X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fgenesis.lisp;h=55c58b2df3b925f6a7c787272cdaee9be7396fdb;hb=6cbe4d8ba6d7bc469d03a72514c789b1f3944878;hp=cd5b7b09224fb90d15b488f26f94b381eaa09297;hpb=2c6b90e36a7c0377cd79625eb6c94d580f98cb93;p=sbcl.git

diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index cd5b7b0..55c58b2 100644
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -30,7 +30,7 @@
 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
 ;;;; files for more information.
 
-(in-package "SB!IMPL")
+(in-package "SB!FASL")
 
 ;;; a magic number used to identify our core files
 (defconstant core-magic
@@ -62,6 +62,9 @@
 
 ;;;; representation of spaces in the core
 
+;;; If there is more than one dynamic space in memory (i.e., if a
+;;; copying GC is in use), then only the active dynamic space gets
+;;; dumped to core.
 (defvar *dynamic*)
 (defconstant dynamic-space-id 1)
 
@@ -176,11 +179,11 @@
 			   (gspace-name gspace)
 			   "unknown"))))))))
 
-(defun allocate-descriptor (gspace length lowtag)
-  #!+sb-doc
-  "Return a descriptor for a block of LENGTH bytes out of GSPACE. The free
-  word index is boosted as necessary, and if additional memory is needed, we
-  grow the GSPACE. The descriptor returned is a pointer of type LOWTAG."
+;;; Return a descriptor for a block of LENGTH bytes out of GSPACE. The
+;;; free word index is boosted as necessary, and if additional memory
+;;; is needed, we grow the GSPACE. The descriptor returned is a
+;;; pointer of type LOWTAG.
+(defun allocate-cold-descriptor (gspace length lowtag)
   (let* ((bytes (round-up length (ash 1 sb!vm:lowtag-bits)))
 	 (old-free-word-index (gspace-free-word-index gspace))
 	 (new-free-word-index (+ old-free-word-index
@@ -393,30 +396,41 @@
       (logior (ash (ldb (byte 8 0) short) 8)
 	      (ldb (byte 8 8) short))))
 
-;;; like SAP-REF-32, except that instead of a SAP we use a byte vector
-(defun byte-vector-ref-32 (byte-vector byte-index)
+;;; BYTE-VECTOR-REF-32 and friends.  These are like SAP-REF-n, except
+;;; that instead of a SAP we use a byte vector
+(macrolet ((make-byte-vector-ref-n
+            (n)
+            (let* ((name (intern (format nil "BYTE-VECTOR-REF-~A" n)))
+                   (number-octets (/ n 8))
+                   (ash-list
+                    (loop for i from 0 to (1- number-octets)
+                          collect `(ash (aref byte-vector (+ byte-index ,i))
+                                        ,(* i 8))))
+                   (setf-list
+                    (loop for i from 0 to (1- number-octets)
+                          append
+                          `((aref byte-vector (+ byte-index ,i))
+                            (ldb (byte 8 ,(* i 8)) new-value)))))
+              `(progn
+                 (defun ,name (byte-vector byte-index)
   (aver (= sb!vm:word-bits 32))
   (aver (= sb!vm:byte-bits 8))
   (ecase sb!c:*backend-byte-order*
     (:little-endian
-     (logior (ash (aref byte-vector (+ byte-index 0)) 0)
-	     (ash (aref byte-vector (+ byte-index 1)) 8)
-	     (ash (aref byte-vector (+ byte-index 2)) 16)
-	     (ash (aref byte-vector (+ byte-index 3)) 24)))
+                      (logior ,@ash-list))
     (:big-endian
      (error "stub: no big-endian ports of SBCL (yet?)"))))
-(defun (setf byte-vector-ref-32) (new-value byte-vector byte-index)
+                 (defun (setf ,name) (new-value byte-vector byte-index)
   (aver (= sb!vm:word-bits 32))
   (aver (= sb!vm:byte-bits 8))
   (ecase sb!c:*backend-byte-order*
     (:little-endian
-     (setf (aref byte-vector (+ byte-index 0)) (ldb (byte 8 0) new-value)
-	   (aref byte-vector (+ byte-index 1)) (ldb (byte 8 8) new-value)
-	   (aref byte-vector (+ byte-index 2)) (ldb (byte 8 16) new-value)
-	   (aref byte-vector (+ byte-index 3)) (ldb (byte 8 24) new-value)))
+                      (setf ,@setf-list))
     (:big-endian
-     (error "stub: no big-endian ports of SBCL (yet?)")))
-  new-value)
+                      (error "stub: no big-endian ports of SBCL (yet?)"))))))))
+  (make-byte-vector-ref-n 8)
+  (make-byte-vector-ref-n 16)
+  (make-byte-vector-ref-n 32))
 
 (declaim (ftype (function (descriptor sb!vm:word) descriptor) read-wordindexed))
 (defun read-wordindexed (address index)
@@ -498,16 +512,16 @@
   #!+sb-doc
   "Allocate LENGTH words in GSPACE and return a new descriptor of type LOWTAG
   pointing to them."
-  (allocate-descriptor gspace (ash length sb!vm:word-shift) lowtag))
+  (allocate-cold-descriptor gspace (ash length sb!vm:word-shift) lowtag))
 (defun allocate-unboxed-object (gspace element-bits length type)
   #!+sb-doc
   "Allocate LENGTH units of ELEMENT-BITS bits plus a header word in GSPACE and
   return an ``other-pointer'' descriptor to them. Initialize the header word
   with the resultant length and TYPE."
   (let* ((bytes (/ (* element-bits length) sb!vm:byte-bits))
-	 (des (allocate-descriptor gspace
-				   (+ bytes sb!vm:word-bytes)
-				   sb!vm:other-pointer-type)))
+	 (des (allocate-cold-descriptor gspace
+					(+ bytes sb!vm:word-bytes)
+					sb!vm:other-pointer-type)))
     (write-memory des
 		  (make-other-immediate-descriptor (ash bytes
 							(- sb!vm:word-shift))
@@ -521,8 +535,9 @@
   ;; FIXME: Here and in ALLOCATE-UNBOXED-OBJECT, BYTES is calculated using
   ;; #'/ instead of #'CEILING, which seems wrong.
   (let* ((bytes (/ (* element-bits length) sb!vm:byte-bits))
-	 (des (allocate-descriptor gspace (+ bytes (* 2 sb!vm:word-bytes))
-					  sb!vm:other-pointer-type)))
+	 (des (allocate-cold-descriptor gspace
+					(+ bytes (* 2 sb!vm:word-bytes))
+					sb!vm:other-pointer-type)))
     (write-memory des (make-other-immediate-descriptor 0 type))
     (write-wordindexed des
 		       sb!vm:vector-length-slot
@@ -1129,11 +1144,11 @@
 	       `(cold-set ',symbol
 			  (cold-fdefinition-object (cold-intern ',symbol)))))
     (frob !cold-init)
-    (frob sb!impl::maybe-gc)
+    (frob maybe-gc)
     (frob internal-error)
     (frob sb!di::handle-breakpoint)
     (frob sb!di::handle-function-end-breakpoint)
-    (frob sb!impl::fdefinition-object))
+    (frob fdefinition-object))
 
   (cold-set '*current-catch-block*          (make-fixnum-descriptor 0))
   (cold-set '*current-unwind-protect-block* (make-fixnum-descriptor 0))
@@ -1141,9 +1156,7 @@
 
   (cold-set '*free-interrupt-context-index* (make-fixnum-descriptor 0))
 
-  ;; FIXME: *!INITIAL-LAYOUTS* should be exported from SB!KERNEL, or
-  ;; perhaps from SB-LD.
-  (cold-set 'sb!kernel::*!initial-layouts* (cold-list-all-layouts))
+  (cold-set '*!initial-layouts* (cold-list-all-layouts))
 
   (/show "dumping packages" (mapcar #'car *cold-package-symbols*))
   (let ((initial-symbols *nil-descriptor*))
@@ -1231,9 +1244,7 @@
       (cold-set 'sb!vm::*fp-constant-lg2* (number-to-core (log 2L0 10L0)))
       (cold-set 'sb!vm::*fp-constant-ln2*
 	    (number-to-core
-	     (log 2L0 2.718281828459045235360287471352662L0))))
-    #!+gencgc
-    (cold-set 'sb!vm::*SCAVENGE-READ-ONLY-GSPACE* *nil-descriptor*)))
+	     (log 2L0 2.718281828459045235360287471352662L0))))))
 
 ;;; Make a cold list that can be used as the arg list to MAKE-PACKAGE in order
 ;;; to make a package that is similar to PKG.
@@ -1334,7 +1345,7 @@
 	    (write-wordindexed fdefn
 			       sb!vm:fdefn-raw-addr-slot
 			       (make-random-descriptor
-				(lookup-foreign-symbol "undefined_tramp"))))
+				(cold-foreign-symbol-address-as-integer "undefined_tramp"))))
 	  fdefn))))
 
 (defun cold-fset (cold-name defn)
@@ -1356,7 +1367,7 @@
 				   sb!vm:word-shift))))
 			 (#.sb!vm:closure-header-type
 			  (make-random-descriptor
-			   (lookup-foreign-symbol "closure_tramp")))))
+			   (cold-foreign-symbol-address-as-integer "closure_tramp")))))
     fdefn))
 
 (defun initialize-static-fns ()
@@ -1387,7 +1398,9 @@
 (defvar *cold-foreign-symbol-table*)
 (declaim (type hash-table *cold-foreign-symbol-table*))
 
-(defun load-foreign-symbol-table (filename)
+;;; Read the sbcl.nm file to find the addresses for foreign-symbols in
+;;; the C runtime.  
+(defun load-cold-foreign-symbol-table (filename)
   (with-open-file (file filename)
     (loop
       (let ((line (read-line file nil nil)))
@@ -1435,36 +1448,15 @@
 		(setf (gethash name *cold-foreign-symbol-table*) value))))))
     (values)))
 
