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 <ctype.h>
  21 #ifndef LISP_FEATURE_WIN32
  22 #include <libgen.h>
  23 #endif
  24 #include <sys/types.h>
  25 #ifndef LISP_FEATURE_WIN32
  26 #include <sys/wait.h>
  27 #endif
  28 #include <stdlib.h>
  29 #include <unistd.h>
  30 #include <sys/file.h>
  31 #include <sys/param.h>
  32 #include <sys/stat.h>
  33 #include <signal.h>
  34 #ifndef LISP_FEATURE_WIN32
  35 #include <sched.h>
  36 #endif
  37 #include <errno.h>
  38 #include <locale.h>
  39 #include <limits.h>
  40
  41 #if defined(SVR4) || defined(__linux__)
  42 #include <time.h>
  43 #endif
  44
  45 #include "signal.h"
  46
  47 #include "runtime.h"
  48 #include "vars.h"
  49 #include "globals.h"
  50 #include "os.h"
  51 #include "interr.h"
  52 #include "alloc.h"
  53 #include "interrupt.h"
  54 #include "arch.h"
  55 #include "gc.h"
  56 #include "validate.h"
  57 #include "core.h"
  58 #include "save.h"
  59 #include "lispregs.h"
  60 #include "thread.h"
  61
  62 #include "genesis/static-symbols.h"
  63 #include "genesis/symbol.h"
  64
  65
  66 #ifdef irix
  67 #include <string.h>
  68 #include "interr.h"
  69 #endif
  70
  71 #ifndef SBCL_HOME
  72 #define SBCL_HOME SBCL_PREFIX"/lib/sbcl/"
  73 #endif
  74
  75 #ifdef LISP_FEATURE_HPUX
  76 extern void *return_from_lisp_stub;
  77 #include "genesis/closure.h"
  78 #include "genesis/simple-fun.h"
  79 #endif
  80
  81 \f
  82 /* SIGINT handler that invokes the monitor (for when Lisp isn't up to it) */
  83 static void
  84 sigint_handler(int signal, siginfo_t *info, os_context_t *context)
  85 {
  86     lose("\nSIGINT hit at 0x%08lX\n",
  87          (unsigned long) *os_context_pc_addr(context));
  88 }
  89
  90 /* (This is not static, because we want to be able to call it from
  91  * Lisp land.) */
  92 void
  93 sigint_init(void)
  94 {
  95     SHOW("entering sigint_init()");
  96     install_handler(SIGINT, sigint_handler);
  97     SHOW("leaving sigint_init()");
  98 }
  99 \f
 100 /*
 101  * helper functions for dealing with command line args
 102  */
 103
 104 void *
 105 successful_malloc(size_t size)
 106 {
 107     void* result = malloc(size);
 108     if (0 == result) {
 109         lose("malloc failure\n");
 110     } else {
 111         return result;
 112     }
 113     return (void *) NULL; /* dummy value: return something ... */
 114 }
 115
 116 char *
 117 copied_string(char *string)
 118 {
 119     return strcpy(successful_malloc(1+strlen(string)), string);
 120 }
 121
 122 char *
 123 copied_existing_filename_or_null(char *filename)
 124 {
 125     struct stat filename_stat;
 126     if (stat(filename, &filename_stat)) { /* if failure */
 127         return 0;
 128     } else {
 129         return copied_string(filename);
 130     }
 131 }
 132
 133 #ifndef LISP_FEATURE_WIN32
 134 char *
 135 copied_realpath(const char *pathname)
 136 {
 137     char *messy, *tidy;
 138     size_t len;
 139
 140     /* realpath() supposedly can't be counted on to always return
 141      * an absolute path, so we prepend the cwd to relative paths */
 142     messy = NULL;
 143     if (pathname[0] != '/') {
 144         messy = successful_malloc(PATH_MAX + 1);
 145         if (getcwd(messy, PATH_MAX + 1) == NULL) {
 146             free(messy);
 147             return NULL;
 148         }
 149         len = strlen(messy);
 150         snprintf(messy + len, PATH_MAX + 1 - len, "/%s", pathname);
 151     }
 152
 153     tidy = successful_malloc(PATH_MAX + 1);
 154     if (realpath((messy ? messy : pathname), tidy) == NULL) {
 155         free(messy);
 156         free(tidy);
 157         return NULL;
 158     }
 159
 160     return tidy;
 161 }
 162 #endif /* LISP_FEATURE_WIN32 */
 163 \f
 164 /* miscellaneous chattiness */
 165
 166 void
 167 print_help()
 168 {
 169     puts(
 170 "Usage: sbcl [runtime-options] [toplevel-options] [user-options]\n\
 171 Common runtime options:\n\
 172   --help                     Print this message and exit.\n\
 173   --version                  Print version information and exit.\n\
 174   --core <filename>          Use the specified core file instead of the default.\n\
 175   --dynamic-space-size <MiB> Size of reserved dynamic space in megabytes.\n\
 176   --control-stack-size <MiB> Size of reserved control stack in megabytes.\n\
 177 \n\
 178 Common toplevel options:\n\
 179   --sysinit <filename>       System-wide init-file to use instead of default.\n\
 180   --userinit <filename>      Per-user init-file to use instead of default.\n\
 181   --no-sysinit               Inhibit processing of any system-wide init-file.\n\
 182   --no-userinit              Inhibit processing of any per-user init-file.\n\
 183   --disable-debugger         Invoke sb-ext:disable-debugger.\n\
 184   --noprint                  Run a Read-Eval Loop without printing results.\n\
 185   --script [<filename>]      Skip #! line, disable debugger, avoid verbosity.\n\
 186   --quit                     Exit with code 0 after option processing.\n\
 187   --non-interactive          Sets both --quit and --disable-debugger.\n\
 188 Common toplevel options that are processed in order:\n\
 189   --eval <form>              Form to eval when processing this option.\n\
 190   --load <filename>          File to load when processing this option.\n\
 191 \n\
 192 User options are not processed by SBCL. All runtime options must\n\
 193 appear before toplevel options, and all toplevel options must\n\
 194 appear before user options.\n\
 195 \n\
 196 For more information please refer to the SBCL User Manual, which\n\
 197 should be installed along with SBCL, and is also available from the\n\
 198 website <http://www.sbcl.org/>.\n");
 199 }
 200
 201 void
 202 print_version()
 203 {
 204     printf("SBCL %s\n", SBCL_VERSION_STRING);
 205 }
 206
 207 void
 208 print_banner()
 209 {
 210     printf(
 211 "This is SBCL %s, an implementation of ANSI Common Lisp.\n\
 212 More information about SBCL is available at <http://www.sbcl.org/>.\n\
 213 \n\
 214 SBCL is free software, provided as is, with absolutely no warranty.\n\
 215 It is mostly in the public domain; some portions are provided under\n\
 216 BSD-style licenses.  See the CREDITS and COPYING files in the\n\
 217 distribution for more information.\n\
 218 ", SBCL_VERSION_STRING);
 219 }
 220
 221 /* Look for a core file to load, first in the directory named by the
 222  * SBCL_HOME environment variable, then in a hardcoded default
 223  * location.  Returns a malloced copy of the core filename. */
 224 char *
 225 search_for_core ()
 226 {
 227     char *sbcl_home = getenv("SBCL_HOME");
 228     char *lookhere;
 229     char *stem = "/sbcl.core";
 230     char *core;
 231
 232     if (!(sbcl_home && *sbcl_home)) sbcl_home = SBCL_HOME;
 233     lookhere = (char *) calloc(strlen(sbcl_home) +
 234                                strlen(stem) +
 235                                1,
 236                                sizeof(char));
 237     sprintf(lookhere, "%s%s", sbcl_home, stem);
 238     core = copied_existing_filename_or_null(lookhere);
 239
 240     if (!core) {
 241         lose("can't find core file at %s\n", lookhere);
 242     }
 243
 244     free(lookhere);
 245
 246     return core;
 247 }
 248
 249 /* Try to find the path to an executable from argv[0], this is only
 250  * used when os_get_runtime_executable_path() returns NULL */
 251 #ifdef LISP_FEATURE_WIN32
 252 char *
 253 search_for_executable(const char *argv0)
 254 {
 255     return NULL;
 256 }
 257 #else /* LISP_FEATURE_WIN32 */
 258 char *
 259 search_for_executable(const char *argv0)
 260 {
 261     char *search, *start, *end, *buf;
 262
 263     /* If argv[0] contains a slash then it's probably an absolute path
 264      * or relative to the current directory, so check if it exists. */
 265     if (strchr(argv0, '/') != NULL && access(argv0, F_OK) == 0)
 266         return copied_realpath(argv0);
 267
 268     /* Bail on an absolute path which doesn't exist */
 269     if (argv0[0] == '/')
 270         return NULL;
 271
 272     /* Otherwise check if argv[0] exists relative to any directory in PATH */
 273     search = getenv("PATH");
 274     if (search == NULL)
 275         return NULL;
 276     search = copied_string(search);
 277     buf = successful_malloc(PATH_MAX + 1);
 278     for (start = search; (end = strchr(start, ':')) != NULL; start = end + 1) {
 279         *end = '\0';
 280         snprintf(buf, PATH_MAX + 1, "%s/%s", start, argv0);
 281         if (access(buf, F_OK) == 0) {
 282             free(search);
 283             search = copied_realpath(buf);
 284             free(buf);
 285             return search;
 286         }
 287     }
 288
 289     free(search);
 290     free(buf);
 291     return NULL;
 292 }
 293 #endif /* LISP_FEATURE_WIN32 */
 294
 295 long parse_size_arg(char *arg, char *arg_name)
 296 {
 297   char *tail, *power_name;
 298   long power, res;
 299   res = strtol(arg, &tail, 0);
 300   if (arg == tail) {
 301     lose("%s argument is not a number: %s", arg_name, arg);
 302   } else if (tail[0]) {
 303     int i, size;
 304     power_name = copied_string(tail);
 305     size = strlen(power_name);
 306     for (i=0; i<size; i++)
 307       power_name[i] = toupper(power_name[i]);
 308   } else {
 309     power = 20;
 310     power_name = NULL;
 311   }
 312   if (power_name) {
 313     if ((0==strcmp("KB", power_name)) ||
 314         (0==strcmp("KIB", power_name))) {
 315       power = 10;
 316     } else if ((0==strcmp("MB", power_name)) ||
 317                (0==strcmp("MIB", power_name))) {
 318       power = 20;
 319     } else if ((0==strcmp("GB", power_name)) ||
 320                (0==strcmp("GIB", power_name))) {
 321       power = 30;
 322     } else {
 323       lose("%s argument has an unknown suffix: %s", arg_name, tail);
 324     }
 325     free(power_name);
 326   }
 327   if ((res <= 0) ||
 328       (res >= (LONG_MAX >> power))) {
 329     lose("%s argument is out of range: %s", arg_name, arg);
 330   }
 331   res <<= power;
 332   return res;
 333 }
 334
 335 char **posix_argv;
 336 char *core_string;
 337
 338 struct runtime_options *runtime_options;
 339
 340 char *saved_runtime_path = NULL;
 341 \f
 342 int
 343 main(int argc, char *argv[], char *envp[])
 344 {
 345 #ifdef LISP_FEATURE_WIN32
 346     /* Exception handling support structure. Evil Win32 hack. */
 347     struct lisp_exception_frame exception_frame;
 348 #endif
 349
 350     /* the name of the core file we're to execute. Note that this is
 351      * a malloc'ed string which should be freed eventually. */
 352     char *core = 0;
 353     char **sbcl_argv = 0;
 354     os_vm_offset_t embedded_core_offset = 0;
 355     char *runtime_path = 0;
 356
 357     /* other command line options */
 358     boolean noinform = 0;
 359     boolean end_runtime_options = 0;
 360     boolean disable_lossage_handler_p = 0;
 361
 362     lispobj initial_function;
 363     const char *sbcl_home = getenv("SBCL_HOME");
 364
 365     interrupt_init();
 366     block_blockable_signals(0, 0);
 367
 368     setlocale(LC_ALL, "");
 369
 370     runtime_options = NULL;
 371
 372     /* Save the argv[0] derived runtime path in case
 373      * os_get_runtime_executable_path(1) isn't able to get an
 374      * externally-usable path later on. */
 375     saved_runtime_path = search_for_executable(argv[0]);
 376
 377     /* Check early to see if this executable has an embedded core,
 378      * which also populates runtime_options if the core has runtime
 379      * options */
 380     runtime_path = os_get_runtime_executable_path(0);
 381     if (runtime_path || saved_runtime_path) {
 382         os_vm_offset_t offset = search_for_embedded_core(
 383             runtime_path ? runtime_path : saved_runtime_path);
 384         if (offset != -1) {
 385             embedded_core_offset = offset;
 386             core = (runtime_path ? runtime_path :
 387                     copied_string(saved_runtime_path));
 388         } else {
 389             if (runtime_path)
 390                 free(runtime_path);
 391         }
 392     }
 393
 394
 395     /* Parse our part of the command line (aka "runtime options"),
 396      * stripping out those options that we handle. */
 397     if (runtime_options != NULL) {
 398         dynamic_space_size = runtime_options->dynamic_space_size;
 399         thread_control_stack_size = runtime_options->thread_control_stack_size;
 400         sbcl_argv = argv;
 401     } else {
 402         int argi = 1;
 403
 404         runtime_options = successful_malloc(sizeof(struct runtime_options));
 405
 406         while (argi < argc) {
 407             char *arg = argv[argi];
 408             if (0 == strcmp(arg, "--script")) {
 409                 /* This is both a runtime and a toplevel option. As a
 410                  * runtime option, it is equivalent to --noinform.
 411                  * This exits, and does not increment argi, so that
 412                  * TOPLEVEL-INIT sees the option. */
 413                 noinform = 1;
 414                 end_runtime_options = 1;
 415                 disable_lossage_handler_p = 1;
 416                 lose_on_corruption_p = 1;
 417                 break;
 418             } else if (0 == strcmp(arg, "--noinform")) {
 419                 noinform = 1;
 420                 ++argi;
 421             } else if (0 == strcmp(arg, "--core")) {
 422                 if (core) {
 423                     lose("more than one core file specified\n");
 424                 } else {
 425                     ++argi;
 426                     if (argi >= argc) {
 427                         lose("missing filename for --core argument\n");
 428                     }
 429                     core = copied_string(argv[argi]);
 430                     ++argi;
 431                 }
 432             } else if (0 == strcmp(arg, "--help")) {
 433                 /* I think this is the (or a) usual convention: upon
 434                  * seeing "--help" we immediately print our help
 435                  * string and exit, ignoring everything else. */
 436                 print_help();
 437                 exit(0);
 438             } else if (0 == strcmp(arg, "--version")) {
 439                 /* As in "--help" case, I think this is expected. */
 440                 print_version();
 441                 exit(0);
 442             } else if (0 == strcmp(arg, "--dynamic-space-size")) {
 443                 ++argi;
 444                 if (argi >= argc)
 445                     lose("missing argument for --dynamic-space-size");
 446                   dynamic_space_size = parse_size_arg(argv[argi++], "--dynamic-space-size");
 447 #               ifdef MAX_DYNAMIC_SPACE_END
 448                 if (!((DYNAMIC_SPACE_START <
 449                        DYNAMIC_SPACE_START+dynamic_space_size) &&
 450                       (DYNAMIC_SPACE_START+dynamic_space_size <=
 451                        MAX_DYNAMIC_SPACE_END)))
 452                   lose("--dynamic-space-size argument %s is too large, max %ldMiB",
 453                        argv[argi-1], MAX_DYNAMIC_SPACE_END-DYNAMIC_SPACE_START);
 454 #               endif
 455             } else if (0 == strcmp(arg, "--control-stack-size")) {
 456                 ++argi;
 457                 if (argi >= argc)
 458                     lose("missing argument for --control-stack-size");
 459                 errno = 0;
 460                 thread_control_stack_size = parse_size_arg(argv[argi++], "--control-stack-size");
 461             } else if (0 == strcmp(arg, "--debug-environment")) {
 462                 int n = 0;
 463                 printf("; Commandline arguments:\n");
 464                 while (n < argc) {
 465                     printf(";  %2d: \"%s\"\n", n, argv[n]);
 466                     ++n;
 467                 }
 468                 n = 0;
 469                 printf(";\n; Environment:\n");
 470                 while (ENVIRON[n]) {
 471                     printf(";  %2d: \"%s\"\n", n, ENVIRON[n]);
 472                     ++n;
 473                 }
 474                 ++argi;
 475             } else if (0 == strcmp(arg, "--disable-ldb")) {
 476                 disable_lossage_handler_p = 1;
 477                 ++argi;
 478             } else if (0 == strcmp(arg, "--lose-on-corruption")) {
 479                 lose_on_corruption_p = 1;
 480                 ++argi;
 481             } else if (0 == strcmp(arg, "--end-runtime-options")) {
 482                 end_runtime_options = 1;
 483                 ++argi;
 484                 break;
 485             } else if (0 == strcmp(arg, "--merge-core-pages")) {
 486                 ++argi;
 487                 merge_core_pages = 1;
 488             } else if (0 == strcmp(arg, "--no-merge-core-pages")) {
 489                 ++argi;
 490                 merge_core_pages = 0;
 491             } else if (0 == strcmp(arg, "--default-merge-core-pages")) {
 492                 ++argi;
 493                 merge_core_pages = -1;
 494             } else {
 495                 /* This option was unrecognized as a runtime option,
 496                  * so it must be a toplevel option or a user option,
 497                  * so we must be past the end of the runtime option
 498                  * section. */
 499                 break;
 500             }
 501         }
 502         /* This is where we strip out those options that we handle. We
 503          * also take this opportunity to make sure that we don't find
 504          * an out-of-place "--end-runtime-options" option. */
 505         {
 506             char *argi0 = argv[argi];
 507             int argj = 1;
 508             /* (argc - argi) for the arguments, one for the binary,
 509                and one for the terminating NULL. */
 510             sbcl_argv = successful_malloc((2 + argc - argi) * sizeof(char *));
 511             sbcl_argv[0] = argv[0];
 512             while (argi < argc) {
 513                 char *arg = argv[argi++];
 514                 /* If we encounter --end-runtime-options for the first
 515                  * time after the point where we had to give up on
 516                  * runtime options, then the point where we had to
 517                  * give up on runtime options must've been a user
 518                  * error. */
 519                 if (!end_runtime_options &&
 520                     0 == strcmp(arg, "--end-runtime-options")) {
 521                     lose("bad runtime option \"%s\"\n", argi0);
 522                 }
 523                 sbcl_argv[argj++] = arg;
 524             }
 525             sbcl_argv[argj] = 0;
 526         }
 527     }
 528
 529     /* Align down to multiple of page_table page size, and to the appropriate
 530      * stack alignment. */
 531     dynamic_space_size &= ~(PAGE_BYTES-1);
 532 #ifdef LISP_FEATURE_GENCGC
 533     dynamic_space_size &= ~(GENCGC_CARD_BYTES-1);
 534 #endif
 535     thread_control_stack_size &= ~(CONTROL_STACK_ALIGNMENT_BYTES-1);
 536
 537     /* Preserve the runtime options for possible future core saving */
 538     runtime_options->dynamic_space_size = dynamic_space_size;
 539     runtime_options->thread_control_stack_size = thread_control_stack_size;
 540
 541     /* KLUDGE: os_vm_page_size is set by os_init(), and on some
 542      * systems (e.g. Alpha) arch_init() needs need os_vm_page_size, so
 543      * it must follow os_init(). -- WHN 2000-01-26 */
 544     os_init(argv, envp);
 545     arch_init();
 546     gc_init();
 547     validate();
 548
 549     /* If no core file was specified, look for one. */
 550     if (!core) {
 551         core = search_for_core();
 552     }
 553
 554     /* Make sure that SBCL_HOME is set and not the empty string,
 555        unless loading an embedded core. */
 556     if (!(sbcl_home && *sbcl_home) && embedded_core_offset == 0) {
 557         char *envstring, *copied_core, *dir;
 558         char *stem = "SBCL_HOME=";
 559         copied_core = copied_string(core);
 560         dir = dirname(copied_core);
 561         envstring = (char *) calloc(strlen(stem) +
 562                                     strlen(dir) +
 563                                     1,
 564                                     sizeof(char));
 565         sprintf(envstring, "%s%s", stem, dir);
 566         putenv(envstring);
 567         free(copied_core);
 568     }
 569
 570     if (!noinform && embedded_core_offset == 0) {
 571         print_banner();
 572         fflush(stdout);
 573     }
 574
 575     if (embedded_core_offset == 0) {
 576         /* Here we make a last attempt at recognizing an embedded core,
 577          * so that a file with an embedded core is a valid argument to
 578          * --core.  We take care that any decisions on special behaviour
 579          * (suppressed banner, embedded options) have already been made
 580          * before we reach this block, so that there is no observable
 581          * difference between "embedded" and "bare" images given to
 582          * --core. */
 583         os_vm_offset_t offset = search_for_embedded_core(core);
 584         if (offset != -1)
 585             embedded_core_offset = offset;
 586     }
 587
 588 #if defined(SVR4) || defined(__linux__) || defined(__NetBSD__)
 589     tzset();
 590 #endif
 591
 592     define_var("nil", NIL, 1);
 593     define_var("t", T, 1);
 594
 595     if (!disable_lossage_handler_p)
 596         enable_lossage_handler();
 597
 598     globals_init();
 599
 600     initial_function = load_core_file(core, embedded_core_offset);
 601     if (initial_function == NIL) {
 602         lose("couldn't find initial function\n");
 603     }
 604 #ifdef LISP_FEATURE_HPUX
 605     /* -1 = CLOSURE_FUN_OFFSET, 23 = SIMPLE_FUN_CODE_OFFSET, we are
 606      * not in LANGUAGE_ASSEMBLY so we cant reach them. */
 607     return_from_lisp_stub = (void *) ((char *)*((unsigned long *)
 608                  ((char *)initial_function + -1)) + 23);
 609 #endif
 610
 611     gc_initialize_pointers();
 612
 613     arch_install_interrupt_handlers();
 614 #ifndef LISP_FEATURE_WIN32
 615     os_install_interrupt_handlers();
 616 #else
 617 /*     wos_install_interrupt_handlers(handler); */
 618     wos_install_interrupt_handlers(&exception_frame);
 619 #endif
 620
 621     /* Pass core filename and the processed argv into Lisp. They'll
 622      * need to be processed further there, to do locale conversion.
 623      */
 624     core_string = core;
 625     posix_argv = sbcl_argv;
 626
 627     FSHOW((stderr, "/funcalling initial_function=0x%lx\n",
 628           (unsigned long)initial_function));
 629 #ifdef LISP_FEATURE_WIN32
 630     fprintf(stderr, "\n\
 631 This is experimental prerelease support for the Windows platform: use\n\
 632 at your own risk.  \"Your Kitten of Death awaits!\"\n");
 633     fflush(stdout);
 634     fflush(stderr);
 635 #endif
 636     create_initial_thread(initial_function);
 637     lose("CATS.  CATS ARE NICE.\n");
 638     return 0;
 639 }