From 74dd48193c0c9a72e49c38b349c4028711312d8a Mon Sep 17 00:00:00 2001
From: "Guillermo J. Rozas" <edu/mit/csail/zurich/gjr>
Date: Sat, 11 Sep 1993 02:45:59 +0000
Subject: [PATCH] - Add a primitive facility to set breakpoints on compiled
 code. - Improve with-interrupt-mask and with-stack-marker from compiled code.

---
 v7/src/microcode/cmpint.c   | 414 +++++++++++++++++++++++++++++++-----
 v7/src/microcode/comutl.c   |  74 ++++++-
 v7/src/microcode/const.h    |   6 +-
 v7/src/microcode/fixobj.h   |   6 +-
 v7/src/microcode/hooks.c    | 215 ++++++++++++-------
 v7/src/microcode/ntgui.c    |  13 +-
 v7/src/microcode/ntgui.h    |  10 +-
 v7/src/microcode/ntsig.c    |  18 +-
 v7/src/microcode/prosio.c   |  24 +--
 v7/src/microcode/utabmd.scm |   5 +-
 v8/src/microcode/cmpint.c   | 414 +++++++++++++++++++++++++++++++-----
 v8/src/microcode/const.h    |   6 +-
 v8/src/microcode/fixobj.h   |   6 +-
 v8/src/microcode/utabmd.scm |   5 +-
 14 files changed, 981 insertions(+), 235 deletions(-)

diff --git a/v7/src/microcode/cmpint.c b/v7/src/microcode/cmpint.c
index 4f3a52bbd..4435f4fb5 100644
--- a/v7/src/microcode/cmpint.c
+++ b/v7/src/microcode/cmpint.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: cmpint.c,v 1.67 1993/09/07 21:45:53 gjr Exp $
+$Id: cmpint.c,v 1.68 1993/09/11 02:45:46 gjr Exp $
 
 Copyright (c) 1989-1993 Massachusetts Institute of Technology
 
@@ -97,6 +97,10 @@ MIT in each case. */
 #include "trap.h"       /* UNASSIGNED_OBJECT, TRAP_EXTENSION_TYPE */
 #include "prims.h"      /* LEXPR */
 #include "prim.h"	/* Primitive_Procedure_Table, etc. */
+
+#define ENTRY_TO_OBJECT(entry)						\
+  (MAKE_POINTER_OBJECT (TC_COMPILED_ENTRY, ((SCHEME_OBJECT *) (entry))))
+
 #define IN_CMPINT_C
 #include "cmpgc.h"      /* Compiled code object relocation */
 
@@ -226,9 +230,6 @@ typedef utility_result EXFUN
   }                                                                     \
 }
 
-#define ENTRY_TO_OBJECT(entry)						\
-  (MAKE_POINTER_OBJECT (TC_COMPILED_ENTRY, ((SCHEME_OBJECT *) (entry))))
-
 #define MAKE_CC_BLOCK(block_addr)					\
   (MAKE_POINTER_OBJECT (TC_COMPILED_CODE_BLOCK, block_addr))
 
@@ -271,7 +272,11 @@ extern C_UTILITY SCHEME_OBJECT
   EXFUN (compiled_closure_to_entry, (SCHEME_OBJECT entry)),
   * EXFUN (compiled_entry_to_block_address, (SCHEME_OBJECT entry)),
   EXFUN (compiled_entry_to_block, (SCHEME_OBJECT entry)),
-  EXFUN (apply_compiled_from_primitive, (int));
+  EXFUN (apply_compiled_from_primitive, (int)),
+  EXFUN (compiled_with_interrupt_mask, (unsigned long,
+					SCHEME_OBJECT,
+					unsigned long)),
+  EXFUN (compiled_with_stack_marker, (SCHEME_OBJECT));
 
 extern C_UTILITY void
   EXFUN (compiler_initialize, (long fasl_p)),
@@ -305,7 +310,15 @@ extern C_TO_SCHEME long
 
 extern utility_table_entry utility_table[];
 
-static SCHEME_OBJECT apply_in_interpreter;
+static SCHEME_OBJECT reflect_to_interface;
+
+/* Breakpoint stuff. */
+
+extern C_UTILITY SCHEME_OBJECT EXFUN (bkpt_install, (PTR));
+extern C_UTILITY SCHEME_OBJECT EXFUN (bkpt_closure_install, (PTR));
+extern C_UTILITY Boolean EXFUN (bkpt_p, (PTR));
+extern C_UTILITY SCHEME_OBJECT EXFUN (bkpt_proceed, (PTR, SCHEME_OBJECT, SCHEME_OBJECT));
+extern C_UTILITY void EXFUN (bkpt_remove, (PTR, SCHEME_OBJECT));
 
 /* These definitions reflect the indices into the table above. */
 
@@ -327,10 +340,15 @@ static SCHEME_OBJECT apply_in_interpreter;
 #define TRAMPOLINE_K_4_2			0xf
 #define TRAMPOLINE_K_4_1			0x10
 #define TRAMPOLINE_K_4_0			0x11
-#define TRAMPOLINE_K_APPLY_IN_INTERPRETER	0x3a
+#define TRAMPOLINE_K_REFLECT_TO_INTERFACE	0x3a
 
 #define TRAMPOLINE_K_OTHER			TRAMPOLINE_K_INTERPRETED
 
+#define REFLECT_CODE_INTERNAL_APPLY		0
+#define REFLECT_CODE_RESTORE_INTERRUPT_MASK	1
+#define REFLECT_CODE_STACK_MARKER		2
+#define REFLECT_CODE_CC_BKPT			3
+
 /* Utilities for application of compiled procedures. */
 
 /* NOTE: In this file, the number of arguments (or minimum
@@ -534,9 +552,6 @@ DEFUN (setup_compiled_invocation,
    */
   return (setup_lexpr_invocation (nactuals, nmax, compiled_entry_address));
 }
