X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fsave.lisp;h=7568ede062b9145d594feac34b53049c969ce41d;hb=0f3a5f2e8886d18d0b4f6485c38a42be629422ae;hp=d4f183ef32e140842ad9927cda4ed1ee1caeab97;hpb=26987375eb9dae6e9b15084e317a04a6509dd05f;p=sbcl.git diff --git a/src/code/save.lisp b/src/code/save.lisp index d4f183e..7568ede 100644 --- a/src/code/save.lisp +++ b/src/code/save.lisp @@ -21,13 +21,19 @@ (file c-string) (initial-fun (unsigned #.sb!vm:n-word-bits)) (prepend-runtime int) - (save-runtime-options 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)) + (save-runtime-options int) + (compressed int) + (compression-level int) + (application-type int)) #!+gencgc (defvar sb!vm::*restart-lisp-function*) @@ -38,7 +44,10 @@ (save-runtime-options nil) (purify t) (root-structures ()) - (environment-name "auxiliary")) + (environment-name "auxiliary") + (compression nil) + #!+win32 + (application-type :console)) #!+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. @@ -49,8 +58,11 @@ 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. + 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 @@ -85,6 +97,19 @@ The following &KEY arguments are defined: 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. @@ -95,7 +120,7 @@ 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. -SAVE-LISP-AND-DIE interacts with SB-ALIEN:LOAD-FOREIGN-OBJECT: see its +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 @@ -116,6 +141,13 @@ 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 @@ -130,20 +162,37 @@ sufficiently motivated to do lengthy fixes." (foreign-bool (value) (if value 1 0)) (save-core (gc) - (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 (unix-namestring core-file-name nil) - (foreign-bool executable) - (foreign-bool save-runtime-options))) - (without-gcing - (save (unix-namestring core-file-name nil) - (get-lisp-obj-address #'restart-lisp) - (foreign-bool executable) - (foreign-bool save-runtime-options))))) + (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 @@ -157,15 +206,21 @@ sufficiently motivated to do lengthy fixes." ;; Compact the environment even though we're skipping the ;; other purification stages. (sb!kernel::compact-environment-aux "Auxiliary" 200) - (save-core t))))) + (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) - (debug-deinit) (foreign-deinit) (stream-deinit) - (deinit-finalizers)) + (deinit-finalizers) + (drop-all-hash-caches))