b95ed510aae0d728eeb4e8a6cea50300660ad4ed
[sbcl.git] / 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 <ctype.h>
21 #ifndef LISP_FEATURE_WIN32
22 #include <libgen.h>
23 #endif
24 #include <sys/types.h>
25 #ifndef LISP_FEATURE_WIN32
26 #include <sys/wait.h>
27 #endif
28 #include <stdlib.h>
29 #include <unistd.h>
30 #include <sys/file.h>
31 #include <sys/param.h>
32 #include <sys/stat.h>
33 #include "runtime.h"
34 #ifndef LISP_FEATURE_WIN32
35 #include <sched.h>
36 #endif
37 #include <errno.h>
38 #include <locale.h>
39 #include <limits.h>
40
41 #if defined(SVR4) || defined(__linux__)
42 #include <time.h>
43 #endif
44
45 #if !(defined(LISP_FEATURE_WIN32) && defined(LISP_FEATURE_SB_THREAD))
46 #include "signal.h"
47 #endif
48
49 #include "runtime.h"
50 #include "vars.h"
51 #include "globals.h"
52 #include "os.h"
53 #include "interr.h"
54 #include "alloc.h"
55 #include "interrupt.h"
56 #include "arch.h"
57 #include "gc.h"
58 #include "validate.h"
59 #include "core.h"
60 #include "save.h"
61 #include "lispregs.h"
62 #include "thread.h"
63
64 #include "genesis/static-symbols.h"
65 #include "genesis/symbol.h"
66
67
68 #ifdef irix
69 #include <string.h>
70 #include "interr.h"
71 #endif
72
73 #ifndef SBCL_HOME
74 #define SBCL_HOME SBCL_PREFIX"/lib/sbcl/"
75 #endif
76
77 #ifdef LISP_FEATURE_HPUX
78 extern void *return_from_lisp_stub;
79 #include "genesis/closure.h"
80 #include "genesis/simple-fun.h"
81 #endif
82
83 \f
84 /* SIGINT handler that invokes the monitor (for when Lisp isn't up to it) */
85 static void
86 sigint_handler(int signal, siginfo_t *info, os_context_t *context)
87 {
88     lose("\nSIGINT hit at 0x%08lX\n",
89          (unsigned long) *os_context_pc_addr(context));
90 }
91
92 /* (This is not static, because we want to be able to call it from
93  * Lisp land.) */
94 void
95 sigint_init(void)
96 {
97     SHOW("entering sigint_init()");
98     install_handler(SIGINT, sigint_handler, 1);
99     SHOW("leaving sigint_init()");
100 }
101 \f
102 /*
103  * helper functions for dealing with command line args
104  */
105
106 void *
107 successful_malloc(size_t size)
108 {
109     void* result = malloc(size);
110     if (0 == result) {
111         lose("malloc failure\n");
112     } else {
113         return result;
114     }
115     return (void *) NULL; /* dummy value: return something ... */
116 }
117
118 char *
119 copied_string(char *string)
120 {
121     return strcpy(successful_malloc(1+strlen(string)), string);
122 }
123
124 char *
125 copied_existing_filename_or_null(char *filename)
126 {
127     struct stat filename_stat;
128     if (stat(filename, &filename_stat)) { /* if failure */
129         return 0;
130     } else {
131         return copied_string(filename);
132     }
133 }
134
135 #ifndef LISP_FEATURE_WIN32
136 char *
137 copied_realpath(const char *pathname)
138 {
139     char *messy, *tidy;
140     size_t len;
141
142     /* realpath() supposedly can't be counted on to always return
143      * an absolute path, so we prepend the cwd to relative paths */
144     messy = NULL;
145     if (pathname[0] != '/') {
146         messy = successful_malloc(PATH_MAX + 1);
147         if (getcwd(messy, PATH_MAX + 1) == NULL) {
148             free(messy);
149             return NULL;
150         }
151         len = strlen(messy);
152         snprintf(messy + len, PATH_MAX + 1 - len, "/%s", pathname);
153     }
154
155     tidy = successful_malloc(PATH_MAX + 1);
156     if (realpath((messy ? messy : pathname), tidy) == NULL) {
157         free(messy);
158         free(tidy);
159         return NULL;
160     }
161
162     return tidy;
163 }
164 #endif /* LISP_FEATURE_WIN32 */
165 \f
166 /* miscellaneous chattiness */
167
168 void
169 print_help()
170 {
171     puts(
172 "Usage: sbcl [runtime-options] [toplevel-options] [user-options]\n\
173 Common runtime options:\n\
174   --help                     Print this message and exit.\n\
175   --version                  Print version information and exit.\n\
176   --core <filename>          Use the specified core file instead of the default.\n\
177   --dynamic-space-size <MiB> Size of reserved dynamic space in megabytes.\n\
178   --control-stack-size <MiB> Size of reserved control stack in megabytes.\n\
179 \n\
180 Common toplevel options:\n\
181   --sysinit <filename>       System-wide init-file to use instead of default.\n\
182   --userinit <filename>      Per-user init-file to use instead of default.\n\
183   --no-sysinit               Inhibit processing of any system-wide init-file.\n\
184   --no-userinit              Inhibit processing of any per-user init-file.\n\
185   --disable-debugger         Invoke sb-ext:disable-debugger.\n\
186   --noprint                  Run a Read-Eval Loop without printing results.\n\
187   --script [<filename>]      Skip #! line, disable debugger, avoid verbosity.\n\
188   --quit                     Exit with code 0 after option processing.\n\
189   --non-interactive          Sets both --quit and --disable-debugger.\n\
190 Common toplevel options that are processed in order:\n\
191   --eval <form>              Form to eval when processing this option.\n\
192   --load <filename>          File to load when processing this option.\n\
193 \n\
194 User options are not processed by SBCL. All runtime options must\n\
195 appear before toplevel options, and all toplevel options must\n\
196 appear before user options.\n\
197 \n\
198 For more information please refer to the SBCL User Manual, which\n\
199 should be installed along with SBCL, and is also available from the\n\
200 website <http://www.sbcl.org/>.\n");
201 }
202
203 void
204 print_version()
205 {
206     printf("SBCL %s\n", SBCL_VERSION_STRING);
207 }
208
209 void
210 print_banner()
211 {
212     printf(
213 "This is SBCL %s, an implementation of ANSI Common Lisp.\n\
214 More information about SBCL is available at <http://www.sbcl.org/>.\n\
215 \n\
216 SBCL is free software, provided as is, with absolutely no warranty.\n\
217 It is mostly in the public domain; some portions are provided under\n\
218 BSD-style licenses.  See the CREDITS and COPYING files in the\n\
219 distribution for more information.\n\
220 "
221 #ifdef LISP_FEATURE_WIN32
222 "\n\
223 WARNING: the Windows port is fragile, particularly for multithreaded\n\
224 code.  Unfortunately, the development team currently lacks the time\n\
225 and resources this platform demands.\n\
226 "
227 #endif
228 , SBCL_VERSION_STRING);
229 }
230
231 /* Look for a core file to load, first in the directory named by the
232  * SBCL_HOME environment variable, then in a hardcoded default
233  * location.  Returns a malloced copy of the core filename. */
234 char *
235 search_for_core ()
236 {
237     char *sbcl_home = getenv("SBCL_HOME");
238     char *lookhere;
239     char *stem = "/sbcl.core";
240     char *core;
241
242     if (!(sbcl_home && *sbcl_home)) sbcl_home = SBCL_HOME;
243     lookhere = (char *) calloc(strlen(sbcl_home) +
244                                strlen(stem) +
245                                1,
246                                sizeof(char));
247     sprintf(lookhere, "%s%s", sbcl_home, stem);
248     core = copied_existing_filename_or_null(lookhere);
249
250     if (!core) {
251         lose("can't find core file at %s\n", lookhere);
252     }
253
254     free(lookhere);
255
256     return core;
257 }
258
259 /* Try to find the path to an executable from argv[0], this is only
260  * used when os_get_runtime_executable_path() returns NULL */
261 #ifdef LISP_FEATURE_WIN32
262 char *
263 search_for_executable(const char *argv0)
264 {
265     return NULL;
266 }
267 #else /* LISP_FEATURE_WIN32 */
268 char *
269 search_for_executable(const char *argv0)
270 {
271     char *search, *start, *end, *buf;
272
273     /* If argv[0] contains a slash then it's probably an absolute path
274      * or relative to the current directory, so check if it exists. */
275     if (strchr(argv0, '/') != NULL && access(argv0, F_OK) == 0)
276         return copied_realpath(argv0);
277
278     /* Bail on an absolute path which doesn't exist */
279     if (argv0[0] == '/')
280         return NULL;
281
282     /* Otherwise check if argv[0] exists relative to any directory in PATH */
283     search = getenv("PATH");
284     if (search == NULL)
285         return NULL;
286     search = copied_string(search);
287     buf = successful_malloc(PATH_MAX + 1);
288     for (start = search; (end = strchr(start, ':')) != NULL; start = end + 1) {
289         *end = '\0';
290         snprintf(buf, PATH_MAX + 1, "%s/%s", start, argv0);
291         if (access(buf, F_OK) == 0) {
292             free(search);
293             search = copied_realpath(buf);
294             free(buf);
295             return search;
296         }
297     }
298     /* The above for-loop fails to process the last part of PATH if PATH does
299      * not end with ':'. We may consider appending an extra ':' to the end of
300      * SEARCH.  -- houjingyi 2013-05-24 */
301     if (start != NULL && *start != '\0') {
302         snprintf(buf, PATH_MAX + 1, "%s/%s", start, argv0);
303         if (access(buf, F_OK) == 0) {
304             free(search);
305             search = copied_realpath(buf);
306             free(buf);
307             return search;
308         }
309     }
310
311     free(search);
312     free(buf);
313     return NULL;
314 }
315 #endif /* LISP_FEATURE_WIN32 */
316
317 size_t
318 parse_size_arg(char *arg, char *arg_name)
319 {
320   char *tail, *power_name;
321   size_t power, res;
322
323   res = strtoul(arg, &tail, 0);
324
325   if (arg == tail) {
326     lose("%s argument is not a number: %s", arg_name, arg);
327   } else if (tail[0]) {
328     int i, size;
329     power_name = copied_string(tail);
330     size = strlen(power_name);
331     for (i=0; i<size; i++)
332       power_name[i] = toupper(power_name[i]);
333   } else {
334     power = 20;
335     power_name = NULL;
336   }
337   if (power_name) {
338     if ((0==strcmp("KB", power_name)) ||
339         (0==strcmp("KIB", power_name))) {
340       power = 10;
341     } else if ((0==strcmp("MB", power_name)) ||
342                (0==strcmp("MIB", power_name))) {
343       power = 20;
344     } else if ((0==strcmp("GB", power_name)) ||
345                (0==strcmp("GIB", power_name))) {
346       power = 30;
347     } else {
348       lose("%s argument has an unknown suffix: %s", arg_name, tail);
349     }
350     free(power_name);
351   }
352   if ((res <= 0) ||
353       (res >= (SIZE_MAX >> power))) {
354     lose("%s argument is out of range: %s", arg_name, arg);
355   }
356   res <<= power;
357   return res;
358 }
359
360 char **posix_argv;
361 char *core_string;
362
363 struct runtime_options *runtime_options;
364
365 char *saved_runtime_path = NULL;
366 #if defined(LISP_FEATURE_WIN32) && defined(LISP_FEATURE_SB_THREAD)
367 void pthreads_win32_init();
368 #endif
369
370 void print_locale_variable(const char *name)
371 {
372   char *value = getenv(name);
373
374   if (value) {
375     fprintf(stderr, "\n  %s=%s", name, value);
376   }
377 }
378
379 void setup_locale()
380 {
381   if(setlocale(LC_ALL, "") == NULL) {
382 #ifndef LISP_FEATURE_WIN32
383
384     fprintf(stderr, "WARNING: Setting locale failed.\n");
385     fprintf(stderr, "  Check the following variables for correct values:");
386
387     if (setlocale(LC_CTYPE, "") == NULL) {
388       print_locale_variable("LC_ALL");
389       print_locale_variable("LC_CTYPE");
390       print_locale_variable("LANG");
391     }
392
393     if (setlocale(LC_MESSAGES, "") == NULL) {
394       print_locale_variable("LC_MESSAGES");
395     }
396     if (setlocale(LC_COLLATE, "") == NULL) {
397       print_locale_variable("LC_COLLATE");
398     }
399     if (setlocale(LC_MONETARY, "") == NULL) {
400       print_locale_variable("LC_MONETARY");
401     }
402     if (setlocale(LC_NUMERIC, "") == NULL) {
403       print_locale_variable("LC_NUMERIC");
404     }
405     if (setlocale(LC_TIME, "") == NULL) {
406       print_locale_variable("LC_TIME");
407     }
408     fprintf(stderr, "\n");
409
410 #endif
411   }
412 }
413
414 \f
415 int
416 main(int argc, char *argv[], char *envp[])
417 {
418 #ifdef LISP_FEATURE_WIN32
419     /* Exception handling support structure. Evil Win32 hack. */
420     struct lisp_exception_frame exception_frame;
421 #endif
422
423     /* the name of the core file we're to execute. Note that this is
424      * a malloc'ed string which should be freed eventually. */
425     char *core = 0;
426     char **sbcl_argv = 0;
427     os_vm_offset_t embedded_core_offset = 0;
428     char *runtime_path = 0;
429
430     /* other command line options */
431     boolean noinform = 0;
432     boolean end_runtime_options = 0;
433     boolean disable_lossage_handler_p = 0;
434
435     lispobj initial_function;
436     const char *sbcl_home = getenv("SBCL_HOME");
437
438 #if defined(LISP_FEATURE_WIN32) && defined(LISP_FEATURE_SB_THREAD)
439     os_preinit();
440     pthreads_win32_init();
441 #endif
442
443     interrupt_init();
444     block_blockable_signals(0, 0);
445
446     runtime_options = NULL;
447
448     /* Save the argv[0] derived runtime path in case
449      * os_get_runtime_executable_path(1) isn't able to get an
450      * externally-usable path later on. */
451     saved_runtime_path = search_for_executable(argv[0]);
452
453     /* Check early to see if this executable has an embedded core,
454      * which also populates runtime_options if the core has runtime
455      * options */
456     runtime_path = os_get_runtime_executable_path(0);
457     if (runtime_path || saved_runtime_path) {
458         os_vm_offset_t offset = search_for_embedded_core(
459             runtime_path ? runtime_path : saved_runtime_path);
460         if (offset != -1) {
461             embedded_core_offset = offset;
462             core = (runtime_path ? runtime_path :
463                     copied_string(saved_runtime_path));
464         } else {
465             if (runtime_path)
466                 free(runtime_path);
467         }
468     }
469
470
471     /* Parse our part of the command line (aka "runtime options"),
472      * stripping out those options that we handle. */
473     if (runtime_options != NULL) {
474         dynamic_space_size = runtime_options->dynamic_space_size;
475         thread_control_stack_size = runtime_options->thread_control_stack_size;
476         sbcl_argv = argv;
477     } else {
478         int argi = 1;
479
480         runtime_options = successful_malloc(sizeof(struct runtime_options));
481
482         while (argi < argc) {
483             char *arg = argv[argi];
484             if (0 == strcmp(arg, "--script")) {
485                 /* This is both a runtime and a toplevel option. As a
486                  * runtime option, it is equivalent to --noinform.
487                  * This exits, and does not increment argi, so that
488                  * TOPLEVEL-INIT sees the option. */
489                 noinform = 1;
490                 end_runtime_options = 1;
491                 disable_lossage_handler_p = 1;
492                 lose_on_corruption_p = 1;
493                 break;
494             } else if (0 == strcmp(arg, "--noinform")) {
495                 noinform = 1;
496                 ++argi;
497             } else if (0 == strcmp(arg, "--core")) {
498                 if (core) {
499                     lose("more than one core file specified\n");
500                 } else {
501                     ++argi;
502                     if (argi >= argc) {
503                         lose("missing filename for --core argument\n");
504                     }
505                     core = copied_string(argv[argi]);
506                     ++argi;
507                 }
508             } else if (0 == strcmp(arg, "--help")) {
509                 /* I think this is the (or a) usual convention: upon
510                  * seeing "--help" we immediately print our help
511                  * string and exit, ignoring everything else. */
512                 print_help();
513                 exit(0);
514             } else if (0 == strcmp(arg, "--version")) {
515                 /* As in "--help" case, I think this is expected. */
516                 print_version();
517                 exit(0);
518             } else if (0 == strcmp(arg, "--dynamic-space-size")) {
519                 ++argi;
520                 if (argi >= argc)
521                     lose("missing argument for --dynamic-space-size");
522                   dynamic_space_size = parse_size_arg(argv[argi++], "--dynamic-space-size");
523 #               ifdef MAX_DYNAMIC_SPACE_END
524                 if (!((DYNAMIC_SPACE_START <
525                        DYNAMIC_SPACE_START+dynamic_space_size) &&
526                       (DYNAMIC_SPACE_START+dynamic_space_size <=
527                        MAX_DYNAMIC_SPACE_END)))
528                   lose("--dynamic-space-size argument %s is too large, max %lu",
529                        argv[argi-1], MAX_DYNAMIC_SPACE_END-DYNAMIC_SPACE_START);
530 #               endif
531             } else if (0 == strcmp(arg, "--control-stack-size")) {
532                 ++argi;
533                 if (argi >= argc)
534                     lose("missing argument for --control-stack-size");
535                 errno = 0;
536                 thread_control_stack_size = parse_size_arg(argv[argi++], "--control-stack-size");
537             } else if (0 == strcmp(arg, "--debug-environment")) {
538                 int n = 0;
539                 printf("; Commandline arguments:\n");
540                 while (n < argc) {
541                     printf(";  %2d: \"%s\"\n", n, argv[n]);
542                     ++n;
543                 }
544                 n = 0;
545                 printf(";\n; Environment:\n");
546                 while (ENVIRON[n]) {
547                     printf(";  %2d: \"%s\"\n", n, ENVIRON[n]);
548                     ++n;
549                 }
550                 ++argi;
551             } else if (0 == strcmp(arg, "--disable-ldb")) {
552                 disable_lossage_handler_p = 1;
553                 ++argi;
554             } else if (0 == strcmp(arg, "--lose-on-corruption")) {
555                 lose_on_corruption_p = 1;
556                 ++argi;
557             } else if (0 == strcmp(arg, "--end-runtime-options")) {
558                 end_runtime_options = 1;
559                 ++argi;
560                 break;
561             } else if (0 == strcmp(arg, "--merge-core-pages")) {
562                 ++argi;
563                 merge_core_pages = 1;
564             } else if (0 == strcmp(arg, "--no-merge-core-pages")) {
565                 ++argi;
566                 merge_core_pages = 0;
567             } else if (0 == strcmp(arg, "--default-merge-core-pages")) {
568                 ++argi;
569                 merge_core_pages = -1;
570             } else {
571                 /* This option was unrecognized as a runtime option,
572                  * so it must be a toplevel option or a user option,
573                  * so we must be past the end of the runtime option
574                  * section. */
575                 break;
576             }
577         }
578         /* This is where we strip out those options that we handle. We
579          * also take this opportunity to make sure that we don't find
580          * an out-of-place "--end-runtime-options" option. */
581         {
582             char *argi0 = argv[argi];
583             int argj = 1;
584             /* (argc - argi) for the arguments, one for the binary,
585                and one for the terminating NULL. */
586             sbcl_argv = successful_malloc((2 + argc - argi) * sizeof(char *));
587             sbcl_argv[0] = argv[0];
588             while (argi < argc) {
589                 char *arg = argv[argi++];
590                 /* If we encounter --end-runtime-options for the first
591                  * time after the point where we had to give up on
592                  * runtime options, then the point where we had to
593                  * give up on runtime options must've been a user
594                  * error. */
595                 if (!end_runtime_options &&
596                     0 == strcmp(arg, "--end-runtime-options")) {
597                     lose("bad runtime option \"%s\"\n", argi0);
598                 }
599                 sbcl_argv[argj++] = arg;
600             }
601             sbcl_argv[argj] = 0;
602         }
603     }
604
605     /* Align down to multiple of page_table page size, and to the appropriate
606      * stack alignment. */
607     dynamic_space_size &= ~(sword_t)(PAGE_BYTES-1);
608 #ifdef LISP_FEATURE_GENCGC
609     dynamic_space_size &= ~(sword_t)(GENCGC_CARD_BYTES-1);
610 #endif
611     thread_control_stack_size &= ~(sword_t)(CONTROL_STACK_ALIGNMENT_BYTES-1);
612
613     /* Preserve the runtime options for possible future core saving */
614     runtime_options->dynamic_space_size = dynamic_space_size;
615     runtime_options->thread_control_stack_size = thread_control_stack_size;
616
617     /* KLUDGE: os_vm_page_size is set by os_init(), and on some
618      * systems (e.g. Alpha) arch_init() needs need os_vm_page_size, so
619      * it must follow os_init(). -- WHN 2000-01-26 */
620     os_init(argv, envp);
621     dyndebug_init(); /* after os_init: do not print output before execve */
622     arch_init();
623     gc_init();
624     validate();
625
626     setup_locale();
627
628     /* If no core file was specified, look for one. */
629     if (!core) {
630         core = search_for_core();
631     }
632
633     /* Make sure that SBCL_HOME is set and not the empty string,
634        unless loading an embedded core. */
635     if (!(sbcl_home && *sbcl_home) && embedded_core_offset == 0) {
636         char *envstring, *copied_core, *dir;
637         char *stem = "SBCL_HOME=";
638         copied_core = copied_string(core);
639         dir = dirname(copied_core);
640         envstring = (char *) calloc(strlen(stem) +
641                                     strlen(dir) +
642                                     1,
643                                     sizeof(char));
644         sprintf(envstring, "%s%s", stem, dir);
645         putenv(envstring);
646         free(copied_core);
647     }
648
649     if (!noinform && embedded_core_offset == 0) {
650         print_banner();
651         fflush(stdout);
652     }
653
654     if (embedded_core_offset == 0) {
655         /* Here we make a last attempt at recognizing an embedded core,
656          * so that a file with an embedded core is a valid argument to
657          * --core.  We take care that any decisions on special behaviour
658          * (suppressed banner, embedded options) have already been made
659          * before we reach this block, so that there is no observable
660          * difference between "embedded" and "bare" images given to
661          * --core. */
662         os_vm_offset_t offset = search_for_embedded_core(core);
663         if (offset != -1)
664             embedded_core_offset = offset;
665     }
666
667 #if defined(SVR4) || defined(__linux__) || defined(__NetBSD__)
668     tzset();
669 #endif
670
671     define_var("nil", NIL, 1);
672     define_var("t", T, 1);
673
674     if (!disable_lossage_handler_p)
675         enable_lossage_handler();
676
677     globals_init();
678
679     initial_function = load_core_file(core, embedded_core_offset);
680     if (initial_function == NIL) {
681         lose("couldn't find initial function\n");
682     }
683 #ifdef LISP_FEATURE_SB_DYNAMIC_CORE
684     os_link_runtime();
685 #endif
686 #ifdef LISP_FEATURE_HPUX
687     /* -1 = CLOSURE_FUN_OFFSET, 23 = SIMPLE_FUN_CODE_OFFSET, we are
688      * not in LANGUAGE_ASSEMBLY so we cant reach them. */
689     return_from_lisp_stub = (void *) ((char *)*((unsigned long *)
690                  ((char *)initial_function + -1)) + 23);
691 #endif
692
693     gc_initialize_pointers();
694
695     arch_install_interrupt_handlers();
696 #ifndef LISP_FEATURE_WIN32
697     os_install_interrupt_handlers();
698 #else
699 /*     wos_install_interrupt_handlers(handler); */
700     wos_install_interrupt_handlers(&exception_frame);
701 #endif
702
703     /* Pass core filename and the processed argv into Lisp. They'll
704      * need to be processed further there, to do locale conversion.
705      */
706     core_string = core;
707     posix_argv = sbcl_argv;
708
709     FSHOW((stderr, "/funcalling initial_function=0x%lx\n",
710           (unsigned long)initial_function));
711     create_initial_thread(initial_function);
712     lose("unexpected return from initial thread in main()\n");
713     return 0;
714 }