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