X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fgenesis.lisp;h=ce9e73f003b78a0223d6537bf8cca4a0a51dbda5;hb=0dcc957ae6bf24809fda82fd59c134e70058c42a;hp=b75b246e215d527ae8cd0079baa5bcb65972305b;hpb=e88f9c7fd830938e1261cc424437905fb50179ae;p=sbcl.git

diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index b75b246..ce9e73f 100644
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -179,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
@@ -512,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))
@@ -535,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
@@ -1136,18 +1137,16 @@
   ;; the function values for these things?? I.e. why do we need this
   ;; section at all? Is it because all the FDEFINITION stuff gets in
   ;; the way of reading function values and is too hairy to rely on at
-  ;; cold boot? FIXME: 5/6 of these are in *STATIC-SYMBOLS* in
+  ;; cold boot? FIXME: Most of these are in *STATIC-SYMBOLS* in
   ;; parms.lisp, but %HANDLE-FUNCTION-END-BREAKPOINT is not. Why?
   ;; Explain.
   (macrolet ((frob (symbol)
 	       `(cold-set ',symbol
 			  (cold-fdefinition-object (cold-intern ',symbol)))))
-    (frob !cold-init)
     (frob maybe-gc)
     (frob internal-error)
     (frob sb!di::handle-breakpoint)
-    (frob sb!di::handle-function-end-breakpoint)
-    (frob fdefinition-object))
+    (frob sb!di::handle-function-end-breakpoint))
 
   (cold-set '*current-catch-block*          (make-fixnum-descriptor 0))
   (cold-set '*current-unwind-protect-block* (make-fixnum-descriptor 0))
@@ -1243,9 +1242,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.
@@ -2228,14 +2225,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))
@@ -2363,10 +2357,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))
@@ -2427,7 +2422,7 @@
   ;; writing beginning boilerplate
   (format t "/*~%")
   (dolist (line
-	   '("This is a machine-generated file. Do not edit it by hand."
+	   '("This is a machine-generated file. Please do not edit it by hand."
 	     ""
 	     "This file contains low-level information about the"
 	     "internals of a particular version and configuration"
@@ -2442,6 +2437,15 @@
   (format t "#ifndef _SBCL_H_~%#define _SBCL_H_~%")
   (terpri)
 
+  ;; propagating *SHEBANG-FEATURES* into C-level #define's
+  (dolist (shebang-feature-name (sort (mapcar #'symbol-name
+					      sb-cold:*shebang-features*)
+				      #'string<))
+    (format t
+	    "#define LISP_FEATURE_~A~%"
+	    (substitute #\_ #\- shebang-feature-name)))
+  (terpri)
+
   ;; writing miscellaneous constants
   (format t "#define SBCL_CORE_VERSION_INTEGER ~D~%" sbcl-core-version-integer)
   (format t
@@ -2553,7 +2557,7 @@
 
   ;; writing codes/strings for internal errors
   (format t "#define ERRORS { \\~%")
-  ;; FIXME: Is this just DO-VECTOR?
+  ;; FIXME: Is this just DOVECTOR?
   (let ((internal-errors sb!c:*backend-internal-errors*))
     (dotimes (i (length internal-errors))
       (format t "    ~S, /*~D*/ \\~%" (cdr (aref internal-errors i)) i)))
@@ -2996,11 +3000,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.