Add :application-type parameter for save-lisp-and-die on Windows.
[sbcl.git] / src / code / save.lisp
index 7f0abb0..7568ede 100644 (file)
 
 (in-package "SB!IMPL")
 \f
-(defvar *before-save-initializations* nil
-  #!+sb-doc
-  "This is a list of functions which are called before creating a saved core
-  image. These functions are executed in the child process which has no ports,
-  so they cannot do anything that tries to talk to the outside world.")
-
-(defvar *after-save-initializations* nil
-  #!+sb-doc
-  "This is a list of functions which are called when a saved core image starts
-  up. The system itself should be initialized at this point, but applications
-  might not be.")
-\f
 ;;;; SAVE-LISP-AND-DIE itself
 
-(sb!alien:def-alien-routine "save" (sb!alien:boolean)
-  (file sb!c-call:c-string)
-  (initial-function (sb!alien:unsigned #.sb!vm:word-bits)))
+(define-alien-routine "save" (boolean)
+  (file c-string)
+  (initial-fun (unsigned #.sb!vm:n-word-bits))
+  (prepend-runtime int)
+  (save-runtime-options int)
+  (compressed int)
+  (compression-level int)
+  (application-type int))
+
+#!+gencgc
+(define-alien-routine "gc_and_save" void
+  (file c-string)
+  (prepend-runtime int)
+  (save-runtime-options int)
+  (compressed int)
+  (compression-level int)
+  (application-type int))
+
+#!+gencgc
+(defvar sb!vm::*restart-lisp-function*)
 
-;;; FIXME: When this is run without the PURIFY option,
-;;; it seems to save memory all the way up to the high-water mark,
-;;; not just what's currently used; and then after loading the
-;;; image to make a running Lisp, the memory never gets reclaimed.
-;;; (But with the PURIFY option it seems to work OK.)
 (defun save-lisp-and-die (core-file-name &key
-                                        (toplevel #'toplevel-init)
-                                        (purify nil)
-                                        (root-structures ())
-                                        (environment-name "auxiliary"))
+                                         (toplevel #'toplevel-init)
+                                         (executable nil)
+                                         (save-runtime-options nil)
+                                         (purify t)
+                                         (root-structures ())
+                                         (environment-name "auxiliary")
+                                         (compression nil)
+                                         #!+win32
+                                         (application-type :console))
   #!+sb-doc
-  "Saves a CMU Common Lisp core image in the file of the specified name,
-  killing the current Lisp invocation in the process (unless it bails
-  out early because of some argument error or something).
+  "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.
+Only global state is preserved: the stack is unwound in the process.
 
-  The following keyword args are defined:
+The following &KEY arguments are defined:
 
   :TOPLEVEL
-      The function to run when the created core file is resumed.
-  The default function handles command line toplevel option
-  processing and runs the top level read-eval-print loop. This
-  function should not return.
+     The function to run when the created core file is resumed. The
+     default function handles command line toplevel option processing
+     and runs the top level read-eval-print loop. This function returning
+     is equivalent to (SB-EXT:EXIT :CODE 0) being called.
+
+     TOPLEVEL functions should always provide an ABORT restart: otherwise
+     code they call will run without one.
+
+  :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. Executable images
+     always behave as if they were passed the --noinform runtime option.
+
+  :SAVE-RUNTIME-OPTIONS
+     If true, values of runtime options --dynamic-space-size and
+     --control-stack-size that were used to start SBCL are stored in
+     the standalone executable, and restored when the executable is
+     run. This also inhibits normal runtime option processing, causing
+     all command line arguments to be passed to the toplevel.
+     Meaningless if :EXECUTABLE is NIL.
 
   :PURIFY
-      If true (the default), do a purifying GC which moves all dynamically
-  allocated objects into static space so that they stay pure. This takes
-  somewhat longer than the normal GC which is otherwise done, but it's only
-  done once, and subsequent GC's will be done less often and will take less
-  time in the resulting core file. See PURIFY.
+     If true (the default on cheneygc), do a purifying GC which moves all
+     dynamically allocated objects into static space. This takes
+     somewhat longer than the normal GC which is otherwise done, but
+     it's only done once, and subsequent GC's will be done less often
+     and will take less time in the resulting core file. See the PURIFY
+     function. This parameter has no effect on platforms using the
+     generational garbage collector.
 
   :ROOT-STRUCTURES
-      This should be a list of the main entry points in any newly loaded
-  systems. This need not be supplied, but locality and/or GC performance
-  may be better if they are. Meaningless if :PURIFY is NIL. See PURIFY.
+     This should be a list of the main entry points in any newly loaded
+     systems. This need not be supplied, but locality and/or GC performance
+     may be better if they are. Meaningless if :PURIFY is NIL. See the
+     PURIFY function.
 
   :ENVIRONMENT-NAME
-      This is also passed to PURIFY when :PURIFY is T. (rarely used)"
-
-  #!+mp (sb!mp::shutdown-multi-processing)
-  (when (fboundp 'sb!eval:flush-interpreted-function-cache)
-    (sb!eval:flush-interpreted-function-cache))
-  ;; FIXME: What is this for? Explain.
-  (when (fboundp 'cancel-finalization)
-    (cancel-finalization sb!sys:*tty*))
+     This is also passed to the PURIFY function when :PURIFY is T.
+     (rarely used)
+
+  :COMPRESSION
+     This is only meaningful if the runtime was built with the :SB-CORE-COMPRESSION
+     feature enabled. If NIL (the default), saves to uncompressed core files. If
+     :SB-CORE-COMPRESSION was enabled at build-time, the argument may also be
+     an integer from -1 to 9, corresponding to zlib compression levels, or T
+     (which is equivalent to the default compression level, -1).
+
+  :APPLICATION-TYPE
+     Present only on Windows and is meaningful only with :EXECUTABLE T.
+     Specifies the subsystem of the executable, :CONSOLE or :GUI.
+     The notable difference is that :GUI doesn't automatically create a console
+     window. The default is :CONSOLE.
+
+The save/load process changes the values of some global variables:
+
+  *STANDARD-OUTPUT*, *DEBUG-IO*, etc.
+    Everything related to open streams is necessarily changed, since
+    the OS won't let us preserve a stream across save and load.
+
+  *DEFAULT-PATHNAME-DEFAULTS*
+    This is reinitialized to reflect the working directory where the
+    saved core is loaded.
+
+SAVE-LISP-AND-DIE interacts with SB-ALIEN:LOAD-SHARED-OBJECT: see its
+documentation for details.
+
+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.
+  * 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
+    purpose.
+This isn't because we like it this way, but just because there don't
+seem to be good quick fixes for either limitation and no one has been
+sufficiently motivated to do lengthy fixes."
+  #!+gencgc
+  (declare (ignore purify root-structures environment-name))
+  #!+sb-core-compression
+  (check-type compression (or boolean (integer -1 9)))
+  #!-sb-core-compression
+  (when compression
+    (error "Unable to save compressed core: this runtime was not built with zlib support"))
+  (when (eql t compression)
+    (setf compression -1))
+  (tune-hashtable-sizes-of-all-packages)
+  (deinit)
   ;; FIXME: Would it be possible to unmix the PURIFY logic from this
   ;; function, and just do a GC :FULL T here? (Then if the user wanted
   ;; a PURIFYed image, he'd just run PURIFY immediately before calling
   ;; SAVE-LISP-AND-DIE.)
-  (if purify
-      (purify :root-structures root-structures
-             :environment-name environment-name)
-      #!-gencgc (gc) #!+gencgc (gc :full t))
-  ;; FIXME: Wouldn't it be more correct to go through this list backwards
-  ;; instead of forwards?
-  (dolist (f *before-save-initializations*)
-    (funcall f))
-  (flet ((restart-lisp ()
-           (handling-end-of-the-world
-            (reinit)
-            (dolist (f *after-save-initializations*)
-              (funcall f))
-            (funcall toplevel))))
-    ;; FIXME: Perhaps WITHOUT-GCING should be wrapped around the
-    ;; LET as well, to avoid the off chance of an interrupt triggering
-    ;; GC and making our saved RESTART-LISP address invalid?
-    (without-gcing
-      (save (unix-namestring core-file-name nil)
-           (get-lisp-obj-address #'restart-lisp)))))
-\f
-;;;; functions used by worldload.lisp in CMU CL bootstrapping
-
-;;; If Name has been byte-compiled, and :RUNTIME is a feature, then load the
-;;; byte-compiled version, otherwise just do normal load.
-#+nil ; no longer needed in SBCL.. I think.. -- WHN 19990814
-(defun maybe-byte-load (name &optional (load-native t))
-  (let ((bname (make-pathname
-               :defaults name
-               :type #.(sb!c:backend-byte-fasl-file-type))))
-    (cond ((and (featurep :runtime)
-               (probe-file bname))
-          (load bname))
-         (load-native
-          (load name)))))
-
-;;; Replace a cold-loaded native object file with a byte-compiled one, if it
-;;; exists.
-#+nil ; no longer needed in SBCL.. I think.. -- WHN 19990814
-(defun byte-load-over (name)
-  (load (make-pathname
-        :defaults name
-        :type #.(sb!c:backend-byte-fasl-file-type))
-       :if-does-not-exist nil))
+  (labels ((restart-lisp ()
+             (handling-end-of-the-world
+               (reinit)
+               #!+hpux (sb!sys:%primitive sb!vm::setup-return-from-lisp-stub)
+               (funcall toplevel)))
+           (foreign-bool (value)
+             (if value 1 0))
+           (save-core (gc)
+             (let ((name (native-namestring
+                          (physicalize-pathname core-file-name)
+                          :as-file t)))
+               (when gc
+                 #!-gencgc (gc)
+                 ;; Do a destructive non-conservative GC, and then save a core.
+                 ;; 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 name
+                                        (foreign-bool executable)
+                                        (foreign-bool save-runtime-options)
+                                        (foreign-bool compression)
+                                        (or compression 0)
+                                        #!+win32
+                                        (ecase application-type
+                                          (:console 0)
+                                          (:gui 1))
+                                        #!-win32 0))
+               (without-gcing
+                 (save name
+                       (get-lisp-obj-address #'restart-lisp)
+                       (foreign-bool executable)
+                       (foreign-bool save-runtime-options)
+                       (foreign-bool compression)
+                       (or compression 0)
+                       #!+win32
+                       (ecase application-type
+                         (:console 0)
+                         (:gui 1))
+                       #!-win32 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 #!-gencgc
+          (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)))
+    ;; Something went very wrong -- reinitialize to have a prayer
+    ;; of being able to report the error.
+    (reinit)
+    (error "Could not save core.")))
+
+(defun deinit ()
+  (call-hooks "save" *save-hooks*)
+  #!+sb-wtimer
+  (itimer-emulation-deinit)
+  (when (rest (sb!thread:list-all-threads))
+    (error "Cannot save core with multiple threads running."))
+  (float-deinit)
+  (profile-deinit)
+  (foreign-deinit)
+  (stream-deinit)
+  (deinit-finalizers)
+  (drop-all-hash-caches))