X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fwin32-os.c;h=b3e22ca6dcddedb6610db50659a9cc198b38f4ed;hb=0285aa5ff8416027932daa001b84429be2ca559b;hp=e4620f8ea9c6e69c40f99e783952a5f91c405286;hpb=45b5a21316381ecab98a0e5a5296294e044170e8;p=sbcl.git diff --git a/src/runtime/win32-os.c b/src/runtime/win32-os.c index e4620f8..b3e22ca 100644 --- a/src/runtime/win32-os.c +++ b/src/runtime/win32-os.c @@ -51,16 +51,6 @@ #include #include -/* KLUDGE: Avoid double definition of boolean by rpcndr.h included via - * shlobj.h. - * - * FIXME: We should probably arrange to use the rpcndr.h boolean on Windows, - * or get rid of our own boolean type. - */ -#define boolean rpcndr_boolean -#include -#undef boolean - #include #include @@ -171,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"); @@ -305,102 +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; -/* - * A good explanation of the exception handling semantics is - * http://win32assembly.online.fr/Exceptionhandling.html . - */ +#if defined(LISP_FEATURE_X86) +static int +handle_single_step(os_context_t *ctx) +{ + if (!single_stepping) + return -1; -EXCEPTION_DISPOSITION -handle_exception(EXCEPTION_RECORD *exception_record, - struct lisp_exception_frame *exception_frame, - CONTEXT *context, - void *dispatcher_context) + /* We are doing a displaced instruction. At least function + * end breakpoints use this. */ + restore_breakpoint_from_single_step(ctx); + + return 0; +} +#endif + +#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 + +static int +handle_breakpoint_trap(os_context_t *ctx) { - if (exception_record->ExceptionFlags & (EH_UNWINDING | EH_EXIT_UNWIND)) { - /* If we're being unwound, be graceful about it. */ +#ifdef LISP_FEATURE_UD2_BREAKPOINTS + if (((unsigned short *)((ctx->win32_context)->Eip))[0] != 0x0b0f) + return -1; +#endif - /* Undo any dynamic bindings. */ - unbind_to_here(exception_frame->bindstack_pointer, - arch_os_get_current_thread()); + /* Unlike some other operating systems, Win32 leaves EIP + * pointing to the breakpoint instruction. */ + ctx->Eip += TRAP_CODE_WIDTH; - return ExceptionContinueSearch; - } + /* 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)); - /* For EXCEPTION_ACCESS_VIOLATION only. */ - void *fault_address = (void *)exception_record->ExceptionInformation[1]; + /* This is just for info in case the monitor wants to print an + * approximation. */ + current_control_stack_pointer = + (lispobj *)*os_context_sp_addr(ctx); - if (single_stepping && - exception_record->ExceptionCode == EXCEPTION_SINGLE_STEP) { - /* We are doing a displaced instruction. At least function - * end breakpoints uses this. */ - restore_breakpoint_from_single_step(context); - return ExceptionContinueExecution; - } + handle_trap(ctx, trap); - if (exception_record->ExceptionCode == EXCEPTION_BREAKPOINT) { - /* Pick off sigtrap case first. */ + /* Done, we're good to go! */ + return 0; +} - extern void sigtrap_handler(int signal, siginfo_t *info, void *context); - /* - * Unlike some other operating systems, Win32 leaves EIP - * pointing to the breakpoint instruction. - */ - context->Eip++; +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; - sigtrap_handler(0, NULL, context); + /* Pick off GC-related memory fault next. */ + MEMORY_BASIC_INFORMATION mem_info; - return ExceptionContinueExecution; + if (!VirtualQuery(fault_address, &mem_info, sizeof mem_info)) { + fprintf(stderr, "VirtualQuery: 0x%lx.\n", GetLastError()); + lose("handle_exception: VirtualQuery failure"); } - else if (exception_record->ExceptionCode == EXCEPTION_ACCESS_VIOLATION && - (is_valid_lisp_addr(fault_address) || - is_linkage_table_addr(fault_address))) { - /* 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 (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 @@ -417,11 +433,11 @@ handle_exception(EXCEPTION_RECORD *exception_record, * aren't supposed to happen during cold init or reinit * anyway. */ - fake_foreign_function_call(context); + fake_foreign_function_call(ctx); /* Allocate the SAP objects while the "interrupts" are still * disabled. */ - context_sap = alloc_sap(context); + context_sap = alloc_sap(ctx); exception_record_sap = alloc_sap(exception_record); /* The exception system doesn't automatically clear pending @@ -430,14 +446,14 @@ handle_exception(EXCEPTION_RECORD *exception_record, _clearfp(); /* Call into lisp to handle things. */ - funcall2(SymbolFunction(HANDLE_WIN32_EXCEPTION), context_sap, + 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(context); + undo_fake_foreign_function_call(ctx); /* FIXME: HANDLE-WIN32-EXCEPTION should be allowed to decline */ - return ExceptionContinueExecution; + return; } fprintf(stderr, "Exception Code: 0x%lx.\n", exception_record->ExceptionCode); @@ -456,11 +472,67 @@ handle_exception(EXCEPTION_RECORD *exception_record, fflush(stderr); - fake_foreign_function_call(context); - lose("fake_foreign_function_call fell through"); + fake_foreign_function_call(ctx); + lose("Exception too early in cold init, cannot continue."); +} + +/* + * 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) +{ + if (exception_record->ExceptionFlags & (EH_UNWINDING | EH_EXIT_UNWIND)) { + /* If we're being unwound, be graceful about it. */ + + /* Undo any dynamic bindings. */ + unbind_to_here(exception_frame->bindstack_pointer, + arch_os_get_current_thread()); + + return ExceptionContinueSearch; + } + + DWORD code = exception_record->ExceptionCode; + + /* For EXCEPTION_ACCESS_VIOLATION only. */ + void *fault_address = (void *)exception_record->ExceptionInformation[1]; + + /* 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 + + 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); - /* FIXME: WTF? How are we supposed to end up here? */ - return ExceptionContinueSearch; + return ExceptionContinueExecution; } void @@ -550,24 +622,26 @@ void scratch(void) Sleep(0); WriteFile(0, 0, 0, 0, 0); _get_osfhandle(0); + _rmdir(0); _pipe(0,0,0); access(0,0); - acos(0); - asin(0); close(0); - cosh(0); dup(0); - hypot(0, 0); isatty(0); - sinh(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 CreateDirectoryA(0,0); + CreateFileMappingA(0,0,0,0,0,0); + CreateFileA(0,0,0,0,0,0,0); GetComputerNameA(0, 0); GetCurrentDirectoryA(0,0); GetEnvironmentVariableA(0, 0, 0); + GetFileAttributesA(0); GetVersionExA(0); MoveFileA(0,0); SHGetFolderPathA(0, 0, 0, 0, 0); @@ -575,20 +649,24 @@ void scratch(void) 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 + _exit(0); } char * -os_get_runtime_executable_path() +os_get_runtime_executable_path(int external) { char path[MAX_PATH + 1]; DWORD bufsize = sizeof(path);