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