X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fsave.lisp;h=8d414eaf807869fcacab2b22f7efd229a3dc3e1e;hb=54da325f13fb41669869aea688ae195426c0e231;hp=beb928666e4e4c55f7a0a98e2fb69adbff8a3e9f;hpb=ce02ab2ecd9c6ae2e570abd8c93ebf3be55bbdad;p=sbcl.git diff --git a/src/code/save.lisp b/src/code/save.lisp index beb9286..8d414ea 100644 --- a/src/code/save.lisp +++ b/src/code/save.lisp @@ -15,113 +15,192 @@ (in-package "SB!IMPL") -(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.") - ;;;; 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)) + +#!+gencgc +(define-alien-routine "gc_and_save" void + (file c-string) + (prepend-runtime int) + (save-runtime-options int) + (compressed int) + (compression-level 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)) #!+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 &KEY 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). + +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))))) - -;;;; 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))) + (without-gcing + (save name + (get-lisp-obj-address #'restart-lisp) + (foreign-bool executable) + (foreign-bool save-runtime-options) + (foreign-bool compression) + (or compression 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))