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