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