1.0.11.33: Oops, restore REPLACE deftransforms that got dropped in refactoring

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

diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp
index 1ad330c..4535238 100644 (file)
--- a/src/compiler/dump.lisp
+++ b/src/compiler/dump.lisp
@@ -113,6 +113,14 @@
     (dotimes (i sb!vm:n-word-bytes)
       (write-byte (ldb (byte 8 (* 8 i)) num) stream))))
 
+;; Dump a 32-bit integer.
+(defun dump-unsigned-byte-32 (num fasl-output)
+  (declare (type sb!vm:word num))
+  (declare (type fasl-output fasl-output))
+  (let ((stream (fasl-output-stream fasl-output)))
+    (dotimes (i 4)
+      (write-byte (ldb (byte 8 (* 8 i)) num) stream))))
+
 ;;; Dump NUM to the fasl stream, represented by N bytes. This works
 ;;; for either signed or unsigned integers. There's no range checking
 ;;; -- if you don't specify enough bytes for the number to fit, this
@@ -285,11 +293,9 @@
                        :if-exists :supersede
                        :element-type 'sb!assem:assembly-unit))
          (res (make-fasl-output :stream stream)))
-
     ;; Begin the header with the constant machine-readable (and
     ;; semi-human-readable) string which is used to identify fasl files.
     (fasl-write-string *fasl-header-string-start-string* stream)
-
     ;; The constant string which begins the header is followed by
     ;; arbitrary human-readable text, terminated by a special
     ;; character code.
@@ -303,24 +309,28 @@
                   at ~A~%  ~
                   on ~A~%  ~
                   using ~A version ~A~%"
-         where
+                 where
                  (format-universal-time nil (get-universal-time))
                  (machine-instance)
                  (sb!xc:lisp-implementation-type)
                  (sb!xc:lisp-implementation-version))))
      stream)
     (dump-byte +fasl-header-string-stop-char-code+ res)
-
     ;; Finish the header by outputting fasl file implementation,
     ;; version, and key *FEATURES*.
     (flet ((dump-counted-string (string)
-             (dump-word (length string) res)
+             ;; The count is dumped as a 32-bit unsigned-byte even on 64-bit
+             ;; platforms. This ensures that a x86-64 SBCL can gracefully
+             ;; detect an error when trying to read a x86 fasl, instead
+             ;; of choking on a ridiculously long counted string.
+             ;;  -- JES, 2005-12-30
+             (dump-unsigned-byte-32 (length string) res)
              (dotimes (i (length string))
                (dump-byte (char-code (aref string i)) res))))
       (dump-counted-string (symbol-name +backend-fasl-file-implementation+))
       (dump-word +fasl-file-version+ res)
+      (dump-counted-string (sb!xc:lisp-implementation-version))
       (dump-counted-string *features-affecting-fasl-format*))
-
     res))
 
 ;;; Close the specified FASL-OUTPUT, aborting the write if ABORT-P.
@@ -371,7 +381,7 @@
               ;;   take a little more care while dumping these.
               ;; So if better list coalescing is needed, start here.
               ;; -- WHN 2000-11-07
-              (if (cyclic-list-p x)
+              (if (maybe-cyclic-p x)
                   (progn
                     (dump-list x file)
                     (eq-save-object x file))
@@ -485,13 +495,15 @@
     (dump-byte 0 file))
   (dump-pop file))
 
-;;; Return T iff CONSTANT has not already been dumped. It's been
-;;; dumped if it's in the EQ table.
+;;; Return T iff CONSTANT has already been dumped. It's been dumped if
+;;; it's in the EQ table.
+;;;
+;;; Note: historically (1) the above comment was "T iff ... has not been dumped",
+;;; (2) the test was  was also true if the constant had been validated / was in
+;;; the valid objects table. This led to substructures occasionally skipping the
+;;; validation, and hence failing the "must have been validated" test.
 (defun fasl-constant-already-dumped-p (constant file)
-  (if (or (gethash constant (fasl-output-eq-table file))
-          (gethash constant (fasl-output-valid-structures file)))
-      t
-      nil))
+  (and (gethash constant (fasl-output-eq-table file)) t))
 
 ;;; Use HANDLE whenever we try to dump CONSTANT. HANDLE should have been
 ;;; returned earlier by FASL-DUMP-LOAD-TIME-VALUE-LAMBDA.
@@ -925,7 +937,7 @@
   (let ((code (sb!xc:char-code char)))
     (cond
       ((< code 256)
-  (dump-fop 'fop-short-character file)
+       (dump-fop 'fop-short-character file)
        (dump-byte code file))
       (t
        (dump-fop 'fop-character file)
@@ -1203,6 +1215,7 @@
     (dump-object name file)
     (dump-object (sb!c::entry-info-arguments entry) file)
     (dump-object (sb!c::entry-info-type entry) file)
+    (dump-object (sb!c::entry-info-xref entry) file)
     (dump-fop 'fop-fun-entry file)
     (dump-word (label-position (sb!c::entry-info-offset entry)) file)
     (dump-pop file)))
@@ -1228,7 +1241,6 @@
   (declare (type component component) (list trace-table))
   (declare (type fasl-output file))
 
-  (dump-fop 'fop-verify-empty-stack file)
   (dump-fop 'fop-verify-table-size file)
   (dump-word (fasl-output-table-free file) file)
 
@@ -1244,7 +1256,6 @@
                                        fixups
                                        file))
         (2comp (component-info component)))
-    (dump-fop 'fop-verify-empty-stack file)
 
     (dolist (entry (sb!c::ir2-component-entries 2comp))
       (let ((entry-handle (dump-one-entry entry code-handle file)))