Changeset 14503

Timestamp:

05/17/13 20:50:55 (10 years ago)

Author:

rschlatte

Message:

Move initial initialization of generic functions Lisp-side

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• FuncallableStandardObject.java (modified) (1 diff)
• clos.lisp (modified) (1 diff)

trunk/abcl/src/org/armedbear/lisp/FuncallableStandardObject.java

@@ -194 +194 @@
                                + arg.princToString() + ".");
         }
-        FuncallableStandardObject o = new FuncallableStandardObject((Layout)l);
-        if (Symbol.SUBTYPEP.execute(arg, LispClass.findClass(Symbol.STANDARD_GENERIC_FUNCTION)) != NIL) {
-          // KLUDGE: this initialization should be moved Lisp-side
-          o.setInstanceSlotValue(Symbol.NAME, NIL);
-          o.setInstanceSlotValue(Symbol.LAMBDA_LIST, NIL);
-          o.setInstanceSlotValue(Symbol.REQUIRED_ARGS, NIL);
-          o.setInstanceSlotValue(Symbol.OPTIONAL_ARGS, NIL);
-          o.setInstanceSlotValue(Symbol.INITIAL_METHODS, NIL);
-          o.setInstanceSlotValue(Symbol.METHODS, NIL);
-          o.setInstanceSlotValue(Symbol.METHOD_CLASS, StandardClass.STANDARD_METHOD);
-          // method combination class set by clos.lisp:shared-initialize :after
-          o.setInstanceSlotValue(Symbol._METHOD_COMBINATION, list(Symbol.STANDARD));
-          o.setInstanceSlotValue(Symbol.ARGUMENT_PRECEDENCE_ORDER, NIL);
-          o.setInstanceSlotValue(Symbol.DECLARATIONS, NIL);
-          o.setInstanceSlotValue(Symbol._DOCUMENTATION, NIL);
-        }
-        return o;
+        return new FuncallableStandardObject((Layout)l);
       }
       return type_error(arg, Symbol.FUNCALLABLE_STANDARD_CLASS);

trunk/abcl/src/org/armedbear/lisp/clos.lisp

@@ -815 +815 @@
 (defun allocate-funcallable-instance (class)
   (let ((instance (sys::%allocate-funcallable-instance class)))
+    ;; KLUDGE: without this, the build fails with unbound-slot
+    (when (or (eq class +the-standard-generic-function-class+)
+              (subtypep class +the-standard-generic-function-class+))
+      (setf (std-slot-value instance 'sys::method-class)
+            +the-standard-method-class+))
     (set-funcallable-instance-function
      instance