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