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