From 299e56be2d19b9e389dba71d0f82691d0055e164 Mon Sep 17 00:00:00 2001
From: "Guillermo J. Rozas" <edu/mit/csail/zurich/gjr>
Date: Thu, 8 Jun 1989 00:26:10 +0000
Subject: [PATCH] Add new flags to the microcode:

BAD_TYPES_INNOCUOUS
If a bad type is seen, the system treats it as a non-pointer for most
purposes.

BAD_TYPES_LETHAL
If a bad type is seen, kill Scheme with TERM_INVALID_TYPE_CODE.

The default is BAD_TYPES_LETHAL when there is no compiler support,
BAD_TYPES_INNOCUOUS when there is.
---
 v7/src/microcode/bchmmg.c  | 14 +++++---
 v7/src/microcode/bchpur.c  | 19 +++++-----
 v7/src/microcode/fasdump.c | 20 +++++------
 v7/src/microcode/gc.h      | 74 ++++++++++++++++++++++++++------------
 v7/src/microcode/gccode.h  | 40 ++++++++++++++++++---
 v7/src/microcode/gcloop.c  | 23 ++++++------
 v7/src/microcode/interp.c  | 47 ++++++++++++++++++------
 v7/src/microcode/memmag.c  | 41 ++++++++++++---------
 v7/src/microcode/purify.c  | 43 ++++++++++------------
 v7/src/microcode/purutl.c  | 35 +++++++++++-------
 v7/src/microcode/version.h |  4 +--
 v8/src/microcode/interp.c  | 47 ++++++++++++++++++------
 v8/src/microcode/version.h |  4 +--
 13 files changed, 265 insertions(+), 146 deletions(-)

diff --git a/v7/src/microcode/bchmmg.c b/v7/src/microcode/bchmmg.c
index f2239003b..156e16b13 100644
--- a/v7/src/microcode/bchmmg.c
+++ b/v7/src/microcode/bchmmg.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/Attic/bchmmg.c,v 9.44 1989/05/31 01:49:41 jinx Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchmmg.c,v 9.45 1989/06/08 00:23:58 jinx Rel $ */
 
 /* Memory management top level.  Garbage collection to disk.
 
@@ -660,7 +660,7 @@ Fix_Weak_Chain()
 	  continue;
 	}
 	/* Otherwise, it is a pointer.  Fall through */
-
+
       /* Normal pointer types, the broken heart is in the first word.
          Note that most special types are treated normally here.
 	 The BH code updates *Scan if the object has been relocated.
@@ -700,11 +700,17 @@ Fix_Weak_Chain()
 	continue;
 
       case GC_Undefined:
+	fprintf(stderr,
+		"\nFix_Weak_Chain: Clearing bad object 0x%08lx.\n",
+		Temp);
+	*Scan = SHARP_F;
+	continue;
+	
       default:			/* Non Marked Headers and Broken Hearts */
       fail:
         fprintf(stderr,
-		"\nFix_Weak_Chain: Bad Object: Type = 0x%02x; Datum = %x\n",
-		OBJECT_TYPE(Temp), OBJECT_DATUM(Temp));
+		"\nFix_Weak_Chain: Bad Object: 0x%08lx.\n",
+		Temp);
 	Microcode_Termination(TERM_INVALID_TYPE_CODE);
 	/*NOTREACHED*/
     }
diff --git a/v7/src/microcode/bchpur.c b/v7/src/microcode/bchpur.c
index ae0ded48c..a27052d99 100644
--- a/v7/src/microcode/bchpur.c
+++ b/v7/src/microcode/bchpur.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$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 $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchpur.c,v 9.44 1989/06/08 00:24:47 jinx Rel $
 
 Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
@@ -117,7 +117,9 @@ purifyloop(Scan, To_ptr, To_Address_ptr, purify_mode)
 	   and if so we need a new bufferfull. */
 	Scan += Get_Integer(Temp);
 	if (Scan < scan_buffer_top)
+	{
 	  break;
+	}
 	else
 	{
 	  unsigned long overflow;
@@ -128,9 +130,6 @@ purifyloop(Scan, To_ptr, To_Address_ptr, purify_mode)
 		   (overflow % GC_DISK_BUFFER_SIZE)) - 1);
 	  break;
 	}
-
-      case_Non_Pointer:
-	break;
 
       case_compiled_entry_point:
 	if (purify_mode == PURE_COPY)
@@ -330,12 +329,12 @@ purifyloop(Scan, To_ptr, To_Address_ptr, purify_mode)
 	continue;
 
       default:
