1.0.23.59: bug 3b has been fixed a while now
[sbcl/tcr.git] / src / runtime / runtime.c
blob2d0e68da4bad304ec10ebac011688acb2b0bf178
1 /*
2 * main() entry point for a stand-alone SBCL image
3 */
5 /*
6 * This software is part of the SBCL system. See the README file for
7 * more information.
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.
16 #include "sbcl.h"
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>
39 #if defined(SVR4) || defined(__linux__)
40 #include <time.h>
41 #endif
43 #include "signal.h"
45 #include "runtime.h"
46 #include "alloc.h"
47 #include "vars.h"
48 #include "globals.h"
49 #include "os.h"
50 #include "interrupt.h"
51 #include "arch.h"
52 #include "gc.h"
53 #include "interr.h"
54 #include "validate.h"
55 #include "core.h"
56 #include "save.h"
57 #include "lispregs.h"
58 #include "thread.h"
60 #include "genesis/static-symbols.h"
61 #include "genesis/symbol.h"
64 #ifdef irix
65 #include <string.h>
66 #include "interr.h"
67 #endif
69 #ifndef SBCL_HOME
70 #define SBCL_HOME "/usr/local/lib/sbcl/"
71 #endif
74 /* SIGINT handler that invokes the monitor (for when Lisp isn't up to it) */
75 static void
76 sigint_handler(int signal, siginfo_t *info, void *void_context)
78 lose("\nSIGINT hit at 0x%08lX\n",
79 (unsigned long) *os_context_pc_addr(void_context));
82 /* (This is not static, because we want to be able to call it from
83 * Lisp land.) */
84 void
85 sigint_init(void)
87 SHOW("entering sigint_init()");
88 install_handler(SIGINT, sigint_handler);
89 SHOW("leaving sigint_init()");
93 * helper functions for dealing with command line args
96 void *
97 successful_malloc(size_t size)
99 void* result = malloc(size);
100 if (0 == result) {
101 lose("malloc failure\n");
102 } else {
103 return result;
105 return (void *) NULL; /* dummy value: return something ... */
108 char *
109 copied_string(char *string)
111 return strcpy(successful_malloc(1+strlen(string)), string);
114 char *
115 copied_existing_filename_or_null(char *filename)
117 struct stat filename_stat;
118 if (stat(filename, &filename_stat)) { /* if failure */
119 return 0;
120 } else {
121 return copied_string(filename);
125 /* miscellaneous chattiness */
127 void
128 print_help()
130 puts(
131 "Usage: sbcl [runtime-options] [toplevel-options] [user-options]\n\
132 Common runtime options:\n\
133 --help Print this message and exit.\n\
134 --version Print version information and exit.\n\
135 --core <filename> Use the specified core file instead of the default.\n\
136 --dynamic-space-size <MiB> Size of reserved dynamic space in megabytes.\n\
137 --control-stack-size <MiB> Size of reserved control stack in megabytes.\n\
139 Common toplevel options:\n\
140 --sysinit <filename> System-wide init-file to use instead of default.\n\
141 --userinit <filename> Per-user init-file to use instead of default.\n\
142 --no-sysinit Inhibit processing of any system-wide init-file.\n\
143 --no-userinit Inhibit processing of any per-user init-file.\n\
145 User options are not processed by SBCL. All runtime options must\n\
146 appear before toplevel options, and all toplevel options must\n\
147 appear before user options.\n\
149 For more information please refer to the SBCL User Manual, which\n\
150 should be installed along with SBCL, and is also available from the\n\
151 website <http://www.sbcl.org/>.\n");
154 void
155 print_version()
157 printf("SBCL %s\n", SBCL_VERSION_STRING);
160 void
161 print_banner()
163 printf(
164 "This is SBCL %s, an implementation of ANSI Common Lisp.\n\
165 More information about SBCL is available at <http://www.sbcl.org/>.\n\
167 SBCL is free software, provided as is, with absolutely no warranty.\n\
168 It is mostly in the public domain; some portions are provided under\n\
169 BSD-style licenses. See the CREDITS and COPYING files in the\n\
170 distribution for more information.\n\
171 ", SBCL_VERSION_STRING);
174 /* Look for a core file to load, first in the directory named by the
175 * SBCL_HOME environment variable, then in a hardcoded default
176 * location. Returns a malloced copy of the core filename. */
177 char *
178 search_for_core ()
180 char *sbcl_home = getenv("SBCL_HOME");
181 char *lookhere;
182 char *stem = "/sbcl.core";
183 char *core;
185 if (!(sbcl_home && *sbcl_home)) sbcl_home = SBCL_HOME;
186 lookhere = (char *) calloc(strlen(sbcl_home) +
187 strlen(stem) +
189 sizeof(char));
190 sprintf(lookhere, "%s%s", sbcl_home, stem);
191 core = copied_existing_filename_or_null(lookhere);
193 if (!core) {
194 lose("can't find core file at %s\n", lookhere);
197 free(lookhere);
199 return core;
202 char **posix_argv;
203 char *core_string;
205 struct runtime_options *runtime_options;
209 main(int argc, char *argv[], char *envp[])
211 #ifdef LISP_FEATURE_WIN32
212 /* Exception handling support structure. Evil Win32 hack. */
213 struct lisp_exception_frame exception_frame;
214 #endif
216 /* the name of the core file we're to execute. Note that this is
217 * a malloc'ed string which should be freed eventually. */
218 char *core = 0;
219 char **sbcl_argv = 0;
220 os_vm_offset_t embedded_core_offset = 0;
221 char *runtime_path = 0;
223 /* other command line options */
224 boolean noinform = 0;
225 boolean end_runtime_options = 0;
227 lispobj initial_function;
228 const char *sbcl_home = getenv("SBCL_HOME");
230 interrupt_init();
231 block_blockable_signals();
233 setlocale(LC_ALL, "");
235 runtime_options = NULL;
237 /* Check early to see if this executable has an embedded core,
238 * which also populates runtime_options if the core has runtime
239 * options */
240 runtime_path = os_get_runtime_executable_path();
241 if (runtime_path) {
242 os_vm_offset_t offset = search_for_embedded_core(runtime_path);
243 if (offset != -1) {
244 embedded_core_offset = offset;
245 core = runtime_path;
246 } else {
247 free(runtime_path);
252 /* Parse our part of the command line (aka "runtime options"),
253 * stripping out those options that we handle. */
254 if (runtime_options != NULL) {
255 dynamic_space_size = runtime_options->dynamic_space_size;
256 thread_control_stack_size = runtime_options->thread_control_stack_size;
257 sbcl_argv = argv;
258 } else {
259 int argi = 1;
261 runtime_options = successful_malloc(sizeof(struct runtime_options));
263 while (argi < argc) {
264 char *arg = argv[argi];
265 if (0 == strcmp(arg, "--script")) {
266 /* This is both a runtime and a toplevel option. As a
267 * runtime option, it is equivalent to --noinform.
268 * This exits, and does not increment argi, so that
269 * TOPLEVEL-INIT sees the option. */
270 noinform = 1;
271 end_runtime_options = 1;
272 break;
273 } else if (0 == strcmp(arg, "--noinform")) {
274 noinform = 1;
275 ++argi;
276 } else if (0 == strcmp(arg, "--core")) {
277 if (core) {
278 lose("more than one core file specified\n");
279 } else {
280 ++argi;
281 if (argi >= argc) {
282 lose("missing filename for --core argument\n");
284 core = copied_string(argv[argi]);
285 ++argi;
287 } else if (0 == strcmp(arg, "--help")) {
288 /* I think this is the (or a) usual convention: upon
289 * seeing "--help" we immediately print our help
290 * string and exit, ignoring everything else. */
291 print_help();
292 exit(0);
293 } else if (0 == strcmp(arg, "--version")) {
294 /* As in "--help" case, I think this is expected. */
295 print_version();
296 exit(0);
297 } else if (0 == strcmp(arg, "--dynamic-space-size")) {
298 ++argi;
299 if (argi >= argc)
300 lose("missing argument for --dynamic-space-size");
301 errno = 0;
302 dynamic_space_size = strtol(argv[argi++], 0, 0) << 20;
303 if (errno)
304 lose("argument to --dynamic-space-size is not a number");
305 } else if (0 == strcmp(arg, "--control-stack-size")) {
306 ++argi;
307 if (argi >= argc)
308 lose("missing argument for --control-stack-size");
309 errno = 0;
310 thread_control_stack_size = strtol(argv[argi++], 0, 0) << 20;
311 if (errno)
312 lose("argument to --dynamic-space-size is not a number");
313 } else if (0 == strcmp(arg, "--debug-environment")) {
314 int n = 0;
315 printf("; Commandline arguments:\n");
316 while (n < argc) {
317 printf("; %2d: \"%s\"\n", n, argv[n]);
318 ++n;
320 n = 0;
321 printf(";\n; Environment:\n");
322 while (ENVIRON[n]) {
323 printf("; %2d: \"%s\"\n", n, ENVIRON[n]);
324 ++n;
326 ++argi;
327 } else if (0 == strcmp(arg, "--end-runtime-options")) {
328 end_runtime_options = 1;
329 ++argi;
330 break;
331 } else {
332 /* This option was unrecognized as a runtime option,
333 * so it must be a toplevel option or a user option,
334 * so we must be past the end of the runtime option
335 * section. */
336 break;
339 /* This is where we strip out those options that we handle. We
340 * also take this opportunity to make sure that we don't find
341 * an out-of-place "--end-runtime-options" option. */
343 char *argi0 = argv[argi];
344 int argj = 1;
345 /* (argc - argi) for the arguments, one for the binary,
346 and one for the terminating NULL. */
347 sbcl_argv = successful_malloc((2 + argc - argi) * sizeof(char *));
348 sbcl_argv[0] = argv[0];
349 while (argi < argc) {
350 char *arg = argv[argi++];
351 /* If we encounter --end-runtime-options for the first
352 * time after the point where we had to give up on
353 * runtime options, then the point where we had to
354 * give up on runtime options must've been a user
355 * error. */
356 if (!end_runtime_options &&
357 0 == strcmp(arg, "--end-runtime-options")) {
358 lose("bad runtime option \"%s\"\n", argi0);
360 sbcl_argv[argj++] = arg;
362 sbcl_argv[argj] = 0;
366 /* Align down to multiple of page_table page size, and to the appropriate
367 * stack alignment. */
368 dynamic_space_size &= ~(PAGE_BYTES-1);
369 thread_control_stack_size &= ~(CONTROL_STACK_ALIGNMENT_BYTES-1);
371 /* Preserve the runtime options for possible future core saving */
372 runtime_options->dynamic_space_size = dynamic_space_size;
373 runtime_options->thread_control_stack_size = thread_control_stack_size;
375 /* KLUDGE: os_vm_page_size is set by os_init(), and on some
376 * systems (e.g. Alpha) arch_init() needs need os_vm_page_size, so
377 * it must follow os_init(). -- WHN 2000-01-26 */
378 os_init(argv, envp);
379 arch_init();
380 gc_init();
381 validate();
383 /* If no core file was specified, look for one. */
384 if (!core) {
385 core = search_for_core();
388 /* Make sure that SBCL_HOME is set and not the empty string,
389 unless loading an embedded core. */
390 if (!(sbcl_home && *sbcl_home) && embedded_core_offset == 0) {
391 char *envstring, *copied_core, *dir;
392 char *stem = "SBCL_HOME=";
393 copied_core = copied_string(core);
394 dir = dirname(copied_core);
395 envstring = (char *) calloc(strlen(stem) +
396 strlen(dir) +
398 sizeof(char));
399 sprintf(envstring, "%s%s", stem, dir);
400 putenv(envstring);
401 free(copied_core);
404 if (!noinform && embedded_core_offset == 0) {
405 print_banner();
406 fflush(stdout);
409 #if defined(SVR4) || defined(__linux__)
410 tzset();
411 #endif
413 define_var("nil", NIL, 1);
414 define_var("t", T, 1);
416 enable_lossage_handler();
418 globals_init();
420 initial_function = load_core_file(core, embedded_core_offset);
421 if (initial_function == NIL) {
422 lose("couldn't find initial function\n");
425 gc_initialize_pointers();
427 arch_install_interrupt_handlers();
428 #ifndef LISP_FEATURE_WIN32
429 os_install_interrupt_handlers();
430 #else
431 /* wos_install_interrupt_handlers(handler); */
432 wos_install_interrupt_handlers(&exception_frame);
433 #endif
435 /* Pass core filename and the processed argv into Lisp. They'll
436 * need to be processed further there, to do locale conversion.
438 core_string = core;
439 posix_argv = sbcl_argv;
441 FSHOW((stderr, "/funcalling initial_function=0x%lx\n",
442 (unsigned long)initial_function));
443 #ifdef LISP_FEATURE_WIN32
444 fprintf(stderr, "\n\
445 This is experimental prerelease support for the Windows platform: use\n\
446 at your own risk. \"Your Kitten of Death awaits!\"\n");
447 fflush(stdout);
448 fflush(stderr);
449 #endif
450 create_initial_thread(initial_function);
451 lose("CATS. CATS ARE NICE.\n");
452 return 0;