0.9.0.8:
[sbcl.git] / src / runtime / runtime.c
index cfc7cd1..2aa0831 100644 (file)
  * files for more information.
  */
 
+#include "sbcl.h"
+
 #include <stdio.h>
 #include <string.h>
+#include <libgen.h>
 #include <sys/types.h>
+#include <sys/wait.h>
 #include <stdlib.h>
 #include <unistd.h>
 #include <sys/file.h>
 #include <sys/param.h>
 #include <sys/stat.h>
+#include <signal.h>
+#include <sched.h>
+#include <errno.h>
+#include <locale.h>
 
 #if defined(SVR4) || defined(__linux__)
 #include <time.h>
@@ -29,7 +37,6 @@
 #include "signal.h"
 
 #include "runtime.h"
-#include "sbcl.h"
 #include "alloc.h"
 #include "vars.h"
 #include "globals.h"
 #include "interr.h"
 #include "monitor.h"
 #include "validate.h"
-#if defined GENCGC
-#include "gencgc.h"
-#endif
 #include "core.h"
 #include "save.h"
 #include "lispregs.h"
+#include "thread.h"
+
+#include "genesis/static-symbols.h"
+#include "genesis/symbol.h"
+
 
 #ifdef irix
 #include <string.h>
 #include "interr.h"
 #endif
+
+#ifndef SBCL_HOME
+#define SBCL_HOME "/usr/local/lib/sbcl/"
+#endif
+
 \f
 /* SIGINT handler that invokes the monitor (for when Lisp isn't up to it) */
 static void
@@ -104,18 +118,65 @@ copied_existing_filename_or_null(char *filename)
 }
 
 /* Convert a null-terminated array of null-terminated strings (e.g.
- * argv or envp) into a Lisp list of Lisp strings. */
+ * argv or envp) into a Lisp list of Lisp base-strings. */
 static lispobj
-alloc_string_list(char *array_ptr[])
+alloc_base_string_list(char *array_ptr[])
 {
     if (*array_ptr) {
-       return alloc_cons(alloc_string(*array_ptr),
-                         alloc_string_list(1 + array_ptr));
+       return alloc_cons(alloc_base_string(*array_ptr),
+                         alloc_base_string_list(1 + array_ptr));
     } else {
        return NIL;
     }
 }
 \f
+/* miscellaneous chattiness */
+
+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\
+\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\
+\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\
+\n\
+More information on SBCL can be found on its man page, or at\n\
+<http://sbcl.sf.net/>.\n");
+}
+
+void
+print_version()
+{
+    printf("SBCL %s\n", SBCL_VERSION_STRING);
+}
+
+void
+print_banner()
+{
+    printf(
+"This is SBCL %s, an implementation of ANSI Common Lisp.\n\
+More information about SBCL is available at <http://www.sbcl.org/>.\n\
+\n\
+SBCL is free software, provided as is, with absolutely no warranty.\n\
+It is mostly in the public domain; some portions are provided under\n\
+BSD-style licenses.  See the CREDITS and COPYING files in the\n\
+distribution for more information.\n\
+", SBCL_VERSION_STRING);
+}
+
+\f
 int
 main(int argc, char *argv[], char *envp[])
 {
@@ -129,6 +190,8 @@ main(int argc, char *argv[], char *envp[])
 
     lispobj initial_function;
 
+    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 */
@@ -151,12 +214,22 @@ main(int argc, char *argv[], char *envp[])
                    lose("more than one core file specified");
                } else {
                    ++argi;
-                   core = copied_string(argv[argi]);
                    if (argi >= argc) {
                        lose("missing filename for --core argument");
                    }
+                   core = copied_string(argv[argi]);
                    ++argi;
                }
+           } else if (0 == strcmp(arg, "--help")) {
+               /* I think this is the (or a) usual convention: upon
+                * seeing "--help" we immediately print our help
+                * string and exit, ignoring everything else. */
+               print_help();
+               exit(0);
+           } else if (0 == strcmp(arg, "--version")) {
+               /* As in "--help" case, I think this is expected. */
+               print_version();
+               exit(0);
            } else if (0 == strcmp(arg, "--end-runtime-options")) {
                end_runtime_options = 1;
                ++argi;
@@ -196,55 +269,41 @@ main(int argc, char *argv[], char *envp[])
     /* If no core file was specified, look for one. */
     if (!core) {
        char *sbcl_home = getenv("SBCL_HOME");
-       if (sbcl_home) {
-           char *lookhere;
-           char *stem = "/sbcl.core";
-           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);
-       } else {
-           core = copied_existing_filename_or_null("/usr/lib/sbcl.core");
-           if (!core) {
-               core =
-                   copied_existing_filename_or_null("/usr/local/lib/sbcl.core");
-           }
-       }
+       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");
        }
     }
