0.9.6.23:

[sbcl.git] / src / compiler / generic / genesis.lisp

diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index fa3c971..4ba0bc2 100644 (file)
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -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
 ;;; 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
 
 (defun round-up (number size)
   #!+sb-doc

@@ -980,7 +981,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 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*
                           ;; no raw slots in LAYOUT:
                           (number-to-core 0)))
   (write-wordindexed *layout-layout*

@@ -998,26 +999,19 @@ core and return a descriptor to it."
                             (vector-in-core)
                             (number-to-core 0)
                             (number-to-core 0)))
                             (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)
          (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)
                             (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
                             (number-to-core 0)))
          (layout-inherits (vector-in-core t-layout

-                                          i-layout

                                           so-layout
                                           bso-layout)))
 
                                           so-layout
                                           bso-layout)))
 

@@ -1276,7 +1270,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!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))
 
   (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 +2589,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.)"
   (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"
              "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 +2597,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."))
              "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 ()
   (format t " */~%"))
 
 (defun write-config-h ()

@@ -2699,6 +2694,15 @@ core and return a descriptor to it."
                   (symbol-value c)
                   nil)
             constants))
                   (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
 
     (setf constants
           (sort constants

@@ -2737,7 +2741,7 @@ core and return a descriptor to it."
                           ((< value cutoff)
                            "~D")
                           (t
                           ((< value cutoff)
                            "~D")
                           (t

-                           "LISPOBJ(~D)")))
+                           "LISPOBJ(~DU)")))

                   value)
           (format t " /* 0x~X */~@[  /* ~A */~]~%" value doc))))
     (terpri))
                   value)
           (format t " /* 0x~X */~@[  /* ~A */~]~%" value doc))))
     (terpri))

@@ -2812,7 +2816,9 @@ core and return a descriptor to it."
 
 (defun write-structure-object (dd)
   (flet ((cstring (designator)
 
 (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;~%")
     (format t "#ifndef LANGUAGE_ASSEMBLY~2%")
     (format t "struct ~A {~%" (cstring (dd-name dd)))
     (format t "    lispobj header;~%")

@@ -2925,6 +2931,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 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))
 (defconstant end-core-entry-type-code 3840)
 
 (declaim (ftype (function (sb!vm:word) sb!vm:word) write-word))

@@ -3280,7 +3287,11 @@ initially undefined function references:~2%")
                     (format t "~&#include \"~A.h\"~%"
                             (string-downcase
                              (string (sb!vm:primitive-object-name obj)))))))
                     (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
           (out-to
            (string-downcase (string class))
            (write-structure-object