X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdump.lisp;h=6bfc35c6b9bbc9da3fd0bb93aa6ceaaf4096c351;hb=94ea2b2082deaa0331dfb66fa6af6ca12dd8dc83;hp=c51e480c45913973d681d9717f4acb03a9a6be52;hpb=460003761254b8f06a88868301f597a5cb0cca94;p=sbcl.git

diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp
index c51e480..6bfc35c 100644
--- a/src/compiler/dump.lisp
+++ b/src/compiler/dump.lisp
@@ -277,9 +277,7 @@
 
 ;;; Open a fasl file, write its header, and return a FASL-OUTPUT
 ;;; object for dumping to it. Some human-readable information about
-;;; the source code is given by the string WHERE. If BYTE-P is true,
-;;; this file will contain no native code, and is thus largely
-;;; implementation independent.
+;;; the source code is given by the string WHERE. 
 (defun open-fasl-output (name where)
   (declare (type pathname name))
   (let* ((stream (open name
@@ -512,13 +510,11 @@
 
 ;;;; number dumping
 
-;;; Dump a ratio.
 (defun dump-ratio (x file)
   (sub-dump-object (numerator x) file)
   (sub-dump-object (denominator x) file)
   (dump-fop 'fop-ratio file))
 
-;;; Dump an integer.
 (defun dump-integer (n file)
   (typecase n
     ((signed-byte 8)
@@ -686,7 +682,7 @@
     (6 (dump-fop 'fop-list*-6 file))
     (7 (dump-fop 'fop-list*-7 file))
     (8 (dump-fop 'fop-list*-8 file))
-    (T (do ((nn n (- nn 255)))
+    (t (do ((nn n (- nn 255)))
 	   ((< nn 256)
 	    (dump-fop 'fop-list* file)
 	    (dump-byte nn file))
@@ -708,7 +704,7 @@
     (6 (dump-fop 'fop-list-6 file))
     (7 (dump-fop 'fop-list-7 file))
     (8 (dump-fop 'fop-list-8 file))
-    (T (cond ((< n 256)
+    (t (cond ((< n 256)
 	      (dump-fop 'fop-list file)
 	      (dump-byte n file))
 	     (t (dump-fop 'fop-list file)
@@ -1319,14 +1315,20 @@
       (error "attempt to dump invalid structure:~%  ~S~%How did this happen?"
 	     struct)))
   (note-potential-circularity struct file)
-  (do ((index 0 (1+ index))
-       (length (%instance-length struct))
-       (circ (fasl-output-circularity-table file)))
-      ((= index length)
+  (aver (%instance-ref struct 0))
+  (do* ((length (%instance-length struct))
+	(ntagged (- length (layout-n-untagged-slots (%instance-ref struct 0))))
+	(circ (fasl-output-circularity-table file))
+	;; last slot first on the stack, so that the layout is on top:
+	(index (1- length) (1- index)))
+      ((minusp index)
        (dump-fop* length fop-small-struct fop-struct file))
-    (let* ((obj (%instance-ref struct index))
+    (let* ((obj (if (>= index ntagged)
+		    (%raw-instance-ref/word struct (- length index 1))
+		    (%instance-ref struct index)))
 	   (ref (gethash obj circ)))
       (cond (ref
+	     (aver (not (zerop index)))
 	     (push (make-circularity :type :struct-set
 				     :object struct
 				     :index index
@@ -1351,4 +1353,5 @@
   (sub-dump-object (layout-inherits obj) file)
   (sub-dump-object (layout-depthoid obj) file)
   (sub-dump-object (layout-length obj) file)
+  (sub-dump-object (layout-n-untagged-slots obj) file)
   (dump-fop 'fop-layout file))