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