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