From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Fri, 12 Feb 1988 16:53:59 +0000 (+0000)
Subject: 1) Fix allocation bug in FILE-ATTRIBUTES.
X-Git-Tag: 20090517-FFI~12904
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=63b1401194e27ea4f279e493f3f565c70e5566ae;p=mit-scheme.git

1) Fix allocation bug in FILE-ATTRIBUTES.
2) Make some error messages nicer.
3) Add ENTITY and RATNUM types.
4) Add apply time support for ENTITYs.
5) Add a type code name table to types.h and storage.c .
6) Clean up some code in debug.c and Ppband.c .
---

diff --git a/v7/src/microcode/bchdmp.c b/v7/src/microcode/bchdmp.c
index 2ec2204ce..23b90d951 100644
--- a/v7/src/microcode/bchdmp.c
+++ b/v7/src/microcode/bchdmp.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/bchdmp.c,v 9.39 1988/02/06 20:38:10 jinx Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchdmp.c,v 9.40 1988/02/12 16:49:43 jinx Exp $ */
 
 /* bchgcl, bchmmg, bchpur, and bchdmp can replace gcloop, memmag,
    purify, and fasdump, respectively, to provide garbage collection
@@ -376,7 +376,10 @@ dumploop(Scan, To_ptr, To_Address_ptr)
       default:
 	fprintf(stderr,
 		"\ndumploop: Bad type code = 0x%02x\n",
-		Type_Code(Temp));
+		OBJECT_TYPE(Temp));
+	fprintf(stderr,
+		"Scan = 0x%lx; Free = 0x%lx; Heap_Bottom = 0x%lx\n",
+		To, Scan, Heap_Bottom);
 	Invalid_Type_Code();
       }
   }
diff --git a/v7/src/microcode/bchgcl.c b/v7/src/microcode/bchgcl.c
index 7e8875173..105250433 100644
--- a/v7/src/microcode/bchgcl.c
+++ b/v7/src/microcode/bchgcl.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/bchgcl.c,v 9.30 1987/06/15 19:25:47 jinx Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchgcl.c,v 9.31 1988/02/12 16:49:57 jinx Exp $ */
 
 /* bchgcl, bchmmg, bchpur, and bchdmp can replace gcloop, memmag,
    purify, and fasdump, respectively, to provide garbage collection
@@ -152,12 +152,15 @@ GCLoop(Scan, To_ptr, To_Address_ptr)
       default:
 	fprintf(stderr,
 		"\nGCLoop: Bad type code = 0x%02x\n",
-		Type_Code(Temp));
+		OBJECT_TYPE(Temp));
+	fprintf(stderr,
+		"Scan = 0x%lx; Free = 0x%lx; Heap_Bottom = 0x%lx\n",
+		To, Scan, Heap_Bottom);
 	Invalid_Type_Code();
       }
   }
 end_gcloop:
   *To_ptr = To;
   *To_Address_ptr = To_Address;
-  return Scan;
+  return (Scan);
 }
diff --git a/v7/src/microcode/bchpur.c b/v7/src/microcode/bchpur.c
index abc6de0b8..4d15df866 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.36 1987/12/09 06:31:42 jinx Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchpur.c,v 9.37 1988/02/12 16:50:08 jinx Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -213,14 +213,17 @@ purifyloop(Scan, To_ptr, To_Address_ptr, purify_mode)
       default:
 	fprintf(stderr,
 		"\npurifyloop: Bad type code = 0x%02x\n",
-		Type_Code(Temp));
+		OBJECT_TYPE(Temp));
+	fprintf(stderr,
+		"Scan = 0x%lx; Free = 0x%lx; Heap_Bottom = 0x%lx\n",
+		To, Scan, Heap_Bottom);
 	Invalid_Type_Code();
       }
   }
 end_purifyloop:
   *To_ptr = To;
   *To_Address_ptr = To_Address;
-  return Scan;
+  return (Scan);
 }
 
 /* This is not paranoia!
diff --git a/v7/src/microcode/debug.c b/v7/src/microcode/debug.c
index fea910a09..b65d0a9cb 100644
--- a/v7/src/microcode/debug.c
+++ b/v7/src/microcode/debug.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/debug.c,v 9.27 1987/12/04 22:15:07 jinx Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/debug.c,v 9.28 1988/02/12 16:50:19 jinx Rel $
  *
  * Utilities to help with debugging
  */
@@ -223,17 +223,23 @@ Print_Expression(Expr, String)
   }
   Do_Printing(Expr, true);
 }
