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 .
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
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();
}
}
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
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);
}
/* -*-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
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!
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
*/
}
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);
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++;
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 */
/* 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;
}
/* 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);
printf(" ...)");
}
return;
+
case TC_COMBINATION_1:
printf("[COMBINATION_1 0x%x]", Temp_Address);
if (Detailed)
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;
printf(")");
return;
}
+
case TC_EXTENDED_LAMBDA:
if (Detailed)
printf("[EXTENDED_LAMBDA (");
\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)
{
}
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)
{
\f
/* Do_Printing, continued */
- case TC_QUAD: printf("[QUAD"); break;
case TC_REFERENCE_TRAP:
{
printf("[REFERENCE-TRAP");
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
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.
*/
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;
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
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: \
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.
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 */
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.
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 */
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 */
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
\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:
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);
SITE_EXPRESSION_DISPATCH_HOOK()
- case TC_RETURN_CODE:
default: Eval_Error(ERR_UNDEFINED_USER_TYPE);
};
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 */
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 .
*/
break; \
}
+char *Type_Names[] = TYPE_NAME_TABLE;
+
void
Display(Location, Type, The_Datum)
long 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(" = ");
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');
/* -*-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
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
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,
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.
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:
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.
#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
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. */
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 */
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
#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
#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
#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 */
;;;; 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
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
#define VERSION 10
#endif
#ifndef SUBVERSION
-#define SUBVERSION 20
+#define SUBVERSION 21
#endif
#ifndef UCODE_TABLES_FILENAME
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.
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 */
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 */
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
\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:
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);
SITE_EXPRESSION_DISPATCH_HOOK()
- case TC_RETURN_CODE:
default: Eval_Error(ERR_UNDEFINED_USER_TYPE);
};
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 */
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 .
*/
break; \
}
+char *Type_Names[] = TYPE_NAME_TABLE;
+
void
Display(Location, Type, The_Datum)
long 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(" = ");
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');
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
#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
#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
#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 */
;;;; 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
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
#define VERSION 10
#endif
#ifndef SUBVERSION
-#define SUBVERSION 20
+#define SUBVERSION 21
#endif
#ifndef UCODE_TABLES_FILENAME