/* A tiny bit of interrupt.c state we want our paws on. */
extern boolean internal_errors_enabled;
+#if defined(LISP_FEATURE_X86)
+static int
+handle_single_step(os_context_t *ctx)
+{
+ 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
+
#ifdef LISP_FEATURE_UD2_BREAKPOINTS
-#define IS_TRAP_EXCEPTION(exception_record, context) \
- (((exception_record)->ExceptionCode == EXCEPTION_ILLEGAL_INSTRUCTION) && \
- (((unsigned short *)((context)->Eip))[0] == 0x0b0f))
+#define SBCL_EXCEPTION_BREAKPOINT EXCEPTION_ILLEGAL_INSTRUCTION
#define TRAP_CODE_WIDTH 2
#else
-#define IS_TRAP_EXCEPTION(exception_record, context) \
- ((exception_record)->ExceptionCode == EXCEPTION_BREAKPOINT)
+#define SBCL_EXCEPTION_BREAKPOINT EXCEPTION_BREAKPOINT
#define TRAP_CODE_WIDTH 1
#endif
-/*
- * 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 *context,
- void *dispatcher_context)
+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 (IS_TRAP_EXCEPTION(exception_record, context)) {
- unsigned char trap;
- /* This is just for info in case the monitor wants to print an
- * approximation. */
- current_control_stack_pointer =
- (lispobj *)*os_context_sp_addr(context);
- /* Unlike some other operating systems, Win32 leaves EIP
- * pointing to the breakpoint instruction. */
- context->Eip += TRAP_CODE_WIDTH;
- /* Now EIP points just after the INT3 byte and aims at the
- * 'kind' value (eg trap_Cerror). */
- trap = *(unsigned char *)(*os_context_pc_addr(context));
- handle_trap(context, trap);
- /* Done, we're good to go! */
- return ExceptionContinueExecution;
- }
- 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;
+ /* Done, we're good to go! */
+ return 0;
+}
- if (!VirtualQuery(fault_address, &mem_info, sizeof mem_info)) {
- fprintf(stderr, "VirtualQuery: 0x%lx.\n", GetLastError());
- lose("handle_exception: VirtualQuery failure");
- }
+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;
+
+ /* Pick off GC-related memory fault next. */
+ MEMORY_BASIC_INFORMATION mem_info;
- 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);
- }
+ 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]) {
+ 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
* 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
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);
fflush(stderr);
- fake_foreign_function_call(context);
+ 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
projects / sbcl.git / commitdiff