2 * main() entry point for a stand-alone SBCL image
6 * This software is part of the SBCL system. See the README file for
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.
18 #include <sys/types.h>
22 #include <sys/param.h>
25 #if defined(SVR4) || defined(__linux__)
37 #include "interrupt.h"
55 /* SIGINT handler that invokes the monitor (for when Lisp isn't up to it) */
57 sigint_handler(int signal, siginfo_t *info, void *void_context)
59 lose("\nSIGINT hit at 0x%08lX\n",
60 (unsigned long) *os_context_pc_addr(void_context));
63 /* (This is not static, because we want to be able to call it from
68 SHOW("entering sigint_init()");
69 install_handler(SIGINT, sigint_handler);
70 SHOW("leaving sigint_init()");
74 * helper functions for dealing with command line args
78 successful_malloc(size_t size)
80 void* result = malloc(size);
82 lose("malloc failure");
86 return (void *) NULL; /* dummy value: return something ... */
90 copied_string(char *string)
92 return strcpy(successful_malloc(1+strlen(string)), string);
96 copied_existing_filename_or_null(char *filename)
98 struct stat filename_stat;
99 if (stat(filename, &filename_stat)) { /* if failure */
102 return copied_string(filename);
106 /* Convert a null-terminated array of null-terminated strings (e.g.
107 * argv or envp) into a Lisp list of Lisp strings. */
109 alloc_string_list(char *array_ptr[])
112 return alloc_cons(alloc_string(*array_ptr),
113 alloc_string_list(1 + array_ptr));
120 main(int argc, char *argv[], char *envp[])
122 /* the name of the core file we're to execute. Note that this is
123 * a malloc'ed string which should be freed eventually. */
126 /* other command line options */
127 boolean noinform = 0;
128 boolean end_runtime_options = 0;
130 lispobj initial_function;
132 /* KLUDGE: os_vm_page_size is set by os_init(), and on some
133 * systems (e.g. Alpha) arch_init() needs need os_vm_page_size, so
134 * it must follow os_init(). -- WHN 2000-01-26 */
140 /* Parse our part of the command line (aka "runtime options"),
141 * stripping out those options that we handle. */
144 while (argi < argc) {
145 char *arg = argv[argi];
146 if (0 == strcmp(arg, "--noinform")) {
149 } else if (0 == strcmp(arg, "--core")) {
151 lose("more than one core file specified");
154 core = copied_string(argv[argi]);
156 lose("missing filename for --core argument");
160 } else if (0 == strcmp(arg, "--end-runtime-options")) {
161 end_runtime_options = 1;
165 /* This option was unrecognized as a runtime option,
166 * so it must be a toplevel option or a user option,
167 * so we must be past the end of the runtime option
172 /* This is where we strip out those options that we handle. We
173 * also take this opportunity to make sure that we don't find
174 * an out-of-place "--end-runtime-options" option. */
176 char *argi0 = argv[argi];
178 while (argi < argc) {
179 char *arg = argv[argi++];
180 /* If we encounter --end-runtime-options for the first
181 * time after the point where we had to give up on
182 * runtime options, then the point where we had to
183 * give up on runtime options must've been a user
185 if (!end_runtime_options &&
186 0 == strcmp(arg, "--end-runtime-options")) {
187 lose("bad runtime option \"%s\"", argi0);
196 /* If no core file was specified, look for one. */
198 char *sbcl_home = getenv("SBCL_HOME");
201 char *stem = "/sbcl.core";
202 lookhere = (char *) calloc(strlen(sbcl_home) +
206 sprintf(lookhere, "%s%s", sbcl_home, stem);
207 core = copied_existing_filename_or_null(lookhere);
210 core = copied_existing_filename_or_null("/usr/lib/sbcl.core");
213 copied_existing_filename_or_null("/usr/local/lib/sbcl.core");
217 lose("can't find core file");
223 "This is SBCL %s, an implementation of ANSI Common Lisp.\n\
225 SBCL is derived from the CMU CL system created at Carnegie Mellon University.\n\
226 Besides software and documentation originally created at Carnegie Mellon\n\
227 University, SBCL contains some software originally from the Massachusetts\n\
228 Institute of Technology, Symbolics Incorporated, and Xerox Corporation, and\n\
229 material contributed by volunteers since the release of CMU CL into the\n\
230 public domain. See the CREDITS file in the distribution for more information.\n\
232 SBCL is a free software system, provided as is, with absolutely no warranty.\n\
233 It is mostly in the public domain, but also includes some software copyrighted\n\
234 Massachusetts Institute of Technology, 1986;\n\
235 Symbolics, Inc., 1989, 1990, 1991, 1992; and\n\
236 Xerox Corporation, 1985, 1986, 1987, 1988, 1989, 1990\n\
237 used under BSD-style licenses allowing copying only under certain conditions.\n\
238 See the COPYING file in the distribution for more information.\n\
240 More information about SBCL is available at <http://sbcl.sourceforge.net/>.\n\
241 ", SBCL_VERSION_STRING);
248 #if defined(SVR4) || defined(__linux__)
252 define_var("nil", NIL, 1);
253 define_var("t", T, 1);
255 set_lossage_handler(monitor_or_something);
264 initial_function = load_core_file(core);
265 if (initial_function == NIL) {
266 lose("couldn't find initial function");
268 SHOW("freeing core");
272 gencgc_pickup_dynamic();
276 #ifdef BINDING_STACK_POINTER
277 SetSymbolValue(BINDING_STACK_POINTER, BINDING_STACK_START);
282 arch_install_interrupt_handlers();
283 os_install_interrupt_handlers();
285 #ifdef PSEUDO_ATOMIC_ATOMIC
286 /* Turn on pseudo atomic for when we call into Lisp. */
287 SHOW("turning on pseudo atomic");
288 SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1));
289 SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0));
292 /* Convert remaining argv values to something that Lisp can grok. */
293 SHOW("setting POSIX-ARGV symbol value");
294 SetSymbolValue(POSIX_ARGV, alloc_string_list(argv));
296 /* Install a handler to pick off SIGINT until the Lisp system gets
297 * far enough along to install its own handler. */
300 FSHOW((stderr, "/funcalling initial_function=0x%lx\n", initial_function));
301 funcall0(initial_function);
303 /* initial_function() is not supposed to return. */
304 lose("Lisp initial_function gave up control.");
305 return 0; /* dummy value: return something */