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"
52 /* SIGINT handler that invokes the monitor (for when Lisp isn't up to it) */
54 sigint_handler(int signal, siginfo_t *info, void *void_context)
56 lose("\nSIGINT hit at 0x%08lX\n",
57 (unsigned long) *os_context_pc_addr(void_context));
60 /* (This is not static, because we want to be able to call it from
65 SHOW("entering sigint_init()");
66 install_handler(SIGINT, sigint_handler);
67 SHOW("leaving sigint_init()");
71 * helper functions for dealing with command line args
75 successful_malloc(size_t size)
77 void* result = malloc(size);
79 lose("malloc failure");
83 return (void *) NULL; /* dummy value: return something ... */
87 copied_string(char *string)
89 return strcpy(successful_malloc(1+strlen(string)), string);
93 copied_existing_filename_or_null(char *filename)
95 struct stat filename_stat;
96 if (stat(filename, &filename_stat)) { /* if failure */
99 return copied_string(filename);
103 /* Convert a null-terminated array of null-terminated strings (e.g.
104 * argv or envp) into a Lisp list of Lisp strings. */
106 alloc_string_list(char *array_ptr[])
109 return alloc_cons(alloc_string(*array_ptr),
110 alloc_string_list(1 + array_ptr));
117 main(int argc, char *argv[], char *envp[])
119 /* the name of the core file we're to execute. Note that this is
120 * a malloc'ed string which should be freed eventually. */
123 /* other command line options */
124 boolean noinform = 0;
125 boolean end_runtime_options = 0;
127 lispobj initial_function;
129 /* KLUDGE: os_vm_page_size is set by os_init(), and on some
130 * systems (e.g. Alpha) arch_init() needs need os_vm_page_size, so
131 * it must follow os_init(). -- WHN 2000-01-26 */
137 /* Parse our part of the command line (aka "runtime options"),
138 * stripping out those options that we handle. */
141 while (argi < argc) {
142 char *arg = argv[argi];
143 if (0 == strcmp(arg, "--noinform")) {
146 } else if (0 == strcmp(arg, "--core")) {
148 lose("more than one core file specified");
151 core = copied_string(argv[argi]);
153 lose("missing filename for --core argument");
157 } else if (0 == strcmp(arg, "--end-runtime-options")) {
158 end_runtime_options = 1;
162 /* This option was unrecognized as a runtime option,
163 * so it must be a toplevel option or a user option,
164 * so we must be past the end of the runtime option
169 /* This is where we strip out those options that we handle. We
170 * also take this opportunity to make sure that we don't find
171 * an out-of-place "--end-runtime-options" option. */
173 char *argi0 = argv[argi];
175 while (argi < argc) {
176 char *arg = argv[argi++];
177 /* If we encounter --end-runtime-options for the first
178 * time after the point where we had to give up on
179 * runtime options, then the point where we had to
180 * give up on runtime options must've been a user
182 if (!end_runtime_options &&
183 0 == strcmp(arg, "--end-runtime-options")) {
184 lose("bad runtime option \"%s\"", argi0);
193 /* If no core file was specified, look for one. */
195 char *sbcl_home = getenv("SBCL_HOME");
198 char *stem = "/sbcl.core";
199 lookhere = (char *) calloc(strlen(sbcl_home) +
203 sprintf(lookhere, "%s%s", sbcl_home, stem);
204 core = copied_existing_filename_or_null(lookhere);
207 core = copied_existing_filename_or_null("/usr/lib/sbcl.core");
210 copied_existing_filename_or_null("/usr/local/lib/sbcl.core");
214 lose("can't find core file");
220 "This is SBCL %s, an implementation of ANSI Common Lisp.\n\
222 SBCL is derived from the CMU CL system created at Carnegie Mellon University.\n\
223 Besides software and documentation originally created at Carnegie Mellon\n\
224 University, SBCL contains some software originally from the Massachusetts\n\
225 Institute of Technology, Symbolics Incorporated, and Xerox Corporation, and\n\
226 material contributed by volunteers since the release of CMU CL into the\n\
227 public domain. See the CREDITS file in the distribution for more information.\n\
229 SBCL is a free software system, provided as is, with absolutely no warranty.\n\
230 It is mostly in the public domain, but also includes some software copyrighted\n\
231 Massachusetts Institute of Technology, 1986;\n\
232 Symbolics, Inc., 1989, 1990, 1991, 1992; and\n\
233 Xerox Corporation, 1985, 1986, 1987, 1988, 1989, 1990\n\
234 used under BSD-style licenses allowing copying only under certain conditions.\n\
235 See the COPYING file in the distribution for more information.\n\
237 More information about SBCL is available at <http://sbcl.sourceforge.net/>.\n\
238 ", SBCL_VERSION_STRING);
245 #if defined(SVR4) || defined(__linux__)
249 define_var("nil", NIL, 1);
250 define_var("t", T, 1);
252 set_lossage_handler(monitor_or_something);
256 initial_function = load_core_file(core);
257 if (initial_function == NIL) {
258 lose("couldn't find initial function");
260 SHOW("freeing core");
263 gc_initialize_pointers();
265 #ifdef BINDING_STACK_POINTER
266 SetSymbolValue(BINDING_STACK_POINTER, BINDING_STACK_START);
271 arch_install_interrupt_handlers();
272 os_install_interrupt_handlers();
274 #ifdef PSEUDO_ATOMIC_ATOMIC
275 /* Turn on pseudo atomic for when we call into Lisp. */
276 SHOW("turning on pseudo atomic");
277 SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1));
278 SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0));
281 /* Convert remaining argv values to something that Lisp can grok. */
282 SHOW("setting POSIX-ARGV symbol value");
283 SetSymbolValue(POSIX_ARGV, alloc_string_list(argv));
285 /* Install a handler to pick off SIGINT until the Lisp system gets
286 * far enough along to install its own handler. */
289 FSHOW((stderr, "/funcalling initial_function=0x%lx\n", initial_function));
290 funcall0(initial_function);
292 /* initial_function() is not supposed to return. */
293 lose("Lisp initial_function gave up control.");
294 return 0; /* dummy value: return something */