+
+extern char *Type_Names[];
 
 Do_Printing(Expr, Detailed)
      Pointer Expr;
      Boolean Detailed;
 {
   long Temp_Address;
-  Boolean Return_After_Print;
+  Boolean
+    Return_After_Print,
+    handled_p;;
 
-  Temp_Address = Get_Integer(Expr);
+  Temp_Address = OBJECT_DATUM(Expr);
   Return_After_Print = false;
-  switch(Type_Code(Expr))
+  handled_p = false;
+
+  switch(OBJECT_TYPE(Expr))
   { case TC_ACCESS:
       printf("[ACCESS (");
       Expr = Vector_Ref(Expr, ACCESS_NAME);
@@ -252,7 +258,7 @@ Do_Printing(Expr, Detailed)
 
       printf("\"");
       Length = ((long) (Vector_Ref(Expr, STRING_LENGTH)));
-      Next = (char *) Nth_Vector_Loc(Expr, STRING_CHARS);
+      Next = ((char *) Nth_Vector_Loc(Expr, STRING_CHARS));
       for (i = 0; i < Length; i++)
       {
 	This = *Next++;
@@ -273,23 +279,29 @@ Do_Printing(Expr, Detailed)
       goto SPrint;
 
     case TC_FIXNUM:
-    { long A;
+    {
+      long A;
+
       Sign_Extend(Expr, A);
       printf("%d", A);
       return;
     }
 
-    case TC_BIG_FLONUM: printf("%f", Get_Float(Expr)); return;
+    case TC_BIG_FLONUM:
+      printf("%f", Get_Float(Expr));
+      return;
 
     case TC_WEAK_CONS:
-    case TC_LIST: List_Print(Expr); return;
+    case TC_LIST:
+      List_Print(Expr);
+      return;
 
     case TC_NULL:
       if (Temp_Address == 0)
-      { printf("()");
+      {
+	printf("()");
         return;
       }
-      printf("[NULL");
       break;
 
 /* Do_Printing continues on the next page */
@@ -297,20 +309,27 @@ Do_Printing(Expr, Detailed)
 /* Do_Printing, continued */
 
     case TC_UNINTERNED_SYMBOL:
-      printf("[UNINTERNED_SYMBOL ("); goto SPrint;
+      printf("[UNINTERNED_SYMBOL (");
+      goto SPrint;
 
     case TC_INTERNED_SYMBOL:
-    { Pointer Name;
+    {
+      Pointer Name;
       char   *Next_Char;
       long    Length, i;
+
       Return_After_Print = true;
 SPrint:
       Name = Vector_Ref(Expr, SYMBOL_NAME);
       Length = ((long) (Vector_Ref(Name, STRING_LENGTH)));
-      Next_Char = (char *) Nth_Vector_Loc(Name, STRING_CHARS);
-      for (i=0; i < Length; i++)
+      Next_Char = ((char *) Nth_Vector_Loc(Name, STRING_CHARS));
+      for (i = 0; i < Length; i++)
+      {
         printf("%c", *Next_Char++);
-      if (Return_After_Print) return;
+      }
+      if (Return_After_Print)
+	return;
+      handled_p = true;
       printf(")");
       break;
     }
@@ -320,14 +339,13 @@ SPrint:
 /* Do_Printing, continued */
 
   case TC_VARIABLE:
-      if (Detailed) printf("[VARIABLE (");
+      if (Detailed)
+	printf("[VARIABLE (");
       Expr = Vector_Ref(Expr, VARIABLE_SYMBOL);
-      if (!Detailed) Return_After_Print = true;
+      if (!Detailed)
+	Return_After_Print = true;
       goto SPrint;
 
-    case TC_BIG_FIXNUM: printf("[BIG_FIXNUM"); break;
-    case TC_BROKEN_HEART: printf("[BROKEN_HEART"); break;
-    case TC_CHARACTER: printf("[CHARACTER"); break;
     case TC_COMBINATION:
       printf("[COMBINATION (%d args) 0x%x]",
 	     Vector_Length(Expr)-1, Temp_Address);
@@ -337,6 +355,7 @@ SPrint:
         printf(" ...)");
       }
       return;
+
     case TC_COMBINATION_1:
       printf("[COMBINATION_1 0x%x]", Temp_Address);
       if (Detailed)
@@ -364,16 +383,7 @@ SPrint:
 	printf(")");
       }
       return;
-    case TC_CELL: printf("[CELL"); break;
-    case TC_COMMENT: printf("[COMMENT"); break;
-    case TC_COMPILED_EXPRESSION: printf("[COMPILED_EXPRESSION"); break;
-    case TC_COMPILED_PROCEDURE:
-     printf("[COMPILED_PROCEDURE"); break;
-    case TC_CONDITIONAL: printf("[CONDITIONAL"); break;
-    case TC_CONTROL_POINT: printf("[CONTROL_POINT"); break;
-    case TC_DELAY: printf("[DELAY"); break;
-    case TC_DELAYED: printf("[DELAYED"); break;
-    case TC_DISJUNCTION: printf("[DISJUNCTION"); break;
+
     case TC_ENVIRONMENT:
     {
       Pointer procedure;
@@ -387,6 +397,7 @@ SPrint:
       printf(")");
       return;
     }
+
     case TC_EXTENDED_LAMBDA:
       if (Detailed)
 	printf("[EXTENDED_LAMBDA (");
@@ -407,11 +418,6 @@ SPrint:
 
 /* Do_Printing, continued */
 
-    case TC_FUTURE: printf("[FUTURE"); break;
-    case TC_HUNK3_A: printf("[TRIPLE_A"); break;
-    case TC_HUNK3_B: printf("[TRIPLE_B"); break;
-    case TC_IN_PACKAGE: printf("[IN_PACKAGE"); break;
-
     case TC_LAMBDA:
       if (Detailed)
       {
@@ -425,18 +431,12 @@ SPrint:
       }
       return;
 
-    case TC_LEXPR: printf("[LEXPR"); break;
-    case TC_MANIFEST_NM_VECTOR: printf("[MANIFEST_NM_VECTOR"); break;
-    case TC_MANIFEST_SPECIAL_NM_VECTOR:
-      printf("[MANIFEST_SPECIAL_NM_VECTOR"); break;
-    case TC_NON_MARKED_VECTOR: printf("[NON_MARKED_VECTOR"); break;
-    case TC_PCOMB0: printf("[PCOMB0"); break;
-    case TC_PCOMB1: printf("[PCOMB1"); break;
-    case TC_PCOMB2: printf("[PCOMB2"); break;
-    case TC_PCOMB3: printf("[PCOMB3"); break;
     case TC_PRIMITIVE:
-      printf("[PRIMITIVE "); Prt_PName(Expr);
-      printf("]"); return;
+      printf("[PRIMITIVE ");
+      Prt_PName(Expr);
+      printf("]");
+      return;
+
     case TC_PROCEDURE:
       if (Detailed)
       {
@@ -453,7 +453,6 @@ SPrint:
 
 /* Do_Printing, continued */
 
-    case TC_QUAD: printf("[QUAD"); break;
     case TC_REFERENCE_TRAP:
     {
       printf("[REFERENCE-TRAP");
@@ -464,29 +463,37 @@ SPrint:
       printf("]");
       return;
     }
+
     case TC_RETURN_CODE:
       printf("[RETURN_CODE ");
       Print_Return_Name(Expr);
       printf("]");
       return;
-    case TC_SCODE_QUOTE: printf("[SCODE_QUOTE"); break;
-    case TC_SEQUENCE_2: printf("[SEQUENCE_2"); break;
-    case TC_SEQUENCE_3: printf("[SEQUENCE_3"); break;
-    case TC_THE_ENVIRONMENT: printf("[THE_ENVIRONMENT"); break;
+
     case TC_TRUE:
       if (Temp_Address == 0)
       {
 	printf("#T");
         return;
       }
-      printf("[TRUE");
       break;
-    case TC_VECTOR: printf("[VECTOR"); break;
-    case TC_VECTOR_16B: printf("[VECTOR_16B"); break;
-    case TC_VECTOR_1B: printf("[VECTOR_1B"); break;
-    default: printf("[0x%x", Type_Code(Expr));
+
+    default:
+      break;
+  }
+  if (!handled_p)
+  {
+    if (OBJECT_TYPE(Expr) <= LAST_TYPE_CODE)
+    {
+      printf("[%s", Type_Names[OBJECT_TYPE(Expr)]);
+    }
+    else
+    {
+      printf("[0x%02x", OBJECT_TYPE(Expr));
+    }
   }
   printf(" 0x%x]", Temp_Address);
+  return;
 }
 
 Boolean
diff --git a/v7/src/microcode/fasdump.c b/v7/src/microcode/fasdump.c
index eb366ebb2..11a917a39 100644
--- a/v7/src/microcode/fasdump.c
+++ b/v7/src/microcode/fasdump.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/fasdump.c,v 9.33 1988/02/06 20:40:12 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasdump.c,v 9.34 1988/02/12 16:50:37 jinx Exp $
 
    This file contains code for fasdump and dump-band.
 */
@@ -196,10 +196,12 @@ DumpLoop(Scan, Dump_Mode)
 
       default:
 	fprintf(stderr,
-		"DumpLoop: Bad type code = 0x%02x\n",
-		Type_Code(Temp));
+		"\nDumpLoop: Bad type code = 0x%02x\n",
+		OBJECT_TYPE(Temp));
+	fprintf(stderr,
+		"Scan = 0x%lx; Free = 0x%lx; Heap_Bottom = 0x%lx\n",
+		To, Scan, Heap_Bottom);
 	Invalid_Type_Code();
-
       }
   }
   NewFree = To;
diff --git a/v7/src/microcode/gccode.h b/v7/src/microcode/gccode.h
index eab2df076..681f42592 100644
--- a/v7/src/microcode/gccode.h
+++ b/v7/src/microcode/gccode.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/gccode.h,v 9.32 1988/02/06 20:40:56 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gccode.h,v 9.33 1988/02/12 16:50:51 jinx Exp $
  *
  * 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
@@ -99,8 +99,9 @@ MIT in each case. */
  case TC_LEXPR:						\
  case TC_DISJUNCTION:					\
  case TC_COMPILED_PROCEDURE:				\
- case TC_COMPILER_LINK:					\
- case TC_COMPLEX
+ case TC_COMPLEX:					\
+ case TC_ENTITY:					\
+ case TC_RATNUM
 
 #define case_Pair					\
  case TC_INTERNED_SYMBOL:				\
diff --git a/v7/src/microcode/gcloop.c b/v7/src/microcode/gcloop.c
index 0c66a1525..374cd5a65 100644
--- a/v7/src/microcode/gcloop.c
+++ b/v7/src/microcode/gcloop.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/gcloop.c,v 9.24 1987/04/03 00:13:50 jinx Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gcloop.c,v 9.25 1988/02/12 16:51:04 jinx Exp $
  *
  * This file contains the code for the most primitive part
  * of garbage collection.
