#include <sys/param.h>
#include <sys/stat.h>
#include <signal.h>
-#ifdef LISP_FEATURE_SB_THREAD
-#include <sys/ptrace.h>
-#endif
#include <sched.h>
#include <errno.h>
+#include <locale.h>
#if defined(SVR4) || defined(__linux__)
#include <time.h>
#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)
{
- lose("\nSIGINT hit at 0x%08lX\n",
- (unsigned long) *os_context_pc_addr(void_context));
+ 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
{
void* result = malloc(size);
if (0 == result) {
- lose("malloc failure");
+ lose("malloc failure");
} else {
- return result;
+ return result;
}
return (void *) NULL; /* dummy value: return something ... */
}
{
struct stat filename_stat;
if (stat(filename, &filename_stat)) { /* if failure */
- return 0;
+ return 0;
} else {
return copied_string(filename);
}
alloc_base_string_list(char *array_ptr[])
{
if (*array_ptr) {
- return alloc_cons(alloc_base_string(*array_ptr),
- alloc_base_string_list(1 + array_ptr));
+ return alloc_cons(alloc_base_string(*array_ptr),
+ alloc_base_string_list(1 + array_ptr));
} else {
- return NIL;
+ return NIL;
}
}
\f
{
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 derived from the CMU CL system created at Carnegie Mellon University.\n\
-Besides software and documentation originally created at Carnegie Mellon\n\
-University, SBCL contains some software originally from the Massachusetts\n\
-Institute of Technology, Symbolics Incorporated, and Xerox Corporation, and\n\
-material contributed by volunteers since the release of CMU CL into the\n\
-public domain. See the CREDITS file in the distribution for more information.\n\
-\n\
-SBCL is a free software system, provided as is, with absolutely no warranty.\n\
-It is mostly in the public domain, but also includes some software copyrighted\n\
- Massachusetts Institute of Technology, 1986;\n\
- Symbolics, Inc., 1989, 1990, 1991, 1992; and\n\
- Xerox Corporation, 1985, 1986, 1987, 1988, 1989, 1990\n\
-used under BSD-style licenses allowing copying only under certain conditions.\n\
-See the COPYING file in the distribution for more information.\n\
-\n\
-More information about SBCL is available at <http://sbcl.sourceforge.net/>.\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 gc_thread_pid;
-FILE *stdlog;
\f
int
/* the name of the core file we're to execute. Note that this is
* a malloc'ed string which should be freed eventually. */
char *core = 0;
+ char **sbcl_argv = 0;
/* other command line options */
boolean noinform = 0;
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 */
/* Parse our part of the command line (aka "runtime options"),
* stripping out those options that we handle. */
{
- int argi = 1;
- while (argi < argc) {
- char *arg = argv[argi];
- if (0 == strcmp(arg, "--noinform")) {
- noinform = 1;
- ++argi;
- } else if (0 == strcmp(arg, "--core")) {
- if (core) {
- lose("more than one core file specified");
- } else {
- ++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;
- break;
- } else {
- /* This option was unrecognized as a runtime option,
- * so it must be a toplevel option or a user option,
- * so we must be past the end of the runtime option
- * section. */
- break;
- }
- }
- /* This is where we strip out those options that we handle. We
- * also take this opportunity to make sure that we don't find
- * an out-of-place "--end-runtime-options" option. */
- {
- char *argi0 = argv[argi];
- int argj = 1;
- while (argi < argc) {
- char *arg = argv[argi++];
- /* If we encounter --end-runtime-options for the first
- * time after the point where we had to give up on
- * runtime options, then the point where we had to
- * give up on runtime options must've been a user
- * error. */
- if (!end_runtime_options &&
- 0 == strcmp(arg, "--end-runtime-options")) {
- lose("bad runtime option \"%s\"", argi0);
- }
- argv[argj++] = arg;
- }
- argv[argj] = 0;
- argc = argj;
- }
+ int argi = 1;
+ while (argi < argc) {
+ char *arg = argv[argi];
+ if (0 == strcmp(arg, "--noinform")) {
+ noinform = 1;
+ ++argi;
+ } else if (0 == strcmp(arg, "--core")) {
+ if (core) {
+ lose("more than one core file specified");
+ } else {
+ ++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;
+ break;
+ } else {
+ /* This option was unrecognized as a runtime option,
+ * so it must be a toplevel option or a user option,
+ * so we must be past the end of the runtime option
+ * section. */
+ break;
+ }
+ }
+ /* This is where we strip out those options that we handle. We
+ * also take this opportunity to make sure that we don't find
+ * an out-of-place "--end-runtime-options" option. */
+ {
+ char *argi0 = argv[argi];
+ int argj = 1;
+ /* (argc - argi) for the arguments, one for the binary,
+ and one for the terminating NULL. */
+ sbcl_argv = successful_malloc((2 + argc - argi) * sizeof(char *));
+ sbcl_argv[0] = argv[0];
+ while (argi < argc) {
+ char *arg = argv[argi++];
+ /* If we encounter --end-runtime-options for the first
+ * time after the point where we had to give up on
+ * runtime options, then the point where we had to
+ * give up on runtime options must've been a user
+ * error. */
+ if (!end_runtime_options &&
+ 0 == strcmp(arg, "--end-runtime-options")) {
+ lose("bad runtime option \"%s\"", argi0);
+ }
+ sbcl_argv[argj++] = arg;
+ }
+ sbcl_argv[argj] = 0;
+ }
}
/* If no core file was specified, look for one. */
if (!core) {
- char *sbcl_home = getenv("SBCL_HOME");
- if (sbcl_home) {
- char *lookhere;
- char *stem = "/sbcl.core";
- 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);
- } else {
- putenv("SBCL_HOME=/usr/local/lib/sbcl/");
- core = copied_existing_filename_or_null("/usr/local/lib/sbcl/sbcl.core");
- if (!core) {
- putenv("SBCL_HOME=/usr/lib/sbcl/");
- core =
- copied_existing_filename_or_null("/usr/lib/sbcl/sbcl.core");
- }
- }
- if (!core) {
- lose("can't find core file");
- }
- } else {
- /* If a core was specified and SBCL_HOME is unset, set it */
- char *sbcl_home = getenv("SBCL_HOME");
- if (!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);
- }
+ char *sbcl_home = getenv("SBCL_HOME");
+ 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) {
- print_banner();
- fflush(stdout);
+ print_banner();
+ fflush(stdout);
}
-#ifdef MACH
- mach_init();
-#endif
#if defined(SVR4) || defined(__linux__)
tzset();
#endif
initial_function = load_core_file(core);
if (initial_function == NIL) {
- lose("couldn't find initial function");
+ lose("couldn't find initial function");
}
SHOW("freeing core");
free(core);
/* Convert remaining argv values to something that Lisp can grok. */
SHOW("setting POSIX-ARGV symbol value");
- SetSymbolValue(POSIX_ARGV, alloc_base_string_list(argv),0);
+ SetSymbolValue(POSIX_ARGV, alloc_base_string_list(sbcl_argv),0);
+ free(sbcl_argv);
/* Install a handler to pick off SIGINT until the Lisp system gets
* far enough along to install its own handler. */
sigint_init();
FSHOW((stderr, "/funcalling initial_function=0x%lx\n", initial_function));
- create_thread(initial_function);
- /* in a unithread build, create_thread never returns */
-#ifdef LISP_FEATURE_SB_THREAD
- gc_thread_pid=getpid();
- parent_loop();
-#endif
+ create_initial_thread(initial_function);
+ lose("CATS. CATS ARE NICE.");
+ return 0;
}
-
-static void parent_sighandler(int signum,siginfo_t *info, void *void_context)
-{
-#if 0
- os_context_t *context = (os_context_t*)void_context;
- fprintf(stderr,
- "parent thread got signal %d from %d, maybe_gc_pending=%d\n",
- signum, info->si_pid,
- maybe_gc_pending);
-#endif
-}
-
-#ifdef LISP_FEATURE_SB_THREAD
-int show_thread_exit=0;
-
-static void /* noreturn */ parent_loop(void)
-{
- struct sigaction sa;
- sigset_t sigset;
- int status;
- pid_t pid=0;
-
- sigemptyset(&sigset);
-
- sigaddset(&sigset, SIGALRM);
- sigaddset(&sigset, SIGCHLD);
- sigprocmask(SIG_UNBLOCK,&sigset,0);
- sa.sa_handler=parent_sighandler;
- sa.sa_mask=sigset;
- sa.sa_flags=SA_SIGINFO;
- sigaction(SIGALRM, &sa, 0);
- sigaction(SIGCHLD, &sa, 0);
-
- sigemptyset(&sigset);
- sa.sa_handler=SIG_IGN;
- sa.sa_mask=sigset;
- sa.sa_flags=0;
- sigaction(SIGINT, &sa, 0);
-
- while(!all_threads) {
- sched_yield();
- }
- while(all_threads && (pid=waitpid(-1,&status,__WALL))) {
- struct thread *th;
- int real_errno=errno;
- if(pid==-1) {
- if(real_errno == EINTR) {
- continue;
- }
- if(real_errno == ECHILD) break;
- fprintf(stderr,"waitpid: %s\n",strerror(real_errno));
- continue;
- }
- if(WIFEXITED(status) || WIFSIGNALED(status)) {
- th=find_thread_by_pid(pid);
- if(!th) continue;
- if(show_thread_exit)
- fprintf(stderr,"waitpid : child %d %x exited \n", pid,th);
- destroy_thread(th);
- if(!all_threads) break;
- }
- }
- exit(WEXITSTATUS(status));
-}
-
-#endif