From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Fri, 3 Apr 1987 00:48:04 +0000 (+0000)
Subject: Rewrite of the variable lookup code and slight tuning of the interpreter.
X-Git-Tag: 20090517-FFI~13652
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d22932b29eda86407b9313ded87896ca110ce13f;p=mit-scheme.git
Rewrite of the variable lookup code and slight tuning of the interpreter.
---
diff --git a/v7/src/microcode/fhooks.c b/v7/src/microcode/fhooks.c
index 624cb8089..3a606bc0d 100644
--- a/v7/src/microcode/fhooks.c
+++ b/v7/src/microcode/fhooks.c
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
promotional, or sales literature without prior written consent from
MIT in each case. */
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/fhooks.c,v 9.21 1987/01/22 14:24:45 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/fhooks.c,v 9.22 1987/04/03 00:43:16 jinx Exp $
*
* This file contains hooks and handles for the new fluid bindings
* scheme for multiprocessors.
@@ -38,35 +38,50 @@ MIT in each case. */
#include "scheme.h"
#include "primitive.h"
+#include "trap.h"
+#include "lookup.h"
#include "locks.h"
-
+
/* (SET-FLUID-BINDINGS! NEW-BINDINGS)
- Sets the microcode fluid-bindings variable. Returns the previous value.
+ Sets the microcode fluid-bindings variable. Returns the previous value.
*/
+
Define_Primitive(Prim_Set_Fluid_Bindings, 1, "SET-FLUID-BINDINGS!")
-{ Pointer Result;
+{
+ Pointer Result;
Primitive_1_Arg();
- if (Arg1 != NIL) Arg_1_Type(TC_LIST);
+
+ if (Arg1 != NIL)
+ Arg_1_Type(TC_LIST);
+
Result = Fluid_Bindings;
Fluid_Bindings = Arg1;
return Result;
}
/* (GET-FLUID-BINDINGS NEW-BINDINGS)
- Gets the microcode fluid-bindings variable.
+ Gets the microcode fluid-bindings variable.
*/
+
Define_Primitive(Prim_Get_Fluid_Bindings, 0, "GET-FLUID-BINDINGS")
-{ Primitive_0_Args();
+{
+ Primitive_0_Args();
+
return Fluid_Bindings;
}
/* (WITH-SAVED-FLUID-BINDINGS THUNK)
- Executes THUNK, then restores the previous fluid bindings.
+ Executes THUNK, then restores the previous fluid bindings.
*/
+
Define_Primitive(Prim_With_Saved_Fluid_Bindings,1,"WITH-SAVED-FLUID-BINDINGS")
-{ Primitive_1_Arg();
+{
+ Primitive_1_Arg();
+
Pop_Primitive_Frame(1);
+
/* Save previous fluid bindings for later restore */
+
Will_Push(CONTINUATION_SIZE + STACK_ENV_EXTRA_SLOTS + 1);
Store_Expression(Fluid_Bindings);
Store_Return(RC_RESTORE_FLUIDS);
@@ -77,67 +92,157 @@ Define_Primitive(Prim_With_Saved_Fluid_Bindings,1,"WITH-SAVED-FLUID-BINDINGS")
longjmp(*Back_To_Eval, PRIM_APPLY);
}
+/* Utilities for the primitives below. */
+
+Pointer
+*lookup_slot(env, var)
+{
+ Pointer *cell, *hunk, value;
+ long trap_kind;
+
+ hunk = Get_Pointer(var);
+ lookup(cell, env, hunk, repeat_slot_lookup);
+
+ value = Fetch(cell[0]);
+
+ if (Type_Code(value) != TC_REFERENCE_TRAP)
+ {
+ return cell;
+ }
+
+ get_trap_kind(trap_kind, value);
+ switch(trap_kind)
+ {
+ case TRAP_DANGEROUS:
+ case TRAP_UNBOUND_DANGEROUS:
+ case TRAP_UNASSIGNED_DANGEROUS:
+ case TRAP_FLUID_DANGEROUS:
+ return deep_lookup(env, hunk[VARIABLE_SYMBOL], hunk);
+
+ case TRAP_FLUID:
+ case TRAP_UNBOUND:
+ case TRAP_UNASSIGNED:
+ return cell;
+
+ default:
+ Primitive_Error(ERR_BROKEN_COMPILED_VARIABLE);
+ }
+}
+
+Pointer
+new_fluid_binding(cell, value, force)
+ Pointer *cell;
+ Pointer value;
+ Boolean force;
+{
+ fast Pointer trap;
+ Lock_Handle set_serializer;
+ Pointer new_trap_value;
+ long new_trap_kind, trap_kind;
+
+ setup_lock(set_serializer, cell);
+
+ new_trap_kind = TRAP_FLUID;
+ trap = *cell;
+ new_trap_value = trap;
+
+ if (Type_Code(trap) == TC_REFERENCE_TRAP)
+ {
+ get_trap_kind(trap_kind, trap);
+ switch(trap_kind)
+ {
+ case TRAP_DANGEROUS:
+ Vector_Set(trap,
+ TRAP_TAG,
+ Make_Unsigned_Fixnum(TRAP_FLUID_DANGEROUS));
+
+ /* Fall through */
+ case TRAP_FLUID:
+ case TRAP_FLUID_DANGEROUS:
+ new_trap_kind = TRAP_NOP;
+ break;
+
+ case TRAP_UNBOUND:
+ case TRAP_UNBOUND_DANGEROUS:
+ if (!force)
+ {
+ remove_lock(set_serializer);
+ Primitive_Error(ERR_UNBOUND_VARIABLE);
+ }
+ /* Fall through */
+ case TRAP_UNASSIGNED:
+ case TRAP_UNASSIGNED_DANGEROUS:
+ new_trap_kind = Make_Unsigned_Fixnum((TRAP_FLUID | (trap_kind & 1)));
+ new_trap_value = UNASSIGNED_OBJECT;
+ break;
+
+ default:
+ remove_lock(set_serializer);
+ Primitive_Error(ERR_BROKEN_COMPILED_VARIABLE);
+ }
+ }
+
+ if (new_trap_kind != TRAP_NOP)
+ {
+ if (GC_allocate_test(2))
+ {
+ remove_lock(set_serializer);
+ Primitive_GC(2);
+ }
+ trap = Make_Pointer(TC_REFERENCE_TRAP, Free);
+ *Free++ = new_trap_kind;
+ *Free++ = new_trap_value;
+ *cell = trap;
+ }
+ remove_lock(set_serializer);
+
+ /* Fluid_Bindings is per processor private. */
+
+ Primitive_GC_If_Needed(4);
+ Free[CONS_CAR] = Make_Pointer(TC_LIST, (Free + 2));
+ Free[CONS_CDR] = Fluid_Bindings;
+ Fluid_Bindings = Make_Pointer(TC_LIST, Free);
+ Free += 2;
+ Free[CONS_CAR] = trap;
+ Free[CONS_CDR] = value;
+ Free += 2;
+
+ return NIL;
+}
+
/* (ADD-FLUID-BINDING! ENVIRONMENT SYMBOL-OR-VARIABLE VALUE)
Looks up symbol-or-variable in environment. If it has not been
fluidized, fluidizes it. A fluid binding with the specified
value is created in this interpreter's fluid bindings.
*/
-Define_Primitive(Prim_Add_Fluid_Binding, 3, "ADD-FLUID-BINDING!")
-{ Pointer Trap_Obj;
- int Temp_Obj;
+Define_Primitive(Prim_Add_Fluid_Binding, 3, "ADD-FLUID-BINDING!")
+{
+ Pointer *cell;
Primitive_3_Args();
- if (Arg1 != GLOBAL_ENV) Arg_1_Type(TC_ENVIRONMENT);
+
+ if (Arg1 != GLOBAL_ENV)
+ Arg_1_Type(TC_ENVIRONMENT);
+
switch (Type_Code(Arg2))
- { case TC_VARIABLE:
- Temp_Obj = Lookup_Slot(Arg2, Arg1);
- if (Temp_Obj == NO_SLOT || Temp_Obj == FOUND_UNBOUND)
- Primitive_Error(ERR_UNBOUND_VARIABLE);
+ {
+ case TC_VARIABLE:
+ cell = lookup_slot(Arg1, Arg2);
break;
+
case TC_INTERNED_SYMBOL:
case TC_UNINTERNED_SYMBOL:
- Temp_Obj = Symbol_Lookup_Slot(Arg1, Arg2);
- if (Temp_Obj == NO_SLOT || Temp_Obj == FOUND_UNBOUND)
- Primitive_Error(ERR_UNBOUND_VARIABLE);
+ cell = deep_lookup(Arg1, Arg2, fake_variable_object);
break;
+
default:
Primitive_Error(ERR_ARG_2_WRONG_TYPE);
- }
- /* Lock region, check if the slot at Lookup_Base[Lookup_Offset] is
- a fluid already. Return it if so, make a new fluid and store it
- there if not, unlock the region. */
- {
-#ifdef COMPILE_FUTURES
- Lock_Handle Set_Serializer;
-#endif
- Pointer Found_Val, Safe_Val;
- if (Lookup_Offset == HEAP_ENV_FUNCTION) Primitive_Error(ERR_BAD_SET);
-#ifdef COMPILE_FUTURES
- Set_Serializer = Lock_Cell(Nth_Vector_Loc(Lookup_Base, Lookup_Offset));
-#endif
- Found_Val = Fast_Vector_Ref(Lookup_Base, Lookup_Offset);
- Safe_Val = Found_Val & ~DANGER_BIT;
- if (Type_Code(Safe_Val) == TC_TRAP) Trap_Obj = Found_Val;
- else
- { Primitive_GC_If_Needed(TRAP_SIZE);
- Trap_Obj = (Pointer) Free;
- *Free++ = NIL; /* Tag for fluids */
- *Free++ = Safe_Val;
- *Free++ = Arg2; /* For debugging purposes */
- Store_Type_Code(Trap_Obj,
- ((Found_Val==Safe_Val)?TC_TRAP:TC_TRAP|DANGER_TYPE));
- Fast_Vector_Set(Lookup_Base, Lookup_Offset, Trap_Obj);
- }
-#ifdef COMPILE_FUTURES
- Unlock_Cell(Set_Serializer);
-#endif
- Add_Fluid_Binding(Trap_Obj, Arg3);
- Val = NIL;
- return Val;
}
+
+ return new_fluid_binding(cell, Arg3, false);
}
-/* (MAKE-FLUID-BINDING! ENVIRONMENT SYMBOL-OR-VARIABLE VALUE)
+/* (MAKE-FLUID-BINDING! ENVIRONMENT SYMBOL-OR-VARIABLE VALUE)
Looks up symbol-or-variable in environment. If it has not been
fluidized, fluidizes it. A fluid binding with the specified
value is created in this interpreter's fluid bindings. Unlike
@@ -149,111 +254,66 @@ Define_Primitive(Prim_Add_Fluid_Binding, 3, "ADD-FLUID-BINDING!")
and does not allow search of the global environment), an AUX
binding must be established in the last frame.
*/
-Define_Primitive(Prim_Make_Fluid_Binding, 3, "MAKE-FLUID-BINDING!")
-{ Pointer Trap_Obj;
+Define_Primitive(Prim_Make_Fluid_Binding, 3, "MAKE-FLUID-BINDING!")
+{
+ Pointer *cell;
+ fast Pointer env, previous;
Primitive_3_Args();
- if (Arg1 != GLOBAL_ENV) Arg_1_Type(TC_ENVIRONMENT);
+
+ if (Arg1 != GLOBAL_ENV)
+ Arg_1_Type(TC_ENVIRONMENT);
+
switch (Type_Code(Arg2))
- { /* Need to check for unbound in non-global env and build
- an AUX binding in that frame if so. Do nothing in
- usual case, unbound in global env.
- */
+ {
case TC_VARIABLE:
- Binding_Lookup_Slot(Arg2, Arg1);
+ cell = lookup_slot(Arg1, Arg2);
break;
+
case TC_INTERNED_SYMBOL:
case TC_UNINTERNED_SYMBOL:
- Symbol_Binding_Lookup_Slot(Arg1, Arg2);
+ cell = deep_lookup(Arg1, Arg2, fake_variable_object);
break;
+
default:
Primitive_Error(ERR_ARG_2_WRONG_TYPE);
- }
- /* Lock region, check if the slot at Lookup_Base[Lookup_Offset] is
- a fluid already. Return it if so, make a new fluid and store it
- there if not, unlock the region. */
- {
-#ifdef COMPILE_FUTURES
- Lock_Handle Set_Serializer;
-#endif
- Pointer Found_Val, Safe_Val;
- if (Lookup_Offset == HEAP_ENV_FUNCTION) Primitive_Error(ERR_BAD_SET);
-#ifdef COMPILE_FUTURES
- Set_Serializer = Lock_Cell(Nth_Vector_Loc(Lookup_Base, Lookup_Offset));
-#endif
- Found_Val = Fast_Vector_Ref(Lookup_Base, Lookup_Offset);
- Safe_Val = Found_Val & ~DANGER_BIT;
- if (Type_Code(Safe_Val) == TC_TRAP) Trap_Obj = Found_Val;
- else
- { Primitive_GC_If_Needed(TRAP_SIZE);
- Trap_Obj = (Pointer) Free;
- *Free++ = NIL; /* Tag for fluids */
- /* Binding version always makes unbounds unassigned */
- *Free++ = (Safe_Val == UNBOUND_OBJECT) ? UNASSIGNED_OBJECT:Safe_Val;
- *Free++ = Arg2; /* For debugging purposes */
- Store_Type_Code(Trap_Obj,
- ((Found_Val==Safe_Val)?TC_TRAP:TC_TRAP|DANGER_TYPE));
- Fast_Vector_Set(Lookup_Base, Lookup_Offset, Trap_Obj);
- }
-#ifdef COMPILE_FUTURES
- Unlock_Cell(Set_Serializer);
-#endif
- Add_Fluid_Binding(Trap_Obj, Arg3);
- Val = NIL;
- return Val;
}
-}
-Add_Fluid_Binding(Key, Value)
-Pointer Key, Value;
-{ Pointer New_Fluids;
-
- Primitive_GC_If_Needed(2 + 2);
- New_Fluids = Make_Pointer(TC_LIST, Free);
- *Free = Make_Pointer(TC_LIST, &Free[2]);
- Free += 1;
- *Free++ = Fluid_Bindings;
- *Free++ = Key;
- *Free++ = Value;
- Fluid_Bindings = New_Fluids;
-}
+ /* This only happens when global is not allowed,
+ it's expensive and will not be used, but is
+ provided for completeness.
+ */
-Symbol_Lookup_Slot(Frame, Symbol)
-Pointer Frame, Symbol;
-{ int result;
- Pointer *Variable = Free;
- Free += 3;
- Variable[VARIABLE_SYMBOL] = (Symbol);
- Variable[VARIABLE_COMPILED_TYPE] = UNCOMPILED_VARIABLE;
- result = Lookup_Slot(Make_Pointer(TC_VARIABLE, Variable), (Frame));
- if (Free == Variable+3) Free = Variable;
- return result;
-}
+ if (cell == unbound_trap_object)
+ {
+ long result;
+ Pointer symbol;
-Binding_Symbol_Lookup_Slot(Frame, Symbol)
-Pointer Frame, Symbol;
-{ int result;
- Pointer *Variable = Free;
- Free += 3;
- Variable[VARIABLE_SYMBOL] = (Symbol);
- Variable[VARIABLE_COMPILED_TYPE] = UNCOMPILED_VARIABLE;
- result = Binding_Lookup_Slot(Make_Pointer(TC_VARIABLE, Variable), (Frame));
- if (Free == Variable+3) Free = Variable;
- return result;
-}
+ env = Arg1;
+ if (Type_Code(env) == GLOBAL_ENV)
+ Primitive_Error(ERR_BAD_FRAME);
+
+ do
+ {
+ previous = env;
+ env = Fast_Vector_Ref(Vector_Ref(env, ENVIRONMENT_FUNCTION),
+ PROCEDURE_ENVIRONMENT);
+ } while (Type_Code(env) != GLOBAL_ENV);
-/* A version which creates a new binding if unbound in last frame */
-
-Symbol_Binding_Lookup_Slot(Frame, Symbol)
-Pointer Frame, Symbol;
-{ int result;
- Pointer *Variable = Free;
- Free += 3;
- Variable[VARIABLE_SYMBOL] = (Symbol);
- Variable[VARIABLE_COMPILED_TYPE] = UNCOMPILED_VARIABLE;
- result = Binding_Lookup_Slot(Make_Pointer(TC_VARIABLE, Variable), (Frame));
- if (Free == Variable+3) Free = Variable;
- return result;
-}
+ symbol = ((Type_Code(Arg2) == TC_VARIABLE) ?
+ Vector_Ref(Arg2, VARIABLE_SYMBOL) :
+ Arg2);
+ result = Local_Set(previous, symbol, UNASSIGNED_OBJECT);
+ if (result != PRIM_DONE)
+ {
+ if (result == PRIM_INTERRUPT)
+ Primitive_Interrupt();
+ Primitive_Error(result);
+ }
+ cell = deep_lookup(previous, symbol, fake_variable_object);
+ }
+
+ return new_fluid_binding(cell, Arg3, true);
+}
diff --git a/v7/src/microcode/lookup.h b/v7/src/microcode/lookup.h
new file mode 100644
index 000000000..6de5e4192
--- /dev/null
+++ b/v7/src/microcode/lookup.h
@@ -0,0 +1,242 @@
+/* -*-C-*-
+
+Copyright (c) 1987 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science. Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/lookup.h,v 9.35 1987/04/03 00:47:02 jinx Exp $ */
+
+/* Macros and declarations for the variable lookup code. */
+
+extern Pointer
+ *deep_lookup(),
+ *lookup_fluid();
+
+extern long
+ deep_lookup_end(),
+ deep_assignment_end();
+
+extern Pointer
+ unbound_trap_object[],
+ uncompiled_trap_object[],
+ illegal_trap_object[],
+ fake_variable_object[];
+
+#define GC_allocate_test(N) GC_Check(N)
+
+#define AUX_LIST_TYPE TC_VECTOR
+
+#define AUX_CHUNK_SIZE 20
+#define AUX_LIST_COUNT ENVIRONMENT_EXTENSION_COUNT
+#define AUX_LIST_FIRST ENVIRONMENT_EXTENSION_MIN_SIZE
+#define AUX_LIST_INITIAL_SIZE (AUX_LIST_FIRST + AUX_CHUNK_SIZE)
+
+/* Variable compilation types. */
+
+#define LOCAL_REF TC_NULL
+#define GLOBAL_REF TC_UNINTERNED_SYMBOL
+#define FORMAL_REF TC_CHARACTER
+#define AUX_REF TC_FIXNUM
+#define UNCOMPILED_REF TC_TRUE
+
+/* Common constants. */
+
+#ifndef b32
+#define UNCOMPILED_VARIABLE Make_Non_Pointer(UNCOMPILED_REF, 0)
+#else
+#define UNCOMPILED_VARIABLE 0x08000000
+#endif
+
+/* Macros for speedy variable reference. */
+
+#if (LOCAL_REF == 0)
+
+#define Lexical_Offset(Ind) ((long) (Ind))
+#define Make_Local_Offset(Ind) ((Pointer) (Ind))
+
+#else
+
+#define Lexical_Offset(Ind) Get_Integer(Ind)
+#define Make_Local_Offset(Ind) Make_Non_Pointer(LOCAL_REF, Ind)
+
+#endif
+
+/* The code below depends on the following. */
+
+#if ((VARIABLE_OFFSET == VARIABLE_COMPILED_TYPE) || \
+ (VARIABLE_FRAME_NO != VARIABLE_COMPILED_TYPE))
+#include "error: trap.h inconsistency detected."
+#endif
+
+#define get_offset(hunk) Lexical_Offset(Fetch(hunk[VARIABLE_OFFSET]))
+
+#ifdef PARALLEL_PROCESSOR
+
+#define verify(type_code, variable, code, label) \
+{ \
+ variable = code; \
+ if (Type_Code(Fetch(hunk[VARIABLE_COMPILED_TYPE])) != \
+ type_code) \
+ goto label; \
+}
+
+#define verified_offset(variable, code) variable
+
+/* Unlike Lock_Cell, cell must be (Pointer *). This currently does
+ not matter, but might on a machine with address mapping.
+ */
+#define setup_lock(handle, cell) handle = Lock_Cell(cell)
+#define remove_lock(handle) Unlock_Cell(handle)
+
+#else
+
+#define verify(type_code, variable, code, label)
+#define verified_offset(variable, code) code
+#define setup_lock(handle, cell)
+#define remove_lock(ignore)
+
+#endif
+
+/* Pointer *cell, env, *hunk; */
+
+#define lookup(cell, env, hunk, label) \
+{ \
+ fast Pointer frame; \
+ long offset; \
+ \
+label: \
+ \
+ frame = Fetch(hunk[VARIABLE_COMPILED_TYPE]); \
+ \
+ switch (Type_Code(frame)) \
+ { \
+ case GLOBAL_REF: \
+ /* frame is a pointer to the same symbol. */ \
+ cell = Nth_Vector_Loc(frame, SYMBOL_GLOBAL_VALUE); \
+ break; \
+ \
+ case LOCAL_REF: \
+ cell = Nth_Vector_Loc(env, Lexical_Offset(frame)); \
+ break; \
+ \
+ case FORMAL_REF: \
+ { \
+ fast long depth; \
+ \
+ verify(FORMAL_REF, offset, get_offset(hunk), label); \
+ \
+ depth = Get_Integer(frame); \
+ frame = env; \
+ while(--depth >= 0) \
+ { \
+ frame = Fast_Vector_Ref(Vector_Ref(frame, ENVIRONMENT_FUNCTION), \
+ PROCEDURE_ENVIRONMENT); \
+ } \
+ \
+ cell = Nth_Vector_Loc(frame, \
+ verified_offset(offset, get_offset(hunk))); \
+ \
+ break; \
+ } \
+ \
+ case AUX_REF: \
+ { \
+ fast long depth; \
+ \
+ verify(AUX_REF, offset, get_offset(hunk), label); \
+ \
+ depth = Get_Integer(frame); \
+ frame = env; \
+ while(--depth >= 0) \
+ { \
+ frame = Fast_Vector_Ref(Vector_Ref(frame, ENVIRONMENT_FUNCTION), \
+ PROCEDURE_ENVIRONMENT); \
+ } \
+ \
+ frame = Vector_Ref(frame, ENVIRONMENT_FUNCTION); \
+ if (Type_Code(frame) != AUX_LIST_TYPE) \
+ { \
+ cell = uncompiled_trap_object; \
+ break; \
+ } \
+ depth = verified_offset(offset, get_offset(hunk)); \
+ if (depth > Vector_Length(frame)) \
+ { \
+ cell = uncompiled_trap_object; \
+ break; \
+ } \
+ frame = Vector_Ref(frame, depth); \
+ if ((frame == NIL) || \
+ (Fast_Vector_Ref(frame, CONS_CAR) != hunk[VARIABLE_SYMBOL])) \
+ { \
+ cell = uncompiled_trap_object; \
+ break; \
+ } \
+ cell = Nth_Vector_Loc(frame, CONS_CDR); \
+ break; \
+ } \
+ \
+ default: \
+ /* Done here rather than in a separate case because of \
+ peculiarities of the bobcat compiler. \
+ */ \
+ cell = ((Type_Code(frame) == UNCOMPILED_REF) ? \
+ uncompiled_trap_object : \
+ illegal_trap_object); \
+ break; \
+ } \
+}
+
+#define lookup_primitive_type_test() \
+{ \
+ if (Type_Code(Arg1) != GLOBAL_ENV) Arg_1_Type(TC_ENVIRONMENT); \
+ if (Type_Code(Arg2) != TC_INTERNED_SYMBOL) \
+ Arg_2_Type(TC_UNINTERNED_SYMBOL); \
+}
+
+#define lookup_primitive_end(Result) \
+{ \
+ if (Result == PRIM_DONE) \
+ return Val; \
+ if (Result == PRIM_INTERRUPT) \
+ Primitive_Interrupt(); \
+ Primitive_Error(Result); \
+}
+
+#define standard_lookup_primitive(action) \
+{ \
+ long Result; \
+ \
+ lookup_primitive_type_test(); \
+ Result = action; \
+ lookup_primitive_end(Result); \
+ /*NOTREACHED*/ \
+}
+
+
diff --git a/v7/src/microcode/prim.h b/v7/src/microcode/prim.h
new file mode 100644
index 000000000..9bceca70d
--- /dev/null
+++ b/v7/src/microcode/prim.h
@@ -0,0 +1,46 @@
+/* -*-C-*-
+
+Copyright (c) 1987 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science. Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+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/prim.h,v 9.35 1987/04/03 00:48:04 jinx Exp $ */
+
+/* External primitive definition structure. */
+
+typedef struct ext_desc /* User supplied primitive data */
+{
+ Pointer (*proc)(); /* Location of actual procedure */
+ int arity; /* Number of arguments */
+ char *name; /* Name of primitive */
+} External_Descriptor;
+
+extern External_Descriptor Ext_Prim_Desc[];
+extern long MAX_EXTERNAL_PRIMITIVE, Get_Ext_Number();
+extern Pointer Undefined_Externals, Make_Prim_Exts();
diff --git a/v7/src/microcode/trap.h b/v7/src/microcode/trap.h
new file mode 100644
index 000000000..99801e3ac
--- /dev/null
+++ b/v7/src/microcode/trap.h
@@ -0,0 +1,93 @@
+/* -*-C-*-
+
+Copyright (c) 1987 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science. Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+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/trap.h,v 9.35 1987/04/03 00:46:33 jinx Exp $ */
+
+/* Kinds of traps:
+
+ Note that for every trap there is a dangerous version.
+ The danger bit is the bottom bit of the trap number,
+ thus all dangerous traps are odd and viceversa.
+
+ For efficiency, some traps are immediate, while some are
+ pointer objects. The type code is multiplexed, and the
+ garbage collector handles it specially.
+
+ */
+
+/* The following are immediate traps: */
+
+#define TRAP_UNASSIGNED 0
+#define TRAP_UNASSIGNED_DANGEROUS 1
+#define TRAP_UNBOUND 2
+#define TRAP_UNBOUND_DANGEROUS 3
+#define TRAP_ILLEGAL 4
+#define TRAP_ILLEGAL_DANGEROUS 5 /* Unused. */
+
+/* TRAP_MAX_IMMEDIATE is defined in const.h */
+
+/* The following are not: */
+
+#define TRAP_NOP 10 /* Unused. */
+#define TRAP_DANGEROUS 11
+#define TRAP_FLUID 12
+#define TRAP_FLUID_DANGEROUS 13
+
+/* Trap utilities */
+
+#define get_trap_kind(variable, what) \
+{ \
+ variable = Datum(what); \
+ if (variable > TRAP_MAX_IMMEDIATE) \
+ variable = Datum(Vector_Ref(what, TRAP_TAG)); \
+}
+
+/* Common constants */
+
+#ifndef b32
+#define UNASSIGNED_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNASSIGNED)
+#define DANGEROUS_UNASSIGNED_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNASSIGNED_DANGEROUS)
+#define UNBOUND_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNBOUND)
+#define DANGEROUS_UNBOUND_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNBOUND_DANGEROUS)
+#else
+#define UNASSIGNED_OBJECT 0x32000000
+#define DANGEROUS_UNASSIGNED_OBJECT 0x32000001
+#define UNBOUND_OBJECT 0x32000002
+#define DANGEROUS_UNBOUND_OBJECT 0x32000003
+#endif
+
+#define DANGEROUS_OBJECT Make_Unsigned_Fixnum(TRAP_DANGEROUS)
+
+#if ((TC_REFERENCE_TRAP != 0x32) || (TC_TRUE != 0x08))
+#include "error: lookup.h and types.h are inconsistent"
+#endif
+
diff --git a/v7/src/microcode/usrdef.h b/v7/src/microcode/usrdef.h
new file mode 100644
index 000000000..7d78b1bdf
--- /dev/null
+++ b/v7/src/microcode/usrdef.h
@@ -0,0 +1,41 @@
+/* -*-C-*-
+
+Copyright (c) 1987 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science. Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+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/usrdef.h,v 9.35 1987/04/03 00:47:31 jinx Exp $ */
+
+/* Macros and header for usrdef.c and variants. */
+
+#include "config.h"
+#include "object.h"
+#include "prim.h"
+
+
diff --git a/v8/src/microcode/lookup.h b/v8/src/microcode/lookup.h
new file mode 100644
index 000000000..dc3e99d92
--- /dev/null
+++ b/v8/src/microcode/lookup.h
@@ -0,0 +1,242 @@
+/* -*-C-*-
+
+Copyright (c) 1987 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science. Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/lookup.h,v 9.35 1987/04/03 00:47:02 jinx Exp $ */
+
+/* Macros and declarations for the variable lookup code. */
+
+extern Pointer
+ *deep_lookup(),
+ *lookup_fluid();
+
+extern long
+ deep_lookup_end(),
+ deep_assignment_end();
+
+extern Pointer
+ unbound_trap_object[],
+ uncompiled_trap_object[],
+ illegal_trap_object[],
+ fake_variable_object[];
+
+#define GC_allocate_test(N) GC_Check(N)
+
+#define AUX_LIST_TYPE TC_VECTOR
+
+#define AUX_CHUNK_SIZE 20
+#define AUX_LIST_COUNT ENVIRONMENT_EXTENSION_COUNT
+#define AUX_LIST_FIRST ENVIRONMENT_EXTENSION_MIN_SIZE
+#define AUX_LIST_INITIAL_SIZE (AUX_LIST_FIRST + AUX_CHUNK_SIZE)
+
+/* Variable compilation types. */
+
+#define LOCAL_REF TC_NULL
+#define GLOBAL_REF TC_UNINTERNED_SYMBOL
+#define FORMAL_REF TC_CHARACTER
+#define AUX_REF TC_FIXNUM
+#define UNCOMPILED_REF TC_TRUE
+
+/* Common constants. */
+
+#ifndef b32
+#define UNCOMPILED_VARIABLE Make_Non_Pointer(UNCOMPILED_REF, 0)
+#else
+#define UNCOMPILED_VARIABLE 0x08000000
+#endif
+
+/* Macros for speedy variable reference. */
+
+#if (LOCAL_REF == 0)
+
+#define Lexical_Offset(Ind) ((long) (Ind))
+#define Make_Local_Offset(Ind) ((Pointer) (Ind))
+
+#else
+
+#define Lexical_Offset(Ind) Get_Integer(Ind)
+#define Make_Local_Offset(Ind) Make_Non_Pointer(LOCAL_REF, Ind)
+
+#endif
+
+/* The code below depends on the following. */
+
+#if ((VARIABLE_OFFSET == VARIABLE_COMPILED_TYPE) || \
+ (VARIABLE_FRAME_NO != VARIABLE_COMPILED_TYPE))
+#include "error: trap.h inconsistency detected."
+#endif
+
+#define get_offset(hunk) Lexical_Offset(Fetch(hunk[VARIABLE_OFFSET]))
+
+#ifdef PARALLEL_PROCESSOR
+
+#define verify(type_code, variable, code, label) \
+{ \
+ variable = code; \
+ if (Type_Code(Fetch(hunk[VARIABLE_COMPILED_TYPE])) != \
+ type_code) \
+ goto label; \
+}
+
+#define verified_offset(variable, code) variable
+
+/* Unlike Lock_Cell, cell must be (Pointer *). This currently does
+ not matter, but might on a machine with address mapping.
+ */
+#define setup_lock(handle, cell) handle = Lock_Cell(cell)
+#define remove_lock(handle) Unlock_Cell(handle)
+
+#else
+
+#define verify(type_code, variable, code, label)
+#define verified_offset(variable, code) code
+#define setup_lock(handle, cell)
+#define remove_lock(ignore)
+
+#endif
+
+/* Pointer *cell, env, *hunk; */
+
+#define lookup(cell, env, hunk, label) \
+{ \
+ fast Pointer frame; \
+ long offset; \
+ \
+label: \
+ \
+ frame = Fetch(hunk[VARIABLE_COMPILED_TYPE]); \
+ \
+ switch (Type_Code(frame)) \
+ { \
+ case GLOBAL_REF: \
+ /* frame is a pointer to the same symbol. */ \
+ cell = Nth_Vector_Loc(frame, SYMBOL_GLOBAL_VALUE); \
+ break; \
+ \
+ case LOCAL_REF: \
+ cell = Nth_Vector_Loc(env, Lexical_Offset(frame)); \
+ break; \
+ \
+ case FORMAL_REF: \
+ { \
+ fast long depth; \
+ \
+ verify(FORMAL_REF, offset, get_offset(hunk), label); \
+ \
+ depth = Get_Integer(frame); \
+ frame = env; \
+ while(--depth >= 0) \
+ { \
+ frame = Fast_Vector_Ref(Vector_Ref(frame, ENVIRONMENT_FUNCTION), \
+ PROCEDURE_ENVIRONMENT); \
+ } \
+ \
+ cell = Nth_Vector_Loc(frame, \
+ verified_offset(offset, get_offset(hunk))); \
+ \
+ break; \
+ } \
+ \
+ case AUX_REF: \
+ { \
+ fast long depth; \
+ \
+ verify(AUX_REF, offset, get_offset(hunk), label); \
+ \
+ depth = Get_Integer(frame); \
+ frame = env; \
+ while(--depth >= 0) \
+ { \
+ frame = Fast_Vector_Ref(Vector_Ref(frame, ENVIRONMENT_FUNCTION), \
+ PROCEDURE_ENVIRONMENT); \
+ } \
+ \
+ frame = Vector_Ref(frame, ENVIRONMENT_FUNCTION); \
+ if (Type_Code(frame) != AUX_LIST_TYPE) \
+ { \
+ cell = uncompiled_trap_object; \
+ break; \
+ } \
+ depth = verified_offset(offset, get_offset(hunk)); \
+ if (depth > Vector_Length(frame)) \
+ { \
+ cell = uncompiled_trap_object; \
+ break; \
+ } \
+ frame = Vector_Ref(frame, depth); \
+ if ((frame == NIL) || \
+ (Fast_Vector_Ref(frame, CONS_CAR) != hunk[VARIABLE_SYMBOL])) \
+ { \
+ cell = uncompiled_trap_object; \
+ break; \
+ } \
+ cell = Nth_Vector_Loc(frame, CONS_CDR); \
+ break; \
+ } \
+ \
+ default: \
+ /* Done here rather than in a separate case because of \
+ peculiarities of the bobcat compiler. \
+ */ \
+ cell = ((Type_Code(frame) == UNCOMPILED_REF) ? \
+ uncompiled_trap_object : \
+ illegal_trap_object); \
+ break; \
+ } \
+}
+
+#define lookup_primitive_type_test() \
+{ \
+ if (Type_Code(Arg1) != GLOBAL_ENV) Arg_1_Type(TC_ENVIRONMENT); \
+ if (Type_Code(Arg2) != TC_INTERNED_SYMBOL) \
+ Arg_2_Type(TC_UNINTERNED_SYMBOL); \
+}
+
+#define lookup_primitive_end(Result) \
+{ \
+ if (Result == PRIM_DONE) \
+ return Val; \
+ if (Result == PRIM_INTERRUPT) \
+ Primitive_Interrupt(); \
+ Primitive_Error(Result); \
+}
+
+#define standard_lookup_primitive(action) \
+{ \
+ long Result; \
+ \
+ lookup_primitive_type_test(); \
+ Result = action; \
+ lookup_primitive_end(Result); \
+ /*NOTREACHED*/ \
+}
+
+
diff --git a/v8/src/microcode/trap.h b/v8/src/microcode/trap.h
new file mode 100644
index 000000000..3dca94da5
--- /dev/null
+++ b/v8/src/microcode/trap.h
@@ -0,0 +1,93 @@
+/* -*-C-*-
+
+Copyright (c) 1987 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science. Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+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/trap.h,v 9.35 1987/04/03 00:46:33 jinx Exp $ */
+
+/* Kinds of traps:
+
+ Note that for every trap there is a dangerous version.
+ The danger bit is the bottom bit of the trap number,
+ thus all dangerous traps are odd and viceversa.
+
+ For efficiency, some traps are immediate, while some are
+ pointer objects. The type code is multiplexed, and the
+ garbage collector handles it specially.
+
+ */
+
+/* The following are immediate traps: */
+
+#define TRAP_UNASSIGNED 0
+#define TRAP_UNASSIGNED_DANGEROUS 1
+#define TRAP_UNBOUND 2
+#define TRAP_UNBOUND_DANGEROUS 3
+#define TRAP_ILLEGAL 4
+#define TRAP_ILLEGAL_DANGEROUS 5 /* Unused. */
+
+/* TRAP_MAX_IMMEDIATE is defined in const.h */
+
+/* The following are not: */
+
+#define TRAP_NOP 10 /* Unused. */
+#define TRAP_DANGEROUS 11
+#define TRAP_FLUID 12
+#define TRAP_FLUID_DANGEROUS 13
+
+/* Trap utilities */
+
+#define get_trap_kind(variable, what) \
+{ \
+ variable = Datum(what); \
+ if (variable > TRAP_MAX_IMMEDIATE) \
+ variable = Datum(Vector_Ref(what, TRAP_TAG)); \
+}
+
+/* Common constants */
+
+#ifndef b32
+#define UNASSIGNED_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNASSIGNED)
+#define DANGEROUS_UNASSIGNED_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNASSIGNED_DANGEROUS)
+#define UNBOUND_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNBOUND)
+#define DANGEROUS_UNBOUND_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNBOUND_DANGEROUS)
+#else
+#define UNASSIGNED_OBJECT 0x32000000
+#define DANGEROUS_UNASSIGNED_OBJECT 0x32000001
+#define UNBOUND_OBJECT 0x32000002
+#define DANGEROUS_UNBOUND_OBJECT 0x32000003
+#endif
+
+#define DANGEROUS_OBJECT Make_Unsigned_Fixnum(TRAP_DANGEROUS)
+
+#if ((TC_REFERENCE_TRAP != 0x32) || (TC_TRUE != 0x08))
+#include "error: lookup.h and types.h are inconsistent"
+#endif
+