X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Flow.lisp;h=930dfd99a8386fc702e17fd1e42042fdc32a466d;hb=bb8121bf453353ce2cadc85d9be7be05ca6248ff;hp=8105d2dd28b0eb40ac31f1491e0190785fd58dc5;hpb=81ce38f2e03e4f569d7a95bb18efb25bb16fc269;p=sbcl.git

diff --git a/src/pcl/low.lisp b/src/pcl/low.lisp
index 8105d2d..930dfd9 100644
--- a/src/pcl/low.lisp
+++ b/src/pcl/low.lisp
@@ -82,9 +82,9 @@
   ;; by puns based on absolute locations. Fun fun fun.. -- WHN 2001-10-30
   :slot-names (clos-slots name hash-code)
   :boa-constructor %make-pcl-funcallable-instance
-  :superclass-name funcallable-instance
-  :metaclass-name random-pcl-classoid
-  :metaclass-constructor make-random-pcl-classoid
+  :superclass-name function
+  :metaclass-name standard-classoid
+  :metaclass-constructor make-standard-classoid
   :dd-type funcallable-structure
   ;; Only internal implementation code will access these, and these
   ;; accesses (slot readers in particular) could easily be a
@@ -101,17 +101,16 @@
   (declare (type function new-value))
   (aver (funcallable-instance-p fin))
   (setf (funcallable-instance-fun fin) new-value))
+;;; FIXME: these macros should just go away.  It's not clear whether
+;;; the inline functions defined by
+;;; !DEFSTRUCT-WITH-ALTERNATE-METACLASS are as efficient as they could
+;;; be; ordinary defstruct accessors are defined as source transforms.
 (defmacro fsc-instance-p (fin)
   `(funcallable-instance-p ,fin))
 (defmacro fsc-instance-wrapper (fin)
   `(%funcallable-instance-layout ,fin))
-;;; FIXME: This seems to bear no relation at all to the CLOS-SLOTS
-;;; slot in the FUNCALLABLE-INSTANCE structure, above, which
-;;; (bizarrely) seems to be set to the NAME of the
-;;; FUNCALLABLE-INSTANCE. At least, the index 1 seems to return the
-;;; NAME, and the index 2 NIL.  Weird.  -- CSR, 2002-11-07
 (defmacro fsc-instance-slots (fin)
-  `(%funcallable-instance-info ,fin 0))
+  `(%funcallable-instance-info ,fin 1))
 (defmacro fsc-instance-hash (fin)
   `(%funcallable-instance-info ,fin 3))
 
@@ -183,7 +182,7 @@
     (if (if (eq *boot-state* 'complete)
                  (typep fun 'generic-function)
                  (eq (class-of fun) *the-class-standard-generic-function*))
-             (setf (%funcallable-instance-info fun 1) new-name)
+             (setf (%funcallable-instance-info fun 2) new-name)
              (bug "unanticipated function type")))
   ;; Fixup name-to-function mappings in cases where the function
   ;; hasn't been defined by DEFUN.  (FIXME: is this right?  This logic
@@ -223,7 +222,7 @@
 (!defstruct-with-alternate-metaclass standard-instance
   :slot-names (slots hash-code)
   :boa-constructor %make-standard-instance
-  :superclass-name instance
+  :superclass-name t
   :metaclass-name standard-classoid
   :metaclass-constructor make-standard-classoid
   :dd-type structure