-(defun lookup-foreign-symbol (name)
-  #!+x86
-  (let ((prefixes
-	 #!+linux #(;; FIXME: How many of these are actually
-		    ;; needed? The first four are taken from rather
-		    ;; disorganized CMU CL code, which could easily
-		    ;; have had redundant values in it..
-		    "_"
-		    "__"
-		    "__libc_"
-		    "ldso_stub__"
-		    ;; ..and the fifth seems to match most
-		    ;; actual symbols, at least in RedHat 6.2.
-		    "")
-	 #!+freebsd #("" "ldso_stub__")
-	 #!+openbsd #("_")))
-    (or (some (lambda (prefix)
-		(gethash (concatenate 'string prefix name)
-			 *cold-foreign-symbol-table*
-			 nil))
-	      prefixes)
-	*foreign-symbol-placeholder-value*
-	(progn
-	  (format *error-output* "~&The foreign symbol table is:~%")
-	  (maphash (lambda (k v)
-		     (format *error-output* "~&~S = #X~8X~%" k v))
-		   *cold-foreign-symbol-table*)
-	  (format *error-output* "~&The prefix table is: ~S~%" prefixes)
-	  (error "The foreign symbol ~S is undefined." name))))
-  #!-x86 (error "non-x86 unsupported in SBCL (but see old CMU CL code)"))
+(defun cold-foreign-symbol-address-as-integer (name)
+  (or (find-foreign-symbol-in-table name *cold-foreign-symbol-table*)
+      *foreign-symbol-placeholder-value*
+      (progn
+        (format *error-output* "~&The foreign symbol table is:~%")
+        (maphash (lambda (k v)
+                   (format *error-output* "~&~S = #X~8X~%" k v))
+                 *cold-foreign-symbol-table*)
+        (error "The foreign symbol ~S is undefined." name))))
 
 (defvar *cold-assembler-routines*)
 
@@ -1550,70 +1542,50 @@
 				offset-within-code-object))
 	 (gspace-byte-address (gspace-byte-address
 			       (descriptor-gspace code-object))))