@@ -139,12 +139,15 @@ Pointer **To_Pointer;
 
       default:
 	fprintf(stderr,
-		"GCLoop: Bad type code = 0x%02x\n",
-		Type_Code(Temp));
+		"\nGCLoop: Bad type code = 0x%02x\n",
+		OBJECT_TYPE(Temp));
+	fprintf(stderr,
+		"Scan = 0x%lx; Free = 0x%lx; Heap_Bottom = 0x%lx\n",
+		To, Scan, Heap_Bottom);
 	Invalid_Type_Code();
 
       }	/* Switch_by_GC_Type */
   } /* For loop */
   *To_Pointer = To;
-  return To;
+  return (To);
 } /* GCLoop */
diff --git a/v7/src/microcode/gctype.c b/v7/src/microcode/gctype.c
index ad266c642..2f0c594eb 100644
--- a/v7/src/microcode/gctype.c
+++ b/v7/src/microcode/gctype.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/gctype.c,v 9.26 1987/11/17 08:11:56 jinx Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/gctype.c,v 9.27 1988/02/12 16:51:15 jinx Exp $
  *
  * This file contains the table which maps between Types and
  * GC Types.
@@ -58,7 +58,7 @@ int GC_Type_Map[MAX_TYPE_CODE + 1] = {
     GC_Pair,			/* TC_COMPILED_PROCEDURE */
     GC_Vector,			/* TC_BIG_FIXNUM */
     GC_Pair,			/* TC_PROCEDURE */
-    GC_Undefined,			/* 0x10 */
+    GC_Pair,			/* TC_ENTITY */
     GC_Pair,			/* TC_DELAY */
     GC_Vector,			/* TC_ENVIRONMENT */
     GC_Pair,			/* TC_DELAYED */
@@ -105,7 +105,7 @@ int GC_Type_Map[MAX_TYPE_CODE + 1] = {
     GC_Pair,			/* TC_WEAK_CONS */
     GC_Quadruple,		/* TC_QUAD */
     GC_Compiled,		/* TC_RETURN_ADDRESS */
-    GC_Pair,			/* TC_COMPILER_LINK */
+    GC_Pair,			/* TC_RATNUM */
     GC_Non_Pointer,		/* TC_STACK_ENVIRONMENT */
     GC_Pair,			/* TC_COMPLEX */
     GC_Vector,			/* TC_COMPILED_CODE_BLOCK */
diff --git a/v7/src/microcode/interp.c b/v7/src/microcode/interp.c
index ce4bfbaeb..fe0b650e2 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.37 1987/12/04 22:17:11 jinx Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/interp.c,v 9.38 1988/02/12 16:51:27 jinx Exp $
  *
  * This file contains the heart of the Scheme Scode
  * interpreter
@@ -542,16 +542,18 @@ Do_Expression:
 
 Eval_Non_Trapping:
   Eval_Ucode_Hook();
-  switch (Type_Code(Fetch_Expression()))
+  switch (OBJECT_TYPE(Fetch_Expression()))
   {
     case TC_BIG_FIXNUM:         /* The self evaluating items */
     case TC_BIG_FLONUM:
     case TC_CHARACTER_STRING:
     case TC_CHARACTER:
+    case TC_COMPILED_CODE_BLOCK:
     case TC_COMPILED_PROCEDURE:
     case TC_COMPLEX:
     case TC_CONTROL_POINT:
     case TC_DELAYED:
+    case TC_ENTITY:
     case TC_ENVIRONMENT:
     case TC_EXTENDED_PROCEDURE:
     case TC_FIXNUM:
@@ -564,13 +566,16 @@ Eval_Non_Trapping:
     case TC_PRIMITIVE:
     case TC_PROCEDURE:
     case TC_QUAD:
+    case TC_RATNUM:
+    case TC_REFERENCE_TRAP:
+    case TC_RETURN_CODE:
     case TC_UNINTERNED_SYMBOL:
     case TC_TRUE: 
     case TC_VECTOR:
     case TC_VECTOR_16B:
     case TC_VECTOR_1B:
-    case TC_REFERENCE_TRAP:
-      Val = Fetch_Expression(); break;
+      Val = Fetch_Expression();
+      break;
 
     case TC_ACCESS:
      Will_Push(CONTINUATION_SIZE);
@@ -853,7 +858,6 @@ lookup_end_restart:
 
     SITE_EXPRESSION_DISPATCH_HOOK()
 
-    case TC_RETURN_CODE:
     default: Eval_Error(ERR_UNDEFINED_USER_TYPE);
   };
 
@@ -1356,6 +1360,24 @@ Perform_Application:
         switch(Type_Code(Function))
         { 
 
+	  case TC_ENTITY:
+	  {
+	    fast long nargs;
+
+	    /* Will_Pushed ommited since frame must be contiguous.
+	       combination code must ensure one more slot.
+	     */
+
+	    /* This code assumes that adding 1 to nargs takes care
+	       of everything, including type code, etc.
+	     */
+	    nargs = Pop();
+	    Push(Fast_Vector_Ref(Function, ENTITY_OPERATOR));
+	    Push(nargs + 1);
+	    /* No interrupts, etc. */
+	    goto Perform_Application;
+	  }
+
 /* Interpret() continues on the next page */
 
 /* Interpret(), continued */
diff --git a/v7/src/microcode/ppband.c b/v7/src/microcode/ppband.c
index a258fd14c..9e22e9552 100644
--- a/v7/src/microcode/ppband.c
+++ b/v7/src/microcode/ppband.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/ppband.c,v 9.31 1988/02/10 15:42:58 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/ppband.c,v 9.32 1988/02/12 16:49:27 jinx Rel $
  *
  * Dumps Scheme FASL in user-readable form .
  */
@@ -184,6 +184,8 @@ static char string_buffer[10];
   break;								\
 }
 
+char *Type_Names[] = TYPE_NAME_TABLE;
+
 void
 Display(Location, Type, The_Datum)
      long Location, Type, The_Datum;
@@ -210,21 +212,18 @@ Display(Location, Type, The_Datum)
 	printf("TRUE\n");
 	return;
       }
-      NON_POINTER("TRUE");
+      /* fall through */
 
-    case TC_MANIFEST_SPECIAL_NM_VECTOR:
-      NON_POINTER("MANIFEST-SPECIAL-NM");
 
+    case TC_CHARACTER:
+    case TC_RETURN_CODE:
+    case TC_PRIMITIVE:
+    case TC_THE_ENVIRONMENT:
+    case TC_PCOMB0:
+    case TC_MANIFEST_SPECIAL_NM_VECTOR:
     case TC_MANIFEST_NM_VECTOR:
-      NON_POINTER("MANIFEST-NM-VECTOR");
+      NON_POINTER(Type_Names[Type]);
 
-    case TC_BROKEN_HEART:
-      if (The_Datum == 0)
-      {
-	Points_To = 0;
-      }
-      POINTER("BROKEN-HEART");
-
     case TC_INTERNED_SYMBOL:
       PRINT_OBJECT("INTERNED-SYMBOL", Points_To);
       printf(" = ");
@@ -259,62 +258,21 @@ Display(Location, Type, The_Datum)
 	POINTER("REFERENCE-TRAP");
       }
 
