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