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.
17 #include <sys/types.h>
21 #include <sys/param.h>
32 #include "interrupt.h"
50 /* SIGINT handler that invokes the monitor (for when Lisp isn't up to it) */
52 static void sigint_handler(int signal, siginfo_t *info, void *void_context)
54 printf("\nSIGINT hit at 0x%08lX\n",
55 (unsigned long) *os_context_pc_addr(void_context));
59 /* (This is not static, because we want to be able to call it from
61 void sigint_init(void)
63 install_handler(SIGINT, sigint_handler);
67 * helper functions for dealing with command line args
71 successful_malloc(size_t size)
73 void* result = malloc(size);
75 lose("malloc failure");
79 return (void *) NULL; /* dummy value: return something ... */
83 copied_string(char *string)
85 return strcpy(successful_malloc(1+strlen(string)), string);
89 copied_existing_filename_or_null(char *filename)
91 struct stat filename_stat;
92 if (stat(filename, &filename_stat)) { /* if failure */
95 return copied_string(filename);
99 /* Convert a null-terminated array of null-terminated strings (e.g.
100 * argv or envp) into a Lisp list of Lisp strings. */
102 alloc_string_list(char *array_ptr[])
105 return alloc_cons(alloc_string(*array_ptr),
106 alloc_string_list(1 + array_ptr));
113 main(int argc, char *argv[], char *envp[])
115 /* the name of the core file we're to execute. Note that this is
116 * a malloc'ed string which must be freed eventually. */
119 /* other command line options */
120 boolean noinform = 0;
121 boolean end_runtime_options = 0;
123 lispobj initial_function;
129 /* Parse our part of the command line (aka "runtime options"),
130 * stripping out those options that we handle. */
133 while (argi < argc) {
134 char *arg = argv[argi];
135 if (0 == strcmp(arg, "--noinform")) {
138 } else if (0 == strcmp(arg, "--core")) {
140 lose("more than one core file specified");
143 core = copied_string(argv[argi]);
145 lose("missing filename for --core argument");
149 } else if (0 == strcmp(arg, "--end-runtime-options")) {
150 end_runtime_options = 1;
154 /* This option was unrecognized as a runtime option,
155 * so it must be a toplevel option or a user option,
156 * so we must be past the end of the runtime option
161 /* This is where we strip out those options that we handle. We
162 * also take this opportunity to make sure that we don't find
163 * an out-of-place "--end-runtime-options" option. */
165 char *argi0 = argv[argi];
167 while (argi < argc) {
168 char *arg = argv[argi++];
169 /* If we encounter --end-runtime-options for the first
170 * time after the point where we had to give up on
171 * runtime options, then the point where we had to
172 * give up on runtime options must've been a user
174 if (!end_runtime_options &&
175 0 == strcmp(arg, "--end-runtime-options")) {
176 lose("bad runtime option \"%s\"", argi0);
185 /* If no core file was specified, look for one. */
187 char *sbcl_home = getenv("SBCL_HOME");
190 lookhere = (char *) calloc(strlen("/sbcl.core") + strlen(sbcl_home) + 1,
192 sprintf(lookhere, "%s/sbcl.core", sbcl_home);
193 core = copied_existing_filename_or_null(lookhere);
196 core = copied_existing_filename_or_null("/usr/lib/sbcl.core");
198 core = copied_existing_filename_or_null("/usr/local/lib/sbcl.core");
202 lose("can't find core file");
208 "This is SBCL " SBCL_VERSION_STRING ", an implementation of ANSI Common Lisp.
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
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.
226 More information on SBCL is available at <http://sbcl.sourceforge.net/>.
234 #if defined(SVR4) || defined(__linux__)
238 define_var("nil", NIL, 1);
239 define_var("t", T, 1);
241 set_lossage_handler(ldb_monitor);
250 initial_function = load_core_file(core);
251 if (initial_function == NIL) {
252 lose("couldn't find initial function");
257 gencgc_pickup_dynamic();
259 #if defined WANT_CGC && defined X86_CGC_ACTIVE_P
261 extern int use_cgc_p;
262 lispobj x = SymbolValue(X86_CGC_ACTIVE_P);
263 if (x != type_UnboundMarker && x != NIL) {
264 /* Enable allocator. */
271 #ifdef BINDING_STACK_POINTER
272 SetSymbolValue(BINDING_STACK_POINTER, BINDING_STACK_START);
274 #if defined INTERNAL_GC_TRIGGER && !defined __i386__
275 SetSymbolValue(INTERNAL_GC_TRIGGER, make_fixnum(-1));
280 arch_install_interrupt_handlers();
281 os_install_interrupt_handlers();
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));
289 /* Convert remaining argv values to something that Lisp can grok. */
290 SetSymbolValue(POSIX_ARGV, alloc_string_list(argv));
292 /* Install a handler to pick off SIGINT until the Lisp system gets
293 * far enough along to install its own handler. */
296 funcall0(initial_function);
298 /* initial_function() is not supposed to return. */
299 lose("Lisp initial_function gave up control.");
300 return 0; /* dummy value: return something */