-    case TC_CHARACTER:			NON_POINTER("CHARACTER");
-    case TC_RETURN_CODE:		NON_POINTER("RETURN-CODE");
-    case TC_PRIMITIVE:			NON_POINTER("PRIMITIVE");
-    case TC_THE_ENVIRONMENT:		NON_POINTER("THE-ENVIRONMENT");
-    case TC_PCOMB0:			NON_POINTER("PCOMB0");
-    case TC_LIST:			POINTER("LIST");
-    case TC_SCODE_QUOTE:		POINTER("SCODE-QUOTE");
-    case TC_PCOMB2:			POINTER("PCOMB2");
-    case TC_BIG_FLONUM:			POINTER("FLONUM");
-
-    case TC_COMBINATION_1:		POINTER("COMBINATION-1");
-    case TC_EXTENDED_PROCEDURE:		POINTER("EXTENDED-PROCEDURE");
-    case TC_VECTOR:			POINTER("VECTOR");
-    case TC_COMBINATION_2:		POINTER("COMBINATION-2");
-    case TC_COMPILED_PROCEDURE:		POINTER("COMPILED-PROCEDURE");
-    case TC_BIG_FIXNUM:			POINTER("BIG-FIXNUM");
-    case TC_PROCEDURE:			POINTER("PROCEDURE");
-    case TC_DELAY:			POINTER("DELAY");
-    case TC_ENVIRONMENT:		POINTER("ENVIRONMENT");
-    case TC_DELAYED:			POINTER("DELAYED");
-    case TC_EXTENDED_LAMBDA:		POINTER("EXTENDED-LAMBDA");
-    case TC_COMMENT:			POINTER("COMMENT");
-    case TC_NON_MARKED_VECTOR:		POINTER("NON-MARKED-VECTOR");
-    case TC_LAMBDA:			POINTER("LAMBDA");
-    case TC_SEQUENCE_2:			POINTER("SEQUENCE-2");
-    case TC_PCOMB1:			POINTER("PCOMB1");
-    case TC_CONTROL_POINT:		POINTER("CONTROL-POINT");
-    case TC_ACCESS:			POINTER("ACCESS");
-    case TC_DEFINITION:			POINTER("DEFINITION");
-    case TC_ASSIGNMENT:			POINTER("ASSIGNMENT");
-    case TC_HUNK3_A:			POINTER("HUNK3_A");
-    case TC_HUNK3_B:			POINTER("HUNK3-B");
-    case TC_IN_PACKAGE:			POINTER("IN-PACKAGE");
-    case TC_COMBINATION:		POINTER("COMBINATION");
-    case TC_COMPILED_EXPRESSION:	POINTER("COMPILED-EXPRESSION");
-    case TC_LEXPR:			POINTER("LEXPR");
-    case TC_PCOMB3:			POINTER("PCOMB3");
-    case TC_VARIABLE:			POINTER("VARIABLE");
-    case TC_FUTURE:			POINTER("FUTURE");
-    case TC_VECTOR_1B:			POINTER("VECTOR-1B");
-    case TC_VECTOR_16B:			POINTER("VECTOR-16B");
-    case TC_SEQUENCE_3:			POINTER("SEQUENCE-3");
-    case TC_CONDITIONAL:		POINTER("CONDITIONAL");
-    case TC_DISJUNCTION:		POINTER("DISJUNCTION");
-    case TC_CELL:			POINTER("CELL");
-    case TC_WEAK_CONS:			POINTER("WEAK-CONS");
-    case TC_RETURN_ADDRESS:		POINTER("RETURN-ADDRESS");
-    case TC_COMPILER_LINK:		POINTER("COMPILER_LINK");
-    case TC_STACK_ENVIRONMENT:		POINTER("STACK-ENVIRONMENT");
-    case TC_COMPLEX:			POINTER("COMPLEX");
-    case TC_QUAD:			POINTER("QUAD");
-    case TC_COMPILED_CODE_BLOCK:	POINTER("COMPILED-CODE-BLOCK");
-
+    case TC_BROKEN_HEART:
+      if (The_Datum == 0)
+      {
+	Points_To = 0;
+      }
     default:
-      sprintf(&the_string[0], "0x%02lx ", Type);
-      POINTER(&the_string[0]);
+      if (Type <= LAST_TYPE_CODE)
+      {
+	POINTER(Type_Names[Type]);
+      }
+      else
+      {
+	sprintf(&the_string[0], "0x%02lx ", Type);
+	POINTER(&the_string[0]);
+      }
   }
   PRINT_OBJECT(the_string, Points_To);
   putchar('\n');
diff --git a/v7/src/microcode/pruxfs.c b/v7/src/microcode/pruxfs.c
index 02f362496..49d42e913 100644
--- a/v7/src/microcode/pruxfs.c
+++ b/v7/src/microcode/pruxfs.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/pruxfs.c,v 9.25 1987/12/18 00:03:51 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/pruxfs.c,v 9.26 1988/02/12 16:53:26 jinx Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -153,7 +153,7 @@ DEFINE_PRIMITIVE ("GID->STRING", Prim_gid_to_string, 1)
   PRIMITIVE_RETURN (C_String_To_Scheme_String (entry -> gr_name));
 }
 
-/* Returns a vector of 9 items:
+/* Returns a vector of 10 items:
 
    0 = #T iff the file is a directory
    1 = number of links to the file
@@ -181,7 +181,7 @@ DEFINE_PRIMITIVE ("FILE-ATTRIBUTES", Prim_file_attributes, 1)
   CHECK_ARG (1, STRING_P);
   if ((stat ((Scheme_String_To_C_String (ARG_REF (1))), (& stat_result))) < 0)
     PRIMITIVE_RETURN (NIL);
-  result = (allocate_marked_vector (TC_VECTOR, 9, true));
+  result = (allocate_marked_vector (TC_VECTOR, 10, true));
   modes = (allocate_string (10));
   User_Vector_Set
     (result, 0,
diff --git a/v7/src/microcode/purify.c b/v7/src/microcode/purify.c
index 22c14f485..073e85cf9 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.29 1987/11/17 08:15:39 jinx Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/purify.c,v 9.30 1988/02/12 16:52:00 jinx Exp $
  *
  * This file contains the code that copies objects into pure
  * and constant space.
@@ -188,13 +188,16 @@ PurifyLoop(Scan, To_Pointer, GC_Mode)
 
       default:
 	fprintf(stderr,
-		"PurifyLoop: Bad type code = 0x%02x\n",
-		Type_Code(Temp));
+		"\nPurifyLoop: Bad type code = 0x%02x\n",
+		OBJECT_TYPE(Temp));
+	fprintf(stderr,
+		"Scan = 0x%lx; Free = 0x%lx; Heap_Bottom = 0x%lx\n",
+		To, Scan, Heap_Bottom);
 	Invalid_Type_Code();
       } /* Switch_by_GC_Type */
   } /* For loop */
   *To_Pointer = To;
-  return To;
+  return (To);
 } /* PurifyLoop */
 
 /* Description of the algorithm for PURIFY:
diff --git a/v7/src/microcode/sdata.h b/v7/src/microcode/sdata.h
index 1ba1196c9..4a74b8bb8 100644
--- a/v7/src/microcode/sdata.h
+++ b/v7/src/microcode/sdata.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/sdata.h,v 9.27 1987/11/17 08:16:29 jinx Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/sdata.h,v 9.28 1988/02/12 16:52:13 jinx Rel $
  *
  * Description of the user data objects.  This should parallel the
  * file SDATA.SCM in the runtime system.
@@ -158,6 +158,15 @@ MIT in each case. */
 #define THUNK_ENVIRONMENT	0
 #define THUNK_PROCEDURE		1
 
+/* ENTITY
+   A cons of a procedure and something else.
+   When invoked, it invokes (tail recurses) into the procedure passing
+   the entity and the arguments to it.
+ */
+
+#define ENTITY_OPERATOR		0
+#define ENTITY_DATA		1
+
 /* ENVIRONMENT
  * Associates identifiers with values.
  * The identifiers are either from a lambda-binding (as in a procedure
diff --git a/v7/src/microcode/storage.c b/v7/src/microcode/storage.c
index 2fa769fef..176a7ed73 100644
--- a/v7/src/microcode/storage.c
+++ b/v7/src/microcode/storage.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/storage.c,v 9.41 1988/02/06 20:41:41 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/storage.c,v 9.42 1988/02/12 16:52:28 jinx Rel $
 
 This file defines the storage for global variables for
 the Scheme Interpreter. */
