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