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