@@ -158,6 +158,9 @@ long MAX_RETURN = MAX_RETURN_CODE;
 extern char *Return_Names[];
 char *Return_Names[] = RETURN_NAME_TABLE;	/* in returns.h */
 
+extern char *Type_Names[];
+char *Type_Names[] = TYPE_NAME_TABLE;		/* in types.h */
+
 extern char *Abort_Names[];
 char *Abort_Names[] = ABORT_NAME_TABLE;		/* in const.h */
 
diff --git a/v7/src/microcode/types.h b/v7/src/microcode/types.h
index 7a073f167..d7af60610 100644
--- a/v7/src/microcode/types.h
+++ b/v7/src/microcode/types.h
@@ -30,12 +30,14 @@ 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/types.h,v 9.26 1987/11/17 08:18:54 jinx Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/types.h,v 9.27 1988/02/12 16:52:46 jinx Exp $
  *
  * Type code definitions, numerical order
  *
  */
 
+/*	Name				Value	Previous Name */
+
 #define TC_NULL	                	0x00
 #define TC_LIST				0x01
 #define TC_CHARACTER			0x02
@@ -52,9 +54,7 @@ MIT in each case. */
 #define TC_COMPILED_PROCEDURE		0x0D
 #define TC_BIG_FIXNUM			0x0E
 #define TC_PROCEDURE			0x0F
-/* 0x10 used to be TC_PRIMITIVE_EXTERNAL */
-/* if it is reused, define PRIMITIVE_EXTERNAL_REUSED below. */
-/* Unused				0x10 */
+#define TC_ENTITY			0x10 /* PRIMITIVE_EXTERNAL */
 #define TC_DELAY			0x11
 #define TC_ENVIRONMENT			0x12
 #define TC_DELAYED			0x13
@@ -71,7 +71,7 @@ MIT in each case. */
 #define TC_INTERNED_SYMBOL		0x1D
 #define TC_CHARACTER_STRING		0x1E
 #define TC_ACCESS			0x1F
-#define TC_HUNK3_A			0x20 /* Used to be EXTENDED_FIXNUM. */
+#define TC_HUNK3_A			0x20 /* EXTENDED_FIXNUM */
 #define TC_DEFINITION			0x21
 #define TC_BROKEN_HEART			0x22
 #define TC_ASSIGNMENT			0x23
@@ -89,26 +89,96 @@ MIT in each case. */
 #define TC_VECTOR_1B			0x2F
 #define TC_PCOMB0			0x30
 #define TC_VECTOR_16B			0x31
-#define TC_REFERENCE_TRAP		0x32 /* Used to be UNASSIGNED. */
+#define TC_REFERENCE_TRAP		0x32 /* UNASSIGNED */
 #define TC_SEQUENCE_3			0x33
 #define TC_CONDITIONAL			0x34
 #define TC_DISJUNCTION			0x35
 #define TC_CELL				0x36
 #define TC_WEAK_CONS			0x37
-#define TC_QUAD				0x38 /* Used to be TC_TRAP. */
+#define TC_QUAD				0x38 /* TRAP */
 #define TC_RETURN_ADDRESS		0x39
-#define TC_COMPILER_LINK		0x3A
+#define TC_RATNUM			0x3A /* COMPILER_LINK */
 #define TC_STACK_ENVIRONMENT		0x3B
 #define TC_COMPLEX			0x3C
 #define TC_COMPILED_CODE_BLOCK		0x3D
 
-/* If you add a new type, don't forget to update gccode.h and gctype.c */
+/* If you add a new type, don't forget to update gccode.h, gctype.c,
+   and the type name table below.
+ */
+
+#define LAST_TYPE_CODE			0X3D
+
+#define TYPE_NAME_TABLE							\
+{									\
+  /* 0x00 */	                "NULL",					\
+  /* 0x01 */			"LIST",					\
+  /* 0x02 */			"CHARACTER",				\
+  /* 0x03 */                 	"SCODE-QUOTE",				\
+  /* 0x04 */			"PCOMB2",				\
+  /* 0x05 */			"UNINTERNED-SYMBOL",			\
+  /* 0x06 */			"BIG-FLONUM",				\
+  /* 0x07 */			"COMBINATION-1",			\
+  /* 0x08 */			"TRUE",					\
+  /* 0x09 */			"EXTENDED-PROCEDURE",			\
+  /* 0x0A */			"VECTOR",				\
+  /* 0x0B */ 			"RETURN-CODE",				\
+  /* 0x0C */			"COMBINATION-2",			\
+  /* 0x0D */			"COMPILED-PROCEDURE",			\
+  /* 0x0E */			"BIG-FIXNUM",				\
+  /* 0x0F */			"PROCEDURE",				\
+  /* 0x10 */			"ENTITY",				\
+  /* 0x11 */			"DELAY",				\
+  /* 0x12 */			"ENVIRONMENT",				\
+  /* 0x13 */			"DELAYED",				\
+  /* 0x14 */			"EXTENDED-LAMBDA",			\
+  /* 0x15 */			"COMMENT",				\
+  /* 0x16 */			"NON-MARKED-VECTOR",			\
+  /* 0x17 */			"LAMBDA",				\
+  /* 0x18 */			"PRIMITIVE",				\
+  /* 0x19 */			"SEQUENCE-2",				\
+  /* 0x1A */			"FIXNUM",				\
+  /* 0x1B */			"PCOMB1",				\
+  /* 0x1C */			"CONTROL-POINT",			\
+  /* 0x1D */			"INTERNED-SYMBOL",			\
+  /* 0x1E */			"CHARACTER-STRING",			\
+  /* 0x1F */			"ACCESS",				\
+  /* 0x20 */			"HUNK3-A",				\
+  /* 0x21 */			"DEFINITION",				\
+  /* 0x22 */			"BROKEN-HEART",				\
+  /* 0x23 */			"ASSIGNMENT",				\
+  /* 0x24 */			"HUNK3-B",				\
+  /* 0x25 */			"IN-PACKAGE",				\
+  /* 0x26 */			"COMBINATION",				\
+  /* 0x27 */			"MANIFEST-NM-VECTOR",			\
+  /* 0x28 */			"COMPILED-EXPRESSION",			\
+  /* 0x29 */			"LEXPR",				\
+  /* 0x2A */  			"PCOMB3",				\
+  /* 0x2B */			"MANIFEST-SPECIAL-NM-VECTOR",		\
+  /* 0x2C */			"VARIABLE",				\
+  /* 0x2D */			"THE-ENVIRONMENT",			\
+  /* 0x2E */			"FUTURE",				\
+  /* 0x2F */			"VECTOR-1B",				\
+  /* 0x30 */			"PCOMB0",				\
+  /* 0x31 */			"VECTOR-16B",				\
+  /* 0x32 */			"REFERENCE-TRAP",			\
+  /* 0x33 */			"SEQUENCE-3",				\
+  /* 0x34 */			"CONDITIONAL",				\
+  /* 0x35 */			"DISJUNCTION",				\
+  /* 0x36 */			"CELL",					\
+  /* 0x37 */			"WEAK-CONS",				\
+  /* 0x38 */			"QUAD",					\
+  /* 0x39 */			"RETURN-ADDRESS",			\
+  /* 0x3A */			"RATNUM",				\
+  /* 0x3B */			"STACK-ENVIRONMENT",			\
+  /* 0x3C */			"COMPLEX",				\
+  /* 0x3D */			"COMPILED-CODE-BLOCK"			\
+  }
+
+/* Flags and aliases */
 
