common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Share magic constants between genesis and editcore

Browse source
This commit is contained in:
Douglas Katzman 2018-01-15 13:44:58 -05:00
parent 6a77fb85a7
commit ea395cb6fb
8 changed files with 65 additions and 61 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
make-genesis-2.lisp
View file

@ -10,6 +10,7 @@
(with-open-file (s "output/object-filenames-for-genesis.lisp-expr"
:direction :input)
(read s)))
(load "tools-for-build/corefile.lisp" :verbose nil)
(host-cload-stem "src/compiler/generic/genesis" nil)
(sb-cold:genesis :object-file-names *target-object-file-names*

1
make-host-1.lisp
View file

@ -91,6 +91,7 @@
;;; propagate structure offset and other information to the C runtime
;;; support code.
(load "tools-for-build/corefile.lisp" :verbose nil)
(host-cload-stem "src/compiler/generic/genesis" nil)
) ; END with-compilation-unit

17
package-data-list.lisp-expr
View file

@ -579,14 +579,10 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*."
:export ("*ASSEMBLER-ROUTINES*"
"GET-ASM-ROUTINE"
"+BACKEND-FASL-FILE-IMPLEMENTATION+"
"BUILD-ID-CORE-ENTRY-TYPE-CODE"
"*FASL-FILE-TYPE*"
"CLOSE-FASL-OUTPUT"
"DEFLATED-CORE-SPACE-ID-FLAG"
"DUMP-ASSEMBLER-ROUTINES"
"DUMP-FOP" "DUMP-OBJECT"
"DYNAMIC-CORE-SPACE-ID"
"END-CORE-ENTRY-TYPE-CODE"
"FASL-CONSTANT-ALREADY-DUMPED-P"
"+FASL-FILE-VERSION+"
"FASL-DUMP-COMPONENT"
@ -597,20 +593,11 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*."
"FASL-OUTPUT" "FASL-OUTPUT-P"
"FASL-OUTPUT-ENTRY-TABLE" "FASL-OUTPUT-STREAM"
"FASL-VALIDATE-STRUCTURE"
"IMMOBILE-FIXEDOBJ-CORE-SPACE-ID"
"IMMOBILE-VARYOBJ-CORE-SPACE-ID"
"INITIAL-FUN-CORE-ENTRY-TYPE-CODE"
"*!LOAD-TIME-VALUES*"
"MAX-CORE-SPACE-ID"
;; FIXME: this are listed here so that genesis
;; puts them into .h files, but they are not present in the resulting core
"NEW-DIRECTORY-CORE-ENTRY-TYPE-CODE"
"OPEN-FASL-OUTPUT" "PAGE-TABLE-CORE-ENTRY-TYPE-CODE"
"READ-ONLY-CORE-SPACE-ID"
"OPEN-FASL-OUTPUT"
"*!COLD-DEFCONSTANTS*" "*!COLD-DEFUNS*"
"*!COLD-SETF-MACROS*" "*!COLD-TOPLEVELS*"
"COLD-CONS" "COLD-INTERN" "COLD-PUSH" "COLD-TARGET-PUSH"
"STATIC-CORE-SPACE-ID"))
"COLD-CONS" "COLD-INTERN" "COLD-PUSH" "COLD-TARGET-PUSH"))
;; This package is a grab bag for things which used to be internal
;; symbols in package COMMON-LISP. Lots of these symbols are accessed

37
src/compiler/generic/genesis.lisp
View file

