X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fwin32-os.c;h=b3e22ca6dcddedb6610db50659a9cc198b38f4ed;hb=0285aa5ff8416027932daa001b84429be2ca559b;hp=1749966eb36e4ca476d9fe52f56c13cdb487f19a;hpb=94284af2ff059b0d83d891fb9903f182db6751af;p=sbcl.git diff --git a/src/runtime/win32-os.c b/src/runtime/win32-os.c index 1749966..b3e22ca 100644 --- a/src/runtime/win32-os.c +++ b/src/runtime/win32-os.c @@ -26,6 +26,7 @@ * yet. */ +#include #include #include #include @@ -42,13 +43,16 @@ #include "runtime.h" #include "alloc.h" #include "genesis/primitive-objects.h" +#include "dynbind.h" #include #include #include #include #include -#include + +#include +#include #include @@ -56,7 +60,6 @@ #include "thread.h" size_t os_vm_page_size; - #include "gc.h" #include "gencgc-internal.h" @@ -85,6 +88,7 @@ static void set_seh_frame(void *frame) asm volatile ("movl %0,%%fs:0": : "r" (frame)); } +#if 0 static struct lisp_exception_frame *find_our_seh_frame(void) { struct lisp_exception_frame *frame = get_seh_frame(); @@ -95,7 +99,6 @@ static struct lisp_exception_frame *find_our_seh_frame(void) return frame; } -#if 0 inline static void *get_stack_frame(void) { void* retval; @@ -158,7 +161,22 @@ os_validate(os_vm_address_t addr, os_vm_size_t len) return 0; } - if ((mem_info.State == MEM_RESERVE) && (mem_info.RegionSize >=len)) return addr; + if ((mem_info.State == MEM_RESERVE) && (mem_info.RegionSize >=len)) { + /* It would be correct to return here. However, support for Wine + * is beneficial, and Wine has a strange behavior in this + * department. It reports all memory below KERNEL32.DLL as + * reserved, but disallows MEM_COMMIT. + * + * Let's work around it: reserve the region we need for a second + * time. The second reservation is documented to fail on normal NT + * family, but it will succeed on Wine if this region is + * actually free. + */ + VirtualAlloc(addr, len, MEM_RESERVE, PAGE_EXECUTE_READWRITE); + /* If it is wine, the second call has succeded, and now the region + * is really reserved. */ + return addr; + } if (mem_info.State == MEM_RESERVE) { fprintf(stderr, "validation of reserved space too short.\n"); @@ -270,12 +288,18 @@ in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen) } boolean +is_linkage_table_addr(os_vm_address_t addr) +{ + return in_range_p(addr, LINKAGE_TABLE_SPACE_START, LINKAGE_TABLE_SPACE_END); +} + +boolean is_valid_lisp_addr(os_vm_address_t addr) { struct thread *th; if(in_range_p(addr, READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE) || in_range_p(addr, STATIC_SPACE_START , STATIC_SPACE_SIZE) || - in_range_p(addr, DYNAMIC_SPACE_START , DYNAMIC_SPACE_SIZE)) + in_range_p(addr, DYNAMIC_SPACE_START , dynamic_space_size)) return 1; for_each_thread(th) { if(((os_vm_address_t)th->control_stack_start <= addr) && (addr < (os_vm_address_t)th->control_stack_end)) @@ -286,183 +310,113 @@ is_valid_lisp_addr(os_vm_address_t addr) return 0; } -/* - * any OS-dependent special low-level handling for signals - */ - /* A tiny bit of interrupt.c state we want our paws on. */ extern boolean internal_errors_enabled; -/* - * FIXME: There is a potential problem with foreign code here. - * If we are running foreign code instead of lisp code and an - * exception occurs we arrange a call into Lisp. If the - * foreign code has installed an exception handler, we run the - * very great risk of throwing through their exception handler - * without asking it to unwind. This is more a problem with - * non-sigtrap (EXCEPTION_BREAKPOINT) exceptions, as they could - * reasonably be expected to happen in foreign code. We need to - * figure out the exception handler unwind semantics and adhere - * to them (probably by abusing the Lisp unwind-protect system) - * if we are going to handle this scenario correctly. - * - * A good explanation of the exception handling semantics is - * http://win32assembly.online.fr/Exceptionhandling.html . - * We will also need to handle this ourselves when foreign - * code tries to unwind -us-. - * - * When unwinding through foreign code we should unwind the - * Lisp stack to the entry from foreign code, then unwind the - * foreign code stack to the entry from Lisp, then resume - * unwinding in Lisp. - */ - -EXCEPTION_DISPOSITION sigtrap_emulator(CONTEXT *context, - struct lisp_exception_frame *exception_frame) +#if defined(LISP_FEATURE_X86) +static int +handle_single_step(os_context_t *ctx) { - if (*((char *)context->Eip + 1) == trap_ContextRestore) { - /* - * This is the cleanup for what is immediately below, and - * for the generic exception handling further below. We - * have to memcpy() the original context (emulated sigtrap - * or normal exception) over our context and resume it. - */ - memcpy(context, &exception_frame->context, sizeof(CONTEXT)); - return ExceptionContinueExecution; - - } else { /* Not a trap_ContextRestore, must be a sigtrap. */ - /* sigtrap_trampoline is defined in x86-assem.S. */ - extern void sigtrap_trampoline; - - /* - * Unlike some other operating systems, Win32 leaves EIP - * pointing to the breakpoint instruction. - */ - context->Eip++; - - /* - * We're not on an alternate stack like we would be in some - * other operating systems, and we don't want to risk leaking - * any important resources if we throw out of the sigtrap - * handler, so we need to copy off our context to a "safe" - * place and then monkey with the return EIP to point to a - * trampoline which calls another function which copies the - * context out to a really-safe place and then calls the real - * sigtrap handler. When the real sigtrap handler returns, the - * trampoline then contains another breakpoint with a code of - * trap_ContextRestore (see above). Essentially the same - * mechanism is used by the generic exception path. There is - * a small window of opportunity between us copying the - * context to the "safe" place and the sigtrap wrapper copying - * it to the really-safe place (allocated in its stack frame) - * during which the context can be smashed. The only scenario - * I can come up with for this, however, involves a stack - * overflow occuring at just the wrong time (which makes one - * wonder how stack overflow exceptions even happen, given - * that we don't switch stacks for exception processing...) - */ - memcpy(&exception_frame->context, context, sizeof(CONTEXT)); - context->Eax = context->Eip; - context->Eip = (unsigned long)&sigtrap_trampoline; - - /* and return */ - return ExceptionContinueExecution; - } + if (!single_stepping) + return -1; + + /* We are doing a displaced instruction. At least function + * end breakpoints use this. */ + restore_breakpoint_from_single_step(ctx); + + return 0; } +#endif -void sigtrap_wrapper(void) -{ - /* - * This is the wrapper around the sigtrap handler called from - * the trampoline returned to from the function above. - * - * There actually is a point to some of the commented-out code - * in this function, although it really belongs to the callback - * wrappers. Once it is installed there, it can probably be - * removed from here. - */ +#ifdef LISP_FEATURE_UD2_BREAKPOINTS +#define SBCL_EXCEPTION_BREAKPOINT EXCEPTION_ILLEGAL_INSTRUCTION +#define TRAP_CODE_WIDTH 2 +#else +#define SBCL_EXCEPTION_BREAKPOINT EXCEPTION_BREAKPOINT +#define TRAP_CODE_WIDTH 1 +#endif - extern void sigtrap_handler(int signal, siginfo_t *info, void *context); +static int +handle_breakpoint_trap(os_context_t *ctx) +{ +#ifdef LISP_FEATURE_UD2_BREAKPOINTS + if (((unsigned short *)((ctx->win32_context)->Eip))[0] != 0x0b0f) + return -1; +#endif -/* volatile struct { */ -/* void *handler[2]; */ - CONTEXT context; -/* } handler; */ + /* Unlike some other operating systems, Win32 leaves EIP + * pointing to the breakpoint instruction. */ + ctx->Eip += TRAP_CODE_WIDTH; - struct lisp_exception_frame *frame = find_our_seh_frame(); + /* Now EIP points just after the INT3 byte and aims at the + * 'kind' value (eg trap_Cerror). */ + unsigned char trap = *(unsigned char *)(*os_context_pc_addr(ctx)); -/* wos_install_interrupt_handlers(handler); */ -/* handler.handler[0] = get_seh_frame(); */ -/* handler.handler[1] = &handle_exception; */ -/* set_seh_frame(&handler); */ + /* This is just for info in case the monitor wants to print an + * approximation. */ + current_control_stack_pointer = + (lispobj *)*os_context_sp_addr(ctx); - memcpy(&context, &frame->context, sizeof(CONTEXT)); - sigtrap_handler(0, NULL, &context); - memcpy(&frame->context, &context, sizeof(CONTEXT)); + handle_trap(ctx, trap); -/* set_seh_frame(handler.handler[0]); */ + /* Done, we're good to go! */ + return 0; } -EXCEPTION_DISPOSITION handle_exception(EXCEPTION_RECORD *exception_record, - struct lisp_exception_frame *exception_frame, - CONTEXT *context, - void *dc) /* FIXME: What's dc again? */ +static int +handle_access_violation(os_context_t *ctx, + EXCEPTION_RECORD *exception_record, + void *fault_address) { + if (!(is_valid_lisp_addr(fault_address) + || is_linkage_table_addr(fault_address))) + return -1; - /* For EXCEPTION_ACCESS_VIOLATION only. */ - void *fault_address = (void *)exception_record->ExceptionInformation[1]; - - if (exception_record->ExceptionCode == EXCEPTION_BREAKPOINT) { - /* Pick off sigtrap case first. */ - return sigtrap_emulator(context, exception_frame); - - } else if (exception_record->ExceptionCode == EXCEPTION_ACCESS_VIOLATION && - (is_valid_lisp_addr(fault_address) || - /* the linkage table does not contain valid lisp - * objects, but is also committed on-demand here - */ - in_range_p(fault_address, LINKAGE_TABLE_SPACE_START, - LINKAGE_TABLE_SPACE_END))) { - /* Pick off GC-related memory fault next. */ - MEMORY_BASIC_INFORMATION mem_info; + /* Pick off GC-related memory fault next. */ + MEMORY_BASIC_INFORMATION mem_info; - if (!VirtualQuery(fault_address, &mem_info, sizeof mem_info)) { - fprintf(stderr, "VirtualQuery: 0x%lx.\n", GetLastError()); - lose("handle_exception: VirtualQuery failure"); - } + if (!VirtualQuery(fault_address, &mem_info, sizeof mem_info)) { + fprintf(stderr, "VirtualQuery: 0x%lx.\n", GetLastError()); + lose("handle_exception: VirtualQuery failure"); + } - if (mem_info.State == MEM_RESERVE) { - /* First use new page, lets get some memory for it. */ - if (!VirtualAlloc(mem_info.BaseAddress, os_vm_page_size, - MEM_COMMIT, PAGE_EXECUTE_READWRITE)) { - fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError()); - lose("handle_exception: VirtualAlloc failure"); - - } else { - /* - * Now, if the page is supposedly write-protected and this - * is a write, tell the gc that it's been hit. - * - * FIXME: Are we supposed to fall-through to the Lisp - * exception handler if the gc doesn't take the wp violation? - */ - if (exception_record->ExceptionInformation[0]) { - int index = find_page_index(fault_address); - if ((index != -1) && (page_table[index].write_protected)) { - gencgc_handle_wp_violation(fault_address); - } + if (mem_info.State == MEM_RESERVE) { + /* First use new page, lets get some memory for it. */ + if (!VirtualAlloc(mem_info.BaseAddress, os_vm_page_size, + MEM_COMMIT, PAGE_EXECUTE_READWRITE)) { + fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError()); + lose("handle_exception: VirtualAlloc failure"); + + } else { + /* + * Now, if the page is supposedly write-protected and this + * is a write, tell the gc that it's been hit. + * + * FIXME: Are we supposed to fall-through to the Lisp + * exception handler if the gc doesn't take the wp violation? + */ + if (exception_record->ExceptionInformation[0]) { + page_index_t index = find_page_index(fault_address); + if ((index != -1) && (page_table[index].write_protected)) { + gencgc_handle_wp_violation(fault_address); } - return ExceptionContinueExecution; } - - } else if (gencgc_handle_wp_violation(fault_address)) { - /* gc accepts the wp violation, so resume where we left off. */ - return ExceptionContinueExecution; + return 0; } - /* All else failed, drop through to the lisp-side exception handler. */ + } else if (gencgc_handle_wp_violation(fault_address)) { + /* gc accepts the wp violation, so resume where we left off. */ + return 0; } + return -1; +} + +static void +signal_internal_error_or_lose(os_context_t *ctx, + EXCEPTION_RECORD *exception_record, + void *fault_address) +{ /* * If we fall through to here then we need to either forward * the exception to the lisp-side exception handler if it's @@ -470,39 +424,36 @@ EXCEPTION_DISPOSITION handle_exception(EXCEPTION_RECORD *exception_record, */ if (internal_errors_enabled) { - /* exception_trampoline is defined in x86-assem.S. */ - extern void exception_trampoline; - - /* - * We're making the somewhat arbitrary decision that - * having internal errors enabled means that lisp has - * sufficient marbles to be able to handle exceptions. - * - * Exceptions aren't supposed to happen during cold - * init or reinit anyway. - */ - - /* - * We use the same mechanism as the sigtrap emulator above - * with just a couple changes. We obviously use a different - * trampoline and wrapper function, we kill out any live - * floating point exceptions, and we save off the exception - * record as well as the context. - */ - - /* Save off context and exception information */ - memcpy(&exception_frame->context, context, sizeof(CONTEXT)); - memcpy(&exception_frame->exception, exception_record, sizeof(EXCEPTION_RECORD)); - - /* Set up to activate trampoline when we return */ - context->Eax = context->Eip; - context->Eip = (unsigned long)&exception_trampoline; - - /* Make sure a floating-point trap doesn't kill us */ - context->FloatSave.StatusWord &= ~0x3f; - - /* And return */ - return ExceptionContinueExecution; + lispobj context_sap; + lispobj exception_record_sap; + + /* We're making the somewhat arbitrary decision that having + * internal errors enabled means that lisp has sufficient + * marbles to be able to handle exceptions, but exceptions + * aren't supposed to happen during cold init or reinit + * anyway. */ + + fake_foreign_function_call(ctx); + + /* Allocate the SAP objects while the "interrupts" are still + * disabled. */ + context_sap = alloc_sap(ctx); + exception_record_sap = alloc_sap(exception_record); + + /* The exception system doesn't automatically clear pending + * exceptions, so we lose as soon as we execute any FP + * instruction unless we do this first. */ + _clearfp(); + + /* Call into lisp to handle things. */ + funcall2(StaticSymbolFunction(HANDLE_WIN32_EXCEPTION), context_sap, + exception_record_sap); + + /* If Lisp doesn't nlx, we need to put things back. */ + undo_fake_foreign_function_call(ctx); + + /* FIXME: HANDLE-WIN32-EXCEPTION should be allowed to decline */ + return; } fprintf(stderr, "Exception Code: 0x%lx.\n", exception_record->ExceptionCode); @@ -521,37 +472,67 @@ EXCEPTION_DISPOSITION handle_exception(EXCEPTION_RECORD *exception_record, fflush(stderr); - fake_foreign_function_call(context); - lose("fake_foreign_function_call fell through"); - - /* FIXME: WTF? How are we supposed to end up here? */ - return ExceptionContinueSearch; + fake_foreign_function_call(ctx); + lose("Exception too early in cold init, cannot continue."); } -void handle_win32_exception_wrapper(void) +/* + * A good explanation of the exception handling semantics is + * http://win32assembly.online.fr/Exceptionhandling.html . + */ + +EXCEPTION_DISPOSITION +handle_exception(EXCEPTION_RECORD *exception_record, + struct lisp_exception_frame *exception_frame, + CONTEXT *ctx, + void *dispatcher_context) { - struct lisp_exception_frame *frame = find_our_seh_frame(); - CONTEXT context; - EXCEPTION_RECORD exception_record; - lispobj context_sap; - lispobj exception_record_sap; + if (exception_record->ExceptionFlags & (EH_UNWINDING | EH_EXIT_UNWIND)) { + /* If we're being unwound, be graceful about it. */ - memcpy(&context, &frame->context, sizeof(CONTEXT)); - memcpy(&exception_record, &frame->exception, sizeof(EXCEPTION_RECORD)); + /* Undo any dynamic bindings. */ + unbind_to_here(exception_frame->bindstack_pointer, + arch_os_get_current_thread()); - fake_foreign_function_call(&context); + return ExceptionContinueSearch; + } - /* Allocate the SAP objects while the "interrupts" are still - * disabled. */ - context_sap = alloc_sap(&context); - exception_record_sap = alloc_sap(&exception_record); + DWORD code = exception_record->ExceptionCode; - funcall2(SymbolFunction(HANDLE_WIN32_EXCEPTION), context_sap, - exception_record_sap); + /* For EXCEPTION_ACCESS_VIOLATION only. */ + void *fault_address = (void *)exception_record->ExceptionInformation[1]; - undo_fake_foreign_function_call(&context); + /* This function will become unwieldy. Let's cut it down into + * pieces based on the different exception codes. Each exception + * code handler gets the chance to decline by returning non-zero if it + * isn't happy: */ + + int rc; + switch (code) { + case EXCEPTION_ACCESS_VIOLATION: + rc = handle_access_violation( + ctx, exception_record, fault_address); + break; + + case SBCL_EXCEPTION_BREAKPOINT: + rc = handle_breakpoint_trap(ctx); + break; + +#if defined(LISP_FEATURE_X86) + case EXCEPTION_SINGLE_STEP: + rc = handle_single_step(ctx); + break; +#endif - memcpy(&frame->context, &context, sizeof(CONTEXT)); + default: + rc = -1; + } + + if (rc) + /* All else failed, drop through to the lisp-side exception handler. */ + signal_internal_error_or_lose(ctx, exception_record, fault_address); + + return ExceptionContinueExecution; } void @@ -615,93 +596,77 @@ char *dirname(char *path) /* This is a manually-maintained version of ldso_stubs.S. */ +void __stdcall RtlUnwind(void *, void *, void *, void *); /* I don't have winternl.h */ + void scratch(void) { - strerror(42); - asin(0); - acos(0); - sinh(0); - cosh(0); - hypot(0, 0); - write(0, 0, 0); - close(0); - #ifndef LISP_FEATURE_SB_UNICODE - MoveFileA(0,0); - #else - MoveFileW(0,0); - #endif - #ifndef LISP_FEATURE_SB_UNICODE - GetCurrentDirectoryA(0,0); - #else - GetCurrentDirectoryW(0,0); - #endif - dup(0); - LoadLibrary(0); - GetProcAddress(0, 0); - FreeLibrary(0); - #ifndef LISP_FEATURE_SB_UNICODE - CreateDirectoryA(0,0); - #else - CreateDirectoryW(0,0); - #endif - _pipe(0,0,0); - isatty(0); - access(0,0); - GetLastError(); - FormatMessageA(0, 0, 0, 0, 0, 0, 0); - #ifdef LISP_FEATURE_SB_UNICODE - FormatMessageW(0, 0, 0, 0, 0, 0, 0); - #endif - _get_osfhandle(0); - ReadFile(0, 0, 0, 0, 0); - WriteFile(0, 0, 0, 0, 0); - PeekNamedPipe(0, 0, 0, 0, 0, 0); + CloseHandle(0); FlushConsoleInputBuffer(0); - PeekConsoleInput(0, 0, 0, 0); - Sleep(0); - #ifndef LISP_FEATURE_SB_UNICODE - SHGetFolderPathA(0, 0, 0, 0, 0); - #else - SHGetFolderPathW(0, 0, 0, 0, 0); - #endif + FormatMessageA(0, 0, 0, 0, 0, 0, 0); + FreeLibrary(0); GetACP(); - GetOEMCP(); - LocalFree(0); - #ifndef LISP_FEATURE_SB_UNICODE - GetEnvironmentVariableA(0, 0, 0); - #else - GetEnvironmentVariableW(0, 0, 0); - #endif GetConsoleCP(); GetConsoleOutputCP(); - GetExitCodeProcess(0, 0); GetCurrentProcess(); + GetExitCodeProcess(0, 0); + GetLastError(); + GetOEMCP(); + GetProcAddress(0, 0); GetProcessTimes(0, 0, 0, 0, 0); + GetSystemTimeAsFileTime(0); + LoadLibrary(0); + LocalFree(0); + PeekConsoleInput(0, 0, 0, 0); + PeekNamedPipe(0, 0, 0, 0, 0, 0); + ReadFile(0, 0, 0, 0, 0); + Sleep(0); + WriteFile(0, 0, 0, 0, 0); + _get_osfhandle(0); + _rmdir(0); + _pipe(0,0,0); + access(0,0); + close(0); + dup(0); + isatty(0); + strerror(42); + write(0, 0, 0); + RtlUnwind(0, 0, 0, 0); + MapViewOfFile(0,0,0,0,0); + UnmapViewOfFile(0); + FlushViewOfFile(0,0); #ifndef LISP_FEATURE_SB_UNICODE - SetEnvironmentVariableA(0, 0); - #else - SetEnvironmentVariableW(0, 0); - #endif - #ifndef LISP_FEATURE_SB_UNICODE - GetVersionExA(0); - #else - GetVersionExW(0); - #endif - #ifndef LISP_FEATURE_SB_UNICODE + CreateDirectoryA(0,0); + CreateFileMappingA(0,0,0,0,0,0); + CreateFileA(0,0,0,0,0,0,0); GetComputerNameA(0, 0); - #else - GetComputerNameW(0, 0); - #endif - #ifndef LISP_FEATURE_SB_UNICODE + GetCurrentDirectoryA(0,0); + GetEnvironmentVariableA(0, 0, 0); + GetFileAttributesA(0); + GetVersionExA(0); + MoveFileA(0,0); + SHGetFolderPathA(0, 0, 0, 0, 0); SetCurrentDirectoryA(0); + SetEnvironmentVariableA(0, 0); #else + CreateDirectoryW(0,0); + CreateFileMappingW(0,0,0,0,0,0); + CreateFileW(0,0,0,0,0,0,0); + FormatMessageW(0, 0, 0, 0, 0, 0, 0); + GetComputerNameW(0, 0); + GetCurrentDirectoryW(0,0); + GetEnvironmentVariableW(0, 0, 0); + GetFileAttributesW(0); + GetVersionExW(0); + MoveFileW(0,0); + SHGetFolderPathW(0, 0, 0, 0, 0); SetCurrentDirectoryW(0); + SetEnvironmentVariableW(0, 0); #endif - CloseHandle(0); + _exit(0); } char * -os_get_runtime_executable_path() +os_get_runtime_executable_path(int external) { char path[MAX_PATH + 1]; DWORD bufsize = sizeof(path);