Add :application-type parameter for save-lisp-and-die on Windows.

Allows to choose the executable subsystem type, :console or :gui.
Default is :console.

diff --git a/NEWS b/NEWS
index 2f214c7..034b9fa 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,8 @@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
 changes relative to sbcl-1.1.14:
+  * enhancement: sb-ext:save-lisp-and-die on Windows now accepts
+    :application-type argument, which can be :console or :gui. :gui allows
+    having GUI applications without an automatically appearing console window.
   * bug fix: Windows applications without the console window no longer misbehave.
     (patch by Wilfredo Velazquez, lp#1256034).
 

diff --git a/src/code/save.lisp b/src/code/save.lisp
index 8d414ea..7568ede 100644 (file)
--- a/src/code/save.lisp
+++ b/src/code/save.lisp
@@ -23,7 +23,8 @@
   (prepend-runtime int)
   (save-runtime-options int)
   (compressed int)
-  (compression-level int))
+  (compression-level int)
+  (application-type int))
 
 #!+gencgc
 (define-alien-routine "gc_and_save" void
@@ -31,7 +32,8 @@
   (prepend-runtime int)
   (save-runtime-options int)
   (compressed int)
-  (compression-level int))
+  (compression-level int)
+  (application-type int))
 
 #!+gencgc
 (defvar sb!vm::*restart-lisp-function*)
@@ -43,7 +45,9 @@
                                          (purify t)
                                          (root-structures ())
                                          (environment-name "auxiliary")
-                                         (compression nil))
+                                         (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.
@@ -100,6 +104,12 @@ The following &KEY arguments are defined:
      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.
@@ -165,14 +175,24 @@ sufficiently motivated to do lengthy fixes."
                                         (foreign-bool executable)
                                         (foreign-bool save-runtime-options)
                                         (foreign-bool compression)
-                                        (or compression 0)))
+                                        (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))))))
+                       (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

diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c
index fbaaa9e..5d218b1 100644 (file)
--- a/src/runtime/gencgc.c
+++ b/src/runtime/gencgc.c
@@ -4531,8 +4531,8 @@ prepare_for_final_gc ()
  * SB!VM:RESTART-LISP-FUNCTION */
 void
 gc_and_save(char *filename, boolean prepend_runtime,
-            boolean save_runtime_options,
-            boolean compressed, int compression_level)
+            boolean save_runtime_options, boolean compressed,
+            int compression_level, int application_type)
 {
     FILE *file;
     void *runtime_bytes = NULL;
@@ -4562,7 +4562,8 @@ gc_and_save(char *filename, boolean prepend_runtime,
     collect_garbage(HIGHEST_NORMAL_GENERATION+1);
 
     if (prepend_runtime)
-        save_runtime_to_filehandle(file, runtime_bytes, runtime_size);
+        save_runtime_to_filehandle(file, runtime_bytes, runtime_size,
+                                   application_type);
 
     /* The dumper doesn't know that pages need to be zeroed before use. */
     zero_all_free_pages();

diff --git a/src/runtime/save.c b/src/runtime/save.c
index f4da52e..3795d2e 100644 (file)
--- a/src/runtime/save.c
+++ b/src/runtime/save.c
@@ -435,11 +435,35 @@ lose:
 }
 
 boolean
-save_runtime_to_filehandle(FILE *output, void *runtime, size_t runtime_size)
+save_runtime_to_filehandle(FILE *output, void *runtime, size_t runtime_size,
+                           int application_type)
 {
     size_t padding;
     void *padbytes;
 
+#ifdef LISP_FEATURE_WIN32
+    {
+        PIMAGE_DOS_HEADER dos_header = (PIMAGE_DOS_HEADER)runtime;
+        PIMAGE_NT_HEADERS nt_header = (PIMAGE_NT_HEADERS)((char *)dos_header +
+                                                          dos_header->e_lfanew);
+
+        int sub_system;
+        switch (application_type) {
+        case 0:
+            sub_system = IMAGE_SUBSYSTEM_WINDOWS_CUI;
+            break;
+        case 1:
+            sub_system = IMAGE_SUBSYSTEM_WINDOWS_GUI;
+            break;
+        default:
+            fprintf(stderr, "Invalid application type %d\n", application_type);
+            return 0;
+        }
+
+        nt_header->OptionalHeader.Subsystem = sub_system;
+    }
+#endif
+
     if (runtime_size != fwrite(runtime, 1, runtime_size, output)) {
         perror("Error saving runtime");
         return 0;
@@ -498,7 +522,8 @@ prepare_to_save(char *filename, boolean prepend_runtime, void **runtime_bytes,
 
 boolean
 save(char *filename, lispobj init_function, boolean prepend_runtime,
-     boolean save_runtime_options, boolean compressed, int compression_level)
+     boolean save_runtime_options, boolean compressed, int compression_level,
+     int application_type)
 {
     FILE *file;
     void *runtime_bytes = NULL;
@@ -509,7 +534,7 @@ save(char *filename, lispobj init_function, boolean prepend_runtime,
         return 1;
 
     if (prepend_runtime)
-        save_runtime_to_filehandle(file, runtime_bytes, runtime_size);
+        save_runtime_to_filehandle(file, runtime_bytes, runtime_size, application_type);
 
     return save_to_filehandle(file, filename, init_function, prepend_runtime,
                               save_runtime_options,

diff --git a/src/runtime/save.h b/src/runtime/save.h
index 0327efa..28b5967 100644 (file)
--- a/src/runtime/save.h
+++ b/src/runtime/save.h
@@ -19,12 +19,14 @@
 extern FILE* open_core_for_saving(char *filename);
 extern void *load_runtime(char *runtime_path, size_t *size_out);
 extern FILE *prepare_to_save(char *filename, boolean prepend_runtime, void **runtime_bytes, size_t *runtime_size);
-extern boolean save_runtime_to_filehandle(FILE *output, void *runtime_bytes, size_t runtime_size);
+extern boolean save_runtime_to_filehandle(FILE *output, void *runtime_bytes,
+                                          size_t runtime_size, int application_type);
 extern boolean save_to_filehandle(FILE *file, char *filename, lispobj initfun,
                                   boolean make_executable, boolean keep_runtime_options,
                                   int core_compression_level);
 extern boolean save(char *filename, lispobj initfun, boolean prepend_runtime,
                     boolean keep_runtime_options,
-                    boolean compressed_core, int core_compression_level);
+                    boolean compressed_core, int core_compression_level,
+                    int application_type);
 
 #endif