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.

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

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)

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

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

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*"

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

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"))

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*

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

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

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

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

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

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))