-    (ecase sb!c:*backend-fasl-file-implementation*
-      ;; Classic CMU CL supported these, and I haven't gone out of my way
-      ;; to break them, but I have no way of testing them.. -- WHN 19990817
-      #|
-      (#.sb!c:pmax-fasl-file-implementation
-       (ecase kind
-	 (:jump
-	  (aver (zerop (ash value -28)))
-	  (setf (ldb (byte 26 0) (sap-ref-32 sap 0))
-		(ash value -2)))
-	 (:lui
-	  (setf (sap-ref-16 sap 0)
-		(+ (ash value -16)
-		   (if (logbitp 15 value) 1 0))))
-	 (:addi
-	  (setf (sap-ref-16 sap 0)
-		(ldb (byte 16 0) value)))))
-      (#.sb!c:sparc-fasl-file-implementation
-       (let ((inst (maybe-byte-swap (sap-ref-32 sap 0))))
+    (ecase +backend-fasl-file-implementation+
+      ;; See CMU CL source for other formerly-supported architectures
+      ;; (and note that you have to rewrite them to use VECTOR-REF
+      ;; unstead of SAP-REF).
+      (:alpha
 	 (ecase kind
-	   (:call
-	    (error "Can't deal with call fixups yet."))
-	   (:sethi
-	    (setf inst
-		  (dpb (ldb (byte 22 10) value)
-		       (byte 22 0)
-		       inst)))
-	   (:add
-	    (setf inst
-		  (dpb (ldb (byte 10 0) value)
-		       (byte 10 0)
-		       inst))))
-	 (setf (sap-ref-32 sap 0)
-	       (maybe-byte-swap inst))))
-      ((#.sb!c:rt-fasl-file-implementation
-	#.sb!c:rt-afpa-fasl-file-implementation)
-       (ecase kind
-	 (:cal
-	  (setf (sap-ref-16 sap 2)
-		(maybe-byte-swap-short
-		 (ldb (byte 16 0) value))))
-	 (:cau
-	  (let ((high (ldb (byte 16 16) value)))
-	    (setf (sap-ref-16 sap 2)
-		  (maybe-byte-swap-short
-		   (if (logbitp 15 value) (1+ high) high)))))
-	 (:ba
-	  (unless (zerop (ash value -24))
-	    (warn "#X~8,'0X out of range for branch-absolute." value))
-	  (let ((inst (maybe-byte-swap-short (sap-ref-16 sap 0))))
+         (:jmp-hint
+          (assert (zerop (ldb (byte 2 0) value)))
+          #+nil ;; was commented out in cmucl source too.  Don't know what
+          ;; it does   -dan 2001.05.03
 	    (setf (sap-ref-16 sap 0)
-		  (maybe-byte-swap-short
-		   (dpb (ldb (byte 8 16) value)
-			(byte 8 0)
-			inst))))
-	  (setf (sap-ref-16 sap 2)
-		(maybe-byte-swap-short (ldb (byte 16 0) value))))))
-      |#
+                (logior (sap-ref-16 sap 0) (ldb (byte 14 0) (ash value -2)))))
+	 (:bits-63-48
+	  (let* ((value (if (logbitp 15 value) (+ value (ash 1 16)) value))
+		 (value (if (logbitp 31 value) (+ value (ash 1 32)) value))
+		 (value (if (logbitp 47 value) (+ value (ash 1 48)) value)))
+	    (setf (byte-vector-ref-8 gspace-bytes gspace-byte-offset)
+                  (ldb (byte 8 48) value)
+                  (byte-vector-ref-8 gspace-bytes (1+ gspace-byte-offset))
+                  (ldb (byte 8 56) value))))
+	 (:bits-47-32
+	  (let* ((value (if (logbitp 15 value) (+ value (ash 1 16)) value))
+		 (value (if (logbitp 31 value) (+ value (ash 1 32)) value)))
+	    (setf (byte-vector-ref-8 gspace-bytes gspace-byte-offset)
+                  (ldb (byte 8 32) value)
+                  (byte-vector-ref-8 gspace-bytes (1+ gspace-byte-offset))
+                  (ldb (byte 8 40) value))))
+	 (:ldah
+	  (let ((value (if (logbitp 15 value) (+ value (ash 1 16)) value)))
+	    (setf (byte-vector-ref-8 gspace-bytes gspace-byte-offset)
+                  (ldb (byte 8 16) value)
+                  (byte-vector-ref-8 gspace-bytes (1+ gspace-byte-offset))
+                  (ldb (byte 8 24) value))))
+	 (:lda
+	  (setf (byte-vector-ref-8 gspace-bytes gspace-byte-offset)
+                (ldb (byte 8 0) value)
+                (byte-vector-ref-8 gspace-bytes (1+ gspace-byte-offset))
+                (ldb (byte 8 8) value)))))
       (:x86
        (let* ((un-fixed-up (byte-vector-ref-32 gspace-bytes
 					       gspace-byte-offset))
 	      (code-object-start-addr (logandc2 (descriptor-bits code-object)
 						sb!vm:lowtag-mask)))
-	 (aver (= code-object-start-addr
+         (assert (= code-object-start-addr
 		  (+ gspace-byte-address
 		     (descriptor-byte-offset code-object))))
 	 (ecase kind
@@ -1649,75 +1621,7 @@
 	      (note-load-time-code-fixup code-object
 					 after-header
 					 value
-					 kind))))))
-      ;; CMU CL supported these, and I haven't gone out of my way to break
-      ;; them, but I have no way of testing them.. -- WHN 19990817
-      #|
-      (#.sb!c:hppa-fasl-file-implementation
-       (let ((inst (maybe-byte-swap (sap-ref-32 sap 0))))
-	 (setf (sap-ref-32 sap 0)
-	       (maybe-byte-swap
-		(ecase kind
-		  (:load
-		   (logior (ash (ldb (byte 11 0) value) 1)
-			   (logand inst #xffffc000)))
-		  (:load-short
-		   (let ((low-bits (ldb (byte 11 0) value)))
-		     (aver (<= 0 low-bits (1- (ash 1 4))))
-		     (logior (ash low-bits 17)
-			     (logand inst #xffe0ffff))))
-		  (:hi
-		   (logior (ash (ldb (byte 5 13) value) 16)
-			   (ash (ldb (byte 2 18) value) 14)
-			   (ash (ldb (byte 2 11) value) 12)
-			   (ash (ldb (byte 11 20) value) 1)
-			   (ldb (byte 1 31) value)
-			   (logand inst #xffe00000)))
-		  (:branch
-		   (let ((bits (ldb (byte 9 2) value)))
-		     (aver (zerop (ldb (byte 2 0) value)))
-		     (logior (ash bits 3)
-			     (logand inst #xffe0e002)))))))))
-      (#.sb!c:alpha-fasl-file-implementation
-       (ecase kind
-	 (:jmp-hint
-	  (aver (zerop (ldb (byte 2 0) value)))
-	  #+nil
-	  (setf (sap-ref-16 sap 0)
-		(logior (sap-ref-16 sap 0) (ldb (byte 14 0) (ash value -2)))))
-	 (:bits-63-48
-	  (let* ((value (if (logbitp 15 value) (+ value (ash 1 16)) value))
-		 (value (if (logbitp 31 value) (+ value (ash 1 32)) value))
-		 (value (if (logbitp 47 value) (+ value (ash 1 48)) value)))
-	    (setf (sap-ref-8 sap 0) (ldb (byte 8 48) value))
-	    (setf (sap-ref-8 sap 1) (ldb (byte 8 56) value))))
-	 (:bits-47-32
-	  (let* ((value (if (logbitp 15 value) (+ value (ash 1 16)) value))
-		 (value (if (logbitp 31 value) (+ value (ash 1 32)) value)))
-	    (setf (sap-ref-8 sap 0) (ldb (byte 8 32) value))
-	    (setf (sap-ref-8 sap 1) (ldb (byte 8 40) value))))
-	 (:ldah
-	  (let ((value (if (logbitp 15 value) (+ value (ash 1 16)) value)))
-	    (setf (sap-ref-8 sap 0) (ldb (byte 8 16) value))
-	    (setf (sap-ref-8 sap 1) (ldb (byte 8 24) value))))
-	 (:lda
-	  (setf (sap-ref-8 sap 0) (ldb (byte 8 0) value))
-	  (setf (sap-ref-8 sap 1) (ldb (byte 8 8) value)))))
-      (#.sb!c:sgi-fasl-file-implementation
-       (ecase kind
-	 (:jump
-	  (aver (zerop (ash value -28)))
-	  (setf (ldb (byte 26 0) (sap-ref-32 sap 0))
-		(ash value -2)))
-	 (:lui
-	  (setf (sap-ref-16 sap 2)
-		(+ (ash value -16)
-		   (if (logbitp 15 value) 1 0))))
-	 (:addi
-	  (setf (sap-ref-16 sap 2)
-		(ldb (byte 16 0) value)))))
-      |#
-      ))
+					 kind)))))) ))
   (values))
 
 (defun resolve-assembler-fixups ()
@@ -1727,12 +1631,16 @@
       (when value
 	(do-cold-fixup (second fixup) (third fixup) value (fourth fixup))))))
 
+;;; *COLD-FOREIGN-SYMBOL-TABLE* becomes *!INITIAL-FOREIGN-SYMBOLS* in
+;;; the core. When the core is loaded, !LOADER-COLD-INIT uses this to
+;;; create *STATIC-FOREIGN-SYMBOLS*, which the code in
+;;; target-load.lisp refers to.
 (defun linkage-info-to-core ()
   (let ((result *nil-descriptor*))
-    (maphash #'(lambda (symbol value)
-		 (cold-push (cold-cons (string-to-core symbol)
-				       (number-to-core value))
-			    result))
+    (maphash (lambda (symbol value)
+	       (cold-push (cold-cons (string-to-core symbol)
+				     (number-to-core value))
+			  result))
 	     *cold-foreign-symbol-table*)
     (cold-set (cold-intern '*!initial-foreign-symbols*) result))
   (let ((result *nil-descriptor*))
@@ -1744,9 +1652,12 @@
 
 ;;;; general machinery for cold-loading FASL files
 
-(defvar *cold-fop-functions* (replace (make-array 256) *fop-functions*)
-  #!+sb-doc
-  "FOP functions for cold loading")
+;;; FOP functions for cold loading
+(defvar *cold-fop-functions*
+  ;; We start out with a copy of the ordinary *FOP-FUNCTIONS*. The
+  ;; ones which aren't appropriate for cold load will be destructively
+  ;; modified.
+  (copy-seq *fop-functions*))
 
 (defvar *normal-fop-functions*)
 
@@ -1784,7 +1695,7 @@
      (error "The fop ~S is not supported in cold load." ',name)))
 
 ;;; COLD-LOAD loads stuff into the core image being built by calling
-;;; FASLOAD with the fop function table rebound to a table of cold
+;;; LOAD-AS-FASL with the fop function table rebound to a table of cold
 ;;; loading functions.
 (defun cold-load (filename)
   #!+sb-doc
@@ -1795,7 +1706,7 @@
 				 (string filename)
 				 (pathname (namestring filename)))))
     (with-open-file (s filename :element-type '(unsigned-byte 8))
-      (fasload s nil nil))))
+      (load-as-fasl s nil nil))))
 
 ;;;; miscellaneous cold fops
 
@@ -1890,11 +1801,11 @@
 
 ;;;; cold fops for loading symbols
 
-;;; Load a symbol SIZE characters long from *FASL-FILE* and intern
+;;; Load a symbol SIZE characters long from *FASL-INPUT-STREAM* and intern
 ;;; that symbol in PACKAGE.
 (defun cold-load-symbol (size package)
   (let ((string (make-string size)))
-    (read-string-as-bytes *fasl-file* string)
+    (read-string-as-bytes *fasl-input-stream* string)
     (cold-intern (intern string package) package)))
 
 (macrolet ((frob (name pname-len package-len)
@@ -1920,7 +1831,7 @@
 		(fop-uninterned-small-symbol-save)
   (let* ((size (clone-arg))
 	 (name (make-string size)))
-    (read-string-as-bytes *fasl-file* name)
+    (read-string-as-bytes *fasl-input-stream* name)
     (let ((symbol (allocate-symbol name)))
       (push-fop-table symbol))))
 
@@ -1977,7 +1888,7 @@
 		(fop-small-string)
   (let* ((len (clone-arg))
 	 (string (make-string len)))
-    (read-string-as-bytes *fasl-file* string)
+    (read-string-as-bytes *fasl-input-stream* string)
     (string-to-core string)))
 
 (clone-cold-fop (fop-vector)
@@ -2013,7 +1924,7 @@
 		 (ceiling (* len sizebits)
 			  sb!vm:byte-bits))))
     (read-sequence-or-die (descriptor-bytes result)
-			  *fasl-file*
+			  *fasl-input-stream*
 			  :start start
 			  :end end)
     result))
@@ -2028,7 +1939,7 @@
 		   (ash sb!vm:vector-data-offset sb!vm:word-shift)))
 	 (end (+ start (* len sb!vm:word-bytes))))
     (read-sequence-or-die (descriptor-bytes result)
-			  *fasl-file*
+			  *fasl-input-stream*
 			  :start start
 			  :end end)
     result))
