#include <stdio.h>
#include <string.h>
+#ifndef LISP_FEATURE_WIN32
#include <libgen.h>
+#endif
#include <sys/types.h>
+#ifndef LISP_FEATURE_WIN32
#include <sys/wait.h>
+#endif
#include <stdlib.h>
#include <unistd.h>
#include <sys/file.h>
#include <sys/param.h>
#include <sys/stat.h>
#include <signal.h>
+#ifndef LISP_FEATURE_WIN32
#include <sched.h>
+#endif
#include <errno.h>
#include <locale.h>
{
void* result = malloc(size);
if (0 == result) {
- lose("malloc failure");
+ lose("malloc failure\n");
} else {
return result;
}
", 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[])
{
+#ifdef LISP_FEATURE_WIN32
+ /* Exception handling support structure. Evil Win32 hack. */
+ struct lisp_exception_frame exception_frame;
+#endif
+
/* the name of the core file we're to execute. Note that this is
* 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;
++argi;
} else if (0 == strcmp(arg, "--core")) {
if (core) {
- lose("more than one core file specified");
+ lose("more than one core file specified\n");
} else {
++argi;
if (argi >= argc) {
- lose("missing filename for --core argument");
+ lose("missing filename for --core argument\n");
}
core = copied_string(argv[argi]);
++argi;
* error. */
if (!end_runtime_options &&
0 == strcmp(arg, "--end-runtime-options")) {
- lose("bad runtime option \"%s\"", argi0);
+ lose("bad runtime option \"%s\"\n", argi0);
}
sbcl_argv[argj++] = arg;
}
/* 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");
- }
+ 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);
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");
+ lose("couldn't find initial function\n");
}
SHOW("freeing core");
free(core);
gc_initialize_pointers();
arch_install_interrupt_handlers();
+#ifndef LISP_FEATURE_WIN32
os_install_interrupt_handlers();
+#else
+/* wos_install_interrupt_handlers(handler); */
+ wos_install_interrupt_handlers(&exception_frame);
+#endif
/* Convert remaining argv values to something that Lisp can grok. */
SHOW("setting POSIX-ARGV symbol value");
FSHOW((stderr, "/funcalling initial_function=0x%lx\n",
(unsigned long)initial_function));
+#ifdef LISP_FEATURE_WIN32
+ fprintf(stderr, "\n\
+This is experimental prerelease support for the Windows platform: use\n\
+at your own risk. \"Your Kitten of Death awaits!\"\n");
+ fflush(stdout);
+ fflush(stderr);
+#endif
create_initial_thread(initial_function);
- lose("CATS. CATS ARE NICE.");
+ lose("CATS. CATS ARE NICE.\n");
return 0;
}