1.0.16.31: --control-stack-size runtime argument
[sbcl.git] / src / runtime / runtime.c
index cb6fcb0..3491f03 100644 (file)
 
 #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>
 
@@ -45,7 +51,6 @@
 #include "arch.h"
 #include "gc.h"
 #include "interr.h"
-#include "monitor.h"
 #include "validate.h"
 #include "core.h"
 #include "save.h"
@@ -93,7 +98,7 @@ successful_malloc(size_t size)
 {
     void* result = malloc(size);
     if (0 == result) {
-        lose("malloc failure");
+        lose("malloc failure\n");
     } else {
         return result;
     }
@@ -136,24 +141,27 @@ void
 print_help()
 {
     puts(
-"SBCL is a Common Lisp programming environment. Ordinarily you shouldn't\n\
-need command line options when you invoke it interactively: you can just\n\
-start it and work with the customary Lisp READ-EVAL-PRINT loop.\n\
+"Usage: sbcl [runtime-options] [toplevel-options] [user-options]\n\
+Common runtime options:\n\
+  --help                     Print this message and exit.\n\
+  --version                  Print version information and exit.\n\
+  --core <filename>          Use the specified core file instead of the default.\n\
+  --dynamic-space-size <MiB> Size of reserved dynamic space in megabytes.\n\
+  --control-stack-size <MiB> Size of reserved control stack in megabytes.\n\
 \n\
-One option idiom which is sometimes useful interactively (e.g. when\n\
-exercising a test case for a bug report) is\n\
-  sbcl --sysinit /dev/null --userinit /dev/null\n\
-to keep SBCL from reading any initialization files at startup. And some\n\
-people like to suppress the default startup message:\n\
-  sbcl --noinform\n\
+Common toplevel options:\n\
+  --sysinit <filename>       System-wide init-file to use instead of default.\n\
+  --userinit <filename>      Per-user init-file to use instead of default.\n\
+  --no-sysinit               Inhibit processing of any system-wide init-file.\n\
+  --no-userinit              Inhibit processing of any per-user init-file.\n\
 \n\
-Other options can be useful when you're running SBCL noninteractively,\n\
-e.g. from a script, or if you have a strange system configuration, so\n\
-that SBCL can't by default find one of the files it needs. For\n\
-information on such options, see the sbcl(1) man page.\n\
+User options are not processed by SBCL. All runtime options must\n\
+appear before toplevel options, and all toplevel options must\n\
+appear before user options.\n\
 \n\
-More information on SBCL can be found on its man page, or at\n\
-<http://sbcl.sf.net/>.\n");
+For more information please refer to the SBCL User Manual, which\n\
+should be installed along with SBCL, and is also available from the\n\
+website <http://www.sbcl.org/>.\n");
 }
 
 void
@@ -176,34 +184,64 @@ 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 = 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);
+
+    if (!core) {
+        lose("can't find core file at %s\n", lookhere);
+    }
+
+    free(lookhere);
+
+    return core;
+}
+
+char **posix_argv;
+char *core_string;
+
 \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;
     boolean end_runtime_options = 0;
 
     lispobj initial_function;
+    const char *sbcl_home = getenv("SBCL_HOME");
 
     interrupt_init();
     block_blockable_signals();
 
     setlocale(LC_ALL, "");
 
-    /* KLUDGE: os_vm_page_size is set by os_init(), and on some
-     * systems (e.g. Alpha) arch_init() needs need os_vm_page_size, so
-     * it must follow os_init(). -- WHN 2000-01-26 */
-    os_init(argv, envp);
-    arch_init();
-    gc_init();
-    validate();
-
     /* Parse our part of the command line (aka "runtime options"),
      * stripping out those options that we handle. */
     {
@@ -215,11 +253,11 @@ main(int argc, char *argv[], char *envp[])
                 ++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;
@@ -234,6 +272,36 @@ main(int argc, char *argv[], char *envp[])
                 /* As in "--help" case, I think this is expected. */
                 print_version();
                 exit(0);
+            } else if (0 == strcmp(arg, "--dynamic-space-size")) {
+                ++argi;
+                if (argi >= argc)
+                    lose("missing argument for --dynamic-space-size");
+                errno = 0;
+                dynamic_space_size = strtol(argv[argi++], 0, 0) << 20;
+                if (errno)
+                    lose("argument to --dynamic-space-size is not a number");
+            } else if (0 == strcmp(arg, "--control-stack-size")) {
+                ++argi;
+                if (argi >= argc)
+                    lose("missing argument for --control-stack-size");
+                errno = 0;
+                thread_control_stack_size = strtol(argv[argi++], 0, 0) << 20;
+                if (errno)
+                    lose("argument to --dynamic-space-size is not a number");
+            } else if (0 == strcmp(arg, "--debug-environment")) {
+                int n = 0;
+                printf("; Commandline arguments:\n");
+                while (n < argc) {
+                    printf(";  %2d: \"%s\"\n", n, argv[n]);
+                    ++n;
+                }
+                n = 0;
+                printf(";\n; Environment:\n");
+                while (ENVIRON[n]) {
+                    printf(";  %2d: \"%s\"\n", n, ENVIRON[n]);
+                    ++n;
+                }
+                ++argi;
             } else if (0 == strcmp(arg, "--end-runtime-options")) {
                 end_runtime_options = 1;
                 ++argi;
@@ -265,7 +333,7 @@ main(int argc, char *argv[], char *envp[])
                  * 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;
             }
@@ -273,26 +341,41 @@ main(int argc, char *argv[], char *envp[])
         }
     }
 
+    /* Align down to multiple of page_table page size, and to the appropriate
+     * stack alignment. */
+    dynamic_space_size &= ~(PAGE_BYTES-1);
+    thread_control_stack_size &= ~(CONTROL_STACK_ALIGNMENT_BYTES-1);
+
+    /* KLUDGE: os_vm_page_size is set by os_init(), and on some
+     * systems (e.g. Alpha) arch_init() needs need os_vm_page_size, so
+     * it must follow os_init(). -- WHN 2000-01-26 */
+    os_init(argv, envp);
+    arch_init();
+    gc_init();
+    validate();
+
     /* 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 and not the empty string,
+       unless loading an embedded core. */
+    if (!(sbcl_home && *sbcl_home) && embedded_core_offset == 0) {
         char *envstring, *copied_core, *dir;
         char *stem = "SBCL_HOME=";
         copied_core = copied_string(core);
@@ -306,7 +389,7 @@ main(int argc, char *argv[], char *envp[])
         free(copied_core);
     }
 
-    if (!noinform) {
+    if (!noinform && embedded_core_offset == 0) {
         print_banner();
         fflush(stdout);
     }
@@ -318,29 +401,41 @@ main(int argc, char *argv[], char *envp[])
     define_var("nil", NIL, 1);
     define_var("t", T, 1);
 
-    set_lossage_handler(monitor_or_something);
+    enable_lossage_handler();
 
     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");
-    SetSymbolValue(POSIX_ARGV, alloc_base_string_list(sbcl_argv),0);
-    free(sbcl_argv);
-
-    FSHOW((stderr, "/funcalling initial_function=0x%lx\n", initial_function));
+    /* Pass core filename and the processed argv into Lisp. They'll
+     * need to be processed further there, to do locale conversion.
+     */
+    core_string = core;
+    posix_argv = sbcl_argv;
+
+    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;
 }