-	sprintf(gc_death_message_buffer,
-		"gcloop: bad type code (0x%02x)",
-		OBJECT_TYPE(Temp));
-	gc_death(TERM_INVALID_TYPE_CODE, gc_death_message_buffer,
-		 Scan, To);
-	/*NOTREACHED*/
+	GC_BAD_TYPE("purifyloop");
+	/* Fall Through */
+
+      case_Non_Pointer:
+	break;
+
       }
   }
 end_purifyloop:
diff --git a/v7/src/microcode/fasdump.c b/v7/src/microcode/fasdump.c
index a01957b64..4d69071dc 100644
--- a/v7/src/microcode/fasdump.c
+++ b/v7/src/microcode/fasdump.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/fasdump.c,v 9.41 1988/10/04 14:48:41 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasdump.c,v 9.42 1989/06/08 00:25:01 jinx Rel $
 
    This file contains code for fasdump and dump-band.
 */
@@ -147,10 +147,6 @@ DumpLoop(Scan, Dump_Mode)
 	Scan += Get_Integer(Temp);
 	break;
 
-      case TC_STACK_ENVIRONMENT:
-      case_Fasload_Non_Pointer:
-	break;
-
       /* Compiled code relocation. */
 
       case_compiled_entry_point:
@@ -281,12 +277,12 @@ DumpLoop(Scan, Dump_Mode)
 	break;
 
       default:
-	sprintf(gc_death_message_buffer,
-		"dumploop: bad type code (0x%02x)",
-		OBJECT_TYPE(Temp));
-	gc_death(TERM_INVALID_TYPE_CODE, gc_death_message_buffer,
-		 Scan, To);
-	/*NOTREACHED*/
+	GC_BAD_TYPE("dumploop");
+	/* Fall Through */
+
+      case TC_STACK_ENVIRONMENT:
+      case_Fasload_Non_Pointer:
+	break;
       }
   }
   result = PRIM_DONE;
diff --git a/v7/src/microcode/gc.h b/v7/src/microcode/gc.h
index 40aac2a68..a050074b2 100644
--- a/v7/src/microcode/gc.h
+++ b/v7/src/microcode/gc.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/gc.h,v 9.26 1988/08/15 20:47:59 cph Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gc.h,v 9.27 1989/06/08 00:23:04 jinx Exp $
  *
  * Garbage collection related macros of sufficient utility to be
  * included in all compilations.
@@ -38,23 +38,56 @@ MIT in each case. */
 
 /* GC Types. */
 
-#define GC_Non_Pointer 	0
-#define GC_Cell		1
-#define GC_Pair		2
-#define GC_Triple	3
-#define GC_Hunk3	3
-#define GC_Quadruple    4
-#define GC_Hunk4        4
-#define GC_Undefined	-1 /* Undefined types */
-#define GC_Special	-2 /* Internal GC types */
-#define GC_Vector	-3
-#define GC_Compiled	-4
-
-#define GC_Type_Code(TC)					\
- ((GC_Type_Map[TC] != GC_Undefined)	?			\
-  GC_Type_Map[TC]			:			\
-  (fprintf(stderr, "Bad Type code = 0x%02x\n", TC),		\
-   Invalid_Type_Code(), GC_Undefined))
+#ifdef CMPGCFILE
+#ifndef BAD_TYPES_LETHAL
+#ifndef BAD_TYPES_INNOCUOUS
+#define BAD_TYPES_INNOCUOUS
+#endif /* BAD_TYPES_INNOCUOUS */
+#endif /* BAD_TYPES_LETHAL */
+#endif /* CMPGCFILE */
+
+#ifdef BAD_TYPES_INNOCUOUS
+#ifdef BAD_TYPES_LETHAL
+#error "gc.h: BAD_TYPES both lethal and innocuous"
+#endif /* BAD_TYPES_LETHAL */
+#else /* not BAD_TYPES_INNOCUOUS */
+#ifndef BAD_TYPES_LETHAL
+#define BAD_TYPES_LETHAL
+#endif /* BAD_TYPES_LETHAL */
+#endif /* BAD_TYPES_INNOCUOUS */
+
+#define GC_Non_Pointer 			0
+#define GC_Cell				1
+#define GC_Pair				2
+#define GC_Triple			3
+#define GC_Hunk3			3
+#define GC_Quadruple    		4
+#define GC_Hunk4        		4
+#define GC_Undefined			-1 /* Undefined types */
+#define GC_Special			-2 /* Internal GC types */
+#define GC_Vector			-3
+#define GC_Compiled			-4
+
+#ifdef BAD_TYPES_INNOCUOUS
+#define INVALID_TYPE_CODE(TC)		GC_Undefined
+
+#else /* not BAD_TYPES_INNOCUOUS */
+
+/* Some C compilers complain if the expression below does not yield
+   a value, and Microcode_Termination yields void.
+ */
+
+#define INVALID_TYPE_CODE(TC)						\
+  (fprintf(stderr, "\nGC_Type_Code: Bad Type code = 0x%02x\n", TC),	\
+   Microcode_Termination(TERM_INVALID_TYPE_CODE),			\
+   GC_Undefined)
+
+#endif /* BAD_TYPES_INNOCUOUS */
+
+#define GC_Type_Code(TC)						\
+ ((GC_Type_Map[TC] != GC_Undefined)	?				\
+  GC_Type_Map[TC]			:				\
+  (INVALID_TYPE_CODE(TC)))
 
 #define GC_Type(Object)			GC_Type_Code(OBJECT_TYPE(Object))
 
