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 <
 313                        DYNAMIC_SPACE_START+dynamic_space_size) &&
 314                       (DYNAMIC_SPACE_START+dynamic_space_size <=
 315                        MAX_DYNAMIC_SPACE_END)))
 316                     lose("specified --dynamic-space-size too large");
 317 #               endif
 318             } else if (0 == strcmp(arg, "--control-stack-size")) {
 319                 ++argi;
 320                 if (argi >= argc)
 321                     lose("missing argument for --control-stack-size");
 322                 errno = 0;
 323                 thread_control_stack_size = strtol(argv[argi++], 0, 0) << 20;
 324                 if (errno)
 325                     lose("argument to --control-stack-size is not a number");
 326             } else if (0 == strcmp(arg, "--debug-environment")) {
 327                 int n = 0;
 328                 printf("; Commandline arguments:\n");
 329                 while (n < argc) {
 330                     printf(";  %2d: \"%s\"\n", n, argv[n]);
 331                     ++n;
 332                 }
 333                 n = 0;
 334                 printf(";\n; Environment:\n");
 335                 while (ENVIRON[n]) {
 336                     printf(";  %2d: \"%s\"\n", n, ENVIRON[n]);
 337                     ++n;
 338                 }
 339                 ++argi;
 340             } else if (0 == strcmp(arg, "--end-runtime-options")) {
 341                 end_runtime_options = 1;
 342                 ++argi;
 343                 break;
 344             } else {
 345                 /* This option was unrecognized as a runtime option,
 346                  * so it must be a toplevel option or a user option,
 347                  * so we must be past the end of the runtime option
 348                  * section. */
 349                 break;
 350             }
 351         }
 352         /* This is where we strip out those options that we handle. We
 353          * also take this opportunity to make sure that we don't find
 354          * an out-of-place "--end-runtime-options" option. */
 355         {
 356             char *argi0 = argv[argi];
 357             int argj = 1;
 358             /* (argc - argi) for the arguments, one for the binary,
 359                and one for the terminating NULL. */
 360             sbcl_argv = successful_malloc((2 + argc - argi) * sizeof(char *));
 361             sbcl_argv[0] = argv[0];
 362             while (argi < argc) {
 363                 char *arg = argv[argi++];
 364                 /* If we encounter --end-runtime-options for the first
 365                  * time after the point where we had to give up on
 366                  * runtime options, then the point where we had to
 367                  * give up on runtime options must've been a user
 368                  * error. */
 369                 if (!end_runtime_options &&
 370                     0 == strcmp(arg, "--end-runtime-options")) {
 371                     lose("bad runtime option \"%s\"\n", argi0);
 372                 }
 373                 sbcl_argv[argj++] = arg;
 374             }
 375             sbcl_argv[argj] = 0;
 376         }
 377     }
 378
 379     /* Align down to multiple of page_table page size, and to the appropriate
 380      * stack alignment. */
 381     dynamic_space_size &= ~(PAGE_BYTES-1);
 382     thread_control_stack_size &= ~(CONTROL_STACK_ALIGNMENT_BYTES-1);
 383
 384     /* Preserve the runtime options for possible future core saving */
 385     runtime_options->dynamic_space_size = dynamic_space_size;
 386     runtime_options->thread_control_stack_size = thread_control_stack_size;
 387
 388     /* KLUDGE: os_vm_page_size is set by os_init(), and on some
 389      * systems (e.g. Alpha) arch_init() needs need os_vm_page_size, so
 390      * it must follow os_init(). -- WHN 2000-01-26 */
 391     os_init(argv, envp);
 392     arch_init();
 393     gc_init();
 394     validate();
 395
 396     /* If no core file was specified, look for one. */
 397     if (!core) {
 398         core = search_for_core();
 399     }
 400
 401     /* Make sure that SBCL_HOME is set and not the empty string,
 402        unless loading an embedded core. */
 403     if (!(sbcl_home && *sbcl_home) && embedded_core_offset == 0) {
 404         char *envstring, *copied_core, *dir;
 405         char *stem = "SBCL_HOME=";
 406         copied_core = copied_string(core);
 407         dir = dirname(copied_core);
 408         envstring = (char *) calloc(strlen(stem) +
 409                                     strlen(dir) +
 410                                     1,
 411                                     sizeof(char));
 412         sprintf(envstring, "%s%s", stem, dir);
 413         putenv(envstring);
 414         free(copied_core);
 415     }
 416
 417     if (!noinform && embedded_core_offset == 0) {
 418         print_banner();
 419         fflush(stdout);
 420     }
 421
 422 #if defined(SVR4) || defined(__linux__)
 423     tzset();
 424 #endif
 425
 426     define_var("nil", NIL, 1);
 427     define_var("t", T, 1);
 428
 429     enable_lossage_handler();
 430
 431     globals_init();
 432
 433     initial_function = load_core_file(core, embedded_core_offset);
 434     if (initial_function == NIL) {
 435         lose("couldn't find initial function\n");
 436     }
 437 #ifdef LISP_FEATURE_HPUX
 438     /* -1 = CLOSURE_FUN_OFFSET, 23 = SIMPLE_FUN_CODE_OFFSET, we are
 439      * not in LANGUAGE_ASSEMBLY so we cant reach them. */
 440     return_from_lisp_stub = (void *) ((char *)*((unsigned long *)
 441                  ((char *)initial_function + -1)) + 23);
 442 #endif
 443
 444     gc_initialize_pointers();
 445
 446     arch_install_interrupt_handlers();
 447 #ifndef LISP_FEATURE_WIN32
 448     os_install_interrupt_handlers();
 449 #else
 450 /*     wos_install_interrupt_handlers(handler); */
 451     wos_install_interrupt_handlers(&exception_frame);
 452 #endif
 453
 454     /* Pass core filename and the processed argv into Lisp. They'll
 455      * need to be processed further there, to do locale conversion.
 456      */
 457     core_string = core;
 458     posix_argv = sbcl_argv;
 459
 460     FSHOW((stderr, "/funcalling initial_function=0x%lx\n",
 461           (unsigned long)initial_function));
 462 #ifdef LISP_FEATURE_WIN32
 463     fprintf(stderr, "\n\
 464 This is experimental prerelease support for the Windows platform: use\n\
 465 at your own risk.  \"Your Kitten of Death awaits!\"\n");
 466     fflush(stdout);
 467     fflush(stderr);
 468 #endif
 469     create_initial_thread(initial_function);
 470     lose("CATS.  CATS ARE NICE.\n");
 471     return 0;
 472 }