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 \n\
 170 More information about SBCL is available at <http://www.sbcl.org/>.\
 171 \n\
 172 SBCL is free software, provided as is, with absolutely no warranty.\n\
 173 It is mostly in the public domain; some portions are provided under\n\
 174 BSD-style licenses.  See the CREDITS and COPYING files in the\n\
 175 distribution for more information.\n\
 176 ", SBCL_VERSION_STRING);
 177 }
 178 \f
 179 FILE *stdlog;
 180
 181 \f
 182 int
 183 main(int argc, char *argv[], char *envp[])
 184 {
 185     /* the name of the core file we're to execute. Note that this is
 186      * a malloc'ed string which should be freed eventually. */
 187     char *core = 0;
 188
 189     /* other command line options */
 190     boolean noinform = 0;
 191     boolean end_runtime_options = 0;
 192
 193     lispobj initial_function;
 194
 195     /* KLUDGE: os_vm_page_size is set by os_init(), and on some
 196      * systems (e.g. Alpha) arch_init() needs need os_vm_page_size, so
 197      * it must follow os_init(). -- WHN 2000-01-26 */
 198     os_init();
 199     arch_init();
 200     gc_init();
 201     validate();
 202
 203     /* Parse our part of the command line (aka "runtime options"),
 204      * stripping out those options that we handle. */
 205     {
 206         int argi = 1;
 207         while (argi < argc) {
 208             char *arg = argv[argi];
 209             if (0 == strcmp(arg, "--noinform")) {
 210                 noinform = 1;
 211                 ++argi;
 212             } else if (0 == strcmp(arg, "--core")) {
 213                 if (core) {
 214                     lose("more than one core file specified");
 215                 } else {
 216                     ++argi;
 217                     if (argi >= argc) {
 218                         lose("missing filename for --core argument");
 219                     }
 220                     core = copied_string(argv[argi]);
 221                     ++argi;
 222                 }
 223             } else if (0 == strcmp(arg, "--help")) {
 224                 /* I think this is the (or a) usual convention: upon
 225                  * seeing "--help" we immediately print our help
 226                  * string and exit, ignoring everything else. */
 227                 print_help();
 228                 exit(0);
 229             } else if (0 == strcmp(arg, "--version")) {
 230                 /* As in "--help" case, I think this is expected. */
 231                 print_version();
 232                 exit(0);
 233             } else if (0 == strcmp(arg, "--end-runtime-options")) {
 234                 end_runtime_options = 1;
 235                 ++argi;
 236                 break;
 237             } else {
 238                 /* This option was unrecognized as a runtime option,
 239                  * so it must be a toplevel option or a user option,
 240                  * so we must be past the end of the runtime option
 241                  * section. */
 242                 break;
 243             }
 244         }
 245         /* This is where we strip out those options that we handle. We
 246          * also take this opportunity to make sure that we don't find
 247          * an out-of-place "--end-runtime-options" option. */
 248         {
 249             char *argi0 = argv[argi];
 250             int argj = 1;
 251             while (argi < argc) {
 252                 char *arg = argv[argi++];
 253                 /* If we encounter --end-runtime-options for the first
 254                  * time after the point where we had to give up on
 255                  * runtime options, then the point where we had to
 256                  * give up on runtime options must've been a user
 257                  * error. */
 258                 if (!end_runtime_options &&
 259                     0 == strcmp(arg, "--end-runtime-options")) {
 260                     lose("bad runtime option \"%s\"", argi0);
 261                 }
 262                 argv[argj++] = arg;
 263             }
 264             argv[argj] = 0;
 265             argc = argj;
 266         }
 267     }
 268
 269     /* If no core file was specified, look for one. */
 270     if (!core) {
 271         char *sbcl_home = getenv("SBCL_HOME");
 272         char *lookhere;
 273         char *stem = "/sbcl.core";
 274         if(!sbcl_home) sbcl_home = SBCL_HOME;
 275         lookhere = (char *) calloc(strlen(sbcl_home) +
 276                                    strlen(stem) +
 277                                    1,
 278                                    sizeof(char));
 279         sprintf(lookhere, "%s%s", sbcl_home, stem);
 280         core = copied_existing_filename_or_null(lookhere);
 281         free(lookhere);
 282         if (!core) {
 283             lose("can't find core file");
 284         }
 285     }
 286     /* Make sure that SBCL_HOME is set, no matter where the core was
 287      * found */
 288     if (!getenv("SBCL_HOME")) {
 289         char *envstring, *copied_core, *dir;
 290         char *stem = "SBCL_HOME=";
 291         copied_core = copied_string(core);
 292         dir = dirname(copied_core);
 293         envstring = (char *) calloc(strlen(stem) +
 294                                     strlen(dir) +
 295                                     1,
 296                                     sizeof(char));
 297         sprintf(envstring, "%s%s", stem, dir);
 298         putenv(envstring);
 299         free(copied_core);
 300     }
 301
 302     if (!noinform) {
 303         print_banner();
 304         fflush(stdout);
 305     }
 306
 307 #if defined(SVR4) || defined(__linux__)
 308     tzset();
 309 #endif
 310
 311     define_var("nil", NIL, 1);
 312     define_var("t", T, 1);
 313
 314     set_lossage_handler(monitor_or_something);
 315
 316     globals_init();
 317
 318     initial_function = load_core_file(core);
 319     if (initial_function == NIL) {
 320         lose("couldn't find initial function");
 321     }
 322     SHOW("freeing core");
 323     free(core);
 324
 325     gc_initialize_pointers();
 326
 327     interrupt_init();
 328     arch_install_interrupt_handlers();
 329     os_install_interrupt_handlers();
 330
 331     /* Convert remaining argv values to something that Lisp can grok. */
 332     SHOW("setting POSIX-ARGV symbol value");
 333     SetSymbolValue(POSIX_ARGV, alloc_base_string_list(argv),0);
 334
 335     /* Install a handler to pick off SIGINT until the Lisp system gets
 336      * far enough along to install its own handler. */
 337     sigint_init();
 338
 339     FSHOW((stderr, "/funcalling initial_function=0x%lx\n", initial_function));
 340     create_thread(initial_function);
 341     /* in a unithread build, create_thread never returns */
 342 #ifdef LISP_FEATURE_SB_THREAD
 343     parent_loop();
 344 #endif
 345 }
 346
 347 #ifdef LISP_FEATURE_SB_THREAD
 348
 349 /* this is being pared down as time goes on; eventually we want to get
 350  * to the point that we have no parent loop at all and the parent
 351  * thread runs Lisp just like any other */
 352
 353 static void /* noreturn */ parent_loop(void)
 354 {
 355     struct sigaction sa;
 356     sigset_t sigset;
 357     int status;
 358     pid_t pid=0;
 359
 360     sigemptyset(&sigset);
 361     sa.sa_handler=SIG_IGN;
 362     sa.sa_mask=sigset;
 363     sa.sa_flags=0;
 364     sigaction(SIGINT, &sa, 0);  /* ^c should go to the lisp thread instead */
 365     sigaction(SIG_THREAD_EXIT, &sa, 0);
 366     sigaction(SIGCHLD, &sa, 0);
 367
 368     while(!all_threads) {
 369         sched_yield();
 370     }
 371     while(all_threads && (pid=waitpid(-1,&status,__WALL))) {
 372         struct thread *th;
 373         if(pid==-1) {
 374             if(errno == EINTR) continue;
 375             fprintf(stderr,"waitpid: %s\n",strerror(errno));
 376         }
 377         else if(WIFEXITED(status) || WIFSIGNALED(status)) {
 378             th=find_thread_by_pid(pid);
 379             if(!th) continue;
 380             destroy_thread(th);
 381             if(!all_threads) break;
 382         }
 383     }
 384     exit(WEXITSTATUS(status));
 385 }
 386
 387 #endif