From 9c1b233ee05cb343e74e3ec16143cfc4b0161d20 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Sun, 20 Jan 2002 18:31:24 +0000 Subject: [PATCH] 0.7.0.1: cleaned up EVAL-STACK left over from deletion of IR1 and byte interpreters (responding to NJF questions sbcl-devel 2002-01-19) deleted unused symbols: %SP-SET-PLIST, %SP-SET-DEFINITION --- package-data-list.lisp-expr | 22 ++++++++++++++++---- src/code/early-fasl.lisp | 16 ++++++++++----- src/compiler/alpha/cell.lisp | 2 -- src/compiler/alpha/nlx.lisp | 16 +++++++-------- src/compiler/alpha/parms.lisp | 1 - src/compiler/generic/genesis.lisp | 1 - src/compiler/x86/nlx.lisp | 15 +++++++------- src/compiler/x86/parms.lisp | 1 - src/runtime/save.c | 40 +++++++++++++++++++++++++++---------- 9 files changed, 73 insertions(+), 41 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index ee3352e..6a62d6e 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -878,7 +878,22 @@ retained, possibly temporariliy, because it might be used internally." ;; implementation of the Lisp type system (e.g. TYPE-INTERSECTION and ;; SPECIFIER-TYPE) could move to a separate package SB!TYPE. (There's ;; lots of stuff which currently uses the SB!KERNEL package which - ;; doesn't actually use the type system stuff.) + ;; doesn't actually use the type system stuff.) And maybe other + ;; possible splits too: + ;; * Pull GC stuff (*GC-INHIBIT*, *NEED-TO-COLLECT-GARBAGE*, etc.) + ;; out into SB-GC. + ;; * Pull special case implementations of sequence functions (e.g. + ;; %MAP-TO-LIST-ARITY-1 and %FIND-POSITION-IF-NOT) and + ;; other sequence function implementation grot into SB-SEQ. + ;; * Pull all the math stuff (%ACOS, %COSH, 32BIT-LOGICAL-AND...) + ;; into SB-MATH. + ;; * Pull all the array stuff (%ARRAY-DATA-VECTOR, %RAW-REF-LONG, + ;; WITH-ARRAY-DATA, ALLOCATE-VECTOR, HAIRY-DATA-VECTOR-REF...) + ;; into SB-ARRAY. + ;; * Pull all the streams stuff out into SB-STREAM. + ;; * Pull all the OBJECT-NOT-FOO symbols out. Maybe we could even + ;; figure out a way to stop exporting them? Failing that, + ;; they could be in SB-INTERR. #s(sb-cold:package-data :name "SB!KERNEL" :doc @@ -924,15 +939,14 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "%SET-SIGNED-SAP-REF-16" "%SET-SIGNED-SAP-REF-32" "%SET-SIGNED-SAP-REF-64" "%SET-SIGNED-SAP-REF-8" "%SET-STACK-REF" "%SIN" "%SIN-QUICK" - "%SINGLE-FLOAT" "%SINH" "%SP-SET-DEFINITION" - "%SP-SET-PLIST" + "%SINGLE-FLOAT" "%SINH" "%SQRT" "%SXHASH-SIMPLE-STRING" "%SXHASH-SIMPLE-SUBSTRING" "%TAN" "%TAN-QUICK" "%TANH" "%UNARY-ROUND" "%UNARY-TRUNCATE" "%WITH-ARRAY-DATA" "%WITH-ARRAY-DATA-MACRO" "*ALREADY-MAYBE-GCING*" "*CURRENT-LEVEL*" "*EMPTY-TYPE*" - "*EVAL-STACK*" "*EVAL-STACK-TOP*" "*GC-INHIBIT*" + "*GC-INHIBIT*" "*NEED-TO-COLLECT-GARBAGE*" "*PRETTY-PRINTER*" "*UNIVERSAL-TYPE*" "*UNIVERSAL-FUN-TYPE*" diff --git a/src/code/early-fasl.lisp b/src/code/early-fasl.lisp index 4c1fa80..12f4e4f 100644 --- a/src/code/early-fasl.lisp +++ b/src/code/early-fasl.lisp @@ -36,9 +36,13 @@ ;;; the code for a character which terminates a fasl file header (defconstant +fasl-header-string-stop-char-code+ 255) -;;; This value should be incremented when the system changes in such -;;; a way that it will no longer work reliably with old fasl files. -(defconstant +fasl-file-version+ 22) +;;; This value should be incremented when the system changes in such a +;;; way that it will no longer work reliably with old fasl files. In +;;; practice, I (WHN) fairly often neglect to increment it for CVS +;;; versions which break binary compatibility. But it certainly should +;;; be incremented for release versions which break binary +;;; compatibility. +(defconstant +fasl-file-version+ 23) ;;; 2 = sbcl-0.6.4 uses COMPILE-OR-LOAD-DEFGENERIC. ;;; 3 = sbcl-0.6.6 uses private symbol, not :EMPTY, for empty HASH-TABLE slot. ;;; 4 = sbcl-0.6.7 uses HAIRY-DATA-VECTOR-REF and HAIRY-DATA-VECTOR-SET @@ -89,6 +93,8 @@ ;;; 22 = about a zillion changes between sbcl-0.pre7.62 and ;;; sbcl-0.pre7.133, during which time it seemed too much ;;; trouble to increment the counter +;;; 23 = sbcl-0.7.0.1 deleted no-longer-used EVAL-STACK stuff, +;;; causing changes in *STATIC-SYMBOLS*. ;;; the conventional file extension for our fasl files (declaim (type simple-string *fasl-file-type*)) @@ -100,11 +106,11 @@ ;;; Assembler routines are named by full Lisp symbols: they ;;; have packages and that sort of native Lisp stuff associated ;;; with them. We can compare them with EQ. -;;; Foreign symbols are named by Lisp strings: the Lisp package +;;; Foreign symbols are named by Lisp STRINGs: the Lisp package ;;; system doesn't extend out to symbols in languages like C. ;;; We want to use EQUAL to compare them. ;;; *STATIC-FOREIGN-SYMBOLS* are static as opposed to "dynamic" (not -;;; as opposed to "extern"). The table contains symbols known at +;;; as opposed to C's "extern"). The table contains symbols known at ;;; the time that the program was built, but not symbols defined ;;; in object files which have been loaded dynamically since then. (declaim (type hash-table *assembler-routines* *static-foreign-symbols*)) diff --git a/src/compiler/alpha/cell.lisp b/src/compiler/alpha/cell.lisp index 98ed018..087e4f4 100644 --- a/src/compiler/alpha/cell.lisp +++ b/src/compiler/alpha/cell.lisp @@ -369,8 +369,6 @@ (define-mutator-accessors binding-stack-end :sap nil) (define-mutator-accessors number-stack-base :sap nil) (define-mutator-accessors number-stack-end :sap nil) - (define-mutator-accessors eval-stack :des t) - (define-mutator-accessors eval-stack-top :ub32 t) (define-mutator-accessors nursery-start :sap nil) (define-mutator-accessors nursery-end :sap nil) (define-mutator-accessors storebuf-start :sap nil) diff --git a/src/compiler/alpha/nlx.lisp b/src/compiler/alpha/nlx.lisp index d844463..654d39d 100644 --- a/src/compiler/alpha/nlx.lisp +++ b/src/compiler/alpha/nlx.lisp @@ -28,15 +28,15 @@ ;;;; ;;;; These VOPs are used in the reentered function to restore the ;;;; appropriate dynamic environment. Currently we only save the -;;;; Current-Catch and binding stack pointer. We don't need to -;;;; save/restore the current unwind-protect, since unwind-protects +;;;; CURRENT-CATCH and binding stack pointer. We don't need to +;;;; save/restore the current UNWIND-PROTECT, since UNWIND-PROTECTS ;;;; are implicitly processed during unwinding. If there were any -;;;; additional stacks, then this would be the place to restore the +;;;; additional stacks (as e.g. there was an interpreter "eval stack" +;;;; before sbcl-0.7.0), then this would be the place to restore the ;;;; top pointers. - -;;; Return a list of TNs that can be used to snapshot the dynamic state for -;;; use with the Save/Restore-Dynamic-Environment VOPs. +;;; Return a list of TNs that can be used to snapshot the dynamic +;;; state for use with the SAVE- and RESTORE-DYNAMIC-ENVIRONMENT VOPs. (!def-vm-support-routine make-dynamic-state-tns () (list (make-normal-tn *backend-t-primitive-type*) (make-normal-tn *backend-t-primitive-type*) @@ -54,8 +54,7 @@ (let ((cur-nfp (current-nfp-tn vop))) (when cur-nfp (inst mskll cur-nfp 4 nfp))) - (inst mskll nsp-tn 4 nsp) - (load-symbol-value eval *eval-stack-top*))) + (inst mskll nsp-tn 4 nsp))) (define-vop (restore-dynamic-state) (:args (catch :scs (descriptor-reg)) @@ -66,7 +65,6 @@ (:temporary (:sc any-reg) temp) (:generator 10 (store-symbol-value catch *current-catch-block*) - (store-symbol-value eval *eval-stack-top*) (inst mskll nsp-tn 0 temp) (let ((cur-nfp (current-nfp-tn vop))) (when cur-nfp diff --git a/src/compiler/alpha/parms.lisp b/src/compiler/alpha/parms.lisp index 0eca5b9..8c23a45 100644 --- a/src/compiler/alpha/parms.lisp +++ b/src/compiler/alpha/parms.lisp @@ -182,7 +182,6 @@ ;; things needed for non-local exit *current-catch-block* *current-unwind-protect-block* - *eval-stack-top* ;; interrupt handling *free-interrupt-context-index* diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index 8fa8d50..e611b4b 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -1176,7 +1176,6 @@ (cold-set '*current-catch-block* (make-fixnum-descriptor 0)) (cold-set '*current-unwind-protect-block* (make-fixnum-descriptor 0)) - (cold-set '*eval-stack-top* (make-fixnum-descriptor 0)) (cold-set '*free-interrupt-context-index* (make-fixnum-descriptor 0)) diff --git a/src/compiler/x86/nlx.lisp b/src/compiler/x86/nlx.lisp index 42dd906..4d387f3 100644 --- a/src/compiler/x86/nlx.lisp +++ b/src/compiler/x86/nlx.lisp @@ -31,16 +31,17 @@ ;;;; ;;;; These VOPs are used in the reentered function to restore the ;;;; appropriate dynamic environment. Currently we only save the -;;;; Current-Catch, the eval stack pointer, and the alien stack -;;;; pointer. +;;;; Current-Catch and the alien stack pointer. (Before sbcl-0.7.0, +;;;; when there were IR1 and byte interpreters, we had to save +;;;; the interpreter "eval stack" too.) ;;;; -;;;; We don't need to save/restore the current unwind-protect, since -;;;; unwind-protects are implicitly processed during unwinding. +;;;; We don't need to save/restore the current UNWIND-PROTECT, since +;;;; UNWIND-PROTECTs are implicitly processed during unwinding. ;;;; ;;;; We don't need to save the BSP, because that is handled automatically. -;;; Return a list of TNs that can be used to snapshot the dynamic state for -;;; use with the Save/Restore-Dynamic-Environment VOPs. +;;; Return a list of TNs that can be used to snapshot the dynamic +;;; state for use with the SAVE- and RESTORE-DYNAMIC-ENVIRONMENT VOPs. (!def-vm-support-routine make-dynamic-state-tns () (make-n-tns 3 *backend-t-primitive-type*)) @@ -50,7 +51,6 @@ (alien-stack :scs (descriptor-reg))) (:generator 13 (load-symbol-value catch *current-catch-block*) - (load-symbol-value eval *eval-stack-top*) (load-symbol-value alien-stack *alien-stack*))) (define-vop (restore-dynamic-state) @@ -59,7 +59,6 @@ (alien-stack :scs (descriptor-reg))) (:generator 10 (store-symbol-value catch *current-catch-block*) - (store-symbol-value eval *eval-stack-top*) (store-symbol-value alien-stack *alien-stack*))) (define-vop (current-stack-pointer) diff --git a/src/compiler/x86/parms.lisp b/src/compiler/x86/parms.lisp index d776400..7b88f3e 100644 --- a/src/compiler/x86/parms.lisp +++ b/src/compiler/x86/parms.lisp @@ -251,7 +251,6 @@ ;; things needed for non-local exit *current-catch-block* *current-unwind-protect-block* - *eval-stack-top* *alien-stack* ;; interrupt handling diff --git a/src/runtime/save.c b/src/runtime/save.c index 5059aa5..3336639 100644 --- a/src/runtime/save.c +++ b/src/runtime/save.c @@ -82,21 +82,33 @@ boolean save(char *filename, lispobj init_function) { FILE *file; - /* Open the file: */ + + /* Open the output file. We don't actually need the file yet, but + * the fopen() might fail for some reason, and we want to detect + * that and back out before we do anything irreversible. */ unlink(filename); file = fopen(filename, "w"); - if (file == NULL) { + if (!file) { perror(filename); return 1; } - printf("[undoing binding stack... "); + + /* Smash the enclosing state. (Once we do this, there's no good + * way to go back, which is a sufficient reason that this ends up + * being SAVE-LISP-AND-DIE instead of SAVE-LISP-AND-GO-ON). */ + printf("[undoing binding stack and other enclosing state... "); fflush(stdout); unbind_to_here((lispobj *)BINDING_STACK_START); SetSymbolValue(CURRENT_CATCH_BLOCK, 0); SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0); - SetSymbolValue(EVAL_STACK_TOP, 0); printf("done]\n"); + fflush(stdout); + + /* (Now we can actually start copying ourselves into the + * output file.) */ + printf("[saving current Lisp image into %s:\n", filename); + fflush(stdout); putw(CORE_MAGIC, file); @@ -107,21 +119,29 @@ save(char *filename, lispobj init_function) putw(CORE_NDIRECTORY, file); putw((5*3)+2, file); - output_space(file, READ_ONLY_SPACE_ID, (lispobj *)READ_ONLY_SPACE_START, + output_space(file, + READ_ONLY_SPACE_ID, + (lispobj *)READ_ONLY_SPACE_START, (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER)); - output_space(file, STATIC_SPACE_ID, (lispobj *)STATIC_SPACE_START, + output_space(file, + STATIC_SPACE_ID, + (lispobj *)STATIC_SPACE_START, (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER)); #ifdef reg_ALLOC - output_space(file, DYNAMIC_SPACE_ID, (lispobj *)current_dynamic_space, + output_space(file, + DYNAMIC_SPACE_ID, + (lispobj *)current_dynamic_space, dynamic_space_free_pointer); #else #ifdef GENCGC - /* Flush the current_region updating the tables. */ + /* Flush the current_region, updating the tables. */ gc_alloc_update_page_tables(0,&boxed_region); gc_alloc_update_page_tables(1,&unboxed_region); update_x86_dynamic_space_free_pointer(); #endif - output_space(file, DYNAMIC_SPACE_ID, (lispobj *)DYNAMIC_SPACE_START, + output_space(file, + DYNAMIC_SPACE_ID, + (lispobj *)DYNAMIC_SPACE_START, (lispobj *)SymbolValue(ALLOCATION_POINTER)); #endif @@ -130,8 +150,8 @@ save(char *filename, lispobj init_function) putw(init_function, file); putw(CORE_END, file); - fclose(file); + fclose(file); printf("done]\n"); exit(0); -- 1.7.10.4