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