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 "alloc.h"
  47 #include "vars.h"
  48 #include "globals.h"
  49 #include "os.h"
  50 #include "interrupt.h"
  51 #include "arch.h"
  52 #include "gc.h"
  53 #include "interr.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 \f
 131 /* miscellaneous chattiness */
 132
 133 void
 134 print_help()
 135 {
 136     puts(
 137 "Usage: sbcl [runtime-options] [toplevel-options] [user-options]\n\
 138 Common runtime options:\n\
 139   --help                     Print this message and exit.\n\
 140   --version                  Print version information and exit.\n\
 141   --core <filename>          Use the specified core file instead of the default.\n\
 142   --dynamic-space-size <MiB> Size of reserved dynamic space in megabytes.\n\
 143   --control-stack-size <MiB> Size of reserved control stack in megabytes.\n\
 144 \n\
 145 Common toplevel options:\n\
 146   --sysinit <filename>       System-wide init-file to use instead of default.\n\
 147   --userinit <filename>      Per-user init-file to use instead of default.\n\
 148   --no-sysinit               Inhibit processing of any system-wide init-file.\n\
 149   --no-userinit              Inhibit processing of any per-user init-file.\n\
 150 \n\
 151 User options are not processed by SBCL. All runtime options must\n\
 152 appear before toplevel options, and all toplevel options must\n\
 153 appear before user options.\n\
 154 \n\
 155 For more information please refer to the SBCL User Manual, which\n\
 156 should be installed along with SBCL, and is also available from the\n\
 157 website <http://www.sbcl.org/>.\n");
 158 }
 159
 160 void
 161 print_version()
 162 {
 163     printf("SBCL %s\n", SBCL_VERSION_STRING);
 164 }
 165
 166 void
 167 print_banner()
 168 {
 169     printf(
 170 "This is SBCL %s, an implementation of ANSI Common Lisp.\n\
 171 More information about SBCL is available at <http://www.sbcl.org/>.\n\
 172 \n\
 173 SBCL is free software, provided as is, with absolutely no warranty.\n\
 174 It is mostly in the public domain; some portions are provided under\n\
 175 BSD-style licenses.  See the CREDITS and COPYING files in the\n\
 176 distribution for more information.\n\
 177 ", SBCL_VERSION_STRING);
 178 }
 179
 180 /* Look for a core file to load, first in the directory named by the
 181  * SBCL_HOME environment variable, then in a hardcoded default
 182  * location.  Returns a malloced copy of the core filename. */
 183 char *
 184 search_for_core ()
 185 {
 186     char *sbcl_home = getenv("SBCL_HOME");
 187     char *lookhere;
 188     char *stem = "/sbcl.core";
 189     char *core;
 190
 191     if (!(sbcl_home && *sbcl_home)) sbcl_home = SBCL_HOME;
 192     lookhere = (char *) calloc(strlen(sbcl_home) +
 193                                strlen(stem) +
 194                                1,
 195                                sizeof(char));
 196     sprintf(lookhere, "%s%s", sbcl_home, stem);
 197     core = copied_existing_filename_or_null(lookhere);
 198
 199     if (!core) {
 200         lose("can't find core file at %s\n", lookhere);
 201     }
 202
 203     free(lookhere);
 204
 205     return core;
 206 }
 207
 208 char **posix_argv;
 209 char *core_string;
 210
 211 struct runtime_options *runtime_options;
 212
 213 \f
 214 int
 215 main(int argc, char *argv[], char *envp[])
 216 {
 217 #ifdef LISP_FEATURE_WIN32
 218     /* Exception handling support structure. Evil Win32 hack. */
 219     struct lisp_exception_frame exception_frame;
 220 #endif
 221
 222     /* the name of the core file we're to execute. Note that this is
 223      * a malloc'ed string which should be freed eventually. */
 224     char *core = 0;
 225     char **sbcl_argv = 0;
 226     os_vm_offset_t embedded_core_offset = 0;
 227     char *runtime_path = 0;
 228
 229     /* other command line options */
 230     boolean noinform = 0;
 231     boolean end_runtime_options = 0;
 232     boolean disable_lossage_handler_p = 0;
 233
 234     lispobj initial_function;
 235     const char *sbcl_home = getenv("SBCL_HOME");
 236
 237     interrupt_init();
 238     block_blockable_signals();
 239
 240     setlocale(LC_ALL, "");
 241
 242     runtime_options = NULL;
 243
 244     /* Check early to see if this executable has an embedded core,
 245      * which also populates runtime_options if the core has runtime
 246      * options */
 247     runtime_path = os_get_runtime_executable_path();
 248     if (runtime_path) {
 249         os_vm_offset_t offset = search_for_embedded_core(runtime_path);
 250         if (offset != -1) {
 251             embedded_core_offset = offset;
 252             core = runtime_path;
 253         } else {
 254             free(runtime_path);
 255         }
 256     }
 257
 258
 259     /* Parse our part of the command line (aka "runtime options"),
 260      * stripping out those options that we handle. */
 261     if (runtime_options != NULL) {
 262         dynamic_space_size = runtime_options->dynamic_space_size;
 263         thread_control_stack_size = runtime_options->thread_control_stack_size;
 264         sbcl_argv = argv;
 265     } else {
 266         int argi = 1;
 267
 268         runtime_options = successful_malloc(sizeof(struct runtime_options));
 269
 270         while (argi < argc) {
 271             char *arg = argv[argi];
 272             if (0 == strcmp(arg, "--script")) {
 273                 /* This is both a runtime and a toplevel option. As a
 274                  * runtime option, it is equivalent to --noinform.
 275                  * This exits, and does not increment argi, so that
 276                  * TOPLEVEL-INIT sees the option. */
 277                 noinform = 1;
 278                 end_runtime_options = 1;
 279                 disable_lossage_handler_p = 1;
 280                 lose_on_corruption_p = 1;
 281                 break;
 282             } else if (0 == strcmp(arg, "--noinform")) {
 283                 noinform = 1;
 284                 ++argi;
 285             } else if (0 == strcmp(arg, "--core")) {
 286                 if (core) {
 287                     lose("more than one core file specified\n");
 288                 } else {
 289                     ++argi;
 290                     if (argi >= argc) {
 291                         lose("missing filename for --core argument\n");
 292                     }
 293                     core = copied_string(argv[argi]);
 294                     ++argi;
 295                 }
 296             } else if (0 == strcmp(arg, "--help")) {
 297                 /* I think this is the (or a) usual convention: upon
 298                  * seeing "--help" we immediately print our help
 299                  * string and exit, ignoring everything else. */
 300                 print_help();
 301                 exit(0);
 302             } else if (0 == strcmp(arg, "--version")) {
 303                 /* As in "--help" case, I think this is expected. */
 304                 print_version();
 305                 exit(0);
 306             } else if (0 == strcmp(arg, "--dynamic-space-size")) {
 307                 ++argi;
 308                 if (argi >= argc)
 309                     lose("missing argument for --dynamic-space-size");
 310                 errno = 0;
 311                 dynamic_space_size = strtol(argv[argi++], 0, 0) << 20;
 312                 if (errno)
 313                     lose("argument to --dynamic-space-size is not a number");
 314 #               ifdef MAX_DYNAMIC_SPACE_END
 315                 if (!((DYNAMIC_SPACE_START <
 316                        DYNAMIC_SPACE_START+dynamic_space_size) &&
 317                       (DYNAMIC_SPACE_START+dynamic_space_size <=
 318                        MAX_DYNAMIC_SPACE_END)))
 319                     lose("specified --dynamic-space-size too large");
 320 #               endif
 321             } else if (0 == strcmp(arg, "--control-stack-size")) {
 322                 ++argi;
 323                 if (argi >= argc)
 324                     lose("missing argument for --control-stack-size");
 325                 errno = 0;
 326                 thread_control_stack_size = strtol(argv[argi++], 0, 0) << 20;
 327                 if (errno)
 328                     lose("argument to --control-stack-size is not a number");
 329             } else if (0 == strcmp(arg, "--debug-environment")) {
 330                 int n = 0;
 331                 printf("; Commandline arguments:\n");
 332                 while (n < argc) {
 333                     printf(";  %2d: \"%s\"\n", n, argv[n]);
 334                     ++n;
 335                 }
 336                 n = 0;
 337                 printf(";\n; Environment:\n");
 338                 while (ENVIRON[n]) {
 339                     printf(";  %2d: \"%s\"\n", n, ENVIRON[n]);
 340                     ++n;
 341                 }
 342                 ++argi;
 343             } else if (0 == strcmp(arg, "--disable-ldb")) {
 344                 disable_lossage_handler_p = 1;
 345                 ++argi;
 346             } else if (0 == strcmp(arg, "--lose-on-corruption")) {
 347                 lose_on_corruption_p = 1;
 348                 ++argi;
 349             } else if (0 == strcmp(arg, "--end-runtime-options")) {
 350                 end_runtime_options = 1;
 351                 ++argi;
 352                 break;
 353             } else {
 354                 /* This option was unrecognized as a runtime option,
 355                  * so it must be a toplevel option or a user option,
 356                  * so we must be past the end of the runtime option
 357                  * section. */
 358                 break;
 359             }
 360         }
 361         /* This is where we strip out those options that we handle. We
 362          * also take this opportunity to make sure that we don't find
 363          * an out-of-place "--end-runtime-options" option. */
 364         {
 365             char *argi0 = argv[argi];
 366             int argj = 1;
 367             /* (argc - argi) for the arguments, one for the binary,
 368                and one for the terminating NULL. */
 369             sbcl_argv = successful_malloc((2 + argc - argi) * sizeof(char *));
 370             sbcl_argv[0] = argv[0];
 371             while (argi < argc) {
 372                 char *arg = argv[argi++];
 373                 /* If we encounter --end-runtime-options for the first
 374                  * time after the point where we had to give up on
 375                  * runtime options, then the point where we had to
 376                  * give up on runtime options must've been a user
 377                  * error. */
 378                 if (!end_runtime_options &&
 379                     0 == strcmp(arg, "--end-runtime-options")) {
 380                     lose("bad runtime option \"%s\"\n", argi0);
 381                 }
 382                 sbcl_argv[argj++] = arg;
 383             }
 384             sbcl_argv[argj] = 0;
 385         }
 386     }
 387
 388     /* Align down to multiple of page_table page size, and to the appropriate
 389      * stack alignment. */
 390     dynamic_space_size &= ~(PAGE_BYTES-1);
 391     thread_control_stack_size &= ~(CONTROL_STACK_ALIGNMENT_BYTES-1);
 392
 393     /* Preserve the runtime options for possible future core saving */
 394     runtime_options->dynamic_space_size = dynamic_space_size;
 395     runtime_options->thread_control_stack_size = thread_control_stack_size;
 396
 397     /* KLUDGE: os_vm_page_size is set by os_init(), and on some
 398      * systems (e.g. Alpha) arch_init() needs need os_vm_page_size, so
 399      * it must follow os_init(). -- WHN 2000-01-26 */
 400     os_init(argv, envp);
 401     arch_init();
 402     gc_init();
 403     validate();
 404
 405     /* If no core file was specified, look for one. */
 406     if (!core) {
 407         core = search_for_core();
 408     }
 409
 410     /* Make sure that SBCL_HOME is set and not the empty string,
 411        unless loading an embedded core. */
 412     if (!(sbcl_home && *sbcl_home) && embedded_core_offset == 0) {
 413         char *envstring, *copied_core, *dir;
 414         char *stem = "SBCL_HOME=";
 415         copied_core = copied_string(core);
 416         dir = dirname(copied_core);
 417         envstring = (char *) calloc(strlen(stem) +
 418                                     strlen(dir) +
 419                                     1,
 420                                     sizeof(char));
 421         sprintf(envstring, "%s%s", stem, dir);
 422         putenv(envstring);
 423         free(copied_core);
 424     }
 425
 426     if (!noinform && embedded_core_offset == 0) {
 427         print_banner();
 428         fflush(stdout);
 429     }
 430
 431 #if defined(SVR4) || defined(__linux__)
 432     tzset();
 433 #endif
 434
 435     define_var("nil", NIL, 1);
 436     define_var("t", T, 1);
 437
 438     if (!disable_lossage_handler_p)
 439         enable_lossage_handler();
 440
 441     globals_init();
 442
 443     initial_function = load_core_file(core, embedded_core_offset);
 444     if (initial_function == NIL) {
 445         lose("couldn't find initial function\n");
 446     }
 447 #ifdef LISP_FEATURE_HPUX
 448     /* -1 = CLOSURE_FUN_OFFSET, 23 = SIMPLE_FUN_CODE_OFFSET, we are
 449      * not in LANGUAGE_ASSEMBLY so we cant reach them. */
 450     return_from_lisp_stub = (void *) ((char *)*((unsigned long *)
 451                  ((char *)initial_function + -1)) + 23);
 452 #endif
 453
 454     gc_initialize_pointers();
 455
 456     arch_install_interrupt_handlers();
 457 #ifndef LISP_FEATURE_WIN32
 458     os_install_interrupt_handlers();
 459 #else
 460 /*     wos_install_interrupt_handlers(handler); */
 461     wos_install_interrupt_handlers(&exception_frame);
 462 #endif
 463
 464     /* Pass core filename and the processed argv into Lisp. They'll
 465      * need to be processed further there, to do locale conversion.
 466      */
 467     core_string = core;
 468     posix_argv = sbcl_argv;
 469
 470     FSHOW((stderr, "/funcalling initial_function=0x%lx\n",
 471           (unsigned long)initial_function));
 472 #ifdef LISP_FEATURE_WIN32
 473     fprintf(stderr, "\n\
 474 This is experimental prerelease support for the Windows platform: use\n\
 475 at your own risk.  \"Your Kitten of Death awaits!\"\n");
 476     fflush(stdout);
 477     fflush(stderr);
 478 #endif
 479     create_initial_thread(initial_function);
 480     lose("CATS.  CATS ARE NICE.\n");
 481     return 0;
 482 }