1.0.37.29: Cleanup from fasl format and fasdump logic changes.

  * Bump fasl format version.

  * Remove fop-normal-load and fop-maybe-cold-load now that they're not
used.

  * Remove *cold-load-dump* logic, now that it's not used.

  * Remove various fop-normal-load-related logic from genesis.

diff --git a/src/code/early-fasl.lisp b/src/code/early-fasl.lisp
index 2249dd1..6c60a2a 100644 (file)
--- a/src/code/early-fasl.lisp
+++ b/src/code/early-fasl.lisp
@@ -76,7 +76,7 @@
 ;;; versions which break binary compatibility. But it certainly should
 ;;; be incremented for release versions which break binary
 ;;; compatibility.
-(def!constant +fasl-file-version+ 77)
+(def!constant +fasl-file-version+ 78)
 ;;; (description of versions before 0.9.0.1 deleted in 0.9.17)
 ;;; 56: (2005-05-22) Something between 0.9.0.1 and 0.9.0.14. My money is
 ;;;     on 0.9.0.6 (MORE CASE CONSISTENCY).
@@ -112,6 +112,8 @@
 ;;;     Further fasl-file-version bumps should only be done for real changes
 ;;;     in the fasl format, not for changes in function/macro signatures or
 ;;;     lisp data structures.
+;;; 78: (2010-04-02) Add FOP-{SMALL-,}NAMED-PACKAGE, remove FOP-NORMAL-LOAD
+;;;     and FOP-MAYBE-COLD-LOAD.
 
 ;;; the conventional file extension for our fasl files
 (declaim (type simple-string *fasl-file-type*))

diff --git a/src/code/fop.lisp b/src/code/fop.lisp
index a4d9331..9891b46 100644 (file)
--- a/src/code/fop.lisp
+++ b/src/code/fop.lisp
@@ -173,11 +173,9 @@
   (/show0 "THROWing FASL-GROUP-END")
   (throw 'fasl-group-end t))
 
-;;; In the normal loader, we just ignore these. GENESIS overwrites
-;;; FOP-MAYBE-COLD-LOAD with something that knows whether to revert to
-;;; cold-loading or not.
-(define-fop (fop-normal-load 81 :stackp nil))
-(define-fop (fop-maybe-cold-load 82 :stackp nil))
+;;; We used to have FOP-NORMAL-LOAD as 81 and FOP-MAYBE-COLD-LOAD as
+;;; 82 until GENESIS learned how to work with host symbols and
+;;; packages directly instead of piggybacking on the host code.
 
 (define-fop (fop-verify-table-size 62 :stackp nil)
   (let ((expected-index (read-word-arg)))

diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp
index c876ba8..cf97382 100644 (file)
--- a/src/compiler/dump.lisp
+++ b/src/compiler/dump.lisp
@@ -91,10 +91,6 @@
 ;;; dumping uses the table.
 (defvar *circularities-detected*)
 
-;;; used to inhibit table access when dumping forms to be read by the
-;;; cold loader
-(defvar *cold-load-dump* nil)
-
 ;;; used to turn off the structure validation during dumping of source
 ;;; info
 (defvar *dump-only-valid-structures* t)
@@ -194,71 +190,62 @@
     (incf (fasl-output-table-free fasl-output))))
 
 ;;; If X is in File's EQUAL-TABLE, then push the object and return T,
-;;; otherwise NIL. If *COLD-LOAD-DUMP* is true, then do nothing and
-;;; return NIL.
+;;; otherwise NIL.
 (defun equal-check-table (x fasl-output)
   (declare (type fasl-output fasl-output))
-  (unless *cold-load-dump*
-    (let ((handle (gethash x (fasl-output-equal-table fasl-output))))
-      (cond
-        (handle (dump-push handle fasl-output) t)
-        (t nil)))))
+  (let ((handle (gethash x (fasl-output-equal-table fasl-output))))
+    (cond
+     (handle (dump-push handle fasl-output) t)
+     (t nil))))
 (defun string-check-table (x fasl-output)
   (declare (type fasl-output fasl-output)
            (type string x))
-  (unless *cold-load-dump*
-    (let ((handle (cdr (assoc
-                        #+sb-xc-host 'base-char ; for repeatable xc fasls
-                        #-sb-xc-host (array-element-type x)
-                        (gethash x (fasl-output-equal-table fasl-output))))))
-      (cond
-        (handle (dump-push handle fasl-output) t)
-        (t nil)))))
+  (let ((handle (cdr (assoc
+                      #+sb-xc-host 'base-char ; for repeatable xc fasls
+                      #-sb-xc-host (array-element-type x)
+                      (gethash x (fasl-output-equal-table fasl-output))))))
+    (cond
+     (handle (dump-push handle fasl-output) t)
+     (t nil))))
 
 ;;; These functions are called after dumping an object to save the
 ;;; object in the table. The object (also passed in as X) must already