-/* Remove #if false and #endif if type code 0x10 is reused. */
+/* Type code 0x10 (used to be TC_PRIMITIVE_EXTERNAL) has been reused. */
 
-#if false
 #define PRIMITIVE_EXTERNAL_REUSED
-#endif
 
 /* Aliases */
 
diff --git a/v7/src/microcode/utabmd.scm b/v7/src/microcode/utabmd.scm
index d8d747b95..a5101e9bf 100644
--- a/v7/src/microcode/utabmd.scm
+++ b/v7/src/microcode/utabmd.scm
@@ -37,7 +37,7 @@
 
 ;;;; Machine Dependent Type Tables
 
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.41 1988/02/06 20:43:02 jinx Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.42 1988/02/12 16:53:42 jinx Exp $
 
 (declare (usual-integrations))
 
@@ -112,7 +112,7 @@
 	       COMPILED-PROCEDURE 	       		;0D
 	       (BIGNUM BIG-FIXNUM)			;0E
 	       PROCEDURE				;0F
-	       #F					;10
+	       (ENTITY)					;10
 	       DELAY					;11
 	       ENVIRONMENT		      		;12
 	       DELAYED					;13
@@ -154,9 +154,9 @@
 	       WEAK-CONS				;37
 	       QUAD        				;38
 	       COMPILER-RETURN-ADDRESS			;39
-	       COMPILER-LINK				;3A
+	       RATNUM					;3A
 	       STACK-ENVIRONMENT			;3B
-	       COMPLEX       				;3C
+	       (RECNUM COMPLEX)				;3C
 	       COMPILED-CODE-BLOCK			;3D
 	       #F					;3E
 	       #F					;3F
@@ -569,4 +569,4 @@
 
 ;;; This identification string is saved by the system.
 
-"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.41 1988/02/06 20:43:02 jinx Exp $"
\ No newline at end of file
+"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.42 1988/02/12 16:53:42 jinx Exp $"
\ No newline at end of file
diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h
index a4d4aeeb5..03f6a1288 100644
--- a/v7/src/microcode/version.h
+++ b/v7/src/microcode/version.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/Attic/version.h,v 10.20 1988/02/06 20:43:29 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.21 1988/02/12 16:53:59 jinx Exp $
 
 This file contains version information for the microcode. */
 
@@ -46,7 +46,7 @@ This file contains version information for the microcode. */
 #define VERSION		10
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION	20
+#define SUBVERSION	21
 #endif
 
 #ifndef UCODE_TABLES_FILENAME
diff --git a/v8/src/microcode/gctype.c b/v8/src/microcode/gctype.c
index 400988a0c..57f6c3c65 100644
--- a/v8/src/microcode/gctype.c
+++ b/v8/src/microcode/gctype.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/gctype.c,v 9.26 1987/11/17 08:11:56 jinx Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/gctype.c,v 9.27 1988/02/12 16:51:15 jinx Exp $
  *
  * This file contains the table which maps between Types and
  * GC Types.
@@ -58,7 +58,7 @@ int GC_Type_Map[MAX_TYPE_CODE + 1] = {
     GC_Pair,			/* TC_COMPILED_PROCEDURE */
     GC_Vector,			/* TC_BIG_FIXNUM */
     GC_Pair,			/* TC_PROCEDURE */
-    GC_Undefined,			/* 0x10 */
+    GC_Pair,			/* TC_ENTITY */
     GC_Pair,			/* TC_DELAY */
     GC_Vector,			/* TC_ENVIRONMENT */
     GC_Pair,			/* TC_DELAYED */
@@ -105,7 +105,7 @@ int GC_Type_Map[MAX_TYPE_CODE + 1] = {
     GC_Pair,			/* TC_WEAK_CONS */
     GC_Quadruple,		/* TC_QUAD */
     GC_Compiled,		/* TC_RETURN_ADDRESS */
-    GC_Pair,			/* TC_COMPILER_LINK */
+    GC_Pair,			/* TC_RATNUM */
     GC_Non_Pointer,		/* TC_STACK_ENVIRONMENT */
     GC_Pair,			/* TC_COMPLEX */
     GC_Vector,			/* TC_COMPILED_CODE_BLOCK */
diff --git a/v8/src/microcode/interp.c b/v8/src/microcode/interp.c
index 1888d6e88..84ce3e9d9 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.37 1987/12/04 22:17:11 jinx Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/interp.c,v 9.38 1988/02/12 16:51:27 jinx Exp $
  *
  * This file contains the heart of the Scheme Scode
  * interpreter
@@ -542,16 +542,18 @@ Do_Expression:
 
 Eval_Non_Trapping:
   Eval_Ucode_Hook();
-  switch (Type_Code(Fetch_Expression()))
+  switch (OBJECT_TYPE(Fetch_Expression()))
   {
     case TC_BIG_FIXNUM:         /* The self evaluating items */
     case TC_BIG_FLONUM:
     case TC_CHARACTER_STRING:
     case TC_CHARACTER:
+    case TC_COMPILED_CODE_BLOCK:
     case TC_COMPILED_PROCEDURE:
     case TC_COMPLEX:
     case TC_CONTROL_POINT:
     case TC_DELAYED:
+    case TC_ENTITY:
     case TC_ENVIRONMENT:
     case TC_EXTENDED_PROCEDURE:
     case TC_FIXNUM:
@@ -564,13 +566,16 @@ Eval_Non_Trapping:
     case TC_PRIMITIVE:
     case TC_PROCEDURE:
     case TC_QUAD:
+    case TC_RATNUM:
+    case TC_REFERENCE_TRAP:
+    case TC_RETURN_CODE:
     case TC_UNINTERNED_SYMBOL:
     case TC_TRUE: 
     case TC_VECTOR:
     case TC_VECTOR_16B:
     case TC_VECTOR_1B:
-    case TC_REFERENCE_TRAP:
-      Val = Fetch_Expression(); break;
+      Val = Fetch_Expression();
+      break;
 
     case TC_ACCESS:
      Will_Push(CONTINUATION_SIZE);
@@ -853,7 +858,6 @@ lookup_end_restart:
 
     SITE_EXPRESSION_DISPATCH_HOOK()
 
-    case TC_RETURN_CODE:
     default: Eval_Error(ERR_UNDEFINED_USER_TYPE);
   };
 
@@ -1356,6 +1360,24 @@ Perform_Application:
         switch(Type_Code(Function))
         { 
 
+	  case TC_ENTITY:
+	  {
+	    fast long nargs;
+
+	    /* Will_Pushed ommited since frame must be contiguous.
+	       combination code must ensure one more slot.
+	     */
+
+	    /* This code assumes that adding 1 to nargs takes care
+	       of everything, including type code, etc.
+	     */
+	    nargs = Pop();
+	    Push(Fast_Vector_Ref(Function, ENTITY_OPERATOR));
+	    Push(nargs + 1);
+	    /* No interrupts, etc. */
+	    goto Perform_Application;
+	  }
+
 /* Interpret() continues on the next page */
 
 /* Interpret(), continued */
diff --git a/v8/src/microcode/ppband.c b/v8/src/microcode/ppband.c
index c0c0247df..f7b8231b4 100644
--- a/v8/src/microcode/ppband.c
+++ b/v8/src/microcode/ppband.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/ppband.c,v 9.31 1988/02/10 15:42:58 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/ppband.c,v 9.32 1988/02/12 16:49:27 jinx Rel $
  *
  * Dumps Scheme FASL in user-readable form .
  */
@@ -184,6 +184,8 @@ static char string_buffer[10];
   break;								\
 }
 
+char *Type_Names[] = TYPE_NAME_TABLE;
+
 void
 Display(Location, Type, The_Datum)
      long Location, Type, The_Datum;
@@ -210,21 +212,18 @@ Display(Location, Type, The_Datum)
 	printf("TRUE\n");
 	return;
       }
-      NON_POINTER("TRUE");
+      /* fall through */
 
-    case TC_MANIFEST_SPECIAL_NM_VECTOR:
-      NON_POINTER("MANIFEST-SPECIAL-NM");
 
+    case TC_CHARACTER:
+    case TC_RETURN_CODE:
+    case TC_PRIMITIVE:
+    case TC_THE_ENVIRONMENT:
+    case TC_PCOMB0:
+    case TC_MANIFEST_SPECIAL_NM_VECTOR:
     case TC_MANIFEST_NM_VECTOR:
-      NON_POINTER("MANIFEST-NM-VECTOR");
+      NON_POINTER(Type_Names[Type]);
 
-    case TC_BROKEN_HEART:
-      if (The_Datum == 0)
-      {
-	Points_To = 0;
-      }
-      POINTER("BROKEN-HEART");
-
     case TC_INTERNED_SYMBOL:
       PRINT_OBJECT("INTERNED-SYMBOL", Points_To);
       printf(" = ");
@@ -259,62 +258,21 @@ Display(Location, Type, The_Datum)
 	POINTER("REFERENCE-TRAP");
       }
 
