From: Christophe Rhodes Date: Thu, 16 Mar 2006 12:01:07 +0000 (+0000) Subject: 0.9.10.39: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=b0a7abdf2bd6f2d66fcce97196024cdb0e1a1886;p=sbcl.git 0.9.10.39: Implement and document SB-EXT:*CORE-PATHNAME*. ... communicate from runtime via SB-INT:*CORE-STRING*, rather than constructing a pathname in C. Related refactoring. ... since OS-COLD-INIT-OR-REINIT has exactly the same functionality on all currently supported platforms, move it into a common file; ... define common *common-static-symbols* and *c-callable-static-symbols* for use in constructing the per-backend *static-symbols* list, and to remove the need for maintaining a separate list of callable symbols in genesis. --- diff --git a/NEWS b/NEWS index c964bac..09e234c 100644 --- a/NEWS +++ b/NEWS @@ -4,6 +4,8 @@ changes in sbcl-0.9.11 relative to sbcl-0.9.10: MacOS X 10.4.5 on Intel. * new feature: Unicode character names are now known to the system (through CHAR-NAME and NAME-CHAR). + * new feature: the filesystem location of SBCL's core file is + exposed to lisp through the variable SB-EXT:*CORE-PATHNAME*. * minor incompatible change: the contrib modules SB-POSIX and SB-BSD-SOCKETS no longer depend on stub C libraries; the intent of this change is to make it easier to distribute diff --git a/build-order.lisp-expr b/build-order.lisp-expr index 75a621c..f606bc3 100644 --- a/build-order.lisp-expr +++ b/build-order.lisp-expr @@ -105,6 +105,7 @@ ;; for various constants e.g. SB!XC:MOST-POSITIVE-FIXNUM and ;; SB!VM:N-LOWTAG-BITS, needed by "early-objdef" and others + ("src/compiler/generic/parms") ("src/compiler/target/parms") ("src/compiler/generic/early-vm") ("src/compiler/generic/early-objdef") @@ -216,8 +217,9 @@ ("src/code/unix" :not-host) #!+win32 ("src/code/win32" :not-host) - #!+mach ("src/code/mach" :not-host) + + ("src/code/common-os" :not-host) #!+mach ("src/code/mach-os" :not-host) #!+sunos ("src/code/sunos-os" :not-host) #!+hpux ("src/code/hpux-os" :not-host) diff --git a/doc/manual/intro.texinfo b/doc/manual/intro.texinfo index de53117..6ae075a 100644 --- a/doc/manual/intro.texinfo +++ b/doc/manual/intro.texinfo @@ -123,8 +123,13 @@ standardization process. @item Executable Fasl Packaging @code{sb-executable} can be used to concatenate multiple fasls into a -single executable (though the presense of an SBCL runtime and core -image is still required to run it). +single executable (though the presense of an SBCL runtime and core image +is still required to run it). + +The @code{:executable} argument to @ref{Function +sb-ext:save-lisp-and-die} can produce a `standalone' executable +containing both an image of the current Lisp session and an SBCL +runtime. @item Bitwise Rotation @code{sb-rotate-byte} provides an efficient primitive for bitwise diff --git a/doc/manual/start-stop.texinfo b/doc/manual/start-stop.texinfo index f16bfca..86c1956 100644 --- a/doc/manual/start-stop.texinfo +++ b/doc/manual/start-stop.texinfo @@ -112,6 +112,12 @@ process, and is also provided as an extension to the user. @include fun-sb-ext-save-lisp-and-die.texinfo +To facilitate distribution of SBCL applications using external +resources, the filesystem location of the SBCL core file being used is +available from Lisp. + +@include var-sb-ext-star-core-pathname-star.texinfo + @node Exit on Errors @comment node-name, next, previous, up @subsection Exit on Errors diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index d0aa44b..189d891 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -564,7 +564,7 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*." :use ("CL" "SB!ALIEN" "SB!INT" "SB!SYS" "SB!GRAY") :export ( ;; Information about how the program was invoked is ;; nonstandard but very useful. - "*POSIX-ARGV*" + "*POSIX-ARGV*" "*CORE-PATHNAME*" "POSIX-GETENV" "POSIX-ENVIRON" ;; People have various good reasons to mess with the GC. @@ -788,6 +788,9 @@ retained, possibly temporariliy, because it might be used internally." :export (;; lambda list keyword extensions "&MORE" + ;; communication between the runtime and Lisp + "*CORE-STRING*" + ;; INFO stuff doesn't belong in a user-visible package, we ;; should be able to change it without apology. "*INFO-ENVIRONMENT*" diff --git a/src/code/bsd-os.lisp b/src/code/bsd-os.lisp index b9c8009..97814f2 100644 --- a/src/code/bsd-os.lisp +++ b/src/code/bsd-os.lisp @@ -1,4 +1,4 @@ -;;;; OS interface functions for CMU CL under BSD Unix. +;;;; OS interface functions for SBCL under BSD Unix. ;;;; This code was written as part of the CMU Common Lisp project at ;;;; Carnegie Mellon University, and has been placed in the public @@ -8,8 +8,9 @@ ;;;; Check that target machine features are set up consistently with ;;;; this file. -#!-bsd (eval-when (:compile-toplevel :load-toplevel :execute) - (error "The :BSD feature is missing, we shouldn't be doing this code.")) +#!-bsd +(eval-when (:compile-toplevel :load-toplevel :execute) + (error "The :BSD feature is missing, we shouldn't be doing this code.")) (defun software-type () #!+sb-doc @@ -20,8 +21,6 @@ #!+NetBSD "NetBSD" #!+Darwin "Darwin")) -(defvar *software-version* nil) - (defun software-version () #!+sb-doc "Return a string describing version of the supporting software, or NIL @@ -33,16 +32,6 @@ (sb!ext:run-program "/usr/bin/uname" `("-r") :output stream)))))) -(defun os-cold-init-or-reinit () - (setf *software-version* nil) - (setf *default-pathname-defaults* - ;; (temporary value, so that #'NATIVE-PATHNAME won't blow up when - ;; we call it below:) - (make-trivial-default-pathname) - *default-pathname-defaults* - ;; (final value, constructed using #'NATIVE-PATHNAME:) - (native-pathname (sb!unix:posix-getcwd/)))) - ;;; Return system time, user time and number of page faults. (defun get-system-info () (multiple-value-bind (err? utime stime maxrss ixrss idrss diff --git a/src/code/common-os.lisp b/src/code/common-os.lisp new file mode 100644 index 0000000..9846ed6 --- /dev/null +++ b/src/code/common-os.lisp @@ -0,0 +1,36 @@ +;;;; OS interface functions for SBCL common to all target OSes + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + +(in-package "SB!SYS") + +(defvar *software-version* nil) + +(defvar *core-pathname* nil + #!+sb-doc + "The absolute pathname of the running SBCL core.") + +;;; if something ever needs to be done differently for one OS, then +;;; split out the different part into per-os functions. +(defun os-cold-init-or-reinit () + (/show0 "entering OS-COLD-INIT-OR-REINIT") + (setf *software-version* nil) + (/show0 "setting *DEFAULT-PATHNAME-DEFAULTS*") + (setf *default-pathname-defaults* + ;; (temporary value, so that #'NATIVE-PATHNAME won't blow up when + ;; we call it below:) + (make-trivial-default-pathname) + *default-pathname-defaults* + ;; (final value, constructed using #'NATIVE-PATHNAME:) + (native-pathname (sb!unix:posix-getcwd/))) + (/show0 "setting *CORE-PATHNAME*") + (setf *core-pathname* + (merge-pathnames (native-pathname *core-string*))) + (/show0 "leaving OS-COLD-INIT-OR-REINIT")) diff --git a/src/code/early-impl.lisp b/src/code/early-impl.lisp index 2a35b72..6009653 100644 --- a/src/code/early-impl.lisp +++ b/src/code/early-impl.lisp @@ -16,6 +16,7 @@ ;;; listed here and then listed separately (and by now, 2001-06-06, ;;; slightly differently) elsewhere. (declaim (special *posix-argv* + *core-string* *read-only-space-free-pointer* sb!vm:*static-space-free-pointer* sb!vm:*initial-dynamic-space-free-pointer* diff --git a/src/code/linux-os.lisp b/src/code/linux-os.lisp index 14f758d..7b1b5f4 100644 --- a/src/code/linux-os.lisp +++ b/src/code/linux-os.lisp @@ -1,4 +1,4 @@ -;;;; OS interface functions for CMU CL under Linux +;;;; OS interface functions for SBCL under Linux ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. @@ -20,8 +20,6 @@ "Return a string describing the supporting software." (values "Linux")) -(defvar *software-version* nil) - ;;; FIXME: More duplicated logic here vrt. other oses. Abstract into ;;; uname-software-version? (defun software-version () @@ -35,21 +33,6 @@ (sb!ext:run-program "/bin/uname" `("-r") :output stream)))))) -;;; FIXME: This logic is duplicated in other backends: -;;; abstract, abstract. OS-COMMON-COLD-INIT-OR-REINIT, mayhaps? -(defun os-cold-init-or-reinit () ; KLUDGE: don't know what to do here - (/show0 "entering linux-os.lisp OS-COLD-INIT-OR-REINIT") - (setf *software-version* nil) - (/show0 "setting *DEFAULT-PATHNAME-DEFAULTS*") - (setf *default-pathname-defaults* - ;; (temporary value, so that #'NATIVE-PATHNAME won't blow up - ;; when we call it below:) - (make-trivial-default-pathname) - *default-pathname-defaults* - ;; (final value, constructed using #'NATIVE-PATHNAME:) - (native-pathname (sb!unix:posix-getcwd/))) - (/show0 "leaving linux-os.lisp OS-COLD-INIT-OR-REINIT")) - ;;; Return system time, user time and number of page faults. (defun get-system-info () (multiple-value-bind diff --git a/src/code/osf1-os.lisp b/src/code/osf1-os.lisp index abc4c02..59f6311 100644 --- a/src/code/osf1-os.lisp +++ b/src/code/osf1-os.lisp @@ -20,8 +20,6 @@ "Return a string describing the supporting software." (values "OSF/1")) -(defvar *software-version* nil) - (defun software-version () #!+sb-doc "Return a string describing version of the supporting software, or NIL @@ -33,19 +31,6 @@ (sb!ext:run-program "/bin/uname" `("-r") :output stream)))))) -(defun os-cold-init-or-reinit () ; KLUDGE: don't know what to do here - (/show "entering osf1-os.lisp OS-COLD-INIT-OR-REINIT") - (setf *software-version* nil) - (/show "setting *DEFAULT-PATHNAME-DEFAULTS*") - (setf *default-pathname-defaults* - ;; (temporary value, so that #'NATIVE-PATHNAME won't blow up - ;; when we call it below:) - (make-trivial-default-pathname) - *default-pathname-defaults* - ;; (final value, constructed using #'NATIVE-PATHNAME:) - (native-pathname (sb!unix:posix-getcwd/))) - (/show "leaving osf1-os.lisp OS-COLD-INIT-OR-REINIT")) - ;;; Return system time, user time and number of page faults. (defun get-system-info () (multiple-value-bind diff --git a/src/code/sunos-os.lisp b/src/code/sunos-os.lisp index 7134c38..2a419a6 100644 --- a/src/code/sunos-os.lisp +++ b/src/code/sunos-os.lisp @@ -1,4 +1,4 @@ -;;;; OS interface functions for CMU CL under Solaris (FIXME: SunOS?) +;;;; OS interface functions for SBCL under SunOS ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. @@ -20,8 +20,6 @@ "Return a string describing the supporting software." (values "SunOS")) -(defvar *software-version* nil) - (defun software-version () #!+sb-doc "Return a string describing version of the supporting software, or NIL @@ -33,19 +31,6 @@ (sb!ext:run-program "/bin/uname" `("-r") :output stream)))))) -(defun os-cold-init-or-reinit () ; KLUDGE: don't know what to do here - (/show "entering sunos-os.lisp OS-COLD-INIT-OR-REINIT") - (setf *software-version* nil) - (/show "setting *DEFAULT-PATHNAME-DEFAULTS*") - (setf *default-pathname-defaults* - ;; (temporary value, so that #'NATIVE-PATHNAME won't blow up when - ;; we call it below:) - (make-trivial-default-pathname) - *default-pathname-defaults* - ;; (final value, constructed using #'NATIVE-PATHNAME:) - (native-pathname (sb!unix:posix-getcwd/))) - (/show "leaving sunos-os.lisp OS-COLD-INIT-OR-REINIT")) - ;;; Return system time, user time and number of page faults. (defun get-system-info () (multiple-value-bind diff --git a/src/code/win32-os.lisp b/src/code/win32-os.lisp index 1565897..dddc8a0 100644 --- a/src/code/win32-os.lisp +++ b/src/code/win32-os.lisp @@ -20,8 +20,6 @@ "Return a string describing the supporting software." (values "Win32")) -(defvar *software-version* nil) - (defun software-version () #!+sb-doc "Return a string describing version of the supporting software, or NIL @@ -34,19 +32,6 @@ (sb!ext:run-program "/bin/uname" `("-r") :output stream)))))) -(defun os-cold-init-or-reinit () ; KLUDGE: don't know what to do here - (/show0 "entering win32-os.lisp OS-COLD-INIT-OR-REINIT") - (setf *software-version* nil) - (/show0 "setting *DEFAULT-PATHNAME-DEFAULTS*") - (setf *default-pathname-defaults* - ;; (temporary value, so that #'NATIVE-PATHNAME won't blow up when - ;; we call it below:) - (make-trivial-default-pathname) - *default-pathname-defaults* - ;; (final value, constructed using #'NATIVE-PATHNAME:) - (native-pathname (sb!unix:posix-getcwd/))) - (/show0 "leaving linux-os.lisp OS-COLD-INIT-OR-REINIT")) - ;;; Return system time, user time and number of page faults. (defun get-system-info () #+nil (multiple-value-bind diff --git a/src/compiler/alpha/parms.lisp b/src/compiler/alpha/parms.lisp index bd27808..2224bd2 100644 --- a/src/compiler/alpha/parms.lisp +++ b/src/compiler/alpha/parms.lisp @@ -169,39 +169,10 @@ ;;; can be loaded directly out of them by indirecting relative to NIL. ;;; (defparameter *static-symbols* - '(t - - ;; The C startup code must fill these in. - *posix-argv* - - ;; functions that the C code needs to call - sub-gc - sb!kernel::internal-error - sb!kernel::control-stack-exhausted-error - sb!kernel::undefined-alien-variable-error - sb!kernel::undefined-alien-function-error - sb!di::handle-breakpoint - sb!di::handle-fun-end-breakpoint - - ;; free pointers - *read-only-space-free-pointer* - *static-space-free-pointer* - *initial-dynamic-space-free-pointer* - - ;; things needed for non-local exit - *current-catch-block* - *current-unwind-protect-block* - - *binding-stack-start* - *control-stack-start* - *control-stack-end* - - ;; interrupt handling - *free-interrupt-context-index* - sb!unix::*interrupts-enabled* - sb!unix::*interrupt-pending* - *gc-inhibit* - *gc-pending*)) + (append + *common-static-symbols* + *c-callable-static-symbols* + '())) (defparameter *static-funs* '(length diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index a381dfd..33a504b 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -1255,19 +1255,8 @@ core and return a descriptor to it." ;; the names to highlight that something weird is going on. Perhaps ;; *MAYBE-GC-FUN*, *INTERNAL-ERROR-FUN*, *HANDLE-BREAKPOINT-FUN*, ;; and *HANDLE-FUN-END-BREAKPOINT-FUN*... - (macrolet ((frob (symbol) - `(cold-set ',symbol - (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) - #!+sb-thread (frob sb!thread::run-interruption)) + (dolist (symbol sb!vm::*c-callable-static-symbols*) + (cold-set symbol (cold-fdefinition-object (cold-intern symbol)))) (cold-set 'sb!vm::*current-catch-block* (make-fixnum-descriptor 0)) (cold-set 'sb!vm::*current-unwind-protect-block* (make-fixnum-descriptor 0)) diff --git a/src/compiler/generic/parms.lisp b/src/compiler/generic/parms.lisp new file mode 100644 index 0000000..b75954a --- /dev/null +++ b/src/compiler/generic/parms.lisp @@ -0,0 +1,55 @@ +;;;; This file contains some parameterizations of various VM +;;;; attributes common to all architectures. + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + +(in-package "SB!VM") + +(defparameter *c-callable-static-symbols* + '(sub-gc + sb!kernel::internal-error + sb!kernel::control-stack-exhausted-error + sb!kernel::undefined-alien-variable-error + sb!kernel::undefined-alien-function-error + sb!kernel::memory-fault-error + sb!di::handle-breakpoint + fdefinition-object + #!+sb-thread sb!thread::run-interruption + #!+win32 sb!kernel::handle-win32-exception)) + +(defparameter *common-static-symbols* + '(t + + ;; filled in by the C code to propagate to Lisp + *posix-argv* *core-string* + + ;; free pointers. Note that these are FIXNUM word counts, not (as + ;; one might expect) byte counts or SAPs. The reason seems to be + ;; that by representing them this way, we can avoid consing + ;; bignums. -- WHN 2000-10-02 + *read-only-space-free-pointer* + *static-space-free-pointer* + *initial-dynamic-space-free-pointer* + + ;; things needed for non-local-exit + *current-catch-block* + *current-unwind-protect-block* + + ;; stack pointers + *binding-stack-start* + *control-stack-start* + *control-stack-end* + + ;; interrupt handling + *free-interrupt-context-index* + sb!unix::*interrupts-enabled* + sb!unix::*interrupt-pending* + *gc-inhibit* + *gc-pending*)) \ No newline at end of file diff --git a/src/compiler/hppa/parms.lisp b/src/compiler/hppa/parms.lisp index 4ad2bf1..30cba51 100644 --- a/src/compiler/hppa/parms.lisp +++ b/src/compiler/hppa/parms.lisp @@ -110,41 +110,11 @@ ;;; The fdefn objects for the static functions are loaded into static ;;; space directly after the static symbols. That way, the raw-addr ;;; can be loaded directly out of them by indirecting relative to NIL. -;;; (defparameter *static-symbols* - '(t - - ;; The C startup code must fill these in. - *posix-argv* - - ;; Functions that the C code needs to call - sb!impl::sub-gc - sb!kernel::internal-error - sb!kernel::control-stack-exhausted-error - sb!kernel::undefined-alien-variable-error - sb!kernel::undefined-alien-function-error - sb!di::handle-breakpoint - sb!impl::fdefinition-object - - ;; Free Pointers. - *read-only-space-free-pointer* - *static-space-free-pointer* - *initial-dynamic-space-free-pointer* - - ;; Things needed for non-local-exit. - *current-catch-block* - *current-unwind-protect-block* - - *binding-stack-start* - *control-stack-start* - *control-stack-end* - - ;; Interrupt Handling - *free-interrupt-context-index* - sb!unix::*interrupts-enabled* - sb!unix::*interrupt-pending* - *gc-inhibit* - *gc-pending*)) + (append + *common-static-symbols* + *c-callable-static-symbols* + '())) (defparameter *static-funs* '(length diff --git a/src/compiler/mips/parms.lisp b/src/compiler/mips/parms.lisp index 64c2eb8..9353950 100644 --- a/src/compiler/mips/parms.lisp +++ b/src/compiler/mips/parms.lisp @@ -144,39 +144,11 @@ ;;; The fdefn objects for the static functions are loaded into static ;;; space directly after the static symbols. That way, the raw-addr ;;; can be loaded directly out of them by indirecting relative to NIL. -;;; (defparameter *static-symbols* - '(t - - *posix-argv* - - sb!impl::sub-gc - sb!kernel::internal-error - sb!kernel::control-stack-exhausted-error - sb!kernel::undefined-alien-variable-error - sb!kernel::undefined-alien-function-error - sb!di::handle-breakpoint - sb!impl::fdefinition-object - - ;; Free Pointers - *read-only-space-free-pointer* - *static-space-free-pointer* - *initial-dynamic-space-free-pointer* - - ;; Things needed for non-local-exit. - *current-catch-block* - *current-unwind-protect-block* - - *binding-stack-start* - *control-stack-start* - *control-stack-end* - - ;; Interrupt Handling - *free-interrupt-context-index* - sb!unix::*interrupts-enabled* - sb!unix::*interrupt-pending* - *gc-inhibit* - *gc-pending*)) + (append + *common-static-symbols* + *c-callable-static-symbols* + '())) (defparameter *static-funs* '(sb!kernel:two-arg-+ diff --git a/src/compiler/ppc/parms.lisp b/src/compiler/ppc/parms.lisp index fce1a51..2ce0502 100644 --- a/src/compiler/ppc/parms.lisp +++ b/src/compiler/ppc/parms.lisp @@ -169,47 +169,17 @@ ;;; can be loaded directly out of them by indirecting relative to NIL. ;;; (defparameter *static-symbols* - '(t - - ;; The C startup code must fill these in. - *posix-argv* - - ;; functions that the C code needs to call - sb!impl::sub-gc - sb!kernel::internal-error - sb!kernel::control-stack-exhausted-error - sb!kernel::undefined-alien-variable-error - sb!kernel::undefined-alien-function-error - sb!di::handle-breakpoint - sb!impl::fdefinition-object - - ;; free pointers - *read-only-space-free-pointer* - *static-space-free-pointer* - *initial-dynamic-space-free-pointer* - - ;; things needed for non-local exit - *current-catch-block* - *current-unwind-protect-block* - - *binding-stack-start* - *control-stack-start* - *control-stack-end* - - ;; interrupt handling - *free-interrupt-context-index* - sb!unix::*interrupts-enabled* - sb!unix::*interrupt-pending* - *gc-inhibit* - *gc-pending* - - *restart-lisp-function* - - ;; CLH: 20060210 Taken from x86-64/parms.lisp per JES' suggestion - ;; Needed for callbacks to work across saving cores. see - ;; ALIEN-CALLBACK-ASSEMBLER-WRAPPER in c-call.lisp for gory - ;; details. - sb!alien::*enter-alien-callback*)) + (append + *common-static-symbols* + *c-callable-static-symbols* + '( + #!+gencgc *restart-lisp-function* + + ;; CLH: 20060210 Taken from x86-64/parms.lisp per JES' suggestion + ;; Needed for callbacks to work across saving cores. see + ;; ALIEN-CALLBACK-ASSEMBLER-WRAPPER in c-call.lisp for gory + ;; details. + sb!alien::*enter-alien-callback*))) (defparameter *static-funs* '(length diff --git a/src/compiler/sparc/parms.lisp b/src/compiler/sparc/parms.lisp index 5abe8b8..2dc5c35 100644 --- a/src/compiler/sparc/parms.lisp +++ b/src/compiler/sparc/parms.lisp @@ -161,40 +161,10 @@ ;;; can be loaded directly out of them by indirecting relative to NIL. ;;; (defparameter *static-symbols* - '(t - - ;; The C startup code must fill these in. - *posix-argv* - sb!impl::*!initial-fdefn-objects* - - ;; functions that the C code needs to call - sub-gc - sb!kernel::internal-error - sb!kernel::control-stack-exhausted-error - sb!kernel::undefined-alien-variable-error - sb!kernel::undefined-alien-function-error - sb!di::handle-breakpoint - sb!di::handle-fun-end-breakpoint - - ;; free pointers - *read-only-space-free-pointer* - *static-space-free-pointer* - *initial-dynamic-space-free-pointer* - - ;; things needed for non-local exit - *current-catch-block* - *current-unwind-protect-block* - - *binding-stack-start* - *control-stack-start* - *control-stack-end* - - ;; interrupt handling - *free-interrupt-context-index* - sb!unix::*interrupts-enabled* - sb!unix::*interrupt-pending* - *gc-inhibit* - *gc-pending*)) + (append + *common-static-symbols* + *c-callable-static-symbols* + '())) (defparameter *static-funs* '(length diff --git a/src/compiler/x86-64/parms.lisp b/src/compiler/x86-64/parms.lisp index 2afd891..eed4cfe 100644 --- a/src/compiler/x86-64/parms.lisp +++ b/src/compiler/x86-64/parms.lisp @@ -159,83 +159,47 @@ (defvar *allocation-pointer*) (defvar *binding-stack-pointer*) -;;; FIXME: !COLD-INIT probably doesn't need -;;; to be in the static symbols table any more. -;;; -;;; FIXME: some of these symbols are shared by all backends, -;;; and should be factored out into a common file. (defparameter *static-symbols* - '(t - - ;; The C startup code must fill these in. - *posix-argv* - - ;; functions that the C code needs to call. When adding to this list, - ;; also add a `frob' form in genesis.lisp finish-symbols. - sub-gc - sb!kernel::internal-error - sb!kernel::control-stack-exhausted-error - sb!kernel::undefined-alien-variable-error - sb!kernel::undefined-alien-function-error - sb!kernel::memory-fault-error - sb!di::handle-breakpoint - fdefinition-object - - ;; free pointers - ;; - ;; Note that these are FIXNUM word counts, not (as one might - ;; expect) byte counts or SAPs. The reason seems to be that by - ;; representing them this way, we can avoid consing bignums. - ;; -- WHN 2000-10-02 - *read-only-space-free-pointer* - *static-space-free-pointer* - *initial-dynamic-space-free-pointer* - - ;; things needed for non-local exit - *current-catch-block* - *current-unwind-protect-block* - *alien-stack* - - ;; interrupt handling - *pseudo-atomic-atomic* - *pseudo-atomic-interrupted* - sb!unix::*interrupts-enabled* - sb!unix::*interrupt-pending* - *free-interrupt-context-index* - *gc-inhibit* - #!+sb-thread *stop-for-gc-pending* - *gc-pending* - #!+sb-thread sb!thread::run-interruption - - *free-tls-index* - *tls-index-lock* - - *allocation-pointer* - *binding-stack-pointer* - *binding-stack-start* - *control-stack-start* - *control-stack-end* - - ;; the floating point constants - *fp-constant-0d0* - *fp-constant-1d0* - *fp-constant-0f0* - *fp-constant-1f0* - - ;; For GC-AND-SAVE - *restart-lisp-function* - - ;; Needed for callbacks to work across saving cores. see - ;; ALIEN-CALLBACK-ASSEMBLER-WRAPPER in c-call.lisp for gory details. - sb!alien::*enter-alien-callback* - - ;; The ..SLOT-UNBOUND.. symbol is static in order to optimise the - ;; common slot unbound check. - ;; - ;; FIXME: In SBCL, the CLOS code has become sufficiently tightly - ;; integrated into the system that it'd probably make sense to use - ;; the ordinary unbound marker for this. - sb!pcl::..slot-unbound..)) + (append + *common-static-symbols* + *c-callable-static-symbols* + '(*alien-stack* + + ;; interrupt handling + *pseudo-atomic-atomic* + *pseudo-atomic-interrupted* + + #!+sb-thread *stop-for-gc-pending* + + #!+sb-thread *free-tls-index* + #!+sb-thread *tls-index-lock* + + *allocation-pointer* + *binding-stack-pointer* + + ;; the floating point constants + *fp-constant-0d0* + *fp-constant-1d0* + *fp-constant-0f0* + *fp-constant-1f0* + + ;; For GC-AND-SAVE + *restart-lisp-function* + + ;; Needed for callbacks to work across saving cores. see + ;; ALIEN-CALLBACK-ASSEMBLER-WRAPPER in c-call.lisp for gory + ;; details. + sb!alien::*enter-alien-callback* + + ;; The ..SLOT-UNBOUND.. symbol is static in order to optimise the + ;; common slot unbound check. + ;; + ;; FIXME: In SBCL, the CLOS code has become sufficiently tightly + ;; integrated into the system that it'd probably make sense to + ;; use the ordinary unbound marker for this. + ;; + ;; FIXME II: if it doesn't make sense, why is this X86-ish only? + sb!pcl::..slot-unbound..))) (defparameter *static-funs* '(length diff --git a/src/compiler/x86/parms.lisp b/src/compiler/x86/parms.lisp index 3f9952d..171431d 100644 --- a/src/compiler/x86/parms.lisp +++ b/src/compiler/x86/parms.lisp @@ -305,90 +305,47 @@ (defvar *allocation-pointer*) (defvar *binding-stack-pointer*) -;;; FIXME: !COLD-INIT probably doesn't need -;;; to be in the static symbols table any more. (defparameter *static-symbols* - '(t - - ;; The C startup code must fill these in. - *posix-argv* - - ;; functions that the C code needs to call. When adding to this list, - ;; also add a `frob' form in genesis.lisp finish-symbols. - sub-gc - sb!kernel::internal-error - sb!kernel::control-stack-exhausted-error - sb!kernel::undefined-alien-variable-error - sb!kernel::undefined-alien-function-error - sb!kernel::memory-fault-error - sb!di::handle-breakpoint - fdefinition-object - #!+win32 sb!kernel::handle-win32-exception - - ;; free pointers - ;; - ;; Note that these are FIXNUM word counts, not (as one might - ;; expect) byte counts or SAPs. The reason seems to be that by - ;; representing them this way, we can avoid consing bignums. - ;; -- WHN 2000-10-02 - *read-only-space-free-pointer* - *static-space-free-pointer* - *initial-dynamic-space-free-pointer* - - ;; things needed for non-local exit - *current-catch-block* - *current-unwind-protect-block* - *alien-stack* - - ;; interrupt handling - *pseudo-atomic-atomic* - *pseudo-atomic-interrupted* - sb!unix::*interrupts-enabled* - sb!unix::*interrupt-pending* - *free-interrupt-context-index* - *gc-inhibit* - #!+sb-thread *stop-for-gc-pending* - *gc-pending* - #!+sb-thread sb!thread::run-interruption - - *free-tls-index* - *tls-index-lock* - - *allocation-pointer* - *binding-stack-pointer* - *binding-stack-start* - *control-stack-start* - *control-stack-end* - - ;; the floating point constants - *fp-constant-0d0* - *fp-constant-1d0* - *fp-constant-0f0* - *fp-constant-1f0* - ;; The following are all long-floats. - *fp-constant-0l0* - *fp-constant-1l0* - *fp-constant-pi* - *fp-constant-l2t* - *fp-constant-l2e* - *fp-constant-lg2* - *fp-constant-ln2* - - ;; For GC-AND-SAVE - *restart-lisp-function* - - ;; Needed for callbacks to work across saving cores. see - ;; ALIEN-CALLBACK-ASSEMBLER-WRAPPER in c-call.lisp for gory details. - sb!alien::*enter-alien-callback* - - ;; The ..SLOT-UNBOUND.. symbol is static in order to optimise the - ;; common slot unbound check. - ;; - ;; FIXME: In SBCL, the CLOS code has become sufficiently tightly - ;; integrated into the system that it'd probably make sense to use - ;; the ordinary unbound marker for this. - sb!pcl::..slot-unbound.. - )) + (append + *common-static-symbols* + *c-callable-static-symbols* + '(*alien-stack* + + ;; interrupt handling + *pseudo-atomic-atomic* + *pseudo-atomic-interrupted* + #!+sb-thread *stop-for-gc-pending* + #!+sb-thread *free-tls-index* + #!+sb-thread *tls-index-lock* + + *allocation-pointer* + *binding-stack-pointer* + + ;; the floating point constants + *fp-constant-0d0* + *fp-constant-1d0* + *fp-constant-0f0* + *fp-constant-1f0* + ;; The following are all long-floats. + *fp-constant-0l0* + *fp-constant-1l0* + *fp-constant-pi* + *fp-constant-l2t* + *fp-constant-l2e* + *fp-constant-lg2* + *fp-constant-ln2* + + ;; For GC-AND-SAVE + *restart-lisp-function* + + ;; Needed for callbacks to work across saving cores. see + ;; ALIEN-CALLBACK-ASSEMBLER-WRAPPER in c-call.lisp for gory + ;; details. + sb!alien::*enter-alien-callback* + + ;; see comments in ../x86-64/parms.lisp + sb!pcl::..slot-unbound.. + ))) (defparameter *static-funs* '(length diff --git a/src/runtime/runtime.c b/src/runtime/runtime.c index 50a5ba8..4c5434e 100644 --- a/src/runtime/runtime.c +++ b/src/runtime/runtime.c @@ -365,8 +365,6 @@ main(int argc, char *argv[], char *envp[]) if (initial_function == NIL) { lose("couldn't find initial function\n"); } - SHOW("freeing core"); - free(core); gc_initialize_pointers(); @@ -378,6 +376,11 @@ main(int argc, char *argv[], char *envp[]) wos_install_interrupt_handlers(&exception_frame); #endif + /* Pass core filename into Lisp */ + SetSymbolValue(CORE_STRING, alloc_base_string(core),0); + SHOW("freeing core"); + free(core); + /* Convert remaining argv values to something that Lisp can grok. */ SHOW("setting POSIX-ARGV symbol value"); SetSymbolValue(POSIX_ARGV, alloc_base_string_list(sbcl_argv),0); diff --git a/version.lisp-expr b/version.lisp-expr index a7bca37..3a9ba11 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.10.38" +"0.9.10.39"