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 #include <libgen.h>
  21 #include <sys/types.h>
  22 #include <sys/wait.h>
  23 #include <stdlib.h>
  24 #include <unistd.h>
  25 #include <sys/file.h>
  26 #include <sys/param.h>
  27 #include <sys/stat.h>
  28 #include <signal.h>
  29 #include <sched.h>
  30 #include <errno.h>
  31 #include <locale.h>
  32
  33 #if defined(SVR4) || defined(__linux__)
  34 #include <time.h>
  35 #endif
  36
  37 #include "signal.h"
  38
  39 #include "runtime.h"
  40 #include "alloc.h"
  41 #include "vars.h"
  42 #include "globals.h"
  43 #include "os.h"
  44 #include "interrupt.h"
  45 #include "arch.h"
  46 #include "gc.h"
  47 #include "interr.h"
  48 #include "monitor.h"
  49 #include "validate.h"
  50 #include "core.h"
  51 #include "save.h"
  52 #include "lispregs.h"
  53 #include "thread.h"
  54
  55 #include "genesis/static-symbols.h"
  56 #include "genesis/symbol.h"
  57
  58
  59 #ifdef irix
  60 #include <string.h>
  61 #include "interr.h"
  62 #endif
  63
  64 #ifndef SBCL_HOME
  65 #define SBCL_HOME "/usr/local/lib/sbcl/"
  66 #endif
  67
  68 \f
  69 /* SIGINT handler that invokes the monitor (for when Lisp isn't up to it) */
  70 static void
  71 sigint_handler(int signal, siginfo_t *info, void *void_context)
  72 {
  73     lose("\nSIGINT hit at 0x%08lX\n",
  74          (unsigned long) *os_context_pc_addr(void_context));
  75 }
  76
  77 /* (This is not static, because we want to be able to call it from
  78  * Lisp land.) */
  79 void
  80 sigint_init(void)
  81 {
  82     SHOW("entering sigint_init()");
  83     install_handler(SIGINT, sigint_handler);
  84     SHOW("leaving sigint_init()");
  85 }
  86 \f
  87 /*
  88  * helper functions for dealing with command line args
  89  */
  90
  91 void *
  92 successful_malloc(size_t size)
  93 {
  94     void* result = malloc(size);
  95     if (0 == result) {
  96         lose("malloc failure\n");
  97     } else {
  98         return result;
  99     }
 100     return (void *) NULL; /* dummy value: return something ... */
 101 }
 102
 103 char *
 104 copied_string(char *string)
 105 {
 106     return strcpy(successful_malloc(1+strlen(string)), string);
 107 }
 108
 109 char *
 110 copied_existing_filename_or_null(char *filename)
 111 {
 112     struct stat filename_stat;
 113     if (stat(filename, &filename_stat)) { /* if failure */
 114         return 0;
 115     } else {
 116         return copied_string(filename);
 117     }
 118 }
 119
 120 /* Convert a null-terminated array of null-terminated strings (e.g.
 121  * argv or envp) into a Lisp list of Lisp base-strings. */
 122 static lispobj
 123 alloc_base_string_list(char *array_ptr[])
 124 {
 125     if (*array_ptr) {
 126         return alloc_cons(alloc_base_string(*array_ptr),
 127                           alloc_base_string_list(1 + array_ptr));
 128     } else {
 129         return NIL;
 130     }
 131 }
 132 \f
 133 /* miscellaneous chattiness */
 134
 135 void
 136 print_help()
 137 {
 138     puts(
 139 "SBCL is a Common Lisp programming environment. Ordinarily you shouldn't\n\
 140 need command line options when you invoke it interactively: you can just\n\
 141 start it and work with the customary Lisp READ-EVAL-PRINT loop.\n\
 142 \n\
 143 One option idiom which is sometimes useful interactively (e.g. when\n\
 144 exercising a test case for a bug report) is\n\
 145   sbcl --sysinit /dev/null --userinit /dev/null\n\
 146 to keep SBCL from reading any initialization files at startup. And some\n\
 147 people like to suppress the default startup message:\n\
 148   sbcl --noinform\n\
 149 \n\
 150 Other options can be useful when you're running SBCL noninteractively,\n\
 151 e.g. from a script, or if you have a strange system configuration, so\n\
 152 that SBCL can't by default find one of the files it needs. For\n\
 153 information on such options, see the sbcl(1) man page.\n\
 154 \n\
 155 More information on SBCL can be found on its man page, or at\n\
 156 <http://sbcl.sf.net/>.\n");
 157 }
 158
 159 void
 160 print_version()
 161 {
 162     printf("SBCL %s\n", SBCL_VERSION_STRING);
 163 }
 164
 165 void
 166 print_banner()
 167 {
 168     printf(
 169 "This is SBCL %s, an implementation of ANSI Common Lisp.\n\
 170 More information about SBCL is available at <http://www.sbcl.org/>.\n\
 171 \n\
 172 SBCL is free software, provided as is, with absolutely no warranty.\n\
 173 It is mostly in the public domain; some portions are provided under\n\
 174 BSD-style licenses.  See the CREDITS and COPYING files in the\n\
 175 distribution for more information.\n\
 176 ", SBCL_VERSION_STRING);
 177 }
 178
 179 \f
 180 int
 181 main(int argc, char *argv[], char *envp[])
 182 {
 183     /* the name of the core file we're to execute. Note that this is
 184      * a malloc'ed string which should be freed eventually. */
 185     char *core = 0;
 186     char **sbcl_argv = 0;
 187
 188     /* other command line options */
 189     boolean noinform = 0;
 190     boolean end_runtime_options = 0;
 191
 192     lispobj initial_function;
 193
 194     interrupt_init();
 195     block_blockable_signals();
 196
 197     setlocale(LC_ALL, "");
 198
 199     /* KLUDGE: os_vm_page_size is set by os_init(), and on some
 200      * systems (e.g. Alpha) arch_init() needs need os_vm_page_size, so
 201      * it must follow os_init(). -- WHN 2000-01-26 */
 202     os_init(argv, envp);
 203     arch_init();
 204     gc_init();
 205     validate();
 206
 207     /* Parse our part of the command line (aka "runtime options"),
 208      * stripping out those options that we handle. */
 209     {
 210         int argi = 1;
 211         while (argi < argc) {
 212             char *arg = argv[argi];
 213             if (0 == strcmp(arg, "--noinform")) {
 214                 noinform = 1;
 215                 ++argi;
 216             } else if (0 == strcmp(arg, "--core")) {
 217                 if (core) {
 218                     lose("more than one core file specified\n");
 219                 } else {
 220                     ++argi;
 221                     if (argi >= argc) {
 222                         lose("missing filename for --core argument\n");
 223                     }
 224                     core = copied_string(argv[argi]);
 225                     ++argi;
 226                 }
 227             } else if (0 == strcmp(arg, "--help")) {
 228                 /* I think this is the (or a) usual convention: upon
 229                  * seeing "--help" we immediately print our help
 230                  * string and exit, ignoring everything else. */
 231                 print_help();
 232                 exit(0);
 233             } else if (0 == strcmp(arg, "--version")) {
 234                 /* As in "--help" case, I think this is expected. */
 235                 print_version();
 236                 exit(0);
 237             } else if (0 == strcmp(arg, "--end-runtime-options")) {
 238                 end_runtime_options = 1;
 239                 ++argi;
 240                 break;
 241             } else {
 242                 /* This option was unrecognized as a runtime option,
 243                  * so it must be a toplevel option or a user option,
 244                  * so we must be past the end of the runtime option
 245                  * section. */
 246                 break;
 247             }
 248         }
 249         /* This is where we strip out those options that we handle. We
 250          * also take this opportunity to make sure that we don't find
 251          * an out-of-place "--end-runtime-options" option. */
 252         {
 253             char *argi0 = argv[argi];
 254             int argj = 1;
 255             /* (argc - argi) for the arguments, one for the binary,
 256                and one for the terminating NULL. */
 257             sbcl_argv = successful_malloc((2 + argc - argi) * sizeof(char *));
 258             sbcl_argv[0] = argv[0];
 259             while (argi < argc) {
 260                 char *arg = argv[argi++];
 261                 /* If we encounter --end-runtime-options for the first
 262                  * time after the point where we had to give up on
 263                  * runtime options, then the point where we had to
 264                  * give up on runtime options must've been a user
 265                  * error. */
 266                 if (!end_runtime_options &&
 267                     0 == strcmp(arg, "--end-runtime-options")) {
 268                     lose("bad runtime option \"%s\"\n", argi0);
 269                 }
 270                 sbcl_argv[argj++] = arg;
 271             }
 272             sbcl_argv[argj] = 0;
 273         }
 274     }
 275
 276     /* If no core file was specified, look for one. */
 277     if (!core) {
 278         char *sbcl_home = getenv("SBCL_HOME");
 279         char *lookhere;
 280         char *stem = "/sbcl.core";
 281         if(!sbcl_home) sbcl_home = SBCL_HOME;
 282         lookhere = (char *) calloc(strlen(sbcl_home) +
 283                                    strlen(stem) +
 284                                    1,
 285                                    sizeof(char));
 286         sprintf(lookhere, "%s%s", sbcl_home, stem);
 287         core = copied_existing_filename_or_null(lookhere);
 288         free(lookhere);
 289         if (!core) {
 290             lose("can't find core file\n");
 291         }
 292     }
 293     /* Make sure that SBCL_HOME is set, no matter where the core was
 294      * found */
 295     if (!getenv("SBCL_HOME")) {
 296         char *envstring, *copied_core, *dir;
 297         char *stem = "SBCL_HOME=";
 298         copied_core = copied_string(core);
 299         dir = dirname(copied_core);
 300         envstring = (char *) calloc(strlen(stem) +
 301                                     strlen(dir) +
 302                                     1,
 303                                     sizeof(char));
 304         sprintf(envstring, "%s%s", stem, dir);
 305         putenv(envstring);
 306         free(copied_core);
 307     }
 308
 309     if (!noinform) {
 310         print_banner();
 311         fflush(stdout);
 312     }
 313
 314 #if defined(SVR4) || defined(__linux__)
 315     tzset();
 316 #endif
 317
 318     define_var("nil", NIL, 1);
 319     define_var("t", T, 1);
 320
 321     set_lossage_handler(monitor_or_something);
 322
 323     globals_init();
 324
 325     initial_function = load_core_file(core);
 326     if (initial_function == NIL) {
 327         lose("couldn't find initial function\n");
 328     }
 329     SHOW("freeing core");
 330     free(core);
 331
 332     gc_initialize_pointers();
 333
 334     arch_install_interrupt_handlers();
 335     os_install_interrupt_handlers();
 336
 337     /* Convert remaining argv values to something that Lisp can grok. */
 338     SHOW("setting POSIX-ARGV symbol value");
 339     SetSymbolValue(POSIX_ARGV, alloc_base_string_list(sbcl_argv),0);
 340     free(sbcl_argv);
 341
 342     FSHOW((stderr, "/funcalling initial_function=0x%lx\n",
 343           (unsigned long)initial_function));
 344     create_initial_thread(initial_function);
 345     lose("CATS.  CATS ARE NICE.\n");
 346     return 0;
 347 }