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