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