0.9.9.12:
authorJuho Snellman <jsnell@iki.fi>
Sun, 5 Feb 2006 22:03:00 +0000 (22:03 +0000)
committerJuho Snellman <jsnell@iki.fi>
Sun, 5 Feb 2006 22:03:00 +0000 (22:03 +0000)
        New SAVE-LISP-AND-DIE keyword argument :EXECUTABLE can be used
        for bundling the runtime and the core file into one executable
        binary. This feature is not currently supported on all SBCL
        platforms.  (thanks to James Bielman)

17 files changed:
NEWS
src/code/save.lisp
src/runtime/bsd-os.c
src/runtime/core.h
src/runtime/coreparse.c
src/runtime/gencgc.c
src/runtime/linux-os.c
src/runtime/os.h
src/runtime/osf1-os.c
src/runtime/ppc-darwin-os.c
src/runtime/runtime.c
src/runtime/runtime.h
src/runtime/save.c
src/runtime/save.h
src/runtime/sunos-os.c
src/runtime/win32-os.c
version.lisp-expr

diff --git a/NEWS b/NEWS
index 855f210..daa7a7a 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,9 @@
 ;;;; -*- coding: utf-8; -*-
 changes in sbcl-0.9.10 relative to sbcl-0.9.9:
+  * new feature: new SAVE-LISP-AND-DIE keyword argument :EXECUTABLE can
+    be used for bundling the runtime and the core file into one 
+    executable binary. This feature is not currently supported on all SBCL
+    platforms.  (thanks to James Bielman)
   * minor incompatible change: the method by which SBCL finds its
     contributed modules has changed; it no longer relies on symbolic
     links from an $SBCL_HOME/systems directory, but searches directly