-;;; be on the top of the FOP stack. If *COLD-LOAD-DUMP* is true, then
-;;; we don't do anything.
+;;; be on the top of the FOP stack.
 (defun eq-save-object (x fasl-output)
   (declare (type fasl-output fasl-output))
-  (unless *cold-load-dump*
-    (let ((handle (dump-pop fasl-output)))
-      (setf (gethash x (fasl-output-eq-table fasl-output)) handle)
-      (dump-push handle fasl-output)))
+  (let ((handle (dump-pop fasl-output)))
+    (setf (gethash x (fasl-output-eq-table fasl-output)) handle)
+    (dump-push handle fasl-output))
   (values))
 (defun equal-save-object (x fasl-output)
   (declare (type fasl-output fasl-output))
-  (unless *cold-load-dump*
-    (let ((handle (dump-pop fasl-output)))
-      (setf (gethash x (fasl-output-equal-table fasl-output)) handle)
-      (setf (gethash x (fasl-output-eq-table fasl-output)) handle)
-      (dump-push handle fasl-output)))
+  (let ((handle (dump-pop fasl-output)))
+    (setf (gethash x (fasl-output-equal-table fasl-output)) handle)
+    (setf (gethash x (fasl-output-eq-table fasl-output)) handle)
+    (dump-push handle fasl-output))
   (values))
 (defun string-save-object (x fasl-output)
   (declare (type fasl-output fasl-output)
            (type string x))
-  (unless *cold-load-dump*
-    (let ((handle (dump-pop fasl-output)))
-      (push (cons #+sb-xc-host 'base-char ; repeatable xc fasls
-                  #-sb-xc-host (array-element-type x)
-                  handle)
-            (gethash x (fasl-output-equal-table fasl-output)))
-      (setf (gethash x (fasl-output-eq-table fasl-output)) handle)
-      (dump-push handle fasl-output)))
+  (let ((handle (dump-pop fasl-output)))
+    (push (cons #+sb-xc-host 'base-char ; repeatable xc fasls
+                #-sb-xc-host (array-element-type x)
+                handle)
+          (gethash x (fasl-output-equal-table fasl-output)))
+    (setf (gethash x (fasl-output-eq-table fasl-output)) handle)
+    (dump-push handle fasl-output))
   (values))
-;;; Record X in File's CIRCULARITY-TABLE unless *COLD-LOAD-DUMP* is
-;;; true. This is called on objects that we are about to dump might
-;;; have a circular path through them.
+;;; Record X in File's CIRCULARITY-TABLE. This is called on objects
+;;; that we are about to dump might have a circular path through them.
 ;;;
 ;;; The object must not currently be in this table, since the dumper
 ;;; should never be recursively called on a circular reference.
 ;;; Instead, the dumping function must detect the circularity and
 ;;; arrange for the dumped object to be patched.
 (defun note-potential-circularity (x fasl-output)
-  (unless *cold-load-dump*
-    (let ((circ (fasl-output-circularity-table fasl-output)))
-      (aver (not (gethash x circ)))
-      (setf (gethash x circ) x)))
+  (let ((circ (fasl-output-circularity-table fasl-output)))
+    (aver (not (gethash x circ)))
+    (setf (gethash x circ) x))
   (values))
 \f
 ;;;; opening and closing fasl files