@@ -67,9 +100,6 @@ MIT in each case. */
 #define GC_Type_Special(Object)		(GC_Type(Object) == GC_Special)
 #define GC_Type_Vector(Object)		(GC_Type(Object) == GC_Vector)
 #define GC_Type_Compiled(Object)	(GC_Type(Object) == GC_Compiled)
-
-#define Invalid_Type_Code()					\
-  Microcode_Termination(TERM_INVALID_TYPE_CODE)
 
 /* Overflow detection, various cases */
 
diff --git a/v7/src/microcode/gccode.h b/v7/src/microcode/gccode.h
index 47e7d019e..3db16b1eb 100644
--- a/v7/src/microcode/gccode.h
+++ b/v7/src/microcode/gccode.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/gccode.h,v 9.39 1988/08/15 20:48:07 cph Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gccode.h,v 9.40 1989/06/08 00:24:34 jinx Rel $
  *
  * This file contains the macros for use in code which does GC-like
  * loops over memory.  It is only included in a few files, unlike
@@ -38,9 +38,6 @@ MIT in each case. */
  *
  */
 
-extern void gc_death();
-extern char gc_death_message_buffer[];
-
 /* A SWITCH on GC types, duplicates information in GC_Type_Map[], but exists
    for efficiency reasons. Macros must be used by convention: first
    Switch_by_GC_Type, then each of the case_ macros (in any order).  The
@@ -157,6 +154,39 @@ extern char gc_death_message_buffer[];
    TC_BIG_FLONUM
 */
 
+extern void gc_death();
+extern char gc_death_message_buffer[];
+
+/* Assumption: A call to GC_BAD_TYPE is followed by the non-pointer code. */
+
+#ifndef BAD_TYPES_INNOCUOUS
+
+#define GC_BAD_TYPE(name)						\
+do									\
+{									\
+  sprintf(gc_death_message_buffer,					\
+	  "%s: bad type code (0x%02x)",					\
+	  (name), (OBJECT_TYPE(Temp)));					\
+  gc_death(TERM_INVALID_TYPE_CODE, gc_death_message_buffer,		\
+	   Scan, To);							\
+  /*NOTREACHED*/							\
+} while (0)
+
+#else /* BAD_TYPES_INNOCUOUS */
+
+#define GC_BAD_TYPE(name)						\
+do									\
+{									\
+  fprintf(stderr,							\
+	  "\n%s: bad type code (0x%02x) 0x%lx",				\
+	  (name), (OBJECT_TYPE(Temp)), Temp);				\
+  fprintf(stderr,							\
+	  " -- Treating as non-pointer.\n");				\
+  /* Fall through */							\
+} while (0)
+
+#endif /* BAD_TYPES_INNOCUOUS */
+
 /* Macros for the garbage collector and related programs. */
 
 /* Pointer setup for the GC Type handlers. */
diff --git a/v7/src/microcode/gcloop.c b/v7/src/microcode/gcloop.c
index cf5125eda..fd1df748e 100644
--- a/v7/src/microcode/gcloop.c
+++ b/v7/src/microcode/gcloop.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/gcloop.c,v 9.29 1988/08/15 20:48:17 cph Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gcloop.c,v 9.30 1989/06/08 00:22:49 jinx Rel $
  *
  * This file contains the code for the most primitive part
  * of garbage collection.
