;;; 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
;;; 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.
;; 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))))
(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*
(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)))
(cold-fdefinition-object (cold-intern ',symbol)))))
(frob sub-gc)
(frob internal-error)
+ #!+win32 (frob handle-win32-exception)
(frob sb!kernel::control-stack-exhausted-error)
(frob sb!kernel::undefined-alien-variable-error)
(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))
(logior (mask-field (byte 16 16)
(bvref-32 gspace-bytes gspace-byte-offset))
(ldb (byte 16 0) value))))))
+ ;; FIXME: PowerPC Fixups are not fully implemented. The bit
+ ;; here starts to set things up to work properly, but there
+ ;; needs to be corresponding code in ppc-vm.lisp
(:ppc
- (ecase kind
- (:ba
- (setf (bvref-32 gspace-bytes gspace-byte-offset)
- (dpb (ash value -2) (byte 24 2)
- (bvref-32 gspace-bytes gspace-byte-offset))))
- (:ha
- (let* ((h (ldb (byte 16 16) value))
- (l (ldb (byte 16 0) value)))
- (setf (bvref-16 gspace-bytes (+ gspace-byte-offset 2))
- (if (logbitp 15 l) (ldb (byte 16 0) (1+ h)) h))))
- (:l
- (setf (bvref-16 gspace-bytes (+ gspace-byte-offset 2))
- (ldb (byte 16 0) value)))))
+ (ecase kind
+ (:ba
+ (setf (bvref-32 gspace-bytes gspace-byte-offset)
+ (dpb (ash value -2) (byte 24 2)
+ (bvref-32 gspace-bytes gspace-byte-offset))))
+ (:ha
+ (let* ((un-fixed-up (bvref-16 gspace-bytes
+ (+ gspace-byte-offset 2)))
+ (fixed-up (+ un-fixed-up value))
+ (h (ldb (byte 16 16) fixed-up))
+ (l (ldb (byte 16 0) fixed-up)))
+ (setf (bvref-16 gspace-bytes (+ gspace-byte-offset 2))
+ (if (logbitp 15 l) (ldb (byte 16 0) (1+ h)) h))))
+ (:l
+ (let* ((un-fixed-up (bvref-16 gspace-bytes
+ (+ gspace-byte-offset 2)))
+ (fixed-up (+ un-fixed-up value)))
+ (setf (bvref-16 gspace-bytes (+ gspace-byte-offset 2))
+ (ldb (byte 16 0) fixed-up))))))
(:sparc
(ecase kind
(:call
(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"
"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 ()
(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
((< value cutoff)
"~D")
(t
- "LISPOBJ(~D)")))
+ "LISPOBJ(~DU)")))
value)
(format t " /* 0x~X */~@[ /* ~A */~]~%" value doc))))
(terpri))
(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;~%")
(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))
(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