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 unsigned long parse_size_arg(char *arg, char *arg_name)
 296 {
 297   char *tail, *power_name;
 298   unsigned long power, res;
 299
 300   res = strtoul(arg, &tail, 0);
 301
 302   if (arg == tail) {
 303     lose("%s argument is not a number: %s", arg_name, arg);
 304   } else if (tail[0]) {
 305     int i, size;
 306     power_name = copied_string(tail);
 307     size = strlen(power_name);
 308     for (i=0; i<size; i++)
 309       power_name[i] = toupper(power_name[i]);
 310   } else {
 311     power = 20;
 312     power_name = NULL;
 313   }
 314   if (power_name) {
 315     if ((0==strcmp("KB", power_name)) ||
 316         (0==strcmp("KIB", power_name))) {
 317       power = 10;
 318     } else if ((0==strcmp("MB", power_name)) ||
 319                (0==strcmp("MIB", power_name))) {
 320       power = 20;
 321     } else if ((0==strcmp("GB", power_name)) ||
 322                (0==strcmp("GIB", power_name))) {
 323       power = 30;
 324     } else {
 325       lose("%s argument has an unknown suffix: %s", arg_name, tail);
 326     }
 327     free(power_name);
 328   }
 329   if ((res <= 0) ||
 330       (res > (ULONG_MAX >> power))) {
 331     lose("%s argument is out of range: %s", arg_name, arg);
 332   }
 333   res <<= power;
 334   return res;
 335 }
 336
 337 char **posix_argv;
 338 char *core_string;
 339
 340 struct runtime_options *runtime_options;
 341
 342 char *saved_runtime_path = NULL;
 343 \f
 344 int
 345 main(int argc, char *argv[], char *envp[])
 346 {
 347 #ifdef LISP_FEATURE_WIN32
 348     /* Exception handling support structure. Evil Win32 hack. */
 349     struct lisp_exception_frame exception_frame;
 350 #endif
 351
 352     /* the name of the core file we're to execute. Note that this is
 353      * a malloc'ed string which should be freed eventually. */
 354     char *core = 0;
 355     char **sbcl_argv = 0;
 356     os_vm_offset_t embedded_core_offset = 0;
 357     char *runtime_path = 0;
 358
 359     /* other command line options */
 360     boolean noinform = 0;
 361     boolean end_runtime_options = 0;
 362     boolean disable_lossage_handler_p = 0;
 363
 364     lispobj initial_function;
 365     const char *sbcl_home = getenv("SBCL_HOME");
 366
 367     interrupt_init();
 368     block_blockable_signals(0, 0);
 369
 370     setlocale(LC_ALL, "");
 371
 372     runtime_options = NULL;
 373
 374     /* Save the argv[0] derived runtime path in case
 375      * os_get_runtime_executable_path(1) isn't able to get an
 376      * externally-usable path later on. */
 377     saved_runtime_path = search_for_executable(argv[0]);
 378
 379     /* Check early to see if this executable has an embedded core,
 380      * which also populates runtime_options if the core has runtime
 381      * options */
 382     runtime_path = os_get_runtime_executable_path(0);
 383     if (runtime_path || saved_runtime_path) {
 384         os_vm_offset_t offset = search_for_embedded_core(
 385             runtime_path ? runtime_path : saved_runtime_path);
 386         if (offset != -1) {
 387             embedded_core_offset = offset;
 388             core = (runtime_path ? runtime_path :
 389                     copied_string(saved_runtime_path));
 390         } else {
 391             if (runtime_path)
 392                 free(runtime_path);
 393         }
 394     }
 395
 396
 397     /* Parse our part of the command line (aka "runtime options"),
 398      * stripping out those options that we handle. */
 399     if (runtime_options != NULL) {
 400         dynamic_space_size = runtime_options->dynamic_space_size;
 401         thread_control_stack_size = runtime_options->thread_control_stack_size;
 402         sbcl_argv = argv;
 403     } else {
 404         int argi = 1;
 405
 406         runtime_options = successful_malloc(sizeof(struct runtime_options));
 407
 408         while (argi < argc) {
 409             char *arg = argv[argi];
 410             if (0 == strcmp(arg, "--script")) {
 411                 /* This is both a runtime and a toplevel option. As a
 412                  * runtime option, it is equivalent to --noinform.
 413                  * This exits, and does not increment argi, so that
 414                  * TOPLEVEL-INIT sees the option. */
 415                 noinform = 1;
 416                 end_runtime_options = 1;
 417                 disable_lossage_handler_p = 1;
 418                 lose_on_corruption_p = 1;
 419                 break;
 420             } else if (0 == strcmp(arg, "--noinform")) {
 421                 noinform = 1;
 422                 ++argi;
 423             } else if (0 == strcmp(arg, "--core")) {
 424                 if (core) {
 425                     lose("more than one core file specified\n");
 426                 } else {
 427                     ++argi;
 428                     if (argi >= argc) {
 429                         lose("missing filename for --core argument\n");
 430                     }
 431                     core = copied_string(argv[argi]);
 432                     ++argi;
 433                 }
 434             } else if (0 == strcmp(arg, "--help")) {
 435                 /* I think this is the (or a) usual convention: upon
 436                  * seeing "--help" we immediately print our help
 437                  * string and exit, ignoring everything else. */
 438                 print_help();
 439                 exit(0);
 440             } else if (0 == strcmp(arg, "--version")) {
 441                 /* As in "--help" case, I think this is expected. */
 442                 print_version();
 443                 exit(0);
 444             } else if (0 == strcmp(arg, "--dynamic-space-size")) {
 445                 ++argi;
 446                 if (argi >= argc)
 447                     lose("missing argument for --dynamic-space-size");
 448                   dynamic_space_size = parse_size_arg(argv[argi++], "--dynamic-space-size");
 449 #               ifdef MAX_DYNAMIC_SPACE_END
 450                 if (!((DYNAMIC_SPACE_START <
 451                        DYNAMIC_SPACE_START+dynamic_space_size) &&
 452                       (DYNAMIC_SPACE_START+dynamic_space_size <=
 453                        MAX_DYNAMIC_SPACE_END)))
 454                   lose("--dynamic-space-size argument %s is too large, max %lu",
 455                        argv[argi-1], MAX_DYNAMIC_SPACE_END-DYNAMIC_SPACE_START);
 456 #               endif
 457             } else if (0 == strcmp(arg, "--control-stack-size")) {
 458                 ++argi;
 459                 if (argi >= argc)
 460                     lose("missing argument for --control-stack-size");
 461                 errno = 0;
 462                 thread_control_stack_size = parse_size_arg(argv[argi++], "--control-stack-size");
 463             } else if (0 == strcmp(arg, "--debug-environment")) {
 464                 int n = 0;
 465                 printf("; Commandline arguments:\n");
 466                 while (n < argc) {
 467                     printf(";  %2d: \"%s\"\n", n, argv[n]);
 468                     ++n;
 469                 }
 470                 n = 0;
 471                 printf(";\n; Environment:\n");
 472                 while (ENVIRON[n]) {
 473                     printf(";  %2d: \"%s\"\n", n, ENVIRON[n]);
 474                     ++n;
 475                 }
 476                 ++argi;
 477             } else if (0 == strcmp(arg, "--disable-ldb")) {
 478                 disable_lossage_handler_p = 1;
 479                 ++argi;
 480             } else if (0 == strcmp(arg, "--lose-on-corruption")) {
 481                 lose_on_corruption_p = 1;
 482                 ++argi;
 483             } else if (0 == strcmp(arg, "--end-runtime-options")) {
 484                 end_runtime_options = 1;
 485                 ++argi;
 486                 break;
 487             } else if (0 == strcmp(arg, "--merge-core-pages")) {
 488                 ++argi;
 489                 merge_core_pages = 1;
 490             } else if (0 == strcmp(arg, "--no-merge-core-pages")) {
 491                 ++argi;
 492                 merge_core_pages = 0;
 493             } else if (0 == strcmp(arg, "--default-merge-core-pages")) {
 494                 ++argi;
 495                 merge_core_pages = -1;
 496             } else {
 497                 /* This option was unrecognized as a runtime option,
 498                  * so it must be a toplevel option or a user option,
 499                  * so we must be past the end of the runtime option
 500                  * section. */
 501                 break;
 502             }
 503         }
 504         /* This is where we strip out those options that we handle. We
 505          * also take this opportunity to make sure that we don't find
 506          * an out-of-place "--end-runtime-options" option. */
 507         {
 508             char *argi0 = argv[argi];
 509             int argj = 1;
 510             /* (argc - argi) for the arguments, one for the binary,
 511                and one for the terminating NULL. */
 512             sbcl_argv = successful_malloc((2 + argc - argi) * sizeof(char *));
 513             sbcl_argv[0] = argv[0];
 514             while (argi < argc) {
 515                 char *arg = argv[argi++];
 516                 /* If we encounter --end-runtime-options for the first
 517                  * time after the point where we had to give up on
 518                  * runtime options, then the point where we had to
 519                  * give up on runtime options must've been a user
 520                  * error. */
 521                 if (!end_runtime_options &&
 522                     0 == strcmp(arg, "--end-runtime-options")) {
 523                     lose("bad runtime option \"%s\"\n", argi0);
 524                 }
 525                 sbcl_argv[argj++] = arg;
 526             }
 527             sbcl_argv[argj] = 0;
 528         }
 529     }
 530
 531     /* Align down to multiple of page_table page size, and to the appropriate
 532      * stack alignment. */
 533     dynamic_space_size &= ~(PAGE_BYTES-1);
 534 #ifdef LISP_FEATURE_GENCGC
 535     dynamic_space_size &= ~(GENCGC_CARD_BYTES-1);
 536 #endif
 537     thread_control_stack_size &= ~(CONTROL_STACK_ALIGNMENT_BYTES-1);
 538
 539     /* Preserve the runtime options for possible future core saving */
 540     runtime_options->dynamic_space_size = dynamic_space_size;
 541     runtime_options->thread_control_stack_size = thread_control_stack_size;
 542
 543     /* KLUDGE: os_vm_page_size is set by os_init(), and on some
 544      * systems (e.g. Alpha) arch_init() needs need os_vm_page_size, so
 545      * it must follow os_init(). -- WHN 2000-01-26 */
 546     os_init(argv, envp);
 547     arch_init();
 548     gc_init();
 549     validate();
 550
 551     /* If no core file was specified, look for one. */
 552     if (!core) {
 553         core = search_for_core();
 554     }
 555
 556     /* Make sure that SBCL_HOME is set and not the empty string,
 557        unless loading an embedded core. */
 558     if (!(sbcl_home && *sbcl_home) && embedded_core_offset == 0) {
 559         char *envstring, *copied_core, *dir;
 560         char *stem = "SBCL_HOME=";
 561         copied_core = copied_string(core);
 562         dir = dirname(copied_core);
 563         envstring = (char *) calloc(strlen(stem) +
 564                                     strlen(dir) +
 565                                     1,
 566                                     sizeof(char));
 567         sprintf(envstring, "%s%s", stem, dir);
 568         putenv(envstring);
 569         free(copied_core);
 570     }
 571
 572     if (!noinform && embedded_core_offset == 0) {
 573         print_banner();
 574         fflush(stdout);
 575     }
 576
 577     if (embedded_core_offset == 0) {
 578         /* Here we make a last attempt at recognizing an embedded core,
 579          * so that a file with an embedded core is a valid argument to
 580          * --core.  We take care that any decisions on special behaviour
 581          * (suppressed banner, embedded options) have already been made
 582          * before we reach this block, so that there is no observable
 583          * difference between "embedded" and "bare" images given to
 584          * --core. */
 585         os_vm_offset_t offset = search_for_embedded_core(core);
 586         if (offset != -1)
 587             embedded_core_offset = offset;
 588     }
 589
 590 #if defined(SVR4) || defined(__linux__) || defined(__NetBSD__)
 591     tzset();
 592 #endif
 593
 594     define_var("nil", NIL, 1);
 595     define_var("t", T, 1);
 596
 597     if (!disable_lossage_handler_p)
 598         enable_lossage_handler();
 599
 600     globals_init();
 601
 602     initial_function = load_core_file(core, embedded_core_offset);
 603     if (initial_function == NIL) {
 604         lose("couldn't find initial function\n");
 605     }
 606 #ifdef LISP_FEATURE_HPUX
 607     /* -1 = CLOSURE_FUN_OFFSET, 23 = SIMPLE_FUN_CODE_OFFSET, we are
 608      * not in LANGUAGE_ASSEMBLY so we cant reach them. */
 609     return_from_lisp_stub = (void *) ((char *)*((unsigned long *)
 610                  ((char *)initial_function + -1)) + 23);
 611 #endif
 612
 613     gc_initialize_pointers();
 614
 615     arch_install_interrupt_handlers();
 616 #ifndef LISP_FEATURE_WIN32
 617     os_install_interrupt_handlers();
 618 #else
 619 /*     wos_install_interrupt_handlers(handler); */
 620     wos_install_interrupt_handlers(&exception_frame);
 621 #endif
 622
 623     /* Pass core filename and the processed argv into Lisp. They'll
 624      * need to be processed further there, to do locale conversion.
 625      */
 626     core_string = core;
 627     posix_argv = sbcl_argv;
 628
 629     FSHOW((stderr, "/funcalling initial_function=0x%lx\n",
 630           (unsigned long)initial_function));
 631 #ifdef LISP_FEATURE_WIN32
 632     fprintf(stderr, "\n\
 633 This is experimental prerelease support for the Windows platform: use\n\
 634 at your own risk.  \"Your Kitten of Death awaits!\"\n");
 635     fflush(stdout);
 636     fflush(stderr);
 637 #endif
 638     create_initial_thread(initial_function);
 639     lose("CATS.  CATS ARE NICE.\n");
 640     return 0;
 641 }