@@ -110,9 +110,6 @@ GCLoop(Scan, To_Pointer)
       case TC_MANIFEST_SPECIAL_NM_VECTOR:
 	Scan += OBJECT_DATUM(Temp);
 	break;
-
-      case_Non_Pointer:
-	break;
 
       /* Compiled code relocation. */
 
@@ -188,7 +185,7 @@ GCLoop(Scan, To_Pointer)
 				  Transport_Compiled(),
 				  Compiled_BH(true, continue)));
 	break;
-
+
       case_Cell:
 	Setup_Pointer_for_GC(Transport_Cell());
 	break;
@@ -204,7 +201,7 @@ GCLoop(Scan, To_Pointer)
       case_Pair:
 	Setup_Pointer_for_GC(Transport_Pair());
 	break;
-
+
       case TC_VARIABLE:
       case_Triple:
 	Setup_Pointer_for_GC(Transport_Triple());
@@ -233,12 +230,12 @@ GCLoop(Scan, To_Pointer)
 	break;
 
       default:
-	sprintf(gc_death_message_buffer,
-		"gcloop: bad type code (0x%02x)",
-		OBJECT_TYPE(Temp));
-	gc_death(TERM_INVALID_TYPE_CODE, gc_death_message_buffer,
-		 Scan, To);
-	/*NOTREACHED*/
+	GC_BAD_TYPE("gcloop");
+	/* Fall Through */
+
+      case_Non_Pointer:
+	break;
+
       }	/* Switch_by_GC_Type */
   } /* For loop */
 
diff --git a/v7/src/microcode/interp.c b/v7/src/microcode/interp.c
index c4fe6dd87..2d99e5a75 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.50 1989/05/31 01:50:31 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/interp.c,v 9.51 1989/06/08 00:23:42 jinx Rel $
  *
  * This file contains the heart of the Scheme Scode
  * interpreter
@@ -579,6 +579,13 @@ Eval_Non_Trapping:
   Eval_Ucode_Hook();
   switch (OBJECT_TYPE(Fetch_Expression()))
   {
+    default:
+#if false
+      Eval_Error(ERR_UNDEFINED_USER_TYPE);
+#else
+      /* fall through to self evaluating. */
+#endif
+
     case TC_BIG_FIXNUM:         /* The self evaluating items */
     case TC_BIG_FLONUM:
     case TC_CHARACTER_STRING:
@@ -891,8 +898,6 @@ lookup_end_restart:
     }
 
     SITE_EXPRESSION_DISPATCH_HOOK()
-
-    default: Eval_Error(ERR_UNDEFINED_USER_TYPE);
   };
 
 /* Interpret() continues on the next page */
@@ -1759,7 +1764,8 @@ return_from_compiled_code:
 	      Pop_Return_Error(Which_Way);
 	    }
 
-	    default: Microcode_Termination( TERM_COMPILER_DEATH);
+	    default:
+	      Microcode_Termination( TERM_COMPILER_DEATH);
             }
           }
 
@@ -1774,8 +1780,11 @@ return_from_compiled_code:
 
     case RC_MOVE_TO_ADJACENT_POINT:
     /* Expression contains the space in which we are moving */