-    case TC_CHARACTER:			NON_POINTER("CHARACTER");
-    case TC_RETURN_CODE:		NON_POINTER("RETURN-CODE");
-    case TC_PRIMITIVE:			NON_POINTER("PRIMITIVE");
-    case TC_THE_ENVIRONMENT:		NON_POINTER("THE-ENVIRONMENT");
-    case TC_PCOMB0:			NON_POINTER("PCOMB0");
-    case TC_LIST:			POINTER("LIST");
-    case TC_SCODE_QUOTE:		POINTER("SCODE-QUOTE");
-    case TC_PCOMB2:			POINTER("PCOMB2");
-    case TC_BIG_FLONUM:			POINTER("FLONUM");
-
-    case TC_COMBINATION_1:		POINTER("COMBINATION-1");
-    case TC_EXTENDED_PROCEDURE:		POINTER("EXTENDED-PROCEDURE");
-    case TC_VECTOR:			POINTER("VECTOR");
-    case TC_COMBINATION_2:		POINTER("COMBINATION-2");
-    case TC_COMPILED_PROCEDURE:		POINTER("COMPILED-PROCEDURE");
-    case TC_BIG_FIXNUM:			POINTER("BIG-FIXNUM");
-    case TC_PROCEDURE:			POINTER("PROCEDURE");
-    case TC_DELAY:			POINTER("DELAY");
-    case TC_ENVIRONMENT:		POINTER("ENVIRONMENT");
-    case TC_DELAYED:			POINTER("DELAYED");
-    case TC_EXTENDED_LAMBDA:		POINTER("EXTENDED-LAMBDA");
-    case TC_COMMENT:			POINTER("COMMENT");
-    case TC_NON_MARKED_VECTOR:		POINTER("NON-MARKED-VECTOR");
-    case TC_LAMBDA:			POINTER("LAMBDA");
-    case TC_SEQUENCE_2:			POINTER("SEQUENCE-2");
-    case TC_PCOMB1:			POINTER("PCOMB1");
-    case TC_CONTROL_POINT:		POINTER("CONTROL-POINT");
-    case TC_ACCESS:			POINTER("ACCESS");
-    case TC_DEFINITION:			POINTER("DEFINITION");
-    case TC_ASSIGNMENT:			POINTER("ASSIGNMENT");
-    case TC_HUNK3_A:			POINTER("HUNK3_A");
-    case TC_HUNK3_B:			POINTER("HUNK3-B");
-    case TC_IN_PACKAGE:			POINTER("IN-PACKAGE");
-    case TC_COMBINATION:		POINTER("COMBINATION");
-    case TC_COMPILED_EXPRESSION:	POINTER("COMPILED-EXPRESSION");
-    case TC_LEXPR:			POINTER("LEXPR");
-    case TC_PCOMB3:			POINTER("PCOMB3");
-    case TC_VARIABLE:			POINTER("VARIABLE");
-    case TC_FUTURE:			POINTER("FUTURE");
-    case TC_VECTOR_1B:			POINTER("VECTOR-1B");
-    case TC_VECTOR_16B:			POINTER("VECTOR-16B");
-    case TC_SEQUENCE_3:			POINTER("SEQUENCE-3");
-    case TC_CONDITIONAL:		POINTER("CONDITIONAL");
-    case TC_DISJUNCTION:		POINTER("DISJUNCTION");
-    case TC_CELL:			POINTER("CELL");
-    case TC_WEAK_CONS:			POINTER("WEAK-CONS");
-    case TC_RETURN_ADDRESS:		POINTER("RETURN-ADDRESS");
-    case TC_COMPILER_LINK:		POINTER("COMPILER_LINK");
-    case TC_STACK_ENVIRONMENT:		POINTER("STACK-ENVIRONMENT");
-    case TC_COMPLEX:			POINTER("COMPLEX");
-    case TC_QUAD:			POINTER("QUAD");
-    case TC_COMPILED_CODE_BLOCK:	POINTER("COMPILED-CODE-BLOCK");
-
+    case TC_BROKEN_HEART:
+      if (The_Datum == 0)
+      {
+	Points_To = 0;
+      }
     default:
-      sprintf(&the_string[0], "0x%02lx ", Type);
-      POINTER(&the_string[0]);
+      if (Type <= LAST_TYPE_CODE)
+      {
+	POINTER(Type_Names[Type]);
+      }
+      else
+      {
+	sprintf(&the_string[0], "0x%02lx ", Type);
+	POINTER(&the_string[0]);
+      }
   }
   PRINT_OBJECT(the_string, Points_To);
   putchar('\n');
diff --git a/v8/src/microcode/types.h b/v8/src/microcode/types.h
index ab28f916d..680391c02 100644
--- a/v8/src/microcode/types.h
+++ b/v8/src/microcode/types.h
@@ -30,12 +30,14 @@ 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/types.h,v 9.26 1987/11/17 08:18:54 jinx Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/types.h,v 9.27 1988/02/12 16:52:46 jinx Exp $
  *
  * Type code definitions, numerical order
  *
  */
 
+/*	Name				Value	Previous Name */
+
 #define TC_NULL	                	0x00
 #define TC_LIST				0x01
 #define TC_CHARACTER			0x02
@@ -52,9 +54,7 @@ MIT in each case. */
 #define TC_COMPILED_PROCEDURE		0x0D
 #define TC_BIG_FIXNUM			0x0E
 #define TC_PROCEDURE			0x0F
-/* 0x10 used to be TC_PRIMITIVE_EXTERNAL */
-/* if it is reused, define PRIMITIVE_EXTERNAL_REUSED below. */
-/* Unused				0x10 */
+#define TC_ENTITY			0x10 /* PRIMITIVE_EXTERNAL */
 #define TC_DELAY			0x11
 #define TC_ENVIRONMENT			0x12
 #define TC_DELAYED			0x13
@@ -71,7 +71,7 @@ MIT in each case. */
 #define TC_INTERNED_SYMBOL		0x1D
 #define TC_CHARACTER_STRING		0x1E
 #define TC_ACCESS			0x1F
-#define TC_HUNK3_A			0x20 /* Used to be EXTENDED_FIXNUM. */
+#define TC_HUNK3_A			0x20 /* EXTENDED_FIXNUM */
 #define TC_DEFINITION			0x21
 #define TC_BROKEN_HEART			0x22
 #define TC_ASSIGNMENT			0x23
