source: branches/1.0.x/abcl/src/org/armedbear/lisp/StandardClass.java

Last change on this file was 13440, checked in by ehuelsmann, 14 years ago

Rename writeToString() to printObject() since that's what it's being used for.
Additionally, create princToString() for use in error messages, making the

required replacement where appropriate.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 31.7 KB
Line 
1/*
2 * StandardClass.java
3 *
4 * Copyright (C) 2003-2005 Peter Graves
5 * $Id: StandardClass.java 13440 2011-08-05 21:25:10Z ehuelsmann $
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 static org.armedbear.lisp.Lisp.*;
37
38public class StandardClass extends SlotClass
39{
40
41  public static Symbol symName = PACKAGE_MOP.intern("NAME");
42  public static Symbol symLayout = PACKAGE_MOP.intern("LAYOUT");
43  public static Symbol symDirectSuperclasses
44    = PACKAGE_MOP.intern("DIRECT-SUPERCLASSES");
45  public static Symbol symDirectSubclasses
46    = PACKAGE_MOP.intern("DIRECT-SUBCLASSES");
47  public static Symbol symPrecedenceList
48    = PACKAGE_MOP.intern("PRECEDENCE-LIST");
49  public static Symbol symDirectMethods
50    = PACKAGE_MOP.intern("DIRECT-METHODS");
51  public static Symbol symDocumentation
52    = PACKAGE_MOP.intern("DOCUMENTATION");
53  public static Symbol symDirectSlots
54    = PACKAGE_MOP.intern("DIRECT-SLOTS");
55  public static Symbol symSlots
56    = PACKAGE_MOP.intern("SLOTS");
57  public static Symbol symDirectDefaultInitargs
58    = PACKAGE_MOP.intern("DIRECT-DEFAULT-INITARGS");
59  public static Symbol symDefaultInitargs
60    = PACKAGE_MOP.intern("DEFAULT-INITARGS");
61  public static Symbol symFinalizedP
62    = PACKAGE_MOP.intern("FINALIZED-P");
63
64  static Layout layoutStandardClass =
65      new Layout(null,
66                 list(symName,
67                      symLayout,
68                      symDirectSuperclasses,
69                      symDirectSubclasses,
70                      symPrecedenceList,
71                      symDirectMethods,
72                      symDirectSlots,
73                      symSlots,
74                      symDirectDefaultInitargs,
75                      symDefaultInitargs,
76                      symFinalizedP,
77                      symDocumentation),
78                 NIL)
79      {
80        @Override
81        public LispClass getLispClass()
82        {
83          return STANDARD_CLASS;
84        }
85      };
86
87  public StandardClass()
88  {
89      super(layoutStandardClass);
90      setDirectSuperclasses(NIL);
91      setDirectSubclasses(NIL);
92      setClassLayout(layoutStandardClass);
93      setCPL(NIL);
94      setDirectMethods(NIL);
95      setDocumentation(NIL);
96      setDirectSlotDefinitions(NIL);
97      setSlotDefinitions(NIL);
98      setDirectDefaultInitargs(NIL);
99      setDefaultInitargs(NIL);
100      setFinalized(false);
101  }
102
103  public StandardClass(Symbol symbol, LispObject directSuperclasses)
104  {
105      super(layoutStandardClass,
106            symbol, directSuperclasses);
107      setDirectSubclasses(NIL);
108      setClassLayout(layoutStandardClass);
109      setCPL(NIL);
110      setDirectMethods(NIL);
111      setDocumentation(NIL);
112      setDirectSlotDefinitions(NIL);
113      setSlotDefinitions(NIL);
114      setDirectDefaultInitargs(NIL);
115      setDefaultInitargs(NIL);
116      setFinalized(false);
117  }
118
119  @Override
120  public LispObject getName()
121  {
122    return getInstanceSlotValue(symName);
123  }
124
125  @Override
126  public void setName(LispObject newName)
127  {
128    setInstanceSlotValue(symName, newName);
129  }
130
131  @Override
132  public Layout getClassLayout()
133  {
134    LispObject layout = getInstanceSlotValue(symLayout);
135    if (layout == UNBOUND_VALUE)
136        return null;
137
138    if (! (layout instanceof Layout)) {
139        (new Error()).printStackTrace();
140        LispThread.currentThread().printBacktrace();
141        return (Layout)Lisp.error(Symbol.TYPE_ERROR,
142                new SimpleString("The value " + layout.princToString()
143                    + " is not of expected type " + Symbol.LAYOUT.princToString()
144                    + " in class " + this.princToString() + "."));
145      }
146   
147    return (layout == UNBOUND_VALUE) ? null : (Layout)layout;
148  }
149
150  @Override
151  public void setClassLayout(LispObject newLayout)
152  {
153    setInstanceSlotValue(symLayout, newLayout);
154  }
155
156  @Override
157  public LispObject getDirectSuperclasses()
158  {
159    return getInstanceSlotValue(symDirectSuperclasses);
160  }
161
162  @Override
163  public void setDirectSuperclasses(LispObject directSuperclasses)
164  {
165    setInstanceSlotValue(symDirectSuperclasses, directSuperclasses);
166  }
167
168  @Override
169  public final boolean isFinalized()
170  {
171    return getInstanceSlotValue(symFinalizedP) != NIL;
172  }
173
174  @Override
175  public final void setFinalized(boolean b)
176  {
177    setInstanceSlotValue(symFinalizedP, b ? T : NIL);
178  }
179
180  @Override
181  public LispObject getDirectSubclasses()
182  {
183    return getInstanceSlotValue(symDirectSubclasses);
184  }
185
186  @Override
187  public void setDirectSubclasses(LispObject directSubclasses)
188  {
189    setInstanceSlotValue(symDirectSubclasses, directSubclasses);
190  }
191
192  @Override
193  public LispObject getCPL()
194  {
195    return getInstanceSlotValue(symPrecedenceList);
196  }
197
198  @Override
199  public void setCPL(LispObject... cpl)
200  {
201    LispObject obj1 = cpl[0];
202    if (obj1.listp() && cpl.length == 1)
203      setInstanceSlotValue(symPrecedenceList, obj1);
204    else
205      {
206        Debug.assertTrue(obj1 == this);
207        LispObject l = NIL;
208        for (int i = cpl.length; i-- > 0;)
209            l = new Cons(cpl[i], l);
210        setInstanceSlotValue(symPrecedenceList, l);
211      }
212  }
213
214  @Override
215  public LispObject getDirectMethods()
216  {
217    return getInstanceSlotValue(symDirectMethods);
218  }
219
220  @Override
221  public void setDirectMethods(LispObject methods)
222  {
223    setInstanceSlotValue(symDirectMethods, methods);
224  }
225
226  @Override
227  public LispObject getDocumentation()
228  {
229    return getInstanceSlotValue(symDocumentation);
230  }
231
232  @Override
233  public void setDocumentation(LispObject doc)
234  {
235    setInstanceSlotValue(symDocumentation, doc);
236  }
237
238  @Override
239  public LispObject getDirectSlotDefinitions()
240  {
241    return getInstanceSlotValue(symDirectSlots);
242  }
243
244  @Override
245  public void setDirectSlotDefinitions(LispObject directSlotDefinitions)
246  {
247    setInstanceSlotValue(symDirectSlots, directSlotDefinitions);
248  }
249
250  @Override
251  public LispObject getSlotDefinitions()
252  {
253    return getInstanceSlotValue(symSlots);
254  }
255
256  @Override
257  public void setSlotDefinitions(LispObject slotDefinitions)
258  {
259     setInstanceSlotValue(symSlots, slotDefinitions);
260  }
261
262  @Override
263  public LispObject getDirectDefaultInitargs()
264  {
265    return getInstanceSlotValue(symDirectDefaultInitargs);
266  }
267
268  @Override
269  public void setDirectDefaultInitargs(LispObject directDefaultInitargs)
270  {
271    setInstanceSlotValue(symDirectDefaultInitargs, directDefaultInitargs);
272  }
273
274  @Override
275  public LispObject getDefaultInitargs()
276  {
277    return getInstanceSlotValue(symDefaultInitargs);
278  }
279
280  @Override
281  public void setDefaultInitargs(LispObject defaultInitargs)
282  {
283    setInstanceSlotValue(symDefaultInitargs, defaultInitargs);
284  }
285
286  @Override
287  public LispObject typeOf()
288  {
289    return Symbol.STANDARD_CLASS;
290  }
291
292  @Override
293  public LispObject classOf()
294  {
295    return STANDARD_CLASS;
296  }
297
298  @Override
299  public LispObject typep(LispObject type)
300  {
301    if (type == Symbol.STANDARD_CLASS)
302      return T;
303    if (type == STANDARD_CLASS)
304      return T;
305    return super.typep(type);
306  }
307
308  public LispObject allocateInstance()
309  {
310    Layout layout = getClassLayout();
311    if (layout == null)
312      {
313        Symbol.ERROR.execute(Symbol.SIMPLE_ERROR,
314                             Keyword.FORMAT_CONTROL,
315                             new SimpleString("No layout for class ~S."),
316                             Keyword.FORMAT_ARGUMENTS,
317                             list(this));
318      }
319    return new StandardObject(this, layout.getLength());
320  }
321
322  @Override
323  public String printObject()
324  {
325    StringBuilder sb =
326      new StringBuilder(Symbol.STANDARD_CLASS.printObject());
327    if (getName() != null)
328      {
329        sb.append(' ');
330        sb.append(getName().printObject());
331      }
332    return unreadableString(sb.toString());
333  }
334
335  private static final LispObject standardClassSlotDefinitions()
336  {
337      // (CONSTANTLY NIL)
338    Function initFunction = new Function() {
339      @Override
340      public LispObject execute()
341      {
342         return NIL;
343      }
344    };
345
346    return
347        list(helperMakeSlotDefinition("NAME", initFunction),
348             helperMakeSlotDefinition("LAYOUT", initFunction),
349             helperMakeSlotDefinition("DIRECT-SUPERCLASSES", initFunction),
350             helperMakeSlotDefinition("DIRECT-SUBCLASSES", initFunction),
351             helperMakeSlotDefinition("PRECEDENCE-LIST", initFunction),
352             helperMakeSlotDefinition("DIRECT-METHODS", initFunction),
353             helperMakeSlotDefinition("DIRECT-SLOTS", initFunction),
354             helperMakeSlotDefinition("SLOTS", initFunction),
355             helperMakeSlotDefinition("DIRECT-DEFAULT-INITARGS", initFunction),
356             helperMakeSlotDefinition("DEFAULT-INITARGS", initFunction),
357             helperMakeSlotDefinition("FINALIZED-P", initFunction),
358             helperMakeSlotDefinition("DOCUMENTATION", initFunction));
359  }
360
361
362
363  private static final SlotDefinition helperMakeSlotDefinition(String name,
364                                                               Function init)
365  {
366    return
367        new SlotDefinition(PACKAGE_MOP.intern(name),   // name
368             list(PACKAGE_MOP.intern("CLASS-" + name)), // readers
369             init);
370  }
371
372  private static final StandardClass addStandardClass(Symbol name,
373                                                      LispObject directSuperclasses)
374  {
375    StandardClass c = new StandardClass(name, directSuperclasses);
376    addClass(name, c);
377    return c;
378  }
379
380  // At this point, BuiltInClass.java has not been completely loaded yet, and
381  // BuiltInClass.CLASS_T is null. So we need to call setDirectSuperclass()
382  // for STANDARD_CLASS and STANDARD_OBJECT in initializeStandardClasses()
383  // below.
384  public static final StandardClass STANDARD_CLASS =
385    addStandardClass(Symbol.STANDARD_CLASS, list(BuiltInClass.CLASS_T));
386  public static final StandardClass STANDARD_OBJECT =
387    addStandardClass(Symbol.STANDARD_OBJECT, list(BuiltInClass.CLASS_T));
388
389    public static final StandardClass SLOT_DEFINITION =
390        addStandardClass(Symbol.SLOT_DEFINITION, list(STANDARD_OBJECT));
391    public static final StandardClass STANDARD_SLOT_DEFINITION =
392        addClass(Symbol.STANDARD_SLOT_DEFINITION, new SlotDefinitionClass(Symbol.STANDARD_SLOT_DEFINITION, list(SLOT_DEFINITION)));
393
394  static
395  {
396      SLOT_DEFINITION.finalizeClass();
397
398    STANDARD_CLASS.setClassLayout(layoutStandardClass);
399    STANDARD_CLASS.setDirectSlotDefinitions(standardClassSlotDefinitions());
400  }
401
402    public static final StandardClass DIRECT_SLOT_DEFINITION =
403      addStandardClass(Symbol.DIRECT_SLOT_DEFINITION, list(SLOT_DEFINITION));
404    public static final StandardClass EFFECTIVE_SLOT_DEFINITION =
405        addStandardClass(Symbol.EFFECTIVE_SLOT_DEFINITION, list(SLOT_DEFINITION));
406    //      addStandardClass(Symbol.STANDARD_SLOT_DEFINITION, list(SLOT_DEFINITION));
407    public static final StandardClass STANDARD_DIRECT_SLOT_DEFINITION =
408        addClass(Symbol.STANDARD_DIRECT_SLOT_DEFINITION,
409                 new SlotDefinitionClass(Symbol.STANDARD_DIRECT_SLOT_DEFINITION,
410                                         list(STANDARD_SLOT_DEFINITION, DIRECT_SLOT_DEFINITION)));
411    public static final StandardClass STANDARD_EFFECTIVE_SLOT_DEFINITION =
412        addClass(Symbol.STANDARD_EFFECTIVE_SLOT_DEFINITION,
413                 new SlotDefinitionClass(Symbol.STANDARD_EFFECTIVE_SLOT_DEFINITION,
414                                         list(STANDARD_SLOT_DEFINITION, EFFECTIVE_SLOT_DEFINITION)));
415
416
417  // BuiltInClass.FUNCTION is also null here (see previous comment).
418  public static final StandardClass GENERIC_FUNCTION =
419    addStandardClass(Symbol.GENERIC_FUNCTION, list(BuiltInClass.FUNCTION,
420                                                    STANDARD_OBJECT));
421
422  public static final StandardClass CLASS =
423    addStandardClass(Symbol.CLASS, list(STANDARD_OBJECT));
424
425  public static final StandardClass BUILT_IN_CLASS =
426    addStandardClass(Symbol.BUILT_IN_CLASS, list(CLASS));
427
428  public static final StandardClass FORWARD_REFERENCED_CLASS =
429    addStandardClass(Symbol.FORWARD_REFERENCED_CLASS, list(CLASS));
430
431  public static final StandardClass STRUCTURE_CLASS =
432    addStandardClass(Symbol.STRUCTURE_CLASS, list(CLASS));
433
434  public static final StandardClass CONDITION =
435    addStandardClass(Symbol.CONDITION, list(STANDARD_OBJECT));
436
437  public static final StandardClass SIMPLE_CONDITION =
438    addStandardClass(Symbol.SIMPLE_CONDITION, list(CONDITION));
439
440  public static final StandardClass WARNING =
441    addStandardClass(Symbol.WARNING, list(CONDITION));
442
443  public static final StandardClass SIMPLE_WARNING =
444    addStandardClass(Symbol.SIMPLE_WARNING, list(SIMPLE_CONDITION, WARNING));
445
446  public static final StandardClass STYLE_WARNING =
447    addStandardClass(Symbol.STYLE_WARNING, list(WARNING));
448
449  public static final StandardClass SERIOUS_CONDITION =
450    addStandardClass(Symbol.SERIOUS_CONDITION, list(CONDITION));
451
452  public static final StandardClass STORAGE_CONDITION =
453    addStandardClass(Symbol.STORAGE_CONDITION, list(SERIOUS_CONDITION));
454
455  public static final StandardClass ERROR =
456    addStandardClass(Symbol.ERROR, list(SERIOUS_CONDITION));
457
458  public static final StandardClass ARITHMETIC_ERROR =
459    addStandardClass(Symbol.ARITHMETIC_ERROR, list(ERROR));
460
461  public static final StandardClass CELL_ERROR =
462    addStandardClass(Symbol.CELL_ERROR, list(ERROR));
463
464  public static final StandardClass CONTROL_ERROR =
465    addStandardClass(Symbol.CONTROL_ERROR, list(ERROR));
466
467  public static final StandardClass FILE_ERROR =
468    addStandardClass(Symbol.FILE_ERROR, list(ERROR));
469
470  public static final StandardClass DIVISION_BY_ZERO =
471    addStandardClass(Symbol.DIVISION_BY_ZERO, list(ARITHMETIC_ERROR));
472
473  public static final StandardClass FLOATING_POINT_INEXACT =
474    addStandardClass(Symbol.FLOATING_POINT_INEXACT, list(ARITHMETIC_ERROR));
475
476  public static final StandardClass FLOATING_POINT_INVALID_OPERATION =
477    addStandardClass(Symbol.FLOATING_POINT_INVALID_OPERATION, list(ARITHMETIC_ERROR));
478
479  public static final StandardClass FLOATING_POINT_OVERFLOW =
480    addStandardClass(Symbol.FLOATING_POINT_OVERFLOW, list(ARITHMETIC_ERROR));
481
482  public static final StandardClass FLOATING_POINT_UNDERFLOW =
483    addStandardClass(Symbol.FLOATING_POINT_UNDERFLOW, list(ARITHMETIC_ERROR));
484
485  public static final StandardClass PROGRAM_ERROR =
486    addStandardClass(Symbol.PROGRAM_ERROR, list(ERROR));
487
488  public static final StandardClass PACKAGE_ERROR =
489    addStandardClass(Symbol.PACKAGE_ERROR, list(ERROR));
490
491  public static final StandardClass STREAM_ERROR =
492    addStandardClass(Symbol.STREAM_ERROR, list(ERROR));
493
494  public static final StandardClass PARSE_ERROR =
495    addStandardClass(Symbol.PARSE_ERROR, list(ERROR));
496
497  public static final StandardClass PRINT_NOT_READABLE =
498    addStandardClass(Symbol.PRINT_NOT_READABLE, list(ERROR));
499
500  public static final StandardClass READER_ERROR =
501    addStandardClass(Symbol.READER_ERROR, list(PARSE_ERROR, STREAM_ERROR));
502
503  public static final StandardClass END_OF_FILE =
504    addStandardClass(Symbol.END_OF_FILE, list(STREAM_ERROR));
505
506  public static final StandardClass SIMPLE_ERROR =
507    addStandardClass(Symbol.SIMPLE_ERROR, list(SIMPLE_CONDITION, ERROR));
508
509  public static final StandardClass TYPE_ERROR =
510    addStandardClass(Symbol.TYPE_ERROR, list(ERROR));
511
512  public static final StandardClass SIMPLE_TYPE_ERROR =
513    addStandardClass(Symbol.SIMPLE_TYPE_ERROR, list(SIMPLE_CONDITION,
514                                                     TYPE_ERROR));
515
516  public static final StandardClass UNBOUND_SLOT =
517    addStandardClass(Symbol.UNBOUND_SLOT, list(CELL_ERROR));
518
519  public static final StandardClass UNBOUND_VARIABLE =
520    addStandardClass(Symbol.UNBOUND_VARIABLE, list(CELL_ERROR));
521
522  public static final StandardClass UNDEFINED_FUNCTION =
523    addStandardClass(Symbol.UNDEFINED_FUNCTION, list(CELL_ERROR));
524
525  public static final StandardClass COMPILER_ERROR =
526    addStandardClass(Symbol.COMPILER_ERROR, list(CONDITION));
527   
528  public static final StandardClass INTERNAL_COMPILER_ERROR =
529    addStandardClass(Symbol.INTERNAL_COMPILER_ERROR, list(CONDITION));
530
531  public static final StandardClass COMPILER_UNSUPPORTED_FEATURE_ERROR =
532    addStandardClass(Symbol.COMPILER_UNSUPPORTED_FEATURE_ERROR,
533                     list(CONDITION));
534
535  public static final StandardClass JAVA_EXCEPTION =
536    addStandardClass(Symbol.JAVA_EXCEPTION, list(ERROR));
537
538  public static final StandardClass METHOD =
539    addStandardClass(Symbol.METHOD, list(STANDARD_OBJECT));
540
541  public static final StandardClass STANDARD_METHOD =
542    new StandardMethodClass();
543  static
544  {
545    addClass(Symbol.STANDARD_METHOD, STANDARD_METHOD);
546  }
547
548  public static final StandardClass STANDARD_READER_METHOD =
549    new StandardReaderMethodClass();
550  static
551  {
552    addClass(Symbol.STANDARD_READER_METHOD, STANDARD_READER_METHOD);
553  }
554
555  public static final StandardClass STANDARD_GENERIC_FUNCTION =
556    new StandardGenericFunctionClass();
557  static
558  {
559    addClass(Symbol.STANDARD_GENERIC_FUNCTION, STANDARD_GENERIC_FUNCTION);
560  }
561
562  public static void initializeStandardClasses()
563  {
564    // We need to call setDirectSuperclass() here for classes that have a
565    // BuiltInClass as a superclass. See comment above (at first mention of
566    // STANDARD_OBJECT).
567    STANDARD_CLASS.setDirectSuperclass(CLASS);
568    STANDARD_OBJECT.setDirectSuperclass(BuiltInClass.CLASS_T);
569    GENERIC_FUNCTION.setDirectSuperclasses(list(BuiltInClass.FUNCTION,
570                                                 STANDARD_OBJECT));
571
572    ARITHMETIC_ERROR.setCPL(ARITHMETIC_ERROR, ERROR, SERIOUS_CONDITION,
573                            CONDITION, STANDARD_OBJECT, BuiltInClass.CLASS_T);
574    ARITHMETIC_ERROR.setDirectSlotDefinitions(
575      list(new SlotDefinition(Symbol.OPERATION,
576                               list(PACKAGE_CL.intern("ARITHMETIC-ERROR-OPERATION"))),
577            new SlotDefinition(Symbol.OPERANDS,
578                               list(PACKAGE_CL.intern("ARITHMETIC-ERROR-OPERANDS")))));
579    BUILT_IN_CLASS.setCPL(BUILT_IN_CLASS, CLASS, STANDARD_OBJECT,
580                          BuiltInClass.CLASS_T);
581    CELL_ERROR.setCPL(CELL_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
582                      STANDARD_OBJECT, BuiltInClass.CLASS_T);
583    CELL_ERROR.setDirectSlotDefinitions(
584      list(new SlotDefinition(Symbol.NAME,
585                               list(Symbol.CELL_ERROR_NAME))));
586    CLASS.setCPL(CLASS, STANDARD_OBJECT, BuiltInClass.CLASS_T);
587    COMPILER_ERROR.setCPL(COMPILER_ERROR, CONDITION, STANDARD_OBJECT,
588                          BuiltInClass.CLASS_T);
589    INTERNAL_COMPILER_ERROR.setCPL(INTERNAL_COMPILER_ERROR, CONDITION, STANDARD_OBJECT,
590                                   BuiltInClass.CLASS_T);
591    COMPILER_UNSUPPORTED_FEATURE_ERROR.setCPL(COMPILER_UNSUPPORTED_FEATURE_ERROR,
592                                              CONDITION, STANDARD_OBJECT,
593                                              BuiltInClass.CLASS_T);
594    CONDITION.setCPL(CONDITION, STANDARD_OBJECT, BuiltInClass.CLASS_T);
595    CONDITION.setDirectSlotDefinitions(
596      list(new SlotDefinition(Symbol.FORMAT_CONTROL,
597                               list(Symbol.SIMPLE_CONDITION_FORMAT_CONTROL)),
598            new SlotDefinition(Symbol.FORMAT_ARGUMENTS,
599                               list(Symbol.SIMPLE_CONDITION_FORMAT_ARGUMENTS),
600                               NIL)));
601    CONDITION.setDirectDefaultInitargs(list(Keyword.FORMAT_ARGUMENTS,
602                                             // FIXME
603                                             new Closure(list(Symbol.LAMBDA, NIL, NIL),
604                                                         new Environment())));
605    CONTROL_ERROR.setCPL(CONTROL_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
606                         STANDARD_OBJECT, BuiltInClass.CLASS_T);
607    DIVISION_BY_ZERO.setCPL(DIVISION_BY_ZERO, ARITHMETIC_ERROR, ERROR,
608                            SERIOUS_CONDITION, CONDITION, STANDARD_OBJECT,
609                            BuiltInClass.CLASS_T);
610    END_OF_FILE.setCPL(END_OF_FILE, STREAM_ERROR, ERROR, SERIOUS_CONDITION,
611                       CONDITION, STANDARD_OBJECT, BuiltInClass.CLASS_T);
612    ERROR.setCPL(ERROR, SERIOUS_CONDITION, CONDITION, STANDARD_OBJECT,
613                 BuiltInClass.CLASS_T);
614    FILE_ERROR.setCPL(FILE_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
615                      STANDARD_OBJECT, BuiltInClass.CLASS_T);
616    FILE_ERROR.setDirectSlotDefinitions(
617      list(new SlotDefinition(Symbol.PATHNAME,
618                               list(PACKAGE_CL.intern("FILE-ERROR-PATHNAME")))));
619    FLOATING_POINT_INEXACT.setCPL(FLOATING_POINT_INEXACT, ARITHMETIC_ERROR,
620                                  ERROR, SERIOUS_CONDITION, CONDITION,
621                                  STANDARD_OBJECT, BuiltInClass.CLASS_T);
622    FLOATING_POINT_INVALID_OPERATION.setCPL(FLOATING_POINT_INVALID_OPERATION,
623                                            ARITHMETIC_ERROR, ERROR,
624                                            SERIOUS_CONDITION, CONDITION,
625                                            STANDARD_OBJECT, BuiltInClass.CLASS_T);
626    FLOATING_POINT_OVERFLOW.setCPL(FLOATING_POINT_OVERFLOW, ARITHMETIC_ERROR,
627                                   ERROR, SERIOUS_CONDITION, CONDITION,
628                                   STANDARD_OBJECT, BuiltInClass.CLASS_T);
629    FLOATING_POINT_UNDERFLOW.setCPL(FLOATING_POINT_UNDERFLOW, ARITHMETIC_ERROR,
630                                    ERROR, SERIOUS_CONDITION, CONDITION,
631                                    STANDARD_OBJECT, BuiltInClass.CLASS_T);
632    FORWARD_REFERENCED_CLASS.setCPL(FORWARD_REFERENCED_CLASS, CLASS,
633                                    BuiltInClass.CLASS_T);
634    GENERIC_FUNCTION.setCPL(GENERIC_FUNCTION, STANDARD_OBJECT,
635                            BuiltInClass.FUNCTION,
636                            BuiltInClass.CLASS_T);
637    JAVA_EXCEPTION.setCPL(JAVA_EXCEPTION, ERROR, SERIOUS_CONDITION, CONDITION,
638                          STANDARD_OBJECT, BuiltInClass.CLASS_T);
639    JAVA_EXCEPTION.setDirectSlotDefinitions(
640      list(new SlotDefinition(Symbol.CAUSE, list(Symbol.JAVA_EXCEPTION_CAUSE))));
641    METHOD.setCPL(METHOD, STANDARD_OBJECT, BuiltInClass.CLASS_T);
642    PACKAGE_ERROR.setCPL(PACKAGE_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
643                         STANDARD_OBJECT, BuiltInClass.CLASS_T);
644    PACKAGE_ERROR.setDirectSlotDefinitions(
645      list(new SlotDefinition(Symbol.PACKAGE,
646                               list(PACKAGE_CL.intern("PACKAGE-ERROR-PACKAGE")))));
647    PARSE_ERROR.setCPL(PARSE_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
648                       STANDARD_OBJECT, BuiltInClass.CLASS_T);
649    PRINT_NOT_READABLE.setCPL(PRINT_NOT_READABLE, ERROR, SERIOUS_CONDITION,
650                              CONDITION, STANDARD_OBJECT, BuiltInClass.CLASS_T);
651    PRINT_NOT_READABLE.setDirectSlotDefinitions(
652      list(new SlotDefinition(Symbol.OBJECT,
653                               list(PACKAGE_CL.intern("PRINT-NOT-READABLE-OBJECT")))));
654    PROGRAM_ERROR.setCPL(PROGRAM_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
655                         STANDARD_OBJECT, BuiltInClass.CLASS_T);
656    READER_ERROR.setCPL(READER_ERROR, PARSE_ERROR, STREAM_ERROR, ERROR,
657                        SERIOUS_CONDITION, CONDITION, STANDARD_OBJECT,
658                        BuiltInClass.CLASS_T);
659    SERIOUS_CONDITION.setCPL(SERIOUS_CONDITION, CONDITION, STANDARD_OBJECT,
660                             BuiltInClass.CLASS_T);
661    SIMPLE_CONDITION.setCPL(SIMPLE_CONDITION, CONDITION, STANDARD_OBJECT,
662                            BuiltInClass.CLASS_T);
663    SIMPLE_ERROR.setCPL(SIMPLE_ERROR, SIMPLE_CONDITION, ERROR,
664                        SERIOUS_CONDITION, CONDITION, STANDARD_OBJECT,
665                        BuiltInClass.CLASS_T);
666    SIMPLE_TYPE_ERROR.setDirectSuperclasses(list(SIMPLE_CONDITION,
667                                                  TYPE_ERROR));
668    SIMPLE_TYPE_ERROR.setCPL(SIMPLE_TYPE_ERROR, SIMPLE_CONDITION,
669                             TYPE_ERROR, ERROR, SERIOUS_CONDITION,
670                             CONDITION, STANDARD_OBJECT, BuiltInClass.CLASS_T);
671    SIMPLE_WARNING.setDirectSuperclasses(list(SIMPLE_CONDITION, WARNING));
672    SIMPLE_WARNING.setCPL(SIMPLE_WARNING, SIMPLE_CONDITION, WARNING,
673                          CONDITION, STANDARD_OBJECT, BuiltInClass.CLASS_T);
674    STANDARD_CLASS.setCPL(STANDARD_CLASS, CLASS,
675                          STANDARD_OBJECT, BuiltInClass.CLASS_T);
676    STANDARD_OBJECT.setCPL(STANDARD_OBJECT, BuiltInClass.CLASS_T);
677    STORAGE_CONDITION.setCPL(STORAGE_CONDITION, SERIOUS_CONDITION, CONDITION,
678                             STANDARD_OBJECT, BuiltInClass.CLASS_T);
679    STREAM_ERROR.setCPL(STREAM_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
680                        STANDARD_OBJECT, BuiltInClass.CLASS_T);
681    STREAM_ERROR.setDirectSlotDefinitions(
682      list(new SlotDefinition(Symbol.STREAM,
683                               list(PACKAGE_CL.intern("STREAM-ERROR-STREAM")))));
684    STRUCTURE_CLASS.setCPL(STRUCTURE_CLASS, CLASS, STANDARD_OBJECT,
685                           BuiltInClass.CLASS_T);
686    STYLE_WARNING.setCPL(STYLE_WARNING, WARNING, CONDITION, STANDARD_OBJECT,
687                         BuiltInClass.CLASS_T);
688    TYPE_ERROR.setCPL(TYPE_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
689                      STANDARD_OBJECT, BuiltInClass.CLASS_T);
690    TYPE_ERROR.setDirectSlotDefinitions(
691      list(new SlotDefinition(Symbol.DATUM,
692                               list(PACKAGE_CL.intern("TYPE-ERROR-DATUM"))),
693            new SlotDefinition(Symbol.EXPECTED_TYPE,
694                               list(PACKAGE_CL.intern("TYPE-ERROR-EXPECTED-TYPE")))));
695    UNBOUND_SLOT.setCPL(UNBOUND_SLOT, CELL_ERROR, ERROR, SERIOUS_CONDITION,
696                        CONDITION, STANDARD_OBJECT, BuiltInClass.CLASS_T);
697    UNBOUND_SLOT.setDirectSlotDefinitions(
698      list(new SlotDefinition(Symbol.INSTANCE,
699                               list(PACKAGE_CL.intern("UNBOUND-SLOT-INSTANCE")))));
700    UNBOUND_VARIABLE.setCPL(UNBOUND_VARIABLE, CELL_ERROR, ERROR,
701                            SERIOUS_CONDITION, CONDITION, STANDARD_OBJECT,
702                            BuiltInClass.CLASS_T);
703    UNDEFINED_FUNCTION.setCPL(UNDEFINED_FUNCTION, CELL_ERROR, ERROR,
704                              SERIOUS_CONDITION, CONDITION, STANDARD_OBJECT,
705                              BuiltInClass.CLASS_T);
706    WARNING.setCPL(WARNING, CONDITION, STANDARD_OBJECT, BuiltInClass.CLASS_T);
707
708    // Condition classes.
709    STANDARD_CLASS.finalizeClass();
710    STANDARD_OBJECT.finalizeClass();
711    CLASS.finalizeClass();
712    ARITHMETIC_ERROR.finalizeClass();
713    CELL_ERROR.finalizeClass();
714    COMPILER_ERROR.finalizeClass();
715    INTERNAL_COMPILER_ERROR.finalizeClass();
716    COMPILER_UNSUPPORTED_FEATURE_ERROR.finalizeClass();
717    CONDITION.finalizeClass();
718    CONTROL_ERROR.finalizeClass();
719    DIVISION_BY_ZERO.finalizeClass();
720    END_OF_FILE.finalizeClass();
721    ERROR.finalizeClass();
722    FILE_ERROR.finalizeClass();
723    FLOATING_POINT_INEXACT.finalizeClass();
724    FLOATING_POINT_INVALID_OPERATION.finalizeClass();
725    FLOATING_POINT_OVERFLOW.finalizeClass();
726    FLOATING_POINT_UNDERFLOW.finalizeClass();
727    JAVA_EXCEPTION.finalizeClass();
728    PACKAGE_ERROR.finalizeClass();
729    PARSE_ERROR.finalizeClass();
730    PRINT_NOT_READABLE.finalizeClass();
731    PROGRAM_ERROR.finalizeClass();
732    READER_ERROR.finalizeClass();
733    SERIOUS_CONDITION.finalizeClass();
734    SIMPLE_CONDITION.finalizeClass();
735    SIMPLE_ERROR.finalizeClass();
736    SIMPLE_TYPE_ERROR.finalizeClass();
737    SIMPLE_WARNING.finalizeClass();
738    STORAGE_CONDITION.finalizeClass();
739    STREAM_ERROR.finalizeClass();
740    STYLE_WARNING.finalizeClass();
741    TYPE_ERROR.finalizeClass();
742    UNBOUND_SLOT.finalizeClass();
743    UNBOUND_VARIABLE.finalizeClass();
744    UNDEFINED_FUNCTION.finalizeClass();
745    WARNING.finalizeClass();
746
747    // SYS:SLOT-DEFINITION is constructed and finalized in
748    // SlotDefinitionClass.java, but we need to fill in a few things here.
749    Debug.assertTrue(SLOT_DEFINITION.isFinalized());
750    SLOT_DEFINITION.setCPL(SLOT_DEFINITION, STANDARD_OBJECT,
751                           BuiltInClass.CLASS_T);
752    SLOT_DEFINITION.setDirectSlotDefinitions(SLOT_DEFINITION.getClassLayout().generateSlotDefinitions());
753    // There are no inherited slots.
754    SLOT_DEFINITION.setSlotDefinitions(SLOT_DEFINITION.getDirectSlotDefinitions());
755
756    DIRECT_SLOT_DEFINITION.setCPL(DIRECT_SLOT_DEFINITION, SLOT_DEFINITION,
757                                  STANDARD_OBJECT, BuiltInClass.CLASS_T);
758    DIRECT_SLOT_DEFINITION.finalizeClass();
759    EFFECTIVE_SLOT_DEFINITION.setCPL(EFFECTIVE_SLOT_DEFINITION, SLOT_DEFINITION,
760                                     STANDARD_OBJECT, BuiltInClass.CLASS_T);
761    EFFECTIVE_SLOT_DEFINITION.finalizeClass();
762    STANDARD_SLOT_DEFINITION.setCPL(STANDARD_SLOT_DEFINITION, SLOT_DEFINITION,
763                                    STANDARD_OBJECT, BuiltInClass.CLASS_T);
764    STANDARD_SLOT_DEFINITION.finalizeClass();
765    STANDARD_DIRECT_SLOT_DEFINITION.setCPL(STANDARD_DIRECT_SLOT_DEFINITION, STANDARD_SLOT_DEFINITION,
766                                           DIRECT_SLOT_DEFINITION, SLOT_DEFINITION, STANDARD_OBJECT,
767                                           BuiltInClass.CLASS_T);
768    STANDARD_DIRECT_SLOT_DEFINITION.finalizeClass();
769    STANDARD_EFFECTIVE_SLOT_DEFINITION.setCPL(STANDARD_EFFECTIVE_SLOT_DEFINITION, STANDARD_SLOT_DEFINITION,
770                                              EFFECTIVE_SLOT_DEFINITION, SLOT_DEFINITION, STANDARD_OBJECT,
771                                              BuiltInClass.CLASS_T);
772    STANDARD_EFFECTIVE_SLOT_DEFINITION.finalizeClass();
773
774    // STANDARD-METHOD
775    Debug.assertTrue(STANDARD_METHOD.isFinalized());
776    STANDARD_METHOD.setCPL(STANDARD_METHOD, METHOD, STANDARD_OBJECT,
777                           BuiltInClass.CLASS_T);
778    STANDARD_METHOD.setDirectSlotDefinitions(STANDARD_METHOD.getClassLayout().generateSlotDefinitions());
779    // There are no inherited slots.
780    STANDARD_METHOD.setSlotDefinitions(STANDARD_METHOD.getDirectSlotDefinitions());
781
782    // STANDARD-READER-METHOD
783    Debug.assertTrue(STANDARD_READER_METHOD.isFinalized());
784    STANDARD_READER_METHOD.setCPL(STANDARD_READER_METHOD, STANDARD_METHOD,
785                                  METHOD, STANDARD_OBJECT, BuiltInClass.CLASS_T);
786    STANDARD_READER_METHOD.setSlotDefinitions(STANDARD_READER_METHOD.getClassLayout().generateSlotDefinitions());
787    // All but the last slot are inherited.
788    STANDARD_READER_METHOD.setDirectSlotDefinitions(list(STANDARD_READER_METHOD.getSlotDefinitions().reverse().car()));
789
790    // STANDARD-GENERIC-FUNCTION
791    Debug.assertTrue(STANDARD_GENERIC_FUNCTION.isFinalized());
792    STANDARD_GENERIC_FUNCTION.setCPL(STANDARD_GENERIC_FUNCTION,
793                                     GENERIC_FUNCTION, STANDARD_OBJECT,
794                                     BuiltInClass.FUNCTION,
795                                     BuiltInClass.CLASS_T);
796    STANDARD_GENERIC_FUNCTION.setDirectSlotDefinitions(STANDARD_GENERIC_FUNCTION.getClassLayout().generateSlotDefinitions());
797    // There are no inherited slots.
798    STANDARD_GENERIC_FUNCTION.setSlotDefinitions(STANDARD_GENERIC_FUNCTION.getDirectSlotDefinitions());
799  }
800}
Note: See TracBrowser for help on using the repository browser.