-    { long From_Count = Get_Integer(Stack_Ref(TRANSLATE_FROM_DISTANCE));
+    {
+      long From_Count;
       Pointer Thunk, New_Location;
+
+      From_Count = Get_Integer(Stack_Ref(TRANSLATE_FROM_DISTANCE));
       if (From_Count != 0)
       { Pointer Current = Stack_Ref(TRANSLATE_FROM_POINT);
 	Stack_Ref(TRANSLATE_FROM_DISTANCE) = Make_Unsigned_Fixnum((From_Count - 1));
@@ -1788,21 +1797,37 @@ return_from_compiled_code:
 	else Save_Cont();
       }
       else
-      { long To_Count = Get_Integer(Stack_Ref(TRANSLATE_TO_DISTANCE))-1;
-	fast Pointer To_Location = Stack_Ref(TRANSLATE_TO_POINT);
+      {
+	long To_Count;
+	fast Pointer To_Location;
 	fast long i;
-	for (i=0; i < To_Count; i++)
+
+	To_Count = (Get_Integer(Stack_Ref(TRANSLATE_TO_DISTANCE))-  1);
+	To_Location = Stack_Ref(TRANSLATE_TO_POINT);
+	for (i = 0; i < To_Count; i++)
+	{
 	  To_Location = Fast_Vector_Ref(To_Location, STATE_POINT_NEARER_POINT);
+	}
 	Thunk = Fast_Vector_Ref(To_Location, STATE_POINT_BEFORE_THUNK);
 	New_Location = To_Location;
 	Stack_Ref(TRANSLATE_TO_DISTANCE) = Make_Unsigned_Fixnum(To_Count);
-	if (To_Count==0) 
+	if (To_Count == 0) 
+	{
 	  Stack_Pointer = Simulate_Popping(4);
-	else Save_Cont();
+	}
+	else
+	{
+	  Save_Cont();
+	}
       }
       if (Fetch_Expression() != NIL)
+      {
         Vector_Set(Fetch_Expression(), STATE_SPACE_NEAREST_POINT, New_Location);
-      else Current_State_Point = New_Location;
+      }
+      else
+      {
+	Current_State_Point = New_Location;
+      }
      Will_Push(2);
       Push(Thunk);
       Push(STACK_FRAME_HEADER);
diff --git a/v7/src/microcode/memmag.c b/v7/src/microcode/memmag.c
index e8496571d..90d9b88cd 100644
--- a/v7/src/microcode/memmag.c
+++ b/v7/src/microcode/memmag.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/memmag.c,v 9.37 1989/05/31 01:50:46 jinx Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/memmag.c,v 9.38 1989/06/08 00:24:10 jinx Rel $ */
 
 /* Memory management top level.
 
@@ -174,7 +174,7 @@ GCFlip()
   Heap_Top = Temp;
   Free = Heap_Bottom;
   SET_MEMTOP(Heap_Top - GC_Reserve);
-  Weak_Chain = NIL;
+  Weak_Chain = EMPTY_LIST;
   return;
 }
 
@@ -182,7 +182,7 @@ GCFlip()
    the picture in gccode.h for a description of the structure built by
    the GC.  This code follows the chain of weak cells (in old space) and
    either updates the new copy's CAR with the relocated version of the
-   object, or replaces it with NIL.
+   object, or replaces it with SHARP_F.
 
    Note that this is the only code in the system, besides the inner garbage
    collector, which looks at both old and new space.
@@ -196,13 +196,13 @@ Fix_Weak_Chain()
   fast Pointer *Old_Weak_Cell, *Scan, Old_Car, Temp, *Old, *Low_Constant;
 
   Low_Constant = Constant_Space;
-  while (Weak_Chain != NIL)
+  while (Weak_Chain != EMPTY_LIST)
   {
     Old_Weak_Cell = Get_Pointer(Weak_Chain);
     Scan = Get_Pointer(*Old_Weak_Cell++);
     Weak_Chain = *Old_Weak_Cell;
     Old_Car = *Scan;
-    Temp = Make_New_Pointer(Type_Code(Weak_Chain), Old_Car);
+    Temp = Make_New_Pointer(OBJECT_TYPE(Weak_Chain), Old_Car);
     Weak_Chain = Make_New_Pointer(TC_NULL, Weak_Chain);
 
     switch(GC_Type(Temp))
@@ -211,22 +211,22 @@ Fix_Weak_Chain()
 	continue;
 
       case GC_Special:
-	if (Type_Code(Temp) != TC_REFERENCE_TRAP)
+	if (OBJECT_TYPE(Temp) != TC_REFERENCE_TRAP)
 	{
 	  /* No other special type makes sense here. */
 	  goto fail;
 	}
-	if (Datum(Temp) <= TRAP_MAX_IMMEDIATE)
+	if (OBJECT_DATUM(Temp) <= TRAP_MAX_IMMEDIATE)
 	{
 	  *Scan = Temp;
 	  continue;
 	}
 	/* Otherwise, it is a pointer.  Fall through */
-
+
       /* Normal pointer types, the broken heart is in the first word.
          Note that most special types are treated normally here.
 	 The BH code updates *Scan if the object has been relocated.
-	 Otherwise it falls through and we replace it with a full NIL.
+	 Otherwise it falls through and we replace it with a full SHARP_F.
 	 Eliminating this assignment would keep old data (pl. of datum).
        */
       case GC_Cell:
@@ -241,7 +241,7 @@ Fix_Weak_Chain()
 	  continue;
 	}
 	Normal_BH(false, continue);
-	*Scan = NIL;
+	*Scan = SHARP_F;
 	continue;
 
       case GC_Compiled:
@@ -252,16 +252,23 @@ Fix_Weak_Chain()
 	  continue;
 	}
 	Compiled_BH(false, continue);
-	*Scan = NIL;
+	*Scan = SHARP_F;
 	continue;
 
       case GC_Undefined:
