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