* files for more information.
*/
+#include "sbcl.h"
+
#include <stdio.h>
+#include <string.h>
+#include <libgen.h>
#include <sys/types.h>
+#include <sys/wait.h>
#include <stdlib.h>
#include <unistd.h>
#include <sys/file.h>
#include <sys/param.h>
#include <sys/stat.h>
+#include <signal.h>
+#include <sched.h>
+#include <errno.h>
+#include <locale.h>
+
+#if defined(SVR4) || defined(__linux__)
+#include <time.h>
+#endif
#include "signal.h"
#include "runtime.h"
-#include "sbcl.h"
#include "alloc.h"
#include "vars.h"
#include "globals.h"
#include "interr.h"
#include "monitor.h"
#include "validate.h"
-#if defined GENCGC
-#include "gencgc.h"
-#endif
#include "core.h"
#include "save.h"
#include "lispregs.h"
+#include "thread.h"
+
+#include "genesis/static-symbols.h"
+#include "genesis/symbol.h"
+
#ifdef irix
#include <string.h>
#include "interr.h"
#endif
+
+#ifndef SBCL_HOME
+#define SBCL_HOME "/usr/local/lib/sbcl/"
+#endif
+
\f
/* SIGINT handler that invokes the monitor (for when Lisp isn't up to it) */
-
-static void sigint_handler(int signal, siginfo_t *info, void *void_context)
+static void
+sigint_handler(int signal, siginfo_t *info, void *void_context)
{
- printf("\nSIGINT hit at 0x%08lX\n",
- (unsigned long) *os_context_pc_addr(void_context));
- ldb_monitor();
+ lose("\nSIGINT hit at 0x%08lX\n",
+ (unsigned long) *os_context_pc_addr(void_context));
}
/* (This is not static, because we want to be able to call it from
* Lisp land.) */
-void sigint_init(void)
+void
+sigint_init(void)
{
+ SHOW("entering sigint_init()");
install_handler(SIGINT, sigint_handler);
+ SHOW("leaving sigint_init()");
}
\f
/*
}
/* Convert a null-terminated array of null-terminated strings (e.g.
- * argv or envp) into a Lisp list of Lisp strings. */
+ * argv or envp) into a Lisp list of Lisp base-strings. */
static lispobj
-alloc_string_list(char *array_ptr[])
+alloc_base_string_list(char *array_ptr[])
{
if (*array_ptr) {
- return alloc_cons(alloc_string(*array_ptr),
- alloc_string_list(1 + array_ptr));
+ return alloc_cons(alloc_base_string(*array_ptr),
+ alloc_base_string_list(1 + array_ptr));
} else {
return NIL;
}
}
\f
+/* miscellaneous chattiness */
+
+void
+print_help()
+{
+ puts(
+"SBCL is a Common Lisp programming environment. Ordinarily you shouldn't\n\
+need command line options when you invoke it interactively: you can just\n\
+start it and work with the customary Lisp READ-EVAL-PRINT loop.\n\
+\n\
+One option idiom which is sometimes useful interactively (e.g. when\n\
+exercising a test case for a bug report) is\n\
+ sbcl --sysinit /dev/null --userinit /dev/null\n\
+to keep SBCL from reading any initialization files at startup. And some\n\
+people like to suppress the default startup message:\n\
+ sbcl --noinform\n\
+\n\
+Other options can be useful when you're running SBCL noninteractively,\n\
+e.g. from a script, or if you have a strange system configuration, so\n\
+that SBCL can't by default find one of the files it needs. For\n\
+information on such options, see the sbcl(1) man page.\n\
+\n\
+More information on SBCL can be found on its man page, or at\n\
+<http://sbcl.sf.net/>.\n");
+}
+
+void
+print_version()
+{
+ printf("SBCL %s\n", SBCL_VERSION_STRING);
+}
+
+void
+print_banner()
+{
+ printf(
+"This is SBCL %s, an implementation of ANSI Common Lisp.\n\
+More information about SBCL is available at <http://www.sbcl.org/>.\n\
+\n\
+SBCL is free software, provided as is, with absolutely no warranty.\n\
+It is mostly in the public domain; some portions are provided under\n\
+BSD-style licenses. See the CREDITS and COPYING files in the\n\
+distribution for more information.\n\
+", SBCL_VERSION_STRING);
+}
+
+\f
int
main(int argc, char *argv[], char *envp[])
{
lispobj initial_function;
+ setlocale(LC_ALL, "");
+
/* KLUDGE: os_vm_page_size is set by os_init(), and on some
* systems (e.g. Alpha) arch_init() needs need os_vm_page_size, so
* it must follow os_init(). -- WHN 2000-01-26 */
lose("more than one core file specified");
} else {
++argi;
- core = copied_string(argv[argi]);
if (argi >= argc) {
lose("missing filename for --core argument");
}
+ core = copied_string(argv[argi]);
++argi;
}
+ } else if (0 == strcmp(arg, "--help")) {
+ /* I think this is the (or a) usual convention: upon
+ * seeing "--help" we immediately print our help
+ * string and exit, ignoring everything else. */
+ print_help();
+ exit(0);
+ } else if (0 == strcmp(arg, "--version")) {
+ /* As in "--help" case, I think this is expected. */
+ print_version();
+ exit(0);
} else if (0 == strcmp(arg, "--end-runtime-options")) {
end_runtime_options = 1;
++argi;
/* If no core file was specified, look for one. */
if (!core) {
char *sbcl_home = getenv("SBCL_HOME");
- if (sbcl_home) {
- char *lookhere;
- lookhere = (char *) calloc(strlen("/sbcl.core") + strlen(sbcl_home) + 1,
- sizeof(char));
- sprintf(lookhere, "%s/sbcl.core", sbcl_home);
- core = copied_existing_filename_or_null(lookhere);
- free(lookhere);
- } else {
- core = copied_existing_filename_or_null("/usr/lib/sbcl.core");
- if (!core) {
- core = copied_existing_filename_or_null("/usr/local/lib/sbcl.core");
- }
- }
+ char *lookhere;
+ char *stem = "/sbcl.core";
+ if(!sbcl_home) sbcl_home = SBCL_HOME;
+ lookhere = (char *) calloc(strlen(sbcl_home) +
+ strlen(stem) +
+ 1,
+ sizeof(char));
+ sprintf(lookhere, "%s%s", sbcl_home, stem);
+ core = copied_existing_filename_or_null(lookhere);
+ free(lookhere);
if (!core) {
lose("can't find core file");
}
}
-
+ /* Make sure that SBCL_HOME is set, no matter where the core was
+ * found */
+ if (!getenv("SBCL_HOME")) {
+ char *envstring, *copied_core, *dir;
+ char *stem = "SBCL_HOME=";
+ copied_core = copied_string(core);
+ dir = dirname(copied_core);
+ envstring = (char *) calloc(strlen(stem) +
+ strlen(dir) +
+ 1,
+ sizeof(char));
+ sprintf(envstring, "%s%s", stem, dir);
+ putenv(envstring);
+ free(copied_core);
+ }
+
if (!noinform) {
- printf(
-"This is SBCL " SBCL_VERSION_STRING ", an implementation of ANSI Common Lisp.
-
-SBCL is derived from the CMU CL system created at Carnegie Mellon University.
-Besides material created at Carnegie Mellon University, and material
-contributed by volunteers since its release into the public domain, CMU CL
-contained, and SBCL contains, material copyrighted by
- Massachusetts Institute of Technology, 1986;
- Symbolics, Inc., 1989, 1990, 1991, 1992; and
- Xerox Corporation, 1985, 1986, 1987, 1988, 1989, 1990.
-More information about the origin of SBCL is available in the CREDITS file
-in the distribution.
-
-SBCL is a free software system, provided as is, with absolutely no warranty.
-It is mostly public domain software, but also includes some software from
-MIT, Symbolics, and Xerox, used under BSD-style licenses which allow copying
-only under certain conditions. More information about copying SBCL is
-available in the COPYING file in the distribution.
-
-More information on SBCL is available at <http://sbcl.sourceforge.net/>.
-");
+ print_banner();
fflush(stdout);
}
-#ifdef MACH
- mach_init();
-#endif
#if defined(SVR4) || defined(__linux__)
tzset();
#endif
define_var("nil", NIL, 1);
define_var("t", T, 1);
- set_lossage_handler(ldb_monitor);
+ set_lossage_handler(monitor_or_something);
-#if 0
- os_init();
- gc_init();
- validate();
-#endif
globals_init();
initial_function = load_core_file(core);
if (initial_function == NIL) {
lose("couldn't find initial function");
}
+ SHOW("freeing core");
free(core);
-#if defined GENCGC
- gencgc_pickup_dynamic();
-#else
-#if defined WANT_CGC && defined X86_CGC_ACTIVE_P
- {
- extern int use_cgc_p;
- lispobj x = SymbolValue(X86_CGC_ACTIVE_P);
- if (x != type_UnboundMarker && x != NIL) {
- /* Enable allocator. */
- use_cgc_p = 1;
- }
- }
-#endif
-#endif
-
-#ifdef BINDING_STACK_POINTER
- SetSymbolValue(BINDING_STACK_POINTER, BINDING_STACK_START);
-#endif
-#if defined INTERNAL_GC_TRIGGER && !defined __i386__
- SetSymbolValue(INTERNAL_GC_TRIGGER, make_fixnum(-1));
-#endif
+ gc_initialize_pointers();
interrupt_init();
-
arch_install_interrupt_handlers();
os_install_interrupt_handlers();
-#ifdef PSEUDO_ATOMIC_ATOMIC
- /* Turn on pseudo atomic for when we call into Lisp. */
- SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1));
- SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0));
-#endif
-
/* Convert remaining argv values to something that Lisp can grok. */
- SetSymbolValue(POSIX_ARGV, alloc_string_list(argv));
+ SHOW("setting POSIX-ARGV symbol value");
+ SetSymbolValue(POSIX_ARGV, alloc_base_string_list(argv),0);
/* Install a handler to pick off SIGINT until the Lisp system gets
* far enough along to install its own handler. */
sigint_init();
- funcall0(initial_function);
-
- /* initial_function() is not supposed to return. */
- lose("Lisp initial_function gave up control.");
- return 0; /* dummy value: return something */
+ FSHOW((stderr, "/funcalling initial_function=0x%lx\n", initial_function));
+ create_initial_thread(initial_function);
+ lose("CATS. CATS ARE NICE.");
+ return 0;
}
projects / sbcl.git / blobdiff