+	fprintf(stderr,
+		"\nFix_Weak_Chain: Clearing bad object 0x%08lx.\n",
+		Temp);
+	*Scan = SHARP_F;
+	continue;
+	
       default:			/* Non Marked Headers and Broken Hearts */
       fail:
         fprintf(stderr,
-		"\nFix_Weak_Chain: Bad Object: Type = 0x%02x; Datum = %x\n",
-		Type_Code(Temp), Datum(Temp));
+		"\nFix_Weak_Chain: Bad Object: 0x%08lx.\n",
+		Temp);
 	Microcode_Termination(TERM_INVALID_TYPE_CODE);
+	/*NOTREACHED*/
     }
   }
   return;
@@ -298,8 +305,8 @@ void GC()
 
   Root = Free;
   The_Precious_Objects = Get_Fixed_Obj_Slot(Precious_Objects);
-  Set_Fixed_Obj_Slot(Precious_Objects, NIL);
-  Set_Fixed_Obj_Slot(Lost_Objects_Base, NIL);
+  Set_Fixed_Obj_Slot(Precious_Objects, SHARP_F);
+  Set_Fixed_Obj_Slot(Lost_Objects_Base, SHARP_F);
 
   *Free++ = Fixed_Objects;
   *Free++ = Make_Pointer(UNMARKED_HISTORY_TYPE, History);
@@ -307,7 +314,7 @@ void GC()
   *Free++ = Undefined_Primitives_Arity;
   *Free++ = Get_Current_Stacklet();
   *Free++ = ((Prev_Restore_History_Stacklet == NULL) ?
-	     NIL :
+	     SHARP_F :
 	     Make_Pointer(TC_CONTROL_POINT, Prev_Restore_History_Stacklet));
   *Free++ = Current_State_Point;
   *Free++ = Fluid_Bindings;
@@ -352,7 +359,7 @@ void GC()
   /* Set_Current_Stacklet is sometimes a No-Op! */
   Set_Current_Stacklet(*Root);
   Root += 1;
-  if (*Root == NIL)
+  if (*Root == SHARP_F)
   {
     Prev_Restore_History_Stacklet = NULL;
     Root += 1;
diff --git a/v7/src/microcode/purify.c b/v7/src/microcode/purify.c
index bbd2717bb..6caf11a02 100644
--- a/v7/src/microcode/purify.c
+++ b/v7/src/microcode/purify.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/purify.c,v 9.38 1989/05/31 01:50:57 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/purify.c,v 9.39 1989/06/08 00:25:19 jinx Rel $
  *
  * This file contains the code that copies objects into pure
  * and constant space.
@@ -114,9 +114,6 @@ PurifyLoop(Scan, To_Pointer, GC_Mode)
       case TC_MANIFEST_SPECIAL_NM_VECTOR:
 	Scan += Get_Integer(Temp);
 	break;
-
-      case_Non_Pointer:
-	break;
 
       /* Compiled code relocation. */
 
@@ -210,11 +207,15 @@ PurifyLoop(Scan, To_Pointer, GC_Mode)
 					Compiled_BH(false, continue)));
 	}
 	break;
-
+
       case_Cell:
 	Setup_Pointer_for_Purify(Transport_Cell());
 	break;
 
+      case TC_WEAK_CONS:
+	Setup_Pointer_for_Purify(Transport_Weak_Cons());
+	break;
+
       /*
 	Symbols, variables, and reference traps cannot be put into
 	pure space.  The strings contained in the first two can, on the
@@ -248,23 +249,21 @@ PurifyLoop(Scan, To_Pointer, GC_Mode)
 	Setup_Pointer_for_Purify(Transport_Pair());
 	break;
 
-      case TC_WEAK_CONS:
-	Setup_Pointer_for_Purify(Transport_Weak_Cons());
-	break;
-
       case TC_VARIABLE:
       case_Triple:
 	Setup_Pointer_for_Purify(Transport_Triple());
 	break;
 
-/* PurifyLoop continues on the next page */
-
-/* PurifyLoop, continued */
-
       case_Quadruple:
 	Setup_Pointer_for_Purify(Transport_Quadruple());
 	break;
 
