/* -*-C-*- $Id: nttrap.c,v 1.19 2001/12/16 06:01:32 cph Exp $ Copyright (c) 1992-2001 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ #include #include "scheme.h" #include "os.h" #include "nt.h" #include "nttrap.h" #include "gccode.h" #include "ntscmlib.h" #include #ifdef W32_TRAP_DEBUG extern char * AskUser (char *, int); extern int EXFUN (TellUser, (char *, ...)); extern int EXFUN (TellUserEx, (int, char *, ...)); #endif /* W32_TRAP_DEBUG */ extern void EXFUN (callWinntExceptionTransferHook, (void)); extern void EXFUN (NT_initialize_traps, (void)); extern void EXFUN (NT_restore_traps, (void)); extern DWORD C_Stack_Pointer, C_Frame_Pointer; #ifdef W32_TRAP_DEBUG static BOOL trap_verbose_p = FALSE; #define IFVERBOSE(command) do \ { \ if (trap_verbose_p) \ { \ int result = command; \ if (result == IDCANCEL) \ trap_verbose_p = FALSE; \ } \ } while (0) #else /* not W32_TRAP_DEBUG */ #define IFVERBOSE(command) do { } while (0) #endif /* W32_TRAP_DEBUG */ static char * trap_output = ((char *) NULL); static char * trap_output_pointer = ((char *) NULL); static void DEFUN_VOID (trap_noise_start) { trap_output = ((char *) NULL); trap_output_pointer = ((char *) NULL); return; } static void DEFUN (trap_noise, (format), char * format DOTS) { va_list arg_ptr; unsigned long size; char * temp; size = (trap_output_pointer - trap_output); temp = ((trap_output == ((char *) NULL)) ? ((char *) (malloc (256))) : ((char *) (realloc (trap_output, (256 + size))))); if (temp == ((char *) NULL)) return; trap_output = temp; trap_output_pointer = (temp + size); va_start (arg_ptr, format); size = (wvsprintf (trap_output_pointer, format, arg_ptr)); trap_output_pointer += size; va_end (arg_ptr); return; } static int DEFUN (trap_noise_end, (style), UINT style) { int value; if (trap_output == ((char *) NULL)) return (IDYES); value = (MessageBox (NULL, trap_output, "MIT Scheme Exception Information", style)); free (trap_output); trap_output = ((char *) NULL); trap_output_pointer = ((char *) NULL); return (value); } static BOOL DEFUN (isvowel, (c), char c) { switch (c) { case 'a': case 'e': case 'i': case 'o': case 'u': case 'A': case 'E': case 'I': case 'O': case 'U': return (TRUE); default: return (FALSE); } } struct exception_name_s { DWORD code; char * name; }; static struct exception_name_s exception_names[] = { { EXCEPTION_ACCESS_VIOLATION, "ACCESS_VIOLATION", }, { EXCEPTION_DATATYPE_MISALIGNMENT, "DATATYPE_MISALIGNMENT", }, { EXCEPTION_BREAKPOINT, "BREAKPOINT", }, { EXCEPTION_SINGLE_STEP, "SINGLE_STEP", }, { EXCEPTION_ARRAY_BOUNDS_EXCEEDED, "ARRAY_BOUNDS_EXCEEDED", }, { EXCEPTION_FLT_DENORMAL_OPERAND, "FLT_DENORMAL_OPERAND", }, { EXCEPTION_FLT_DIVIDE_BY_ZERO, "FLT_DIVIDE_BY_ZERO", }, { EXCEPTION_FLT_INEXACT_RESULT, "FLT_INEXACT_RESULT", }, { EXCEPTION_FLT_INVALID_OPERATION, "FLT_INVALID_OPERATION", }, { EXCEPTION_FLT_OVERFLOW, "FLT_OVERFLOW", }, { EXCEPTION_FLT_STACK_CHECK, "FLT_STACK_CHECK", }, { EXCEPTION_FLT_UNDERFLOW, "FLT_UNDERFLOW", }, { EXCEPTION_INT_DIVIDE_BY_ZERO, "INT_DIVIDE_BY_ZERO", }, { EXCEPTION_INT_OVERFLOW, "INT_OVERFLOW", }, { EXCEPTION_PRIV_INSTRUCTION, "PRIV_INSTRUCTION", }, { EXCEPTION_IN_PAGE_ERROR, "IN_PAGE_ERROR", }, { EXCEPTION_ILLEGAL_INSTRUCTION, "ILLEGAL_INSTRUCTION", }, { EXCEPTION_NONCONTINUABLE_EXCEPTION, "NONCONTINUABLE_EXCEPTION", }, { EXCEPTION_STACK_OVERFLOW, "STACK_OVERFLOW", }, { EXCEPTION_INVALID_DISPOSITION, "INVALID_DISPOSITION", }, }; const int excp_name_limit = ((sizeof (exception_names)) / (sizeof (struct exception_name_s))); static char * find_exception_name (DWORD code) { int i; for (i = 0; i < excp_name_limit; i++) if (exception_names[i].code == code) return (exception_names[i].name); return ((char *) NULL); } static void DEFUN (describe_trap, (noise, code), char * noise AND DWORD code) { char * name; name = (find_exception_name (code)); if (name == ((char *) NULL)) trap_noise (">> The %s an unknown trap [code = %d].\n", noise, code); else trap_noise (">> The %s a%s %s trap.\n", noise, ((isvowel (name[0])) ? "n" : ""), name); return; } #define STATE_UNKNOWN (LONG_TO_UNSIGNED_FIXNUM (0)) #define STATE_PRIMITIVE (LONG_TO_UNSIGNED_FIXNUM (1)) #define STATE_COMPILED_CODE (LONG_TO_UNSIGNED_FIXNUM (2)) #define STATE_PROBABLY_COMPILED (LONG_TO_UNSIGNED_FIXNUM (3)) struct trap_recovery_info { SCHEME_OBJECT state; SCHEME_OBJECT pc_info_1; SCHEME_OBJECT pc_info_2; SCHEME_OBJECT extra_trap_info; }; static struct trap_recovery_info dummy_recovery_info = { STATE_UNKNOWN, SHARP_F, SHARP_F, SHARP_F }; struct nt_trap_code_desc { int trapno; unsigned long code_mask; unsigned long code_value; char *name; }; static enum trap_state trap_state; static enum trap_state user_trap_state; static enum trap_state saved_trap_state; static DWORD saved_trap_code; enum trap_state DEFUN (OS_set_trap_state, (state), enum trap_state state) { enum trap_state old_trap_state = user_trap_state; user_trap_state = state; trap_state = state; return (old_trap_state); } static void DEFUN_VOID (trap_normal_termination) { trap_state = trap_state_exitting_soft; termination_trap (); } static void DEFUN_VOID (trap_immediate_termination) { extern void EXFUN (OS_restore_external_state, (void)); trap_state = trap_state_exitting_hard; OS_restore_external_state (); exit (1); } void DEFUN_VOID (NT_initialize_traps) { trap_state = trap_state_recover; user_trap_state = trap_state_recover; (void) SetErrorMode (SEM_FAILCRITICALERRORS | SEM_NOGPFAULTERRORBOX); } void DEFUN_VOID (NT_restore_traps) { return; } static int DEFUN (display_exception_information, (info, context, flags), PEXCEPTION_RECORD info AND PCONTEXT context AND int flags) { int value; char msgbuf[4096]; char * flag, * name, * bufptr; bufptr = &msgbuf[0]; name = (find_exception_name (info->ExceptionCode)); flag = ((info->ExceptionFlags == 0) ? "Continuable" : "Non-continuable"); if (name == ((char *) NULL)) bufptr += (sprintf (bufptr, "%s Unknown Exception %d Raised at address 0x%lx", flag, info->ExceptionCode, info->ExceptionAddress)); else bufptr += (sprintf (bufptr, "%s %s Exception Raised at address 0x%lx", flag, name, info->ExceptionAddress)); #ifdef W32_TRAP_DEBUG if (context == ((PCONTEXT) NULL)) bufptr += (sprintf (bufptr, "\nContext is NULL.")); else { if ((context->ContextFlags & CONTEXT_CONTROL) != 0) bufptr += (sprintf (bufptr, "\nContext contains CONTROL information.")); if ((context->ContextFlags & CONTEXT_INTEGER) != 0) bufptr += (sprintf (bufptr, "\nContext contains INTEGER registers.")); if ((context->ContextFlags & CONTEXT_SEGMENTS) != 0) bufptr += (sprintf (bufptr, "\nContext contains SEGMENT registers.")); if ((context->ContextFlags & CONTEXT_FLOATING_POINT) != 0) bufptr += (sprintf (bufptr, "\nContext contains floating-point registers.")); bufptr += (sprintf (bufptr, "\ncontext->Eip = 0x%lx.", context->Eip)); bufptr += (sprintf (bufptr, "\ncontext->Esp = 0x%lx.", context->Esp)); bufptr += (sprintf (bufptr, "\nStack_Pointer = 0x%lx.", Stack_Pointer)); bufptr += (sprintf (bufptr, "\nadj (Stack_Pointer) = 0x%lx.", (ADDR_TO_SCHEME_ADDR (Stack_Pointer)))); } #endif /* W32_TRAP_DEBUG */ info = info->ExceptionRecord; if (info != ((PEXCEPTION_RECORD) NULL)) bufptr += (sprintf (bufptr, "\nTrap occurred within an earlier trap.")); #ifdef W32_TRAP_DEBUG if (flags == MB_YESNO) bufptr += (sprintf (bufptr, "\n\nDisplay More Information?")); #else /* not W32_TRAP_DEBUG */ flags = MB_OK; bufptr += (sprintf (bufptr, "\n\nScheme cannot find the state necessary to continue.")); #endif /* W32_TRAP_DEBUG */ value = (MessageBox (NULL, &msgbuf[0], "MIT Scheme Exception Info", (flags | MB_ICONSTOP))); return (value); } #define TEMP_STACK_LEN 2048 /* objects */ static BOOL return_by_aborting, clear_real_stack; static SCHEME_OBJECT temp_stack_buffer[TEMP_STACK_LEN], * temp_stack = &temp_stack_buffer[0], * temp_stack_end = &temp_stack_buffer[TEMP_STACK_LEN], * temp_stack_limit, * real_stack_guard, * real_stack_pointer; int WinntExceptionTransferHook (void) { /* These must be static because the memcpy below may be overwriting this procedure's locals! */ static int size; static SCHEME_OBJECT * temp_stack_ptr, * new_sp; temp_stack_ptr = Stack_Pointer; size = (temp_stack_limit - temp_stack_ptr); IFVERBOSE (TellUserEx (MB_OKCANCEL, "WinntExceptionTransferHook.")); if (clear_real_stack) INITIALIZE_STACK (); else { Stack_Pointer = real_stack_pointer; Stack_Guard = real_stack_guard; } new_sp = (real_stack_pointer - size); if (new_sp != temp_stack_ptr) memcpy (new_sp, temp_stack_ptr, (size * (sizeof (SCHEME_OBJECT)))); Stack_Pointer = new_sp; SET_INTERRUPT_MASK ((FETCH_INTERRUPT_MASK ())); if (return_by_aborting) abort_to_interpreter (PRIM_APPLY); return (PRIM_APPLY); } extern unsigned short __cdecl EXFUN (getCS, (void)); extern unsigned short __cdecl EXFUN (getDS, (void)); /* Needed because Stack_Check checks for <= instead of < when pushing */ #define MAGIC_BUFFER_SIZE 1 static void DEFUN (setup_trap_frame, (code, context, trinfo, new_stack_pointer), DWORD code AND PCONTEXT context AND struct trap_recovery_info * trinfo AND SCHEME_OBJECT * new_stack_pointer) { SCHEME_OBJECT trap_name, trap_code; SCHEME_OBJECT handler; int stack_recovered_p = (new_stack_pointer != 0); long saved_mask = (FETCH_INTERRUPT_MASK ()); SET_INTERRUPT_MASK (0); /* To prevent GC for now. */ IFVERBOSE (TellUserEx (MB_OKCANCEL, "setup_trap_frame (%s, 0x%lx, %s, 0x%lx, 0x%lx).", (find_exception_name (code)), context, trinfo, new_stack_pointer)); if ((! (Valid_Fixed_Obj_Vector ())) || ((handler = (Get_Fixed_Obj_Slot (Trap_Handler))) == SHARP_F)) { trap_noise_start (); trap_noise ("There is no trap handler for recovery!\n"); describe_trap ("trap is", code); (void) trap_noise_end (MB_OK | MB_ICONSTOP); termination_trap (); } if (Free > MemTop) Request_GC (0); trap_name = ((context == ((PCONTEXT) NULL)) ? SHARP_F : (char_pointer_to_string (find_exception_name (code)))); trap_code = (long_to_integer (0)); if (win32_under_win32s_p ()) { if (! stack_recovered_p) INITIALIZE_STACK (); clear_real_stack = FALSE; real_stack_pointer = Stack_Pointer; real_stack_guard = Stack_Guard; temp_stack_limit = Stack_Pointer; } else { clear_real_stack = (!stack_recovered_p); real_stack_pointer = new_stack_pointer; real_stack_guard = Stack_Guard; temp_stack_limit = temp_stack_end; Stack_Pointer = temp_stack_end; Stack_Guard = temp_stack; } Will_Push (7 + CONTINUATION_SIZE); STACK_PUSH (trinfo -> extra_trap_info); STACK_PUSH (trinfo -> pc_info_2); STACK_PUSH (trinfo -> pc_info_1); STACK_PUSH (trinfo -> state); STACK_PUSH (BOOLEAN_TO_OBJECT (stack_recovered_p)); STACK_PUSH (trap_code); STACK_PUSH (trap_name); Store_Return (RC_HARDWARE_TRAP); Store_Expression (long_to_integer (code)); Save_Cont (); Pushed (); if (stack_recovered_p /* This may want to be done in other cases, but this may be enough. */ && (trinfo->state == STATE_COMPILED_CODE)) Stop_History (); History = (Make_Dummy_History ()); Will_Push (STACK_ENV_EXTRA_SLOTS + 2); STACK_PUSH (trap_name); STACK_PUSH (handler); STACK_PUSH (STACK_FRAME_HEADER + 1); Pushed (); SET_INTERRUPT_MASK (saved_mask); IFVERBOSE (TellUserEx (MB_OKCANCEL, "setup_trap_frame done.")); return; } /* Heuristic recovery from processor traps/exceptions. continue_from_trap attempts to: 1) validate the trap information (pc and sp); 2) determine whether compiled code was executing, a primitive was executing, or execution was in the interpreter; 3) guess what C global state is still valid; and 4) set up a recovery frame for the interpreter so that debuggers can display more information. */ #define SCHEME_ALIGNMENT_MASK ((sizeof (long)) - 1) #define STACK_ALIGNMENT_MASK SCHEME_ALIGNMENT_MASK #define FREE_PARANOIA_MARGIN 0x100 /* PCs must be aligned according to this. */ #define PC_ALIGNMENT_MASK ((1 << PC_ZERO_BITS) - 1) /* But they may have bits that can be masked by this. */ #ifndef PC_VALUE_MASK # define PC_VALUE_MASK (~0) #endif #define C_STACK_SIZE 0x01000000 #ifdef HAS_COMPILER_SUPPORT # define ALLOW_ONLY_C 0 #else # define ALLOW_ONLY_C 1 # define PLAUSIBLE_CC_BLOCK_P(block) 0 #endif static SCHEME_OBJECT * EXFUN (find_block_address, (char * pc_value, SCHEME_OBJECT * area_start)); #define IA32_NREGS 12 /* For now */ #define GET_ETEXT() (Heap_Bottom) static void DEFUN (continue_from_trap, (code, context), DWORD code AND PCONTEXT context) { int pc_in_builtin; int builtin_index; int pc_in_C; int pc_in_heap; int pc_in_constant_space; int pc_in_scheme; int pc_in_hyper_space; int pc_in_utility; int utility_index; int scheme_sp_valid; long scheme_sp; long the_pc; SCHEME_OBJECT * new_stack_pointer; SCHEME_OBJECT * xtra_info; struct trap_recovery_info trinfo; extern int EXFUN (pc_to_utility_index, (unsigned long)); extern int EXFUN (pc_to_builtin_index, (unsigned long)); IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap (%s, 0x%lx).", (find_exception_name (code)), context)); if (context == ((PCONTEXT) NULL)) { if (Free < MemTop) Free = MemTop; setup_trap_frame (code, context, (&dummy_recovery_info), 0); /*NOTREACHED*/ } if (context->SegSs == (getDS ())) { IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap: SS = C DS; Stack_Pointer = 0x%lx; Esp = 0x%lx.", Stack_Pointer, context->Esp)); scheme_sp = (context->Esp); } else { IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap: SS unknown!")); scheme_sp = 0; } if (context->SegCs == (getCS ())) { IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap: CS = C CS.")); the_pc = (context->Eip & PC_VALUE_MASK); } else { IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap: CS unknown")); goto pc_in_hyperspace; } if ((the_pc & PC_ALIGNMENT_MASK) != 0) { pc_in_hyperspace: pc_in_builtin = 0; pc_in_utility = 0; pc_in_C = 0; pc_in_heap = 0; pc_in_constant_space = 0; pc_in_scheme = 0; pc_in_hyper_space = 1; } else { builtin_index = (pc_to_builtin_index (the_pc)); pc_in_builtin = (builtin_index != -1); utility_index = (pc_to_utility_index (the_pc)); pc_in_utility = (utility_index != -1); pc_in_C = ((the_pc <= ((long) (GET_ETEXT ()))) && (! pc_in_builtin)); pc_in_heap = ((the_pc < ((long) Heap_Top)) && (the_pc >= ((long) Heap_Bottom))); pc_in_constant_space = ((the_pc < ((long) Constant_Top)) && (the_pc >= ((long) Constant_Space))); pc_in_scheme = (pc_in_heap || pc_in_constant_space || pc_in_builtin); pc_in_hyper_space = ((!pc_in_C) && (!pc_in_scheme)); } IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap 1")); scheme_sp_valid = (pc_in_scheme && ((scheme_sp < ((long) Stack_Top)) && (scheme_sp >= ((long) Stack_Bottom)) && ((scheme_sp & STACK_ALIGNMENT_MASK) == 0))); IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap 2")); new_stack_pointer = (scheme_sp_valid ? ((SCHEME_OBJECT *) scheme_sp) : ((pc_in_C && (Stack_Pointer < Stack_Top) && (Stack_Pointer > Stack_Bottom)) ? Stack_Pointer : ((SCHEME_OBJECT *) 0))); IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap 3")); if (pc_in_hyper_space || (pc_in_scheme && ALLOW_ONLY_C)) { /* In hyper space. */ (trinfo . state) = STATE_UNKNOWN; (trinfo . pc_info_1) = SHARP_F; (trinfo . pc_info_2) = SHARP_F; new_stack_pointer = 0; if ((Free < MemTop) || (Free >= Heap_Top) || ((((unsigned long) Free) & SCHEME_ALIGNMENT_MASK) != 0)) Free = MemTop; } else if (pc_in_scheme) { /* In compiled code. */ SCHEME_OBJECT * block_addr; SCHEME_OBJECT * maybe_free; block_addr = (pc_in_builtin ? ((SCHEME_OBJECT *) NULL) : (find_block_address (((PTR) the_pc), (pc_in_heap ? Heap_Bottom : Constant_Space)))); if (block_addr != ((SCHEME_OBJECT *) NULL)) { (trinfo . state) = STATE_COMPILED_CODE; (trinfo . pc_info_1) = (MAKE_POINTER_OBJECT (TC_COMPILED_CODE_BLOCK, block_addr)); (trinfo . pc_info_2) = (LONG_TO_UNSIGNED_FIXNUM (the_pc - ((long) block_addr))); } else if (pc_in_builtin) { (trinfo . state) = STATE_PROBABLY_COMPILED; (trinfo . pc_info_1) = (LONG_TO_UNSIGNED_FIXNUM (builtin_index)); (trinfo . pc_info_2) = SHARP_T; } else { (trinfo . state) = STATE_PROBABLY_COMPILED; (trinfo . pc_info_1) = (LONG_TO_UNSIGNED_FIXNUM (the_pc)); (trinfo . pc_info_2) = SHARP_F; } if ((block_addr == ((SCHEME_OBJECT *) NULL)) && (! pc_in_builtin)) { if ((Free < MemTop) || (Free >= Heap_Top) || ((((unsigned long) Free) & SCHEME_ALIGNMENT_MASK) != 0)) Free = MemTop; } else { maybe_free = ((SCHEME_OBJECT *) context->Edi); if (((((unsigned long) maybe_free) & SCHEME_ALIGNMENT_MASK) == 0) && (maybe_free >= Heap_Bottom) && (maybe_free < Heap_Top)) Free = (maybe_free + FREE_PARANOIA_MARGIN); else if ((Free < MemTop) || (Free >= Heap_Top) || ((((unsigned long) Free) & SCHEME_ALIGNMENT_MASK) != 0)) Free = MemTop; } } else /* pc_in_C */ { /* In the interpreter, a primitive, or a compiled code utility. */ SCHEME_OBJECT primitive = (Regs[REGBLOCK_PRIMITIVE]); if (pc_in_utility) { (trinfo . state) = STATE_PROBABLY_COMPILED; (trinfo . pc_info_1) = (LONG_TO_UNSIGNED_FIXNUM (utility_index)); (trinfo . pc_info_2) = UNSPECIFIC; } else if ((OBJECT_TYPE (primitive)) != TC_PRIMITIVE) { (trinfo . state) = STATE_UNKNOWN; (trinfo . pc_info_1) = SHARP_F; (trinfo . pc_info_2) = SHARP_F; new_stack_pointer = 0; } else { (trinfo . state) = STATE_PRIMITIVE; (trinfo . pc_info_1) = primitive; (trinfo . pc_info_2) = (LONG_TO_UNSIGNED_FIXNUM (Regs[REGBLOCK_LEXPR_ACTUALS])); } if ((new_stack_pointer == 0) || ((((unsigned long) Free) & SCHEME_ALIGNMENT_MASK) != 0) || ((Free < Heap_Bottom) || (Free >= Heap_Top)) || ((Free < MemTop) && ((Free + FREE_PARANOIA_MARGIN) >= MemTop))) Free = MemTop; else if ((Free + FREE_PARANOIA_MARGIN) < MemTop) Free += FREE_PARANOIA_MARGIN; } IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap 4")); if (win32_under_win32s_p ()) (trinfo . extra_trap_info) = SHARP_F; else { xtra_info = Free; Free += (1 + (IA32_NREGS + 2)); (trinfo . extra_trap_info) = (MAKE_POINTER_OBJECT (TC_NON_MARKED_VECTOR, xtra_info)); (*xtra_info++) = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, (IA32_NREGS + 2))); (*xtra_info++) = ((SCHEME_OBJECT) the_pc); (*xtra_info++) = ((SCHEME_OBJECT) scheme_sp); { int counter = IA32_NREGS; int * regs = ((int *) context->Edi); while ((counter--) > 0) (*xtra_info++) = ((SCHEME_OBJECT) (*regs++)); } } IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap 5")); /* Handshake with try+except. */ context->Eip = ((DWORD) callWinntExceptionTransferHook); context->SegCs = (getCS ()); return_by_aborting = TRUE; IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap 6")); if (pc_in_scheme && (! (win32_under_win32s_p ()))) { context->Esp = C_Stack_Pointer; context->Ebp = C_Frame_Pointer; if (pc_in_scheme) return_by_aborting = FALSE; } IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap 7")); setup_trap_frame (code, context, (&trinfo), new_stack_pointer); IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap 8")); } /* Find the compiled code block in area which contains `pc_value'. This attempts to be more efficient than `find_block_address_in_area'. If the pointer is in the heap, it can actually do twice as much work, but it is expected to pay off on the average. */ static SCHEME_OBJECT * EXFUN (find_block_address_in_area, (char * pc_value, SCHEME_OBJECT * area_start)); #define MINIMUM_SCAN_RANGE 2048 static SCHEME_OBJECT * DEFUN (find_block_address, (pc_value, area_start), char * pc_value AND SCHEME_OBJECT * area_start) { if (area_start == Constant_Space) { extern SCHEME_OBJECT * EXFUN (find_constant_space_block, (SCHEME_OBJECT *)); SCHEME_OBJECT * constant_block = (find_constant_space_block ((SCHEME_OBJECT *) (((unsigned long) pc_value) &~ SCHEME_ALIGNMENT_MASK))); return ((constant_block == 0) ? 0 : (find_block_address_in_area (pc_value, constant_block))); } { SCHEME_OBJECT * nearest_word = ((SCHEME_OBJECT *) (((unsigned long) pc_value) &~ SCHEME_ALIGNMENT_MASK)); long maximum_distance = (nearest_word - area_start); long distance = maximum_distance; while ((distance / 2) > MINIMUM_SCAN_RANGE) distance = (distance / 2); while ((distance * 2) < maximum_distance) { SCHEME_OBJECT * block = (find_block_address_in_area (pc_value, (nearest_word - distance))); if (block != 0) return (block); distance *= 2; } } return (find_block_address_in_area (pc_value, area_start)); } /* Find the compiled code block in area which contains `pc_value', by scanning sequentially the complete area. For the time being, skip over manifest closures and linkage sections. */ static SCHEME_OBJECT * DEFUN (find_block_address_in_area, (pc_value, area_start), char * pc_value AND SCHEME_OBJECT * area_start) { SCHEME_OBJECT * first_valid = area_start; SCHEME_OBJECT * area = area_start; while (((char *) area) < pc_value) { SCHEME_OBJECT object = (*area); switch (OBJECT_TYPE (object)) { case TC_LINKAGE_SECTION: { switch (READ_LINKAGE_KIND (object)) { case GLOBAL_OPERATOR_LINKAGE_KIND: case OPERATOR_LINKAGE_KIND: { long count = (READ_OPERATOR_LINKAGE_COUNT (object)); area = ((END_OPERATOR_LINKAGE_AREA (area, count)) + 1); break; } default: #if FALSE { gc_death (TERM_EXIT, "find_block_address: Unknown compiler linkage kind.", area, NULL); /*NOTREACHED*/ } #else /* Fall through, no reason to crash here. */ #endif case ASSIGNMENT_LINKAGE_KIND: case CLOSURE_PATTERN_LINKAGE_KIND: case REFERENCE_LINKAGE_KIND: area += ((READ_CACHE_LINKAGE_COUNT (object)) + 1); break; } break; } case TC_MANIFEST_CLOSURE: { area += 1; { long count = (MANIFEST_CLOSURE_COUNT (area)); area = (MANIFEST_CLOSURE_END (area, count)); } break; } case TC_MANIFEST_NM_VECTOR: { long count = (OBJECT_DATUM (object)); if (((char *) (area + (count + 1))) < pc_value) { area += (count + 1); first_valid = area; break; } { SCHEME_OBJECT * block = (area - 1); return (((area == first_valid) || ((OBJECT_TYPE (* block)) != TC_MANIFEST_VECTOR) || ((OBJECT_DATUM (* block)) < ((unsigned long) (count + 1))) || (! (PLAUSIBLE_CC_BLOCK_P (block)))) ? 0 : block); } } default: { area += 1; break; } } } return (0); } static void DEFUN (trap_recover, (code, context), DWORD code AND PCONTEXT context) { IFVERBOSE (TellUserEx (MB_OKCANCEL, "trap_recover (%s, 0x%lx).", (find_exception_name (code)), context)); if (WITHIN_CRITICAL_SECTION_P ()) { CLEAR_CRITICAL_SECTION_HOOK (); EXIT_CRITICAL_SECTION ({}); } reset_interruptable_extent (); continue_from_trap (code, context); } static void DEFUN (nt_trap_handler, (code, context), DWORD code AND PCONTEXT context) { Boolean stack_overflowed_p = (STACK_OVERFLOWED_P ()); enum trap_state old_trap_state = trap_state; int flags; IFVERBOSE (TellUserEx (MB_OKCANCEL, "nt_trap_handler (%s, 0x%lx).", (find_exception_name (code)), context)); if (old_trap_state == trap_state_exitting_hard) _exit (1); else if (old_trap_state == trap_state_exitting_soft) trap_immediate_termination (); trap_state = trap_state_trapped; trap_noise_start (); if (WITHIN_CRITICAL_SECTION_P ()) { trap_noise (">> The system has trapped within critical section \"%s\".\n", (CRITICAL_SECTION_NAME ())); describe_trap ("trap is", code); } else if (stack_overflowed_p || (old_trap_state != trap_state_recover)) { trap_noise (">> The system has trapped.\n"); describe_trap ("trap is", code); } if (stack_overflowed_p) { trap_noise (">> The stack has overflowed overwriting adjacent memory.\n"); trap_noise (">> This was probably caused by a runaway recursion.\n"); } switch (old_trap_state) { case trap_state_trapped: if ((saved_trap_state == trap_state_recover) || (saved_trap_state == trap_state_query)) { trap_noise (">> The trap occurred while processing an earlier trap.\n"); describe_trap ("earlier trap was", saved_trap_code); trap_noise ((WITHIN_CRITICAL_SECTION_P ()) ? ">> Successful recovery is extremely unlikely.\n" : ">> Successful recovery is unlikely.\n"); break; } else { (void) trap_noise_end (MB_OK | MB_ICONSTOP); trap_immediate_termination (); } case trap_state_recover: if ((WITHIN_CRITICAL_SECTION_P ()) || stack_overflowed_p) { trap_noise (">> Successful recovery is unlikely.\n"); break; } else { saved_trap_state = old_trap_state; saved_trap_code = code; (void) trap_noise_end (MB_OK | MB_ICONSTOP); trap_recover (code, context); return; } case trap_state_exit: (void) trap_noise_end (MB_OK | MB_ICONSTOP); termination_trap (); } trap_noise ("\n"); saved_trap_state = old_trap_state; saved_trap_code = code; flags = MB_ICONSTOP; while (1) { trap_noise ("Attempt recovery?"); if ((trap_noise_end (MB_YESNO | flags)) == IDYES) { trap_recover (code, context); return; } flags = 0; trap_noise ("Terminate Scheme normally?"); switch (trap_noise_end (MB_YESNOCANCEL)) { case IDYES: trap_normal_termination (); case IDNO: trap_immediate_termination (); _exit (1); default: break; } } } #ifdef W32_TRAP_DEBUG static void DEFUN (parse_response, (buf, addr, len), char * buf AND unsigned long * addr AND int * len) { const char * separators = " ,\t;"; char * token; token = (strtok (buf, separators)); if (token == ((char *) NULL)) return; * addr = (strtoul (token, ((char **) NULL), 0)); token = (strtok (((char *) NULL), separators)); if (token == ((char *) NULL)) return; * len = ((int) (strtoul (token, ((char **) NULL), 0))); return; } static void DEFUN (tinyexcpdebug, (code, info), DWORD code AND LPEXCEPTION_POINTERS info) { int count, len; char * message; unsigned long * addr; char responsebuf[256], * response; if ((MessageBox (NULL, "Debug?", "MIT Scheme Exception Debugger", MB_YESNO)) != IDYES) return; message = "&info ="; addr = ((unsigned long *) (& info)); len = 1; while (1) { trap_noise_start (); trap_noise ("%s 0x%lx.\n", message, ((unsigned long) addr)); for (count = 0; count < len; count++) trap_noise ("\n*0x%08x\t= 0x%08x\t= %d.", (addr + count), addr[count], addr[count]); trap_noise ("\n\nMore?"); if ((trap_noise_end (MB_YESNO)) != IDYES) break; response = (AskUser (&responsebuf[0], (sizeof (responsebuf)))); if (response == ((char *) NULL)) continue; message = "Contents of"; parse_response (&responsebuf[0], &addr, &len); } return; } #endif /* W32_TRAP_DEBUG */ #ifndef PAGE_SIZE # define PAGE_SIZE 0x1000 #endif static Boolean stack_protected = FALSE; unsigned long protected_stack_base; unsigned long protected_stack_end; void DEFUN_VOID (win32_unprotect_stack) { DWORD old_protection; if ((stack_protected) && (VirtualProtect (((LPVOID) protected_stack_base), PAGE_SIZE, PAGE_READWRITE, &old_protection))) stack_protected = FALSE; return; } void DEFUN_VOID (win32_protect_stack) { DWORD old_protection; if ((! stack_protected) && (VirtualProtect (((LPVOID) protected_stack_base), PAGE_SIZE, (PAGE_GUARD | PAGE_READWRITE), &old_protection))) stack_protected = TRUE; return; } void DEFUN_VOID (win32_stack_reset) { unsigned long boundary; /* This presumes that the distance between Stack_Bottom and Stack_Guard is at least a page. */ boundary = ((((unsigned long) Stack_Guard) & (~ ((unsigned long) (PAGE_SIZE - 1)))) - (2 * PAGE_SIZE)); if (stack_protected && (protected_stack_base == boundary)) return; win32_unprotect_stack (); protected_stack_base = boundary; protected_stack_end = (boundary + PAGE_SIZE); win32_protect_stack (); return; } #define EXCEPTION_CODE_GUARDED_PAGE_ACCESS 0x80000001L static LONG DEFUN (WinntException, (code, info), DWORD code AND LPEXCEPTION_POINTERS info) { PCONTEXT context; context = info->ContextRecord; if ((info->ExceptionRecord->ExceptionFlags != 0) || (context == ((PCONTEXT) NULL)) || ((context->ContextFlags & CONTEXT_CONTROL) == 0) || ((context->ContextFlags & CONTEXT_INTEGER) == 0) || ((context->ContextFlags & CONTEXT_SEGMENTS) == 0)) { (void) display_exception_information (info->ExceptionRecord, info->ContextRecord, MB_OK); trap_immediate_termination (); /*NOTREACHED*/ return (0); } else if (code == EXCEPTION_CODE_GUARDED_PAGE_ACCESS) { if (stack_protected && (context->Esp >= protected_stack_base) && (context->Esp <= protected_stack_end)) REQUEST_INTERRUPT (INT_Stack_Overflow); /* Just in case */ stack_protected = FALSE; return (EXCEPTION_CONTINUE_EXECUTION); } else { #ifdef W32_TRAP_DEBUG trap_verbose_p = ((display_exception_information (info->ExceptionRecord, info->ContextRecord, MB_YESNO)) == IDYES); tinyexcpdebug (code, info); #endif /* W32_TRAP_DEBUG */ nt_trap_handler (code, context); return (EXCEPTION_CONTINUE_EXECUTION); } } #if (defined(__WATCOMC__) && (__WATCOMC__ < 1100)) /* Watcom 10 has broken __try/__except support, which has been fixed in version 11. */ #define USE_SET_UNHANDLED_EXCEPTION_FILTER #endif #ifdef USE_SET_UNHANDLED_EXCEPTION_FILTER static LONG WINAPI scheme_unhandled_exception_filter (LPEXCEPTION_POINTERS info) { return (WinntException (((info -> ExceptionRecord) -> ExceptionCode), info)); } #endif /* USE_SET_UNHANDLED_EXCEPTION_FILTER */ void win32_enter_interpreter (void (*enter_interpreter) (void)) { #ifdef USE_SET_UNHANDLED_EXCEPTION_FILTER (void) SetUnhandledExceptionFilter (scheme_unhandled_exception_filter); (* enter_interpreter) (); outf_fatal ("Exception!\n"); termination_trap (); #else /* not USE_SET_UNHANDLED_EXCEPTION_FILTER */ do { __try { (* enter_interpreter) (); } __except (WinntException ((GetExceptionCode ()), (GetExceptionInformation ()))) { outf_fatal ("Exception!\n"); termination_trap (); } } while (1); #endif /* not USE_SET_UNHANDLED_EXCEPTION_FILTER */ }