index cff44fc..77a9f1c 100644 (file)
 
 (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
@@ -113,10 +121,12 @@ 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
index 0bd5fc9..9b25e7b 100644 (file)
@@ -335,3 +335,11 @@ int arch_os_thread_cleanup(struct thread *thread) {
     return 1;                  /* success */
 }
 #endif
+
+#ifndef LISP_FEATURE_DARWIN   /* defined in ppc-darwin-os.c instead */
+char *
+os_get_runtime_executable_path()
+{
+    return NULL;
+}
+#endif
index e7484c3..57df1cb 100644 (file)
@@ -31,7 +31,8 @@ struct ndir_entry {
 #endif
 };
 
-extern lispobj load_core_file(char *file);
+extern lispobj load_core_file(char *file, os_vm_offset_t offset);
+extern os_vm_offset_t search_for_embedded_core(char *file);
 
 /* arbitrary string identifying this build, embedded in .core files to
  * prevent people mismatching a runtime built e.g. with :SB-SHOW
index 07d1525..07b96ae 100644 (file)
@@ -43,8 +43,69 @@ unsigned char build_id[] =
 #include "../../output/build-id.tmp"
 ;
 
+int
+open_binary(char *filename, int mode)
+{
+#ifdef LISP_FEATURE_WIN32
+    mode |= O_BINARY;
+#endif
+
+    return open(filename, mode);
+}
+
+/* Search 'filename' for an embedded core.  An SBCL core has, at the
+ * end of the file, a trailer containing the size of the core (an
+ * os_vm_offset_t) and a final signature word (the lispobj
+ * CORE_MAGIC).  If this trailer is found at the end of the file, the
+ * start of the core can be determined from the core size.
+ *
+ * If an embedded core is present, this returns the offset into the
+ * file to load the core from, or -1 if no core is present. */
+os_vm_offset_t
+search_for_embedded_core(char *filename)
+{
+    lispobj header;
+    os_vm_offset_t lispobj_size = sizeof(lispobj);
+    os_vm_offset_t trailer_size = lispobj_size + sizeof(os_vm_offset_t);
+    os_vm_offset_t core_size, pos;
+    int fd = -1;
+
+    if ((fd = open_binary(filename, O_RDONLY)) < 0)
+        goto lose;
+    if (lseek(fd, -lispobj_size, SEEK_END) < 0)
+        goto lose;
+    if (read(fd, &header, (size_t)lispobj_size) < lispobj_size)
+        goto lose;
+
+    if (header == CORE_MAGIC) {
+        if (lseek(fd, -trailer_size, SEEK_END) < 0)
+            goto lose;
+        if (read(fd, &core_size, sizeof(os_vm_offset_t)) < 0)
+            goto lose;
+
+        if (lseek(fd, -(core_size + trailer_size), SEEK_END) < 0)
+            goto lose;
+        pos = lseek(fd, 0, SEEK_CUR);
+
+        if (read(fd, &header, (size_t)lispobj_size) < lispobj_size)
+            goto lose;
+
+        if (header != CORE_MAGIC)
+            goto lose;
+
+        close(fd);
+        return pos;
+    }
+
+lose:
+    if (fd != -1)
+        close(fd);
+
+    return -1;
+}
+
 static void
-process_directory(int fd, u32 *ptr, int count)
+process_directory(int fd, u32 *ptr, int count, os_vm_offset_t file_offset)
 {
     struct ndir_entry *entry;
 
@@ -63,7 +124,7 @@ process_directory(int fd, u32 *ptr, int count)
             os_vm_address_t real_addr;
             FSHOW((stderr, "/mapping %ld(0x%lx) bytes at 0x%lx\n",
                    (long)len, (long)len, (unsigned long)addr));
-            real_addr = os_map(fd, offset, addr, len);
+            real_addr = os_map(fd, offset + file_offset, addr, len);
             if (real_addr != addr) {
                 lose("file mapped in wrong place! "
                      "(0x%08x != 0x%08lx)\n",
@@ -125,14 +186,10 @@ process_directory(int fd, u32 *ptr, int count)
 }
 
 lispobj
-load_core_file(char *file)
+load_core_file(char *file, os_vm_offset_t file_offset)
 {
     lispobj *header, val, len, *ptr, remaining_len;
-#ifndef LISP_FEATURE_WIN32
-    int fd = open(file, O_RDONLY), count;
-#else
-    int fd = open(file, O_RDONLY | O_BINARY), count;
-#endif
+    int fd = open_binary(file, O_RDONLY), count;
 
     lispobj initial_function = NIL;
     FSHOW((stderr, "/entering load_core_file(%s)\n", file));
@@ -142,6 +199,7 @@ load_core_file(char *file)
         exit(1);
     }
 
+    lseek(fd, file_offset, SEEK_SET);
     header = calloc(os_vm_page_size / sizeof(u32), sizeof(u32));
 
     count = read(fd, header, os_vm_page_size);
@@ -218,12 +276,12 @@ load_core_file(char *file)
                               ptr,
 #ifndef LISP_FEATURE_ALPHA
                               remaining_len / (sizeof(struct ndir_entry) /
-                                               sizeof(long))
+                                               sizeof(long)),
 #else
                               remaining_len / (sizeof(struct ndir_entry) /
-                                               sizeof(u32))
+                                               sizeof(u32)),
 #endif
-                              );
+                              file_offset);
             break;
 
         case INITIAL_FUN_CORE_ENTRY_TYPE_CODE:
@@ -239,7 +297,7 @@ load_core_file(char *file)
             size_t offset = 0;
             long bytes_read;
             long data[4096];
-            lseek(fd, fdoffset, SEEK_SET);
+            lseek(fd, fdoffset + file_offset, SEEK_SET);
             while ((bytes_read = read(fd, data, (size < 4096 ? size : 4096 )))
                     > 0)
             {
@@ -267,3 +325,4 @@ load_core_file(char *file)
     SHOW("returning from load_core_file(..)");
     return initial_function;
 }
+
index 85251a4..3721c88 100644 (file)
@@ -4433,13 +4433,16 @@ prepare_for_final_gc ()
  * function being set to the value of the static symbol
  * SB!VM:RESTART-LISP-FUNCTION */
 void
