source: branches/streams/abcl/src/org/armedbear/lisp/Layout.java

Last change on this file was 14466, checked in by rschlatte, 12 years ago

call type_error when possible

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 8.5 KB
Line 
1/*
2 * Layout.java
3 *
4 * Copyright (C) 2003-2006 Peter Graves
5 * $Id: Layout.java 14466 2013-04-24 12:50:40Z rschlatte $
6 *
7 * This program is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
11 *
12 * This program is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with this program; if not, write to the Free Software
19 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
20 *
21 * As a special exception, the copyright holders of this library give you
22 * permission to link this library with independent modules to produce an
23 * executable, regardless of the license terms of these independent
24 * modules, and to copy and distribute the resulting executable under
25 * terms of your choice, provided that you also meet, for each linked
26 * independent module, the terms and conditions of the license of that
27 * module.  An independent module is a module which is not derived from
28 * or based on this library.  If you modify this library, you may extend
29 * this exception to your version of the library, but you are not
30 * obligated to do so.  If you do not wish to do so, delete this
31 * exception statement from your version.
32 */
33
34package org.armedbear.lisp;
35
36import java.util.concurrent.ConcurrentHashMap;
37import static org.armedbear.lisp.Lisp.*;
38
39public class Layout extends LispObject
40{
41  private final LispObject lispClass;
42  public final ConcurrentHashMap<LispObject, LispObject> slotTable;
43
44  final LispObject[] slotNames;
45  final LispObject sharedSlots;
46
47  private boolean invalid;
48
49  public Layout(LispObject lispClass, LispObject instanceSlots, LispObject sharedSlots)
50  {
51    this.lispClass = lispClass;
52    Debug.assertTrue(instanceSlots.listp());
53    int length = instanceSlots.length();
54    slotNames = new LispObject[length];
55    int i = 0;
56
57    while (instanceSlots != NIL)
58      {
59        slotNames[i++] = instanceSlots.car();
60        instanceSlots = instanceSlots.cdr();
61      }
62
63    Debug.assertTrue(i == length);
64    this.sharedSlots = sharedSlots;
65    slotTable = initializeSlotTable(slotNames);
66  }
67
68  public Layout(LispObject lispClass, LispObject[] instanceSlotNames,
69                LispObject sharedSlots)
70  {
71    this.lispClass = lispClass;
72    this.slotNames = instanceSlotNames;
73    this.sharedSlots = sharedSlots;
74    slotTable = initializeSlotTable(slotNames);
75  }
76
77  // Copy constructor.
78  Layout(Layout oldLayout)
79  {
80    lispClass = oldLayout.getLispClass();
81    slotNames = oldLayout.slotNames;
82    sharedSlots = oldLayout.sharedSlots;
83    slotTable = initializeSlotTable(slotNames);
84  }
85
86  private ConcurrentHashMap initializeSlotTable(LispObject[] slotNames)
87  {
88    ConcurrentHashMap ht = new ConcurrentHashMap(slotNames.length);
89    for (int i = slotNames.length; i-- > 0;)
90      ht.put(slotNames[i], Fixnum.getInstance(i));
91    return ht;
92  }
93
94  @Override
95  public LispObject getParts()
96  {
97    LispObject result = NIL;
98    result = result.push(new Cons("class", getLispClass()));
99    for (int i = 0; i < slotNames.length; i++)
100      {
101        result = result.push(new Cons("slot " + i, slotNames[i]));
102      }
103    result = result.push(new Cons("shared slots", sharedSlots));
104    return result.nreverse();
105  }
106
107  public LispObject getLispClass()
108  {
109    return lispClass;
110  }
111
112  public boolean isInvalid()
113  {
114    return invalid;
115  }
116
117  public void invalidate()
118  {
119    invalid = true;
120  }
121
122  public LispObject[] getSlotNames()
123  {
124    return slotNames;
125  }
126
127  public int getLength()
128  {
129    return slotNames.length;
130  }
131
132  public LispObject getSharedSlots()
133  {
134    return sharedSlots;
135  }
136
137  @Override
138  public String printObject()
139  {
140    return unreadableString("LAYOUT");
141  }
142
143  // Generates a list of slot definitions for the slot names in this layout.
144  protected LispObject generateSlotDefinitions()
145  {
146    LispObject list = NIL;
147    for (int i = slotNames.length; i-- > 0;)
148      list = list.push(new SlotDefinition(slotNames[i], NIL));
149
150    return list;
151  }
152
153  // ### make-layout
154  private static final Primitive MAKE_LAYOUT =
155    new Primitive("make-layout", PACKAGE_SYS, true,
156                  "class instance-slots class-slots")
157    {
158      @Override
159      public LispObject execute(LispObject first, LispObject second,
160                                LispObject third)
161
162      {
163          return new Layout(first, checkList(second), checkList(third));
164      }
165
166    };
167
168  // ### layout-class
169  private static final Primitive LAYOUT_CLASS =
170    new Primitive("layout-class", PACKAGE_SYS, true, "layout")
171    {
172      @Override
173      public LispObject execute(LispObject arg)
174      {
175          return checkLayout(arg).getLispClass();
176      }
177    };
178
179  // ### layout-length
180  private static final Primitive LAYOUT_LENGTH =
181    new Primitive("layout-length", PACKAGE_SYS, true, "layout")
182    {
183      @Override
184      public LispObject execute(LispObject arg)
185      {
186          return Fixnum.getInstance(checkLayout(arg).slotNames.length);
187      }
188    };
189
190  public int getSlotIndex(LispObject slotName)
191  {
192    LispObject index = slotTable.get(slotName);
193    if (index != null)
194      return ((Fixnum)index).value;
195    return -1;
196  }
197
198  public LispObject getSharedSlotLocation(LispObject slotName)
199
200  {
201    LispObject rest = sharedSlots;
202    while (rest != NIL)
203      {
204        LispObject location = rest.car();
205        if (location.car() == slotName)
206          return location;
207        rest = rest.cdr();
208      }
209    return null;
210  }
211
212  // ### layout-slot-index layout slot-name => index
213  private static final Primitive LAYOUT_SLOT_INDEX =
214    new Primitive("layout-slot-index", PACKAGE_SYS, true)
215    {
216      @Override
217      public LispObject execute(LispObject first, LispObject second)
218
219      {
220          final LispObject slotNames[] = checkLayout(first).slotNames;
221          for (int i = slotNames.length; i-- > 0;)
222            {
223              if (slotNames[i] == second)
224                return Fixnum.getInstance(i);
225            }
226          return NIL;
227      }
228    };
229
230  // ### layout-slot-location layout slot-name => location
231  private static final Primitive LAYOUT_SLOT_LOCATION =
232    new Primitive("layout-slot-location", PACKAGE_SYS, true, "layout slot-name")
233    {
234      @Override
235      public LispObject execute(LispObject first, LispObject second)
236
237      {
238            final Layout layOutFirst = checkLayout(first);
239            final LispObject slotNames[] = layOutFirst.slotNames;
240            final int limit = slotNames.length;
241            for (int i = 0; i < limit; i++)
242              {
243                if (slotNames[i] == second)
244                  return Fixnum.getInstance(i);
245              }
246            // Reaching here, it's not an instance slot.
247            LispObject rest = layOutFirst.sharedSlots;
248            while (rest != NIL)
249              {
250                LispObject location = rest.car();
251                if (location.car() == second)
252                  return location;
253                rest = rest.cdr();
254              }
255            return NIL;
256          }
257    };
258
259  // ### %make-instances-obsolete class => class
260  private static final Primitive _MAKE_INSTANCES_OBSOLETE =
261    new Primitive("%make-instances-obsolete", PACKAGE_SYS, true, "class")
262    {
263      @Override
264      public LispObject execute(LispObject arg)
265      {
266        final LispObject lispClass = arg;
267        LispObject oldLayout;
268        // Non-finalized classes might not have a valid layout, but they do
269        // not have instances either so we can abort.
270        if (lispClass instanceof LispClass) {
271          if (!((LispClass)lispClass).isFinalized())
272            return arg;
273          oldLayout = ((LispClass)lispClass).getClassLayout();
274        } else if (lispClass instanceof StandardObject) {
275          if (((StandardObject)arg)
276              .getInstanceSlotValue(StandardClass.symFinalizedP) == NIL)
277            return arg;
278          oldLayout = Symbol.CLASS_LAYOUT.execute(lispClass);
279        } else {
280          return type_error(arg, Symbol.CLASS);
281        }
282
283        Layout newLayout = new Layout((Layout)oldLayout);
284        if (lispClass instanceof LispClass)
285          ((LispClass)lispClass).setClassLayout(newLayout);
286        else
287          Symbol.CLASS_LAYOUT.getSymbolSetfFunction()
288              .execute(newLayout, lispClass);
289        ((Layout)oldLayout).invalidate();
290        return arg;
291      }
292    };
293}
Note: See TracBrowser for help on using the repository browser.