@@ -89,26 +89,96 @@ MIT in each case. */
 #define TC_VECTOR_1B			0x2F
 #define TC_PCOMB0			0x30
 #define TC_VECTOR_16B			0x31
-#define TC_REFERENCE_TRAP		0x32 /* Used to be UNASSIGNED. */
+#define TC_REFERENCE_TRAP		0x32 /* UNASSIGNED */
 #define TC_SEQUENCE_3			0x33
 #define TC_CONDITIONAL			0x34
 #define TC_DISJUNCTION			0x35
 #define TC_CELL				0x36
 #define TC_WEAK_CONS			0x37
-#define TC_QUAD				0x38 /* Used to be TC_TRAP. */
+#define TC_QUAD				0x38 /* TRAP */
 #define TC_RETURN_ADDRESS		0x39
-#define TC_COMPILER_LINK		0x3A
+#define TC_RATNUM			0x3A /* COMPILER_LINK */
 #define TC_STACK_ENVIRONMENT		0x3B
 #define TC_COMPLEX			0x3C
 #define TC_COMPILED_CODE_BLOCK		0x3D
 
-/* If you add a new type, don't forget to update gccode.h and gctype.c */
+/* If you add a new type, don't forget to update gccode.h, gctype.c,
+   and the type name table below.
+ */
+
+#define LAST_TYPE_CODE			0X3D
+
+#define TYPE_NAME_TABLE							\
+{									\
+  /* 0x00 */	                "NULL",					\
+  /* 0x01 */			"LIST",					\
+  /* 0x02 */			"CHARACTER",				\
+  /* 0x03 */                 	"SCODE-QUOTE",				\
+  /* 0x04 */			"PCOMB2",				\
+  /* 0x05 */			"UNINTERNED-SYMBOL",			\
+  /* 0x06 */			"BIG-FLONUM",				\
+  /* 0x07 */			"COMBINATION-1",			\
+  /* 0x08 */			"TRUE",					\
+  /* 0x09 */			"EXTENDED-PROCEDURE",			\
+  /* 0x0A */			"VECTOR",				\
+  /* 0x0B */ 			"RETURN-CODE",				\
+  /* 0x0C */			"COMBINATION-2",			\
+  /* 0x0D */			"COMPILED-PROCEDURE",			\
+  /* 0x0E */			"BIG-FIXNUM",				\
+  /* 0x0F */			"PROCEDURE",				\
+  /* 0x10 */			"ENTITY",				\
+  /* 0x11 */			"DELAY",				\
+  /* 0x12 */			"ENVIRONMENT",				\
+  /* 0x13 */			"DELAYED",				\
+  /* 0x14 */			"EXTENDED-LAMBDA",			\
+  /* 0x15 */			"COMMENT",				\
+  /* 0x16 */			"NON-MARKED-VECTOR",			\
+  /* 0x17 */			"LAMBDA",				\
+  /* 0x18 */			"PRIMITIVE",				\
+  /* 0x19 */			"SEQUENCE-2",				\
+  /* 0x1A */			"FIXNUM",				\
+  /* 0x1B */			"PCOMB1",				\
+  /* 0x1C */			"CONTROL-POINT",			\
+  /* 0x1D */			"INTERNED-SYMBOL",			\
+  /* 0x1E */			"CHARACTER-STRING",			\
+  /* 0x1F */			"ACCESS",				\
+  /* 0x20 */			"HUNK3-A",				\
+  /* 0x21 */			"DEFINITION",				\
+  /* 0x22 */			"BROKEN-HEART",				\
+  /* 0x23 */			"ASSIGNMENT",				\
+  /* 0x24 */			"HUNK3-B",				\
+  /* 0x25 */			"IN-PACKAGE",				\
+  /* 0x26 */			"COMBINATION",				\
+  /* 0x27 */			"MANIFEST-NM-VECTOR",			\
+  /* 0x28 */			"COMPILED-EXPRESSION",			\
+  /* 0x29 */			"LEXPR",				\
+  /* 0x2A */  			"PCOMB3",				\
+  /* 0x2B */			"MANIFEST-SPECIAL-NM-VECTOR",		\
+  /* 0x2C */			"VARIABLE",				\
+  /* 0x2D */			"THE-ENVIRONMENT",			\
+  /* 0x2E */			"FUTURE",				\
+  /* 0x2F */			"VECTOR-1B",				\
+  /* 0x30 */			"PCOMB0",				\
+  /* 0x31 */			"VECTOR-16B",				\
+  /* 0x32 */			"REFERENCE-TRAP",			\
+  /* 0x33 */			"SEQUENCE-3",				\
+  /* 0x34 */			"CONDITIONAL",				\
+  /* 0x35 */			"DISJUNCTION",				\
+  /* 0x36 */			"CELL",					\
+  /* 0x37 */			"WEAK-CONS",				\
+  /* 0x38 */			"QUAD",					\
+  /* 0x39 */			"RETURN-ADDRESS",			\
+  /* 0x3A */			"RATNUM",				\
+  /* 0x3B */			"STACK-ENVIRONMENT",			\
+  /* 0x3C */			"COMPLEX",				\
+  /* 0x3D */			"COMPILED-CODE-BLOCK"			\
+  }
+
+/* Flags and aliases */
 
-/* Remove #if false and #endif if type code 0x10 is reused. */
+/* Type code 0x10 (used to be TC_PRIMITIVE_EXTERNAL) has been reused. */
 
-#if false
 #define PRIMITIVE_EXTERNAL_REUSED
-#endif
 
 /* Aliases */
 
diff --git a/v8/src/microcode/utabmd.scm b/v8/src/microcode/utabmd.scm
index 4546f4db2..a5f9eb59a 100644
--- a/v8/src/microcode/utabmd.scm
+++ b/v8/src/microcode/utabmd.scm
@@ -37,7 +37,7 @@
 
 ;;;; Machine Dependent Type Tables
 
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.41 1988/02/06 20:43:02 jinx Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.42 1988/02/12 16:53:42 jinx Exp $
 
 (declare (usual-integrations))
 
@@ -112,7 +112,7 @@
 	       COMPILED-PROCEDURE 	       		;0D
 	       (BIGNUM BIG-FIXNUM)			;0E
 	       PROCEDURE				;0F
-	       #F					;10
+	       (ENTITY)					;10
 	       DELAY					;11
 	       ENVIRONMENT		      		;12
 	       DELAYED					;13
@@ -154,9 +154,9 @@
 	       WEAK-CONS				;37
 	       QUAD        				;38
 	       COMPILER-RETURN-ADDRESS			;39
-	       COMPILER-LINK				;3A
+	       RATNUM					;3A
 	       STACK-ENVIRONMENT			;3B
-	       COMPLEX       				;3C
+	       (RECNUM COMPLEX)				;3C
 	       COMPILED-CODE-BLOCK			;3D
 	       #F					;3E
 	       #F					;3F
@@ -569,4 +569,4 @@
 
 ;;; This identification string is saved by the system.
 
-"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.41 1988/02/06 20:43:02 jinx Exp $"
\ No newline at end of file
+"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.42 1988/02/12 16:53:42 jinx Exp $"
\ No newline at end of file
diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h
index 0ff5327bb..f7f527c2a 100644
--- a/v8/src/microcode/version.h
+++ b/v8/src/microcode/version.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/version.h,v 10.20 1988/02/06 20:43:29 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.21 1988/02/12 16:53:59 jinx Exp $
 
 This file contains version information for the microcode. */
 
@@ -46,7 +46,7 @@ This file contains version information for the microcode. */
 #define VERSION		10
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION	20
+#define SUBVERSION	21
 #endif
 
 #ifndef UCODE_TABLES_FILENAME