-gc_and_save(char *filename)
+gc_and_save(char *filename, int prepend_runtime)
 {
-    FILE *file = open_core_for_saving(filename);
-    if (!file) {
-        perror(filename);
-        return;
-    }
+    FILE *file;
+    void *runtime_bytes = NULL;
+    size_t runtime_size;
+
+    file = prepare_to_save(filename, prepend_runtime, &runtime_bytes, &runtime_size);
+    if (file == NULL)
+       return;
+
     conservative_stack = 0;
 
     /* The filename might come from Lisp, and be moved by the now
@@ -4458,9 +4461,13 @@ gc_and_save(char *filename)
     gencgc_alloc_start_page = -1;
     collect_garbage(HIGHEST_NORMAL_GENERATION+1);
 
+    if (prepend_runtime)
+        save_runtime_to_filehandle(file, runtime_bytes, runtime_size);
+
     /* The dumper doesn't know that pages need to be zeroed before use. */
     zero_all_free_pages();
-    save_to_filehandle(file, filename, SymbolValue(RESTART_LISP_FUNCTION,0));
+    save_to_filehandle(file, filename, SymbolValue(RESTART_LISP_FUNCTION,0),
+                       prepend_runtime);
     /* Oops. Save still managed to fail. Since we've mangled the stack
      * beyond hope, there's not much we can do.
      * (beyond FUNCALLing RESTART_LISP_FUNCTION, but I suspect that's
index 2b1dd25..51bef4d 100644 (file)
@@ -370,3 +370,18 @@ os_install_interrupt_handlers(void)
                                                  sig_stop_for_gc_handler);
 #endif
 }
+
+char *
+os_get_runtime_executable_path()
+{
+    char path[PATH_MAX + 1];
+    int size;
+
+    size = readlink("/proc/self/exe", path, sizeof(path));
+    if (size < 0)
+        return NULL;
+    else
+        path[size] = '\0';
+
+    return copied_string(path);
+}
index 3cf3f2d..d71b819 100644 (file)
@@ -179,4 +179,9 @@ extern void os_deallocate(os_vm_address_t addr, os_vm_size_t len);
  * to return the value in a way that Lisp can understand. */
 int os_get_errno(void);
 
+/* Return an absolute path to the runtime executable, or NULL if this
+ * information is unavailable.  If a non-null pathname is returned, it
+ * must be 'free'd. */
+extern char *os_get_runtime_executable_path();
+
 #endif
index 1a2ffac..f2a40b7 100644 (file)
@@ -147,3 +147,8 @@ os_install_interrupt_handlers(void)
                                                  sigsegv_handler);
 }
 
+char *
+os_get_runtime_executable_path()
+{
+    return NULL;
+}
index 6b3ab7e..1a841b6 100644 (file)
 
 #include "sbcl.h"
 #include "globals.h"
+#include "runtime.h"
 #include <signal.h>
 #include <ucontext.h>
+#include <limits.h>
+#include <mach-o/dyld.h>
 #include "bsd-os.h"
 
 os_context_register_t   *
@@ -110,3 +113,17 @@ os_flush_icache(os_vm_address_t address, os_vm_size_t length)
     /* see ppc-arch.c */
     ppc_flush_icache(address,length);
 }
+
+char *
+os_get_runtime_executable_path()
+{
+    char path[PATH_MAX + 1];
+    uint32_t size = sizeof(path);
+
+    if (_NSGetExecutablePath(path, &size) == -1)
+        return NULL;
+    else
+        path[size] = '\0';
+
+    return copied_string(path);
+}
index bcbe86e..50a5ba8 100644 (file)
@@ -182,7 +182,33 @@ distribution for more information.\n\
 ", SBCL_VERSION_STRING);
 }
 
