0.9.7.9:
[sbcl.git] / src / compiler / generic / genesis.lisp
index fa3c971..01b7e71 100644 (file)
@@ -60,7 +60,8 @@
 ;;; 2: eliminated non-ANSI %DEFCONSTANT/%%DEFCONSTANT support,
 ;;;    deleted a slot from DEBUG-SOURCE structure
 ;;; 3: added build ID to cores to discourage sbcl/.core mismatch
-(defconstant sbcl-core-version-integer 3)
+;;; 4: added gc page table data
+(defconstant sbcl-core-version-integer 4)
 
 (defun round-up (number size)
   #!+sb-doc
@@ -853,7 +854,7 @@ core and return a descriptor to it."
 ;;; FIXME: This information should probably be pulled out of the
 ;;; cross-compiler's tables at genesis time instead of inserted by
 ;;; hand here as a bare numeric constant.
-(defconstant target-layout-length 17)
+(defconstant target-layout-length 18)
 
 ;;; Return a list of names created from the cold layout INHERITS data
 ;;; in X.
@@ -923,22 +924,17 @@ core and return a descriptor to it."
             ;; the target Lisp's (RANDOM-LAYOUT-CLOS-HASH) sequence
             ;; and show up as the CLOS-HASH value of some other
             ;; LAYOUT.
-            ;;
-            ;; FIXME: This expression here can generate a zero value,
-            ;; and the CMU CL code goes out of its way to generate
-            ;; strictly positive values (even though the field is
-            ;; declared as an INDEX). Check that it's really OK to
-            ;; have zero values in the CLOS-HASH slots.
-            (hash-value (mod (logxor (logand   (random-layout-clos-hash) 15253)
-                                     (logandc2 (random-layout-clos-hash) 15253)
-                                     1)
-                             ;; (The MOD here is defensive programming
-                             ;; to make sure we never write an
-                             ;; out-of-range value even if some joker
-                             ;; sets LAYOUT-CLOS-HASH-MAX to other
-                             ;; than 2^n-1 at some time in the
-                             ;; future.)
-                             (1+ sb!kernel:layout-clos-hash-max))))
+            (hash-value
+             (1+ (mod (logxor (logand   (random-layout-clos-hash) 15253)
+                              (logandc2 (random-layout-clos-hash) 15253)
+                              1)
+                      ;; (The MOD here is defensive programming
+                      ;; to make sure we never write an
+                      ;; out-of-range value even if some joker
+                      ;; sets LAYOUT-CLOS-HASH-MAX to other
+                      ;; than 2^n-1 at some time in the
+                      ;; future.)
+                      sb!kernel:layout-clos-hash-max))))
         (write-wordindexed result
                            (+ i sb!vm:instance-slots-offset 1)
                            (make-fixnum-descriptor hash-value))))
@@ -980,7 +976,7 @@ core and return a descriptor to it."
                           (number-to-core target-layout-length)
                           (vector-in-core)
                           ;; FIXME: hard-coded LAYOUT-DEPTHOID of LAYOUT..
-                          (number-to-core 4)
+                          (number-to-core 3)
                           ;; no raw slots in LAYOUT:
                           (number-to-core 0)))
   (write-wordindexed *layout-layout*
@@ -998,26 +994,19 @@ core and return a descriptor to it."
                             (vector-in-core)
                             (number-to-core 0)
                             (number-to-core 0)))
-         (i-layout
-          (make-cold-layout 'instance
-                            (number-to-core 0)
-                            (vector-in-core t-layout)
-                            (number-to-core 1)
-                            (number-to-core 0)))
          (so-layout
           (make-cold-layout 'structure-object
                             (number-to-core 1)
-                            (vector-in-core t-layout i-layout)
-                            (number-to-core 2)
+                            (vector-in-core t-layout)
+                            (number-to-core 1)
                             (number-to-core 0)))
          (bso-layout
           (make-cold-layout 'structure!object
                             (number-to-core 1)
-                            (vector-in-core t-layout i-layout so-layout)
-                            (number-to-core 3)
+                            (vector-in-core t-layout so-layout)
+                            (number-to-core 2)
                             (number-to-core 0)))
          (layout-inherits (vector-in-core t-layout
-                                          i-layout
                                           so-layout
                                           bso-layout)))
 