-
-
-
 
 /* Main compiled code entry points.
 
@@ -659,11 +674,65 @@ defer_application:
       break;
   }
 
-  STACK_PUSH (apply_in_interpreter);
+  STACK_PUSH (FIXNUM_ZERO + REFLECT_CODE_INTERNAL_APPLY);
+  STACK_PUSH (reflect_to_interface);
   Stack_Pointer = (STACK_LOC (- arity));
   return (SHARP_F);
 }
 
+C_UTILITY SCHEME_OBJECT
+DEFUN (compiled_with_interrupt_mask, (old_mask, receiver, new_mask),
+       unsigned long old_mask
+       AND SCHEME_OBJECT receiver
+       AND unsigned long new_mask)
+{
+  long result;
+
+  STACK_PUSH (LONG_TO_FIXNUM (old_mask));
+  STACK_PUSH (FIXNUM_ZERO + REFLECT_CODE_RESTORE_INTERRUPT_MASK);
+  STACK_PUSH (reflect_to_interface);
+
+  STACK_PUSH (LONG_TO_FIXNUM (new_mask));
+  result = (setup_compiled_invocation (2,
+				       ((instruction *)
+					(OBJECT_ADDRESS (receiver)))));
+  STACK_PUSH (receiver);
+
+  if (result != PRIM_DONE)
+  {
+    STACK_PUSH (STACK_FRAME_HEADER + 1);
+    STACK_PUSH (FIXNUM_ZERO + REFLECT_CODE_INTERNAL_APPLY);
+    STACK_PUSH (reflect_to_interface);
+  }
+
+  Stack_Pointer = (STACK_LOC (- 2));
+  return (SHARP_F);
+}
+
+C_UTILITY SCHEME_OBJECT
+DEFUN (compiled_with_stack_marker, (thunk), SCHEME_OBJECT thunk)
+{
+  long result;
+
+  STACK_PUSH (FIXNUM_ZERO + REFLECT_CODE_STACK_MARKER);
+  STACK_PUSH (reflect_to_interface);
+
+  result = (setup_compiled_invocation (1,
+				       ((instruction *)
+					(OBJECT_ADDRESS (thunk)))));
+  STACK_PUSH (thunk);
+
+  if (result != PRIM_DONE)
+  {
+    STACK_PUSH (STACK_FRAME_HEADER);
+    STACK_PUSH (FIXNUM_ZERO + REFLECT_CODE_INTERNAL_APPLY);
+    STACK_PUSH (reflect_to_interface);
+  }
+
+  Stack_Pointer = (STACK_LOC (- 3));
+  return (SHARP_F);
+}
+
 /*
   SCHEME_UTILITYs
 
@@ -686,22 +755,6 @@ DEFUN (comutil_return_to_interpreter,
 {
   RETURN_TO_C (PRIM_DONE);
 }
-
-/*
-  This is an alternate way for code to return to the
-  Scheme interpreter.
-  It is invoked by a trampoline, which passes the address of the
-  trampoline storage block (empty) to it.
- */
-
-SCHEME_UTILITY utility_result
-DEFUN (comutil_apply_in_interpreter,
-       (tramp_data_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR tramp_data_raw
-       AND long ignore_2 AND long ignore_3 AND long ignore_4)
-{
-  RETURN_TO_C (PRIM_APPLY);
-}
 
 #if (COMPILER_PROCESSOR_TYPE != COMPILER_I386_TYPE)
 
@@ -2299,13 +2352,9 @@ DEFUN (compiled_entry_type,
   field1 = min_arity;
   field2 = max_arity;
   if (min_arity >= 0)
-  {
     kind = KIND_PROCEDURE;
-  }
   else if (max_arity >= 0)
-  {
     kind = KIND_ILLEGAL;
-  }
   else if ((((unsigned long) max_arity) & 0xff) < 0xe0)
   {
     /* Field2 is the offset to the next continuation */
@@ -2736,6 +2785,174 @@ DEFUN (coerce_to_compiled,
   return (PRIM_DONE);
 }
 
+#ifndef HAVE_BKPT_SUPPORT
+
+C_UTILITY SCHEME_OBJECT
+DEFUN (bkpt_install, (ep), PTR ep)
+{
+  return (SHARP_F);
+}
+
+C_UTILITY SCHEME_OBJECT
+DEFUN (bkpt_closure_install, (ep), PTR ep)
+{
+  return (SHARP_F);
+}
+
+C_UTILITY void
+DEFUN (bkpt_remove, (ep, handle), PTR ep AND SCHEME_OBJECT handle)
+{
+  error_external_return ();
+}
+
+C_UTILITY Boolean
+DEFUN (bkpt_p, (ep), PTR ep)
+{
+  return (SHARP_F);
+}
+
+C_UTILITY SCHEME_OBJECT
+DEFUN (bkpt_proceed, (ep, handle, state),
+       PTR ep AND SCHEME_OBJECT handle AND SCHEME_OBJECT state)
+{
+  error_external_return ();
+}
+
+C_UTILITY PTR
+DEFUN_VOID (do_bkpt_proceed)
+{
+  error_external_return ();
+}
+
+#else /* HAVE_BKPT_SUPPORT */
+
+#define BKPT_PROCEED_FRAME_SIZE	3
+
+C_UTILITY SCHEME_OBJECT
+DEFUN (bkpt_proceed, (ep, handle, state),
+       PTR ep AND SCHEME_OBJECT handle AND SCHEME_OBJECT state)
+{
+  if ((! (COMPILED_CODE_ADDRESS_P (STACK_REF (BKPT_PROCEED_FRAME_SIZE))))
+      || ((OBJECT_ADDRESS (STACK_REF (BKPT_PROCEED_FRAME_SIZE)))
+	  != ((SCHEME_OBJECT *) ep)))
+    error_external_return ();
+
+  STACK_PUSH (FIXNUM_ZERO + REFLECT_CODE_CC_BKPT);
+  STACK_PUSH (reflect_to_interface);
+  Stack_Pointer = (STACK_LOC (- BKPT_PROCEED_FRAME_SIZE));
+  return (SHARP_F);
+}
+#endif /* HAVE_BKPT_SUPPORT */
+
+SCHEME_UTILITY utility_result
+DEFUN (comutil_compiled_code_bkpt,
+       (entry_point_raw, dlink_raw, ignore_3, ignore_4),
+       SCHEME_ADDR entry_point_raw AND SCHEME_ADDR dlink_raw
+       AND long ignore_3 AND long ignore_4)
+{
+  long type_info[3];
+  instruction * entry_point_a
+    = ((instruction *) (SCHEME_ADDR_TO_ADDR (entry_point_raw)));
+  SCHEME_OBJECT entry_point = (ENTRY_TO_OBJECT (entry_point_a));
+  SCHEME_OBJECT state;
+  SCHEME_OBJECT stack_ptr;
+
+  STACK_PUSH (entry_point);	/* return address */
+
+  /* Potential bug: This does not preserve the environment for
+     IC procedures.  There is no way to tell that we have
+     an IC procedure in our hands.  It is not safe to preserve
+     it in general because the contents of the register may
+     be stale (predate the last GC).
+     However, the compiler no longer generates IC procedures, and
+     will probably never do it again.
+   */
+
+  compiled_entry_type (entry_point, &type_info[0]);
+  if (type_info[0] != KIND_CONTINUATION)
+    state = SHARP_F;
+  else if (type_info[1] == CONTINUATION_DYNAMIC_LINK)
+    state = (MAKE_POINTER_OBJECT
+	     (TC_STACK_ENVIRONMENT, (SCHEME_ADDR_TO_ADDR (dlink_raw))));
+  else
+    state = Val;
+
+  stack_ptr = (MAKE_POINTER_OBJECT (TC_STACK_ENVIRONMENT, Stack_Pointer));
+  STACK_PUSH (state);		/* state to preserve */
+  STACK_PUSH (stack_ptr);	/* "Environment" pointer */
+  STACK_PUSH (entry_point);	/* argument to handler */
+  return (comutil_apply ((Get_Fixed_Obj_Slot (COMPILED_CODE_BKPT_HANDLER)),
+			 4, ignore_3, ignore_4));
+}
+
+SCHEME_UTILITY utility_result
+DEFUN (comutil_compiled_closure_bkpt,
+       (entry_point_raw, ignore_2, ignore_3, ignore_4),
+       SCHEME_ADDR entry_point_raw
+       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+{
+  instruction * entry_point_a
+    = ((instruction *) (SCHEME_ADDR_TO_ADDR (entry_point_raw)));
+  SCHEME_OBJECT entry_point = (ENTRY_TO_OBJECT (entry_point_a));
+  SCHEME_OBJECT stack_ptr;
+
+  STACK_PUSH (entry_point);	/* return address */
+
+  stack_ptr = (MAKE_POINTER_OBJECT (TC_STACK_ENVIRONMENT, Stack_Pointer));
+  STACK_PUSH (SHARP_F);		/* state to preserve */
+  STACK_PUSH (stack_ptr);	/* "Environment" pointer */
+  STACK_PUSH (entry_point);	/* argument to handler */
+  return (comutil_apply ((Get_Fixed_Obj_Slot (COMPILED_CODE_BKPT_HANDLER)),
+			 4, ignore_3, ignore_4));
+}
+
+SCHEME_UTILITY utility_result
+DEFUN (comutil_reflect_to_interface,
+       (tramp_data_raw, ignore_2, ignore_3, ignore_4),
+       SCHEME_ADDR tramp_data_raw
+       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+{
+  SCHEME_OBJECT code = (STACK_POP ());
+
+  switch (OBJECT_DATUM (code))
+  {
+    case REFLECT_CODE_INTERNAL_APPLY:
+    {
+      long frame_size = (OBJECT_DATUM (STACK_POP ()));
+      SCHEME_OBJECT procedure = (STACK_POP ());
+      
+      return (comutil_apply (procedure, frame_size, ignore_3, ignore_4));
+    }
+
+    case REFLECT_CODE_CC_BKPT:
+    {
+      unsigned long value;
+
+      if (do_bkpt_proceed (& value))
+	RETURN_TO_SCHEME (value);
+      else
+	RETURN_TO_C (value);
+    }
+
+    case REFLECT_CODE_RESTORE_INTERRUPT_MASK:
+    {
+      SET_INTERRUPT_MASK (OBJECT_DATUM (STACK_POP ()));
+      RETURN_TO_SCHEME (OBJECT_ADDRESS (STACK_POP ()));
+    }
+
+    case REFLECT_CODE_STACK_MARKER:
+    {
+      STACK_POP ();		/* marker1 */
+      STACK_POP ();		/* marker2 */
+      RETURN_TO_SCHEME (OBJECT_ADDRESS (STACK_POP ()));
+    }
+
+    default:
+      STACK_PUSH (code);
+      RETURN_TO_C (ERR_EXTERNAL_RETURN);
+  }
+}
+
 /*
   Utility table used by the assembly language interface to invoke
   the SCHEME_UTILITY procedures that appear in this file.
@@ -2809,8 +3026,10 @@ utility_table_entry utility_table[] =
   UTE(comutil_quotient),			/* 0x37 */
   UTE(comutil_remainder),			/* 0x38 */
   UTE(comutil_modulo),				/* 0x39 */
-  UTE(comutil_apply_in_interpreter),		/* 0x3a */
-  UTE(comutil_interrupt_continuation_2)		/* 0x3b */
+  UTE(comutil_reflect_to_interface),		/* 0x3a */
+  UTE(comutil_interrupt_continuation_2),	/* 0x3b */
+  UTE(comutil_compiled_code_bkpt),		/* 0x3c */
+  UTE(comutil_compiled_closure_bkpt)		/* 0x3d */
   };
 
 /* Support for trap handling. */
@@ -2837,6 +3056,9 @@ struct util_descriptor_s
 static
 struct util_descriptor_s utility_descriptor_table[] =
 {
+#ifdef DECLARE_CMPINTMD_UTILITIES
+  DECLARE_CMPINTMD_UTILITIES(),
+#endif /* DECLARE_CMPINTMD_UTILITIES */
   UTLD(C_to_interface),
   UTLD(open_gap),
   UTLD(setup_lexpr_invocation),
@@ -2845,8 +3067,9 @@ struct util_descriptor_s utility_descriptor_table[] =
   UTLD(apply_compiled_procedure),
   UTLD(return_to_compiled_code),
   UTLD(apply_compiled_from_primitive),
+  UTLD(compiled_with_interrupt_mask),
+  UTLD(compiled_with_stack_marker),
   UTLD(comutil_return_to_interpreter),
-  UTLD(comutil_apply_in_interpreter),
   UTLD(comutil_primitive_apply),
   UTLD(comutil_primitive_lexpr_apply),
   UTLD(comutil_apply),
@@ -2948,6 +3171,17 @@ struct util_descriptor_s utility_descriptor_table[] =
   UTLD(make_uuo_link),
   UTLD(make_fake_uuo_link),
   UTLD(coerce_to_compiled),
+#ifndef HAVE_BKPT_SUPPORT
+  UTLD(bkpt_install),
+  UTLD(bkpt_closure_install),
+  UTLD(bkpt_remove),
+  UTLD(bkpt_p),
+  UTLD(do_bkpt_proceed),
+#endif 
+  UTLD(bkpt_proceed),
+  UTLD(comutil_compiled_code_bkpt),
+  UTLD(comutil_compiled_closure_bkpt),
+  UTLD(comutil_reflect_to_interface),
   UTLD(end_of_utils)
 };
 
@@ -3144,24 +3378,31 @@ DEFUN_VOID (compiler_reset_internal)
 {
   long len;
   SCHEME_OBJECT * block;
-  /* Other stuff can be placed here. */
-
-  Registers[REGBLOCK_CLOSURE_FREE] = ((SCHEME_OBJECT) NULL);
-  Registers[REGBLOCK_CLOSURE_SPACE] = ((SCHEME_OBJECT) 0);
 
-  ASM_RESET_HOOK();
+  /* Other stuff can be placed here. */
 
   block = (OBJECT_ADDRESS (compiler_utilities));
   len = (OBJECT_DATUM (block[0]));
+
   return_to_interpreter =
     (ENTRY_TO_OBJECT (((char *) block)
 		      + ((unsigned long) (block [len - 1]))));
-  apply_in_interpreter = 
+
+  reflect_to_interface =
     (ENTRY_TO_OBJECT (((char *) block)
 		      + ((unsigned long) (block [len]))));
+
+  Registers[REGBLOCK_CLOSURE_FREE] = ((SCHEME_OBJECT) NULL);
+  Registers[REGBLOCK_CLOSURE_SPACE] = ((SCHEME_OBJECT) 0);
+  Registers[REGBLOCK_REFLECT_TO_INTERFACE] = reflect_to_interface;
+
+  ASM_RESET_HOOK();
+
   return;
 }
 
+#define COMPILER_UTILITIES_LENGTH ((2 * (TRAMPOLINE_ENTRY_SIZE + 1)) + 1)
+
 C_UTILITY void
 DEFUN (compiler_reset,
        (new_block),
@@ -3170,7 +3411,8 @@ DEFUN (compiler_reset,
   /* Called after a disk restore */
 
   if (((OBJECT_TYPE (new_block)) != TC_COMPILED_CODE_BLOCK)
-      || ((OBJECT_TYPE (MEMORY_REF (new_block, 0))) != TC_MANIFEST_NM_VECTOR))
+      || ((OBJECT_TYPE (MEMORY_REF (new_block, 0))) != TC_MANIFEST_NM_VECTOR)
+      || ((VECTOR_LENGTH (new_block)) != (COMPILER_UTILITIES_LENGTH - 1)))
   {
     extern void EXFUN (compiler_reset_error, (void));
 
@@ -3199,7 +3441,7 @@ DEFUN (compiler_initialize, (fasl_p), long fasl_p)
     extern SCHEME_OBJECT * EXFUN (copy_to_constant_space,
 				  (SCHEME_OBJECT *, long));
 
-    len = ((2 * TRAMPOLINE_ENTRY_SIZE) + 3);
+    len = COMPILER_UTILITIES_LENGTH;
     if (GC_Check (len))
     {
       outf_fatal ("compiler_initialize: Not enough space!\n");
@@ -3209,18 +3451,21 @@ DEFUN (compiler_initialize, (fasl_p), long fasl_p)
     block = Free;
     Free += len;
     block[0] = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, (len - 1)));
+
     tramp1 = ((instruction *) (TRAMPOLINE_ENTRY_POINT (block - 1)));
-    tramp2 = ((instruction *)
-	      (((char *) tramp1)
-	       + (TRAMPOLINE_ENTRY_SIZE * (sizeof (SCHEME_OBJECT)))));
     fill_trampoline (block, tramp1,
 		     ((format_word) FORMAT_WORD_RETURN),
 		     TRAMPOLINE_K_RETURN);
+    block[len - 2] = (((char *) tramp1) - ((char *) block));
+
+    tramp2 = ((instruction *)
+	      (((char *) tramp1)
+	       + (TRAMPOLINE_ENTRY_SIZE * (sizeof (SCHEME_OBJECT)))));
     fill_trampoline (block, tramp2,
 		     ((format_word) FORMAT_WORD_RETURN),
-		     TRAMPOLINE_K_APPLY_IN_INTERPRETER);
-    block[len - 2] = (((char *) tramp1) - ((char *) block));
+		     TRAMPOLINE_K_REFLECT_TO_INTERFACE);
     block[len - 1] = (((char *) tramp2) - ((char *) block));
+
     block = (copy_to_constant_space (block, len));
     compiler_utilities = (MAKE_CC_BLOCK (block));
     compiler_reset_internal ();
@@ -3284,7 +3529,11 @@ extern SCHEME_OBJECT
   EXFUN (compiled_closure_to_entry, (SCHEME_OBJECT entry)),
   * EXFUN (compiled_entry_to_block_address, (SCHEME_OBJECT entry)),
   EXFUN (compiled_entry_to_block, (SCHEME_OBJECT entry)),
-  EXFUN (apply_compiled_from_primitive, (int));
+  EXFUN (apply_compiled_from_primitive, (int)),
+  EXFUN (compiled_with_interrupt_mask, (unsigned long,
+					SCHEME_OBJECT,
+					unsigned long)),
+  EXFUN (compiled_with_stack_marker, (SCHEME_OBJECT));
 
 extern void
   EXFUN (compiler_reset, (SCHEME_OBJECT new_block)),
@@ -3293,6 +3542,14 @@ extern void
 	 (SCHEME_OBJECT extension, SCHEME_OBJECT block, long offset)),
   EXFUN (compiled_entry_type, (SCHEME_OBJECT entry, long *buffer)),
   EXFUN (declare_compiled_code, (SCHEME_OBJECT block));
+
+/* Breakpoint stuff. */
+
+extern SCHEME_OBJECT EXFUN (bkpt_install, (PTR));
+extern SCHEME_OBJECT EXFUN (bkpt_closure_install, (PTR));
+extern Boolean EXFUN (bkpt_p, (PTR));
+extern SCHEME_OBJECT EXFUN (bkpt_proceed, (PTR, SCHEME_OBJECT, SCHEME_OBJECT));
+extern void EXFUN (bkpt_remove, (PTR, SCHEME_OBJECT));
 
 SCHEME_OBJECT
 #ifndef WINNT
@@ -3330,6 +3587,23 @@ DEFUN (apply_compiled_from_primitive, (arity), int arity)
   /*NOTREACHED*/
 }
 
+SCHEME_OBJECT
+DEFUN (compiled_with_interrupt_mask, (old_mask, receiver, new_mask),
+       unsigned long old_mask
+       AND SCHEME_OBJECT receiver
+       AND unsigned long new_mask)
+{
+  signal_error_from_primitive (ERR_INAPPLICABLE_CONTINUATION);
+  /*NOTREACHED*/
+}
+
+SCHEME_OBJECT
+DEFUN (compiled_with_stack_marker, (thunk), SCHEME_OBJECT thunk)
+{
+  signal_error_from_primitive (ERR_INAPPLICABLE_CONTINUATION);
+  /*NOTREACHED*/
+}
+
 /* Bad entry points. */
 
 long
@@ -3360,7 +3634,7 @@ DEFUN (extract_uuo_link,
   Microcode_Termination (TERM_COMPILER_DEATH);
   /*NOTREACHED*/
 }
-
+
 void
 DEFUN (store_variable_cache,
        (extension, block, offset),
@@ -3380,7 +3654,7 @@ DEFUN (extract_variable_cache,
   Microcode_Termination (TERM_COMPILER_DEATH);
   /*NOTREACHED*/
 }
-
+
 SCHEME_OBJECT
 DEFUN (compiled_block_debugging_info,
        (block),
@@ -3560,11 +3834,44 @@ DEFUN (pc_to_builtin_index, (pc), unsigned long pc)
 {
   return (-1);
 }
+
+SCHEME_OBJECT
+DEFUN (bkpt_install, (ep), PTR ep)
+{
+  return (SHARP_F);
+}
+
+SCHEME_OBJECT
+DEFUN (bkpt_closure_install, (ep), PTR ep)
+{
+  return (SHARP_F);
+}
+
+void
+DEFUN (bkpt_remove, (ep, handle), PTR ep AND SCHEME_OBJECT handle)
+{
+  error_external_return ();
+}
+
+Boolean
+DEFUN (bkpt_p, (ep), PTR ep)
+{
+  return (SHARP_F);
+}
+
+SCHEME_OBJECT
+DEFUN (bkpt_proceed, (ep, handle, state), 
+       PTR ep AND SCHEME_OBJECT handle AND SCHEME_OBJECT state)
+{
+  error_external_return ();
+}
+
 #endif	/* HAS_COMPILER_SUPPORT */
 
 #ifdef WINNT
 #include "ntscmlib.h"
 
+extern unsigned long * winnt_catatonia_block;
 extern void EXFUN (winnt_allocate_registers, (void));
 extern void EXFUN (winnt_allocate_registers, (void));
 
@@ -3574,14 +3881,16 @@ extern void EXFUN (winnt_allocate_registers, (void));
 
 typedef struct register_storage
 {
-  /* The following two must be allocated consecutively */
+  /* The following must be allocated consecutively */
+  unsigned long catatonia_block[3];
 #if (COMPILER_PROCESSOR_TYPE == COMPILER_I386_TYPE)
   void * Regstart[32];	/* Negative byte offsets from &Registers[0] */
 #endif
   SCHEME_OBJECT Registers [REGBLOCK_LENGTH];
 } REGMEM;
 
-SCHEME_OBJECT * RegistersPtr = 0;
+SCHEME_OBJECT * RegistersPtr = ((SCHEME_OBJECT *) NULL);
+unsigned long * winnt_catatonia_block = ((unsigned long *) NULL);
 static REGMEM regmem;
 
 void
@@ -3589,6 +3898,7 @@ DEFUN_VOID (winnt_allocate_registers)
 {
   REGMEM * mem = & regmem;
 
+  winnt_catatonia_block = ((unsigned long *) &mem->catatonia_block[0]);
   RegistersPtr = mem->Registers;
   if (! (win32_lock_memory_area (mem, (sizeof (REGMEM)))))
   {
diff --git a/v7/src/microcode/comutl.c b/v7/src/microcode/comutl.c
index 01d078de2..7e3d966ce 100644
--- a/v7/src/microcode/comutl.c
+++ b/v7/src/microcode/comutl.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: comutl.c,v 1.25 1993/09/01 22:09:26 gjr Exp $
+$Id: comutl.c,v 1.26 1993/09/11 02:45:51 gjr Exp $
 
 Copyright (c) 1987-1993 Massachusetts Institute of Technology
 
@@ -201,3 +201,75 @@ DEFINE_PRIMITIVE ("DECLARE-COMPILED-CODE-BLOCK",
   declare_compiled_code (new_cc_block);
   PRIMITIVE_RETURN (SHARP_T);
 }
+
+extern SCHEME_OBJECT EXFUN (bkpt_install, (PTR));
+extern SCHEME_OBJECT EXFUN (bkpt_closure_install, (PTR));
+extern Boolean EXFUN (bkpt_p, (PTR));
+extern SCHEME_OBJECT EXFUN (bkpt_proceed, (PTR, SCHEME_OBJECT, SCHEME_OBJECT));
+extern void EXFUN (bkpt_remove, (PTR, SCHEME_OBJECT));
+
+DEFINE_PRIMITIVE ("BKPT/INSTALL", Prim_install_bkpt, 1, 1,
+		  "(compiled-entry-object)\n\
+Install a breakpoint trap in a compiled code object.\n\
+Returns false or a handled needed by REMOVE-BKPT and ONE-STEP-PROCEED.")
+{
+  PRIMITIVE_HEADER (1);
+  CHECK_ARG (1, COMPILED_CODE_ADDRESS_P);
+
+  {
+    SCHEME_OBJECT * entry = (OBJECT_ADDRESS (ARG_REF (1)));
+    SCHEME_OBJECT * block;
+
+    if (bkpt_p ((PTR) entry))
+      error_bad_range_arg (1);
+
+    block = (compiled_entry_to_block_address (ARG_REF (1)));
+    if ((OBJECT_TYPE (block[0])) == TC_MANIFEST_CLOSURE)
+      PRIMITIVE_RETURN (bkpt_closure_install ((PTR) entry));
+    else
+      PRIMITIVE_RETURN (bkpt_install ((PTR) entry));
+  }
+}
+
+DEFINE_PRIMITIVE ("BKPT/REMOVE", Prim_remove_bkpt, 2, 2,
+		  "(compiled-entry-object handle)\n\
+Remove a breakpoint trap installed by INSTALL-BKPT.")
+{
+  PRIMITIVE_HEADER (2);
+  CHECK_ARG (1, COMPILED_CODE_ADDRESS_P);
+  CHECK_ARG (2, VECTOR_P);
+
+  {
+    SCHEME_OBJECT * entry = (OBJECT_ADDRESS (ARG_REF (1)));
+    SCHEME_OBJECT handle = (ARG_REF (2));
+
+    if (! (bkpt_p ((PTR) entry)))
+      error_bad_range_arg (1);
+    bkpt_remove (((PTR) entry), handle);
+    PRIMITIVE_RETURN (UNSPECIFIC);
+  }
+}
+
+DEFINE_PRIMITIVE ("BKPT?", Prim_bkpt_p, 1, 1,
+		  "(compiled-entry-object)\n\
+True if there is a breakpoint trap in compiled-entry-object.")
+{
+  PRIMITIVE_HEADER (1);
+  CHECK_ARG (1, COMPILED_CODE_ADDRESS_P);
+
+  PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT
+		    (bkpt_p ((PTR) (OBJECT_ADDRESS (ARG_REF (1))))));
+}
+
+DEFINE_PRIMITIVE ("BKPT/PROCEED", Prim_bkpt_proceed, 3, 3,
+		  "(compiled-entry-object handle state)\n\
+Proceed the computation from the current breakpoint.")
+{
+  PRIMITIVE_HEADER (3);
+  CHECK_ARG (1, COMPILED_CODE_ADDRESS_P);
+  CHECK_ARG (2, VECTOR_P);
+
+  PRIMITIVE_RETURN (bkpt_proceed (((PTR) (OBJECT_ADDRESS (ARG_REF (1)))),
+				  (ARG_REF (2)),
+				  (ARG_REF (3))));
+}
diff --git a/v7/src/microcode/const.h b/v7/src/microcode/const.h
index 77e697256..5bbd6c6ae 100644
--- a/v7/src/microcode/const.h
+++ b/v7/src/microcode/const.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: const.h,v 9.42 1993/06/09 20:28:27 jawilson Exp $
+$Id: const.h,v 9.43 1993/09/11 02:45:52 gjr Exp $
 
 Copyright (c) 1987-1993 Massachusetts Institute of Technology
 
@@ -178,7 +178,9 @@ MIT in each case. */
 #define REGBLOCK_CLOSURE_SPACE		10	/* For use by compiler */
 #define REGBLOCK_STACK_GUARD		11
 #define REGBLOCK_INT_CODE		12
-#define REGBLOCK_MINIMUM_LENGTH		13
+#define REGBLOCK_REFLECT_TO_INTERFACE	13	/* For use by compiler */
+
+#define REGBLOCK_MINIMUM_LENGTH		14
 
 /* Codes specifying how to start scheme at boot time. */
 
diff --git a/v7/src/microcode/fixobj.h b/v7/src/microcode/fixobj.h
index 682c200af..8c282ad83 100644
--- a/v7/src/microcode/fixobj.h
+++ b/v7/src/microcode/fixobj.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: fixobj.h,v 9.34 1993/08/28 22:46:36 gjr Exp $
+$Id: fixobj.h,v 9.35 1993/09/11 02:45:53 gjr Exp $
 
 Copyright (c) 1987-1993 Massachusetts Institute of Technology
 
@@ -124,6 +124,6 @@ MIT in each case. */
 #define PC_Sample_Prob_Comp_Table	0x3D /* Sure looked compiled ?! */
 #define PC_Sample_UFO_Table		0x3E /* Invalid ENV at sample time  */
 
+#define COMPILED_CODE_BKPT_HANDLER	0x3F
 
-
-#define NFixed_Objects			0x3F
+#define NFixed_Objects			0x40
diff --git a/v7/src/microcode/hooks.c b/v7/src/microcode/hooks.c
index 400706a1a..8d18dd28c 100644
--- a/v7/src/microcode/hooks.c
+++ b/v7/src/microcode/hooks.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: hooks.c,v 9.51 1993/06/04 00:15:34 cph Exp $
+$Id: hooks.c,v 9.52 1993/09/11 02:45:54 gjr Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -40,10 +40,9 @@ MIT in each case. */
 #include "winder.h"
 #include "history.h"
 
-#define APPLY_AVOID_CANONICALIZATION
-
 DEFINE_PRIMITIVE ("APPLY", Prim_apply, 2, 2,
-  "Invoke first argument on the arguments contained in the second argument.")
+		  "(PROCEDURE LIST-OF-ARGS)\n\
+Invoke PROCEDURE on the arguments contained in list-of-ARGS.")
 {
   SCHEME_OBJECT procedure;
   SCHEME_OBJECT argument_list;
@@ -52,7 +51,6 @@ DEFINE_PRIMITIVE ("APPLY", Prim_apply, 2, 2,
 
   procedure = (ARG_REF (1));
   argument_list = (ARG_REF (2));
-#ifndef APPLY_AVOID_CANONICALIZATION
   /* Since this primitive must pop its own frame off and push a new
      frame on the stack, it has to be careful.  Its own stack frame is
      needed if an error or GC is required.  So these checks are done
@@ -66,8 +64,6 @@ DEFINE_PRIMITIVE ("APPLY", Prim_apply, 2, 2,
      overhead of maintaining this other form (e.g. PRIMITIVE_GC_If_Needed)
      is sufficiently high that it probably makes up for the time saved.
    */
-  PRIMITIVE_CANONICALIZE_CONTEXT ();
-#endif /* APPLY_AVOID_CANONICALIZATION */
   {
     fast SCHEME_OBJECT scan_list, scan_list_trail;
     TOUCH_IN_PRIMITIVE (argument_list, scan_list);
@@ -150,13 +146,11 @@ DEFINE_PRIMITIVE ("APPLY", Prim_apply, 2, 2,
  Pushed ();
 #endif
 
-#ifdef APPLY_AVOID_CANONICALIZATION
   if (COMPILED_CODE_ADDRESS_P (STACK_REF (number_of_args + 2)))
   {
     extern SCHEME_OBJECT EXFUN (apply_compiled_from_primitive, (int));
     PRIMITIVE_RETURN (apply_compiled_from_primitive (2));
   }
-#endif /* APPLY_AVOID_CANONICALIZATION */
 
   PRIMITIVE_ABORT (PRIM_APPLY);
   /*NOTREACHED*/
@@ -343,7 +337,8 @@ DEFUN (CWCC, (return_code, reuse_flag, receiver),
 */
 
 DEFINE_PRIMITIVE ("CALL-WITH-CURRENT-CONTINUATION", Prim_catch, 1, 1,
-  "Invoke argument with a reentrant copy of the current control stack.")
+		  "(RECEIVER)\n\
+Invoke RECEIVER with a reentrant copy of the current control stack.")
 {
   PRIMITIVE_HEADER (1);
   PRIMITIVE_CANONICALIZE_CONTEXT ();
@@ -353,7 +348,8 @@ DEFINE_PRIMITIVE ("CALL-WITH-CURRENT-CONTINUATION", Prim_catch, 1, 1,
 
 DEFINE_PRIMITIVE ("NON-REENTRANT-CALL-WITH-CURRENT-CONTINUATION",
 		  Prim_non_reentrant_catch, 1, 1,
-  "Invoke argument with a non-reentrant copy of the current control stack.")
+		  "(RECEIVER)\n\
+Invoke RECEIVER with a non-reentrant copy of the current control stack.")
 {
   PRIMITIVE_HEADER (1);
   PRIMITIVE_CANONICALIZE_CONTEXT();
@@ -374,7 +370,8 @@ DEFINE_PRIMITIVE ("NON-REENTRANT-CALL-WITH-CURRENT-CONTINUATION",
  */   
 
 DEFINE_PRIMITIVE ("WITHIN-CONTROL-POINT", Prim_within_control_point, 2, 2,
-  "Invoke second argument with the first argument as its control stack.")
+		  "(CONTROL-POINT THUNK)\n\
+Invoke THUNK with CONTROL-POINT as its control stack.")
 {
   SCHEME_OBJECT control_point, thunk;
   PRIMITIVE_HEADER (2);
@@ -406,7 +403,8 @@ DEFINE_PRIMITIVE ("WITHIN-CONTROL-POINT", Prim_within_control_point, 2, 2,
   /*NOTREACHED*/
 }
 
-DEFINE_PRIMITIVE ("ERROR-PROCEDURE", Prim_error_procedure, 3, 3, 0)
+DEFINE_PRIMITIVE ("ERROR-PROCEDURE", Prim_error_procedure, 3, 3,
+		  "(MESSAGE IRRITANTS ENVIRONMENT)\nSignal an error.")
 {
   PRIMITIVE_HEADER (3);
   PRIMITIVE_CANONICALIZE_CONTEXT ();
@@ -432,7 +430,9 @@ DEFINE_PRIMITIVE ("ERROR-PROCEDURE", Prim_error_procedure, 3, 3, 0)
   }
 }
 
-DEFINE_PRIMITIVE ("SCODE-EVAL", Prim_scode_eval, 2, 2, 0)
+DEFINE_PRIMITIVE ("SCODE-EVAL", Prim_scode_eval, 2, 2,
+		  "(SCODE-EXPRESSION ENVIRONMENT)\n\
+Evaluate SCODE-EXPRESSION in ENVIRONMENT.")
 {
   PRIMITIVE_HEADER (2);
   PRIMITIVE_CANONICALIZE_CONTEXT ();
@@ -448,7 +448,10 @@ DEFINE_PRIMITIVE ("SCODE-EVAL", Prim_scode_eval, 2, 2, 0)
   /*NOTREACHED*/
 }
 
-DEFINE_PRIMITIVE ("FORCE", Prim_force, 1, 1, 0)
+DEFINE_PRIMITIVE ("FORCE", Prim_force, 1, 1,
+		  "(PROMISE)\n\
+Return the value memoized in PROMISE, computing it if it has not been\n\
+memoized yet.")
 {
   PRIMITIVE_HEADER (1);
   CHECK_ARG (1, PROMISE_P);
@@ -492,7 +495,13 @@ DEFINE_PRIMITIVE ("FORCE", Prim_force, 1, 1, 0)
 
 /* State Space Implementation */
 
-DEFINE_PRIMITIVE ("EXECUTE-AT-NEW-STATE-POINT", Prim_execute_at_new_point, 4, 4, 0)
+DEFINE_PRIMITIVE ("EXECUTE-AT-NEW-STATE-POINT",
+		  Prim_execute_at_new_point, 4, 4,
+		  "(OLD-STATE-POINT BEFORE-THUNK DURING-THUNK AFTER-THUNK)\n\
+Invoke DURING-THUNK in a new state point defined by the transition\n\
+<BEFORE-THUNK, AFTER-THUNK> from OLD-STATE-POINT.\n\
+If OLD-STATE-POINT is #F, the current state point in the global state\n\
+space is used as the starting point.")
 {
   PRIMITIVE_HEADER (4);
 
@@ -544,7 +553,8 @@ DEFINE_PRIMITIVE ("EXECUTE-AT-NEW-STATE-POINT", Prim_execute_at_new_point, 4, 4,
   }
 }
 
-DEFINE_PRIMITIVE ("TRANSLATE-TO-STATE-POINT", Prim_translate_to_point, 1, 1, 0)
+DEFINE_PRIMITIVE ("TRANSLATE-TO-STATE-POINT", Prim_translate_to_point, 1, 1,
+		  "(STATE-POINT)\nRestore the dynamic state to STATE-POINT.")
 {
   PRIMITIVE_HEADER (1);
   PRIMITIVE_CANONICALIZE_CONTEXT ();
@@ -558,7 +568,8 @@ DEFINE_PRIMITIVE ("TRANSLATE-TO-STATE-POINT", Prim_translate_to_point, 1, 1, 0)
 }
 
 DEFINE_PRIMITIVE ("MAKE-STATE-SPACE", Prim_make_state_space, 1, 1,
-  "Return a newly-allocated state-space.\n\
+		  "(MUTABLE?)\n\
+Return a newly-allocated state-space.\n\
 Argument MUTABLE?, if not #F, means return a mutable state-space.\n\
 Otherwise, -the- immutable state-space is saved internally.")
 {
@@ -591,7 +602,10 @@ Otherwise, -the- immutable state-space is saved internally.")
   }
 }
 
-DEFINE_PRIMITIVE ("CURRENT-DYNAMIC-STATE", Prim_current_dynamic_state, 1, 1, 0)
+DEFINE_PRIMITIVE ("CURRENT-DYNAMIC-STATE", Prim_current_dynamic_state, 1, 1,
+		  "(STATE-SPACE)\n\
+Return the current state point in STATE-SPACE. If STATE-SPACE is #F,\n\
+return the current state point in the global state space.")
 {
   PRIMITIVE_HEADER (1);
 
@@ -602,7 +616,9 @@ DEFINE_PRIMITIVE ("CURRENT-DYNAMIC-STATE", Prim_current_dynamic_state, 1, 1, 0)
   PRIMITIVE_RETURN (MEMORY_REF ((ARG_REF (1)), STATE_SPACE_NEAREST_POINT));
 }
 
-DEFINE_PRIMITIVE ("SET-CURRENT-DYNAMIC-STATE!", Prim_set_dynamic_state, 1, 1, 0)
+DEFINE_PRIMITIVE ("SET-CURRENT-DYNAMIC-STATE!", Prim_set_dynamic_state, 1, 1,
+		  "(STATE-POINT)\n\
+Set the current dynamic state point to STATE-POINT.")
 {
   PRIMITIVE_HEADER (1);
   CHECK_ARG (1, STATE_POINT_P);
@@ -628,7 +644,7 @@ DEFINE_PRIMITIVE ("SET-CURRENT-DYNAMIC-STATE!", Prim_set_dynamic_state, 1, 1, 0)
 /* Interrupts */
 
 DEFINE_PRIMITIVE ("GET-INTERRUPT-ENABLES", Prim_get_interrupt_enables, 0, 0,
-  "(get-interrupt-enables)\n\
+		  "()\n\
 Returns the current interrupt mask.\n\
 There are two interrupt bit masks:\n\
 - The interrupt mask has a one bit for every enabled interrupt.\n\
@@ -646,8 +662,8 @@ should clear the corresponding interrupt bit.")
 }
 
 DEFINE_PRIMITIVE ("SET-INTERRUPT-ENABLES!", Prim_set_interrupt_enables, 1, 1,
-  "(set-interrupt-enables! interrupt-mask)\n\
-Sets the interrupt mask to NEW-INT-ENABLES; returns previous mask value.\n\
+		  "(INTERRUPT-MASK)\n\
+Sets the interrupt mask to INTERRUPT-MASK; returns previous mask value.\n\
 See `get-interrupt-enables' for more information on interrupts.")
 {
   PRIMITIVE_HEADER (1);
@@ -659,8 +675,8 @@ See `get-interrupt-enables' for more information on interrupts.")
 }
 
 DEFINE_PRIMITIVE ("CLEAR-INTERRUPTS!", Prim_clear_interrupts, 1, 1,
-  "(clear-interrupts! interrupt-mask)\n\
-Clears the interrupt bits in interrupt-mask by clearing the\n\
+		  "(INTERRUPT-MASK)\n\
+Clears the interrupt bits in INTERRUPT-MASK by clearing the\n\
 corresponding bits in the interrupt code.\n\
 See `get-interrupt-enables' for more information on interrupts.")
 {
@@ -670,8 +686,8 @@ See `get-interrupt-enables' for more information on interrupts.")
 }
 
 DEFINE_PRIMITIVE ("DISABLE-INTERRUPTS!", Prim_disable_interrupts, 1, 1, 
-  "(disable-interrupts! interrupt-mask)\n\
-Disables the interrupts specified in interrupt-mask by clearing the\n\
+		  "(INTERRUPT-MASK)\n\
+Disables the interrupts specified in INTERRUPT-MASK by clearing the\n\
 corresponding bits in the interrupt mask. Returns previous mask value.\n\
 See `get-interrupt-enables' for more information on interrupts.")
 {
@@ -684,8 +700,8 @@ See `get-interrupt-enables' for more information on interrupts.")
 }
 
 DEFINE_PRIMITIVE ("ENABLE-INTERRUPTS!", Prim_enable_interrupts, 1, 1,
-  "(enable-interrupts! interrupt-mask)\n\
-Enables the interrupts specified in interrupt-mask by setting the\n\
+		  "(INTERRUPT-MASK)\n\
+Enables the interrupts specified in INTERRUPT-MASK by setting the\n\
 corresponding bits in the interrupt mask. Returns previous mask value.\n\
 See `get-interrupt-enables' for more information on interrupts.")
 {
@@ -698,8 +714,8 @@ See `get-interrupt-enables' for more information on interrupts.")
 }
 
 DEFINE_PRIMITIVE ("REQUEST-INTERRUPTS!", Prim_request_interrupts, 1, 1,
-  "(request-interrupts! interrupt-mask)\n\
-Requests the interrupt bits in interrupt-mask by setting the\n\
+		  "(INTERRUPT-MASK)\n\
+Requests the interrupt bits in INTERRUPT-MASK by setting the\n\
 corresponding bits in the interrupt code.\n\
 See `get-interrupt-enables' for more information on interrupts.")
 {
@@ -708,9 +724,11 @@ See `get-interrupt-enables' for more information on interrupts.")
   PRIMITIVE_RETURN (UNSPECIFIC);
 }
 
-DEFINE_PRIMITIVE ("RETURN-TO-APPLICATION", Prim_return_to_application, 2, LEXPR,
-  "Invokes first argument THUNK with no arguments and a special return address.\n\
-The return address calls the second argument on the remaining arguments.\n\
+DEFINE_PRIMITIVE ("RETURN-TO-APPLICATION",
+		  Prim_return_to_application, 2, LEXPR,
+  "(THUNK PROCEDURE . ARGS)\n\
+Invokes THUNK with no arguments and a special return address.\n\
+The return address calls PROCEDURE on ARGS.\n\
 This is used by the runtime system to create stack frames that can be\n\
 identified by the continuation parser.")
 {
@@ -736,41 +754,72 @@ identified by the continuation parser.")
   PRIMITIVE_ABORT (PRIM_APPLY);
   /*NOTREACHED*/
 }
-
+
 DEFINE_PRIMITIVE ("WITH-STACK-MARKER", Prim_with_stack_marker, 3, 3,
-  "Call first argument THUNK with a continuation that has a special marker.\n\
+		  "(THUNK MARKER1 MARKER2)\n\
+Call THUNK with a continuation that has a special marker.\n\
 When THUNK returns, the marker is discarded.\n\
 The value of THUNK is returned to the continuation of this primitive.\n\
-The marker consists of the second and third arguments.\n\
-By convention, the second argument is a tag identifying the kind of marker,\n\
-and the third argument is data identifying the marker instance.")
+The marker consists of MARKER1 and MARKER2.\n\
+By convention, MARKER1 is a tag identifying the kind of marker,\n\
+and MARKER2 is data identifying the marker instance.")
 {
+  SCHEME_OBJECT thunk;
   PRIMITIVE_HEADER (3);
-  PRIMITIVE_CANONICALIZE_CONTEXT ();
+
+  thunk = (ARG_REF (1));
+
+  if ((COMPILED_CODE_ADDRESS_P (STACK_REF (2)))
+      && (COMPILED_CODE_ADDRESS_P (thunk)))
+  {
+    extern SCHEME_OBJECT EXFUN (compiled_with_stack_marker, (SCHEME_OBJECT));
+
+    STACK_POP ();
+    return (compiled_with_stack_marker (thunk));
+  }
+  else
   {
-    SCHEME_OBJECT thunk = (STACK_POP ());
+    PRIMITIVE_CANONICALIZE_CONTEXT ();
+
+    STACK_POP ();
     STACK_PUSH (MAKE_OBJECT (TC_RETURN_CODE, RC_STACK_MARKER));
-  Will_Push (STACK_ENV_EXTRA_SLOTS + 1);
+   Will_Push (STACK_ENV_EXTRA_SLOTS + 1);
     STACK_PUSH (thunk);
     STACK_PUSH (STACK_FRAME_HEADER);
-  Pushed ();
+   Pushed ();
+    PRIMITIVE_ABORT (PRIM_APPLY);
+    /*NOTREACHED*/
   }
-  PRIMITIVE_ABORT (PRIM_APPLY);
-  /*NOTREACHED*/
 }
-
-DEFINE_PRIMITIVE ("WITH-INTERRUPT-MASK", Prim_with_interrupt_mask, 2, 2, 0)
+
+static SCHEME_OBJECT 
+DEFUN (with_new_interrupt_mask, (new_mask), unsigned long new_mask)
 {
-  PRIMITIVE_HEADER (2);
-  PRIMITIVE_CANONICALIZE_CONTEXT ();
+  SCHEME_OBJECT receiver = (ARG_REF (2));
+
+  if ((COMPILED_CODE_ADDRESS_P (STACK_REF (2)))
+      && (COMPILED_CODE_ADDRESS_P (receiver)))
   {
-    long new_mask = (INT_Mask & (arg_integer (1)));
-    SCHEME_OBJECT thunk = (ARG_REF (2));
+    extern SCHEME_OBJECT
+      EXFUN (compiled_with_interrupt_mask, (unsigned long,
+					    SCHEME_OBJECT,
+					    unsigned long));
+    unsigned long current_mask = (FETCH_INTERRUPT_MASK ());
+
+    POP_PRIMITIVE_FRAME (2);
+    SET_INTERRUPT_MASK (new_mask);
+
+    PRIMITIVE_RETURN
+      (compiled_with_interrupt_mask (current_mask, receiver, new_mask));
+  }
+  else
+  {
+    PRIMITIVE_CANONICALIZE_CONTEXT ();
     POP_PRIMITIVE_FRAME (2);
     preserve_interrupt_mask ();
   Will_Push (STACK_ENV_EXTRA_SLOTS + 2);
     STACK_PUSH (LONG_TO_FIXNUM (FETCH_INTERRUPT_MASK ()));
-    STACK_PUSH (thunk);
+    STACK_PUSH (receiver);
     STACK_PUSH (STACK_FRAME_HEADER + 1);
   Pushed ();
     SET_INTERRUPT_MASK (new_mask);
@@ -779,26 +828,28 @@ DEFINE_PRIMITIVE ("WITH-INTERRUPT-MASK", Prim_with_interrupt_mask, 2, 2, 0)
   }
 }
 
-DEFINE_PRIMITIVE ("WITH-INTERRUPTS-REDUCED", Prim_with_interrupts_reduced, 2, 2, 0)
+DEFINE_PRIMITIVE ("WITH-INTERRUPT-MASK", Prim_with_interrupt_mask, 2, 2,
+		  "(MASK RECEIVER)\n\
+Set the interrupt mask to MASK for the duration of the call to RECEIVER.\n\
+RECEIVER is passed the old interrupt mask as its argument.")
 {
   PRIMITIVE_HEADER (2);
-  PRIMITIVE_CANONICALIZE_CONTEXT();
-  {
-    long new_mask = (INT_Mask & (arg_integer (1)));
-    long old_mask = (FETCH_INTERRUPT_MASK ());
-    SCHEME_OBJECT thunk = (ARG_REF (2));
-    POP_PRIMITIVE_FRAME (2);
-    preserve_interrupt_mask ();
-  Will_Push (STACK_ENV_EXTRA_SLOTS + 2);
-    STACK_PUSH (LONG_TO_FIXNUM (old_mask));
-    STACK_PUSH (thunk);
-    STACK_PUSH (STACK_FRAME_HEADER + 1);
-  Pushed ();
-    SET_INTERRUPT_MASK
-      ((new_mask > old_mask) ? new_mask : (new_mask & old_mask));
-    PRIMITIVE_ABORT (PRIM_APPLY);
-    /*NOTREACHED*/
-  }
+  PRIMITIVE_RETURN (with_new_interrupt_mask (INT_Mask & (arg_integer (1))));
+}
+
+DEFINE_PRIMITIVE ("WITH-INTERRUPTS-REDUCED",
+		  Prim_with_interrupts_reduced, 2, 2,
+		  "(MASK RECEIVER)\n\
+Like `with-interrupt-mask', but only disables interrupts.")
+{
+  unsigned long old_mask, new_mask;
+  PRIMITIVE_HEADER (2);
+
+  old_mask = (FETCH_INTERRUPT_MASK ());
+  new_mask = (INT_Mask & (arg_integer (1)));
+  PRIMITIVE_RETURN (with_new_interrupt_mask ((new_mask > old_mask) ?
+					     new_mask :
+					     (new_mask & old_mask)));
 }
 
 /* History */
@@ -812,7 +863,9 @@ initialize_history ()
     (MAKE_POINTER_OBJECT (UNMARKED_HISTORY_TYPE, (Make_Dummy_History ())));
 }
 
-DEFINE_PRIMITIVE ("SET-CURRENT-HISTORY!", Prim_set_current_history, 1, 1, 0)
+DEFINE_PRIMITIVE ("SET-CURRENT-HISTORY!", Prim_set_current_history, 1, 1,
+		  "(HISTORY)\n\
+Set the interpreter's history object to HISTORY.")
 {
   PRIMITIVE_HEADER (1);
   PRIMITIVE_CANONICALIZE_CONTEXT ();
@@ -828,7 +881,8 @@ DEFINE_PRIMITIVE ("SET-CURRENT-HISTORY!", Prim_set_current_history, 1, 1, 0)
   /*NOTREACHED*/
 }
 
-DEFINE_PRIMITIVE ("WITH-HISTORY-DISABLED", Prim_with_history_disabled, 1, 1, 0)
+DEFINE_PRIMITIVE ("WITH-HISTORY-DISABLED", Prim_with_history_disabled, 1, 1,
+		  "(THUNK)\nExecute THUNK with the interpreter's history OFF.")
 {
   PRIMITIVE_HEADER (1);
   PRIMITIVE_CANONICALIZE_CONTEXT ();
@@ -870,13 +924,16 @@ DEFINE_PRIMITIVE ("WITH-HISTORY-DISABLED", Prim_with_history_disabled, 1, 1, 0)
 
 /* Miscellaneous State */
 
-DEFINE_PRIMITIVE ("GET-FLUID-BINDINGS", Prim_get_fluid_bindings, 0, 0, 0)
+DEFINE_PRIMITIVE ("GET-FLUID-BINDINGS", Prim_get_fluid_bindings, 0, 0,
+		  "()\nReturn the current deep fluid bindings.")
 {
   PRIMITIVE_HEADER (0);
   PRIMITIVE_RETURN (Fluid_Bindings);
 }
 
-DEFINE_PRIMITIVE ("SET-FLUID-BINDINGS!", Prim_set_fluid_bindings, 1, 1, 0)
+DEFINE_PRIMITIVE ("SET-FLUID-BINDINGS!", Prim_set_fluid_bindings, 1, 1,
+		  "(FLUID-BINDINGS-ALIST)\n\
+Set the current deep fluid bindings alist to FLUID-BINDINGS-ALIST.")
 {
   PRIMITIVE_HEADER (1);
   CHECK_ARG (1, APPARENT_LIST_P);
@@ -887,7 +944,9 @@ DEFINE_PRIMITIVE ("SET-FLUID-BINDINGS!", Prim_set_fluid_bindings, 1, 1, 0)
   }
 }
 
-DEFINE_PRIMITIVE ("GET-FIXED-OBJECTS-VECTOR", Prim_get_fixed_objects_vector, 0, 0, 0)
+DEFINE_PRIMITIVE ("GET-FIXED-OBJECTS-VECTOR",
+		  Prim_get_fixed_objects_vector, 0, 0,
+		  "()\nReturn the fixed objects vector (TM).") 
 {
   PRIMITIVE_HEADER (0);
   if (Valid_Fixed_Obj_Vector ())
@@ -896,10 +955,12 @@ DEFINE_PRIMITIVE ("GET-FIXED-OBJECTS-VECTOR", Prim_get_fixed_objects_vector, 0,
 }
 
 #ifndef SET_FIXED_OBJ_HOOK
-#define SET_FIXED_OBJ_HOOK(vector) Fixed_Objects = (vector)
+# define SET_FIXED_OBJ_HOOK(vector) Fixed_Objects = (vector)
 #endif
 
-DEFINE_PRIMITIVE ("SET-FIXED-OBJECTS-VECTOR!", Prim_set_fixed_objects_vector, 1, 1, 0)
+DEFINE_PRIMITIVE ("SET-FIXED-OBJECTS-VECTOR!",
+		  Prim_set_fixed_objects_vector, 1, 1,
+		  "(NEW-FOV)\nSet the fixed objects vector (TM) to NEW-FOV.")
 {
   PRIMITIVE_HEADER (1);
   CHECK_ARG (1, VECTOR_P);
diff --git a/v7/src/microcode/ntgui.c b/v7/src/microcode/ntgui.c
index b0531fff2..1e382795a 100644
--- a/v7/src/microcode/ntgui.c
+++ b/v7/src/microcode/ntgui.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: ntgui.c,v 1.10 1993/09/07 19:08:01 gjr Exp $
+$Id: ntgui.c,v 1.11 1993/09/11 02:45:55 gjr Exp $
 
 Copyright (c) 1993 Massachusetts Institute of Technology
 
@@ -190,15 +190,16 @@ DEFUN_VOID (nt_gui_default_poll)
 
 extern HANDLE master_tty_window;
 extern void catatonia_trigger (void);
+extern unsigned long * winnt_catatonia_block;
 
 void
 catatonia_trigger (void)
 {
   int mes_result;
   static BOOL already_exitting = FALSE;
-  SCHEME_OBJECT saved = Registers[REGBLOCK_CATATONIA_LIMIT];
+  SCHEME_OBJECT saved = winnt_catatonia_block[CATATONIA_BLOCK_LIMIT];
 
-  Registers[REGBLOCK_CATATONIA_LIMIT] = 0;
+  winnt_catatonia_block[CATATONIA_BLOCK_LIMIT] = 0;
 
   mes_result = (MessageBox (master_tty_window,
 			    "Scheme appears to have become catatonic.\n"
@@ -206,8 +207,8 @@ catatonia_trigger (void)
 			    "MIT Scheme",
 			    (MB_ICONSTOP | MB_OKCANCEL)));
 
-  Registers[REGBLOCK_CATATONIA_COUNTER] = 0;
-  Registers[REGBLOCK_CATATONIA_LIMIT] = saved;
+  winnt_catatonia_block[CATATONIA_BLOCK_COUNTER] = 0;
+  winnt_catatonia_block[CATATONIA_BLOCK_LIMIT] = saved;
 
   if (mes_result != IDOK)
     return;
@@ -252,7 +253,7 @@ DEFINE_PRIMITIVE ("MICROCODE-POLL-INTERRUPT-HANDLER",
   }
   else
   {
-    Registers[REGBLOCK_CATATONIA_COUNTER] = 0;
+    winnt_catatonia_block[CATATONIA_BLOCK_COUNTER] = 0;
     nt_gui_default_poll ();
 #ifndef USE_WM_TIMER
     low_level_timer_tick ();
diff --git a/v7/src/microcode/ntgui.h b/v7/src/microcode/ntgui.h
index b45a6f38b..7a02a976b 100644
--- a/v7/src/microcode/ntgui.h
+++ b/v7/src/microcode/ntgui.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: ntgui.h,v 1.5 1993/09/08 04:44:41 gjr Exp $
+$Id: ntgui.h,v 1.6 1993/09/11 02:45:56 gjr Exp $
 
 Copyright (c) 1993 Massachusetts Institute of Technology
 
@@ -54,11 +54,11 @@ MIT in each case. */
 #define IDM_ABOUT          303
 #define IDM_EMERGENCYKILL  400
 
-#ifndef REGBLOCK_CATATONIA_COUNTER
+#ifndef CATATONIA_BLOCK_COUNTER
 /* They must be contiguous, with counter being lower. */
-# define REGBLOCK_CATATONIA_COUNTER REGBLOCK_MINIMUM_LENGTH
-# define REGBLOCK_CATATONIA_LIMIT   (REGBLOCK_CATATONIA_COUNTER + 1)
-# define REGBLOCK_CATATONIA_FLAG    (REGBLOCK_CATATONIA_COUNTER + 2)
+# define CATATONIA_BLOCK_COUNTER 	0
+# define CATATONIA_BLOCK_LIMIT   	(CATATONIA_BLOCK_COUNTER + 1)
+# define CATATONIA_BLOCK_FLAG    	(CATATONIA_BLOCK_COUNTER + 2)
 #endif
 
 #define WM_CATATONIC (WM_USER)
diff --git a/v7/src/microcode/ntsig.c b/v7/src/microcode/ntsig.c
index 9aae23e3d..adcb1b38a 100644
--- a/v7/src/microcode/ntsig.c
+++ b/v7/src/microcode/ntsig.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: ntsig.c,v 1.12 1993/09/08 04:44:06 gjr Exp $
+$Id: ntsig.c,v 1.13 1993/09/11 02:45:57 gjr Exp $
 
 Copyright (c) 1992-1993 Massachusetts Institute of Technology
 
@@ -412,21 +412,29 @@ DEFUN_VOID (OS_restartable_exit)
 #define ASYNC_TIMER_PERIOD	50	/* msec */
 
 static void * timer_state = ((void *) NULL);
+extern unsigned long * winnt_catatonia_block;
 
 static char *
 DEFUN_VOID (install_timer)
 {
-  Registers[REGBLOCK_CATATONIA_COUNTER] = 0;
-  Registers[REGBLOCK_CATATONIA_LIMIT]
+  /* This presumes that the catatonia block is allocated near
+     the register block and locked in physical memory with it.
+   */
+
+  long catatonia_offset
+    = (((SCHEME_OBJECT *) &winnt_catatonia_block[0]) - (&Registers[0]));
+
+  winnt_catatonia_block[CATATONIA_BLOCK_COUNTER] = 0;
+  winnt_catatonia_block[CATATONIA_BLOCK_LIMIT]
     = (CATATONIA_PERIOD / ASYNC_TIMER_PERIOD);
-  Registers[REGBLOCK_CATATONIA_FLAG] = 0;
+  winnt_catatonia_block[CATATONIA_BLOCK_FLAG] = 0;
   switch (win32_install_async_timer (&timer_state,
 				     &Registers[0],
 				     REGBLOCK_MEMTOP,
 				     REGBLOCK_INT_CODE,
 				     REGBLOCK_INT_MASK,
 				     (INT_Global_GC | INT_Global_1),
-				     REGBLOCK_CATATONIA_COUNTER,
+				     catatonia_offset,
 				     WM_CATATONIC,
 				     master_tty_window))
   {
diff --git a/v7/src/microcode/prosio.c b/v7/src/microcode/prosio.c
index 84efe6b41..8d9399d99 100644
--- a/v7/src/microcode/prosio.c
+++ b/v7/src/microcode/prosio.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: prosio.c,v 1.8 1993/04/06 22:18:09 cph Exp $
+$Id: prosio.c,v 1.9 1993/09/11 02:45:58 gjr Exp $
 
 Copyright (c) 1987-93 Massachusetts Institute of Technology
 
@@ -236,25 +236,3 @@ DEFINE_PRIMITIVE ("CHANNEL-UNREGISTER", Prim_channel_unregister, 1, 1,
   OS_channel_unregister (arg_channel (1));
   PRIMITIVE_RETURN (UNSPECIFIC);
 }
-
-DEFINE_PRIMITIVE ("CHANNEL-SELECT-THEN-READ", Prim_channel_select_then_read, 4, 4,
-  "Like CHANNEL-READ, but also watches registered input channels.\n\
-If there is no input on CHANNEL, returns #F.\n\
-If there is input on some other registered channel, returns -2.\n\
-If the status of some subprocess changes, returns -3.\n\
-If an interrupt occurs during the read, returns -4.")
-{
-  PRIMITIVE_HEADER (4);
-  CHECK_ARG (2, STRING_P);
-  {
-    SCHEME_OBJECT buffer = (ARG_REF (2));
-    long length = (STRING_LENGTH (buffer));
-    long end = (arg_index_integer (4, (length + 1)));
-    long start = (arg_index_integer (3, (end + 1)));
-    long nread =
-      (OS_channel_select_then_read ((arg_channel (1)),
-				    (STRING_LOC (buffer, start)),
-				    (end - start)));
-    PRIMITIVE_RETURN ((nread == (-1)) ? SHARP_F : (long_to_integer (nread)));
-  }
-}
diff --git a/v7/src/microcode/utabmd.scm b/v7/src/microcode/utabmd.scm
index 80f5c5b9a..2d6a1ecff 100644
--- a/v7/src/microcode/utabmd.scm
+++ b/v7/src/microcode/utabmd.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: utabmd.scm,v 9.70 1993/08/28 21:17:23 gjr Exp $
+;;; $Id: utabmd.scm,v 9.71 1993/09/11 02:45:59 gjr Exp $
 ;;;
 ;;;	Copyright (c) 1987-1993 Massachusetts Institute of Technology
 ;;;
@@ -120,6 +120,7 @@
 	       PC-Sample/Interp-Proc-Buffer		;3C
 	       PC-Sample/Prob-Comp-Table		;3D
 	       PC-Sample/UFO-Table			;3E
+	       COMPILED-CODE-BKPT-HANDLER		;3F
 	       ))
 
 ;;; [] Types
@@ -714,4 +715,4 @@
 
 ;;; This identification string is saved by the system.
 
-"$Id: utabmd.scm,v 9.70 1993/08/28 21:17:23 gjr Exp $"
\ No newline at end of file
+"$Id: utabmd.scm,v 9.71 1993/09/11 02:45:59 gjr Exp $"
\ No newline at end of file
diff --git a/v8/src/microcode/cmpint.c b/v8/src/microcode/cmpint.c
index 4f3a52bbd..4435f4fb5 100644
--- a/v8/src/microcode/cmpint.c
+++ b/v8/src/microcode/cmpint.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: cmpint.c,v 1.67 1993/09/07 21:45:53 gjr Exp $
+$Id: cmpint.c,v 1.68 1993/09/11 02:45:46 gjr Exp $
 
 Copyright (c) 1989-1993 Massachusetts Institute of Technology
 
@@ -97,6 +97,10 @@ MIT in each case. */
 #include "trap.h"       /* UNASSIGNED_OBJECT, TRAP_EXTENSION_TYPE */
 #include "prims.h"      /* LEXPR */
 #include "prim.h"	/* Primitive_Procedure_Table, etc. */
+
+#define ENTRY_TO_OBJECT(entry)						\
+  (MAKE_POINTER_OBJECT (TC_COMPILED_ENTRY, ((SCHEME_OBJECT *) (entry))))
+
 #define IN_CMPINT_C
 #include "cmpgc.h"      /* Compiled code object relocation */
 
@@ -226,9 +230,6 @@ typedef utility_result EXFUN
   }                                                                     \
 }
 
-#define ENTRY_TO_OBJECT(entry)						\
-  (MAKE_POINTER_OBJECT (TC_COMPILED_ENTRY, ((SCHEME_OBJECT *) (entry))))
-
 #define MAKE_CC_BLOCK(block_addr)					\
   (MAKE_POINTER_OBJECT (TC_COMPILED_CODE_BLOCK, block_addr))
 
@@ -271,7 +272,11 @@ extern C_UTILITY SCHEME_OBJECT
   EXFUN (compiled_closure_to_entry, (SCHEME_OBJECT entry)),
   * EXFUN (compiled_entry_to_block_address, (SCHEME_OBJECT entry)),
   EXFUN (compiled_entry_to_block, (SCHEME_OBJECT entry)),
-  EXFUN (apply_compiled_from_primitive, (int));
+  EXFUN (apply_compiled_from_primitive, (int)),
+  EXFUN (compiled_with_interrupt_mask, (unsigned long,
+					SCHEME_OBJECT,
+					unsigned long)),
+  EXFUN (compiled_with_stack_marker, (SCHEME_OBJECT));
 
 extern C_UTILITY void
   EXFUN (compiler_initialize, (long fasl_p)),
@@ -305,7 +310,15 @@ extern C_TO_SCHEME long
 
 extern utility_table_entry utility_table[];
 
-static SCHEME_OBJECT apply_in_interpreter;
+static SCHEME_OBJECT reflect_to_interface;
+
+/* Breakpoint stuff. */
+
+extern C_UTILITY SCHEME_OBJECT EXFUN (bkpt_install, (PTR));
+extern C_UTILITY SCHEME_OBJECT EXFUN (bkpt_closure_install, (PTR));
+extern C_UTILITY Boolean EXFUN (bkpt_p, (PTR));
+extern C_UTILITY SCHEME_OBJECT EXFUN (bkpt_proceed, (PTR, SCHEME_OBJECT, SCHEME_OBJECT));
+extern C_UTILITY void EXFUN (bkpt_remove, (PTR, SCHEME_OBJECT));
 
 /* These definitions reflect the indices into the table above. */
 
@@ -327,10 +340,15 @@ static SCHEME_OBJECT apply_in_interpreter;
 #define TRAMPOLINE_K_4_2			0xf
 #define TRAMPOLINE_K_4_1			0x10
 #define TRAMPOLINE_K_4_0			0x11
-#define TRAMPOLINE_K_APPLY_IN_INTERPRETER	0x3a
+#define TRAMPOLINE_K_REFLECT_TO_INTERFACE	0x3a
 
 #define TRAMPOLINE_K_OTHER			TRAMPOLINE_K_INTERPRETED
 
+#define REFLECT_CODE_INTERNAL_APPLY		0
+#define REFLECT_CODE_RESTORE_INTERRUPT_MASK	1
+#define REFLECT_CODE_STACK_MARKER		2
+#define REFLECT_CODE_CC_BKPT			3
+
 /* Utilities for application of compiled procedures. */
 
 /* NOTE: In this file, the number of arguments (or minimum
@@ -534,9 +552,6 @@ DEFUN (setup_compiled_invocation,
    */
   return (setup_lexpr_invocation (nactuals, nmax, compiled_entry_address));
 }
-
-
-
 
 /* Main compiled code entry points.
 
@@ -659,11 +674,65 @@ defer_application:
       break;
   }
 
-  STACK_PUSH (apply_in_interpreter);
+  STACK_PUSH (FIXNUM_ZERO + REFLECT_CODE_INTERNAL_APPLY);
+  STACK_PUSH (reflect_to_interface);
   Stack_Pointer = (STACK_LOC (- arity));
   return (SHARP_F);
 }
 
+C_UTILITY SCHEME_OBJECT
+DEFUN (compiled_with_interrupt_mask, (old_mask, receiver, new_mask),
+       unsigned long old_mask
+       AND SCHEME_OBJECT receiver
+       AND unsigned long new_mask)
+{
+  long result;
+
+  STACK_PUSH (LONG_TO_FIXNUM (old_mask));
+  STACK_PUSH (FIXNUM_ZERO + REFLECT_CODE_RESTORE_INTERRUPT_MASK);
+  STACK_PUSH (reflect_to_interface);
+
+  STACK_PUSH (LONG_TO_FIXNUM (new_mask));
+  result = (setup_compiled_invocation (2,
+				       ((instruction *)
+					(OBJECT_ADDRESS (receiver)))));
+  STACK_PUSH (receiver);
+
+  if (result != PRIM_DONE)
+  {
+    STACK_PUSH (STACK_FRAME_HEADER + 1);
+    STACK_PUSH (FIXNUM_ZERO + REFLECT_CODE_INTERNAL_APPLY);
+    STACK_PUSH (reflect_to_interface);
+  }
+
+  Stack_Pointer = (STACK_LOC (- 2));
+  return (SHARP_F);
+}
+
+C_UTILITY SCHEME_OBJECT
+DEFUN (compiled_with_stack_marker, (thunk), SCHEME_OBJECT thunk)
+{
+  long result;
+
+  STACK_PUSH (FIXNUM_ZERO + REFLECT_CODE_STACK_MARKER);
+  STACK_PUSH (reflect_to_interface);
+
+  result = (setup_compiled_invocation (1,
+				       ((instruction *)
+					(OBJECT_ADDRESS (thunk)))));
+  STACK_PUSH (thunk);
+
+  if (result != PRIM_DONE)
+  {
+    STACK_PUSH (STACK_FRAME_HEADER);
+    STACK_PUSH (FIXNUM_ZERO + REFLECT_CODE_INTERNAL_APPLY);
+    STACK_PUSH (reflect_to_interface);
+  }
+
+  Stack_Pointer = (STACK_LOC (- 3));
+  return (SHARP_F);
+}
+
 /*
   SCHEME_UTILITYs
 
@@ -686,22 +755,6 @@ DEFUN (comutil_return_to_interpreter,
 {
   RETURN_TO_C (PRIM_DONE);
 }
-
-/*
-  This is an alternate way for code to return to the
-  Scheme interpreter.
-  It is invoked by a trampoline, which passes the address of the
-  trampoline storage block (empty) to it.
- */
-
-SCHEME_UTILITY utility_result
-DEFUN (comutil_apply_in_interpreter,
-       (tramp_data_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR tramp_data_raw
-       AND long ignore_2 AND long ignore_3 AND long ignore_4)
-{
-  RETURN_TO_C (PRIM_APPLY);
-}
 
 #if (COMPILER_PROCESSOR_TYPE != COMPILER_I386_TYPE)
 
@@ -2299,13 +2352,9 @@ DEFUN (compiled_entry_type,
   field1 = min_arity;
   field2 = max_arity;
   if (min_arity >= 0)
-  {
     kind = KIND_PROCEDURE;
-  }
   else if (max_arity >= 0)
-  {
     kind = KIND_ILLEGAL;
-  }
   else if ((((unsigned long) max_arity) & 0xff) < 0xe0)
   {
     /* Field2 is the offset to the next continuation */
@@ -2736,6 +2785,174 @@ DEFUN (coerce_to_compiled,
   return (PRIM_DONE);
 }
 
+#ifndef HAVE_BKPT_SUPPORT
+
+C_UTILITY SCHEME_OBJECT
+DEFUN (bkpt_install, (ep), PTR ep)
+{
+  return (SHARP_F);
+}
+
+C_UTILITY SCHEME_OBJECT
+DEFUN (bkpt_closure_install, (ep), PTR ep)
+{
+  return (SHARP_F);
+}
+
+C_UTILITY void
+DEFUN (bkpt_remove, (ep, handle), PTR ep AND SCHEME_OBJECT handle)
+{
+  error_external_return ();
+}
+
+C_UTILITY Boolean
+DEFUN (bkpt_p, (ep), PTR ep)
+{
+  return (SHARP_F);
+}
+
+C_UTILITY SCHEME_OBJECT
+DEFUN (bkpt_proceed, (ep, handle, state),
+       PTR ep AND SCHEME_OBJECT handle AND SCHEME_OBJECT state)
+{
+  error_external_return ();
+}
+
+C_UTILITY PTR
+DEFUN_VOID (do_bkpt_proceed)
+{
+  error_external_return ();
+}
+
+#else /* HAVE_BKPT_SUPPORT */
+
+#define BKPT_PROCEED_FRAME_SIZE	3
+
+C_UTILITY SCHEME_OBJECT
+DEFUN (bkpt_proceed, (ep, handle, state),
+       PTR ep AND SCHEME_OBJECT handle AND SCHEME_OBJECT state)
+{
+  if ((! (COMPILED_CODE_ADDRESS_P (STACK_REF (BKPT_PROCEED_FRAME_SIZE))))
+      || ((OBJECT_ADDRESS (STACK_REF (BKPT_PROCEED_FRAME_SIZE)))
+	  != ((SCHEME_OBJECT *) ep)))
+    error_external_return ();
+
+  STACK_PUSH (FIXNUM_ZERO + REFLECT_CODE_CC_BKPT);
+  STACK_PUSH (reflect_to_interface);
+  Stack_Pointer = (STACK_LOC (- BKPT_PROCEED_FRAME_SIZE));
+  return (SHARP_F);
+}
+#endif /* HAVE_BKPT_SUPPORT */
+
+SCHEME_UTILITY utility_result
+DEFUN (comutil_compiled_code_bkpt,
+       (entry_point_raw, dlink_raw, ignore_3, ignore_4),
+       SCHEME_ADDR entry_point_raw AND SCHEME_ADDR dlink_raw
+       AND long ignore_3 AND long ignore_4)
+{
+  long type_info[3];
+  instruction * entry_point_a
+    = ((instruction *) (SCHEME_ADDR_TO_ADDR (entry_point_raw)));
+  SCHEME_OBJECT entry_point = (ENTRY_TO_OBJECT (entry_point_a));
+  SCHEME_OBJECT state;
+  SCHEME_OBJECT stack_ptr;
+
+  STACK_PUSH (entry_point);	/* return address */
+
+  /* Potential bug: This does not preserve the environment for
+     IC procedures.  There is no way to tell that we have
+     an IC procedure in our hands.  It is not safe to preserve
+     it in general because the contents of the register may
+     be stale (predate the last GC).
+     However, the compiler no longer generates IC procedures, and
+     will probably never do it again.
+   */
+
+  compiled_entry_type (entry_point, &type_info[0]);
+  if (type_info[0] != KIND_CONTINUATION)
+    state = SHARP_F;
+  else if (type_info[1] == CONTINUATION_DYNAMIC_LINK)
+    state = (MAKE_POINTER_OBJECT
+	     (TC_STACK_ENVIRONMENT, (SCHEME_ADDR_TO_ADDR (dlink_raw))));
+  else
+    state = Val;
+
+  stack_ptr = (MAKE_POINTER_OBJECT (TC_STACK_ENVIRONMENT, Stack_Pointer));
+  STACK_PUSH (state);		/* state to preserve */
+  STACK_PUSH (stack_ptr);	/* "Environment" pointer */
+  STACK_PUSH (entry_point);	/* argument to handler */
+  return (comutil_apply ((Get_Fixed_Obj_Slot (COMPILED_CODE_BKPT_HANDLER)),
+			 4, ignore_3, ignore_4));
+}
+
+SCHEME_UTILITY utility_result
+DEFUN (comutil_compiled_closure_bkpt,
+       (entry_point_raw, ignore_2, ignore_3, ignore_4),
+       SCHEME_ADDR entry_point_raw
+       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+{
+  instruction * entry_point_a
+    = ((instruction *) (SCHEME_ADDR_TO_ADDR (entry_point_raw)));
+  SCHEME_OBJECT entry_point = (ENTRY_TO_OBJECT (entry_point_a));
+  SCHEME_OBJECT stack_ptr;
+
+  STACK_PUSH (entry_point);	/* return address */
+
+  stack_ptr = (MAKE_POINTER_OBJECT (TC_STACK_ENVIRONMENT, Stack_Pointer));
+  STACK_PUSH (SHARP_F);		/* state to preserve */
+  STACK_PUSH (stack_ptr);	/* "Environment" pointer */
+  STACK_PUSH (entry_point);	/* argument to handler */
+  return (comutil_apply ((Get_Fixed_Obj_Slot (COMPILED_CODE_BKPT_HANDLER)),
+			 4, ignore_3, ignore_4));
+}
+
+SCHEME_UTILITY utility_result
+DEFUN (comutil_reflect_to_interface,
+       (tramp_data_raw, ignore_2, ignore_3, ignore_4),
+       SCHEME_ADDR tramp_data_raw
+       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+{
+  SCHEME_OBJECT code = (STACK_POP ());
+
+  switch (OBJECT_DATUM (code))
+  {
+    case REFLECT_CODE_INTERNAL_APPLY:
+    {
+      long frame_size = (OBJECT_DATUM (STACK_POP ()));
+      SCHEME_OBJECT procedure = (STACK_POP ());
+      
+      return (comutil_apply (procedure, frame_size, ignore_3, ignore_4));
+    }
+
+    case REFLECT_CODE_CC_BKPT:
+    {
+      unsigned long value;
+
+      if (do_bkpt_proceed (& value))
+	RETURN_TO_SCHEME (value);
+      else
+	RETURN_TO_C (value);
+    }
+
+    case REFLECT_CODE_RESTORE_INTERRUPT_MASK:
+    {
+      SET_INTERRUPT_MASK (OBJECT_DATUM (STACK_POP ()));
+      RETURN_TO_SCHEME (OBJECT_ADDRESS (STACK_POP ()));
+    }
+
+    case REFLECT_CODE_STACK_MARKER:
+    {
+      STACK_POP ();		/* marker1 */
+      STACK_POP ();		/* marker2 */
+      RETURN_TO_SCHEME (OBJECT_ADDRESS (STACK_POP ()));
+    }
+
+    default:
+      STACK_PUSH (code);
+      RETURN_TO_C (ERR_EXTERNAL_RETURN);
+  }
+}
+
 /*
   Utility table used by the assembly language interface to invoke
   the SCHEME_UTILITY procedures that appear in this file.
@@ -2809,8 +3026,10 @@ utility_table_entry utility_table[] =
   UTE(comutil_quotient),			/* 0x37 */
   UTE(comutil_remainder),			/* 0x38 */
   UTE(comutil_modulo),				/* 0x39 */
-  UTE(comutil_apply_in_interpreter),		/* 0x3a */
-  UTE(comutil_interrupt_continuation_2)		/* 0x3b */
+  UTE(comutil_reflect_to_interface),		/* 0x3a */
+  UTE(comutil_interrupt_continuation_2),	/* 0x3b */
+  UTE(comutil_compiled_code_bkpt),		/* 0x3c */
+  UTE(comutil_compiled_closure_bkpt)		/* 0x3d */
   };
 
 /* Support for trap handling. */
@@ -2837,6 +3056,9 @@ struct util_descriptor_s
 static
 struct util_descriptor_s utility_descriptor_table[] =
 {
+#ifdef DECLARE_CMPINTMD_UTILITIES
+  DECLARE_CMPINTMD_UTILITIES(),
+#endif /* DECLARE_CMPINTMD_UTILITIES */
   UTLD(C_to_interface),
   UTLD(open_gap),
   UTLD(setup_lexpr_invocation),
@@ -2845,8 +3067,9 @@ struct util_descriptor_s utility_descriptor_table[] =
   UTLD(apply_compiled_procedure),
   UTLD(return_to_compiled_code),
   UTLD(apply_compiled_from_primitive),
+  UTLD(compiled_with_interrupt_mask),
+  UTLD(compiled_with_stack_marker),
   UTLD(comutil_return_to_interpreter),
-  UTLD(comutil_apply_in_interpreter),
   UTLD(comutil_primitive_apply),
   UTLD(comutil_primitive_lexpr_apply),
   UTLD(comutil_apply),
@@ -2948,6 +3171,17 @@ struct util_descriptor_s utility_descriptor_table[] =
   UTLD(make_uuo_link),
   UTLD(make_fake_uuo_link),
   UTLD(coerce_to_compiled),
+#ifndef HAVE_BKPT_SUPPORT
+  UTLD(bkpt_install),
+  UTLD(bkpt_closure_install),
+  UTLD(bkpt_remove),
+  UTLD(bkpt_p),
+  UTLD(do_bkpt_proceed),
+#endif 
+  UTLD(bkpt_proceed),
+  UTLD(comutil_compiled_code_bkpt),
+  UTLD(comutil_compiled_closure_bkpt),
+  UTLD(comutil_reflect_to_interface),
   UTLD(end_of_utils)
 };
 
@@ -3144,24 +3378,31 @@ DEFUN_VOID (compiler_reset_internal)
 {
   long len;
   SCHEME_OBJECT * block;
-  /* Other stuff can be placed here. */
-
-  Registers[REGBLOCK_CLOSURE_FREE] = ((SCHEME_OBJECT) NULL);
-  Registers[REGBLOCK_CLOSURE_SPACE] = ((SCHEME_OBJECT) 0);
 
-  ASM_RESET_HOOK();
+  /* Other stuff can be placed here. */
 
   block = (OBJECT_ADDRESS (compiler_utilities));
   len = (OBJECT_DATUM (block[0]));
+
   return_to_interpreter =
     (ENTRY_TO_OBJECT (((char *) block)
 		      + ((unsigned long) (block [len - 1]))));
-  apply_in_interpreter = 
+
+  reflect_to_interface =
     (ENTRY_TO_OBJECT (((char *) block)
 		      + ((unsigned long) (block [len]))));
+
+  Registers[REGBLOCK_CLOSURE_FREE] = ((SCHEME_OBJECT) NULL);
+  Registers[REGBLOCK_CLOSURE_SPACE] = ((SCHEME_OBJECT) 0);
+  Registers[REGBLOCK_REFLECT_TO_INTERFACE] = reflect_to_interface;
+
+  ASM_RESET_HOOK();
+
   return;
 }
 
+#define COMPILER_UTILITIES_LENGTH ((2 * (TRAMPOLINE_ENTRY_SIZE + 1)) + 1)
+
 C_UTILITY void
 DEFUN (compiler_reset,
        (new_block),
@@ -3170,7 +3411,8 @@ DEFUN (compiler_reset,
   /* Called after a disk restore */
 
   if (((OBJECT_TYPE (new_block)) != TC_COMPILED_CODE_BLOCK)
-      || ((OBJECT_TYPE (MEMORY_REF (new_block, 0))) != TC_MANIFEST_NM_VECTOR))
+      || ((OBJECT_TYPE (MEMORY_REF (new_block, 0))) != TC_MANIFEST_NM_VECTOR)
+      || ((VECTOR_LENGTH (new_block)) != (COMPILER_UTILITIES_LENGTH - 1)))
   {
     extern void EXFUN (compiler_reset_error, (void));
 
@@ -3199,7 +3441,7 @@ DEFUN (compiler_initialize, (fasl_p), long fasl_p)
     extern SCHEME_OBJECT * EXFUN (copy_to_constant_space,
 				  (SCHEME_OBJECT *, long));
 
-    len = ((2 * TRAMPOLINE_ENTRY_SIZE) + 3);
+    len = COMPILER_UTILITIES_LENGTH;
     if (GC_Check (len))
     {
       outf_fatal ("compiler_initialize: Not enough space!\n");
@@ -3209,18 +3451,21 @@ DEFUN (compiler_initialize, (fasl_p), long fasl_p)
     block = Free;
     Free += len;
     block[0] = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, (len - 1)));
+
     tramp1 = ((instruction *) (TRAMPOLINE_ENTRY_POINT (block - 1)));
-    tramp2 = ((instruction *)
-	      (((char *) tramp1)
-	       + (TRAMPOLINE_ENTRY_SIZE * (sizeof (SCHEME_OBJECT)))));
     fill_trampoline (block, tramp1,
 		     ((format_word) FORMAT_WORD_RETURN),
 		     TRAMPOLINE_K_RETURN);
+    block[len - 2] = (((char *) tramp1) - ((char *) block));
+
+    tramp2 = ((instruction *)
+	      (((char *) tramp1)
+	       + (TRAMPOLINE_ENTRY_SIZE * (sizeof (SCHEME_OBJECT)))));
     fill_trampoline (block, tramp2,
 		     ((format_word) FORMAT_WORD_RETURN),
-		     TRAMPOLINE_K_APPLY_IN_INTERPRETER);
-    block[len - 2] = (((char *) tramp1) - ((char *) block));
+		     TRAMPOLINE_K_REFLECT_TO_INTERFACE);
     block[len - 1] = (((char *) tramp2) - ((char *) block));
+
     block = (copy_to_constant_space (block, len));
     compiler_utilities = (MAKE_CC_BLOCK (block));
     compiler_reset_internal ();
@@ -3284,7 +3529,11 @@ extern SCHEME_OBJECT
   EXFUN (compiled_closure_to_entry, (SCHEME_OBJECT entry)),
   * EXFUN (compiled_entry_to_block_address, (SCHEME_OBJECT entry)),
   EXFUN (compiled_entry_to_block, (SCHEME_OBJECT entry)),
-  EXFUN (apply_compiled_from_primitive, (int));
+  EXFUN (apply_compiled_from_primitive, (int)),
+  EXFUN (compiled_with_interrupt_mask, (unsigned long,
+					SCHEME_OBJECT,
+					unsigned long)),
+  EXFUN (compiled_with_stack_marker, (SCHEME_OBJECT));
 
 extern void
   EXFUN (compiler_reset, (SCHEME_OBJECT new_block)),
@@ -3293,6 +3542,14 @@ extern void
 	 (SCHEME_OBJECT extension, SCHEME_OBJECT block, long offset)),
   EXFUN (compiled_entry_type, (SCHEME_OBJECT entry, long *buffer)),
   EXFUN (declare_compiled_code, (SCHEME_OBJECT block));
+
+/* Breakpoint stuff. */
+
+extern SCHEME_OBJECT EXFUN (bkpt_install, (PTR));
+extern SCHEME_OBJECT EXFUN (bkpt_closure_install, (PTR));
+extern Boolean EXFUN (bkpt_p, (PTR));
+extern SCHEME_OBJECT EXFUN (bkpt_proceed, (PTR, SCHEME_OBJECT, SCHEME_OBJECT));
+extern void EXFUN (bkpt_remove, (PTR, SCHEME_OBJECT));
 
 SCHEME_OBJECT
 #ifndef WINNT
@@ -3330,6 +3587,23 @@ DEFUN (apply_compiled_from_primitive, (arity), int arity)
   /*NOTREACHED*/
 }
 
+SCHEME_OBJECT
+DEFUN (compiled_with_interrupt_mask, (old_mask, receiver, new_mask),
+       unsigned long old_mask
+       AND SCHEME_OBJECT receiver
+       AND unsigned long new_mask)
+{
+  signal_error_from_primitive (ERR_INAPPLICABLE_CONTINUATION);
+  /*NOTREACHED*/
+}
+
+SCHEME_OBJECT
+DEFUN (compiled_with_stack_marker, (thunk), SCHEME_OBJECT thunk)
+{
+  signal_error_from_primitive (ERR_INAPPLICABLE_CONTINUATION);
+  /*NOTREACHED*/
+}
+
 /* Bad entry points. */
 
 long
@@ -3360,7 +3634,7 @@ DEFUN (extract_uuo_link,
   Microcode_Termination (TERM_COMPILER_DEATH);
   /*NOTREACHED*/
 }
-
+
 void
 DEFUN (store_variable_cache,
        (extension, block, offset),
@@ -3380,7 +3654,7 @@ DEFUN (extract_variable_cache,
   Microcode_Termination (TERM_COMPILER_DEATH);
   /*NOTREACHED*/
 }
-
+
 SCHEME_OBJECT
 DEFUN (compiled_block_debugging_info,
        (block),
@@ -3560,11 +3834,44 @@ DEFUN (pc_to_builtin_index, (pc), unsigned long pc)
 {
   return (-1);
 }
+
+SCHEME_OBJECT
+DEFUN (bkpt_install, (ep), PTR ep)
+{
+  return (SHARP_F);
+}
+
+SCHEME_OBJECT
+DEFUN (bkpt_closure_install, (ep), PTR ep)
+{
+  return (SHARP_F);
+}
+
+void
+DEFUN (bkpt_remove, (ep, handle), PTR ep AND SCHEME_OBJECT handle)
+{
+  error_external_return ();
+}
+
+Boolean
+DEFUN (bkpt_p, (ep), PTR ep)
+{
+  return (SHARP_F);
+}
+
+SCHEME_OBJECT
+DEFUN (bkpt_proceed, (ep, handle, state), 
+       PTR ep AND SCHEME_OBJECT handle AND SCHEME_OBJECT state)
+{
+  error_external_return ();
+}
+
 #endif	/* HAS_COMPILER_SUPPORT */
 
 #ifdef WINNT
 #include "ntscmlib.h"
 
+extern unsigned long * winnt_catatonia_block;
 extern void EXFUN (winnt_allocate_registers, (void));
 extern void EXFUN (winnt_allocate_registers, (void));
 
@@ -3574,14 +3881,16 @@ extern void EXFUN (winnt_allocate_registers, (void));
 
 typedef struct register_storage
 {
-  /* The following two must be allocated consecutively */
+  /* The following must be allocated consecutively */
+  unsigned long catatonia_block[3];
 #if (COMPILER_PROCESSOR_TYPE == COMPILER_I386_TYPE)
   void * Regstart[32];	/* Negative byte offsets from &Registers[0] */
 #endif
   SCHEME_OBJECT Registers [REGBLOCK_LENGTH];
 } REGMEM;
 
-SCHEME_OBJECT * RegistersPtr = 0;
+SCHEME_OBJECT * RegistersPtr = ((SCHEME_OBJECT *) NULL);
+unsigned long * winnt_catatonia_block = ((unsigned long *) NULL);
 static REGMEM regmem;
 
 void
@@ -3589,6 +3898,7 @@ DEFUN_VOID (winnt_allocate_registers)
 {
   REGMEM * mem = & regmem;
 
+  winnt_catatonia_block = ((unsigned long *) &mem->catatonia_block[0]);
   RegistersPtr = mem->Registers;
   if (! (win32_lock_memory_area (mem, (sizeof (REGMEM)))))
   {
diff --git a/v8/src/microcode/const.h b/v8/src/microcode/const.h
index 77e697256..5bbd6c6ae 100644
--- a/v8/src/microcode/const.h
+++ b/v8/src/microcode/const.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: const.h,v 9.42 1993/06/09 20:28:27 jawilson Exp $
+$Id: const.h,v 9.43 1993/09/11 02:45:52 gjr Exp $
 
 Copyright (c) 1987-1993 Massachusetts Institute of Technology
 
@@ -178,7 +178,9 @@ MIT in each case. */
 #define REGBLOCK_CLOSURE_SPACE		10	/* For use by compiler */
 #define REGBLOCK_STACK_GUARD		11
 #define REGBLOCK_INT_CODE		12
-#define REGBLOCK_MINIMUM_LENGTH		13
+#define REGBLOCK_REFLECT_TO_INTERFACE	13	/* For use by compiler */
+
+#define REGBLOCK_MINIMUM_LENGTH		14
 
 /* Codes specifying how to start scheme at boot time. */
 
diff --git a/v8/src/microcode/fixobj.h b/v8/src/microcode/fixobj.h
index 682c200af..8c282ad83 100644
--- a/v8/src/microcode/fixobj.h
+++ b/v8/src/microcode/fixobj.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: fixobj.h,v 9.34 1993/08/28 22:46:36 gjr Exp $
+$Id: fixobj.h,v 9.35 1993/09/11 02:45:53 gjr Exp $
 
 Copyright (c) 1987-1993 Massachusetts Institute of Technology
 
@@ -124,6 +124,6 @@ MIT in each case. */
 #define PC_Sample_Prob_Comp_Table	0x3D /* Sure looked compiled ?! */
 #define PC_Sample_UFO_Table		0x3E /* Invalid ENV at sample time  */
 
+#define COMPILED_CODE_BKPT_HANDLER	0x3F
 
-
-#define NFixed_Objects			0x3F
+#define NFixed_Objects			0x40
diff --git a/v8/src/microcode/utabmd.scm b/v8/src/microcode/utabmd.scm
index 80f5c5b9a..2d6a1ecff 100644
--- a/v8/src/microcode/utabmd.scm
+++ b/v8/src/microcode/utabmd.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: utabmd.scm,v 9.70 1993/08/28 21:17:23 gjr Exp $
+;;; $Id: utabmd.scm,v 9.71 1993/09/11 02:45:59 gjr Exp $
 ;;;
 ;;;	Copyright (c) 1987-1993 Massachusetts Institute of Technology
 ;;;
@@ -120,6 +120,7 @@
 	       PC-Sample/Interp-Proc-Buffer		;3C
 	       PC-Sample/Prob-Comp-Table		;3D
 	       PC-Sample/UFO-Table			;3E
+	       COMPILED-CODE-BKPT-HANDLER		;3F
 	       ))
 
 ;;; [] Types
@@ -714,4 +715,4 @@
 
 ;;; This identification string is saved by the system.
 
-"$Id: utabmd.scm,v 9.70 1993/08/28 21:17:23 gjr Exp $"
\ No newline at end of file
+"$Id: utabmd.scm,v 9.71 1993/09/11 02:45:59 gjr Exp $"
\ No newline at end of file
-- 
2.25.1