-\f
+/* Look for a core file to load, first in the directory named by the
+ * SBCL_HOME environment variable, then in a hardcoded default
+ * location.  Returns a malloced copy of the core filename. */
+char *
+search_for_core ()
+{
+    char *sbcl_home = getenv("SBCL_HOME");
+    char *lookhere;
+    char *stem = "/sbcl.core";
+    char *core;
+
+    if(!sbcl_home) sbcl_home = SBCL_HOME;
+    lookhere = (char *) calloc(strlen(sbcl_home) +
+                               strlen(stem) +
+                               1,
+                               sizeof(char));
+    sprintf(lookhere, "%s%s", sbcl_home, stem);
+    core = copied_existing_filename_or_null(lookhere);
+    free(lookhere);
+    if (!core) {
+        lose("can't find core file\n");
+    }
+
+    return core;
+}
+
\f
 int
 main(int argc, char *argv[], char *envp[])
 {
@@ -195,6 +221,7 @@ main(int argc, char *argv[], char *envp[])
      * a malloc'ed string which should be freed eventually. */
     char *core = 0;
     char **sbcl_argv = 0;
+    os_vm_offset_t embedded_core_offset = 0;
 
     /* other command line options */
     boolean noinform = 0;
@@ -286,24 +313,25 @@ main(int argc, char *argv[], char *envp[])
 
     /* If no core file was specified, look for one. */
     if (!core) {
-        char *sbcl_home = getenv("SBCL_HOME");
-        char *lookhere;
-        char *stem = "/sbcl.core";
-        if(!sbcl_home) sbcl_home = SBCL_HOME;
-        lookhere = (char *) calloc(strlen(sbcl_home) +
-                                   strlen(stem) +
-                                   1,
-                                   sizeof(char));
-        sprintf(lookhere, "%s%s", sbcl_home, stem);
-        core = copied_existing_filename_or_null(lookhere);
-        free(lookhere);
-        if (!core) {
-            lose("can't find core file\n");
-        }
+       char *runtime_path = os_get_runtime_executable_path();
+
+       if (runtime_path) {
+          os_vm_offset_t offset = search_for_embedded_core(runtime_path);
+
+          if (offset != -1) {
+             embedded_core_offset = offset;
+             core = runtime_path;
+          } else {
+             free(runtime_path);
+             core = search_for_core();
+          }
+       } else {
+          core = search_for_core();
+       }
     }
-    /* Make sure that SBCL_HOME is set, no matter where the core was
-     * found */
-    if (!getenv("SBCL_HOME")) {
+
+    /* Make sure that SBCL_HOME is set, unless loading an embedded core. */
+    if (!getenv("SBCL_HOME") && embedded_core_offset == 0) {
         char *envstring, *copied_core, *dir;
         char *stem = "SBCL_HOME=";
         copied_core = copied_string(core);
@@ -333,7 +361,7 @@ main(int argc, char *argv[], char *envp[])
 
     globals_init();
 
-    initial_function = load_core_file(core);
+    initial_function = load_core_file(core, embedded_core_offset);
     if (initial_function == NIL) {
         lose("couldn't find initial function\n");
     }
index 269042c..5768f8a 100644 (file)
@@ -159,4 +159,7 @@ typedef int boolean;
 #define never_returns
 #endif
 
+extern void *successful_malloc (size_t size);
+extern char *copied_string (char *string);
+
 #endif /* _SBCL_RUNTIME_H_ */
index f939eec..9273ce1 100644 (file)
@@ -9,6 +9,10 @@
  * files for more information.
  */
 
+#ifndef LISP_FEATURE_WIN32
+#include <sys/types.h>
+#include <sys/stat.h>
+#endif
 #include <stdlib.h>
 #include <stdio.h>
 #include <string.h>
@@ -37,7 +41,7 @@ write_lispobj(lispobj obj, FILE *file)
 }
 
 static long
-write_bytes(FILE *file, char *addr, long bytes)
+write_bytes(FILE *file, char *addr, long bytes, os_vm_offset_t file_offset)
 {
     long count, here, data;
 
@@ -52,9 +56,9 @@ write_bytes(FILE *file, char *addr, long bytes)
 
     fflush(file);
     here = ftell(file);
-    fseek(file, 0, 2);
+    fseek(file, 0, SEEK_END);
     data = (ftell(file)+os_vm_page_size-1)&~(os_vm_page_size-1);
-    fseek(file, data, 0);
+    fseek(file, data, SEEK_SET);
 
     while (bytes > 0) {
         count = fwrite(addr, 1, bytes, file);
@@ -68,12 +72,12 @@ write_bytes(FILE *file, char *addr, long bytes)
         }
     }
     fflush(file);
-    fseek(file, here, 0);
-    return data/os_vm_page_size - 1;
+    fseek(file, here, SEEK_SET);
+    return ((data - file_offset) / os_vm_page_size) - 1;
 }
 
 static void
-output_space(FILE *file, int id, lispobj *addr, lispobj *end)
+output_space(FILE *file, int id, lispobj *addr, lispobj *end, os_vm_offset_t file_offset)
 {
     int words, bytes, data;
     static char *names[] = {NULL, "dynamic", "static", "read-only"};
@@ -87,7 +91,7 @@ output_space(FILE *file, int id, lispobj *addr, lispobj *end)
     printf("writing %d bytes from the %s space at 0x%08lx\n",
            bytes, names[id], (unsigned long)addr);
 
-    data = write_bytes(file, (char *)addr, bytes);
+    data = write_bytes(file, (char *)addr, bytes, file_offset);
 
     write_lispobj(data, file);
     write_lispobj((long)addr / os_vm_page_size, file);
@@ -105,9 +109,11 @@ open_core_for_saving(char *filename)
 }
 
 boolean
-save_to_filehandle(FILE *file, char *filename, lispobj init_function)
+save_to_filehandle(FILE *file, char *filename, lispobj init_function,
+                   boolean make_executable)
 {
     struct thread *th;
+    os_vm_offset_t core_start_pos, core_end_pos, core_size;
 
     /* Smash the enclosing state. (Once we do this, there's no good
      * way to go back, which is a sufficient reason that this ends up
@@ -127,6 +133,7 @@ save_to_filehandle(FILE *file, char *filename, lispobj init_function)
     printf("[saving current Lisp image into %s:\n", filename);
     fflush(stdout);
 
+    core_start_pos = ftell(file);
     write_lispobj(CORE_MAGIC, file);
 
     write_lispobj(VERSION_CORE_ENTRY_TYPE_CODE, file);
@@ -152,16 +159,19 @@ save_to_filehandle(FILE *file, char *filename, lispobj init_function)
     output_space(file,
                  READ_ONLY_CORE_SPACE_ID,
                  (lispobj *)READ_ONLY_SPACE_START,
-                 (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0));
+                 (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0),
+                 core_start_pos);
     output_space(file,
                  STATIC_CORE_SPACE_ID,
                  (lispobj *)STATIC_SPACE_START,
-                 (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0));
+                 (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0),
+                 core_start_pos);
 #ifdef reg_ALLOC
     output_space(file,
                  DYNAMIC_CORE_SPACE_ID,
                  (lispobj *)current_dynamic_space,
-                 dynamic_space_free_pointer);
+                 dynamic_space_free_pointer,
+                 core_start_pos);
 #else
 #ifdef LISP_FEATURE_GENCGC
     /* Flush the current_region, updating the tables. */
@@ -171,7 +181,8 @@ save_to_filehandle(FILE *file, char *filename, lispobj init_function)
     output_space(file,
                  DYNAMIC_CORE_SPACE_ID,
                  (lispobj *)DYNAMIC_SPACE_START,
-                 (lispobj *)SymbolValue(ALLOCATION_POINTER,0));
+                 (lispobj *)SymbolValue(ALLOCATION_POINTER,0),
+                 core_start_pos);
 #endif
 
     write_lispobj(INITIAL_FUN_CORE_ENTRY_TYPE_CODE, file);
@@ -192,7 +203,7 @@ save_to_filehandle(FILE *file, char *filename, lispobj init_function)
             write_lispobj(PAGE_TABLE_CORE_ENTRY_TYPE_CODE, file);
             write_lispobj(4, file);
             write_lispobj(size, file);
-            offset = write_bytes(file, (char *) data, size);
+            offset = write_bytes(file, (char *) data, size, core_start_pos);
             write_lispobj(offset, file);
         }
     }
