X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fsave.lisp;h=1e83ab3f18e6149dadcdcda7f802b5b9a9dd86be;hb=25fe91bf63fd473d9316675b0e0ca9be0079e9eb;hp=da69f135f347efb5ec168443ba196f2b12ef7a57;hpb=8977ab898eab890a11eb9b4bab72c42561f0dc22;p=sbcl.git

diff --git a/src/code/save.lisp b/src/code/save.lisp
index da69f13..1e83ab3 100644
--- a/src/code/save.lisp
+++ b/src/code/save.lisp
@@ -19,11 +19,13 @@
 
 (define-alien-routine "save" (boolean)
   (file c-string)
-  (initial-fun (unsigned #.sb!vm:n-word-bits)))
+  (initial-fun (unsigned #.sb!vm:n-word-bits))
+  (prepend-runtime int))
 
 #!+gencgc
 (define-alien-routine "gc_and_save" void
-  (file c-string))
+  (file c-string)
+  (prepend-runtime int))
 
 #!+gencgc
 (defvar sb!vm::*restart-lisp-function*)
@@ -33,7 +35,8 @@
                                          (purify #!+gencgc nil
                                                  #!-gencgc t)
                                          (root-structures ())
-                                         (environment-name "auxiliary"))
+                                         (environment-name "auxiliary")
+                                         (executable nil))
   #!+sb-doc
   "Save a \"core image\", i.e. enough information to restart a Lisp
 process later in the same state, in the file of the specified name.
@@ -47,6 +50,11 @@ The following &KEY arguments are defined:
      and runs the top level read-eval-print loop. This function should
      not return.
 
+  :EXECUTABLE
+     If true, arrange to combine the SBCL runtime and the core image
+     to create a standalone executable.  If false (the default), the
+     core image will not be executable on its own.
+
   :PURIFY
      If true (the default on cheneygc), do a purifying GC which moves all
      dynamically allocated objects into static space. This takes
@@ -77,19 +85,22 @@ The save/load process changes the values of some global variables:
     This is reinitialized to reflect the working directory where the
     saved core is loaded.
 
-Foreign objects loaded with SB-ALIEN:LOAD-SHARED-OBJECT are
-automatically reloaded on startup, but references to foreign symbols
-do not survive intact on all platforms: in this case a WARNING is
-signalled when saving the core. If no warning is signalled, then the
-foreign symbol references will remain intact. Platforms where this is
-currently the case are x86/FreeBSD, x86/Linux, x86/NetBSD,
-sparc/Linux, sparc/SunOS, and ppc/Darwin.
+Foreign objects loaded with SB-ALIEN:LOAD-SHARED-OBJECT are automatically
+reloaded on startup, but references to foreign symbols do not survive intact
+on all platforms: in this case a WARNING is signalled when saving the core. If
+no warning is signalled, then the foreign symbol references will remain
+intact. Platforms where this is currently the case are x86/FreeBSD, x86/Linux,
+x86/NetBSD, sparc/Linux, sparc/SunOS, and ppc/Darwin.
+
+On threaded platforms only a single thread may remain running after
+SB-EXT:*SAVE-HOOKS* have run. Applications using multiple threads can
+be SAVE-LISP-AND-DIE friendly by registering a save-hook that quits
+any additional threads, and an init-hook that restarts them.
 
 This implementation is not as polished and painless as you might like:
   * It corrupts the current Lisp image enough that the current process
     needs to be killed afterwards. This can be worked around by forking
     another process that saves the core.
-  * It will not work if multiple threads are in use.
   * There is absolutely no binary compatibility of core images between
     different runtime support programs. Even runtimes built from the same
     sources at different times are treated as incompatible for this
@@ -113,26 +124,36 @@ sufficiently motivated to do lengthy fixes."
                ;; A normal GC will leave huge amounts of storage unreclaimed
                ;; (over 50% on x86). This needs to be done by a single function
                ;; since the GC will invalidate the stack.
-               #!+gencgc (gc-and-save (unix-namestring core-file-name nil)))
+               #!+gencgc (gc-and-save (unix-namestring core-file-name nil)
+                                      (if executable 1 0)))
              (without-gcing
               (save (unix-namestring core-file-name nil)
-                    (get-lisp-obj-address #'restart-lisp)))))
+                    (get-lisp-obj-address #'restart-lisp)
+                    (if executable 1 0)))))
     ;; Save the restart function into a static symbol, to allow GC-AND-SAVE
     ;; access to it even after the GC has moved it.
+    #!+gencgc
     (setf sb!vm::*restart-lisp-function* #'restart-lisp)
     (cond (purify
            (purify :root-structures root-structures
                    :environment-name environment-name)
            (save-core nil))
           (t
+           ;; Compact the environment even though we're skipping the
+           ;; other purification stages.
+           (sb!kernel::compact-environment-aux "Auxiliary" 200)
            (save-core t)))))
 
 (defun deinit ()
   (dolist (hook *save-hooks*)
     (with-simple-restart (continue "Skip this save hook.")
       (funcall hook)))
+  (when (rest (sb!thread:list-all-threads))
+    (error "Cannot save core with multiple threads running."))
+  #!-win32
   (when (fboundp 'cancel-finalization)
     (cancel-finalization sb!sys:*tty*))
+  (float-deinit)
   (profile-deinit)
   (debug-deinit)
   (foreign-deinit))