43d98aac57aec53f6a14bd3b25f1b120a40dec10
[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 /*
17  * $Header$
18  */
19
20 #include <stdio.h>
21 #include <sys/types.h>
22 #include <stdlib.h>
23 #include <unistd.h>
24 #include <sys/file.h>
25 #include <sys/param.h>
26 #include <sys/stat.h>
27
28 #include "signal.h"
29
30 #include "runtime.h"
31 #include "sbcl.h"
32 #include "alloc.h"
33 #include "vars.h"
34 #include "globals.h"
35 #include "os.h"
36 #include "interrupt.h"
37 #include "arch.h"
38 #include "gc.h"
39 #include "interr.h"
40 #include "monitor.h"
41 #include "validate.h"
42 #if defined GENCGC
43 #include "gencgc.h"
44 #endif
45 #include "core.h"
46 #include "save.h"
47 #include "lispregs.h"
48
49 #ifdef irix
50 #include <string.h>
51 #include "interr.h"
52 #endif
53 \f
54 /* SIGINT handler that invokes the monitor (for when Lisp isn't up to it) */
55
56 static void sigint_handler(int signal, siginfo_t *info, void *void_context)
57 {
58     printf("\nSIGINT hit at 0x%08lX\n", *os_context_pc_addr(void_context));
59     ldb_monitor();
60 }
61
62 /* (This is not static, because we want to be able to call it from
63  * Lisp land.) */
64 void sigint_init(void)
65 {
66     install_handler(SIGINT, sigint_handler);
67 }
68 \f
69 /*
70  * helper functions for dealing with command line args
71  */
72
73 void *
74 successful_malloc(size_t size)
75 {
76     void* result = malloc(size);
77     if (0 == result) {
78         lose("malloc failure");
79     } else {
80         return result;
81     }
82 }
83
84 char *
85 copied_string(char *string)
86 {
87     return strcpy(successful_malloc(1+strlen(string)), string);
88 }
89
90 char *
91 copied_existing_filename_or_null(char *filename)
92 {
93     struct stat filename_stat;
94     if (stat(filename, &filename_stat)) { /* if failure */
95         return 0;
96     } else {
97         return copied_string(filename);
98     }
99 }
100
101 /* Convert a null-terminated array of null-terminated strings (e.g.
102  * argv or envp) into a Lisp list of Lisp strings. */
103 static lispobj
104 alloc_string_list(char *array_ptr[])
105 {
106     if (*array_ptr) {
107         return alloc_cons(alloc_string(*array_ptr),
108                           alloc_string_list(1 + array_ptr));
109     } else {
110         return NIL;
111     }
112 }
113 \f
114 int
115 main(int argc, char *argv[], char *envp[])
116 {
117     /* the name of the core file we're to execute. Note that this is
118      * a malloc'ed string which must be freed eventually. */
119     char *core = 0;
120
121     /* other command line options */
122     boolean noinform = 0;
123     boolean end_runtime_options = 0;
124
125     lispobj initial_function;
126
127     os_init();
128     gc_init();
129     validate();
130
131     /* Parse our part of the command line (aka "runtime options"),
132      * stripping out those options that we handle. */
133     {
134         int argi = 1;
135         while (argi < argc) {
136             char *arg = argv[argi];
137             if (0 == strcmp(arg, "--noinform")) {
138                 noinform = 1;
139                 ++argi;
140             } else if (0 == strcmp(arg, "--core")) {
141                 if (core) {
142                     lose("more than one core file specified");
143                 } else {
144                     ++argi;
145                     core = copied_string(argv[argi]);
146                     if (argi >= argc) {
147                         lose("missing filename for --core argument");
148                     }
149                     ++argi;
150                 }
151             } else if (0 == strcmp(arg, "--end-runtime-options")) {
152                 end_runtime_options = 1;
153                 ++argi;
154                 break;
155             } else {
156                 /* This option was unrecognized as a runtime option,
157                  * so it must be a toplevel option or a user option,
158                  * so we must be past the end of the runtime option
159                  * section. */
160                 break;
161             }
162         }
163         /* This is where we strip out those options that we handle. We
164          * also take this opportunity to make sure that we don't find
165          * an out-of-place "--end-runtime-options" option. */
166         {
167             char *argi0 = argv[argi];
168             int argj = 1;
169             while (argi < argc) {
170                 char *arg = argv[argi++];
171                 /* If we encounter --end-runtime-options for the first
172                  * time after the point where we had to give up on
173                  * runtime options, then the point where we had to
174                  * give up on runtime options must've been a user
175                  * error. */
176                 if (!end_runtime_options &&
177                     0 == strcmp(arg, "--end-runtime-options")) {
178                     lose("bad runtime option \"%s\"", argi0);
179                 }
180                 argv[argj++] = arg;
181             }
182             argv[argj] = 0;
183             argc = argj;
184         }
185     }
186
187     /* If no core file was specified, look for one. */
188     if (!core) {
189         char *sbcl_home = getenv("SBCL_HOME");
190         if (sbcl_home) {
191             char *lookhere;
192             asprintf(&lookhere, "%s/sbcl.core", sbcl_home);
193             core = copied_existing_filename_or_null(lookhere);
194             free(lookhere);
195         } else {
196             core = copied_existing_filename_or_null("/usr/lib/sbcl.core");
197             if (!core) {
198                 core = copied_existing_filename_or_null("/usr/local/lib/sbcl.core");
199             }
200         }
201         if (!core) {
202             lose("can't find core file");
203         }
204     }
205
206     if (!noinform) {
207         printf(
208 "This is SBCL " SBCL_VERSION_STRING ", an implementation of ANSI Common Lisp.
209
210 SBCL is derived from the CMU CL system created at Carnegie Mellon University.
211 Besides material created at Carnegie Mellon University, and material
212 contributed by volunteers since its release into the public domain, CMU CL
213 contained, and SBCL contains, material copyrighted by
214   Massachusetts Institute of Technology, 1986;
215   Symbolics, Inc., 1989, 1990, 1991, 1992; and
216   Xerox Corporation, 1985, 1986, 1987, 1988, 1989, 1990.
217 More information about the origin of SBCL is available in the CREDITS file
218 in the distribution.
219
220 SBCL is a free software system, provided as is, with absolutely no warranty.
221 It is mostly public domain software, but also includes some software from
222 MIT, Symbolics, and Xerox, used under BSD-style licenses which allow copying
223 only under certain conditions. More information about copying SBCL is
224 available in the COPYING file in the distribution.
225
226 More information on SBCL is available at <http://sbcl.sourceforge.net/>.
227 ");
228         fflush(stdout);
229     }
230
231 #ifdef MACH
232     mach_init();
233 #endif
234 #if defined(SVR4) || defined(__linux__)
235     tzset();
236 #endif
237
238     define_var("nil", NIL, 1);
239     define_var("t", T, 1);
240
241     set_lossage_handler(ldb_monitor);
242
243 #if 0
244     os_init();
245     gc_init();
246     validate();
247 #endif
248     globals_init();
249
250     initial_function = load_core_file(core);
251     if (initial_function == NIL) {
252         lose("couldn't find initial function");
253     }
254     free(core);
255
256 #if defined GENCGC
257     gencgc_pickup_dynamic();
258 #else
259 #if defined WANT_CGC && defined X86_CGC_ACTIVE_P
260     {
261         extern int use_cgc_p;
262         lispobj x = SymbolValue(X86_CGC_ACTIVE_P);
263         if (x != type_UnboundMarker && x != NIL) {
264             /* Enable allocator. */
265             use_cgc_p = 1;              
266         }
267     }
268 #endif
269 #endif
270
271 #ifdef BINDING_STACK_POINTER
272     SetSymbolValue(BINDING_STACK_POINTER, BINDING_STACK_START);
273 #endif
274 #if defined INTERNAL_GC_TRIGGER && !defined __i386__
275     SetSymbolValue(INTERNAL_GC_TRIGGER, make_fixnum(-1));
276 #endif
277
278     interrupt_init();
279
280     arch_install_interrupt_handlers();
281     os_install_interrupt_handlers();
282
283 #ifdef PSEUDO_ATOMIC_ATOMIC
284     /* Turn on pseudo atomic for when we call into Lisp. */
285     SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1));
286     SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0));
287 #endif
288
289     /* Convert remaining argv values to something that Lisp can grok. */
290     SetSymbolValue(POSIX_ARGV, alloc_string_list(argv));
291
292     /* Install a handler to pick off SIGINT until the Lisp system gets
293      * far enough along to install its own handler. */
294     sigint_init();
295
296     funcall0(initial_function);
297
298     /* initial_function() is not supposed to return. */
299     lose("Lisp initial_function gave up control.");
300 }