home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / microcode / nttrap.c < prev    next >
C/C++ Source or Header  |  2000-12-05  |  34KB  |  1,298 lines
  1. /* -*-C-*-
  2.  
  3. $Id: nttrap.c,v 1.18 2000/12/05 21:23:46 cph Exp $
  4.  
  5. Copyright (c) 1992-2000 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. */
  21.  
  22. #include <stdarg.h>
  23. #include "scheme.h"
  24. #include "os.h"
  25. #include "nt.h"
  26. #include "nttrap.h"
  27. #include "gccode.h"
  28. #include "ntscmlib.h"
  29. #include <windows.h>
  30.  
  31. #ifdef W32_TRAP_DEBUG
  32. extern char * AskUser (char *, int);
  33. extern int EXFUN (TellUser, (char *, ...));
  34. extern int EXFUN (TellUserEx, (int, char *, ...));
  35. #endif /* W32_TRAP_DEBUG */
  36.  
  37. extern void EXFUN (callWinntExceptionTransferHook, (void));
  38. extern void EXFUN (NT_initialize_traps, (void));
  39. extern void EXFUN (NT_restore_traps, (void));
  40.  
  41. extern DWORD
  42.   C_Stack_Pointer,
  43.   C_Frame_Pointer;
  44.  
  45. #ifdef W32_TRAP_DEBUG
  46.  
  47. static BOOL trap_verbose_p = FALSE;
  48.  
  49. #define IFVERBOSE(command) do                        \
  50. {                                    \
  51.   if (trap_verbose_p)                            \
  52.   {                                    \
  53.     int result = command;                        \
  54.     if (result == IDCANCEL)                        \
  55.       trap_verbose_p = FALSE;                        \
  56.   }                                    \
  57. } while (0)
  58.  
  59. #else /* not W32_TRAP_DEBUG */
  60.  
  61. #define IFVERBOSE(command)        do { } while (0)
  62.  
  63. #endif /* W32_TRAP_DEBUG */
  64.  
  65. static char * trap_output = ((char *) NULL);
  66. static char * trap_output_pointer = ((char *) NULL);
  67.  
  68. static void
  69. DEFUN_VOID (trap_noise_start)
  70. {
  71.   trap_output = ((char *) NULL);
  72.   trap_output_pointer = ((char *) NULL);
  73.   return;
  74. }
  75.  
  76. static void
  77. DEFUN (trap_noise, (format), char * format DOTS)
  78. {
  79.   va_list arg_ptr;
  80.   unsigned long size;
  81.   char * temp;
  82.   
  83.   size = (trap_output_pointer - trap_output);
  84.   temp = ((trap_output == ((char *) NULL))
  85.       ? ((char *) (malloc (256)))
  86.       : ((char *) (realloc (trap_output, (256 + size)))));
  87.   if (temp == ((char *) NULL))
  88.     return;
  89.  
  90.   trap_output = temp;
  91.   trap_output_pointer = (temp + size);
  92.   va_start (arg_ptr, format);
  93.   size = (wvsprintf (trap_output_pointer, format, arg_ptr));
  94.   trap_output_pointer += size;
  95.   va_end (arg_ptr);
  96.   return;
  97. }
  98.  
  99. static int
  100. DEFUN (trap_noise_end, (style), UINT style)
  101. {
  102.   int value;
  103.  
  104.   if (trap_output == ((char *) NULL))
  105.     return (IDYES);
  106.  
  107.   value = (MessageBox (NULL,
  108.                trap_output,
  109.                "MIT Scheme Exception Information",
  110.                style));
  111.   free (trap_output);
  112.   trap_output = ((char *) NULL);
  113.   trap_output_pointer = ((char *) NULL);
  114.   return (value);
  115. }
  116.  
  117. static BOOL
  118. DEFUN (isvowel, (c), char c)
  119. {
  120.   switch (c)
  121.   {
  122.     case 'a':
  123.     case 'e':
  124.     case 'i':
  125.     case 'o':
  126.     case 'u':
  127.     case 'A':
  128.     case 'E':
  129.     case 'I':
  130.     case 'O':
  131.     case 'U':
  132.       return (TRUE);
  133.  
  134.     default:
  135.       return (FALSE);
  136.   }
  137. }
  138.  
  139. struct exception_name_s
  140. {
  141.   DWORD code;
  142.   char * name;
  143. };
  144.  
  145. static struct exception_name_s exception_names[] =
  146. {
  147.  {
  148.    EXCEPTION_ACCESS_VIOLATION,
  149.    "ACCESS_VIOLATION",
  150.  },
  151.  {
  152.    EXCEPTION_DATATYPE_MISALIGNMENT,
  153.    "DATATYPE_MISALIGNMENT",
  154.  },
  155.  {
  156.    EXCEPTION_BREAKPOINT,
  157.    "BREAKPOINT",
  158.  },
  159.  {
  160.    EXCEPTION_SINGLE_STEP,
  161.    "SINGLE_STEP",
  162.  },
  163.  {
  164.    EXCEPTION_ARRAY_BOUNDS_EXCEEDED,
  165.    "ARRAY_BOUNDS_EXCEEDED",
  166.  },
  167.  {
  168.    EXCEPTION_FLT_DENORMAL_OPERAND,
  169.    "FLT_DENORMAL_OPERAND",
  170.  },
  171.  {
  172.    EXCEPTION_FLT_DIVIDE_BY_ZERO,
  173.    "FLT_DIVIDE_BY_ZERO",
  174.  },
  175.  {
  176.    EXCEPTION_FLT_INEXACT_RESULT,
  177.    "FLT_INEXACT_RESULT",
  178.  },
  179.  {
  180.    EXCEPTION_FLT_INVALID_OPERATION,
  181.    "FLT_INVALID_OPERATION",
  182.  },
  183.  {
  184.    EXCEPTION_FLT_OVERFLOW,
  185.    "FLT_OVERFLOW",
  186.  },
  187.  {
  188.    EXCEPTION_FLT_STACK_CHECK,
  189.    "FLT_STACK_CHECK",
  190.  },
  191.  {
  192.    EXCEPTION_FLT_UNDERFLOW,
  193.    "FLT_UNDERFLOW",
  194.  },
  195.  {
  196.    EXCEPTION_INT_DIVIDE_BY_ZERO,
  197.    "INT_DIVIDE_BY_ZERO",
  198.  },
  199.  {
  200.    EXCEPTION_INT_OVERFLOW,
  201.    "INT_OVERFLOW",
  202.  },
  203.  
  204.  {
  205.    EXCEPTION_PRIV_INSTRUCTION,
  206.    "PRIV_INSTRUCTION",
  207.  },
  208.  {
  209.    EXCEPTION_IN_PAGE_ERROR,
  210.    "IN_PAGE_ERROR",
  211.  },
  212.  {
  213.    EXCEPTION_ILLEGAL_INSTRUCTION,
  214.    "ILLEGAL_INSTRUCTION",
  215.  },
  216.  {
  217.    EXCEPTION_NONCONTINUABLE_EXCEPTION,
  218.    "NONCONTINUABLE_EXCEPTION",
  219.  },
  220.  {
  221.    EXCEPTION_STACK_OVERFLOW,
  222.    "STACK_OVERFLOW",
  223.  },
  224.  {
  225.    EXCEPTION_INVALID_DISPOSITION,
  226.    "INVALID_DISPOSITION",
  227.  },
  228. };
  229.  
  230. const int excp_name_limit = ((sizeof (exception_names))
  231.                  / (sizeof (struct exception_name_s)));
  232.  
  233. static char *
  234. find_exception_name (DWORD code)
  235. {
  236.   int i;
  237.  
  238.   for (i = 0; i < excp_name_limit; i++)
  239.     if (exception_names[i].code == code)
  240.       return (exception_names[i].name);
  241.   return ((char *) NULL);
  242. }
  243.  
  244. static void
  245. DEFUN (describe_trap, (noise, code),
  246.        char * noise AND DWORD code)
  247. {
  248.   char * name;
  249.  
  250.   name = (find_exception_name (code));
  251.   if (name == ((char *) NULL))
  252.     trap_noise (">> The %s an unknown trap [code = %d].\n",
  253.         noise, code);
  254.   else
  255.     trap_noise (">> The %s a%s %s trap.\n",
  256.         noise,
  257.         ((isvowel (name[0])) ? "n" : ""),
  258.         name);
  259.   return;
  260. }
  261.  
  262. #define STATE_UNKNOWN        (LONG_TO_UNSIGNED_FIXNUM (0))
  263. #define STATE_PRIMITIVE        (LONG_TO_UNSIGNED_FIXNUM (1))
  264. #define STATE_COMPILED_CODE    (LONG_TO_UNSIGNED_FIXNUM (2))
  265. #define STATE_PROBABLY_COMPILED    (LONG_TO_UNSIGNED_FIXNUM (3))
  266.  
  267. struct trap_recovery_info
  268. {
  269.   SCHEME_OBJECT state;
  270.   SCHEME_OBJECT pc_info_1;
  271.   SCHEME_OBJECT pc_info_2;
  272.   SCHEME_OBJECT extra_trap_info;
  273. };
  274.  
  275. static struct trap_recovery_info dummy_recovery_info =
  276. {
  277.   STATE_UNKNOWN,
  278.   SHARP_F,
  279.   SHARP_F,
  280.   SHARP_F
  281. };
  282.  
  283. struct nt_trap_code_desc
  284. {
  285.   int trapno;
  286.   unsigned long code_mask;
  287.   unsigned long code_value;
  288.   char *name;
  289. };
  290.  
  291. static enum trap_state trap_state;
  292. static enum trap_state user_trap_state;
  293.  
  294. static enum trap_state saved_trap_state;
  295. static DWORD saved_trap_code;
  296.  
  297. enum trap_state
  298. DEFUN (OS_set_trap_state, (state), enum trap_state state)
  299. {
  300.   enum trap_state old_trap_state = user_trap_state;
  301.  
  302.   user_trap_state = state;
  303.   trap_state = state;
  304.   return (old_trap_state);
  305. }
  306.  
  307. static void
  308. DEFUN_VOID (trap_normal_termination)
  309. {
  310.   trap_state = trap_state_exitting_soft;
  311.   termination_trap ();
  312. }
  313.  
  314. static void
  315. DEFUN_VOID (trap_immediate_termination)
  316. {
  317.   extern void EXFUN (OS_restore_external_state, (void));
  318.  
  319.   trap_state = trap_state_exitting_hard;
  320.   OS_restore_external_state ();
  321.   exit (1);
  322. }
  323.  
  324. void
  325. DEFUN_VOID (NT_initialize_traps)
  326. {
  327.   trap_state = trap_state_recover;
  328.   user_trap_state = trap_state_recover;
  329.   (void) SetErrorMode (SEM_FAILCRITICALERRORS | SEM_NOGPFAULTERRORBOX);
  330. }
  331.  
  332. void
  333. DEFUN_VOID (NT_restore_traps)
  334. {
  335.   return;
  336. }
  337.  
  338. static int
  339. DEFUN (display_exception_information, (info, context, flags),
  340.        PEXCEPTION_RECORD info AND PCONTEXT context AND int flags)
  341. {
  342.   int value;
  343.   char msgbuf[4096];
  344.   char * flag, * name, * bufptr;
  345.  
  346.   bufptr = &msgbuf[0];
  347.   name = (find_exception_name (info->ExceptionCode));
  348.   flag = ((info->ExceptionFlags == 0) ? "Continuable" : "Non-continuable");
  349.   if (name == ((char *) NULL))
  350.     bufptr += (sprintf (bufptr, "%s Unknown Exception %d Raised at address 0x%lx",
  351.             flag, info->ExceptionCode, info->ExceptionAddress));
  352.   else
  353.     bufptr += (sprintf (bufptr, "%s %s Exception Raised at address 0x%lx",
  354.             flag, name, info->ExceptionAddress));
  355.  
  356. #ifdef W32_TRAP_DEBUG
  357.   if (context == ((PCONTEXT) NULL))
  358.     bufptr += (sprintf (bufptr, "\nContext is NULL."));
  359.   else
  360.   {
  361.     if ((context->ContextFlags & CONTEXT_CONTROL) != 0)
  362.       bufptr += (sprintf (bufptr,
  363.               "\nContext contains CONTROL information."));
  364.     if ((context->ContextFlags & CONTEXT_INTEGER) != 0)
  365.       bufptr += (sprintf (bufptr,
  366.               "\nContext contains INTEGER registers."));
  367.     if ((context->ContextFlags & CONTEXT_SEGMENTS) != 0)
  368.       bufptr += (sprintf (bufptr,
  369.               "\nContext contains SEGMENT registers."));
  370.     if ((context->ContextFlags & CONTEXT_FLOATING_POINT) != 0)
  371.       bufptr += (sprintf (bufptr,
  372.               "\nContext contains floating-point registers."));
  373.     bufptr += (sprintf (bufptr, "\ncontext->Eip        = 0x%lx.", context->Eip));
  374.     bufptr += (sprintf (bufptr, "\ncontext->Esp        = 0x%lx.", context->Esp));
  375.     bufptr += (sprintf (bufptr, "\nStack_Pointer       = 0x%lx.", Stack_Pointer));
  376.     bufptr += (sprintf (bufptr, "\nadj (Stack_Pointer) = 0x%lx.",
  377.             (ADDR_TO_SCHEME_ADDR (Stack_Pointer))));
  378.   }
  379. #endif /* W32_TRAP_DEBUG */
  380.  
  381.   info = info->ExceptionRecord;
  382.   if (info != ((PEXCEPTION_RECORD) NULL))
  383.     bufptr += (sprintf (bufptr,
  384.             "\nTrap occurred within an earlier trap."));
  385.  
  386. #ifdef W32_TRAP_DEBUG
  387.   if (flags == MB_YESNO)
  388.     bufptr += (sprintf (bufptr, "\n\nDisplay More Information?"));
  389. #else /* not W32_TRAP_DEBUG */
  390.   flags = MB_OK;
  391.   bufptr +=
  392.     (sprintf (bufptr,
  393.           "\n\nScheme cannot find the state necessary to continue."));
  394. #endif /* W32_TRAP_DEBUG */
  395.  
  396.   value = (MessageBox (NULL, &msgbuf[0],
  397.                "MIT Scheme Exception Info",
  398.                (flags | MB_ICONSTOP)));
  399.   return (value);
  400. }
  401.  
  402. #define TEMP_STACK_LEN 2048    /* objects */
  403.  
  404. static BOOL
  405.   return_by_aborting,
  406.   clear_real_stack;
  407.  
  408. static SCHEME_OBJECT
  409.   temp_stack_buffer[TEMP_STACK_LEN],
  410.   * temp_stack = &temp_stack_buffer[0],
  411.   * temp_stack_end = &temp_stack_buffer[TEMP_STACK_LEN],
  412.   * temp_stack_limit,
  413.   * real_stack_guard,
  414.   * real_stack_pointer;
  415.  
  416. int
  417. WinntExceptionTransferHook (void)
  418. {
  419.   /* These must be static because the memcpy below may
  420.      be overwriting this procedure's locals!
  421.    */
  422.  
  423.   static int size;
  424.   static SCHEME_OBJECT * temp_stack_ptr, * new_sp;
  425.  
  426.   temp_stack_ptr = Stack_Pointer;
  427.   size = (temp_stack_limit - temp_stack_ptr);
  428.   IFVERBOSE (TellUserEx (MB_OKCANCEL, "WinntExceptionTransferHook."));
  429.  
  430.   if (clear_real_stack)
  431.     INITIALIZE_STACK ();
  432.   else
  433.   {
  434.     Stack_Pointer = real_stack_pointer;
  435.     Stack_Guard = real_stack_guard;
  436.   }
  437.     
  438.   new_sp = (real_stack_pointer - size);
  439.   if (new_sp != temp_stack_ptr)
  440.     memcpy (new_sp, temp_stack_ptr, (size * (sizeof (SCHEME_OBJECT))));
  441.   Stack_Pointer = new_sp;
  442.   SET_INTERRUPT_MASK ((FETCH_INTERRUPT_MASK ()));
  443.   if (return_by_aborting)
  444.     abort_to_interpreter (PRIM_APPLY);
  445.   return (PRIM_APPLY);
  446. }
  447.  
  448. extern unsigned short __cdecl EXFUN (getCS, (void));
  449. extern unsigned short __cdecl EXFUN (getDS, (void));
  450.  
  451. /* Needed because Stack_Check checks for <= instead of < when pushing */
  452.  
  453. #define MAGIC_BUFFER_SIZE    1
  454.  
  455. static void
  456. DEFUN (setup_trap_frame, (code, context, trinfo, new_stack_pointer),
  457.        DWORD code
  458.        AND PCONTEXT context
  459.        AND struct trap_recovery_info * trinfo
  460.        AND SCHEME_OBJECT * new_stack_pointer)
  461. {
  462.   SCHEME_OBJECT trap_name, trap_code;
  463.   SCHEME_OBJECT handler;
  464.   int stack_recovered_p = (new_stack_pointer != 0);
  465.   long saved_mask = (FETCH_INTERRUPT_MASK ());
  466.   SET_INTERRUPT_MASK (0);    /* To prevent GC for now. */
  467.  
  468.   IFVERBOSE (TellUserEx (MB_OKCANCEL,
  469.              "setup_trap_frame (%s, 0x%lx, %s, 0x%lx, 0x%lx).",
  470.              (find_exception_name (code)),
  471.              context,
  472.              trinfo,
  473.              new_stack_pointer));
  474.  
  475.   if ((! (Valid_Fixed_Obj_Vector ()))
  476.       || ((handler = (Get_Fixed_Obj_Slot (Trap_Handler))) == SHARP_F))
  477.     {
  478.       trap_noise_start ();
  479.       trap_noise ("There is no trap handler for recovery!\n");
  480.       describe_trap ("trap is", code);
  481.       (void) trap_noise_end (MB_OK | MB_ICONSTOP);
  482.       termination_trap ();
  483.     }
  484.   if (Free > MemTop)
  485.     Request_GC (0);
  486.  
  487.   trap_name = ((context == ((PCONTEXT) NULL))
  488.            ? SHARP_F
  489.            : (char_pointer_to_string (find_exception_name (code))));
  490.   trap_code = (long_to_integer (0));
  491.  
  492.   if (win32_under_win32s_p ())
  493.   {
  494.     if (! stack_recovered_p)
  495.       INITIALIZE_STACK ();
  496.     clear_real_stack = FALSE;
  497.     real_stack_pointer = Stack_Pointer;
  498.     real_stack_guard = Stack_Guard;
  499.     temp_stack_limit = Stack_Pointer;
  500.   }
  501.   else
  502.   {
  503.     clear_real_stack = (!stack_recovered_p);
  504.     real_stack_pointer = new_stack_pointer;
  505.     real_stack_guard = Stack_Guard;
  506.     temp_stack_limit = temp_stack_end;
  507.     Stack_Pointer = temp_stack_end;
  508.     Stack_Guard = temp_stack;
  509.   }
  510.  
  511.  Will_Push (7 + CONTINUATION_SIZE);
  512.   STACK_PUSH (trinfo -> extra_trap_info);
  513.   STACK_PUSH (trinfo -> pc_info_2);
  514.   STACK_PUSH (trinfo -> pc_info_1);
  515.   STACK_PUSH (trinfo -> state);
  516.   STACK_PUSH (BOOLEAN_TO_OBJECT (stack_recovered_p));
  517.   STACK_PUSH (trap_code);
  518.   STACK_PUSH (trap_name);
  519.   Store_Return (RC_HARDWARE_TRAP);
  520.   Store_Expression (long_to_integer (code));
  521.   Save_Cont ();
  522.  Pushed ();
  523.   if (stack_recovered_p
  524.       /* This may want to be done in other cases, but this may be enough. */
  525.       && (trinfo->state == STATE_COMPILED_CODE))
  526.     Stop_History ();
  527.  
  528.   History = (Make_Dummy_History ());
  529.  Will_Push (STACK_ENV_EXTRA_SLOTS + 2);
  530.   STACK_PUSH (trap_name);
  531.   STACK_PUSH (handler);
  532.   STACK_PUSH (STACK_FRAME_HEADER + 1);
  533.  Pushed ();
  534.   SET_INTERRUPT_MASK (saved_mask);
  535.  
  536.   IFVERBOSE (TellUserEx (MB_OKCANCEL, "setup_trap_frame done."));
  537.   return;
  538. }
  539.  
  540. /* Heuristic recovery from processor traps/exceptions.
  541.  
  542.    continue_from_trap attempts to:
  543.  
  544.    1) validate the trap information (pc and sp);
  545.    2) determine whether compiled code was executing,
  546.       a primitive was executing,
  547.       or execution was in the interpreter;
  548.    3) guess what C global state is still valid; and
  549.    4) set up a recovery frame for the interpreter so that debuggers can
  550.       display more information. 
  551. */
  552.  
  553. #define SCHEME_ALIGNMENT_MASK        ((sizeof (long)) - 1)
  554. #define STACK_ALIGNMENT_MASK        SCHEME_ALIGNMENT_MASK
  555. #define FREE_PARANOIA_MARGIN        0x100
  556.  
  557. /* PCs must be aligned according to this. */
  558.  
  559. #define PC_ALIGNMENT_MASK        ((1 << PC_ZERO_BITS) - 1)
  560.  
  561. /* But they may have bits that can be masked by this. */
  562.  
  563. #ifndef PC_VALUE_MASK
  564. # define PC_VALUE_MASK            (~0)
  565. #endif
  566.  
  567. #define C_STACK_SIZE            0x01000000
  568.  
  569. #ifdef HAS_COMPILER_SUPPORT
  570. # define ALLOW_ONLY_C 0
  571. #else
  572. # define ALLOW_ONLY_C 1
  573. # define PLAUSIBLE_CC_BLOCK_P(block)    0
  574. #endif
  575.  
  576. static SCHEME_OBJECT * EXFUN
  577.   (find_block_address, (char * pc_value, SCHEME_OBJECT * area_start));
  578.  
  579. #define IA32_NREGS 12
  580.  
  581. /* For now */
  582. #define GET_ETEXT() (Heap_Bottom)
  583.  
  584. static void
  585. DEFUN (continue_from_trap, (code, context),
  586.        DWORD code AND PCONTEXT context)
  587. {
  588.   int pc_in_builtin;
  589.   int builtin_index;
  590.   int pc_in_C;
  591.   int pc_in_heap;
  592.   int pc_in_constant_space;
  593.   int pc_in_scheme;
  594.   int pc_in_hyper_space;
  595.   int pc_in_utility;
  596.   int utility_index;
  597.   int scheme_sp_valid;
  598.   long scheme_sp;
  599.   long the_pc;
  600.   SCHEME_OBJECT * new_stack_pointer;
  601.   SCHEME_OBJECT * xtra_info;
  602.   struct trap_recovery_info trinfo;
  603.   extern int EXFUN (pc_to_utility_index, (unsigned long));
  604.   extern int EXFUN (pc_to_builtin_index, (unsigned long));
  605.  
  606.   IFVERBOSE (TellUserEx (MB_OKCANCEL,
  607.              "continue_from_trap (%s, 0x%lx).",
  608.              (find_exception_name (code)), context));
  609.  
  610.   if (context == ((PCONTEXT) NULL))
  611.   {
  612.     if (Free < MemTop)
  613.       Free = MemTop;
  614.     setup_trap_frame (code, context, (&dummy_recovery_info), 0);
  615.     /*NOTREACHED*/
  616.   }
  617.  
  618.   if (context->SegSs == (getDS ()))
  619.   {
  620.     IFVERBOSE
  621.       (TellUserEx
  622.        (MB_OKCANCEL,
  623.     "continue_from_trap: SS = C DS; Stack_Pointer = 0x%lx; Esp = 0x%lx.",
  624.     Stack_Pointer, context->Esp));
  625.     scheme_sp = (context->Esp);
  626.   }
  627.   else
  628.   {
  629.     IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap: SS unknown!"));
  630.     scheme_sp = 0;
  631.   }
  632.  
  633.   if (context->SegCs == (getCS ()))
  634.   {
  635.     IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap: CS = C CS."));
  636.     the_pc = (context->Eip & PC_VALUE_MASK);
  637.   }
  638.   else
  639.   {
  640.     IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap: CS unknown"));
  641.     goto pc_in_hyperspace;
  642.   }
  643.  
  644.   if ((the_pc & PC_ALIGNMENT_MASK) != 0)
  645.   {
  646. pc_in_hyperspace:
  647.     pc_in_builtin = 0;
  648.     pc_in_utility = 0;
  649.     pc_in_C = 0;
  650.     pc_in_heap = 0;
  651.     pc_in_constant_space = 0;
  652.     pc_in_scheme = 0;
  653.     pc_in_hyper_space = 1;
  654.   }
  655.   else
  656.   {
  657.     builtin_index = (pc_to_builtin_index (the_pc));
  658.     pc_in_builtin = (builtin_index != -1);
  659.     utility_index = (pc_to_utility_index (the_pc));
  660.     pc_in_utility = (utility_index != -1);    
  661.     pc_in_C = ((the_pc <= ((long) (GET_ETEXT ()))) && (! pc_in_builtin));
  662.     pc_in_heap =
  663.       ((the_pc < ((long) Heap_Top)) && (the_pc >= ((long) Heap_Bottom)));
  664.     pc_in_constant_space =
  665.       ((the_pc < ((long) Constant_Top)) &&
  666.        (the_pc >= ((long) Constant_Space)));
  667.     pc_in_scheme = (pc_in_heap || pc_in_constant_space || pc_in_builtin);
  668.     pc_in_hyper_space = ((!pc_in_C) && (!pc_in_scheme));
  669.   }
  670.  
  671.   IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap 1"));
  672.  
  673.   scheme_sp_valid =
  674.     (pc_in_scheme
  675.      && ((scheme_sp < ((long) Stack_Top)) &&
  676.      (scheme_sp >= ((long) Stack_Bottom)) &&
  677.      ((scheme_sp & STACK_ALIGNMENT_MASK) == 0)));
  678.  
  679.   IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap 2"));
  680.  
  681.   new_stack_pointer =
  682.     (scheme_sp_valid
  683.      ? ((SCHEME_OBJECT *) scheme_sp)
  684.      : ((pc_in_C
  685.     && (Stack_Pointer < Stack_Top)
  686.     && (Stack_Pointer > Stack_Bottom))
  687.         ? Stack_Pointer
  688.         : ((SCHEME_OBJECT *) 0)));
  689.  
  690.   IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap 3"));
  691.  
  692.   if (pc_in_hyper_space || (pc_in_scheme && ALLOW_ONLY_C))
  693.   {
  694.     /* In hyper space. */
  695.     (trinfo . state) = STATE_UNKNOWN;
  696.     (trinfo . pc_info_1) = SHARP_F;
  697.     (trinfo . pc_info_2) = SHARP_F;
  698.     new_stack_pointer = 0;
  699.     if ((Free < MemTop) ||
  700.     (Free >= Heap_Top) ||
  701.     ((((unsigned long) Free) & SCHEME_ALIGNMENT_MASK) != 0))
  702.       Free = MemTop;
  703.   }
  704.   else if (pc_in_scheme)
  705.   {
  706.     /* In compiled code. */
  707.     SCHEME_OBJECT * block_addr;
  708.     SCHEME_OBJECT * maybe_free;
  709.     block_addr =
  710.       (pc_in_builtin
  711.        ? ((SCHEME_OBJECT *) NULL)
  712.        : (find_block_address (((PTR) the_pc),
  713.                   (pc_in_heap ? Heap_Bottom : Constant_Space))));
  714.  
  715.     if (block_addr != ((SCHEME_OBJECT *) NULL))
  716.     {
  717.       (trinfo . state) = STATE_COMPILED_CODE;
  718.       (trinfo . pc_info_1) =
  719.     (MAKE_POINTER_OBJECT (TC_COMPILED_CODE_BLOCK, block_addr));
  720.       (trinfo . pc_info_2) =
  721.     (LONG_TO_UNSIGNED_FIXNUM (the_pc - ((long) block_addr)));
  722.     }
  723.     else if (pc_in_builtin)
  724.     {
  725.       (trinfo . state) = STATE_PROBABLY_COMPILED;
  726.       (trinfo . pc_info_1) = (LONG_TO_UNSIGNED_FIXNUM (builtin_index));
  727.       (trinfo . pc_info_2) = SHARP_T;
  728.     }
  729.     else 
  730.     {
  731.       (trinfo . state) = STATE_PROBABLY_COMPILED;
  732.       (trinfo . pc_info_1) = (LONG_TO_UNSIGNED_FIXNUM (the_pc));
  733.       (trinfo . pc_info_2) = SHARP_F;
  734.     }
  735.  
  736.     if ((block_addr == ((SCHEME_OBJECT *) NULL)) && (! pc_in_builtin))
  737.     {
  738.       if ((Free < MemTop) ||
  739.       (Free >= Heap_Top) ||
  740.       ((((unsigned long) Free) & SCHEME_ALIGNMENT_MASK) != 0))
  741.     Free = MemTop;
  742.     }
  743.     else
  744.     {
  745.       maybe_free = ((SCHEME_OBJECT *) context->Edi);
  746.       if (((((unsigned long) maybe_free) & SCHEME_ALIGNMENT_MASK) == 0)
  747.       && (maybe_free >= Heap_Bottom) && (maybe_free < Heap_Top))
  748.     Free = (maybe_free + FREE_PARANOIA_MARGIN);
  749.       else
  750.     if ((Free < MemTop) || (Free >= Heap_Top)
  751.         || ((((unsigned long) Free) & SCHEME_ALIGNMENT_MASK) != 0))
  752.       Free = MemTop;
  753.     }
  754.   }
  755.  
  756.   else /* pc_in_C */
  757.   {
  758.     /* In the interpreter, a primitive, or a compiled code utility. */
  759.  
  760.     SCHEME_OBJECT primitive = (Regs[REGBLOCK_PRIMITIVE]);
  761.  
  762.     if (pc_in_utility)
  763.     {
  764.       (trinfo . state) = STATE_PROBABLY_COMPILED;
  765.       (trinfo . pc_info_1) = (LONG_TO_UNSIGNED_FIXNUM (utility_index));
  766.       (trinfo . pc_info_2) = UNSPECIFIC;
  767.     }
  768.     else if ((OBJECT_TYPE (primitive)) != TC_PRIMITIVE)
  769.     {
  770.       (trinfo . state) = STATE_UNKNOWN;
  771.       (trinfo . pc_info_1) = SHARP_F;
  772.       (trinfo . pc_info_2) = SHARP_F;
  773.       new_stack_pointer = 0;
  774.     }
  775.     else
  776.     {
  777.       (trinfo . state) = STATE_PRIMITIVE;
  778.       (trinfo . pc_info_1) = primitive;
  779.       (trinfo . pc_info_2) =
  780.     (LONG_TO_UNSIGNED_FIXNUM (Regs[REGBLOCK_LEXPR_ACTUALS]));
  781.     }
  782.     if ((new_stack_pointer == 0)
  783.     || ((((unsigned long) Free) & SCHEME_ALIGNMENT_MASK) != 0)
  784.     || ((Free < Heap_Bottom) || (Free >= Heap_Top))
  785.     || ((Free < MemTop) && ((Free + FREE_PARANOIA_MARGIN) >= MemTop)))
  786.       Free = MemTop;
  787.     else if ((Free + FREE_PARANOIA_MARGIN) < MemTop)
  788.       Free +=  FREE_PARANOIA_MARGIN;
  789.   }
  790.  
  791.   IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap 4"));
  792.  
  793.   if (win32_under_win32s_p ())
  794.     (trinfo . extra_trap_info) = SHARP_F;
  795.   else
  796.   {
  797.     xtra_info = Free;
  798.     Free += (1 + (IA32_NREGS + 2));
  799.     (trinfo . extra_trap_info) =
  800.       (MAKE_POINTER_OBJECT (TC_NON_MARKED_VECTOR, xtra_info));
  801.     (*xtra_info++) = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, (IA32_NREGS + 2)));
  802.     (*xtra_info++) = ((SCHEME_OBJECT) the_pc);
  803.     (*xtra_info++) = ((SCHEME_OBJECT) scheme_sp);
  804.     {
  805.       int counter = IA32_NREGS;
  806.       int * regs = ((int *) context->Edi);
  807.       while ((counter--) > 0)
  808.     (*xtra_info++) = ((SCHEME_OBJECT) (*regs++));
  809.     }
  810.   }
  811.  
  812.   IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap 5"));
  813.  
  814.   /* Handshake with try+except. */
  815.  
  816.   context->Eip = ((DWORD) callWinntExceptionTransferHook);
  817.   context->SegCs = (getCS ());
  818.   return_by_aborting = TRUE;
  819.  
  820.   IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap 6"));
  821.  
  822.   if (pc_in_scheme && (! (win32_under_win32s_p ())))
  823.   {
  824.     context->Esp = C_Stack_Pointer;
  825.     context->Ebp = C_Frame_Pointer;
  826.     if (pc_in_scheme)
  827.       return_by_aborting = FALSE;
  828.   }
  829.  
  830.   IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap 7"));
  831.  
  832.   setup_trap_frame (code, context, (&trinfo), new_stack_pointer);
  833.  
  834.   IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap 8"));
  835. }
  836.  
  837. /* Find the compiled code block in area which contains `pc_value'.
  838.    This attempts to be more efficient than `find_block_address_in_area'.
  839.    If the pointer is in the heap, it can actually do twice as
  840.    much work, but it is expected to pay off on the average. */
  841.  
  842. static SCHEME_OBJECT * EXFUN
  843.   (find_block_address_in_area, (char * pc_value, SCHEME_OBJECT * area_start));
  844.  
  845. #define MINIMUM_SCAN_RANGE        2048
  846.  
  847. static SCHEME_OBJECT *
  848. DEFUN (find_block_address, (pc_value, area_start),
  849.        char * pc_value AND
  850.        SCHEME_OBJECT * area_start)
  851. {
  852.   if (area_start == Constant_Space)
  853.     {
  854.       extern SCHEME_OBJECT * EXFUN
  855.     (find_constant_space_block, (SCHEME_OBJECT *));
  856.       SCHEME_OBJECT * constant_block =
  857.     (find_constant_space_block
  858.      ((SCHEME_OBJECT *)
  859.       (((unsigned long) pc_value) &~ SCHEME_ALIGNMENT_MASK)));
  860.       return
  861.     ((constant_block == 0)
  862.      ? 0
  863.      : (find_block_address_in_area (pc_value, constant_block)));
  864.     }
  865.   {
  866.     SCHEME_OBJECT * nearest_word =
  867.       ((SCHEME_OBJECT *)
  868.        (((unsigned long) pc_value) &~ SCHEME_ALIGNMENT_MASK));
  869.     long maximum_distance = (nearest_word - area_start);
  870.     long distance = maximum_distance;
  871.     while ((distance / 2) > MINIMUM_SCAN_RANGE)
  872.       distance = (distance / 2);
  873.     while ((distance * 2) < maximum_distance)
  874.       {
  875.     SCHEME_OBJECT * block =
  876.       (find_block_address_in_area (pc_value, (nearest_word - distance)));
  877.     if (block != 0)
  878.       return (block);
  879.     distance *= 2;
  880.       }
  881.   }
  882.   return (find_block_address_in_area (pc_value, area_start));
  883. }
  884.  
  885. /*
  886.   Find the compiled code block in area which contains `pc_value',
  887.   by scanning sequentially the complete area.
  888.   For the time being, skip over manifest closures and linkage sections. */
  889.  
  890. static SCHEME_OBJECT *
  891. DEFUN (find_block_address_in_area, (pc_value, area_start),
  892.        char * pc_value AND
  893.        SCHEME_OBJECT * area_start)
  894. {
  895.   SCHEME_OBJECT * first_valid = area_start;
  896.   SCHEME_OBJECT * area = area_start;
  897.   while (((char *) area) < pc_value)
  898.     {
  899.       SCHEME_OBJECT object = (*area);
  900.       switch (OBJECT_TYPE (object))
  901.     {
  902.     case TC_LINKAGE_SECTION:
  903.       {
  904.         switch (READ_LINKAGE_KIND (object))
  905.         {
  906.           case GLOBAL_OPERATOR_LINKAGE_KIND:
  907.           case OPERATOR_LINKAGE_KIND:
  908.           {
  909.         long count = (READ_OPERATOR_LINKAGE_COUNT (object));
  910.         area = ((END_OPERATOR_LINKAGE_AREA (area, count)) + 1);
  911.         break;
  912.           }
  913.  
  914.           default:
  915. #if FALSE
  916.           {
  917.         gc_death (TERM_EXIT,
  918.               "find_block_address: Unknown compiler linkage kind.",
  919.               area, NULL);
  920.         /*NOTREACHED*/
  921.           }
  922. #else
  923.           /* Fall through, no reason to crash here. */
  924. #endif
  925.           case ASSIGNMENT_LINKAGE_KIND:
  926.           case CLOSURE_PATTERN_LINKAGE_KIND:
  927.           case REFERENCE_LINKAGE_KIND:
  928.             area += ((READ_CACHE_LINKAGE_COUNT (object)) + 1);
  929.         break;
  930.  
  931.         }
  932.         break;
  933.       }
  934.     case TC_MANIFEST_CLOSURE:
  935.       {
  936.         area += 1;
  937.         {
  938.           long count = (MANIFEST_CLOSURE_COUNT (area));
  939.           area = ((MANIFEST_CLOSURE_END (area, count)) + 1);
  940.         }
  941.         break;
  942.       }
  943.     case TC_MANIFEST_NM_VECTOR:
  944.       {
  945.         long count = (OBJECT_DATUM (object));
  946.         if (((char *) (area + (count + 1))) < pc_value)
  947.           {
  948.         area += (count + 1);
  949.         first_valid = area;
  950.         break;
  951.           }
  952.         {
  953.           SCHEME_OBJECT * block = (area - 1);
  954.           return
  955.         (((area == first_valid)
  956.           || ((OBJECT_TYPE (* block)) != TC_MANIFEST_VECTOR)
  957.           || ((OBJECT_DATUM (* block)) < ((unsigned long) (count + 1)))
  958.           || (! (PLAUSIBLE_CC_BLOCK_P (block))))
  959.          ? 0
  960.          : block);
  961.         }
  962.       }
  963.     default:
  964.       {
  965.         area += 1;
  966.         break;
  967.       }
  968.     }
  969.     }
  970.   return (0);
  971. }
  972.  
  973. static void
  974. DEFUN (trap_recover, (code, context),
  975.        DWORD code AND PCONTEXT context)
  976. {
  977.   IFVERBOSE (TellUserEx (MB_OKCANCEL,
  978.              "trap_recover (%s, 0x%lx).",
  979.              (find_exception_name (code)), context));
  980.  
  981.   if (WITHIN_CRITICAL_SECTION_P ())
  982.     {
  983.       CLEAR_CRITICAL_SECTION_HOOK ();
  984.       EXIT_CRITICAL_SECTION ({});
  985.     }
  986.   reset_interruptable_extent ();
  987.   continue_from_trap (code, context);
  988. }
  989.  
  990. static void
  991. DEFUN (nt_trap_handler, (code, context),
  992.        DWORD code AND PCONTEXT context)
  993. {
  994.   Boolean stack_overflowed_p = (STACK_OVERFLOWED_P ());
  995.   enum trap_state old_trap_state = trap_state;
  996.   int flags;
  997.  
  998.   IFVERBOSE (TellUserEx (MB_OKCANCEL,
  999.              "nt_trap_handler (%s, 0x%lx).",
  1000.              (find_exception_name (code)), context));
  1001.  
  1002.   if (old_trap_state == trap_state_exitting_hard)
  1003.     _exit (1);
  1004.   else if (old_trap_state == trap_state_exitting_soft)
  1005.     trap_immediate_termination ();
  1006.  
  1007.   trap_state = trap_state_trapped;
  1008.  
  1009.   trap_noise_start ();
  1010.   if (WITHIN_CRITICAL_SECTION_P ())
  1011.   {
  1012.     trap_noise (">> The system has trapped within critical section \"%s\".\n",
  1013.         (CRITICAL_SECTION_NAME ()));
  1014.     describe_trap ("trap is", code);
  1015.   }
  1016.   else if (stack_overflowed_p || (old_trap_state != trap_state_recover))
  1017.   {
  1018.     trap_noise (">> The system has trapped.\n");
  1019.     describe_trap ("trap is", code);
  1020.   }
  1021.   if (stack_overflowed_p)
  1022.   {
  1023.     trap_noise (">> The stack has overflowed overwriting adjacent memory.\n");
  1024.     trap_noise (">> This was probably caused by a runaway recursion.\n");
  1025.   }
  1026.  
  1027.   switch (old_trap_state)
  1028.   {
  1029.   case trap_state_trapped:
  1030.     if ((saved_trap_state == trap_state_recover)
  1031.     || (saved_trap_state == trap_state_query))
  1032.     {
  1033.       trap_noise (">> The trap occurred while processing an earlier trap.\n");
  1034.       describe_trap ("earlier trap was", saved_trap_code);
  1035.       trap_noise ((WITHIN_CRITICAL_SECTION_P ())
  1036.           ? ">> Successful recovery is extremely unlikely.\n"
  1037.           : ">> Successful recovery is unlikely.\n");
  1038.       break;
  1039.     }
  1040.     else
  1041.     { 
  1042.       (void) trap_noise_end (MB_OK | MB_ICONSTOP);
  1043.       trap_immediate_termination ();
  1044.     }
  1045.  
  1046.   case trap_state_recover:
  1047.     if ((WITHIN_CRITICAL_SECTION_P ()) || stack_overflowed_p)
  1048.     {
  1049.       trap_noise (">> Successful recovery is unlikely.\n");
  1050.       break;
  1051.     }
  1052.     else
  1053.     {
  1054.       saved_trap_state = old_trap_state;
  1055.       saved_trap_code = code;
  1056.       (void) trap_noise_end (MB_OK | MB_ICONSTOP);
  1057.       trap_recover (code, context);
  1058.       return;
  1059.     }
  1060.   case trap_state_exit:
  1061.     (void) trap_noise_end (MB_OK | MB_ICONSTOP);
  1062.     termination_trap ();
  1063.   }
  1064.  
  1065.   trap_noise ("\n");
  1066.   saved_trap_state = old_trap_state;
  1067.   saved_trap_code = code;
  1068.   flags = MB_ICONSTOP;
  1069.  
  1070.   while (1)
  1071.   {
  1072.     trap_noise ("Attempt recovery?");
  1073.     if ((trap_noise_end (MB_YESNO | flags)) == IDYES)
  1074.     {
  1075.       trap_recover (code, context);
  1076.       return;
  1077.     }
  1078.     flags = 0;
  1079.  
  1080.     trap_noise ("Terminate Scheme normally?");
  1081.     switch (trap_noise_end (MB_YESNOCANCEL))
  1082.     {
  1083.       case IDYES:
  1084.         trap_normal_termination ();
  1085.  
  1086.       case IDNO:
  1087.         trap_immediate_termination ();
  1088.     _exit (1);
  1089.  
  1090.       default:
  1091.     break;
  1092.     }
  1093.   }
  1094. }
  1095.  
  1096. #ifdef W32_TRAP_DEBUG
  1097.  
  1098. static void
  1099. DEFUN (parse_response, (buf, addr, len),
  1100.        char * buf AND unsigned long * addr AND int * len)
  1101. {
  1102.   const char * separators = " ,\t;";
  1103.   char * token;
  1104.  
  1105.   token = (strtok (buf, separators));
  1106.   if (token == ((char *) NULL))
  1107.     return;
  1108.   * addr = (strtoul (token, ((char **) NULL), 0));
  1109.   token = (strtok (((char *) NULL), separators));
  1110.   if (token == ((char *) NULL))
  1111.     return;
  1112.   * len = ((int) (strtoul (token, ((char **) NULL), 0)));
  1113.   return;
  1114. }
  1115.  
  1116. static void
  1117. DEFUN (tinyexcpdebug, (code, info),
  1118.        DWORD code AND LPEXCEPTION_POINTERS info)
  1119. {
  1120.   int count, len;
  1121.   char * message;
  1122.   unsigned long * addr;
  1123.   char responsebuf[256], * response;
  1124.  
  1125.   if ((MessageBox (NULL, "Debug?", "MIT Scheme Exception Debugger", MB_YESNO))
  1126.       != IDYES)
  1127.     return;
  1128.  
  1129.   message = "&info =";
  1130.   addr = ((unsigned long *) (& info));
  1131.   len = 1;
  1132.  
  1133.   while (1)
  1134.   {
  1135.     trap_noise_start ();
  1136.     trap_noise ("%s 0x%lx.\n", message, ((unsigned long) addr));
  1137.     for (count = 0; count < len; count++)
  1138.       trap_noise ("\n*0x%08x\t= 0x%08x\t= %d.",
  1139.           (addr + count),
  1140.           addr[count],
  1141.           addr[count]);
  1142.     trap_noise ("\n\nMore?");
  1143.     if ((trap_noise_end (MB_YESNO)) != IDYES)
  1144.       break;
  1145.     response = (AskUser (&responsebuf[0], (sizeof (responsebuf))));
  1146.     if (response == ((char *) NULL))
  1147.       continue;
  1148.     message = "Contents of";
  1149.     parse_response (&responsebuf[0], &addr, &len);
  1150.   }
  1151.   return;
  1152. }
  1153. #endif /* W32_TRAP_DEBUG */
  1154.  
  1155. #ifndef PAGE_SIZE
  1156. # define PAGE_SIZE 0x1000
  1157. #endif
  1158.  
  1159. static Boolean stack_protected = FALSE;
  1160. unsigned long protected_stack_base;
  1161. unsigned long protected_stack_end;
  1162.  
  1163. void
  1164. DEFUN_VOID (win32_unprotect_stack)
  1165. {
  1166.   DWORD old_protection;
  1167.  
  1168.   if ((stack_protected)
  1169.       && (VirtualProtect (((LPVOID) protected_stack_base),
  1170.               PAGE_SIZE,
  1171.               PAGE_READWRITE,
  1172.               &old_protection)))
  1173.     stack_protected = FALSE;
  1174.   return;
  1175. }
  1176.  
  1177. void
  1178. DEFUN_VOID (win32_protect_stack)
  1179. {
  1180.   DWORD old_protection;
  1181.  
  1182.   if ((! stack_protected)
  1183.       && (VirtualProtect (((LPVOID) protected_stack_base),
  1184.               PAGE_SIZE,
  1185.               (PAGE_GUARD | PAGE_READWRITE),
  1186.               &old_protection)))
  1187.     stack_protected = TRUE;
  1188.  return; 
  1189. }
  1190.  
  1191. void
  1192. DEFUN_VOID (win32_stack_reset)
  1193. {
  1194.   unsigned long boundary;
  1195.  
  1196.   /* This presumes that the distance between Stack_Bottom and
  1197.      Stack_Guard is at least a page.
  1198.    */
  1199.  
  1200.   boundary = ((((unsigned long) Stack_Guard)
  1201.            & (~ ((unsigned long) (PAGE_SIZE - 1))))
  1202.           - (2 * PAGE_SIZE));
  1203.   if (stack_protected && (protected_stack_base == boundary))
  1204.     return;
  1205.   win32_unprotect_stack ();
  1206.   protected_stack_base = boundary;
  1207.   protected_stack_end  = (boundary + PAGE_SIZE);
  1208.   win32_protect_stack ();
  1209.   return;
  1210. }
  1211.  
  1212. #define EXCEPTION_CODE_GUARDED_PAGE_ACCESS    0x80000001L
  1213.  
  1214. static LONG
  1215. DEFUN (WinntException, (code, info),
  1216.        DWORD code AND LPEXCEPTION_POINTERS info)
  1217. {
  1218.   PCONTEXT context;
  1219.  
  1220.   context = info->ContextRecord;
  1221.   if ((info->ExceptionRecord->ExceptionFlags != 0)
  1222.       || (context == ((PCONTEXT) NULL))
  1223.       || ((context->ContextFlags & CONTEXT_CONTROL) == 0)
  1224.       || ((context->ContextFlags & CONTEXT_INTEGER) == 0)
  1225.       || ((context->ContextFlags & CONTEXT_SEGMENTS) == 0))
  1226.   {
  1227.     (void)
  1228.       display_exception_information (info->ExceptionRecord,
  1229.                      info->ContextRecord,
  1230.                      MB_OK);
  1231.     trap_immediate_termination ();
  1232.     /*NOTREACHED*/
  1233.     return (0);
  1234.   }
  1235.   else if (code == EXCEPTION_CODE_GUARDED_PAGE_ACCESS)
  1236.   {
  1237.     if (stack_protected
  1238.     && (context->Esp >= protected_stack_base)
  1239.     && (context->Esp <= protected_stack_end))
  1240.       REQUEST_INTERRUPT (INT_Stack_Overflow);
  1241.     /* Just in case */
  1242.     stack_protected = FALSE;
  1243.     return (EXCEPTION_CONTINUE_EXECUTION);
  1244.   }
  1245.   else
  1246.   {
  1247. #ifdef W32_TRAP_DEBUG
  1248.     trap_verbose_p = ((display_exception_information
  1249.                (info->ExceptionRecord,
  1250.             info->ContextRecord,
  1251.             MB_YESNO))
  1252.               == IDYES);
  1253.     tinyexcpdebug (code, info);
  1254. #endif /* W32_TRAP_DEBUG */
  1255.     nt_trap_handler (code, context);
  1256.     return (EXCEPTION_CONTINUE_EXECUTION);
  1257.   }
  1258. }
  1259.  
  1260. #if (defined(__WATCOMC__) && (__WATCOMC__ < 1100))
  1261. /* Watcom 10 has broken __try/__except support,
  1262.    which has been fixed in version 11.  */
  1263. #define USE_SET_UNHANDLED_EXCEPTION_FILTER
  1264. #endif
  1265.  
  1266. #ifdef USE_SET_UNHANDLED_EXCEPTION_FILTER
  1267. static LONG WINAPI
  1268. scheme_unhandled_exception_filter (LPEXCEPTION_POINTERS info)
  1269. {
  1270.   return (WinntException (((info -> ExceptionRecord) -> ExceptionCode), info));
  1271. }
  1272. #endif /* USE_SET_UNHANDLED_EXCEPTION_FILTER */
  1273.  
  1274. void
  1275. win32_enter_interpreter (void (*enter_interpreter) (void))
  1276. {
  1277. #ifdef USE_SET_UNHANDLED_EXCEPTION_FILTER
  1278.   (void) SetUnhandledExceptionFilter (scheme_unhandled_exception_filter);
  1279.   (* enter_interpreter) ();
  1280.   outf_fatal ("Exception!\n");
  1281.   termination_trap ();
  1282. #else /* not USE_SET_UNHANDLED_EXCEPTION_FILTER */
  1283.   do
  1284.   {
  1285.     __try
  1286.     {
  1287.       (* enter_interpreter) ();
  1288.     }
  1289.     __except (WinntException ((GetExceptionCode ()),
  1290.                   (GetExceptionInformation ())))
  1291.     {
  1292.       outf_fatal ("Exception!\n");
  1293.       termination_trap ();
  1294.     }
  1295.   } while (1);
  1296. #endif /* not USE_SET_UNHANDLED_EXCEPTION_FILTER */
  1297. }
  1298.