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; }