@@ -359,7 +346,7 @@
 ;;; When we go to dump the object, we enter it in the CIRCULARITY-TABLE.
 (defun dump-non-immediate-object (x file)
   (let ((index (gethash x (fasl-output-eq-table file))))
-    (cond ((and index (not *cold-load-dump*))
+    (cond (index
            (dump-push index file))
           (t
            (typecase x
@@ -649,9 +636,6 @@
 ;;;
 ;;; Otherwise, we recursively call the dumper to dump the current
 ;;; element.
-;;;
-;;; Marking of the conses is inhibited when *COLD-LOAD-DUMP* is true.
-;;; This inhibits all circularity detection.
 (defun dump-list (list file)
   (aver (and list
              (not (gethash list (fasl-output-circularity-table file)))))
@@ -676,8 +660,7 @@
         (terminate-undotted-list n file)
         (return)))
 
-    (unless *cold-load-dump*
-      (setf (gethash l circ) list))
+    (setf (gethash l circ) list)
 
     (let* ((obj (car l))
            (ref (gethash obj circ)))
@@ -970,10 +953,7 @@
   (values))
 
 ;;; If we get here, it is assumed that the symbol isn't in the table,
-;;; but we are responsible for putting it there when appropriate. To
-;;; avoid too much special-casing, we always push the symbol in the
-;;; table, but don't record that we have done so if *COLD-LOAD-DUMP*
-;;; is true.
+;;; but we are responsible for putting it there when appropriate.
 (defun dump-symbol (s file)
   (declare (type fasl-output file))
   (let* ((pname (symbol-name s))
@@ -1030,9 +1010,8 @@
                   #!-sb-unicode dump-base-chars-of-string
                   pname file)
 
-    (unless *cold-load-dump*
-      (setf (gethash s (fasl-output-eq-table file))
-            (fasl-output-table-free file)))
+    (setf (gethash s (fasl-output-eq-table file))
+          (fasl-output-table-free file))
 
     (incf (fasl-output-table-free file)))
 

diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index de143e5..6470fda 100644 (file)
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -1933,8 +1933,6 @@ core and return a descriptor to it."
   ;; modified.
   (copy-seq *fop-funs*))
 
-(defvar *normal-fop-funs*)
-
 ;;; Cause a fop to have a special definition for cold load.
 ;;;
 ;;; This is similar to DEFINE-FOP, but unlike DEFINE-FOP, this version
@@ -1978,8 +1976,7 @@ core and return a descriptor to it."
 (defun cold-load (filename)
   #!+sb-doc
   "Load the file named by FILENAME into the cold load image being built."
-  (let* ((*normal-fop-funs* *fop-funs*)
-         (*fop-funs* *cold-fop-funs*)
+  (let* ((*fop-funs* *cold-fop-funs*)
          (*cold-load-filename* (etypecase filename
                                  (string filename)
                                  (pathname (namestring filename)))))
@@ -1996,15 +1993,6 @@ core and return a descriptor to it."
 (define-cold-fop (fop-empty-list) nil)
 (define-cold-fop (fop-truth) t)
 
-(define-cold-fop (fop-normal-load :stackp nil)
-  (setq *fop-funs* *normal-fop-funs*))
-
-(define-fop (fop-maybe-cold-load 82 :stackp nil)
-  (when *cold-load-filename*
-    (setq *fop-funs* *cold-fop-funs*)))
-
-(define-cold-fop (fop-maybe-cold-load :stackp nil))
-
 (clone-cold-fop (fop-struct)
                 (fop-small-struct)
   (let* ((size (clone-arg))

diff --git a/version.lisp-expr b/version.lisp-expr
index 47c3023..bbe15b8 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.37.28"
+"1.0.37.29"