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