@@ -200,21 +211,133 @@ save_to_filehandle(FILE *file, char *filename, lispobj init_function)
 
     write_lispobj(END_CORE_ENTRY_TYPE_CODE, file);
 
+    /* Write a trailing header, ignored when parsing the core normally.
+     * This is used to locate the start of the core when the runtime is
+     * prepended to it. */
+    fseek(file, 0, SEEK_END);
+    core_end_pos = ftell(file);
+    core_size = core_end_pos - core_start_pos;
+
+    fwrite(&core_size, sizeof(os_vm_offset_t), 1, file);
+    write_lispobj(CORE_MAGIC, file);
     fclose(file);
-    printf("done]\n");
 
+#ifndef LISP_FEATURE_WIN32
+    if (make_executable)
+        chmod (filename, 0755);
+#endif
+
+    printf("done]\n");
     exit(0);
 }
 
+/* Slurp the executable portion of the runtime into a malloced buffer
+ * and return it.  Places the size in bytes of the runtime into
+ * 'size_out'.  Returns NULL if the runtime cannot be loaded from
+ * 'runtime_path'. */
+void *
+load_runtime(char *runtime_path, size_t *size_out)
+{
+    void *buf = NULL;
+    FILE *input = NULL;
+    size_t size, count;
+    os_vm_offset_t core_offset;
+
+    core_offset = search_for_embedded_core (runtime_path);
+    if ((input = fopen(runtime_path, "rb")) == NULL) {
+        fprintf(stderr, "Unable to open runtime: %s\n", runtime_path);
+        goto lose;
+    }
+
+    fseek(input, 0, SEEK_END);
+    size = (size_t) ftell(input);
+    fseek(input, 0, SEEK_SET);
+
+    if (core_offset != -1 && size > core_offset)
+        size = core_offset;
+
+    buf = successful_malloc(size);
+    if ((count = fread(buf, 1, size, input)) != size) {
+        fprintf(stderr, "Premature EOF while reading runtime.\n");
+        goto lose;
+    }
+
+    fclose(input);
+    *size_out = size;
+    return buf;
+
+lose:
+    if (input != NULL)
+        fclose(input);
+    if (buf != NULL)
+        free(buf);
+    return NULL;
+}
+
 boolean
