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