@@ -1276,7 +1265,8 @@ core and return a descriptor to it."
     (frob sb!kernel::undefined-alien-function-error)
     (frob sb!kernel::memory-fault-error)
     (frob sb!di::handle-breakpoint)
-    (frob sb!di::handle-fun-end-breakpoint))
+    (frob sb!di::handle-fun-end-breakpoint)
+    #!+sb-thread (frob sb!thread::run-interruption))
 
   (cold-set 'sb!vm::*current-catch-block*          (make-fixnum-descriptor 0))
   (cold-set 'sb!vm::*current-unwind-protect-block* (make-fixnum-descriptor 0))
@@ -2594,7 +2584,7 @@ core and return a descriptor to it."
   (dolist (line
            '("This is a machine-generated file. Please do not edit it by hand."
              "(As of sbcl-0.8.14, it came from WRITE-CONFIG-H in genesis.lisp.)"
-             ""
+             nil
              "This file contains low-level information about the"
              "internals of a particular version and configuration"
              "of SBCL. It is used by the C compiler to create a runtime"
@@ -2602,7 +2592,7 @@ core and return a descriptor to it."
              "operating system's native format, which can then be used to"
              "load and run 'core' files, which are basically programs"
              "in SBCL's own format."))
-    (format t " * ~A~%" line))
+    (format t " *~@[ ~A~]~%" line))
   (format t " */~%"))
 
 (defun write-config-h ()
@@ -2699,6 +2689,15 @@ core and return a descriptor to it."
                   (symbol-value c)
                   nil)
             constants))
+    ;; One more symbol that doesn't fit into the code above.
+    (flet ((translate (name)
+             (delete #\+ (substitute #\_ #\- name))))
+      (let ((c 'sb!impl::+magic-hash-vector-value+))
+        (push (list (translate (symbol-name c))
+                    9
+                    (symbol-value c)
+                    nil)
+              constants)))
 
     (setf constants
           (sort constants
@@ -2737,7 +2736,7 @@ core and return a descriptor to it."
                           ((< value cutoff)
                            "~D")
                           (t
-                           "LISPOBJ(~D)")))
+                           "LISPOBJ(~DU)")))
                   value)
           (format t " /* 0x~X */~@[  /* ~A */~]~%" value doc))))
     (terpri))
@@ -2812,7 +2811,9 @@ core and return a descriptor to it."
 
 (defun write-structure-object (dd)
   (flet ((cstring (designator)
-           (substitute #\_ #\- (string-downcase (string designator)))))
+           (substitute
+            #\_ #\%
+            (substitute #\_ #\- (string-downcase (string designator))))))
     (format t "#ifndef LANGUAGE_ASSEMBLY~2%")
     (format t "struct ~A {~%" (cstring (dd-name dd)))
     (format t "    lispobj header;~%")
@@ -2925,6 +2926,7 @@ initially undefined function references:~2%")
 (defconstant build-id-core-entry-type-code 3899)
 (defconstant new-directory-core-entry-type-code 3861)
 (defconstant initial-fun-core-entry-type-code 3863)
+(defconstant page-table-core-entry-type-code 3880)
 (defconstant end-core-entry-type-code 3840)
 
 (declaim (ftype (function (sb!vm:word) sb!vm:word) write-word))
@@ -3280,7 +3282,11 @@ initially undefined function references:~2%")
                     (format t "~&#include \"~A.h\"~%"
                             (string-downcase
                              (string (sb!vm:primitive-object-name obj)))))))
-        (dolist (class '(hash-table layout))
+        (dolist (class '(hash-table
+                         layout
+                         sb!c::compiled-debug-info
+                         sb!c::compiled-debug-fun
+                         sb!xc:package))
           (out-to
            (string-downcase (string class))
            (write-structure-object