inline void
os_sem_wait(os_sem_t *sem, char *what)
{
kern_return_t ret;
restart:
FSHOW((stderr, "%s: os_sem_wait(%p)\n", what, sem));
ret = semaphore_wait(*sem);
FSHOW((stderr, "%s: os_sem_wait(%p) => %s\n", what, sem,
KERN_SUCCESS==ret ? "ok" : strerror(errno)));
switch (ret) {
case KERN_SUCCESS:
return;
/* It is unclear just when we can get this, but a sufficiently
* long wait seems to do that, at least sometimes.
*
* However, a wait that long is definitely abnormal for the
* GC, so we complain before retrying.
*/
case KERN_OPERATION_TIMED_OUT:
fprintf(stderr, "%s: os_sem_wait(%p): %s", what, sem, strerror(errno));
/* This is analogous to POSIX EINTR. */
case KERN_ABORTED:
goto restart;
default:
lose("%s: os_sem_wait(%p): %lu, %s", what, sem, ret, strerror(errno));
}
}
void
os_sem_wait(os_sem_t *sem, char *what)
{
FSHOW((stderr, "%s: os_sem_wait(%p) ...\n", what, sem));
while (-1 == sem_wait(sem))
if (EINTR!=errno)
lose("%s: os_sem_wait(%p): %s", what, sem, strerror(errno));
FSHOW((stderr, "%s: os_sem_wait(%p) => ok\n", what, sem));
}
void
os_sem_init(os_sem_t *sem, unsigned int value)
{
if (-1==sem_init(sem, 0, value))
lose("os_sem_init(%p, %u): %s", sem, value, strerror(errno));
FSHOW((stderr, "os_sem_init(%p, %u)\n", sem, value));
}
void
os_sem_post(sem_t *sem, char *what)
{
if (-1 == sem_post(sem))
lose("%s: os_sem_post(%p): %s", what, sem, strerror(errno));
FSHOW((stderr, "%s: os_sem_post(%p)\n", what, sem));
}
pthread_t
setup_mach_exception_handling_thread()
{
kern_return_t ret;
pthread_t mach_exception_handling_thread = NULL;
pthread_attr_t attr;
current_mach_task = mach_task_self();
/* allocate a mach_port for this process */
ret = mach_port_allocate(current_mach_task,
MACH_PORT_RIGHT_PORT_SET,
&mach_exception_handler_port_set);
/* create the thread that will receive the mach exceptions */
FSHOW((stderr, "Creating mach_exception_handler thread!\n"));
pthread_attr_init(&attr);
pthread_create(&mach_exception_handling_thread,
&attr,
mach_exception_handler,
(void*) mach_exception_handler_port_set);
pthread_attr_destroy(&attr);
return mach_exception_handling_thread;
}
void
os_sem_post(os_sem_t *sem, char *what)
{
if (KERN_SUCCESS!=semaphore_signal(*sem))
lose("%s: os_sem_post(%p): %s", what, sem, strerror(errno));
FSHOW((stderr, "%s: os_sem_post(%p) ok\n", what, sem));
}
lispobj
funcall0(lispobj function)
{
lispobj *args = NULL;
FSHOW((stderr, "/entering funcall0(0x%lx)\n", (long)function));
return safe_call_into_lisp(function, args, 0);
}
/* this is the first thing that runs in the child (which is why the
* silly calling convention). Basically it calls the user's requested
* lisp function after doing arch_os_thread_init and whatever other
* bookkeeping needs to be done
*/
int
new_thread_trampoline(struct thread *th)
{
int result;
init_thread_data scribble;
FSHOW((stderr,"/creating thread %lu\n", thread_self()));
check_deferrables_blocked_or_lose(0);
#ifndef LISP_FEATURE_SB_SAFEPOINT
check_gc_signals_unblocked_or_lose(0);
#endif
lispobj function = th->no_tls_value_marker;
th->no_tls_value_marker = NO_TLS_VALUE_MARKER_WIDETAG;
init_new_thread(th, &scribble, 1);
result = funcall0(function);
undo_init_new_thread(th, &scribble);
schedule_thread_post_mortem(th);
FSHOW((stderr,"/exiting thread %lu\n", thread_self()));
return result;
}
void arch_skip_instruction(os_context_t *context)
{
/* Assuming we get here via an INT3 xxx instruction, the PC now
* points to the interrupt code (a Lisp value) so we just move
* past it. Skip the code; after that, if the code is an
* error-trap or cerror-trap then skip the data bytes that follow. */
int vlen;
long code;
/* Get and skip the Lisp interrupt code. */
code = *(char*)(*os_context_pc_addr(context))++;
switch (code)
{
case trap_Error:
case trap_Cerror:
/* Lisp error arg vector length */
vlen = *(char*)(*os_context_pc_addr(context))++;
/* Skip Lisp error arg data bytes. */
while (vlen-- > 0) {
++*os_context_pc_addr(context);
}
break;
case trap_Breakpoint: /* not tested */
case trap_FunEndBreakpoint: /* not tested */
break;
#ifdef LISP_FEATURE_SB_SAFEPOINT
case trap_GlobalSafepoint:
case trap_CspSafepoint:
#endif
case trap_PendingInterrupt:
case trap_Halt:
case trap_SingleStepAround:
case trap_SingleStepBefore:
case trap_InvalidArgCount:
/* only needed to skip the Code */
break;
default:
fprintf(stderr,"[arch_skip_inst invalid code %ld\n]\n",code);
break;
}
FSHOW((stderr,
"/[arch_skip_inst resuming at %x]\n",
*os_context_pc_addr(context)));
}
/* tell the kernel that we want EXC_BAD_ACCESS exceptions sent to the
exception port (which is being listened to do by the mach
exception handling thread). */
kern_return_t
mach_thread_init(mach_port_t thread_exception_port)
{
kern_return_t ret;
mach_port_t current_mach_thread;
/* allocate a named port for the thread */
FSHOW((stderr, "Allocating mach port %x\n", thread_exception_port));
ret = mach_port_allocate_name(current_mach_task,
MACH_PORT_RIGHT_RECEIVE,
thread_exception_port);
if (ret) {
lose("mach_port_allocate_name failed with return_code %d\n", ret);
}
/* establish the right for the thread_exception_port to send messages */
ret = mach_port_insert_right(current_mach_task,
thread_exception_port,
thread_exception_port,
MACH_MSG_TYPE_MAKE_SEND);
if (ret) {
lose("mach_port_insert_right failed with return_code %d\n", ret);
}
current_mach_thread = mach_thread_self();
ret = thread_set_exception_ports(current_mach_thread,
EXC_MASK_BAD_ACCESS | EXC_MASK_BAD_INSTRUCTION,
thread_exception_port,
EXCEPTION_DEFAULT,
THREAD_STATE_NONE);
if (ret) {
lose("thread_set_exception_ports failed with return_code %d\n", ret);
}
ret = mach_port_deallocate (current_mach_task, current_mach_thread);
if (ret) {
lose("mach_port_deallocate failed with return_code %d\n", ret);
}
ret = mach_port_move_member(current_mach_task,
thread_exception_port,
mach_exception_handler_port_set);
if (ret) {
lose("mach_port_move_member failed with return_code %d\n", ret);
}
return ret;
}
void
os_init(char *argv[], char *envp[])
{
struct utsname name;
int major_version;
int minor_version;
uname(&name);
major_version = atoi(name.release);
if (major_version != 5) {
lose("sunos major version=%d (which isn't 5!)\n", major_version);
}
minor_version = atoi(name.release+2);
if ((minor_version < 8)) {
kludge_mmap_fd = open("/dev/zero",O_RDONLY);
if (kludge_mmap_fd < 0) {
perror("open");
lose("Error in open(..)\n");
}
} else if (minor_version > 11) {
FSHOW((stderr, "os_init: Solaris version greater than 11?\nUnknown MAP_ANON behaviour.\n"));
lose("Unknown mmap() interaction with MAP_ANON\n");
} else {
/* Versions 8-11*/
KLUDGE_MAYBE_MAP_ANON = 0x100;
}
/* I do not understand this at all. FIXME. */
os_vm_page_size = os_real_page_size = sysconf(_SC_PAGESIZE);
if(os_vm_page_size>OS_VM_DEFAULT_PAGESIZE){
fprintf(stderr,"os_init: Pagesize too large (%d > %d)\n",
os_vm_page_size,OS_VM_DEFAULT_PAGESIZE);
exit(1);
} else {
/*
* we do this because there are apparently dependencies on
* the pagesize being OS_VM_DEFAULT_PAGESIZE somewhere...
* but since the OS doesn't know we're using this restriction,
* we have to grovel around a bit to enforce it, thus anything
* that uses real_page_size_difference.
*/
/* FIXME: Is this still true? */
real_page_size_difference=OS_VM_DEFAULT_PAGESIZE-os_vm_page_size;
os_vm_page_size=OS_VM_DEFAULT_PAGESIZE;
}
}
static void
process_directory(int fd, lispobj *ptr, int count, os_vm_offset_t file_offset)
{
extern void immobile_space_coreparse(uword_t,uword_t);
struct ndir_entry *entry;
int compressed;
FSHOW((stderr, "/process_directory(..), count=%d\n", count));
for (entry = (struct ndir_entry *) ptr; --count>= 0; ++entry) {
compressed = 0;
sword_t id = entry->identifier;
if (id <= (MAX_CORE_SPACE_ID | DEFLATED_CORE_SPACE_ID_FLAG)) {
if (id & DEFLATED_CORE_SPACE_ID_FLAG)
compressed = 1;
id &= ~(DEFLATED_CORE_SPACE_ID_FLAG);
}
sword_t offset = os_vm_page_size * (1 + entry->data_page);
os_vm_address_t addr =
(os_vm_address_t) (os_vm_page_size * entry->address);
lispobj *free_pointer = (lispobj *) addr + entry->nwords;
uword_t len = os_vm_page_size * entry->page_count;
if (len != 0) {
os_vm_address_t real_addr;
FSHOW((stderr, "/mapping %ld(0x%lx) bytes at 0x%lx\n",
len, len, (uword_t)addr));
if (compressed) {
#ifdef LISP_FEATURE_SB_CORE_COMPRESSION
real_addr = inflate_core_bytes(fd, offset + file_offset, addr, len);
#else
lose("This runtime was not built with zlib-compressed core support... aborting\n");
#endif
} else {
#ifdef LISP_FEATURE_HPUX
real_addr = copy_core_bytes(fd, offset + file_offset, addr, len);
#else
real_addr = os_map(fd, offset + file_offset, addr, len);
#endif
}
if (real_addr != addr) {
lose("file mapped in wrong place! "
"(0x%08x != 0x%08lx)\n",
real_addr,
addr);
}
}
#ifdef MADV_MERGEABLE
if ((merge_core_pages == 1)
|| ((merge_core_pages == -1) && compressed)) {
madvise(addr, len, MADV_MERGEABLE);
}
#endif
FSHOW((stderr, "/space id = %ld, free pointer = %p\n",
id, (uword_t)free_pointer));
switch (id) {
case DYNAMIC_CORE_SPACE_ID:
if (len > dynamic_space_size) {
fprintf(stderr,
"dynamic space too small for core: %luKiB required, %luKiB available.\n",
(unsigned long)len >> 10,
(unsigned long)dynamic_space_size >> 10);
exit(1);
}
#ifdef LISP_FEATURE_GENCGC
if (addr != (os_vm_address_t)DYNAMIC_SPACE_START) {
fprintf(stderr, "in core: %p; in runtime: %p \n",
(void*)addr, (void*)DYNAMIC_SPACE_START);
lose("core/runtime address mismatch: DYNAMIC_SPACE_START\n");
}
#else
if ((addr != (os_vm_address_t)DYNAMIC_0_SPACE_START) &&
(addr != (os_vm_address_t)DYNAMIC_1_SPACE_START)) {
fprintf(stderr, "in core: %p; in runtime: %p or %p\n",
(void*)addr,
(void*)DYNAMIC_0_SPACE_START,
(void*)DYNAMIC_1_SPACE_START);
lose("warning: core/runtime address mismatch: DYNAMIC_SPACE_START\n");
}
#endif
#if defined(ALLOCATION_POINTER)
SetSymbolValue(ALLOCATION_POINTER, (lispobj)free_pointer,0);
#else
dynamic_space_free_pointer = free_pointer;
#endif
/* For stop-and-copy GC, this will be whatever the GC was
* using at the time. With GENCGC, this will always be
* space 0. (We checked above that for GENCGC,
* addr==DYNAMIC_SPACE_START.) */
current_dynamic_space = (lispobj *)addr;
break;
case STATIC_CORE_SPACE_ID:
if (addr != (os_vm_address_t)STATIC_SPACE_START) {
fprintf(stderr, "in core: %p - in runtime: %p\n",
(void*)addr, (void*)STATIC_SPACE_START);
lose("core/runtime address mismatch: STATIC_SPACE_START\n");
}
break;
case READ_ONLY_CORE_SPACE_ID:
if (addr != (os_vm_address_t)READ_ONLY_SPACE_START) {
fprintf(stderr, "in core: %p - in runtime: %p\n",
(void*)addr, (void*)READ_ONLY_SPACE_START);
lose("core/runtime address mismatch: READ_ONLY_SPACE_START\n");
}
break;
#ifdef LISP_FEATURE_IMMOBILE_SPACE
// Immobile space is subdivided into fixed-size and variable-size.
// There is no margin between the two, though for efficiency
// they are written separately to eliminate waste in the core file.
case IMMOBILE_FIXEDOBJ_CORE_SPACE_ID:
if (addr != (os_vm_address_t)IMMOBILE_SPACE_START) {
fprintf(stderr, "in core: %p - in runtime: %p\n",
(void*)addr, (void*)IMMOBILE_SPACE_START);
lose("core/runtime address mismatch: IMMOBILE_SPACE_START\n");
}
immobile_space_coreparse(IMMOBILE_SPACE_START, len);
break;
case IMMOBILE_VARYOBJ_CORE_SPACE_ID:
if (addr != (os_vm_address_t)IMMOBILE_VARYOBJ_SUBSPACE_START) {
fprintf(stderr, "in core: %p - in runtime: %p\n",
(void*)addr, (void*)IMMOBILE_VARYOBJ_SUBSPACE_START);
lose("core/runtime address mismatch: IMMOBILE_VARYOBJ_SUBSPACE_START\n");
}
immobile_space_coreparse(IMMOBILE_VARYOBJ_SUBSPACE_START, len);
break;
#endif
default:
lose("unknown space ID %ld addr %p\n", id, addr);
}
}
void
os_init(char *argv[], char *envp[])
{
/* Conduct various version checks: do we have enough mmap(), is
* this a sparc running 2.2, can we do threads? */
struct utsname name;
int major_version;
int minor_version;
int patch_version;
char *p;
uname(&name);
p=name.release;
major_version = atoi(p);
p=strchr(p,'.')+1;
minor_version = atoi(p);
p=strchr(p,'.')+1;
patch_version = atoi(p);
if (major_version<2) {
lose("linux kernel version too old: major version=%d (can't run in version < 2.0.0)\n",
major_version);
}
if (!(major_version>2 || minor_version >= 4)) {
#ifdef LISP_FEATURE_SPARC
FSHOW((stderr,"linux kernel %d.%d predates 2.4;\n enabling workarounds for SPARC kernel bugs in signal handling.\n", major_version,minor_version));
linux_sparc_siginfo_bug = 1;
#endif
}
#ifdef LISP_FEATURE_SB_THREAD
#if !defined(LISP_FEATURE_SB_LUTEX) && !defined(LISP_FEATURE_SB_PTHREAD_FUTEX)
futex_init();
#endif
if(! isnptl()) {
lose("This version of SBCL only works correctly with the NPTL threading\n"
"library. Please use a newer glibc, use an older SBCL, or stop using\n"
"LD_ASSUME_KERNEL\n");
}
#endif
/* Don't use getpagesize(), since it's not constant across Linux
* kernel versions on some architectures (for example PPC). FIXME:
* possibly the same should be done on other architectures too.
*/
os_vm_page_size = BACKEND_PAGE_BYTES;
/* KLUDGE: Disable memory randomization on new Linux kernels
* by setting a personality flag and re-executing. (We need
* to re-execute, since the memory maps that can conflict with
* the SBCL spaces have already been done at this point).
*
* Since randomization is currently implemented only on x86 kernels,
* don't do this trick on other platforms.
*/
#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
if ((major_version == 2
/* Some old kernels will apparently lose unsupported personality flags
* on exec() */
&& ((minor_version == 6 && patch_version >= 11)
|| (minor_version > 6)
/* This is what RHEL 3 reports */
|| (minor_version == 4 && patch_version > 20)))
|| major_version >= 3)
{
int pers = personality(0xffffffffUL);
/* 0x40000 aka. ADDR_NO_RANDOMIZE */
if (!(pers & 0x40000)) {
int retval = personality(pers | 0x40000);
/* Allegedly some Linux kernels (the reported case was
* "hardened Linux 2.6.7") won't set the new personality,
* but nor will they return -1 for an error. So as a
* workaround query the new personality...
*/
int newpers = personality(0xffffffffUL);
/* ... and don't re-execute if either the setting resulted
* in an error or if the value didn't change. Otherwise
* this might result in an infinite loop.
*/
if (retval != -1 && newpers != pers) {
/* Use /proc/self/exe instead of trying to figure out
* the executable path from PATH and argv[0], since
* that's unreliable. We follow the symlink instead of
* executing the file directly in order to prevent top
* from displaying the name of the process as "exe". */
char runtime[PATH_MAX+1];
int i = readlink("/proc/self/exe", runtime, PATH_MAX);
if (i != -1) {
runtime[i] = '\0';
execve(runtime, argv, envp);
}
}
/* Either changing the personality or execve() failed. Either
* way we might as well continue, and hope that the random
* memory maps are ok this time around.
*/
fprintf(stderr, "WARNING: Couldn't re-execute SBCL with the proper personality flags (maybe /proc isn't mounted?). Trying to continue anyway.\n");
}
}
#ifdef LISP_FEATURE_X86
/* Use SSE detector. Recent versions of Linux enable SSE support
* on SSE capable CPUs. */
/* FIXME: Are there any old versions that does not support SSE? */
fast_bzero_pointer = fast_bzero_detect;
#endif
#endif
}
int
main(int argc, char *argv[], char *envp[])
{
#ifdef LISP_FEATURE_WIN32
/* Exception handling support structure. Evil Win32 hack. */
struct lisp_exception_frame exception_frame;
#endif
/* 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;
os_vm_offset_t embedded_core_offset = 0;
char *runtime_path = 0;
/* other command line options */
boolean noinform = 0;
boolean end_runtime_options = 0;
boolean disable_lossage_handler_p = 0;
lispobj initial_function;
const char *sbcl_home = getenv("SBCL_HOME");
interrupt_init();
block_blockable_signals(0, 0);
setlocale(LC_ALL, "");
runtime_options = NULL;
/* Check early to see if this executable has an embedded core,
* which also populates runtime_options if the core has runtime
* options */
runtime_path = os_get_runtime_executable_path();
if (runtime_path) {
os_vm_offset_t offset = search_for_embedded_core(runtime_path);
if (offset != -1) {
embedded_core_offset = offset;
core = runtime_path;
} else {
free(runtime_path);
}
}
/* Parse our part of the command line (aka "runtime options"),
* stripping out those options that we handle. */
if (runtime_options != NULL) {
dynamic_space_size = runtime_options->dynamic_space_size;
thread_control_stack_size = runtime_options->thread_control_stack_size;
sbcl_argv = argv;
} else {
int argi = 1;
runtime_options = successful_malloc(sizeof(struct runtime_options));
while (argi < argc) {
char *arg = argv[argi];
if (0 == strcmp(arg, "--script")) {
/* This is both a runtime and a toplevel option. As a
* runtime option, it is equivalent to --noinform.
* This exits, and does not increment argi, so that
* TOPLEVEL-INIT sees the option. */
noinform = 1;
end_runtime_options = 1;
disable_lossage_handler_p = 1;
lose_on_corruption_p = 1;
break;
} else if (0 == strcmp(arg, "--noinform")) {
noinform = 1;
++argi;
} else if (0 == strcmp(arg, "--core")) {
if (core) {
lose("more than one core file specified\n");
} else {
++argi;
if (argi >= argc) {
lose("missing filename for --core argument\n");
}
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, "--dynamic-space-size")) {
++argi;
if (argi >= argc)
lose("missing argument for --dynamic-space-size");
errno = 0;
dynamic_space_size = strtol(argv[argi++], 0, 0) << 20;
if (errno)
lose("argument to --dynamic-space-size is not a number");
# ifdef MAX_DYNAMIC_SPACE_END
if (!((DYNAMIC_SPACE_START <
DYNAMIC_SPACE_START+dynamic_space_size) &&
(DYNAMIC_SPACE_START+dynamic_space_size <=
MAX_DYNAMIC_SPACE_END)))
lose("specified --dynamic-space-size too large");
# endif
} else if (0 == strcmp(arg, "--control-stack-size")) {
++argi;
if (argi >= argc)
lose("missing argument for --control-stack-size");
errno = 0;
thread_control_stack_size = strtol(argv[argi++], 0, 0) << 20;
if (errno)
lose("argument to --control-stack-size is not a number");
} else if (0 == strcmp(arg, "--debug-environment")) {
int n = 0;
printf("; Commandline arguments:\n");
while (n < argc) {
printf("; %2d: \"%s\"\n", n, argv[n]);
++n;
}
n = 0;
printf(";\n; Environment:\n");
while (ENVIRON[n]) {
printf("; %2d: \"%s\"\n", n, ENVIRON[n]);
++n;
}
++argi;
} else if (0 == strcmp(arg, "--disable-ldb")) {
disable_lossage_handler_p = 1;
++argi;
} else if (0 == strcmp(arg, "--lose-on-corruption")) {
lose_on_corruption_p = 1;
++argi;
} 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\"\n", argi0);
}
sbcl_argv[argj++] = arg;
}
sbcl_argv[argj] = 0;
}
}
/* Align down to multiple of page_table page size, and to the appropriate
* stack alignment. */
dynamic_space_size &= ~(PAGE_BYTES-1);
thread_control_stack_size &= ~(CONTROL_STACK_ALIGNMENT_BYTES-1);
/* Preserve the runtime options for possible future core saving */
runtime_options->dynamic_space_size = dynamic_space_size;
runtime_options->thread_control_stack_size = thread_control_stack_size;
/* 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 */
os_init(argv, envp);
arch_init();
gc_init();
validate();
/* If no core file was specified, look for one. */
if (!core) {
core = search_for_core();
}
/* Make sure that SBCL_HOME is set and not the empty string,
unless loading an embedded core. */
if (!(sbcl_home && *sbcl_home) && embedded_core_offset == 0) {
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 && embedded_core_offset == 0) {
print_banner();
fflush(stdout);
}
#if defined(SVR4) || defined(__linux__)
tzset();
#endif
define_var("nil", NIL, 1);
define_var("t", T, 1);
if (!disable_lossage_handler_p)
enable_lossage_handler();
globals_init();
initial_function = load_core_file(core, embedded_core_offset);
if (initial_function == NIL) {
lose("couldn't find initial function\n");
}
#ifdef LISP_FEATURE_HPUX
/* -1 = CLOSURE_FUN_OFFSET, 23 = SIMPLE_FUN_CODE_OFFSET, we are
* not in LANGUAGE_ASSEMBLY so we cant reach them. */
return_from_lisp_stub = (void *) ((char *)*((unsigned long *)
((char *)initial_function + -1)) + 23);
#endif
gc_initialize_pointers();
arch_install_interrupt_handlers();
#ifndef LISP_FEATURE_WIN32
os_install_interrupt_handlers();
#else
/* wos_install_interrupt_handlers(handler); */
wos_install_interrupt_handlers(&exception_frame);
#endif
/* Pass core filename and the processed argv into Lisp. They'll
* need to be processed further there, to do locale conversion.
*/
core_string = core;
posix_argv = sbcl_argv;
FSHOW((stderr, "/funcalling initial_function=0x%lx\n",
(unsigned long)initial_function));
#ifdef LISP_FEATURE_WIN32
fprintf(stderr, "\n\
This is experimental prerelease support for the Windows platform: use\n\
at your own risk. \"Your Kitten of Death awaits!\"\n");
fflush(stdout);
fflush(stderr);
#endif
create_initial_thread(initial_function);
lose("CATS. CATS ARE NICE.\n");
return 0;
}