+      case TC_BIG_FLONUM:
+        Setup_Pointer_for_Purify({
+	  Transport_Flonum();
+	  break;
+	});
+
 	/* No need to handle futures specially here, since PurifyLoop
 	   is always invoked after running GCLoop, which will have
 	   spliced all spliceable futures unless the GC itself of the
@@ -288,19 +287,13 @@ PurifyLoop(Scan, To_Pointer, GC_Mode)
 	Setup_Pointer_for_Purify(Transport_Vector());
 	break;
 
-      case TC_BIG_FLONUM:
-        Setup_Pointer_for_Purify({
-	  Transport_Flonum();
-	  break;
-	});
-
       default:
-	sprintf(gc_death_message_buffer,
-		"purifyloop: bad type code (0x%02x)",
-		OBJECT_TYPE(Temp));
-	gc_death(TERM_INVALID_TYPE_CODE, gc_death_message_buffer,
-		 Scan, To);
-	/*NOTREACHED*/
+	GC_BAD_TYPE("purifyloop");
+	/* Fall Through */
+
+      case_Non_Pointer:
+	break;
+
       } /* Switch_by_GC_Type */
   } /* For loop */
 
diff --git a/v7/src/microcode/purutl.c b/v7/src/microcode/purutl.c
index 84132c27e..cfef162a6 100644
--- a/v7/src/microcode/purutl.c
+++ b/v7/src/microcode/purutl.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/purutl.c,v 9.35 1989/03/27 23:15:52 jinx Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/purutl.c,v 9.36 1989/06/08 00:25:32 jinx Rel $ */
 
 /* Pure/Constant space utilities. */
 
@@ -102,9 +102,9 @@ Update(From, To, Was, Will_Be)
   return;
 }
 
-Pointer
-Make_Impure(Object)
-     Pointer Object;
+long
+Make_Impure(Object, New_Object)
+     Pointer Object, *New_Object;
 {
   Pointer *New_Address, *End_Of_Area;
   fast Pointer *Obj_Address, *Constant_Address;
@@ -122,8 +122,11 @@ Make_Impure(Object)
     case TC_MANIFEST_NM_VECTOR:
     case TC_MANIFEST_SPECIAL_NM_VECTOR:
     case_Non_Pointer:
+#if false
       fprintf(stderr, "\nImpurify Non-Pointer (0x%lx)\n", Object);
       Microcode_Termination(TERM_NON_POINTER_RELOCATION);
+#endif
+      return (ERR_ARG_1_WRONG_TYPE);
   
     case TC_BIG_FLONUM:
     case TC_FUTURE:
@@ -155,7 +158,12 @@ Make_Impure(Object)
     default:
       fprintf(stderr, "\nImpurify: Bad type code = 0x%02x.\n",
 	      OBJECT_TYPE(Object));
-      Invalid_Type_Code();
+#ifdef BAD_TYPES_LETHAL
+      Microcode_Termination(TERM_INVALID_TYPE_CODE);
+      /*NOTREACHED*/
+#else /* not BAD_TYPES_LETHAL */
+      return (ERR_ARG_1_WRONG_TYPE);
+#endif /* BAD_TYPES_LETHAL */
   }
 
   /* Add a copy of the object to the last constant block in memory.
@@ -166,7 +174,7 @@ Make_Impure(Object)
   Obj_Address = Get_Pointer(Object);
   if (!Test_Pure_Space_Top(Constant_Address + Length))
   {
-    return (NIL);
+    return (ERR_IMPURIFY_OUT_OF_SPACE);
   }
   Block_Length = Get_Integer(*(Constant_Address-1));
   Constant_Address -= 2;
@@ -221,7 +229,8 @@ Make_Impure(Object)
 
   EXIT_CRITICAL_SECTION ({});
 
-  return (Make_Pointer(OBJECT_TYPE(Object), New_Address));
+  *New_Object = (Make_Pointer(OBJECT_TYPE(Object), New_Address));
+  return (PRIM_DONE);
 }
 
 /* (PRIMITIVE-IMPURIFY OBJECT)
@@ -230,16 +239,18 @@ Make_Impure(Object)
 */
 DEFINE_PRIMITIVE ("PRIMITIVE-IMPURIFY", Prim_impurify, 1, 1, 0)
 {
-  Pointer Result;
+  long result;
+  Pointer New_Object;
   Primitive_1_Arg();
 
   Touch_In_Primitive(Arg1, Arg1);
-  Result = Make_Impure(Arg1);
-  if (Result != NIL)
+  result = Make_Impure(Arg1, &New_Object);
+  if (result == PRIM_DONE)
   {
-    return (Result);
+    PRIMITIVE_RETURN(New_Object);
   }
-  Primitive_Error(ERR_IMPURIFY_OUT_OF_SPACE);
+  else
+  Primitive_Error(result);
   /*NOTREACHED*/
 }
 
diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h
index 2876d9133..9aeb45972 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.81 1989/06/07 01:10:13 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.82 1989/06/08 00:26:10 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	81
+#define SUBVERSION	82
 #endif
 
 #ifndef UCODE_TABLES_FILENAME
diff --git a/v8/src/microcode/interp.c b/v8/src/microcode/interp.c
index f9eab214a..30bee0b94 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.50 1989/05/31 01:50:31 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/interp.c,v 9.51 1989/06/08 00:23:42 jinx Rel $
  *
  * This file contains the heart of the Scheme Scode
  * interpreter
@@ -579,6 +579,13 @@ Eval_Non_Trapping:
   Eval_Ucode_Hook();
   switch (OBJECT_TYPE(Fetch_Expression()))
   {
+    default:
+#if false
+      Eval_Error(ERR_UNDEFINED_USER_TYPE);
+#else
+      /* fall through to self evaluating. */
+#endif
+
     case TC_BIG_FIXNUM:         /* The self evaluating items */
     case TC_BIG_FLONUM:
     case TC_CHARACTER_STRING:
@@ -891,8 +898,6 @@ lookup_end_restart:
     }
 
     SITE_EXPRESSION_DISPATCH_HOOK()
-
-    default: Eval_Error(ERR_UNDEFINED_USER_TYPE);
   };
 
 /* Interpret() continues on the next page */
@@ -1759,7 +1764,8 @@ return_from_compiled_code:
 	      Pop_Return_Error(Which_Way);
 	    }
 
-	    default: Microcode_Termination( TERM_COMPILER_DEATH);
+	    default:
+	      Microcode_Termination( TERM_COMPILER_DEATH);
             }
           }
 
@@ -1774,8 +1780,11 @@ return_from_compiled_code:
 
     case RC_MOVE_TO_ADJACENT_POINT:
     /* Expression contains the space in which we are moving */
-    { long From_Count = Get_Integer(Stack_Ref(TRANSLATE_FROM_DISTANCE));
+    {
+      long From_Count;
       Pointer Thunk, New_Location;
+
+      From_Count = Get_Integer(Stack_Ref(TRANSLATE_FROM_DISTANCE));
       if (From_Count != 0)
       { Pointer Current = Stack_Ref(TRANSLATE_FROM_POINT);
 	Stack_Ref(TRANSLATE_FROM_DISTANCE) = Make_Unsigned_Fixnum((From_Count - 1));
@@ -1788,21 +1797,37 @@ return_from_compiled_code:
 	else Save_Cont();
       }
       else
-      { long To_Count = Get_Integer(Stack_Ref(TRANSLATE_TO_DISTANCE))-1;
-	fast Pointer To_Location = Stack_Ref(TRANSLATE_TO_POINT);
+      {
+	long To_Count;
+	fast Pointer To_Location;
 	fast long i;
-	for (i=0; i < To_Count; i++)
+
+	To_Count = (Get_Integer(Stack_Ref(TRANSLATE_TO_DISTANCE))-  1);
+	To_Location = Stack_Ref(TRANSLATE_TO_POINT);
+	for (i = 0; i < To_Count; i++)
+	{
 	  To_Location = Fast_Vector_Ref(To_Location, STATE_POINT_NEARER_POINT);
+	}
 	Thunk = Fast_Vector_Ref(To_Location, STATE_POINT_BEFORE_THUNK);
 	New_Location = To_Location;
 	Stack_Ref(TRANSLATE_TO_DISTANCE) = Make_Unsigned_Fixnum(To_Count);
-	if (To_Count==0) 
+	if (To_Count == 0) 
+	{
 	  Stack_Pointer = Simulate_Popping(4);
-	else Save_Cont();
+	}
+	else
+	{
+	  Save_Cont();
+	}
       }
       if (Fetch_Expression() != NIL)
+      {
         Vector_Set(Fetch_Expression(), STATE_SPACE_NEAREST_POINT, New_Location);
-      else Current_State_Point = New_Location;
+      }
+      else
+      {
+	Current_State_Point = New_Location;
+      }
      Will_Push(2);
       Push(Thunk);
       Push(STACK_FRAME_HEADER);
diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h
index 19e447662..9a8b7f9fc 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.81 1989/06/07 01:10:13 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.82 1989/06/08 00:26:10 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	81
+#define SUBVERSION	82
 #endif
 
 #ifndef UCODE_TABLES_FILENAME
-- 
2.25.1