X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fgenesis.lisp;h=01b7e711c26e4cd00c8d4f04f4a703cdaaffee07;hb=b9915e9a838059473beb4fa03a6410eb8d6b68e3;hp=fc8fed26d5df3958e7324c17185c815f2de76605;hpb=d2054d96f0c8200decf8b6b8560d754d3c541cd7;p=sbcl.git diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index fc8fed2..01b7e71 100644 --- 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 -(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 () @@ -2746,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)) @@ -2821,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;~%") @@ -2934,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)) @@ -3289,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