From ea395cb6fb53f04e081254738c1cdc1f3e6fef7f Mon Sep 17 00:00:00 2001 From: Douglas Katzman Date: Mon, 15 Jan 2018 13:44:58 -0500 Subject: [PATCH] Share magic constants between genesis and editcore --- make-genesis-2.lisp | 1 + make-host-1.lisp | 1 + package-data-list.lisp-expr | 17 ++------------- src/compiler/generic/genesis.lisp | 37 ++++++++------------------------ src/runtime/coreparse.c | 4 +--- src/runtime/save.c | 2 +- tools-for-build/corefile.lisp | 45 +++++++++++++++++++++++++++++++++++++++ tools-for-build/editcore.lisp | 19 +++++------------ 8 files changed, 65 insertions(+), 61 deletions(-) create mode 100644 tools-for-build/corefile.lisp diff --git a/make-genesis-2.lisp b/make-genesis-2.lisp index ff3092616..8a81496db 100644 --- a/make-genesis-2.lisp +++ b/make-genesis-2.lisp @@ -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* diff --git a/make-host-1.lisp b/make-host-1.lisp index 5b765e448..8cb4553c5 100644 --- a/make-host-1.lisp +++ b/make-host-1.lisp @@ -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 diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 8c4804190..0d6c871ac 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -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 diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index c3a1401f8..1dd5a8f2f 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -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*) diff --git a/src/runtime/coreparse.c b/src/runtime/coreparse.c index cdf30cabe..6eea4da45 100644 --- a/src/runtime/coreparse.c +++ b/src/runtime/coreparse.c @@ -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; diff --git a/src/runtime/save.c b/src/runtime/save.c index d36675e55..4f9203dc4 100644 --- a/src/runtime/save.c +++ b/src/runtime/save.c @@ -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); diff --git a/tools-for-build/corefile.lisp b/tools-for-build/corefile.lisp new file mode 100644 index 000000000..8b322c836 --- /dev/null +++ b/tools-for-build/corefile.lisp @@ -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) diff --git a/tools-for-build/editcore.lisp b/tools-for-build/editcore.lisp index 0ae4ccea0..afe257290 100644 --- a/tools-for-build/editcore.lisp +++ b/tools-for-build/editcore.lisp @@ -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) -- 2.11.4.GIT