0.9.2.9: thread objects

[sbcl.git] / src / compiler / dump.lisp

diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp
index ede2e77..6bfc35c 100644 (file)
--- 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 @@
 \f
 ;;;; 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)
@@ -896,10 +892,10 @@
         (dump-unsigned-vector 32 (* 4 len)))
         #-sb-xc-host
         #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
-        ((simple-array (unsigned-byte-63) (*))
+        ((simple-array (unsigned-byte 63) (*))
          (dump-unsigned-vector 63 (* 8 len)))
         #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
-        ((simple-array (unsigned-byte-64) (*))
+        ((simple-array (unsigned-byte 64) (*))
          (dump-unsigned-vector 64 (* 8 len)))
        ((simple-array (signed-byte 8) (*))
         (dump-signed-vector 8 len))
@@ -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))