1) Fix allocation bug in FILE-ATTRIBUTES.
authorGuillermo J. Rozas <edu/mit/csail/zurich/gjr>
Fri, 12 Feb 1988 16:53:59 +0000 (16:53 +0000)
committerGuillermo J. Rozas <edu/mit/csail/zurich/gjr>
Fri, 12 Feb 1988 16:53:59 +0000 (16:53 +0000)
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 .

23 files changed:
v7/src/microcode/bchdmp.c
v7/src/microcode/bchgcl.c
v7/src/microcode/bchpur.c
v7/src/microcode/debug.c
v7/src/microcode/fasdump.c
v7/src/microcode/gccode.h
v7/src/microcode/gcloop.c
v7/src/microcode/gctype.c
v7/src/microcode/interp.c
v7/src/microcode/ppband.c
v7/src/microcode/pruxfs.c
v7/src/microcode/purify.c
v7/src/microcode/sdata.h
v7/src/microcode/storage.c
v7/src/microcode/types.h
v7/src/microcode/utabmd.scm
v7/src/microcode/version.h
v8/src/microcode/gctype.c
v8/src/microcode/interp.c
v8/src/microcode/ppband.c
v8/src/microcode/types.h
v8/src/microcode/utabmd.scm
v8/src/microcode/version.h

index 2ec2204ce909d123c97d2c7513c3f68e5f68d260..23b90d9511c498a322d8d2e414ba1f62e6187e1b 100644 (file)
@@ -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();
       }
   }
index 7e88751739cc5f61d4381411a75ea2c41d7cc196..10525043358df2dadafcdafdcb4f195ec0535607 100644 (file)
@@ -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);
 }
index abc6de0b893fea79f6b780b89f1f4f992bb01211..4d15df8667f072751f9c75efb729a6e179af2257 100644 (file)
@@ -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);
 }
 \f
 /* This is not paranoia!
index fea910a09cac3b78877ea4b6edb7cee22e42c475..b65d0a9cb91d98111fe80bff827df2f38b7bd1de 100644 (file)
@@ -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);
 }
+\f
+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:
 \f
 /* 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:
 \f
 /* 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;
 }
 \f
 Boolean
index eb366ebb2f44ac6687c5caf33e8d65a2e486203c..11a917a39f0f14e0991160ae148ddfc390586f77 100644 (file)
@@ -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;
index eab2df076778913f082f9eb9d1df1e6b59b79e90..681f42592fa0eb51f04c70b403f0f8f6b714a50e 100644 (file)
@@ -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:                              \
index 0c66a1525b622a2f2e09b948b61d3d6000ab36e3..374cd5a656a5c56becee6a522e3e9e3d7f628b8b 100644 (file)
@@ -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 */
index ad266c64277ed33aff7702750c0ea5999ded8713..2f0c594ebdd8d92fe2d989350fda039d5b519225 100644 (file)
@@ -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 */
index ce4bfbaeb410410df040584c667a81a1f9a4a9bc..fe0b650e2d9771bb45765eed4bcab819aa597556 100644 (file)
@@ -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:
 \f
 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 */
 \f
 /* Interpret(), continued */
index a258fd14c53f7b5bf0cebd5056b3238cee22f21c..9e22e955219f4e222ee416d559535b2707332d5c 100644 (file)
@@ -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]);
 \f
-    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");
-\f
-    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');
index 02f362496f7594777e359e4c383faeb6a60a2627..49d42e913d1cdf71a8cf912d5645236810a6d2f0 100644 (file)
@@ -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));
 }
 \f
-/* 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,
index 22c14f4852a30fa750e948045563fbde529737e6..073e85cf9dbace94dedf303333d8450dfe52e1bf 100644 (file)
@@ -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 */
 \f
 /* Description of the algorithm for PURIFY:
index 1ba1196c9df1c854f17bfd7f31d09b45e5d2f108..4a74b8bb8bad7dd36f96cd88260403c00ce935ed 100644 (file)
@@ -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
index 2fa769fefcd7c03e4e54698112dfe777be44257f..176a7ed735d694d06e18cda5bfbbbb321b5aac97 100644 (file)
@@ -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 */
 
index 7a073f16799cf6e5a14a84e0f6be2cad5886b1cf..d7af60610dfa1f612460edf14514d7f62e02738d 100644 (file)
@@ -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
  *
  */
 \f
+/*     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
+\f
+#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"                   \
+  }
+\f
+/* 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 */
 
index d8d747b95600e1da845372dee07585f24c58bb37..a5101e9bff5888b86d3b6476f4a2a01c12fc0f74 100644 (file)
@@ -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))
 
               COMPILED-PROCEDURE                       ;0D
               (BIGNUM BIG-FIXNUM)                      ;0E
               PROCEDURE                                ;0F
-              #F                                       ;10
+              (ENTITY)                                 ;10
               DELAY                                    ;11
               ENVIRONMENT                              ;12
               DELAYED                                  ;13
               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
 
 ;;; 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
index a4d4aeeb5d941beabec4dd735a622225a39b12bd..03f6a12881a66e1df2e7ed19c3359c81444acffd 100644 (file)
@@ -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. */
 \f
@@ -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
index 400988a0c41dd194ad18232e8b31855a61d6a4f8..57f6c3c65f0c0d7d64acbb0a03c74f1108d7f834 100644 (file)
@@ -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 */
index 1888d6e888dd76f4f6fc0a23b5d5c2d726a3894d..84ce3e9d9b36630f6500ac9d0f3381cbd0fb5bdc 100644 (file)
@@ -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:
 \f
 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 */
 \f
 /* Interpret(), continued */
index c0c0247dfce423144a4c49c7f62e07d31a4b41b7..f7b8231b4e03612e0673209ce771aeb59a481292 100644 (file)
@@ -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]);
 \f
-    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");
-\f
-    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');
index ab28f916d949a3ab23e6fd48d4beab2dc4d9352c..680391c02b02a62b286782b2503cb427e75cd27f 100644 (file)
@@ -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
  *
  */
 \f
+/*     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
+\f
+#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"                   \
+  }
+\f
+/* 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 */
 
index 4546f4db2322825b62f0e4f30df4edd0bb3ccbda..a5f9eb59af7b1e51b85b34a0f2f7b0e2c7c1d998 100644 (file)
@@ -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))
 
               COMPILED-PROCEDURE                       ;0D
               (BIGNUM BIG-FIXNUM)                      ;0E
               PROCEDURE                                ;0F
-              #F                                       ;10
+              (ENTITY)                                 ;10
               DELAY                                    ;11
               ENVIRONMENT                              ;12
               DELAYED                                  ;13
               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
 
 ;;; 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
index 0ff5327bb1052ef763149b5c6f40b438dae01f1f..f7f527c2a07ea84648c09d67fef9428f38d941af 100644 (file)
@@ -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. */
 \f
@@ -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