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