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, void *void_context)
  83 {
  84     lose("\nSIGINT hit at 0x%08lX\n",
  85          (unsigned long) *os_context_pc_addr(void_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
 233     lispobj initial_function;
 234     const char *sbcl_home = getenv("SBCL_HOME");
 235
 236     interrupt_init();
 237     block_blockable_signals();
 238
 239     setlocale(LC_ALL, "");
 240
 241     runtime_options = NULL;
 242
 243     /* Check early to see if this executable has an embedded core,
 244      * which also populates runtime_options if the core has runtime
 245      * options */
 246     runtime_path = os_get_runtime_executable_path();
 247     if (runtime_path) {
 248         os_vm_offset_t offset = search_for_embedded_core(runtime_path);
 249         if (offset != -1) {
 250             embedded_core_offset = offset;
 251             core = runtime_path;
 252         } else {
 253             free(runtime_path);
 254         }
 255     }
 256
 257
 258     /* Parse our part of the command line (aka "runtime options"),
 259      * stripping out those options that we handle. */
 260     if (runtime_options != NULL) {
 261         dynamic_space_size = runtime_options->dynamic_space_size;
 262         thread_control_stack_size = runtime_options->thread_control_stack_size;
 263         sbcl_argv = argv;
 264     } else {
 265         int argi = 1;
 266
 267         runtime_options = successful_malloc(sizeof(struct runtime_options));
 268
 269         while (argi < argc) {
 270             char *arg = argv[argi];
 271             if (0 == strcmp(arg, "--script")) {
 272                 /* This is both a runtime and a toplevel option. As a
 273                  * runtime option, it is equivalent to --noinform.
 274                  * This exits, and does not increment argi, so that
 275                  * TOPLEVEL-INIT sees the option. */
 276                 noinform = 1;
 277                 end_runtime_options = 1;
 278                 break;
 279             } else if (0 == strcmp(arg, "--noinform")) {
 280                 noinform = 1;
 281                 ++argi;
 282             } else if (0 == strcmp(arg, "--core")) {
 283                 if (core) {
 284                     lose("more than one core file specified\n");
 285                 } else {
 286                     ++argi;
 287                     if (argi >= argc) {
 288                         lose("missing filename for --core argument\n");
 289                     }
 290                     core = copied_string(argv[argi]);
 291                     ++argi;
 292                 }
 293             } else if (0 == strcmp(arg, "--help")) {
 294                 /* I think this is the (or a) usual convention: upon
 295                  * seeing "--help" we immediately print our help
 296                  * string and exit, ignoring everything else. */
 297                 print_help();
 298                 exit(0);
 299             } else if (0 == strcmp(arg, "--version")) {
 300                 /* As in "--help" case, I think this is expected. */
 301                 print_version();
 302                 exit(0);
 303             } else if (0 == strcmp(arg, "--dynamic-space-size")) {
 304                 ++argi;
 305                 if (argi >= argc)
 306                     lose("missing argument for --dynamic-space-size");
 307                 errno = 0;
 308                 dynamic_space_size = strtol(argv[argi++], 0, 0) << 20;
 309                 if (errno)
 310                     lose("argument to --dynamic-space-size is not a number");
 311 #               ifdef MAX_DYNAMIC_SPACE_END
 312                 if (!((DYNAMIC_SPACE_START < DYNAMIC_SPACE_START+dynamic_space_size) &&
 313                       (DYNAMIC_SPACE_START+dynamic_space_size <= MAX_DYNAMIC_SPACE_END)))
 314                     lose("specified --dynamic-space-size too large");
 315 #               endif
 316             } else if (0 == strcmp(arg, "--control-stack-size")) {
 317                 ++argi;
 318                 if (argi >= argc)
 319                     lose("missing argument for --control-stack-size");
 320                 errno = 0;
 321                 thread_control_stack_size = strtol(argv[argi++], 0, 0) << 20;
 322                 if (errno)
 323                     lose("argument to --control-stack-size is not a number");
 324             } else if (0 == strcmp(arg, "--debug-environment")) {
 325                 int n = 0;
 326                 printf("; Commandline arguments:\n");
 327                 while (n < argc) {
 328                     printf(";  %2d: \"%s\"\n", n, argv[n]);
 329                     ++n;
 330                 }
 331                 n = 0;
 332                 printf(";\n; Environment:\n");
 333                 while (ENVIRON[n]) {
 334                     printf(";  %2d: \"%s\"\n", n, ENVIRON[n]);
 335                     ++n;
 336                 }
 337                 ++argi;
 338             } else if (0 == strcmp(arg, "--end-runtime-options")) {
 339                 end_runtime_options = 1;
 340                 ++argi;
 341                 break;
 342             } else {
 343                 /* This option was unrecognized as a runtime option,
 344                  * so it must be a toplevel option or a user option,
 345                  * so we must be past the end of the runtime option
 346                  * section. */
 347                 break;
 348             }
 349         }
 350         /* This is where we strip out those options that we handle. We
 351          * also take this opportunity to make sure that we don't find
 352          * an out-of-place "--end-runtime-options" option. */
 353         {
 354             char *argi0 = argv[argi];
 355             int argj = 1;
 356             /* (argc - argi) for the arguments, one for the binary,
 357                and one for the terminating NULL. */
 358             sbcl_argv = successful_malloc((2 + argc - argi) * sizeof(char *));
 359             sbcl_argv[0] = argv[0];
 360             while (argi < argc) {
 361                 char *arg = argv[argi++];
 362                 /* If we encounter --end-runtime-options for the first
 363                  * time after the point where we had to give up on
 364                  * runtime options, then the point where we had to
 365                  * give up on runtime options must've been a user
 366                  * error. */
 367                 if (!end_runtime_options &&
 368                     0 == strcmp(arg, "--end-runtime-options")) {
 369                     lose("bad runtime option \"%s\"\n", argi0);
 370                 }
 371                 sbcl_argv[argj++] = arg;
 372             }
 373             sbcl_argv[argj] = 0;
 374         }
 375     }
 376
 377     /* Align down to multiple of page_table page size, and to the appropriate
 378      * stack alignment. */
 379     dynamic_space_size &= ~(PAGE_BYTES-1);
 380     thread_control_stack_size &= ~(CONTROL_STACK_ALIGNMENT_BYTES-1);
 381
 382     /* Preserve the runtime options for possible future core saving */
 383     runtime_options->dynamic_space_size = dynamic_space_size;
 384     runtime_options->thread_control_stack_size = thread_control_stack_size;
 385
 386     /* KLUDGE: os_vm_page_size is set by os_init(), and on some
 387      * systems (e.g. Alpha) arch_init() needs need os_vm_page_size, so
 388      * it must follow os_init(). -- WHN 2000-01-26 */
 389     os_init(argv, envp);
 390     arch_init();
 391     gc_init();
 392     validate();
 393
 394     /* If no core file was specified, look for one. */
 395     if (!core) {
 396         core = search_for_core();
 397     }
 398
 399     /* Make sure that SBCL_HOME is set and not the empty string,
 400        unless loading an embedded core. */
 401     if (!(sbcl_home && *sbcl_home) && embedded_core_offset == 0) {
 402         char *envstring, *copied_core, *dir;
 403         char *stem = "SBCL_HOME=";
 404         copied_core = copied_string(core);
 405         dir = dirname(copied_core);
 406         envstring = (char *) calloc(strlen(stem) +
 407                                     strlen(dir) +
 408                                     1,
 409                                     sizeof(char));
 410         sprintf(envstring, "%s%s", stem, dir);
 411         putenv(envstring);
 412         free(copied_core);
 413     }
 414
 415     if (!noinform && embedded_core_offset == 0) {
 416         print_banner();
 417         fflush(stdout);
 418     }
 419
 420 #if defined(SVR4) || defined(__linux__)
 421     tzset();
 422 #endif
 423
 424     define_var("nil", NIL, 1);
 425     define_var("t", T, 1);
 426
 427     enable_lossage_handler();
 428
 429     globals_init();
 430
 431     initial_function = load_core_file(core, embedded_core_offset);
 432     if (initial_function == NIL) {
 433         lose("couldn't find initial function\n");
 434     }
 435 #ifdef LISP_FEATURE_HPUX
 436     /* -1 = CLOSURE_FUN_OFFSET, 23 = SIMPLE_FUN_CODE_OFFSET, we are not in LANGUAGE_ASSEMBLY
 437        so we cant reach them. */
 438     return_from_lisp_stub = (void *) ((char *)*((unsigned long *)
 439                  ((char *)initial_function + -1)) + 23);
 440 #endif
 441
 442     gc_initialize_pointers();
 443
 444     arch_install_interrupt_handlers();
 445 #ifndef LISP_FEATURE_WIN32
 446     os_install_interrupt_handlers();
 447 #else
 448 /*     wos_install_interrupt_handlers(handler); */
 449     wos_install_interrupt_handlers(&exception_frame);
 450 #endif
 451
 452     /* Pass core filename and the processed argv into Lisp. They'll
 453      * need to be processed further there, to do locale conversion.
 454      */
 455     core_string = core;
 456     posix_argv = sbcl_argv;
 457
 458     FSHOW((stderr, "/funcalling initial_function=0x%lx\n",
 459           (unsigned long)initial_function));
 460 #ifdef LISP_FEATURE_WIN32
 461     fprintf(stderr, "\n\
 462 This is experimental prerelease support for the Windows platform: use\n\
 463 at your own risk.  \"Your Kitten of Death awaits!\"\n");
 464     fflush(stdout);
 465     fflush(stderr);
 466 #endif
 467     create_initial_thread(initial_function);
 468     lose("CATS.  CATS ARE NICE.\n");
 469     return 0;
 470 }