@ -28,7 +28,9 @@
(in-package "SB!FASL")
;;; a magic number used to identify our core files
(eval-when (:compile-toplevel :load-toplevel :execute)
(use-package "SB-COREFILE")) ; not SB!COREFILE
(defconstant core-magic
(logior (ash (sb!xc:char-code #\S) 24)
(ash (sb!xc:char-code #\B) 16)
@ -176,24 +178,16 @@
;;; copying GC is in use), then only the active dynamic space gets
;;; dumped to core.
(defvar *dynamic*)
(defconstant dynamic-core-space-id 1)
(defvar *static*)
(defconstant static-core-space-id 2)
(defvar *read-only*)
(defconstant read-only-core-space-id 3)
#!+immobile-space
(progn
(defvar *immobile-fixedobj*)
(defvar *immobile-varyobj*)
(defconstant immobile-fixedobj-core-space-id 4)
(defconstant immobile-varyobj-core-space-id 5)
(defvar *immobile-space-map* nil))
(defconstant max-core-space-id (+ 3 #!+immobile-space 2))
(defconstant deflated-core-space-id-flag 8)
;;; a GENESIS-time representation of a memory space (e.g. read-only
;;; space, dynamic space, or static space)
@ -2929,7 +2923,10 @@ core and return a descriptor to it."
;; We also propagate magic numbers
;; related to file format,
;; which live here instead of SB!VM.
"SB!FASL"))
"SB!FASL"
;; Home package of some constants which aren't
;; in the target Lisp but are propagated to C.
"SB-COREFILE"))
(do-external-symbols (symbol (find-package package-name))
(when (constantp symbol)
(let ((name (symbol-name symbol)))
@ -3359,22 +3356,6 @@ III. initially undefined function references (alphabetically):
(defvar *core-file*)
;;; magic numbers to identify entries in a core file
;;;
;;; (In case you were wondering: No, AFAIK there's no special magic about
;;; these which requires them to be in the 38xx range. They're just
;;; arbitrary words, tested not for being in a particular range but just
;;; for equality. However, if you ever need to look at a .core file and
;;; figure out what's going on, it's slightly convenient that they're
;;; all in an easily recognizable range, and displacing the range away from
;;; zero seems likely to reduce the chance that random garbage will be
;;; misinterpreted as a .core file.)
(defconstant build-id-core-entry-type-code 3860)
(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))
(defun write-word (num)
(ecase sb!c:*backend-byte-order*
@ -3512,8 +3493,8 @@ III. initially undefined function references (alphabetically):
(dovector (char build-id) (write-byte (sb!xc:char-code char) *core-file*))
(dotimes (j (- padding)) (write-byte #xff *core-file*)))
;; Write the New Directory entry header.
(write-word new-directory-core-entry-type-code)
;; Write the Directory entry header.
(write-word directory-core-entry-type-code)
(let ((spaces (nconc (list *read-only* *static*)
#!+immobile-space
(list *immobile-fixedobj* *immobile-varyobj*)

4
src/runtime/coreparse.c
View file

@ -933,15 +933,13 @@ load_core_file(char *file, os_vm_offset_t file_offset, int merge_core_pages)
lose("can't load .core for different runtime, sorry\n");
}
case NEW_DIRECTORY_CORE_ENTRY_TYPE_CODE:
SHOW("NEW_DIRECTORY_CORE_ENTRY_TYPE_CODE case");
case DIRECTORY_CORE_ENTRY_TYPE_CODE:
process_directory(remaining_len / NDIR_ENTRY_LENGTH,
(struct ndir_entry*)ptr, fd, file_offset,
merge_core_pages, &adj);
break;
case INITIAL_FUN_CORE_ENTRY_TYPE_CODE:
SHOW("INITIAL_FUN_CORE_ENTRY_TYPE_CODE case");
initial_function = adjust_word(&adj, (lispobj)*ptr);
break;

2
src/runtime/save.c
View file

@ -288,7 +288,7 @@ save_to_filehandle(FILE *file, char *filename, lispobj init_function,
if (nwrote != (int)(sizeof (core_entry_elt_t) * string_words))
perror(GENERAL_WRITE_FAILURE_MSG);
write_lispobj(NEW_DIRECTORY_CORE_ENTRY_TYPE_CODE, file);
write_lispobj(DIRECTORY_CORE_ENTRY_TYPE_CODE, file);
write_lispobj(/* (word count = N spaces described by 5 words each, plus the
* entry type code, plus this count itself) */
(5 * MAX_CORE_SPACE_ID) + 2, file);

45
tools-for-build/corefile.lisp Normal file
View file

@ -0,0 +1,45 @@
;;; This package name does not persist after the build is complete,
;;; so it does not have an "!" in it.
;;; It it needed by genesis and SB-EDITCORE
(defpackage "SB-COREFILE"
(::use "CL")
(:export #:core-magic
#:build-id-core-entry-type-code
#:directory-core-entry-type-code
#:initial-fun-core-entry-type-code
#:page-table-core-entry-type-code
#:linkage-table-core-entry-type-code
#:end-core-entry-type-code
#:max-core-space-id
;;
#:read-only-core-space-id
#:static-core-space-id
#:dynamic-core-space-id
#:immobile-fixedobj-core-space-id
#:immobile-varyobj-core-space-id
#:deflated-core-space-id-flag))
(in-package "SB-COREFILE")
;;; magic numbers to identify entries in a core file
;;;
;;; These are arbitrary words, tested not for being in a particular range,
;;; but just for equality. However, if you ever need to look at a .core file
;;; and figure out what's going on, it's slightly convenient that they're
;;; all in an easily recognizable range, and displacing the range away from
;;; zero seems likely to reduce the chance that random garbage will be
;;; misinterpreted as a .core file.)
(defconstant build-id-core-entry-type-code 3860)
(defconstant directory-core-entry-type-code 3861)
(defconstant initial-fun-core-entry-type-code 3863)
(defconstant page-table-core-entry-type-code 3880)
(defconstant linkage-table-core-entry-type-code 3881)
(defconstant end-core-entry-type-code 3840)
(defconstant dynamic-core-space-id 1)
(defconstant static-core-space-id 2)
(defconstant read-only-core-space-id 3)
(defconstant immobile-fixedobj-core-space-id 4)
(defconstant immobile-varyobj-core-space-id 5)
(defconstant deflated-core-space-id-flag 8)

19
tools-for-build/editcore.lisp
View file

@ -18,9 +18,11 @@
(eval-when (:compile-toplevel :load-toplevel :execute)
(require :sb-posix)) ; for mmap
(load (merge-pathnames "corefile.lisp" *load-pathname*))
(defpackage "SB-EDITCORE"
(:use "CL" "SB-VM" "SB-INT" "SB-EXT" "SB-KERNEL" "SB-SYS"
"SB-ALIEN")
(:use "CL" "SB-ALIEN" "SB-COREFILE" "SB-INT" "SB-EXT"
"SB-KERNEL" "SB-SYS" "SB-VM")
(:import-from "SB-ALIEN-INTERNALS"
#:alien-type-bits #:parse-alien-type
#:alien-value-sap #:alien-value-type)
@ -50,17 +52,6 @@
(ash (char-code #\C) 8)
(char-code #\L)))
(defconstant build-id-core-entry-type-code 3860)
(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)
(defconstant dynamic-core-space-id 1)
(defconstant static-core-space-id 2)
(defconstant immobile-fixedobj-core-space-id 4)
(defconstant immobile-varyobj-core-space-id 5)
(defglobal +noexec-stack-note+ ".section .note.GNU-stack, \"\", @progbits")
(defstruct (core-space ; "space" is a CL symbol
@ -1242,7 +1233,7 @@
:element-type 'base-char)))
(%byte-blt core-header (* (1+ ptr) n-word-bytes) string 0 (length string))
(format t "Build ID [~a]~%" string))))
(#.new-directory-core-entry-type-code
(#.directory-core-entry-type-code
(do-directory-entry ((index ptr len) core-header)
(incf original-total-npages npages)
(push (make-space id addr data-page page-adjust nwords) spaces)