-save(char *filename, lispobj init_function)
+save_runtime_to_filehandle(FILE *output, void *runtime, size_t runtime_size)
+{
+    size_t padding;
+    void *padbytes;
+
+    fwrite(runtime, 1, runtime_size, output);
+
+    padding = (os_vm_page_size - (runtime_size % os_vm_page_size)) & ~os_vm_page_size;
+    if (padding > 0) {
+        padbytes = successful_malloc(padding);
+        memset(padbytes, 0, padding);
+        fwrite(padbytes, 1, padding, output);
+        free(padbytes);
+    }
+
+    return 1;
+}
+
+FILE *
+prepare_to_save(char *filename, boolean prepend_runtime, void **runtime_bytes,
+                size_t *runtime_size)
 {
-    FILE *file = open_core_for_saving(filename);
+    FILE *file;
+    char *runtime_path;
+
+    if (prepend_runtime) {
+        runtime_path = os_get_runtime_executable_path();
+
+        if (runtime_path == NULL) {
+            fprintf(stderr, "Unable to get default runtime path.\n");
+            return NULL;
+        }
+
+        *runtime_bytes = load_runtime(runtime_path, runtime_size);
+        free(runtime_path);
+
+        if (*runtime_bytes == NULL)
+            return 0;
+    }
 
-    if (!file) {
+    file = open_core_for_saving(filename);
+    if (file == NULL) {
+        free(*runtime_bytes);
         perror(filename);
-        return 1;
+        return NULL;
     }
 
-    return save_to_filehandle(file, filename, init_function);
+    return file;
+}
+
+boolean
+save(char *filename, lispobj init_function, boolean prepend_runtime)
+{
+    FILE *file;
+    void *runtime_bytes = NULL;
+    size_t runtime_size;
+
+    file = prepare_to_save(filename, prepend_runtime, &runtime_bytes, &runtime_size);
+    if (file == NULL)
+        return 1;
+
+    if (prepend_runtime)
+        save_runtime_to_filehandle(file, runtime_bytes, runtime_size);
+
+    return save_to_filehandle(file, filename, init_function, prepend_runtime);
 }
index 93b6afa..7ad3ac6 100644 (file)
 #include "core.h"
 
 extern FILE* open_core_for_saving(char *filename);
-extern boolean save_to_filehandle(FILE *file, char *filename, lispobj initfun);
-extern boolean save(char *filename, lispobj initfun);
+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_to_filehandle(FILE *file, char *filename, lispobj initfun, int make_executable);
+extern boolean save(char *filename, lispobj initfun, boolean prepend_runtime);
 
 #endif
index 723534f..1f2581b 100644 (file)
@@ -241,3 +241,9 @@ os_install_interrupt_handlers()
     undoably_install_low_level_interrupt_handler(SIG_MEMORY_FAULT,
                                                  sigsegv_handler);
 }
+
+char *
+os_get_runtime_executable_path()
+{
+    return NULL;
+}
index a867faf..8ec02db 100644 (file)
@@ -38,6 +38,7 @@
 #include "interrupt.h"
 #include "interr.h"
 #include "lispregs.h"
+#include "runtime.h"
 #include "monitor.h"
 #include "alloc.h"
 #include "genesis/primitive-objects.h"
@@ -635,4 +636,19 @@ void scratch(void)
     Sleep(0);
 }
 
+char *
+os_get_runtime_executable_path()
+{
+    char path[MAX_PATH + 1];
+    DWORD bufsize = sizeof(path);
+    DWORD size;
+
+    if ((size = GetModuleFileNameA(NULL, path, bufsize)) == 0)
+        return NULL;
+    else if (size == bufsize && GetLastError() == ERROR_INSUFFICIENT_BUFFER)
+        return NULL;
+
+    return copied_string(path);
+}
+
 /* EOF */
index ffc0350..c7c54a5 100644 (file)
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.9.11"
+"0.9.9.12"