-
+    /* Make sure that SBCL_HOME is set, no matter where the core was
+     * found */
+    if (!getenv("SBCL_HOME")) {
+       char *envstring, *copied_core, *dir;
+       char *stem = "SBCL_HOME=";
+       copied_core = copied_string(core);
+       dir = dirname(copied_core);
+       envstring = (char *) calloc(strlen(stem) +
+                                   strlen(dir) + 
+                                   1,
+                                   sizeof(char));
+       sprintf(envstring, "%s%s", stem, dir);
+       putenv(envstring);
+       free(copied_core);
+    }
+    
     if (!noinform) {
-       printf(
-"This is SBCL " SBCL_VERSION_STRING ", an implementation of ANSI Common Lisp.\n\
-\n\
-SBCL is derived from the CMU CL system created at Carnegie Mellon University.\n\
-Besides software and documentation originally created at Carnegie Mellon\n\
-University, SBCL contains some software originally from the Massachusetts\n\
-Institute of Technology, Symbolics Incorporated, and Xerox Corporation, and\n\
-material contributed by volunteers since the release of CMU CL into the\n\
-public domain. See the CREDITS file in the distribution for more information.\n\
-\n\
-SBCL is a free software system, provided as is, with absolutely no warranty.\n\
-It is mostly in the public domain, but also includes some software copyrighted\n\
-  Massachusetts Institute of Technology, 1986;\n\
-  Symbolics, Inc., 1989, 1990, 1991, 1992; and\n\
-  Xerox Corporation, 1985, 1986, 1987, 1988, 1989, 1990\n\
-used under BSD-style licenses allowing copying only under certain conditions.\n\
-See the COPYING file in the distribution for more information.\n\
-\n\
-More information about SBCL is available at <http://sbcl.sourceforge.net/>.\n\
-");
+       print_banner();
        fflush(stdout);
     }
 
-#ifdef MACH
-    mach_init();
-#endif
 #if defined(SVR4) || defined(__linux__)
     tzset();
 #endif
@@ -254,11 +313,6 @@ More information about SBCL is available at <http://sbcl.sourceforge.net/>.\n\
 
     set_lossage_handler(monitor_or_something);
 
-#if 0
-    os_init();
-    gc_init();
-    validate();
-#endif
     globals_init();
 
     initial_function = load_core_file(core);
@@ -268,43 +322,23 @@ More information about SBCL is available at <http://sbcl.sourceforge.net/>.\n\
     SHOW("freeing core");
     free(core);
 
-#if defined GENCGC
-    gencgc_pickup_dynamic();
-#else
-#endif
-
-#ifdef BINDING_STACK_POINTER
-    SetSymbolValue(BINDING_STACK_POINTER, BINDING_STACK_START);
-#endif
-#if defined INTERNAL_GC_TRIGGER && !defined __i386__
-    SetSymbolValue(INTERNAL_GC_TRIGGER, make_fixnum(-1));
-#endif
+    gc_initialize_pointers();
 
     interrupt_init();
-
     arch_install_interrupt_handlers();
     os_install_interrupt_handlers();
 
-#ifdef PSEUDO_ATOMIC_ATOMIC
-    /* Turn on pseudo atomic for when we call into Lisp. */
-    SHOW("turning on pseudo atomic");
-    SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1));
-    SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0));
-#endif
-
     /* Convert remaining argv values to something that Lisp can grok. */
     SHOW("setting POSIX-ARGV symbol value");
-    SetSymbolValue(POSIX_ARGV, alloc_string_list(argv));
+    SetSymbolValue(POSIX_ARGV, alloc_base_string_list(argv),0);
 
     /* Install a handler to pick off SIGINT until the Lisp system gets
      * far enough along to install its own handler. */
     sigint_init();
 
     FSHOW((stderr, "/funcalling initial_function=0x%lx\n", initial_function));
-    funcall0(initial_function);
-
-    /* initial_function() is not supposed to return. */
-    lose("Lisp initial_function gave up control.");
-    return 0; /* dummy value: return something */
+    create_initial_thread(initial_function);
+    lose("CATS.  CATS ARE NICE.");
+    return 0;
 }