From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Wed, 31 May 1989 01:51:15 +0000 (+0000)
Subject: Make unsafe primitives back out of compiled code so that they don't
X-Git-Tag: 20090517-FFI~12033
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=cef3274e344af69c9b6001a2814657856552c7c9;p=mit-scheme.git

Make unsafe primitives back out of compiled code so that they don't
have to be treated specially by the compiler or the compiled code
interface.  This allows UUO linking of primitives, and applying
primitives from compiled code without going to the interpreter.

"Unsafe" primitives must use the new macro
PRIMITIVE_CANONICALIZE_CONTEXT before they start manipulating the
interpreter's state.

This macro will allow them to proceed if they have been invoked from
the interpreter, or will cause them to back into the interpreter and
restart if they have been invoked from compiled code.
---

diff --git a/v7/src/microcode/bchmmg.c b/v7/src/microcode/bchmmg.c
index 3e02a3603..f2239003b 100644
--- a/v7/src/microcode/bchmmg.c
+++ b/v7/src/microcode/bchmmg.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchmmg.c,v 9.43 1989/03/27 23:13:56 jinx Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchmmg.c,v 9.44 1989/05/31 01:49:41 jinx Exp $ */
 
 /* Memory management top level.  Garbage collection to disk.
 
@@ -856,6 +856,7 @@ DEFINE_PRIMITIVE ("GARBAGE-COLLECT", Prim_garbage_collect, 1, 1, 0)
   Pointer GC_Daemon_Proc;
   Primitive_1_Arg();
 
+  PRIMITIVE_CANONICALIZE_CONTEXT();
   Arg_1_Type(TC_FIXNUM);
   if (Free > Heap_Top)
   {
diff --git a/v7/src/microcode/bchpur.c b/v7/src/microcode/bchpur.c
index b36b2489b..ae0ded48c 100644
--- a/v7/src/microcode/bchpur.c
+++ b/v7/src/microcode/bchpur.c
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchpur.c,v 9.42 1989/03/27 23:14:03 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchpur.c,v 9.43 1989/05/31 01:49:47 jinx Exp $
 
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -490,6 +490,7 @@ DEFINE_PRIMITIVE ("PRIMITIVE-PURIFY", Prim_primitive_purify, 3, 3, 0)
   Pointer result;
   Primitive_3_Args();
 
+  PRIMITIVE_CANONICALIZE_CONTEXT();
   if ((Arg2 != SHARP_T) && (Arg2 != SHARP_F))
     Primitive_Error(ERR_ARG_2_WRONG_TYPE);
   Arg_3_Type(TC_FIXNUM);
diff --git a/v7/src/microcode/const.h b/v7/src/microcode/const.h
index 5bb3c9f7b..157d9a8e1 100644
--- a/v7/src/microcode/const.h
+++ b/v7/src/microcode/const.h
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/const.h,v 9.31 1989/05/24 05:32:23 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/const.h,v 9.32 1989/05/31 01:49:52 jinx Exp $
  *
  * Named constants used throughout the interpreter
  *
@@ -121,6 +121,7 @@ MIT in each case. */
 #define PRIM_POP_RETURN			-7
 #define PRIM_TOUCH			-8
 #define PRIM_APPLY_INTERRUPT		-9
+#define PRIM_REENTER			-10
 
 #define ABORT_NAME_TABLE						\
 {									\
@@ -132,7 +133,8 @@ MIT in each case. */
   /* -6 */	"NO-TRAP_APPLY",					\
   /* -7 */	"POP-RETURN",						\
   /* -8 */	"TOUCH",						\
-  /* -9 */	"APPLY-INTERRUPT"					\
+  /* -9 */	"APPLY-INTERRUPT",					\
+  /* -10 */	"REENTER"						\
 }
 
 /* Some numbers of parameters which mean something special */
diff --git a/v7/src/microcode/dmpwrld.c b/v7/src/microcode/dmpwrld.c
index d9bcdbca1..2e5a9e0c4 100644
--- a/v7/src/microcode/dmpwrld.c
+++ b/v7/src/microcode/dmpwrld.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dmpwrld.c,v 9.28 1988/10/21 00:12:33 cph Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dmpwrld.c,v 9.29 1989/05/31 01:49:57 jinx Rel $
  *
  * This file contains a primitive to dump an executable version of Scheme.
  * It uses unexec.c from GNU Emacs.
