From: Juho Snellman <jsnell@iki.fi>
Date: Sun, 5 Feb 2006 22:03:00 +0000 (+0000)
Subject: 0.9.9.12:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=baa0eaf21221dc564088c37b228c620c298aeaa1;p=sbcl.git

0.9.9.12:
        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)
---

diff --git a/NEWS b/NEWS
index 855f210..daa7a7a 100644
--- 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
diff --git a/src/code/save.lisp b/src/code/save.lisp
index cff44fc..77a9f1c 100644
--- a/src/code/save.lisp
+++ b/src/code/save.lisp
@@ -19,11 +19,13 @@
 
 (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
diff --git a/src/runtime/bsd-os.c b/src/runtime/bsd-os.c
index 0bd5fc9..9b25e7b 100644
--- a/src/runtime/bsd-os.c
+++ b/src/runtime/bsd-os.c
@@ -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
diff --git a/src/runtime/core.h b/src/runtime/core.h
index e7484c3..57df1cb 100644
--- a/src/runtime/core.h
+++ b/src/runtime/core.h
@@ -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
diff --git a/src/runtime/coreparse.c b/src/runtime/coreparse.c
index 07d1525..07b96ae 100644
--- a/src/runtime/coreparse.c
+++ b/src/runtime/coreparse.c
@@ -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;
 }
+
diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c
index 85251a4..3721c88 100644
--- a/src/runtime/gencgc.c
+++ b/src/runtime/gencgc.c
@@ -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
diff --git a/src/runtime/linux-os.c b/src/runtime/linux-os.c
index 2b1dd25..51bef4d 100644
--- a/src/runtime/linux-os.c
+++ b/src/runtime/linux-os.c
@@ -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);
+}
diff --git a/src/runtime/os.h b/src/runtime/os.h
index 3cf3f2d..d71b819 100644
--- a/src/runtime/os.h
+++ b/src/runtime/os.h
@@ -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
diff --git a/src/runtime/osf1-os.c b/src/runtime/osf1-os.c
index 1a2ffac..f2a40b7 100644
--- a/src/runtime/osf1-os.c
+++ b/src/runtime/osf1-os.c
@@ -147,3 +147,8 @@ os_install_interrupt_handlers(void)
                                                  sigsegv_handler);
 }
 
+char *
+os_get_runtime_executable_path()
+{
+    return NULL;
+}
diff --git a/src/runtime/ppc-darwin-os.c b/src/runtime/ppc-darwin-os.c
index 6b3ab7e..1a841b6 100644
--- a/src/runtime/ppc-darwin-os.c
+++ b/src/runtime/ppc-darwin-os.c
@@ -16,8 +16,11 @@
 
 #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);
+}
diff --git a/src/runtime/runtime.c b/src/runtime/runtime.c
index bcbe86e..50a5ba8 100644
--- a/src/runtime/runtime.c
+++ b/src/runtime/runtime.c
@@ -182,7 +182,33 @@ distribution for more information.\n\
 ", SBCL_VERSION_STRING);
 }
 
-
+/* 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;
+}
+
+ 
 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");
     }
diff --git a/src/runtime/runtime.h b/src/runtime/runtime.h
index 269042c..5768f8a 100644
--- a/src/runtime/runtime.h
+++ b/src/runtime/runtime.h
@@ -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_ */
diff --git a/src/runtime/save.c b/src/runtime/save.c
index f939eec..9273ce1 100644
--- a/src/runtime/save.c
+++ b/src/runtime/save.c
@@ -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);
 }
diff --git a/src/runtime/save.h b/src/runtime/save.h
index 93b6afa..7ad3ac6 100644
--- a/src/runtime/save.h
+++ b/src/runtime/save.h
@@ -15,7 +15,10 @@
 #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
diff --git a/src/runtime/sunos-os.c b/src/runtime/sunos-os.c
index 723534f..1f2581b 100644
--- a/src/runtime/sunos-os.c
+++ b/src/runtime/sunos-os.c
@@ -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;
+}
diff --git a/src/runtime/win32-os.c b/src/runtime/win32-os.c
index a867faf..8ec02db 100644
--- a/src/runtime/win32-os.c
+++ b/src/runtime/win32-os.c
@@ -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 */
diff --git a/version.lisp-expr b/version.lisp-expr
index ffc0350..c7c54a5 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -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"