X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefbangstruct.lisp;h=c16b0fc4dd28b0230def9766d7b9c9f7373f9490;hb=771b864c8f32af7734bc0550aeaf1539fc4df194;hp=7516e290814a1e0a11d89e0d03c885180f3deef6;hpb=2c6b90e36a7c0377cd79625eb6c94d580f98cb93;p=sbcl.git

diff --git a/src/code/defbangstruct.lisp b/src/code/defbangstruct.lisp
index 7516e29..c16b0fc 100644
--- a/src/code/defbangstruct.lisp
+++ b/src/code/defbangstruct.lisp
@@ -28,9 +28,6 @@
 ;;; information for DEF!STRUCT-defined types
 (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
 
-  ;; FIXME: All this could be byte compiled. (Perhaps most of the rest
-  ;; of the file could be, too.)
-
   ;; (DEF!STRUCT-SUPERTYPE TYPE) is the DEF!STRUCT-defined type that
   ;; TYPE inherits from, or NIL if none.
   (defvar *def!struct-supertype* (make-hash-table))
@@ -78,9 +75,19 @@
 ;;; objects
 (defun just-dump-it-normally (object &optional (env nil env-p))
   (declare (type structure!object object))
+  (declare (ignorable env env-p object))
+  ;; KLUDGE: we require essentially three different behaviours of
+  ;; JUST-DUMP-IT-NORMALLY, two of which (host compiler's
+  ;; MAKE-LOAD-FORM, cross-compiler's MAKE-LOAD-FORM) are handled by
+  ;; the #+SB-XC-HOST clause.  The #-SB-XC-HOST clause is the
+  ;; behaviour required by the target, before the CLOS-based
+  ;; MAKE-LOAD-FORM-SAVING-SLOTS is implemented.
+  #+sb-xc-host
   (if env-p
-      (make-load-form-saving-slots object :environment env)
-      (make-load-form-saving-slots object)))
+      (sb!xc:make-load-form-saving-slots object :environment env)
+      (sb!xc:make-load-form-saving-slots object))
+  #-sb-xc-host
+  :sb-just-dump-it-normally)
 
 ;;; a MAKE-LOAD-FORM function for objects which don't use the load
 ;;; form system. This is used for LAYOUT objects because the special
@@ -100,14 +107,14 @@
   ;; a description of a DEF!STRUCT call to be stored until we get
   ;; enough of the system running to finish processing it
   (defstruct delayed-def!struct
-    (args (required-argument) :type cons)
+    (args (missing-arg) :type cons)
     (package (sane-package) :type package))
   ;; a list of DELAYED-DEF!STRUCTs stored until we get DEF!STRUCT
   ;; working fully so that we can apply it to them then. After
   ;; DEF!STRUCT is made to work fully, this list is processed, then
   ;; made unbound, and should no longer be used.
   (defvar *delayed-def!structs* nil))
-(eval-when (:compile-toplevel :load-toplevel :execute)
+(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
   ;; Parse the arguments for a DEF!STRUCT call, and return
   ;;   (VALUES NAME DEFSTRUCT-ARGS MAKE-LOAD-FORM-FUN DEF!STRUCT-SUPERTYPE),
   ;; where NAME is the name of the new type, DEFSTRUCT-ARGS is the
@@ -121,6 +128,7 @@
 	(if (consp nameoid)
 	    (values (first nameoid) (rest nameoid))
 	    (values nameoid nil))
+      (declare (type list options))
       (let* ((include-clause (find :include options :key #'first))
 	     (def!struct-supertype nil) ; may change below
 	     (mlff-clause (find :make-load-form-fun options :key #'first))
@@ -147,29 +155,31 @@
 (progn
   (defun %instance-length (instance)
     (aver (typep instance 'structure!object))
-    (layout-length (class-layout (sb!xc:find-class (type-of instance)))))
+    (layout-length (classoid-layout (find-classoid (type-of instance)))))
   (defun %instance-ref (instance index)
     (aver (typep instance 'structure!object))
-    (let* ((class (sb!xc:find-class (type-of instance)))
-	   (layout (class-layout class)))
+    (let* ((class (find-classoid (type-of instance)))
+	   (layout (classoid-layout class)))
       (if (zerop index)
 	  layout
 	  (let* ((dd (layout-info layout))
 		 (dsd (elt (dd-slots dd) (1- index)))
-		 (accessor (dsd-accessor dsd)))
-	    (declare (type symbol accessor))
-	    (funcall accessor instance)))))
+		 (accessor-name (dsd-accessor-name dsd)))
+	    (declare (type symbol accessor-name))
+	    (funcall accessor-name instance)))))
   (defun %instance-set (instance index new-value)
     (aver (typep instance 'structure!object))
-    (let* ((class (sb!xc:find-class (type-of instance)))
-	   (layout (class-layout class)))
+    (let* ((class (find-classoid (type-of instance)))
+	   (layout (classoid-layout class)))
       (if (zerop index)
 	  (error "can't set %INSTANCE-REF FOO 0 in cross-compilation host")
 	  (let* ((dd (layout-info layout))
 		 (dsd (elt (dd-slots dd) (1- index)))
-		 (accessor (dsd-accessor dsd)))
-	    (declare (type symbol accessor))
-	    (funcall (fdefinition `(setf ,accessor)) new-value instance))))))
+		 (accessor-name (dsd-accessor-name dsd)))
+	    (declare (type symbol accessor-name))
+	    (funcall (fdefinition `(setf ,accessor-name))
+		     new-value
+		     instance))))))
 
 ;;; a helper function for DEF!STRUCT in the #+SB-XC-HOST case: Return
 ;;; DEFSTRUCT-style arguments with any class names in the SB!XC