From: Alastair Bridgewater <lisphacker@users.sourceforge.net>
Date: Tue, 3 Feb 2009 04:13:13 +0000 (+0000)
Subject: 1.0.25.2: Eliminate untagged pointers to heap space in cold-init
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=9603675940cce3bcac93b354dca62d20c991cbce;p=sbcl.git

1.0.25.2: Eliminate untagged pointers to heap space in cold-init

Load-time value fixups encountered by genesis are added as a kind of
toplevel form to be patched during cold-init.  The reference to the
location to fix up was being dumped as a SAP pointing to the correct
point in heap space.  Instead of dumping a SAP, we now dump the
containing object and an offset within the object, thus removing one
obstacle to running the GC or doing other heap-space relocation prior
to running the cold-toplevels.
---

diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp
index 5252ea3..6752e22 100644
--- a/src/code/cold-init.lisp
+++ b/src/code/cold-init.lisp
@@ -197,9 +197,10 @@
             (setf (svref *!load-time-values* (third toplevel-thing))
                   (funcall (second toplevel-thing))))
            (:load-time-value-fixup
-            (setf (sap-ref-word (second toplevel-thing) 0)
+            (setf (sap-ref-word (int-sap (get-lisp-obj-address (second toplevel-thing)))
+                                (third toplevel-thing))
                   (get-lisp-obj-address
-                   (svref *!load-time-values* (third toplevel-thing)))))
+                   (svref *!load-time-values* (fourth toplevel-thing)))))
            #!+(and x86 gencgc)
            (:load-time-code-fixup
             (sb!vm::!envector-load-time-code-fixup (second toplevel-thing)
diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index d74575c..d6e91ad 100644
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -530,15 +530,16 @@
 
 ;;; (Note: In CMU CL, this function expected a SAP-typed ADDRESS
 ;;; value, instead of the SAP-INT we use here.)
-(declaim (ftype (function (sb!vm:word descriptor) (values))
+(declaim (ftype (function (descriptor sb!vm:word descriptor) (values))
                 note-load-time-value-reference))
-(defun note-load-time-value-reference (address marker)
+(defun note-load-time-value-reference (address offset marker)
   (cold-push (cold-cons
               (cold-intern :load-time-value-fixup)
-              (cold-cons (sap-int-to-core address)
-                         (cold-cons
-                          (number-to-core (descriptor-word-offset marker))
-                          *nil-descriptor*)))
+              (cold-cons address
+                         (cold-cons (number-to-core offset)
+                                    (cold-cons
+                                     (number-to-core (descriptor-word-offset marker))
+                                     *nil-descriptor*))))
              *current-reversed-cold-toplevels*)
   (values))
 
@@ -555,9 +556,10 @@
   ;; idea?) -- WHN 19990817
   (if (and (null (descriptor-gspace value))
            (not (null (descriptor-word-offset value))))
-    (note-load-time-value-reference (+ (logandc2 (descriptor-bits address)
-                                                 sb!vm:lowtag-mask)
-                                       (ash index sb!vm:word-shift))
+    (note-load-time-value-reference address
+                                    (- (ash index sb!vm:word-shift)
+                                       (logand (descriptor-bits address)
+                                               sb!vm:lowtag-mask))
                                     value)
     (let* ((bytes (gspace-bytes (descriptor-intuit-gspace address)))
            (byte-index (ash (+ index (descriptor-word-offset address))
diff --git a/version.lisp-expr b/version.lisp-expr
index 1bef3f7..9956c63 100644
--- 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.25.1"
+"1.0.25.2"