0.9.0.39:
[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 <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");
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     setlocale(LC_ALL, "");
195
196     /* KLUDGE: os_vm_page_size is set by os_init(), and on some
197      * systems (e.g. Alpha) arch_init() needs need os_vm_page_size, so
198      * it must follow os_init(). -- WHN 2000-01-26 */
199     os_init();
200     arch_init();
201     gc_init();
202     validate();
203
204     /* Parse our part of the command line (aka "runtime options"),
205      * stripping out those options that we handle. */
206     {
207         int argi = 1;
208         while (argi < argc) {
209             char *arg = argv[argi];
210             if (0 == strcmp(arg, "--noinform")) {
211                 noinform = 1;
212                 ++argi;
213             } else if (0 == strcmp(arg, "--core")) {
214                 if (core) {
215                     lose("more than one core file specified");
216                 } else {
217                     ++argi;
218                     if (argi >= argc) {
219                         lose("missing filename for --core argument");
220                     }
221                     core = copied_string(argv[argi]);
222                     ++argi;
223                 }
224             } else if (0 == strcmp(arg, "--help")) {
225                 /* I think this is the (or a) usual convention: upon
226                  * seeing "--help" we immediately print our help
227                  * string and exit, ignoring everything else. */
228                 print_help();
229                 exit(0);
230             } else if (0 == strcmp(arg, "--version")) {
231                 /* As in "--help" case, I think this is expected. */
232                 print_version();
233                 exit(0);
234             } else if (0 == strcmp(arg, "--end-runtime-options")) {
235                 end_runtime_options = 1;
236                 ++argi;
237                 break;
238             } else {
239                 /* This option was unrecognized as a runtime option,
240                  * so it must be a toplevel option or a user option,
241                  * so we must be past the end of the runtime option
242                  * section. */
243                 break;
244             }
245         }
246         /* This is where we strip out those options that we handle. We
247          * also take this opportunity to make sure that we don't find
248          * an out-of-place "--end-runtime-options" option. */
249         {
250             char *argi0 = argv[argi];
251             int argj = 1;
252             /* (argc - argi) for the arguments, one for the binary,
253                and one for the terminating NULL. */
254             sbcl_argv = successful_malloc((2 + argc - argi) * sizeof(char *));
255             sbcl_argv[0] = argv[0];
256             while (argi < argc) {
257                 char *arg = argv[argi++];
258                 /* If we encounter --end-runtime-options for the first
259                  * time after the point where we had to give up on
260                  * runtime options, then the point where we had to
261                  * give up on runtime options must've been a user
262                  * error. */
263                 if (!end_runtime_options &&
264                     0 == strcmp(arg, "--end-runtime-options")) {
265                     lose("bad runtime option \"%s\"", argi0);
266                 }
267                 sbcl_argv[argj++] = arg;
268             }
269             sbcl_argv[argj] = 0;
270         }
271     }
272
273     /* If no core file was specified, look for one. */
274     if (!core) {
275         char *sbcl_home = getenv("SBCL_HOME");
276         char *lookhere;
277         char *stem = "/sbcl.core";
278         if(!sbcl_home) sbcl_home = SBCL_HOME;
279         lookhere = (char *) calloc(strlen(sbcl_home) +
280                                    strlen(stem) +
281                                    1,
282                                    sizeof(char));
283         sprintf(lookhere, "%s%s", sbcl_home, stem);
284         core = copied_existing_filename_or_null(lookhere);
285         free(lookhere);
286         if (!core) {
287             lose("can't find core file");
288         }
289     }
290     /* Make sure that SBCL_HOME is set, no matter where the core was
291      * found */
292     if (!getenv("SBCL_HOME")) {
293         char *envstring, *copied_core, *dir;
294         char *stem = "SBCL_HOME=";
295         copied_core = copied_string(core);
296         dir = dirname(copied_core);
297         envstring = (char *) calloc(strlen(stem) +
298                                     strlen(dir) + 
299                                     1,
300                                     sizeof(char));
301         sprintf(envstring, "%s%s", stem, dir);
302         putenv(envstring);
303         free(copied_core);
304     }
305     
306     if (!noinform) {
307         print_banner();
308         fflush(stdout);
309     }
310
311 #if defined(SVR4) || defined(__linux__)
312     tzset();
313 #endif
314
315     define_var("nil", NIL, 1);
316     define_var("t", T, 1);
317
318     set_lossage_handler(monitor_or_something);
319
320     globals_init();
321
322     initial_function = load_core_file(core);
323     if (initial_function == NIL) {
324         lose("couldn't find initial function");
325     }
326     SHOW("freeing core");
327     free(core);
328
329     gc_initialize_pointers();
330
331     interrupt_init();
332     arch_install_interrupt_handlers();
333     os_install_interrupt_handlers();
334
335     /* Convert remaining argv values to something that Lisp can grok. */
336     SHOW("setting POSIX-ARGV symbol value");
337     SetSymbolValue(POSIX_ARGV, alloc_base_string_list(sbcl_argv),0);
338     free(sbcl_argv);
339
340     /* Install a handler to pick off SIGINT until the Lisp system gets
341      * far enough along to install its own handler. */
342     sigint_init();
343
344     FSHOW((stderr, "/funcalling initial_function=0x%lx\n", initial_function));
345     create_initial_thread(initial_function);
346     lose("CATS.  CATS ARE NICE.");
347     return 0;
348 }
349