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 \f
  74 /* SIGINT handler that invokes the monitor (for when Lisp isn't up to it) */
  75 static void
  76 sigint_handler(int signal, siginfo_t *info, void *void_context)
  77 {
  78     lose("\nSIGINT hit at 0x%08lX\n",
  79          (unsigned long) *os_context_pc_addr(void_context));
  80 }
  81
  82 /* (This is not static, because we want to be able to call it from
  83  * Lisp land.) */
  84 void
  85 sigint_init(void)
  86 {
  87     SHOW("entering sigint_init()");
  88     install_handler(SIGINT, sigint_handler);
  89     SHOW("leaving sigint_init()");
  90 }
  91 \f
  92 /*
  93  * helper functions for dealing with command line args
  94  */
  95
  96 void *
  97 successful_malloc(size_t size)
  98 {
  99     void* result = malloc(size);
 100     if (0 == result) {
 101         lose("malloc failure\n");
 102     } else {
 103         return result;
 104     }
 105     return (void *) NULL; /* dummy value: return something ... */
 106 }
 107
 108 char *
 109 copied_string(char *string)
 110 {
 111     return strcpy(successful_malloc(1+strlen(string)), string);
 112 }
 113
 114 char *
 115 copied_existing_filename_or_null(char *filename)
 116 {
 117     struct stat filename_stat;
 118     if (stat(filename, &filename_stat)) { /* if failure */
 119         return 0;
 120     } else {
 121         return copied_string(filename);
 122     }
 123 }
 124
 125 /* Convert a null-terminated array of null-terminated strings (e.g.
 126  * argv or envp) into a Lisp list of Lisp base-strings. */
 127 static lispobj
 128 alloc_base_string_list(char *array_ptr[])
 129 {
 130     if (*array_ptr) {
 131         return alloc_cons(alloc_base_string(*array_ptr),
 132                           alloc_base_string_list(1 + array_ptr));
 133     } else {
 134         return NIL;
 135     }
 136 }
 137 \f
 138 /* miscellaneous chattiness */
 139
 140 void
 141 print_help()
 142 {
 143     puts(
 144 "SBCL is a Common Lisp programming environment. Ordinarily you shouldn't\n\
 145 need command line options when you invoke it interactively: you can just\n\
 146 start it and work with the customary Lisp READ-EVAL-PRINT loop.\n\
 147 \n\
 148 One option idiom which is sometimes useful interactively (e.g. when\n\
 149 exercising a test case for a bug report) is\n\
 150   sbcl --no-sysinit --no-userinit\n\
 151 to keep SBCL from reading any initialization files at startup. And some\n\
 152 people like to suppress the default startup message:\n\
 153   sbcl --noinform\n\
 154 \n\
 155 Other options can be useful when you're running SBCL noninteractively,\n\
 156 e.g. from a script, or if you have a strange system configuration, so\n\
 157 that SBCL can't by default find one of the files it needs. For\n\
 158 information on such options, see the sbcl(1) man page.\n\
 159 \n\
 160 More information on SBCL can be found on its man page, or at\n\
 161 <http://sbcl.sf.net/>.\n");
 162 }
 163
 164 void
 165 print_version()
 166 {
 167     printf("SBCL %s\n", SBCL_VERSION_STRING);
 168 }
 169
 170 void
 171 print_banner()
 172 {
 173     printf(
 174 "This is SBCL %s, an implementation of ANSI Common Lisp.\n\
 175 More information about SBCL is available at <http://www.sbcl.org/>.\n\
 176 \n\
 177 SBCL is free software, provided as is, with absolutely no warranty.\n\
 178 It is mostly in the public domain; some portions are provided under\n\
 179 BSD-style licenses.  See the CREDITS and COPYING files in the\n\
 180 distribution for more information.\n\
 181 ", SBCL_VERSION_STRING);
 182 }
 183
 184 /* Look for a core file to load, first in the directory named by the
 185  * SBCL_HOME environment variable, then in a hardcoded default
 186  * location.  Returns a malloced copy of the core filename. */
 187 char *
 188 search_for_core ()
 189 {
 190     char *sbcl_home = getenv("SBCL_HOME");
 191     char *lookhere;
 192     char *stem = "/sbcl.core";
 193     char *core;
 194
 195     if(!sbcl_home) sbcl_home = SBCL_HOME;
 196     lookhere = (char *) calloc(strlen(sbcl_home) +
 197                                strlen(stem) +
 198                                1,
 199                                sizeof(char));
 200     sprintf(lookhere, "%s%s", sbcl_home, stem);
 201     core = copied_existing_filename_or_null(lookhere);
 202     free(lookhere);
 203     if (!core) {
 204         lose("can't find core file\n");
 205     }
 206
 207     return core;
 208 }
 209
 210  \f
 211 int
 212 main(int argc, char *argv[], char *envp[])
 213 {
 214 #ifdef LISP_FEATURE_WIN32
 215     /* Exception handling support structure. Evil Win32 hack. */
 216     struct lisp_exception_frame exception_frame;
 217 #endif
 218
 219     /* the name of the core file we're to execute. Note that this is
 220      * a malloc'ed string which should be freed eventually. */
 221     char *core = 0;
 222     char **sbcl_argv = 0;
 223     os_vm_offset_t embedded_core_offset = 0;
 224
 225     /* other command line options */
 226     boolean noinform = 0;
 227     boolean end_runtime_options = 0;
 228
 229     lispobj initial_function;
 230
 231     interrupt_init();
 232     block_blockable_signals();
 233
 234     setlocale(LC_ALL, "");
 235
 236     /* KLUDGE: os_vm_page_size is set by os_init(), and on some
 237      * systems (e.g. Alpha) arch_init() needs need os_vm_page_size, so
 238      * it must follow os_init(). -- WHN 2000-01-26 */
 239     os_init(argv, envp);
 240     arch_init();
 241     gc_init();
 242     validate();
 243
 244     /* Parse our part of the command line (aka "runtime options"),
 245      * stripping out those options that we handle. */
 246     {
 247         int argi = 1;
 248         while (argi < argc) {
 249             char *arg = argv[argi];
 250             if (0 == strcmp(arg, "--noinform")) {
 251                 noinform = 1;
 252                 ++argi;
 253             } else if (0 == strcmp(arg, "--core")) {
 254                 if (core) {
 255                     lose("more than one core file specified\n");
 256                 } else {
 257                     ++argi;
 258                     if (argi >= argc) {
 259                         lose("missing filename for --core argument\n");
 260                     }
 261                     core = copied_string(argv[argi]);
 262                     ++argi;
 263                 }
 264             } else if (0 == strcmp(arg, "--help")) {
 265                 /* I think this is the (or a) usual convention: upon
 266                  * seeing "--help" we immediately print our help
 267                  * string and exit, ignoring everything else. */
 268                 print_help();
 269                 exit(0);
 270             } else if (0 == strcmp(arg, "--version")) {
 271                 /* As in "--help" case, I think this is expected. */
 272                 print_version();
 273                 exit(0);
 274             } else if (0 == strcmp(arg, "--end-runtime-options")) {
 275                 end_runtime_options = 1;
 276                 ++argi;
 277                 break;
 278             } else {
 279                 /* This option was unrecognized as a runtime option,
 280                  * so it must be a toplevel option or a user option,
 281                  * so we must be past the end of the runtime option
 282                  * section. */
 283                 break;
 284             }
 285         }
 286         /* This is where we strip out those options that we handle. We
 287          * also take this opportunity to make sure that we don't find
 288          * an out-of-place "--end-runtime-options" option. */
 289         {
 290             char *argi0 = argv[argi];
 291             int argj = 1;
 292             /* (argc - argi) for the arguments, one for the binary,
 293                and one for the terminating NULL. */
 294             sbcl_argv = successful_malloc((2 + argc - argi) * sizeof(char *));
 295             sbcl_argv[0] = argv[0];
 296             while (argi < argc) {
 297                 char *arg = argv[argi++];
 298                 /* If we encounter --end-runtime-options for the first
 299                  * time after the point where we had to give up on
 300                  * runtime options, then the point where we had to
 301                  * give up on runtime options must've been a user
 302                  * error. */
 303                 if (!end_runtime_options &&
 304                     0 == strcmp(arg, "--end-runtime-options")) {
 305                     lose("bad runtime option \"%s\"\n", argi0);
 306                 }
 307                 sbcl_argv[argj++] = arg;
 308             }
 309             sbcl_argv[argj] = 0;
 310         }
 311     }
 312
 313     /* If no core file was specified, look for one. */
 314     if (!core) {
 315        char *runtime_path = os_get_runtime_executable_path();
 316
 317        if (runtime_path) {
 318           os_vm_offset_t offset = search_for_embedded_core(runtime_path);
 319
 320           if (offset != -1) {
 321              embedded_core_offset = offset;
 322              core = runtime_path;
 323           } else {
 324              free(runtime_path);
 325              core = search_for_core();
 326           }
 327        } else {
 328           core = search_for_core();
 329        }
 330     }
 331
 332     /* Make sure that SBCL_HOME is set, unless loading an embedded core. */
 333     if (!getenv("SBCL_HOME") && embedded_core_offset == 0) {
 334         char *envstring, *copied_core, *dir;
 335         char *stem = "SBCL_HOME=";
 336         copied_core = copied_string(core);
 337         dir = dirname(copied_core);
 338         envstring = (char *) calloc(strlen(stem) +
 339                                     strlen(dir) +
 340                                     1,
 341                                     sizeof(char));
 342         sprintf(envstring, "%s%s", stem, dir);
 343         putenv(envstring);
 344         free(copied_core);
 345     }
 346
 347     if (!noinform) {
 348         print_banner();
 349         fflush(stdout);
 350     }
 351
 352 #if defined(SVR4) || defined(__linux__)
 353     tzset();
 354 #endif
 355
 356     define_var("nil", NIL, 1);
 357     define_var("t", T, 1);
 358
 359     enable_lossage_handler();
 360
 361     globals_init();
 362
 363     initial_function = load_core_file(core, embedded_core_offset);
 364     if (initial_function == NIL) {
 365         lose("couldn't find initial function\n");
 366     }
 367
 368     gc_initialize_pointers();
 369
 370     arch_install_interrupt_handlers();
 371 #ifndef LISP_FEATURE_WIN32
 372     os_install_interrupt_handlers();
 373 #else
 374 /*     wos_install_interrupt_handlers(handler); */
 375     wos_install_interrupt_handlers(&exception_frame);
 376 #endif
 377
 378     /* Pass core filename into Lisp */
 379     SetSymbolValue(CORE_STRING, alloc_base_string(core),0);
 380     SHOW("freeing core");
 381     free(core);
 382
 383     /* Convert remaining argv values to something that Lisp can grok. */
 384     SHOW("setting POSIX-ARGV symbol value");
 385     SetSymbolValue(POSIX_ARGV, alloc_base_string_list(sbcl_argv),0);
 386     free(sbcl_argv);
 387
 388     FSHOW((stderr, "/funcalling initial_function=0x%lx\n",
 389           (unsigned long)initial_function));
 390 #ifdef LISP_FEATURE_WIN32
 391     fprintf(stderr, "\n\
 392 This is experimental prerelease support for the Windows platform: use\n\
 393 at your own risk.  \"Your Kitten of Death awaits!\"\n");
 394     fflush(stdout);
 395     fflush(stderr);
 396 #endif
 397     create_initial_thread(initial_function);
 398     lose("CATS.  CATS ARE NICE.\n");
 399     return 0;
 400 }