@@ -2096,9 +2007,9 @@
 
 #!+long-float
 (define-cold-fop (fop-long-float)
-  (ecase sb!c:*backend-fasl-file-implementation*
-    (:x86 ; 80 bit long-float format
-     (prepare-for-fast-read-byte *fasl-file*
+  (ecase +backend-fasl-file-implementation+
+    (:x86 ; (which has 80-bit long-float format)
+     (prepare-for-fast-read-byte *fasl-input-stream*
        (let* ((des (allocate-unboxed-object *dynamic* sb!vm:word-bits
 					    (1- sb!vm:long-float-size)
 					    sb!vm:long-float-type))
@@ -2114,7 +2025,7 @@
     ;; SBCL.
     #+nil
     (#.sb!c:sparc-fasl-file-implementation ; 128 bit long-float format
-     (prepare-for-fast-read-byte *fasl-file*
+     (prepare-for-fast-read-byte *fasl-input-stream*
        (let* ((des (allocate-unboxed-object *dynamic* sb!vm:word-bits
 					    (1- sb!vm:long-float-size)
 					    sb!vm:long-float-type))
@@ -2131,9 +2042,9 @@
 
 #!+long-float
 (define-cold-fop (fop-complex-long-float)
-  (ecase sb!c:*backend-fasl-file-implementation*
-    (:x86 ; 80 bit long-float format
-     (prepare-for-fast-read-byte *fasl-file*
+  (ecase +backend-fasl-file-implementation+
+    (:x86 ; (which has 80-bit long-float format)
+     (prepare-for-fast-read-byte *fasl-input-stream*
        (let* ((des (allocate-unboxed-object *dynamic* sb!vm:word-bits
 					    (1- sb!vm:complex-long-float-size)
 					    sb!vm:complex-long-float-type))
@@ -2166,7 +2077,7 @@
     ;; This was supported in CMU CL, but isn't currently supported in SBCL.
     #+nil
     (#.sb!c:sparc-fasl-file-implementation ; 128 bit long-float format
-     (prepare-for-fast-read-byte *fasl-file*
+     (prepare-for-fast-read-byte *fasl-input-stream*
        (let* ((des (allocate-unboxed-object *dynamic* sb!vm:word-bits
 					    (1- sb!vm:complex-long-float-size)
 					    sb!vm:complex-long-float-type))
@@ -2236,7 +2147,7 @@
     (make-descriptor 0 0 nil counter)))
 
 (defun finalize-load-time-value-noise ()
-  (cold-set (cold-intern 'sb!impl::*!load-time-values*)
+  (cold-set (cold-intern '*!load-time-values*)
 	    (allocate-vector-object *dynamic*
 				    sb!vm:word-bits
 				    *load-time-value-counter*
@@ -2316,14 +2227,11 @@
 	     ;; Note: we round the number of constants up to ensure
 	     ;; that the code vector will be properly aligned.
 	     (round-up raw-header-n-words 2))
-	    (des (allocate-descriptor
-		  ;; In the X86 with CGC, code can't be relocated, so
-		  ;; we have to put it into static space. In all other
-		  ;; configurations, code can go into dynamic space.
-		  #!+(and x86 cgc) *static* ; KLUDGE: Why? -- WHN 19990907
-		  #!-(and x86 cgc) *dynamic*
-		  (+ (ash header-n-words sb!vm:word-shift) code-size)
-		  sb!vm:other-pointer-type)))
+	    (des (allocate-cold-descriptor *dynamic*
+					   (+ (ash header-n-words
+						   sb!vm:word-shift)
+					      code-size)
+					   sb!vm:other-pointer-type)))
        (write-memory des
 		     (make-other-immediate-descriptor header-n-words
 						      sb!vm:code-header-type))
@@ -2345,7 +2253,7 @@
 			(ash header-n-words sb!vm:word-shift)))
 	      (end (+ start code-size)))
 	 (read-sequence-or-die (descriptor-bytes des)
-			       *fasl-file*
+			       *fasl-input-stream*
 			       :start start
 			       :end end)
 	 #!+sb-show
@@ -2439,9 +2347,9 @@
 	 (code-object (pop-stack))
 	 (len (read-arg 1))
 	 (sym (make-string len)))
-    (read-string-as-bytes *fasl-file* sym)
+    (read-string-as-bytes *fasl-input-stream* sym)
     (let ((offset (read-arg 4))
-	  (value (lookup-foreign-symbol sym)))
+	  (value (cold-foreign-symbol-address-as-integer sym)))
       (do-cold-fixup code-object offset value kind))
     code-object))
 
@@ -2451,10 +2359,11 @@
 	  ;; Note: we round the number of constants up to ensure that
 	  ;; the code vector will be properly aligned.
 	  (round-up sb!vm:code-constants-offset 2))
-	 (des (allocate-descriptor *read-only*
-				   (+ (ash header-n-words sb!vm:word-shift)
-				      length)
-				   sb!vm:other-pointer-type)))
+	 (des (allocate-cold-descriptor *read-only*
+					(+ (ash header-n-words
+						sb!vm:word-shift)
+					   length)
+					sb!vm:other-pointer-type)))
     (write-memory des
 		  (make-other-immediate-descriptor header-n-words
 						   sb!vm:code-header-type))
@@ -2470,7 +2379,7 @@
 		     (ash header-n-words sb!vm:word-shift)))
 	   (end (+ start length)))
       (read-sequence-or-die (descriptor-bytes des)
-			    *fasl-file*
+			    *fasl-input-stream*
 			    :start start
 			    :end end))
     des))
@@ -2845,10 +2754,6 @@ initially undefined function references:~2%")
     (write-long *data-page*)
     (multiple-value-bind (floor rem)
 	(floor (gspace-byte-address gspace) sb!c:*backend-page-size*)
-      ;; FIXME: Define an INSIST macro which does like ASSERT, but
-      ;; less expensively (ERROR, not CERROR), and which reports
-      ;; "internal error" on failure. Use it here and elsewhere in the
-      ;; system.
       (aver (zerop rem))
       (write-long floor))
     (write-long pages)
@@ -2971,7 +2876,7 @@ initially undefined function references:~2%")
 
     ;; Read symbol table, if any.
     (when symbol-table-file-name
-      (load-foreign-symbol-table symbol-table-file-name))
+      (load-cold-foreign-symbol-table symbol-table-file-name))
 
     ;; Now that we've successfully read our only input file (by
     ;; loading the symbol table, if any), it's a good time to ensure
@@ -3088,11 +2993,17 @@ initially undefined function references:~2%")
 
       ;; Tell the target Lisp how much stuff we've allocated.
       (cold-set 'sb!vm:*read-only-space-free-pointer*
-		(allocate-descriptor *read-only* 0 sb!vm:even-fixnum-type))
+		(allocate-cold-descriptor *read-only*
+					  0
+					  sb!vm:even-fixnum-type))
       (cold-set 'sb!vm:*static-space-free-pointer*
-		(allocate-descriptor *static* 0 sb!vm:even-fixnum-type))
+		(allocate-cold-descriptor *static*
+					  0
+					  sb!vm:even-fixnum-type))
       (cold-set 'sb!vm:*initial-dynamic-space-free-pointer*
-		(allocate-descriptor *dynamic* 0 sb!vm:even-fixnum-type))
+		(allocate-cold-descriptor *dynamic*
+					  0
+					  sb!vm:even-fixnum-type))
       (/show "done setting free pointers")
 
       ;; Write results to files.