[armedbear-cvs] r14134 - trunk/abcl/src/org/armedbear/lisp
rschlatte at common-lisp.net
rschlatte at common-lisp.net
Sat Aug 25 21:14:51 UTC 2012
Author: rschlatte
Date: Sat Aug 25 14:14:49 2012
New Revision: 14134
Log:
Handle instances of subclasses of standard-slot-definition in accessors
- Subclasses of standard-(direct|effective)-slot-definition are of Java
class StandardObject and might have different class layout.
- Keep the fast, fixed-indexing path for objects of Java class
SlotDefinition, handle other objects via slot-name-based indexing.
- Thanks to Stas Boukarev and Pascal Costanza for error reports and
diagnosis.
Modified:
trunk/abcl/src/org/armedbear/lisp/SlotClass.java
trunk/abcl/src/org/armedbear/lisp/SlotDefinition.java
trunk/abcl/src/org/armedbear/lisp/SlotDefinitionClass.java
trunk/abcl/src/org/armedbear/lisp/Symbol.java
Modified: trunk/abcl/src/org/armedbear/lisp/SlotClass.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/SlotClass.java Wed Aug 22 14:36:59 2012 (r14133)
+++ trunk/abcl/src/org/armedbear/lisp/SlotClass.java Sat Aug 25 14:14:49 2012 (r14134)
@@ -170,8 +170,10 @@
LispObject tail = getSlotDefinitions();
while (tail != NIL) {
SlotDefinition slotDefinition = (SlotDefinition) tail.car();
- slotDefinition.setLocation(i);
- instanceSlotNames[i++] = slotDefinition.getName();
+ SlotDefinition.SET_SLOT_DEFINITION_LOCATION
+ .execute(slotDefinition, Fixnum.getInstance(i));
+ instanceSlotNames[i++] = SlotDefinition._SLOT_DEFINITION_NAME
+ .execute(slotDefinition);
tail = tail.cdr();
}
setClassLayout(new Layout(this, instanceSlotNames, NIL));
Modified: trunk/abcl/src/org/armedbear/lisp/SlotDefinition.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/SlotDefinition.java Wed Aug 22 14:36:59 2012 (r14133)
+++ trunk/abcl/src/org/armedbear/lisp/SlotDefinition.java Sat Aug 25 14:14:49 2012 (r14134)
@@ -47,11 +47,15 @@
}
public SlotDefinition(StandardClass clazz) {
+ // clazz layout needs to have SlotDefinitionClass layout as prefix
+ // or indexed slot access won't work
super(clazz, clazz.getClassLayout().getLength());
slots[SlotDefinitionClass.SLOT_INDEX_LOCATION] = NIL;
}
public SlotDefinition(StandardClass clazz, LispObject name) {
+ // clazz layout needs to have SlotDefinitionClass layout as prefix
+ // or indexed slot access won't work
super(clazz, clazz.getClassLayout().getLength());
slots[SlotDefinitionClass.SLOT_INDEX_NAME] = name;
slots[SlotDefinitionClass.SLOT_INDEX_INITFUNCTION] = NIL;
@@ -118,18 +122,8 @@
}
public static StandardObject checkSlotDefinition(LispObject obj) {
- if (obj instanceof StandardObject) return (StandardObject)obj;
- return (StandardObject)type_error(obj, Symbol.SLOT_DEFINITION);
- }
-
- public final LispObject getName()
- {
- return slots[SlotDefinitionClass.SLOT_INDEX_NAME];
- }
-
- public final void setLocation(int i)
- {
- slots[SlotDefinitionClass.SLOT_INDEX_LOCATION] = Fixnum.getInstance(i);
+ if (obj instanceof StandardObject) return (StandardObject)obj;
+ return (StandardObject)type_error(obj, Symbol.SLOT_DEFINITION);
}
@Override
@@ -149,7 +143,8 @@
private static final Primitive MAKE_SLOT_DEFINITION
= new pf_make_slot_definition();
@DocString(name="make-slot-definition",
- args="&optional class")
+ args="&optional class",
+ doc="Cannot be called with user-defined subclasses of standard-slot-definition.")
private static final class pf_make_slot_definition extends Primitive
{
pf_make_slot_definition()
@@ -168,7 +163,7 @@
}
};
- private static final Primitive _SLOT_DEFINITION_NAME
+ static final Primitive _SLOT_DEFINITION_NAME
= new pf__slot_definition_name();
@DocString(name="%slot-definition-name")
private static final class pf__slot_definition_name extends Primitive
@@ -180,7 +175,11 @@
@Override
public LispObject execute(LispObject arg)
{
- return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_NAME];
+ StandardObject o = checkSlotDefinition(arg);
+ if (o instanceof SlotDefinition)
+ return o.slots[SlotDefinitionClass.SLOT_INDEX_NAME];
+ else
+ return o.getInstanceSlotValue(Symbol.NAME);
}
};
@@ -198,7 +197,11 @@
@Override
public LispObject execute(LispObject first, LispObject second)
{
- checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_NAME] = second;
+ StandardObject o = checkSlotDefinition(first);
+ if (o instanceof SlotDefinition)
+ o.slots[SlotDefinitionClass.SLOT_INDEX_NAME] = second;
+ else
+ o.setInstanceSlotValue(Symbol.NAME, second);
return second;
}
};
@@ -215,7 +218,11 @@
@Override
public LispObject execute(LispObject arg)
{
- return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_INITFUNCTION];
+ StandardObject o = checkSlotDefinition(arg);
+ if (o instanceof SlotDefinition)
+ return o.slots[SlotDefinitionClass.SLOT_INDEX_INITFUNCTION];
+ else
+ return o.getInstanceSlotValue(Symbol.INITFUNCTION);
}
};
@@ -233,7 +240,11 @@
@Override
public LispObject execute(LispObject first, LispObject second)
{
- checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_INITFUNCTION] = second;
+ StandardObject o = checkSlotDefinition(first);
+ if (o instanceof SlotDefinition)
+ o.slots[SlotDefinitionClass.SLOT_INDEX_INITFUNCTION] = second;
+ else
+ o.setInstanceSlotValue(Symbol.INITFUNCTION, second);
return second;
}
};
@@ -246,13 +257,16 @@
{
pf__slot_definition_initform()
{
- super("%slot-definition-initform", PACKAGE_SYS, true,
- "slot-definition");
+ super("%slot-definition-initform", PACKAGE_SYS, true, "slot-definition");
}
@Override
public LispObject execute(LispObject arg)
{
- return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_INITFORM];
+ StandardObject o = checkSlotDefinition(arg);
+ if (o instanceof SlotDefinition)
+ return o.slots[SlotDefinitionClass.SLOT_INDEX_INITFORM];
+ else
+ return o.getInstanceSlotValue(Symbol.INITFORM);
}
};
@@ -270,7 +284,11 @@
@Override
public LispObject execute(LispObject first, LispObject second)
{
- checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_INITFORM] = second;
+ StandardObject o = checkSlotDefinition(first);
+ if (o instanceof SlotDefinition)
+ o.slots[SlotDefinitionClass.SLOT_INDEX_INITFORM] = second;
+ else
+ o.setInstanceSlotValue(Symbol.INITFORM, second);
return second;
}
};
@@ -287,7 +305,11 @@
@Override
public LispObject execute(LispObject arg)
{
- return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_INITARGS];
+ StandardObject o = checkSlotDefinition(arg);
+ if (o instanceof SlotDefinition)
+ return o.slots[SlotDefinitionClass.SLOT_INDEX_INITARGS];
+ else
+ return o.getInstanceSlotValue(Symbol.INITARGS);
}
};
@@ -305,7 +327,11 @@
@Override
public LispObject execute(LispObject first, LispObject second)
{
- checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_INITARGS] = second;
+ StandardObject o = checkSlotDefinition(first);
+ if (o instanceof SlotDefinition)
+ o.slots[SlotDefinitionClass.SLOT_INDEX_INITARGS] = second;
+ else
+ o.setInstanceSlotValue(Symbol.INITARGS, second);
return second;
}
};
@@ -323,7 +349,11 @@
@Override
public LispObject execute(LispObject arg)
{
- return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_READERS];
+ StandardObject o = checkSlotDefinition(arg);
+ if (o instanceof SlotDefinition)
+ return o.slots[SlotDefinitionClass.SLOT_INDEX_READERS];
+ else
+ return o.getInstanceSlotValue(Symbol.READERS);
}
};
@@ -341,7 +371,11 @@
@Override
public LispObject execute(LispObject first, LispObject second)
{
- checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_READERS] = second;
+ StandardObject o = checkSlotDefinition(first);
+ if (o instanceof SlotDefinition)
+ o.slots[SlotDefinitionClass.SLOT_INDEX_READERS] = second;
+ else
+ o.setInstanceSlotValue(Symbol.READERS, second);
return second;
}
};
@@ -360,7 +394,11 @@
@Override
public LispObject execute(LispObject arg)
{
- return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_WRITERS];
+ StandardObject o = checkSlotDefinition(arg);
+ if (o instanceof SlotDefinition)
+ return o.slots[SlotDefinitionClass.SLOT_INDEX_WRITERS];
+ else
+ return o.getInstanceSlotValue(Symbol.WRITERS);
}
};
@@ -378,7 +416,11 @@
@Override
public LispObject execute(LispObject first, LispObject second)
{
- checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_WRITERS] = second;
+ StandardObject o = checkSlotDefinition(first);
+ if (o instanceof SlotDefinition)
+ o.slots[SlotDefinitionClass.SLOT_INDEX_WRITERS] = second;
+ else
+ o.setInstanceSlotValue(Symbol.WRITERS, second);
return second;
}
};
@@ -397,7 +439,11 @@
@Override
public LispObject execute(LispObject arg)
{
- return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION];
+ StandardObject o = checkSlotDefinition(arg);
+ if (o instanceof SlotDefinition)
+ return o.slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION];
+ else
+ return o.getInstanceSlotValue(Symbol.ALLOCATION);
}
};
@@ -415,7 +461,11 @@
@Override
public LispObject execute(LispObject first, LispObject second)
{
- checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION] = second;
+ StandardObject o = checkSlotDefinition(first);
+ if (o instanceof SlotDefinition)
+ o.slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION] = second;
+ else
+ o.setInstanceSlotValue(Symbol.ALLOCATION, second);
return second;
}
};
@@ -434,7 +484,11 @@
@Override
public LispObject execute(LispObject arg)
{
- return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION_CLASS];
+ StandardObject o = checkSlotDefinition(arg);
+ if (o instanceof SlotDefinition)
+ return o.slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION_CLASS];
+ else
+ return o.getInstanceSlotValue(Symbol.ALLOCATION_CLASS);
}
};
@@ -452,7 +506,11 @@
@Override
public LispObject execute(LispObject first, LispObject second)
{
- checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION_CLASS] = second;
+ StandardObject o = checkSlotDefinition(first);
+ if (o instanceof SlotDefinition)
+ o.slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION_CLASS] = second;
+ else
+ o.setInstanceSlotValue(Symbol.ALLOCATION_CLASS, second);
return second;
}
};
@@ -469,11 +527,15 @@
@Override
public LispObject execute(LispObject arg)
{
- return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_LOCATION];
+ StandardObject o = checkSlotDefinition(arg);
+ if (o instanceof SlotDefinition)
+ return o.slots[SlotDefinitionClass.SLOT_INDEX_LOCATION];
+ else
+ return o.getInstanceSlotValue(Symbol.LOCATION);
}
};
- private static final Primitive SET_SLOT_DEFINITION_LOCATION
+ static final Primitive SET_SLOT_DEFINITION_LOCATION
= new pf_set_slot_definition_location();
@DocString(name="set-slot-definition-location",
args="slot-definition location")
@@ -487,7 +549,11 @@
@Override
public LispObject execute(LispObject first, LispObject second)
{
- checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_LOCATION] = second;
+ StandardObject o = checkSlotDefinition(first);
+ if (o instanceof SlotDefinition)
+ o.slots[SlotDefinitionClass.SLOT_INDEX_LOCATION] = second;
+ else
+ o.setInstanceSlotValue(Symbol.LOCATION, second);
return second;
}
};
@@ -504,7 +570,11 @@
@Override
public LispObject execute(LispObject arg)
{
- return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_TYPE];
+ StandardObject o = checkSlotDefinition(arg);
+ if (o instanceof SlotDefinition)
+ return o.slots[SlotDefinitionClass.SLOT_INDEX_TYPE];
+ else
+ return o.getInstanceSlotValue(Symbol._TYPE);
}
};
@@ -522,7 +592,11 @@
@Override
public LispObject execute(LispObject first, LispObject second)
{
- checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_TYPE] = second;
+ StandardObject o = checkSlotDefinition(first);
+ if (o instanceof SlotDefinition)
+ o.slots[SlotDefinitionClass.SLOT_INDEX_TYPE] = second;
+ else
+ o.setInstanceSlotValue(Symbol._TYPE, second);
return second;
}
};
@@ -539,7 +613,11 @@
@Override
public LispObject execute(LispObject arg)
{
- return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_DOCUMENTATION];
+ StandardObject o = checkSlotDefinition(arg);
+ if (o instanceof SlotDefinition)
+ return o.slots[SlotDefinitionClass.SLOT_INDEX_DOCUMENTATION];
+ else
+ return o.getInstanceSlotValue(Symbol._DOCUMENTATION);
}
};
@@ -557,7 +635,11 @@
@Override
public LispObject execute(LispObject first, LispObject second)
{
- checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_DOCUMENTATION] = second;
+ StandardObject o = checkSlotDefinition(first);
+ if (o instanceof SlotDefinition)
+ o.slots[SlotDefinitionClass.SLOT_INDEX_DOCUMENTATION] = second;
+ else
+ o.setInstanceSlotValue(Symbol._DOCUMENTATION, second);
return second;
}
};
Modified: trunk/abcl/src/org/armedbear/lisp/SlotDefinitionClass.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/SlotDefinitionClass.java Wed Aug 22 14:36:59 2012 (r14133)
+++ trunk/abcl/src/org/armedbear/lisp/SlotDefinitionClass.java Sat Aug 25 14:14:49 2012 (r14134)
@@ -50,22 +50,23 @@
public static final int SLOT_INDEX_DOCUMENTATION = 10;
/**
- * For internal use only. This constructor hardcodes the layout of the class, and can't be used
- * to create arbitrary subclasses of slot-definition.
+ * For internal use only. This constructor hardcodes the layout of
+ * the class, and can't be used to create arbitrary subclasses of
+ * slot-definition since new slots get added at the beginning.
*/
public SlotDefinitionClass(Symbol symbol, LispObject cpl) {
super(symbol, cpl);
Package pkg = PACKAGE_SYS;
LispObject[] instanceSlotNames = {
- pkg.intern("NAME"),
- pkg.intern("INITFUNCTION"),
- pkg.intern("INITFORM"),
- pkg.intern("INITARGS"),
- pkg.intern("READERS"),
- pkg.intern("WRITERS"),
- pkg.intern("ALLOCATION"),
- pkg.intern("ALLOCATION-CLASS"),
- pkg.intern("LOCATION"),
+ Symbol.NAME,
+ Symbol.INITFUNCTION,
+ Symbol.INITFORM,
+ Symbol.INITARGS,
+ Symbol.READERS,
+ Symbol.WRITERS,
+ Symbol.ALLOCATION,
+ Symbol.ALLOCATION_CLASS,
+ Symbol.LOCATION,
Symbol._TYPE,
Symbol._DOCUMENTATION
};
Modified: trunk/abcl/src/org/armedbear/lisp/Symbol.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Symbol.java Wed Aug 22 14:36:59 2012 (r14133)
+++ trunk/abcl/src/org/armedbear/lisp/Symbol.java Sat Aug 25 14:14:49 2012 (r14134)
@@ -3110,6 +3110,10 @@
// Internal symbols in SYSTEM package.
+ public static final Symbol ALLOCATION =
+ PACKAGE_SYS.addInternalSymbol("ALLOCATION");
+ public static final Symbol ALLOCATION_CLASS =
+ PACKAGE_SYS.addInternalSymbol("ALLOCATION-CLASS");
public static final Symbol BACKQUOTE_MACRO =
PACKAGE_SYS.addInternalSymbol("BACKQUOTE-MACRO");
public static final Symbol CASE_FROB_STREAM =
@@ -3137,10 +3141,24 @@
PACKAGE_SYS.addInternalSymbol("FUNCTION-PRELOAD");
public static final Symbol _GENERIC_FUNCTION =
PACKAGE_SYS.addInternalSymbol("%GENERIC-FUNCTION");
+ public static final Symbol INITARGS =
+ PACKAGE_SYS.addInternalSymbol("INITARGS");
+ public static final Symbol INITFORM =
+ PACKAGE_SYS.addInternalSymbol("INITFORM");
+ public static final Symbol INITFUNCTION =
+ PACKAGE_SYS.addInternalSymbol("INITFUNCTION");
public static final Symbol INSTANCE =
PACKAGE_SYS.addInternalSymbol("INSTANCE");
+ public static final Symbol JAVA_STACK_FRAME =
+ PACKAGE_SYS.addInternalSymbol("JAVA-STACK-FRAME");
public static final Symbol KEYWORDS =
PACKAGE_SYS.addInternalSymbol("KEYWORDS");
+ public static final Symbol LAMBDA_LIST =
+ PACKAGE_SYS.addInternalSymbol("LAMBDA-LIST");
+ public static final Symbol LISP_STACK_FRAME =
+ PACKAGE_SYS.addInternalSymbol("LISP-STACK-FRAME");
+ public static final Symbol LOCATION =
+ PACKAGE_SYS.addInternalSymbol("LOCATION");
public static final Symbol MACROEXPAND_MACRO =
PACKAGE_SYS.addInternalSymbol("MACROEXPAND-MACRO");
public static final Symbol MAKE_FUNCTION_PRELOADING_CONTEXT =
@@ -3157,6 +3175,8 @@
PACKAGE_SYS.addInternalSymbol("PROXY-PRELOADED-FUNCTION");
public static final Symbol QUALIFIERS =
PACKAGE_SYS.addInternalSymbol("QUALIFIERS");
+ public static final Symbol READERS =
+ PACKAGE_SYS.addInternalSymbol("READERS");
public static final Symbol _SOURCE =
PACKAGE_SYS.addInternalSymbol("%SOURCE");
public static final Symbol SOCKET_STREAM =
@@ -3173,12 +3193,8 @@
PACKAGE_SYS.addInternalSymbol("STACK-FRAME");
public static final Symbol _TYPE =
PACKAGE_SYS.addInternalSymbol("%TYPE");
- public static final Symbol LISP_STACK_FRAME =
- PACKAGE_SYS.addInternalSymbol("LISP-STACK-FRAME");
- public static final Symbol JAVA_STACK_FRAME =
- PACKAGE_SYS.addInternalSymbol("JAVA-STACK-FRAME");
- public static final Symbol LAMBDA_LIST =
- PACKAGE_SYS.addInternalSymbol("LAMBDA-LIST");
+ public static final Symbol WRITERS =
+ PACKAGE_SYS.addInternalSymbol("WRITERS");
// CDR6
public static final Symbol _INSPECTOR_HOOK_ =
More information about the armedbear-cvs
mailing list