From d22932b29eda86407b9313ded87896ca110ce13f Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Fri, 3 Apr 1987 00:48:04 +0000 Subject: [PATCH] Rewrite of the variable lookup code and slight tuning of the interpreter. --- v7/src/microcode/fhooks.c | 348 ++++++++++++++++++++++---------------- v7/src/microcode/lookup.h | 242 ++++++++++++++++++++++++++ v7/src/microcode/prim.h | 46 +++++ v7/src/microcode/trap.h | 93 ++++++++++ v7/src/microcode/usrdef.h | 41 +++++ v8/src/microcode/lookup.h | 242 ++++++++++++++++++++++++++ v8/src/microcode/trap.h | 93 ++++++++++ 7 files changed, 961 insertions(+), 144 deletions(-) create mode 100644 v7/src/microcode/lookup.h create mode 100644 v7/src/microcode/prim.h create mode 100644 v7/src/microcode/trap.h create mode 100644 v7/src/microcode/usrdef.h create mode 100644 v8/src/microcode/lookup.h create mode 100644 v8/src/microcode/trap.h 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 + -- 2.25.1