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