@@ -189,6 +189,7 @@ DEFINE_PRIMITIVE ("DUMP-WORLD", Prim_dump_world, 1, 1, 0)
   long Buflen;
   Primitive_1_Arg();
 
+  PRIMITIVE_CANONICALIZE_CONTEXT();
   Arg_1_Type(TC_CHARACTER_STRING);
 
   if (there_are_open_files())
diff --git a/v7/src/microcode/fasload.c b/v7/src/microcode/fasload.c
index f083f47bc..0f86618ce 100644
--- a/v7/src/microcode/fasload.c
+++ b/v7/src/microcode/fasload.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasload.c,v 9.39 1989/03/27 23:14:58 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasload.c,v 9.40 1989/05/31 01:50:02 jinx Exp $
 
    The "fast loader" which reads in and relocates binary files and then
    interns symbols.  It is called with one argument: the (character
@@ -737,6 +737,7 @@ DEFINE_PRIMITIVE ("LOAD-BAND", Prim_band_load, 1, 1, 0)
   Boolean load_file_failed;
   Primitive_1_Arg();
 
+  PRIMITIVE_CANONICALIZE_CONTEXT();
   saved_free = Free;
   Free = Heap_Bottom;
   saved_memtop = MemTop;
diff --git a/v7/src/microcode/fhooks.c b/v7/src/microcode/fhooks.c
index e344ef35e..967514104 100644
--- a/v7/src/microcode/fhooks.c
+++ b/v7/src/microcode/fhooks.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/fhooks.c,v 9.29 1988/09/29 04:58:22 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/fhooks.c,v 9.30 1989/05/31 01:50:09 jinx Rel $
  *
  * This file contains hooks and handles for the new fluid bindings
  * scheme for multiprocessors.
@@ -78,6 +78,7 @@ DEFINE_PRIMITIVE ("WITH-SAVED-FLUID-BINDINGS", Prim_with_saved_fluid_bindings, 1
 {
   Primitive_1_Arg();
 
+  PRIMITIVE_CANONICALIZE_CONTEXT();
   Pop_Primitive_Frame(1);
 
   /* Save previous fluid bindings for later restore */
@@ -90,6 +91,7 @@ DEFINE_PRIMITIVE ("WITH-SAVED-FLUID-BINDINGS", Prim_with_saved_fluid_bindings, 1
   Push(STACK_FRAME_HEADER);
  Pushed();
   PRIMITIVE_ABORT(PRIM_APPLY);
+  /*NOTREACHED*/
 }
 
 /* Utilities for the primitives below. */
diff --git a/v7/src/microcode/futures.h b/v7/src/microcode/futures.h
index 38c036fa2..b4ed70852 100644
--- a/v7/src/microcode/futures.h
+++ b/v7/src/microcode/futures.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/futures.h,v 9.24 1988/08/15 20:47:48 cph Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/futures.h,v 9.25 1989/05/31 01:50:14 jinx Rel $
  *
  * This file contains macros useful for dealing with futures
  */
@@ -124,6 +124,9 @@ MIT in each case. */
    ASSUMPTION: The SYMBOL slot of a VARIABLE does NOT contain a future, nor
    do the cached lexical address slots.
 
+   ASSUMPTION: Environment structure, which is created only by the
+   interpreter, never contains FUTUREs on its spine.
+
    ASSUMPTION: History objects are never created using futures.
 
    ASSUMPTION: State points, which are created only by the interpreter,
diff --git a/v7/src/microcode/hooks.c b/v7/src/microcode/hooks.c
index 69f0de265..58e5e4a08 100644
--- a/v7/src/microcode/hooks.c
+++ b/v7/src/microcode/hooks.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/hooks.c,v 9.35 1989/03/27 23:15:12 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/hooks.c,v 9.36 1989/05/31 01:50:19 jinx Rel $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -51,7 +51,7 @@ DEFINE_PRIMITIVE ("APPLY", Prim_apply, 2, 2, 0)
 {
   fast Pointer scan_list, *scan_stack;
   fast long number_of_args, i;
-#ifdef butterfly
+#ifdef PARALLEL_PROCESSOR
   Pointer *saved_stack_pointer;
 #endif
   Primitive_2_Args();
@@ -67,11 +67,13 @@ DEFINE_PRIMITIVE ("APPLY", Prim_apply, 2, 2, 0)
      list into a linear (vector-like) form, so as to avoid the
      overhead of traversing the list twice.  Unfortunately, the
      overhead of maintaining this other form (e.g. PRIMITIVE_GC_If_Needed)
-     is sufficiently high that it probably makes up for the time saved. */
+     is sufficiently high that it probably makes up for the time saved.
+   */
 
+  PRIMITIVE_CANONICALIZE_CONTEXT();
   Touch_In_Primitive( Arg2, scan_list);
   number_of_args = 0;
-  while (Type_Code( scan_list) == TC_LIST)
+  while (OBJECT_TYPE( scan_list) == TC_LIST)
   {
     number_of_args += 1;
     Touch_In_Primitive( Vector_Ref( scan_list, CONS_CDR), scan_list);
@@ -90,7 +92,7 @@ DEFINE_PRIMITIVE ("APPLY", Prim_apply, 2, 2, 0)
   Pop_Primitive_Frame( 2);
 
  Will_Push( (number_of_args + STACK_ENV_EXTRA_SLOTS + 1));
-#ifdef butterfly
+#ifdef PARALLEL_PROCESSOR
   saved_stack_pointer = Stack_Pointer;
 #endif
   scan_stack = Simulate_Pushing (number_of_args);
@@ -99,9 +101,9 @@ DEFINE_PRIMITIVE ("APPLY", Prim_apply, 2, 2, 0)
   Touch_In_Primitive (Arg2, scan_list);
   while (i > 0)
   {
-#ifdef butterfly
+#ifdef PARALLEL_PROCESSOR
     /* Check for abominable case of someone bashing the arg list. */
-    if (Type_Code( scan_list) != TC_LIST)
+    if (OBJECT_TYPE( scan_list) != TC_LIST)
     {
       Stack_Pointer = saved_stack_pointer;
       signal_error_from_primitive (ERR_ARG_2_BAD_RANGE);
@@ -239,6 +241,7 @@ DEFINE_PRIMITIVE ("CALL-WITH-CURRENT-CONTINUATION", Prim_catch, 1, 1, 0)
   Pointer Control_Point;
   Primitive_1_Arg ();
 
+  PRIMITIVE_CANONICALIZE_CONTEXT();
   CWCC (RC_RESTORE_HISTORY);
   Vector_Set (Control_Point, STACKLET_REUSE_FLAG, NIL);
   PRIMITIVE_ABORT (PRIM_APPLY);
@@ -250,6 +253,8 @@ DEFINE_PRIMITIVE ("NON-REENTRANT-CALL-WITH-CURRENT-CONTINUATION", Prim_non_reent
   Pointer Control_Point;
   Primitive_1_Arg ();
 
+  PRIMITIVE_CANONICALIZE_CONTEXT();
+
 #ifdef USE_STACKLETS
 
   CWCC (RC_RESTORE_DONT_COPY_HISTORY);
@@ -305,6 +310,7 @@ DEFINE_PRIMITIVE ("ERROR-PROCEDURE", Prim_error_procedure, 3, 3, 0)
 {
   Primitive_3_Args();
 
+  PRIMITIVE_CANONICALIZE_CONTEXT();
   /*
     This is done outside the Will_Push because the space for it
     is guaranteed by the interpreter before it gets here.
@@ -364,6 +370,7 @@ DEFINE_PRIMITIVE ("FORCE", Prim_force, 1, 1, 0)
     case FIXNUM_ZERO:
       {
 	/* New-style thunk used by compiled code. */
+	PRIMITIVE_CANONICALIZE_CONTEXT();
 	Pop_Primitive_Frame (1);
        Will_Push (CONTINUATION_SIZE + STACK_ENV_EXTRA_SLOTS + 1);
 	Store_Return (RC_SNAP_NEED_THUNK);
@@ -379,6 +386,7 @@ DEFINE_PRIMITIVE ("FORCE", Prim_force, 1, 1, 0)
     default:
       {
 	/* Old-style thunk used by interpreted code. */
+	PRIMITIVE_CANONICALIZE_CONTEXT();
 	Pop_Primitive_Frame (1);
        Will_Push (CONTINUATION_SIZE);
 	Store_Return (RC_SNAP_NEED_THUNK);
@@ -405,6 +413,7 @@ DEFINE_PRIMITIVE ("EXECUTE-AT-NEW-STATE-POINT", Prim_execute_at_new_point, 4, 4,
   Pointer New_Point, Old_Point;
   Primitive_4_Args();
 
+  PRIMITIVE_CANONICALIZE_CONTEXT();
   guarantee_state_point();
   if (Arg1 == NIL)
     Old_Point = Current_State_Point;
@@ -542,7 +551,8 @@ DEFINE_PRIMITIVE ("SCODE-EVAL", Prim_scode_eval, 2, 2, 0)
 {
   Primitive_2_Args();
 
-  if (Type_Code(Arg2) != GLOBAL_ENV)
+  PRIMITIVE_CANONICALIZE_CONTEXT();
+  if (OBJECT_TYPE(Arg2) != GLOBAL_ENV)
     Arg_2_Type(TC_ENVIRONMENT);
   Pop_Primitive_Frame(2);
   Store_Env(Arg2);
@@ -625,6 +635,7 @@ DEFINE_PRIMITIVE ("SET-CURRENT-HISTORY!", Prim_set_current_history, 1, 1, 0)
 {
   Primitive_1_Arg();
 
+  PRIMITIVE_CANONICALIZE_CONTEXT();
   if (!(HUNK3_P(Arg1)))
     error_wrong_type_arg (1);
 
@@ -679,6 +690,7 @@ DEFINE_PRIMITIVE ("TRANSLATE-TO-STATE-POINT", Prim_translate_to_point, 1, 1, 0)
 {
   Primitive_1_Arg();
 
+  PRIMITIVE_CANONICALIZE_CONTEXT();
   Arg_1_Type(TC_VECTOR);
   if (Vector_Ref(Arg1, STATE_POINT_TAG) != Get_Fixed_Obj_Slot(State_Point_Tag))
     signal_error_from_primitive(ERR_ARG_1_WRONG_TYPE);
@@ -701,6 +713,7 @@ DEFINE_PRIMITIVE ("WITH-HISTORY-DISABLED", Prim_with_history_disabled, 1, 1, 0)
   Pointer *First_Rib, *Rib, *Second_Rib;
   Primitive_1_Arg();
 
+  PRIMITIVE_CANONICALIZE_CONTEXT();
   /* Remove one reduction from the history before saving it */
   First_Rib = Get_Pointer(History[HIST_RIB]);
   Second_Rib = Get_Pointer(First_Rib[RIB_NEXT_REDUCTION]);
@@ -734,6 +747,7 @@ DEFINE_PRIMITIVE ("WITH-INTERRUPT-MASK", Prim_with_interrupt_mask, 2, 2, 0)
   Pointer mask;
   Primitive_2_Args();
 
+  PRIMITIVE_CANONICALIZE_CONTEXT();
   Arg_1_Type(TC_FIXNUM);
   Pop_Primitive_Frame(2);
   mask = MAKE_SIGNED_FIXNUM(FETCH_INTERRUPT_MASK());
@@ -759,6 +773,7 @@ DEFINE_PRIMITIVE ("WITH-INTERRUPTS-REDUCED", Prim_with_interrupts_reduced, 2, 2,
   long new_interrupt_mask, old_interrupt_mask;
   Primitive_2_Args();
 
+  PRIMITIVE_CANONICALIZE_CONTEXT();
   Arg_1_Type(TC_FIXNUM);
   Pop_Primitive_Frame(2);
   mask = MAKE_SIGNED_FIXNUM(FETCH_INTERRUPT_MASK());
@@ -795,6 +810,7 @@ DEFINE_PRIMITIVE ("WITHIN-CONTROL-POINT", Prim_within_control_point, 2, 2, 0)
 {
   Primitive_2_Args();
 
+  PRIMITIVE_CANONICALIZE_CONTEXT();
   Arg_1_Type(TC_CONTROL_POINT);
   Our_Throw(false, Arg1);
   Within_Stacklet_Backout();
diff --git a/v7/src/microcode/intercom.c b/v7/src/microcode/intercom.c
index 26d80cada..2436b9df9 100644
--- a/v7/src/microcode/intercom.c
+++ b/v7/src/microcode/intercom.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/intercom.c,v 9.25 1988/08/15 20:49:47 cph Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/intercom.c,v 9.26 1989/05/31 01:50:26 jinx Rel $
  *
  * Single-processor simulation of locking, propagating, and
  * communicating stuff.
@@ -65,8 +65,9 @@ MIT in each case. */
 DEFINE_PRIMITIVE ("GLOBAL-INTERRUPT", Prim_send_global_interrupt, 3, 3, 0)
 {
   long Saved_Zone, Which_Level;
-  
   Primitive_3_Args();
+
+  PRIMITIVE_CANONICALIZE_CONTEXT();
   Arg_1_Type(TC_FIXNUM);
   Range_Check(Which_Level, Arg1, 0, 3, ERR_ARG_1_BAD_RANGE);
   Save_Time_Zone(Zone_Global_Int);
@@ -192,9 +193,11 @@ DEFINE_PRIMITIVE ("PEEK-AT-WORK-QUEUE", Prim_peek_queue, 0, 0, 0)
 DEFINE_PRIMITIVE ("GET-WORK", Prim_get_work, 1, 1, 0)
 {
   Pointer Get_Work();
+  Pointer result;
   Primitive_1_Arg();
 
-  PRIMITIVE_RETURN(Get_Work(Arg1));
+  result = Get_Work(Arg1);
+  PRIMITIVE_RETURN(result);
 }
 
 Pointer Get_Work(Arg1)
@@ -203,13 +206,14 @@ Pointer Get_Work(Arg1)
   Pointer The_Queue, Queue_Head, Result, The_Prim;
 
   /* This gets this primitive's code which is in the expression register. */
-  The_Prim = Fetch_Expression();
+  The_Prim = Regs[REGBLOCK_PRIMITIVE];
   The_Queue = Get_Fixed_Obj_Slot(The_Work_Queue);
   if (The_Queue != NIL)
   {
     Queue_Head = Vector_Ref(The_Queue, CONS_CAR);
   }
   if ((The_Queue == NIL) || (Queue_Head == NIL))
+  {
     if (Arg1 == NIL)
     {
       printf("\nNo work available, but some has been requested!\n");
@@ -217,6 +221,7 @@ Pointer Get_Work(Arg1)
     }
     else
     {
+      PRIMITIVE_CANONICALIZE_CONTEXT();
       Pop_Primitive_Frame(1);
      Will_Push(2 * (STACK_ENV_EXTRA_SLOTS + 1) + 1 + CONTINUATION_SIZE);
       Push(NIL);	/* Upon return, no hope if there is no work */
@@ -229,6 +234,7 @@ Pointer Get_Work(Arg1)
       Push(STACK_FRAME_HEADER);
      Pushed();
       PRIMITIVE_ABORT(PRIM_APPLY);
+    }
   }
   Result = Vector_Ref(Queue_Head, CONS_CAR);
   Queue_Head = Vector_Ref(Queue_Head, CONS_CDR);
@@ -337,6 +343,7 @@ DEFINE_PRIMITIVE ("MASTER-GC-LOOP", Prim_master_gc, 1, 1, 0)
   extern Pointer make_primitive();
   Primitive_1_Arg();
 
+  PRIMITIVE_CANONICALIZE_CONTEXT();
   if (gc_prim == NIL)
   {
     gc_prim = make_primitive("GARBAGE-COLLECT");
diff --git a/v7/src/microcode/interp.c b/v7/src/microcode/interp.c
index 50f88d54f..c4fe6dd87 100644
--- a/v7/src/microcode/interp.c
+++ b/v7/src/microcode/interp.c
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/interp.c,v 9.49 1989/03/28 20:39:19 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/interp.c,v 9.50 1989/05/31 01:50:31 jinx Exp $
  *
  * This file contains the heart of the Scheme Scode
  * interpreter
@@ -454,6 +454,12 @@ Repeat_Dispatch:
       PROCEED_AFTER_PRIMITIVE();
     case CODE_MAP(PRIM_POP_RETURN):
       goto Pop_Return;
+
+    case PRIM_REENTER:
+      BACK_OUT_AFTER_PRIMITIVE();
+      LOG_FUTURES();
+    case CODE_MAP(PRIM_REENTER):
+      goto Perform_Application;
 
     case PRIM_TOUCH:
     {
@@ -463,9 +469,8 @@ Repeat_Dispatch:
       BACK_OUT_AFTER_PRIMITIVE();
       Val = temp;
       LOG_FUTURES();
-      /* fall through */
     }
-
+    /* fall through */
     case CODE_MAP(PRIM_TOUCH):
       TOUCH_SETUP(Val);
       goto Internal_Apply;
diff --git a/v7/src/microcode/lookup.h b/v7/src/microcode/lookup.h
index 33bf6e126..d20bc9d85 100644
--- a/v7/src/microcode/lookup.h
+++ b/v7/src/microcode/lookup.h
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/lookup.h,v 9.41 1988/09/29 05:02:21 jinx Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/lookup.h,v 9.42 1989/05/31 01:50:41 jinx Rel $ */
 
 /* Macros and declarations for the variable lookup code. */
 
@@ -268,6 +268,14 @@ label:									\
 
 extern long extend_frame();
 
+/* Definition recaches eagerly by default. */
+
+#ifndef DEFINITION_RECACHES_LAZILY
+#ifndef DEFINITION_RECACHES_EAGERLY
+#define DEFINITION_RECACHES_EAGERLY
+#endif
+#endif
+
 #ifndef DEFINITION_RECACHES_EAGERLY
 
 extern long compiler_uncache();
diff --git a/v7/src/microcode/memmag.c b/v7/src/microcode/memmag.c
index d28c7b160..e8496571d 100644
--- a/v7/src/microcode/memmag.c
+++ b/v7/src/microcode/memmag.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/memmag.c,v 9.36 1989/03/27 23:15:41 jinx Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/memmag.c,v 9.37 1989/05/31 01:50:46 jinx Exp $ */
 
 /* Memory management top level.
 
@@ -383,6 +383,7 @@ DEFINE_PRIMITIVE ("GARBAGE-COLLECT", Prim_garbage_collect, 1, 1, 0)
   Pointer GC_Daemon_Proc;
   Primitive_1_Arg();
 
+  PRIMITIVE_CANONICALIZE_CONTEXT();
   Arg_1_Type(TC_FIXNUM);
   if (Free > Heap_Top)
   {
diff --git a/v7/src/microcode/prims.h b/v7/src/microcode/prims.h
index 61974b17c..805974319 100644
--- a/v7/src/microcode/prims.h
+++ b/v7/src/microcode/prims.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1987 Massachusetts Institute of Technology
+Copyright (c) 1987, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prims.h,v 9.33 1988/08/15 20:53:04 cph Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prims.h,v 9.34 1989/05/31 01:50:51 jinx Rel $ */
 
 /* This file contains some macros for defining primitives,
    for argument type or value checking, and for accessing
@@ -66,6 +66,13 @@ Pointer fn_name ()
 #define PRIMITIVE_RETURN(value)	return (value)
 
 #define PRIMITIVE_ABORT(action)	longjmp(*Back_To_Eval, (action))
+
+extern void canonicalize_primitive_context();
+
+#define PRIMITIVE_CANONICALIZE_CONTEXT()				\
+{									\
+  canonicalize_primitive_context();					\
+}
 
 /* Preambles for primitive procedures.  These store the arguments into
  * local variables for fast access.
diff --git a/v7/src/microcode/purify.c b/v7/src/microcode/purify.c
index 22ef48cd3..bbd2717bb 100644
--- a/v7/src/microcode/purify.c
+++ b/v7/src/microcode/purify.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/purify.c,v 9.37 1989/03/27 23:15:46 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/purify.c,v 9.38 1989/05/31 01:50:57 jinx Exp $
  *
  * This file contains the code that copies objects into pure
  * and constant space.
@@ -504,6 +504,7 @@ DEFINE_PRIMITIVE ("PRIMITIVE-PURIFY", Prim_primitive_purify, 3, 3, 0)
   Pointer Object, Lost_Objects, Purify_Result, Daemon;
   Primitive_3_Args();
 
+  PRIMITIVE_CANONICALIZE_CONTEXT();
   Save_Time_Zone(Zone_Purify);
   if ((Arg2 != SHARP_T) && (Arg2 != NIL))
     Primitive_Error(ERR_ARG_2_WRONG_TYPE);
diff --git a/v7/src/microcode/step.c b/v7/src/microcode/step.c
index 0e473da47..b4a5e027d 100644
--- a/v7/src/microcode/step.c
+++ b/v7/src/microcode/step.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/step.c,v 9.25 1988/08/15 20:55:24 cph Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/step.c,v 9.26 1989/05/31 01:51:02 jinx Rel $
  *
  * Support for the stepper
  */
@@ -85,6 +85,7 @@ DEFINE_PRIMITIVE ("PRIMITIVE-EVAL-STEP", Prim_eval_step, 3, 3, 0)
 {
   Primitive_3_Args();
 
+  PRIMITIVE_CANONICALIZE_CONTEXT();
   Install_Traps(Arg3, false);
   Pop_Primitive_Frame(3);
   Store_Expression(Arg1);
@@ -109,6 +110,7 @@ DEFINE_PRIMITIVE ("PRIMITIVE-APPLY-STEP", Prim_apply_step, 3, 3, 0)
   long Number_Of_Args, i;
   Primitive_3_Args();
 
+  PRIMITIVE_CANONICALIZE_CONTEXT();
   Arg_3_Type(TC_HUNK3);
   Number_Of_Args = 0;
   Next_From_Slot = Arg2;
diff --git a/v7/src/microcode/utils.c b/v7/src/microcode/utils.c
index 0eeb76455..f2df22854 100644
--- a/v7/src/microcode/utils.c
+++ b/v7/src/microcode/utils.c
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utils.c,v 9.41 1989/05/24 15:11:28 jinx Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utils.c,v 9.42 1989/05/31 01:51:07 jinx Rel $ */
 
 /* This file contains utilities for interrupts, errors, etc. */
 
@@ -212,6 +212,41 @@ Back_Out_Of_Primitive ()
   return;
 }
 
+/*
+  canonicalize_primitive_context should be used by "unsafe" primitives
+  to guarantee that their execution context is the expected one, ie.
+  they are called from the interpreter.
+  If they are called from compiled code, they should abort to the
+  interpreter and reenter.
+  Note: This is called only from the macro PRIMITIVE_CANONICALIZE_CONTEXT,
+  so that the work can be divided between them if it is an issue.
+ */
+
+extern void canonicalize_primitive_context();
+
+void
+canonicalize_primitive_context()
+{
+  long nargs;
+  Pointer primitive;
+
+  primitive = Regs[REGBLOCK_PRIMITIVE];
+  if (OBJECT_TYPE(primitive) != TC_PRIMITIVE)
+  {
+    fprintf(stderr,
+	    "\ncanonicalize_primitive_context invoked when not in primitive!\n");
+    Microcode_Termination(TERM_BAD_BACK_OUT);
+  }
+  nargs = PRIMITIVE_N_ARGUMENTS(primitive);
+  if ((OBJECT_TYPE(Stack_Ref(nargs))) != TC_COMPILED_ENTRY)
+  {
+    return;
+  }
+  /* The primitive has been invoked from compiled code. */
+  PRIMITIVE_ABORT(PRIM_REENTER);
+  /*NOTREACHED*/
+}
+
 /* Useful error procedures */
 
 /* Note that backing out of the primitives happens after aborting,
@@ -933,6 +968,12 @@ Find_State_Space (State_Point)
 	 at the root, indicating that the microcode variable rather
 	 than the state space contains the current state space
 	 location.
+
+   NOTE: This procedure is invoked both by primitives and the interpreter
+   itself.  As such, it is using the pun that PRIMITIVE_ABORT is just a
+   (non-local) return to the interpreter.  This should be cleaned up.
+   NOTE: Any primitive that invokes this procedure must do a
+   PRIMITIVE_CANONICALIZE_CONTEXT() first!
 */
 
 void
@@ -1030,7 +1071,11 @@ Pointer
 Compiler_Get_Fixed_Objects()
 {
   if (Valid_Fixed_Obj_Vector())
+  {
     return (Get_Fixed_Obj_Slot(Me_Myself));
+  }
   else
+  {
     return (NIL);
+  }
 }
diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h
index 3f7545437..535b4494b 100644
--- a/v7/src/microcode/version.h
+++ b/v7/src/microcode/version.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.78 1989/05/26 20:22:19 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.79 1989/05/31 01:51:15 jinx Exp $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -46,7 +46,7 @@ MIT in each case. */
 #define VERSION		10
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION	78
+#define SUBVERSION	79
 #endif
 
 #ifndef UCODE_TABLES_FILENAME
diff --git a/v8/src/microcode/const.h b/v8/src/microcode/const.h
index 64a9de960..16e7b628f 100644
--- a/v8/src/microcode/const.h
+++ b/v8/src/microcode/const.h
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/const.h,v 9.31 1989/05/24 05:32:23 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/const.h,v 9.32 1989/05/31 01:49:52 jinx Exp $
  *
  * Named constants used throughout the interpreter
  *
@@ -121,6 +121,7 @@ MIT in each case. */
 #define PRIM_POP_RETURN			-7
 #define PRIM_TOUCH			-8
 #define PRIM_APPLY_INTERRUPT		-9
+#define PRIM_REENTER			-10
 
 #define ABORT_NAME_TABLE						\
 {									\
@@ -132,7 +133,8 @@ MIT in each case. */
   /* -6 */	"NO-TRAP_APPLY",					\
   /* -7 */	"POP-RETURN",						\
   /* -8 */	"TOUCH",						\
-  /* -9 */	"APPLY-INTERRUPT"					\
+  /* -9 */	"APPLY-INTERRUPT",					\
+  /* -10 */	"REENTER"						\
 }
 
 /* Some numbers of parameters which mean something special */
diff --git a/v8/src/microcode/interp.c b/v8/src/microcode/interp.c
index 3a87abd22..f9eab214a 100644
--- a/v8/src/microcode/interp.c
+++ b/v8/src/microcode/interp.c
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/interp.c,v 9.49 1989/03/28 20:39:19 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/interp.c,v 9.50 1989/05/31 01:50:31 jinx Exp $
  *
  * This file contains the heart of the Scheme Scode
  * interpreter
@@ -454,6 +454,12 @@ Repeat_Dispatch:
       PROCEED_AFTER_PRIMITIVE();
     case CODE_MAP(PRIM_POP_RETURN):
       goto Pop_Return;
+
+    case PRIM_REENTER:
+      BACK_OUT_AFTER_PRIMITIVE();
+      LOG_FUTURES();
+    case CODE_MAP(PRIM_REENTER):
+      goto Perform_Application;
 
     case PRIM_TOUCH:
     {
@@ -463,9 +469,8 @@ Repeat_Dispatch:
       BACK_OUT_AFTER_PRIMITIVE();
       Val = temp;
       LOG_FUTURES();
-      /* fall through */
     }
-
+    /* fall through */
     case CODE_MAP(PRIM_TOUCH):
       TOUCH_SETUP(Val);
       goto Internal_Apply;
diff --git a/v8/src/microcode/lookup.h b/v8/src/microcode/lookup.h
index 4d918aeaf..cc69294b9 100644
--- a/v8/src/microcode/lookup.h
+++ b/v8/src/microcode/lookup.h
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/lookup.h,v 9.41 1988/09/29 05:02:21 jinx Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/lookup.h,v 9.42 1989/05/31 01:50:41 jinx Rel $ */
 
 /* Macros and declarations for the variable lookup code. */
 
@@ -268,6 +268,14 @@ label:									\
 
 extern long extend_frame();
 
+/* Definition recaches eagerly by default. */
+
+#ifndef DEFINITION_RECACHES_LAZILY
+#ifndef DEFINITION_RECACHES_EAGERLY
+#define DEFINITION_RECACHES_EAGERLY
+#endif
+#endif
+
 #ifndef DEFINITION_RECACHES_EAGERLY
 
 extern long compiler_uncache();
diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h
index ee76d97f2..f4f076d02 100644
--- a/v8/src/microcode/version.h
+++ b/v8/src/microcode/version.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.78 1989/05/26 20:22:19 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.79 1989/05/31 01:51:15 jinx Exp $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -46,7 +46,7 @@ MIT in each case. */
 #define VERSION		10
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION	78
+#define SUBVERSION	79
 #endif
 
 #ifndef UCODE_TABLES_FILENAME