From: Alastair Bridgewater <lisphacker@users.sourceforge.net>
Date: Sat, 3 Apr 2010 00:38:18 +0000 (+0000)
Subject: 1.0.37.24: Genesis deFIXMEification: Symbol allocation gspace.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=2ac72bb9dee580d01a1cb55fc72a5535ba6b9bd8;p=sbcl.git

1.0.37.24: Genesis deFIXMEification: Symbol allocation gspace.

  * Removed *cold-symbol-allocation-gspace*

  * Added keyword argument for allocation gspace to allocate-symbol.

  * Added keyword argument for allocation space to cold-intern, changing
optional package argument to be a keyword argument as well.

  * Changed initialize-non-nil-symbols to pass explicit gspace arguments
to cold-intern instead of using *cold-symbol-allocation-gspace*.

  * Fixed the one use of the package argument to cold-intern for the
keyword-argument version.
---

diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index 3470516..10ebc3d 100644
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -810,14 +810,10 @@ core and return a descriptor to it."
 
 ;;;; symbol magic
 
-;;; FIXME: This should be a &KEY argument of ALLOCATE-SYMBOL.
-(defvar *cold-symbol-allocation-gspace* nil)
-
 ;;; Allocate (and initialize) a symbol.
-(defun allocate-symbol (name)
+(defun allocate-symbol (name &key (gspace *dynamic*))
   (declare (simple-string name))
-  (let ((symbol (allocate-unboxed-object (or *cold-symbol-allocation-gspace*
-                                             *dynamic*)
+  (let ((symbol (allocate-unboxed-object gspace
                                          sb!vm:n-word-bits
                                          (1- sb!vm:symbol-size)
                                          sb!vm:symbol-header-widetag)))
@@ -1096,8 +1092,9 @@ core and return a descriptor to it."
 ;;; we allocate the symbol, make sure we record a reference to the
 ;;; symbol in the home package so that the package gets set.
 (defun cold-intern (symbol
-                    &optional
-                    (package (symbol-package-for-target-symbol symbol)))
+                    &key
+                    (package (symbol-package-for-target-symbol symbol))
+                    (gspace *dynamic*))
 
   (aver (package-ok-for-target-symbol-p package))
 
@@ -1121,7 +1118,7 @@ core and return a descriptor to it."
         (cold-intern-info (get symbol 'cold-intern-info)))
     (unless cold-intern-info
       (cond ((eq (symbol-package-for-target-symbol symbol) package)
-             (let ((handle (allocate-symbol (symbol-name symbol))))
+             (let ((handle (allocate-symbol (symbol-name symbol) :gspace gspace)))
                (setf (gethash (descriptor-bits handle) *cold-symbols*) symbol)
                (when (eq package *keyword-package*)
                  (cold-set handle handle))
@@ -1188,29 +1185,29 @@ core and return a descriptor to it."
 (defun initialize-non-nil-symbols ()
   #!+sb-doc
   "Initialize the cold load symbol-hacking data structures."
-  (let ((*cold-symbol-allocation-gspace* *static*))
-    ;; Intern the others.
-    (dolist (symbol sb!vm:*static-symbols*)
-      (let* ((des (cold-intern symbol))
-             (offset-wanted (sb!vm:static-symbol-offset symbol))
-             (offset-found (- (descriptor-low des)
-                              (descriptor-low *nil-descriptor*))))
-        (unless (= offset-wanted offset-found)
-          ;; FIXME: should be fatal
-          (warn "Offset from ~S to ~S is ~W, not ~W"
-                symbol
-                nil
-                offset-found
-                offset-wanted))))
-    ;; Establish the value of T.
-    (let ((t-symbol (cold-intern t)))
-      (cold-set t-symbol t-symbol))
-    ;; Establish the value of *PSEUDO-ATOMIC-BITS* so that the
-    ;; allocation sequences that expect it to be zero upon entrance
-    ;; actually find it to be so.
-    #!+(or x86-64 x86)
-    (let ((p-a-a-symbol (cold-intern 'sb!kernel:*pseudo-atomic-bits*)))
-      (cold-set p-a-a-symbol (make-fixnum-descriptor 0)))))
+  ;; Intern the others.
+  (dolist (symbol sb!vm:*static-symbols*)
+    (let* ((des (cold-intern symbol :gspace *static*))
+           (offset-wanted (sb!vm:static-symbol-offset symbol))
+           (offset-found (- (descriptor-low des)
+                            (descriptor-low *nil-descriptor*))))
+      (unless (= offset-wanted offset-found)
+        ;; FIXME: should be fatal
+        (warn "Offset from ~S to ~S is ~W, not ~W"
+              symbol
+              nil
+              offset-found
+              offset-wanted))))
+  ;; Establish the value of T.
+  (let ((t-symbol (cold-intern t :gspace *static*)))
+    (cold-set t-symbol t-symbol))
+  ;; Establish the value of *PSEUDO-ATOMIC-BITS* so that the
+  ;; allocation sequences that expect it to be zero upon entrance
+  ;; actually find it to be so.
+  #!+(or x86-64 x86)
+  (let ((p-a-a-symbol (cold-intern 'sb!kernel:*pseudo-atomic-bits*
+                                   :gspace *static*)))
+    (cold-set p-a-a-symbol (make-fixnum-descriptor 0))))
 
 ;;; a helper function for FINISH-SYMBOLS: Return a cold alist suitable
 ;;; to be stored in *!INITIAL-LAYOUTS*.
@@ -3326,7 +3323,7 @@ initially undefined function references:~2%")
                    ;; nothing if NAME is NIL.
                    (chill (name)
                      (when name
-                       (cold-intern (intern name package) package))))
+                       (cold-intern (intern name package) :package package))))
             (mapc-on-tree #'chill (sb-cold:package-data-export pd))
             (mapc #'chill (sb-cold:package-data-reexport pd))
             (dolist (sublist (sb-cold:package-data-import-from pd))
diff --git a/version.lisp-expr b/version.lisp-expr
index 3d8bc36..ee55441 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.37.23"
+"1.0.37.24"