2 * the Win32 incarnation of OS-dependent routines. See also
3 * $(sbcl_arch)-win32-os.c
5 * This file (along with os.h) exports an OS-independent interface to
6 * the operating system VM facilities. Surprise surprise, this
7 * interface looks a lot like the Mach interface (but simpler in some
8 * places). For some operating systems, a subset of these functions
9 * will have to be emulated.
13 * This software is part of the SBCL system. See the README file for
16 * This software is derived from the CMU CL system, which was
17 * written at Carnegie Mellon University and released into the
18 * public domain. The software is in the public domain and is
19 * provided with absolutely no warranty. See the COPYING and CREDITS
20 * files for more information.
24 * This file was copied from the Linux version of the same, and
25 * likely still has some linuxisms in it have haven't been elimiated
31 #include <sys/param.h>
40 #include "interrupt.h"
45 #include "genesis/primitive-objects.h"
47 #include <sys/types.h>
53 /* KLUDGE: Avoid double definition of boolean by rpcndr.h included via
56 * FIXME: We should probably arrange to use the rpcndr.h boolean on Windows,
57 * or get rid of our own boolean type.
59 #define boolean rpcndr_boolean
69 size_t os_vm_page_size;
72 #include "gencgc-internal.h"
75 int linux_sparc_siginfo_bug = 0;
76 int linux_supports_futex=0;
79 /* The exception handling function looks like this: */
80 EXCEPTION_DISPOSITION handle_exception(EXCEPTION_RECORD *,
81 struct lisp_exception_frame *,
87 static void *get_seh_frame(void)
90 asm volatile ("movl %%fs:0,%0": "=r" (retval));
94 static void set_seh_frame(void *frame)
96 asm volatile ("movl %0,%%fs:0": : "r" (frame));
99 static struct lisp_exception_frame *find_our_seh_frame(void)
101 struct lisp_exception_frame *frame = get_seh_frame();
103 while (frame->handler != handle_exception)
104 frame = frame->next_frame;
110 inline static void *get_stack_frame(void)
113 asm volatile ("movl %%ebp,%0": "=r" (retval));
118 void os_init(char *argv[], char *envp[])
120 SYSTEM_INFO system_info;
122 GetSystemInfo(&system_info);
123 os_vm_page_size = system_info.dwPageSize;
125 base_seh_frame = get_seh_frame();
130 * So we have three fun scenarios here.
132 * First, we could be being called to reserve the memory areas
133 * during initialization (prior to loading the core file).
135 * Second, we could be being called by the GC to commit a page
136 * that has just been decommitted (for easy zero-fill).
138 * Third, we could be being called by create_thread_struct()
139 * in order to create the sundry and various stacks.
141 * The third case is easy to pick out because it passes an
144 * The second case is easy to pick out because it will be for
145 * a range of memory that is MEM_RESERVE rather than MEM_FREE.
147 * The second case is also an easy implement, because we leave
148 * the memory as reserved (since we do lazy commits).
152 os_validate(os_vm_address_t addr, os_vm_size_t len)
154 MEMORY_BASIC_INFORMATION mem_info;
157 /* the simple case first */
158 os_vm_address_t real_addr;
159 if (!(real_addr = VirtualAlloc(addr, len, MEM_COMMIT, PAGE_EXECUTE_READWRITE))) {
160 fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError());
167 if (!VirtualQuery(addr, &mem_info, sizeof mem_info)) {
168 fprintf(stderr, "VirtualQuery: 0x%lx.\n", GetLastError());
172 if ((mem_info.State == MEM_RESERVE) && (mem_info.RegionSize >=len)) return addr;
174 if (mem_info.State == MEM_RESERVE) {
175 fprintf(stderr, "validation of reserved space too short.\n");
179 if (!VirtualAlloc(addr, len, (mem_info.State == MEM_RESERVE)? MEM_COMMIT: MEM_RESERVE, PAGE_EXECUTE_READWRITE)) {
180 fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError());
188 * For os_invalidate(), we merely decommit the memory rather than
189 * freeing the address space. This loses when freeing per-thread
190 * data and related memory since it leaks address space. It's not
191 * too lossy, however, since the two scenarios I'm aware of are
192 * fd-stream buffers, which are pooled rather than torched, and
193 * thread information, which I hope to pool (since windows creates
194 * threads at its own whim, and we probably want to be able to
195 * have them callback without funky magic on the part of the user,
196 * and full-on thread allocation is fairly heavyweight). Someone
197 * will probably shoot me down on this with some pithy comment on
198 * the use of (setf symbol-value) on a special variable. I'm happy
203 os_invalidate(os_vm_address_t addr, os_vm_size_t len)
205 if (!VirtualFree(addr, len, MEM_DECOMMIT)) {
206 fprintf(stderr, "VirtualFree: 0x%lx.\n", GetLastError());
211 * os_map() is called to map a chunk of the core file into memory.
213 * Unfortunately, Windows semantics completely screws this up, so
214 * we just add backing store from the swapfile to where the chunk
215 * goes and read it up like a normal file. We could consider using
216 * a lazy read (demand page) setup, but that would mean keeping an
217 * open file pointer for the core indefinately (and be one more
218 * thing to maintain).
222 os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len)
227 fprintf(stderr, "os_map: %d, 0x%x, %p, 0x%x.\n", fd, offset, addr, len);
231 if (!VirtualAlloc(addr, len, MEM_COMMIT, PAGE_EXECUTE_READWRITE)) {
232 fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError());
233 lose("os_map: VirtualAlloc failure");
236 if (lseek(fd, offset, SEEK_SET) == -1) {
237 lose("os_map: Seek failure.");
240 count = read(fd, addr, len);
242 fprintf(stderr, "expected 0x%x, read 0x%x.\n", len, count);
243 lose("os_map: Failed to read enough bytes.");
249 static DWORD os_protect_modes[8] = {
256 PAGE_EXECUTE_READWRITE,
257 PAGE_EXECUTE_READWRITE,
261 os_protect(os_vm_address_t address, os_vm_size_t length, os_vm_prot_t prot)
265 if (!VirtualProtect(address, length, os_protect_modes[prot], &old_prot)) {
266 fprintf(stderr, "VirtualProtect failed, code 0x%lx.\n", GetLastError());
271 /* FIXME: Now that FOO_END, rather than FOO_SIZE, is the fundamental
272 * description of a space, we could probably punt this and just do
273 * (FOO_START <= x && x < FOO_END) everywhere it's called. */
275 in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen)
277 char* beg = (char*)((long)sbeg);
278 char* end = (char*)((long)sbeg) + slen;
279 char* adr = (char*)a;
280 return (adr >= beg && adr < end);
284 is_linkage_table_addr(os_vm_address_t addr)
286 return in_range_p(addr, LINKAGE_TABLE_SPACE_START, LINKAGE_TABLE_SPACE_END);
290 is_valid_lisp_addr(os_vm_address_t addr)
293 if(in_range_p(addr, READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE) ||
294 in_range_p(addr, STATIC_SPACE_START , STATIC_SPACE_SIZE) ||
295 in_range_p(addr, DYNAMIC_SPACE_START , dynamic_space_size))
297 for_each_thread(th) {
298 if(((os_vm_address_t)th->control_stack_start <= addr) && (addr < (os_vm_address_t)th->control_stack_end))
300 if(in_range_p(addr, (unsigned long)th->binding_stack_start, BINDING_STACK_SIZE))
307 * any OS-dependent special low-level handling for signals
310 /* A tiny bit of interrupt.c state we want our paws on. */
311 extern boolean internal_errors_enabled;
314 * FIXME: There is a potential problem with foreign code here.
315 * If we are running foreign code instead of lisp code and an
316 * exception occurs we arrange a call into Lisp. If the
317 * foreign code has installed an exception handler, we run the
318 * very great risk of throwing through their exception handler
319 * without asking it to unwind. This is more a problem with
320 * non-sigtrap (EXCEPTION_BREAKPOINT) exceptions, as they could
321 * reasonably be expected to happen in foreign code. We need to
322 * figure out the exception handler unwind semantics and adhere
323 * to them (probably by abusing the Lisp unwind-protect system)
324 * if we are going to handle this scenario correctly.
326 * A good explanation of the exception handling semantics is
327 * http://win32assembly.online.fr/Exceptionhandling.html .
328 * We will also need to handle this ourselves when foreign
329 * code tries to unwind -us-.
331 * When unwinding through foreign code we should unwind the
332 * Lisp stack to the entry from foreign code, then unwind the
333 * foreign code stack to the entry from Lisp, then resume
337 EXCEPTION_DISPOSITION
338 sigtrap_emulator(CONTEXT *context,
339 struct lisp_exception_frame *exception_frame)
341 if (*((char *)context->Eip + 1) == trap_ContextRestore) {
342 /* This is the cleanup for what is immediately below, and
343 * for the generic exception handling further below. We
344 * have to memcpy() the original context (emulated sigtrap
345 * or normal exception) over our context and resume it. */
346 memcpy(context, &exception_frame->context, sizeof(CONTEXT));
347 return ExceptionContinueExecution;
350 /* Not a trap_ContextRestore, must be a sigtrap.
351 * sigtrap_trampoline is defined in x86-assem.S. */
352 extern void sigtrap_trampoline;
355 * Unlike some other operating systems, Win32 leaves EIP
356 * pointing to the breakpoint instruction.
360 /* We're not on an alternate stack like we would be in some
361 * other operating systems, and we don't want to risk leaking
362 * any important resources if we throw out of the sigtrap
363 * handler, so we need to copy off our context to a "safe"
364 * place and then monkey with the return EIP to point to a
365 * trampoline which calls another function which copies the
366 * context out to a really-safe place and then calls the real
367 * sigtrap handler. When the real sigtrap handler returns, the
368 * trampoline then contains another breakpoint with a code of
369 * trap_ContextRestore (see above). Essentially the same
370 * mechanism is used by the generic exception path. There is
371 * a small window of opportunity between us copying the
372 * context to the "safe" place and the sigtrap wrapper copying
373 * it to the really-safe place (allocated in its stack frame)
374 * during which the context can be smashed. The only scenario
375 * I can come up with for this, however, involves a stack
376 * overflow occuring at just the wrong time (which makes one
377 * wonder how stack overflow exceptions even happen, given
378 * that we don't switch stacks for exception processing...) */
379 memcpy(&exception_frame->context, context, sizeof(CONTEXT));
381 /* FIXME: Why do we save the old EIP in EAX? The sigtrap_trampoline
382 * pushes it into stack, but the sigtrap_wrapper where the trampoline
383 * goes ignores it, and after the wrapper we hit the trap_ContextRestore,
384 * which nukes the whole context with the original one?
386 * Am I misreading this, or is the EAX here and in the
387 * trampoline superfluous? --NS 20061024 */
388 context->Eax = context->Eip;
389 context->Eip = (unsigned long)&sigtrap_trampoline;
392 return ExceptionContinueExecution;
396 void sigtrap_wrapper(void)
399 * This is the wrapper around the sigtrap handler called from
400 * the trampoline returned to from the function above.
402 * There actually is a point to some of the commented-out code
403 * in this function, although it really belongs to the callback
404 * wrappers. Once it is installed there, it can probably be
407 extern void sigtrap_handler(int signal, siginfo_t *info, void *context);
409 /* volatile struct { */
410 /* void *handler[2]; */
414 struct lisp_exception_frame *frame = find_our_seh_frame();
416 /* wos_install_interrupt_handlers(handler); */
417 /* handler.handler[0] = get_seh_frame(); */
418 /* handler.handler[1] = &handle_exception; */
419 /* set_seh_frame(&handler); */
421 memcpy(&context, &frame->context, sizeof(CONTEXT));
422 sigtrap_handler(0, NULL, &context);
423 memcpy(&frame->context, &context, sizeof(CONTEXT));
425 /* set_seh_frame(handler.handler[0]); */
428 EXCEPTION_DISPOSITION
429 handle_exception(EXCEPTION_RECORD *exception_record,
430 struct lisp_exception_frame *exception_frame,
432 void *dc) /* FIXME: What's dc again? */
434 /* For EXCEPTION_ACCESS_VIOLATION only. */
435 void *fault_address = (void *)exception_record->ExceptionInformation[1];
437 if (single_stepping &&
438 exception_record->ExceptionCode == EXCEPTION_SINGLE_STEP) {
439 /* We are doing a displaced instruction. At least function
440 * end breakpoints uses this. */
441 restore_breakpoint_from_single_step(context);
442 return ExceptionContinueExecution;
445 if (exception_record->ExceptionCode == EXCEPTION_BREAKPOINT) {
446 /* Pick off sigtrap case first. */
447 return sigtrap_emulator(context, exception_frame);
449 else if (exception_record->ExceptionCode == EXCEPTION_ACCESS_VIOLATION &&
450 (is_valid_lisp_addr(fault_address) ||
451 is_linkage_table_addr(fault_address))) {
452 /* Pick off GC-related memory fault next. */
453 MEMORY_BASIC_INFORMATION mem_info;
455 if (!VirtualQuery(fault_address, &mem_info, sizeof mem_info)) {
456 fprintf(stderr, "VirtualQuery: 0x%lx.\n", GetLastError());
457 lose("handle_exception: VirtualQuery failure");
460 if (mem_info.State == MEM_RESERVE) {
461 /* First use new page, lets get some memory for it. */
462 if (!VirtualAlloc(mem_info.BaseAddress, os_vm_page_size,
463 MEM_COMMIT, PAGE_EXECUTE_READWRITE)) {
464 fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError());
465 lose("handle_exception: VirtualAlloc failure");
469 * Now, if the page is supposedly write-protected and this
470 * is a write, tell the gc that it's been hit.
472 * FIXME: Are we supposed to fall-through to the Lisp
473 * exception handler if the gc doesn't take the wp violation?
475 if (exception_record->ExceptionInformation[0]) {
476 int index = find_page_index(fault_address);
477 if ((index != -1) && (page_table[index].write_protected)) {
478 gencgc_handle_wp_violation(fault_address);
481 return ExceptionContinueExecution;
484 } else if (gencgc_handle_wp_violation(fault_address)) {
485 /* gc accepts the wp violation, so resume where we left off. */
486 return ExceptionContinueExecution;
489 /* All else failed, drop through to the lisp-side exception handler. */
493 * If we fall through to here then we need to either forward
494 * the exception to the lisp-side exception handler if it's
495 * set up, or drop to LDB.
498 if (internal_errors_enabled) {
499 /* exception_trampoline is defined in x86-assem.S. */
500 extern void exception_trampoline;
502 /* We're making the somewhat arbitrary decision that having
503 * internal errors enabled means that lisp has sufficient
504 * marbles to be able to handle exceptions, but xceptions
505 * aren't supposed to happen during cold init or reinit
508 * We use the same mechanism as the sigtrap emulator above
509 * with just a couple changes. We obviously use a different
510 * trampoline and wrapper function, we kill out any live
511 * floating point exceptions, and we save off the exception
512 * record as well as the context. */
514 /* Save off context and exception information */
515 memcpy(&exception_frame->context, context, sizeof(CONTEXT));
516 memcpy(&exception_frame->exception, exception_record, sizeof(EXCEPTION_RECORD));
518 /* Set up to activate trampoline when we return
520 * FIXME: Why do we save the old EIP in EAX? The
521 * exception_trampoline pushes it into stack, but the wrapper
522 * where the trampoline goes ignores it, and then the wrapper
523 * unwinds from Lisp... WTF?
525 * Am I misreading this, or is the EAX here and in the
526 * trampoline superfluous? --NS 20061024 */
527 context->Eax = context->Eip;
528 context->Eip = (unsigned long)&exception_trampoline;
530 /* Make sure a floating-point trap doesn't kill us */
531 context->FloatSave.StatusWord &= ~0x3f;
534 return ExceptionContinueExecution;
537 fprintf(stderr, "Exception Code: 0x%lx.\n", exception_record->ExceptionCode);
538 fprintf(stderr, "Faulting IP: 0x%lx.\n", (DWORD)exception_record->ExceptionAddress);
539 if (exception_record->ExceptionCode == EXCEPTION_ACCESS_VIOLATION) {
540 MEMORY_BASIC_INFORMATION mem_info;
542 if (VirtualQuery(fault_address, &mem_info, sizeof mem_info)) {
543 fprintf(stderr, "page status: 0x%lx.\n", mem_info.State);
546 fprintf(stderr, "Was writing: %ld, where: 0x%lx.\n",
547 exception_record->ExceptionInformation[0],
548 (DWORD)fault_address);
553 fake_foreign_function_call(context);
554 lose("fake_foreign_function_call fell through");
556 /* FIXME: WTF? How are we supposed to end up here? */
557 return ExceptionContinueSearch;
560 void handle_win32_exception_wrapper(void)
562 struct lisp_exception_frame *frame = find_our_seh_frame();
564 EXCEPTION_RECORD exception_record;
566 lispobj exception_record_sap;
568 memcpy(&context, &frame->context, sizeof(CONTEXT));
569 memcpy(&exception_record, &frame->exception, sizeof(EXCEPTION_RECORD));
571 fake_foreign_function_call(&context);
573 /* Allocate the SAP objects while the "interrupts" are still
575 context_sap = alloc_sap(&context);
576 exception_record_sap = alloc_sap(&exception_record);
578 funcall2(SymbolFunction(HANDLE_WIN32_EXCEPTION), context_sap,
579 exception_record_sap);
581 /* FIXME: These never happen, as the Lisp-side call is
582 * to an ERROR, which means we must do a non-local exit
584 undo_fake_foreign_function_call(&context);
585 memcpy(&frame->context, &context, sizeof(CONTEXT));
589 wos_install_interrupt_handlers(struct lisp_exception_frame *handler)
591 handler->next_frame = get_seh_frame();
592 handler->handler = &handle_exception;
593 set_seh_frame(handler);
596 void bcopy(const void *src, void *dest, size_t n)
598 MoveMemory(dest, src, n);
602 * The stubs below are replacements for the windows versions,
603 * which can -fail- when used in our memory spaces because they
604 * validate the memory spaces they are passed in a way that
605 * denies our exception handler a chance to run.
608 void *memmove(void *dest, const void *src, size_t n)
612 for (i = 0; i < n; i++) *(((char *)dest)+i) = *(((char *)src)+i);
614 while (n--) *(((char *)dest)+n) = *(((char *)src)+n);
619 void *memcpy(void *dest, const void *src, size_t n)
621 while (n--) *(((char *)dest)+n) = *(((char *)src)+n);
625 char *dirname(char *path)
627 static char buf[PATH_MAX + 1];
628 size_t pathlen = strlen(path);
631 if (pathlen >= sizeof(buf)) {
632 lose("Pathname too long in dirname.\n");
637 for (i = pathlen; i >= 0; --i) {
638 if (buf[i] == '/' || buf[i] == '\\') {
647 /* This is a manually-maintained version of ldso_stubs.S. */
652 FlushConsoleInputBuffer(0);
653 FormatMessageA(0, 0, 0, 0, 0, 0, 0);
657 GetConsoleOutputCP();
659 GetExitCodeProcess(0, 0);
662 GetProcAddress(0, 0);
663 GetProcessTimes(0, 0, 0, 0, 0);
664 GetSystemTimeAsFileTime(0);
667 PeekConsoleInput(0, 0, 0, 0);
668 PeekNamedPipe(0, 0, 0, 0, 0, 0);
669 ReadFile(0, 0, 0, 0, 0);
671 WriteFile(0, 0, 0, 0, 0);
685 #ifndef LISP_FEATURE_SB_UNICODE
686 CreateDirectoryA(0,0);
687 GetComputerNameA(0, 0);
688 GetCurrentDirectoryA(0,0);
689 GetEnvironmentVariableA(0, 0, 0);
692 SHGetFolderPathA(0, 0, 0, 0, 0);
693 SetCurrentDirectoryA(0);
694 SetEnvironmentVariableA(0, 0);
696 CreateDirectoryW(0,0);
697 FormatMessageW(0, 0, 0, 0, 0, 0, 0);
698 GetComputerNameW(0, 0);
699 GetCurrentDirectoryW(0,0);
700 GetEnvironmentVariableW(0, 0, 0);
703 SHGetFolderPathW(0, 0, 0, 0, 0);
704 SetCurrentDirectoryW(0);
705 SetEnvironmentVariableW(0, 0);
710 os_get_runtime_executable_path()
712 char path[MAX_PATH + 1];
713 DWORD bufsize = sizeof(path);
716 if ((size = GetModuleFileNameA(NULL, path, bufsize)) == 0)
718 else if (size == bufsize && GetLastError() == ERROR_INSUFFICIENT_BUFFER)
721 return copied_string(path);