X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fruntime.c;h=4c5434e187bb703d0e4cef036e17ef70620a0725;hb=b0a7abdf2bd6f2d66fcce97196024cdb0e1a1886;hp=876ed3ad0f85b8a43c14ef1bcb7530f8273977c5;hpb=7fb597b585fc715537ea644f7d84440eca217ca1;p=sbcl.git

diff --git a/src/runtime/runtime.c b/src/runtime/runtime.c
index 876ed3a..4c5434e 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,32 +313,29 @@ 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);
-#ifndef LISP_FEATURE_WIN32
         dir = dirname(copied_core);
-#else /* LISP_FEATURE_WIN32 */
-        dir = "";
-#endif
         envstring = (char *) calloc(strlen(stem) +
                                     strlen(dir) +
                                     1,
@@ -337,12 +361,10 @@ 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");
     }
-    SHOW("freeing core");
-    free(core);
 
     gc_initialize_pointers();
 
@@ -354,6 +376,11 @@ main(int argc, char *argv[], char *envp[])
     wos_install_interrupt_handlers(&exception_frame);
 #endif
 
+    /* Pass core filename into Lisp */
+    SetSymbolValue(CORE_STRING, alloc_base_string(core),0);
+    SHOW("freeing core");
+    free(core);
+
     /* Convert remaining argv values to something that Lisp can grok. */
     SHOW("setting POSIX-ARGV symbol value");
     SetSymbolValue(POSIX_ARGV, alloc_base_string_list(sbcl_argv),0);