src/runtime/runtime.c

   1 /*
   2  * main() entry point for a stand-alone SBCL image
   3  */
   4
   5 /*
   6  * This software is part of the SBCL system. See the README file for
   7  * more information.
   8  *
   9  * This software is derived from the CMU CL system, which was
  10  * written at Carnegie Mellon University and released into the
  11  * public domain. The software is in the public domain and is
  12  * provided with absolutely no warranty. See the COPYING and CREDITS
  13  * files for more information.
  14  */
  15
  16 #include <stdio.h>
  17 #include <sys/types.h>
  18 #include <stdlib.h>
  19 #include <unistd.h>
  20 #include <sys/file.h>
  21 #include <sys/param.h>
  22 #include <sys/stat.h>
  23
  24 #include "signal.h"
  25
  26 #include "runtime.h"
  27 #include "sbcl.h"
  28 #include "alloc.h"
  29 #include "vars.h"
  30 #include "globals.h"
  31 #include "os.h"
  32 #include "interrupt.h"
  33 #include "arch.h"
  34 #include "gc.h"
  35 #include "interr.h"
  36 #include "monitor.h"
  37 #include "validate.h"
  38 #if defined GENCGC
  39 #include "gencgc.h"
  40 #endif
  41 #include "core.h"
  42 #include "save.h"
  43 #include "lispregs.h"
  44
  45 #ifdef irix
  46 #include <string.h>
  47 #include "interr.h"
  48 #endif
  49 \f
  50 /* SIGINT handler that invokes the monitor (for when Lisp isn't up to it) */
  51 static void
  52 sigint_handler(int signal, siginfo_t *info, void *void_context)
  53 {
  54     lose("\nSIGINT hit at 0x%08lX\n",
  55          (unsigned long) *os_context_pc_addr(void_context));
  56 }
  57
  58 /* (This is not static, because we want to be able to call it from
  59  * Lisp land.) */
  60 void
  61 sigint_init(void)
  62 {
  63     SHOW("entering sigint_init()");
  64     install_handler(SIGINT, sigint_handler);
  65     SHOW("leaving sigint_init()");
  66 }
  67 \f
  68 /*
  69  * helper functions for dealing with command line args
  70  */
  71
  72 void *
  73 successful_malloc(size_t size)
  74 {
  75     void* result = malloc(size);
  76     if (0 == result) {
  77         lose("malloc failure");
  78     } else {
  79         return result;
  80     }
  81     return (void *) NULL; /* dummy value: return something ... */
  82 }
  83
  84 char *
  85 copied_string(char *string)
  86 {
  87     return strcpy(successful_malloc(1+strlen(string)), string);
  88 }
  89
  90 char *
  91 copied_existing_filename_or_null(char *filename)
  92 {
  93     struct stat filename_stat;
  94     if (stat(filename, &filename_stat)) { /* if failure */
  95         return 0;
  96     } else {
  97         return copied_string(filename);
  98     }
  99 }
 100
 101 /* Convert a null-terminated array of null-terminated strings (e.g.
 102  * argv or envp) into a Lisp list of Lisp strings. */
 103 static lispobj
 104 alloc_string_list(char *array_ptr[])
 105 {
 106     if (*array_ptr) {
 107         return alloc_cons(alloc_string(*array_ptr),
 108                           alloc_string_list(1 + array_ptr));
 109     } else {
 110         return NIL;
 111     }
 112 }
 113 \f
 114 int
 115 main(int argc, char *argv[], char *envp[])
 116 {
 117     /* the name of the core file we're to execute. Note that this is
 118      * a malloc'ed string which should be freed eventually. */
 119     char *core = 0;
 120
 121     /* other command line options */
 122     boolean noinform = 0;
 123     boolean end_runtime_options = 0;
 124
 125     lispobj initial_function;
 126
 127     /* KLUDGE: os_vm_page_size is set by os_init(), and on some
 128      * systems (e.g. Alpha) arch_init() needs need os_vm_page_size, so
 129      * it must follow os_init(). -- WHN 2000-01-26 */
 130     os_init();
 131     arch_init();
 132     gc_init();
 133     validate();
 134
 135     /* Parse our part of the command line (aka "runtime options"),
 136      * stripping out those options that we handle. */
 137     {
 138         int argi = 1;
 139         while (argi < argc) {
 140             char *arg = argv[argi];
 141             if (0 == strcmp(arg, "--noinform")) {
 142                 noinform = 1;
 143                 ++argi;
 144             } else if (0 == strcmp(arg, "--core")) {
 145                 if (core) {
 146                     lose("more than one core file specified");
 147                 } else {
 148                     ++argi;
 149                     core = copied_string(argv[argi]);
 150                     if (argi >= argc) {
 151                         lose("missing filename for --core argument");
 152                     }
 153                     ++argi;
 154                 }
 155             } else if (0 == strcmp(arg, "--end-runtime-options")) {
 156                 end_runtime_options = 1;
 157                 ++argi;
 158                 break;
 159             } else {
 160                 /* This option was unrecognized as a runtime option,
 161                  * so it must be a toplevel option or a user option,
 162                  * so we must be past the end of the runtime option
 163                  * section. */
 164                 break;
 165             }
 166         }
 167         /* This is where we strip out those options that we handle. We
 168          * also take this opportunity to make sure that we don't find
 169          * an out-of-place "--end-runtime-options" option. */
 170         {
 171             char *argi0 = argv[argi];
 172             int argj = 1;
 173             while (argi < argc) {
 174                 char *arg = argv[argi++];
 175                 /* If we encounter --end-runtime-options for the first
 176                  * time after the point where we had to give up on
 177                  * runtime options, then the point where we had to
 178                  * give up on runtime options must've been a user
 179                  * error. */
 180                 if (!end_runtime_options &&
 181                     0 == strcmp(arg, "--end-runtime-options")) {
 182                     lose("bad runtime option \"%s\"", argi0);
 183                 }
 184                 argv[argj++] = arg;
 185             }
 186             argv[argj] = 0;
 187             argc = argj;
 188         }
 189     }
 190
 191     /* If no core file was specified, look for one. */
 192     if (!core) {
 193         char *sbcl_home = getenv("SBCL_HOME");
 194         if (sbcl_home) {
 195             char *lookhere;
 196             lookhere = (char *) calloc(strlen("/sbcl.core") + strlen(sbcl_home) + 1,
 197                                         sizeof(char));
 198             sprintf(lookhere, "%s/sbcl.core", sbcl_home);
 199             core = copied_existing_filename_or_null(lookhere);
 200             free(lookhere);
 201         } else {
 202             core = copied_existing_filename_or_null("/usr/lib/sbcl.core");
 203             if (!core) {
 204                 core = copied_existing_filename_or_null("/usr/local/lib/sbcl.core");
 205             }
 206         }
 207         if (!core) {
 208             lose("can't find core file");
 209         }
 210     }
 211
 212     if (!noinform) {
 213         printf(
 214 "This is SBCL " SBCL_VERSION_STRING ", an implementation of ANSI Common Lisp.
 215
 216 SBCL is derived from the CMU CL system created at Carnegie Mellon University.
 217 Besides software and documentation originally created at Carnegie Mellon
 218 University, SBCL contains some software originally from the Massachusetts
 219 Institute of Technology, Symbolics Incorporated, and Xerox Corporation, and
 220 material contributed by volunteers since the release of CMU CL into the
 221 public domain. See the CREDITS file in the distribution for more information.
 222
 223 SBCL is a free software system, provided as is, with absolutely no warranty.
 224 It is mostly in the public domain, but also includes some software copyrighted
 225   Massachusetts Institute of Technology, 1986;
 226   Symbolics, Inc., 1989, 1990, 1991, 1992; and
 227   Xerox Corporation, 1985, 1986, 1987, 1988, 1989, 1990
 228 used under BSD-style licenses allowing copying only under certain conditions.
 229 See the COPYING file in the distribution for more information.
 230
 231 More information on SBCL is available at <http://sbcl.sourceforge.net/>.
 232 ");
 233         fflush(stdout);
 234     }
 235
 236 #ifdef MACH
 237     mach_init();
 238 #endif
 239 #if defined(SVR4) || defined(__linux__)
 240     tzset();
 241 #endif
 242
 243     define_var("nil", NIL, 1);
 244     define_var("t", T, 1);
 245
 246     set_lossage_handler(monitor_or_something);
 247
 248 #if 0
 249     os_init();
 250     gc_init();
 251     validate();
 252 #endif
 253     globals_init();
 254
 255     initial_function = load_core_file(core);
 256     if (initial_function == NIL) {
 257         lose("couldn't find initial function");
 258     }
 259     SHOW("freeing core");
 260     free(core);
 261
 262 #if defined GENCGC
 263     gencgc_pickup_dynamic();
 264 #else
 265 #endif
 266
 267 #ifdef BINDING_STACK_POINTER
 268     SetSymbolValue(BINDING_STACK_POINTER, BINDING_STACK_START);
 269 #endif
 270 #if defined INTERNAL_GC_TRIGGER && !defined __i386__
 271     SetSymbolValue(INTERNAL_GC_TRIGGER, make_fixnum(-1));
 272 #endif
 273
 274     interrupt_init();
 275
 276     arch_install_interrupt_handlers();
 277     os_install_interrupt_handlers();
 278
 279 #ifdef PSEUDO_ATOMIC_ATOMIC
 280     /* Turn on pseudo atomic for when we call into Lisp. */
 281     SHOW("turning on pseudo atomic");
 282     SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1));
 283     SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0));
 284 #endif
 285
 286     /* Convert remaining argv values to something that Lisp can grok. */
 287     SHOW("setting POSIX-ARGV symbol value");
 288     SetSymbolValue(POSIX_ARGV, alloc_string_list(argv));
 289
 290     /* Install a handler to pick off SIGINT until the Lisp system gets
 291      * far enough along to install its own handler. */
 292     sigint_init();
 293
 294     FSHOW((stderr, "/funcalling initial_function=0x%lx\n", initial_function));
 295     funcall0(initial_function);
 296
 297     /* initial_function() is not supposed to return. */
 298     lose("Lisp initial_function gave up control.");
 299     return 0; /* dummy value: return something */
 300 }
 301