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