- New traps (TRAP_COMPILER_CACHED and dangerous).
- Support in lookup and interpret.
- Change to fasdump to generalize the fixed utility kludge.
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.28 1987/04/16 14:35:15 jinx Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchdmp.c,v 9.29 1987/05/29 02:20:58 jinx Exp $ */
/* bchgcl, bchmmg, bchpur, and bchdmp can replace gcloop, memmag,
purify, and fasdump, respectively, to provide garbage collection
*/
Built_In_Primitive(Prim_Band_Dump, 2, "DUMP-BAND", 0xB7)
{
+ extern Pointer compiler_utilities;
Pointer Combination, Ext_Prims;
long Arg1Type;
Primitive_2_Args();
Free[COMB_1_ARG_1] = NIL;
Free += 2;
*Free++ = Combination;
- *Free++ = return_to_interpreter;
+ *Free++ = compiler_utilities;
*Free = Make_Pointer(TC_LIST, Free-2);
Free++; /* Some compilers are TOO clever about this and increment Free
before calculating Free-2! */
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/boot.c,v 9.33 1987/05/28 00:45:29 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/boot.c,v 9.34 1987/05/29 02:21:09 jinx Exp $
Copyright (c) 1987 Massachusetts Institute of Technology
case TERM_BROKEN_HEART:
printf("Broken heart encountered.\n"); break;
case TERM_COMPILER_DEATH:
- printf("Compiled code entered without compiler support.\n"); break;
+ printf("Mismatch between compiled code and compiled code support.\n");
+ break;
case TERM_DISK_RESTORE:
printf("DISK restore.\n"); break;
case TERM_EOF:
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/extern.h,v 9.24 1987/04/16 02:21:28 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/extern.h,v 9.25 1987/05/29 02:22:08 jinx Exp $
*
* External declarations.
*
*Heap, /* Bottom of all heap space */
Current_State_Point, /* Dynamic state point */
Fluid_Bindings, /* Fluid bindings AList */
- return_to_interpreter, /* Return address/code left by interpreter
- when calling compiled code */
- *last_return_code; /* Address of the most recent return code in the stack.
+ *last_return_code, /* Address of the most recent return code in the stack.
This is only meaningful while in compiled code.
*** This must be changed when stacklets are used. ***
*/
+ return_to_interpreter;/* Return code/address used by the compiled code
+ interface to make compiled code return to the
+ interpreter.
+ */
extern Declare_Fixed_Objects();
\f
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.25 1987/04/16 14:34:02 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasdump.c,v 9.26 1987/05/29 02:22:19 jinx Exp $
This file contains code for fasdump and dump-band.
*/
*/
Built_In_Primitive(Prim_Band_Dump, 2, "DUMP-BAND", 0xB7)
{
+ extern Pointer compiler_utilities;
Pointer Combination, Ext_Prims;
long Arg1Type;
Primitive_2_Args();
Free[COMB_1_ARG_1] = NIL;
Free += 2;
*Free++ = Combination;
- *Free++ = return_to_interpreter;
+ *Free++ = compiler_utilities;
*Free = Make_Pointer(TC_LIST, Free-2);
Free++; /* Some compilers are TOO clever about this and increment Free
before calculating Free-2! */
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/fasload.c,v 9.25 1987/04/16 02:21:50 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasload.c,v 9.26 1987/05/29 02:22:32 jinx Exp $
The "fast loader" which reads in and relocates binary files and then
interns symbols. It is called with one argument: the (character
return C_String_To_Scheme_String(reload_band_name);
}
+extern void compiler_reset_error();
+
+void
+compiler_reset_error()
+{
+ fprintf(stderr,
+ "\ncompiler_restart_error: The band being restored and\n");
+ fprintf(stderr,
+ "the compiled code interface in this microcode are inconsistent.\n");
+ Microcode_Termination(TERM_COMPILER_DEATH);
+}
+
/* (LOAD-BAND FILE-NAME)
Restores the heap and pure space from the contents of FILE-NAME,
which is typically a file created by DUMP-BAND. The file can,
*/
Built_In_Primitive(Prim_Band_Load, 1, "LOAD-BAND", 0xB9)
{
+ extern Pointer compiler_utilities;
Pointer Save_FO, *Save_Free, *Save_Free_Constant,
Save_Undefined, *Save_Stack_Pointer,
- *Save_Stack_Guard, Result;
+ *Save_Stack_Guard, saved_utilities, Result;
long Jump_Value;
jmp_buf Swapped_Buf, *Saved_Buf;
Free_Constant = Constant_Space;
Save_Stack_Pointer = Stack_Pointer;
Save_Stack_Guard = Stack_Guard;
+ saved_utilities = compiler_utilities;
/* Prim_Band_Load continues on next page */
\f
Saved_Buf = Back_To_Eval;
Jump_Value = setjmp(Swapped_Buf);
if (Jump_Value == 0)
- { extern char *malloc();
+ {
+ extern char *malloc();
extern strcpy(), free();
+ extern void compiler_reset();
length = Get_Integer(Fast_Vector_Ref(Arg1, STRING_LENGTH));
band_name = malloc(length);
if (band_name != ((char *) NULL))
strcpy(band_name, Scheme_String_To_C_String(Arg1));
- Back_To_Eval = (jmp_buf *) Swapped_Buf;
+ Back_To_Eval = ((jmp_buf *) Swapped_Buf);
Result = Fasload(Arg1, false);
Back_To_Eval = Saved_Buf;
Save_Cont();
Store_Expression(Vector_Ref(Result,0));
/* Primitive externals handled by Fasload */
- return_to_interpreter = Vector_Ref(Result, 1);
+ compiler_utilities = Vector_Ref(Result, 1);
+ compiler_reset(compiler_utilities);
Store_Env(Make_Non_Pointer(GLOBAL_ENV, GO_TO_GLOBAL));
Set_Pure_Top();
Band_Load_Hook();
- longjmp(*Back_To_Eval, PRIM_DO_EXPRESSION);
+ PRIMITIVE_ABORT(PRIM_DO_EXPRESSION);
}
else
- { if (band_name != ((char *) NULL))
+ {
+ if (band_name != ((char *) NULL))
free(band_name);
+ compiler_utilities = saved_utilities;
Back_To_Eval = Saved_Buf;
Free = Save_Free;
Free_Constant = Save_Free_Constant;
Undefined_Externals = Save_Undefined;
Restore_Fixed_Obj(Save_FO);
if (Jump_Value == PRIM_INTERRUPT)
- { printf("\nFile too large for memory.\n");
+ {
+ fprintf(stderr, "\nFile too large for memory.\n");
Jump_Value = ERR_FASL_FILE_BAD_DATA;
}
Primitive_Error(Jump_Value);
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.22 1987/04/03 00:43:16 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/fhooks.c,v 9.23 1987/05/29 02:22:51 jinx Exp $
*
* This file contains hooks and handles for the new fluid bindings
* scheme for multiprocessors.
Result = Fluid_Bindings;
Fluid_Bindings = Arg1;
- return Result;
+ PRIMITIVE_RETURN(Result);
}
/* (GET-FLUID-BINDINGS NEW-BINDINGS)
{
Primitive_0_Args();
- return Fluid_Bindings;
+ PRIMITIVE_RETURN(Fluid_Bindings);
}
/* (WITH-SAVED-FLUID-BINDINGS THUNK)
Push(Arg1);
Push(STACK_FRAME_HEADER);
Pushed();
- longjmp(*Back_To_Eval, PRIM_APPLY);
+ PRIMITIVE_ABORT(PRIM_APPLY);
}
\f
/* Utilities for the primitives below. */
case TRAP_UNBOUND_DANGEROUS:
case TRAP_UNASSIGNED_DANGEROUS:
case TRAP_FLUID_DANGEROUS:
- return deep_lookup(env, hunk[VARIABLE_SYMBOL], hunk);
+ case TRAP_COMPILER_CACHED_DANGEROUS:
+ return deep_lookup(env, hunk[VARIABLE_SYMBOL], hunk, false);
+ case TRAP_COMPILER_CACHED:
case TRAP_FLUID:
case TRAP_UNBOUND:
case TRAP_UNASSIGNED:
return cell;
+ case TRAP_NOP:
+ Primitive_Error(ERR_BAD_FRAME);
+
default:
Primitive_Error(ERR_BROKEN_COMPILED_VARIABLE);
}
Pointer new_trap_value;
long new_trap_kind, trap_kind;
+ new_trap_kind = TRAP_FLUID;
setup_lock(set_serializer, cell);
- new_trap_kind = TRAP_FLUID;
+new_fluid_binding_restart:
+
trap = *cell;
new_trap_value = trap;
get_trap_kind(trap_kind, trap);
switch(trap_kind)
{
+ case TRAP_NOP:
case TRAP_DANGEROUS:
Vector_Set(trap,
TRAP_TAG,
- Make_Unsigned_Fixnum(TRAP_FLUID_DANGEROUS));
+ Make_Unsigned_Fixnum(TRAP_FLUID | (trap_kind & 1)));
/* Fall through */
case TRAP_FLUID:
case TRAP_FLUID_DANGEROUS:
- new_trap_kind = TRAP_NOP;
+ new_trap_kind = -1;
break;
-\f
+
case TRAP_UNBOUND:
case TRAP_UNBOUND_DANGEROUS:
if (!force)
/* Fall through */
case TRAP_UNASSIGNED:
case TRAP_UNASSIGNED_DANGEROUS:
- new_trap_kind = Make_Unsigned_Fixnum((TRAP_FLUID | (trap_kind & 1)));
+ new_trap_kind = (TRAP_FLUID | (trap_kind & 1));
new_trap_value = UNASSIGNED_OBJECT;
break;
+\f
+ case TRAP_COMPILER_CACHED:
+ case TRAP_COMPILED_CACHED_DANGEROUS:
+ cell = Nth_Vector_Loc(Fast_Vector_Ref(*cell, TRAP_EXTRA),
+ TRAP_EXTENSION_CELL);
+ goto new_fluid_binding_restart;
default:
remove_lock(set_serializer);
}
}
- if (new_trap_kind != TRAP_NOP)
+ if (new_trap_kind != -1)
{
if (GC_allocate_test(2))
{
Primitive_GC(2);
}
trap = Make_Pointer(TC_REFERENCE_TRAP, Free);
- *Free++ = new_trap_kind;
+ *Free++ = Make_Unsigned_Fixnum(new_trap_kind);
*Free++ = new_trap_value;
*cell = trap;
}
case TC_INTERNED_SYMBOL:
case TC_UNINTERNED_SYMBOL:
- cell = deep_lookup(Arg1, Arg2, fake_variable_object);
+ cell = deep_lookup(Arg1, Arg2, fake_variable_object, false);
break;
default:
Primitive_Error(ERR_ARG_2_WRONG_TYPE);
}
- return new_fluid_binding(cell, Arg3, false);
+ PRIMITIVE_RETURN(new_fluid_binding(cell, Arg3, false));
}
\f
/* (MAKE-FLUID-BINDING! ENVIRONMENT SYMBOL-OR-VARIABLE VALUE)
Define_Primitive(Prim_Make_Fluid_Binding, 3, "MAKE-FLUID-BINDING!")
{
+ extern Pointer *force_definition();
Pointer *cell;
- fast Pointer env, previous;
Primitive_3_Args();
if (Arg1 != GLOBAL_ENV)
case TC_INTERNED_SYMBOL:
case TC_UNINTERNED_SYMBOL:
- cell = deep_lookup(Arg1, Arg2, fake_variable_object);
+ cell = deep_lookup(Arg1, Arg2, fake_variable_object, false);
break;
default:
Primitive_Error(ERR_ARG_2_WRONG_TYPE);
}
-\f
- /* This only happens when global is not allowed,
- it's expensive and will not be used, but is
- provided for completeness.
- */
if (cell == unbound_trap_object)
{
- long result;
- Pointer symbol;
+ long message;
- 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);
+ /* This only happens when global is not allowed,
+ only provided for completeness.
+ */
- symbol = ((Type_Code(Arg2) == TC_VARIABLE) ?
- Vector_Ref(Arg2, VARIABLE_SYMBOL) :
- Arg2);
+ cell = force_definition(Arg1,
+ ((Type_Code(Arg2) == TC_VARIABLE) ?
+ Vector_Ref(Arg2, VARIABLE_SYMBOL) :
+ Arg2)
+ &message);
- result = Local_Set(previous, symbol, UNASSIGNED_OBJECT);
- if (result != PRIM_DONE)
+ if (message != PRIM_DONE)
{
- if (result == PRIM_INTERRUPT)
+ if (message == PRIM_INTERRUPT)
Primitive_Interrupt();
-
- Primitive_Error(result);
+ else
+ Primitive_Error(message);
}
- cell = deep_lookup(previous, symbol, fake_variable_object);
}
- return new_fluid_binding(cell, Arg3, true);
+ PRIMITIVE_RETURN(new_fluid_binding(cell, Arg3, true));
}
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.24 1987/04/21 15:02:02 cph Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/interp.c,v 9.25 1987/05/29 02:23:02 jinx Exp $
*
* This file contains the heart of the Scheme Scode
* interpreter
Set_Time_Zone(Zone_Lookup);
cell = Get_Pointer(Fetch_Expression());
lookup(cell, Fetch_Env(), cell, repeat_variable_lookup);
- Val = *cell;
+
+lookup_end_restart:
+
+ Val = Fetch(cell[0]);
if (Type_Code(Val) != TC_REFERENCE_TRAP)
{
Set_Time_Zone(Zone_Working);
case TRAP_UNBOUND_DANGEROUS:
case TRAP_UNASSIGNED_DANGEROUS:
case TRAP_FLUID_DANGEROUS:
+ case TRAP_COMPILER_CACHED_DANGEROUS:
cell = Get_Pointer(Fetch_Expression());
temp =
- deep_lookup_end(deep_lookup(Fetch_Env(), cell[VARIABLE_SYMBOL], cell),
+ deep_lookup_end(deep_lookup(Fetch_Env(),
+ cell[VARIABLE_SYMBOL],
+ cell),
cell);
- goto external_lookup_return;
-
- /* No need to recompile, pass the fake variable. */
- case TRAP_FLUID:
- temp = deep_lookup_end(lookup_fluid(Val), fake_variable_object);
-
- external_lookup_return:
Import_Val();
if (temp != PRIM_DONE)
break;
Set_Time_Zone(Zone_Working);
goto Pop_Return;
+ case TRAP_COMPILER_CACHED:
+ cell = Nth_Vector_Loc(Fast_Vector_Ref(Val, TRAP_EXTRA),
+ TRAP_EXTENSION_CELL);
+ goto lookup_end_restart;
+
+ case TRAP_FLUID:
+ cell = lookup_fluid(Val);
+ goto lookup_end_restart;
+
+/* Interpret() continues on the next page */
+\f
+/* Interpret(), continued */
+
+ case TRAP_NOP:
+ Val = Vector_Ref(Val, TRAP_EXTRA);
+ Set_Time_Zone(Zone_Working);
+ goto Pop_Return;
+
case TRAP_UNBOUND:
temp = ERR_UNBOUND_VARIABLE;
break;
temp = ERR_UNASSIGNED_VARIABLE;
break;
-/* Interpret() continues on the next page */
-\f
-/* Interpret(), continued */
-
default:
temp = ERR_BROKEN_COMPILED_VARIABLE;
break;
temp = Lex_Ref(Fetch_Env(), Fetch_Expression());
Import_Val();
if (temp == PRIM_DONE)
- break;
+ goto Pop_Return;
#endif No_In_Line_Lookup
\f
/* Interpret(), continued */
-#define define_compiler_restart( return_code, entry) \
+#define define_compiler_restart(return_code, entry) \
case return_code: \
- { extern long entry(); \
+ { \
+ extern long entry(); \
compiled_code_restart(); \
Export_Registers(); \
Which_Way = entry(); \
goto return_from_compiled_code; \
}
- define_compiler_restart( RC_COMP_INTERRUPT_RESTART,
- comp_interrupt_restart)
+ define_compiler_restart (RC_COMP_INTERRUPT_RESTART,
+ comp_interrupt_restart)
+
+ define_compiler_restart (RC_COMP_LEXPR_INTERRUPT_RESTART,
+ comp_lexpr_interrupt_restart)
+
+ define_compiler_restart (RC_COMP_LOOKUP_APPLY_RESTART,
+ comp_lookup_apply_restart)
- define_compiler_restart( RC_COMP_LEXPR_INTERRUPT_RESTART,
- comp_lexpr_interrupt_restart)
+ define_compiler_restart (RC_COMP_REFERENCE_RESTART,
+ comp_reference_restart)
- define_compiler_restart( RC_COMP_LOOKUP_APPLY_RESTART,
- comp_lookup_apply_restart)
+ define_compiler_restart (RC_COMP_ACCESS_RESTART, comp_access_restart)
- define_compiler_restart( RC_COMP_REFERENCE_RESTART,
- comp_reference_restart)
+ define_compiler_restart (RC_COMP_UNASSIGNED_P_RESTART,
+ comp_unassigned_p_restart)
- define_compiler_restart( RC_COMP_ACCESS_RESTART,
- comp_access_restart)
+ define_compiler_restart (RC_COMP_UNBOUND_P_RESTART,
+ comp_unbound_p_restart)
- define_compiler_restart( RC_COMP_UNASSIGNED_P_RESTART,
- comp_unassigned_p_restart)
+ define_compiler_restart (RC_COMP_ASSIGNMENT_RESTART,
+ comp_assignment_restart)
- define_compiler_restart( RC_COMP_UNBOUND_P_RESTART,
- comp_unbound_p_restart)
+ define_compiler_restart (RC_COMP_DEFINITION_RESTART,
+ comp_definition_restart)
- define_compiler_restart( RC_COMP_ASSIGNMENT_RESTART,
- comp_assignment_restart)
+ define_compiler_restart (RC_COMP_SAFE_REFERENCE_RESTART,
+ comp_safe_reference_restart)
- define_compiler_restart( RC_COMP_DEFINITION_RESTART,
- comp_definition_restart)
+ define_compiler_restart (RC_COMP_CACHE_VARIABLE_RESTART,
+ comp_cache_variable_restart)
+ define_compiler_restart (RC_COMP_REFERENCE_TRAP_RESTART,
+ comp_reference_trap_restart)
+
+ define_compiler_restart (RC_COMP_ASSIGNMENT_TRAP_RESTART,
+ comp_assignment_trap_restart)
+
+ define_compiler_restart (RC_COMP_UUO_LINK_RESTART, comp_uuo_link_restart)
+
+ define_compiler_restart (RC_COMP_UUO_LINK_TRAP_RESTART,
+ comp_uuo_link_trap_restart)
+\f
case RC_REENTER_COMPILED_CODE:
compiled_code_restart();
Export_Registers();
Which_Way = return_to_compiled_code();
goto return_from_compiled_code;
-\f
+
case RC_CONDITIONAL_DECIDE:
Pop_Return_Val_Check();
End_Subproblem();
/* Should be called RC_REDO_EVALUATION. */
Store_Env(Pop());
Reduces_To(Fetch_Expression());
-
+\f
case RC_EXECUTE_ACCESS_FINISH:
{
long Result;
Restore_Env();
cell = Get_Pointer(Vector_Ref(Fetch_Expression(), ASSIGN_NAME));
lookup(cell, Fetch_Env(), cell, repeat_assignment_lookup);
- setup_lock(set_serializer, cell);
value = Val;
bogus_unassigned = Get_Fixed_Obj_Slot(Non_Object);
if (value == bogus_unassigned)
value = UNASSIGNED_OBJECT;
+assignment_end_before_lock:
+
+ setup_lock(set_serializer, cell);
+
+assignment_end_after_lock:
+
if (Type_Code(*cell) != TC_REFERENCE_TRAP)
{
Val = *cell;
case TRAP_UNBOUND_DANGEROUS:
case TRAP_UNASSIGNED_DANGEROUS:
case TRAP_FLUID_DANGEROUS:
+ case TRAP_COMPILER_CACHED_DANGEROUS:
remove_lock(set_serializer);
cell = Get_Pointer(Vector_Ref(Fetch_Expression(), ASSIGN_NAME));
temp =
cell,
value,
false);
- goto external_assignment_return;
-
- case TRAP_UNASSIGNED:
- Val = bogus_unassigned;
- goto normal_assignment_done;
-
- case TRAP_FLUID:
- /* No need to recompile, pass the fake variable. */
- remove_lock(set_serializer);
- temp = deep_assignment_end(lookup_fluid(*cell),
- fake_variable_object,
- value,
- false);
-
- external_assignment_return:
+external_assignment_return:
Import_Val();
if (temp != PRIM_DONE)
break;
End_Subproblem();
goto Pop_Return;
+ case TRAP_COMPILER_CACHED:
+ {
+ Pointer extension;
+
+ extension = Fast_Vector_Ref(Val, TRAP_EXTRA);
+ if (Fast_Vector_Ref(extension, TRAP_EXTENSION_UUO_LIST) != NIL)
+ {
+ /* No need to recompile, pass the fake variable. */
+ remove_lock(set_serializer);
+ temp = deep_assignment_end(cell,
+ fake_variable_object,
+ value,
+ false);
+ goto external_assignment_return;
+ }
+ cell = Nth_Vector_Loc(extension, TRAP_EXTENSION_CELL);
+ goto assignment_end_after_lock;
+ }
+
+/* Interpret() continues on the next page */
+\f
+/* Interpret(), continued */
+
+ case TRAP_FLUID:
+ remove_lock(set_serializer);
+ cell = lookup_fluid(Val);
+ goto assignment_end_before_lock;
+
case TRAP_UNBOUND:
remove_lock(set_serializer);
temp = ERR_UNBOUND_VARIABLE;
break;
+ case TRAP_UNASSIGNED:
+ Val = bogus_unassigned;
+ goto normal_assignment_done;
+
+ case TRAP_NOP:
+ remove_lock(set_serializer);
+ temp = ERR_BAD_FRAME;
+ break;
+
default:
remove_lock(set_serializer);
temp = ERR_BROKEN_COMPILED_VARIABLE;
break;
}
+ if (value == UNASSIGNED_OBJECT)
+ value = bogus_unassigned;
+
/* Interpret() continues on the next page */
\f
/* Interpret(), continued */
-#else
+#else No_In_Line_Lookup
+ value = Val;
Set_Time_Zone(Zone_Lookup);
Restore_Env();
temp = Lex_Set(Fetch_Env(),
value);
Import_Val();
if (temp == PRIM_DONE)
- { End_Subproblem();
+ {
+ End_Subproblem();
Set_Time_Zone(Zone_Working);
break;
}
-#endif
+#endif No_In_Line_Lookup
Set_Time_Zone(Zone_Working);
Save_Env();
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.36 1987/04/16 02:26:04 jinx Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/lookup.h,v 9.37 1987/05/29 02:24:06 jinx Exp $ */
/* Macros and declarations for the variable lookup code. */
extern Pointer
*deep_lookup(),
- *lookup_fluid();
+ *lookup_fluid(),
+ *force_definition();
extern long
deep_lookup_end(),
\f
#define lookup_primitive_type_test() \
{ \
- if (Type_Code(Arg1) != GLOBAL_ENV) Arg_1_Type(TC_ENVIRONMENT); \
+ 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; \
+ PRIMITIVE_RETURN(Val); \
if (Result == PRIM_INTERRUPT) \
Primitive_Interrupt(); \
Primitive_Error(Result); \
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.23 1987/04/16 02:29:06 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/sdata.h,v 9.24 1987/05/29 02:24:18 jinx Rel $
*
* Description of the user data objects. This should parallel the
* file SDATA.SCM in the runtime system.
#define PROCEDURE_LAMBDA_EXPR 0
#define PROCEDURE_ENVIRONMENT 1
\f
+/* QUAD or HUNK4
+ * Like a pair but with 4 components.
+ */
+
+#define HUNK4_CXR0 0
+#define HUNK4_CXR1 1
+#define HUNK4_CXR2 2
+#define HUNK4_CXR3 3
+
/* REFERENCE_TRAP
* Causes the variable lookup code to trap.
* Used to implement a variety of features.
#define TRAP_TAG 0
#define TRAP_EXTRA 1
+/* Traps can be extended for the use of the fast variable reference mechanism in
+ * compiled code. The following is the format of a trap extension object.
+ */
+
+#define TRAP_EXTENSION_CELL HUNK4_CXR0
+#define TRAP_EXTENSION_CACHE_LIST HUNK4_CXR1
+#define TRAP_EXTENSION_UUO_LIST HUNK4_CXR2
+#define TRAP_EXTENSION_NAME HUNK4_CXR3
+
+/* Aliases */
+#define TRAP_EXTENSION_BLOCK TRAP_EXTENSION_CACHE_LIST
+#define TRAP_EXTENSION_OFFSET TRAP_EXTENSION_UUO_LIST
+\f
/* RETURN_CODE
* Represents an address where computation is to continue. These can be
* thought of as states in a finite state machine, labels in an assembly
#define STATE_SPACE_TAG 1
#define STATE_SPACE_NEAREST_POINT 2
#define STATE_SPACE_SIZE 3
-
+\f
/* When in RC_MOVE_TO_ADJACENT_POINT in the interpreter, the following
information is available on the stack (placed there by
Translate_To_Point
#define TRANSLATE_FROM_DISTANCE 1
#define TRANSLATE_TO_POINT 2
#define TRANSLATE_TO_DISTANCE 3
-\f
+
/* TRUE
* The initial binding of the variable T is to an object of this type.
* This type is the beginnings of a possible move toward a system where
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.31 1987/05/28 16:07:58 cph Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/storage.c,v 9.32 1987/05/29 02:24:33 jinx Exp $
This file defines the storage for global variables for
the Scheme Interpreter. */
*Heap, /* Bottom of entire heap */
Current_State_Point = NIL, /* Used by dynamic winder */
Fluid_Bindings = NIL, /* Fluid bindings AList */
- return_to_interpreter, /* Return address/code left by interpreter
- when calling compiled code */
- uuo_link_trap, /* Entry address for uuo links needing
- special attention */
*last_return_code, /* Address of the most recent return code in the stack.
This is only meaningful while in compiled code.
*** This must be changed when stacklets are used. ***
*/
+ compiler_utilities, /* Utility block in constant space needed by the compiled
+ code interface. */
Swap_Temp; /* Used by Swap_Pointers in default.h */
\f
long IntCode, /* Interrupts requesting */
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.37 1987/04/16 02:30:49 jinx Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/trap.h,v 9.38 1987/05/29 02:24:53 jinx Rel $ */
\f
/* Kinds of traps:
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_UNBOUND 2
#define TRAP_UNBOUND_DANGEROUS 3
#define TRAP_ILLEGAL 4
-#define TRAP_ILLEGAL_DANGEROUS 5 /* Unused. */
+#define TRAP_ILLEGAL_DANGEROUS 5
/* TRAP_MAX_IMMEDIATE is defined in const.h */
/* The following are not: */
-#define TRAP_NOP 10 /* Unused. */
+#define TRAP_NOP 10
#define TRAP_DANGEROUS 11
#define TRAP_FLUID 12
#define TRAP_FLUID_DANGEROUS 13
+#define TRAP_COMPILER_CACHED 14
+#define TRAP_COMPILER_CACHED_DANGEROUS 15
+
+#define TRAP_EXTENSION_TYPE TC_QUAD
/* Trap utilities */
#define DANGEROUS_ILLEGAL_OBJECT 0x32000005
#endif
+#define NOP_OBJECT Make_Unsigned_Fixnum(TRAP_NOP)
#define DANGEROUS_OBJECT Make_Unsigned_Fixnum(TRAP_DANGEROUS)
+#define REQUEST_RECACHE_OBJECT DANGEROUS_ILLEGAL_OBJECT
#if (TC_REFERENCE_TRAP != 0x32)
#include "error: trap.h and types.h are inconsistent"
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 9.55 1987/05/28 00:49:25 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 9.56 1987/05/29 02:25:04 jinx Exp $
This file contains version information for the microcode. */
\f
#define VERSION 9
#endif
#ifndef SUBVERSION
-#define SUBVERSION 55
+#define SUBVERSION 56
#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/interp.c,v 9.24 1987/04/21 15:02:02 cph Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/interp.c,v 9.25 1987/05/29 02:23:02 jinx Exp $
*
* This file contains the heart of the Scheme Scode
* interpreter
Set_Time_Zone(Zone_Lookup);
cell = Get_Pointer(Fetch_Expression());
lookup(cell, Fetch_Env(), cell, repeat_variable_lookup);
- Val = *cell;
+
+lookup_end_restart:
+
+ Val = Fetch(cell[0]);
if (Type_Code(Val) != TC_REFERENCE_TRAP)
{
Set_Time_Zone(Zone_Working);
case TRAP_UNBOUND_DANGEROUS:
case TRAP_UNASSIGNED_DANGEROUS:
case TRAP_FLUID_DANGEROUS:
+ case TRAP_COMPILER_CACHED_DANGEROUS:
cell = Get_Pointer(Fetch_Expression());
temp =
- deep_lookup_end(deep_lookup(Fetch_Env(), cell[VARIABLE_SYMBOL], cell),
+ deep_lookup_end(deep_lookup(Fetch_Env(),
+ cell[VARIABLE_SYMBOL],
+ cell),
cell);
- goto external_lookup_return;
-
- /* No need to recompile, pass the fake variable. */
- case TRAP_FLUID:
- temp = deep_lookup_end(lookup_fluid(Val), fake_variable_object);
-
- external_lookup_return:
Import_Val();
if (temp != PRIM_DONE)
break;
Set_Time_Zone(Zone_Working);
goto Pop_Return;
+ case TRAP_COMPILER_CACHED:
+ cell = Nth_Vector_Loc(Fast_Vector_Ref(Val, TRAP_EXTRA),
+ TRAP_EXTENSION_CELL);
+ goto lookup_end_restart;
+
+ case TRAP_FLUID:
+ cell = lookup_fluid(Val);
+ goto lookup_end_restart;
+
+/* Interpret() continues on the next page */
+\f
+/* Interpret(), continued */
+
+ case TRAP_NOP:
+ Val = Vector_Ref(Val, TRAP_EXTRA);
+ Set_Time_Zone(Zone_Working);
+ goto Pop_Return;
+
case TRAP_UNBOUND:
temp = ERR_UNBOUND_VARIABLE;
break;
temp = ERR_UNASSIGNED_VARIABLE;
break;
-/* Interpret() continues on the next page */
-\f
-/* Interpret(), continued */
-
default:
temp = ERR_BROKEN_COMPILED_VARIABLE;
break;
temp = Lex_Ref(Fetch_Env(), Fetch_Expression());
Import_Val();
if (temp == PRIM_DONE)
- break;
+ goto Pop_Return;
#endif No_In_Line_Lookup
\f
/* Interpret(), continued */
-#define define_compiler_restart( return_code, entry) \
+#define define_compiler_restart(return_code, entry) \
case return_code: \
- { extern long entry(); \
+ { \
+ extern long entry(); \
compiled_code_restart(); \
Export_Registers(); \
Which_Way = entry(); \
goto return_from_compiled_code; \
}
- define_compiler_restart( RC_COMP_INTERRUPT_RESTART,
- comp_interrupt_restart)
+ define_compiler_restart (RC_COMP_INTERRUPT_RESTART,
+ comp_interrupt_restart)
+
+ define_compiler_restart (RC_COMP_LEXPR_INTERRUPT_RESTART,
+ comp_lexpr_interrupt_restart)
+
+ define_compiler_restart (RC_COMP_LOOKUP_APPLY_RESTART,
+ comp_lookup_apply_restart)
- define_compiler_restart( RC_COMP_LEXPR_INTERRUPT_RESTART,
- comp_lexpr_interrupt_restart)
+ define_compiler_restart (RC_COMP_REFERENCE_RESTART,
+ comp_reference_restart)
- define_compiler_restart( RC_COMP_LOOKUP_APPLY_RESTART,
- comp_lookup_apply_restart)
+ define_compiler_restart (RC_COMP_ACCESS_RESTART, comp_access_restart)
- define_compiler_restart( RC_COMP_REFERENCE_RESTART,
- comp_reference_restart)
+ define_compiler_restart (RC_COMP_UNASSIGNED_P_RESTART,
+ comp_unassigned_p_restart)
- define_compiler_restart( RC_COMP_ACCESS_RESTART,
- comp_access_restart)
+ define_compiler_restart (RC_COMP_UNBOUND_P_RESTART,
+ comp_unbound_p_restart)
- define_compiler_restart( RC_COMP_UNASSIGNED_P_RESTART,
- comp_unassigned_p_restart)
+ define_compiler_restart (RC_COMP_ASSIGNMENT_RESTART,
+ comp_assignment_restart)
- define_compiler_restart( RC_COMP_UNBOUND_P_RESTART,
- comp_unbound_p_restart)
+ define_compiler_restart (RC_COMP_DEFINITION_RESTART,
+ comp_definition_restart)
- define_compiler_restart( RC_COMP_ASSIGNMENT_RESTART,
- comp_assignment_restart)
+ define_compiler_restart (RC_COMP_SAFE_REFERENCE_RESTART,
+ comp_safe_reference_restart)
- define_compiler_restart( RC_COMP_DEFINITION_RESTART,
- comp_definition_restart)
+ define_compiler_restart (RC_COMP_CACHE_VARIABLE_RESTART,
+ comp_cache_variable_restart)
+ define_compiler_restart (RC_COMP_REFERENCE_TRAP_RESTART,
+ comp_reference_trap_restart)
+
+ define_compiler_restart (RC_COMP_ASSIGNMENT_TRAP_RESTART,
+ comp_assignment_trap_restart)
+
+ define_compiler_restart (RC_COMP_UUO_LINK_RESTART, comp_uuo_link_restart)
+
+ define_compiler_restart (RC_COMP_UUO_LINK_TRAP_RESTART,
+ comp_uuo_link_trap_restart)
+\f
case RC_REENTER_COMPILED_CODE:
compiled_code_restart();
Export_Registers();
Which_Way = return_to_compiled_code();
goto return_from_compiled_code;
-\f
+
case RC_CONDITIONAL_DECIDE:
Pop_Return_Val_Check();
End_Subproblem();
/* Should be called RC_REDO_EVALUATION. */
Store_Env(Pop());
Reduces_To(Fetch_Expression());
-
+\f
case RC_EXECUTE_ACCESS_FINISH:
{
long Result;
Restore_Env();
cell = Get_Pointer(Vector_Ref(Fetch_Expression(), ASSIGN_NAME));
lookup(cell, Fetch_Env(), cell, repeat_assignment_lookup);
- setup_lock(set_serializer, cell);
value = Val;
bogus_unassigned = Get_Fixed_Obj_Slot(Non_Object);
if (value == bogus_unassigned)
value = UNASSIGNED_OBJECT;
+assignment_end_before_lock:
+
+ setup_lock(set_serializer, cell);
+
+assignment_end_after_lock:
+
if (Type_Code(*cell) != TC_REFERENCE_TRAP)
{
Val = *cell;
case TRAP_UNBOUND_DANGEROUS:
case TRAP_UNASSIGNED_DANGEROUS:
case TRAP_FLUID_DANGEROUS:
+ case TRAP_COMPILER_CACHED_DANGEROUS:
remove_lock(set_serializer);
cell = Get_Pointer(Vector_Ref(Fetch_Expression(), ASSIGN_NAME));
temp =
cell,
value,
false);
- goto external_assignment_return;
-
- case TRAP_UNASSIGNED:
- Val = bogus_unassigned;
- goto normal_assignment_done;
-
- case TRAP_FLUID:
- /* No need to recompile, pass the fake variable. */
- remove_lock(set_serializer);
- temp = deep_assignment_end(lookup_fluid(*cell),
- fake_variable_object,
- value,
- false);
-
- external_assignment_return:
+external_assignment_return:
Import_Val();
if (temp != PRIM_DONE)
break;
End_Subproblem();
goto Pop_Return;
+ case TRAP_COMPILER_CACHED:
+ {
+ Pointer extension;
+
+ extension = Fast_Vector_Ref(Val, TRAP_EXTRA);
+ if (Fast_Vector_Ref(extension, TRAP_EXTENSION_UUO_LIST) != NIL)
+ {
+ /* No need to recompile, pass the fake variable. */
+ remove_lock(set_serializer);
+ temp = deep_assignment_end(cell,
+ fake_variable_object,
+ value,
+ false);
+ goto external_assignment_return;
+ }
+ cell = Nth_Vector_Loc(extension, TRAP_EXTENSION_CELL);
+ goto assignment_end_after_lock;
+ }
+
+/* Interpret() continues on the next page */
+\f
+/* Interpret(), continued */
+
+ case TRAP_FLUID:
+ remove_lock(set_serializer);
+ cell = lookup_fluid(Val);
+ goto assignment_end_before_lock;
+
case TRAP_UNBOUND:
remove_lock(set_serializer);
temp = ERR_UNBOUND_VARIABLE;
break;
+ case TRAP_UNASSIGNED:
+ Val = bogus_unassigned;
+ goto normal_assignment_done;
+
+ case TRAP_NOP:
+ remove_lock(set_serializer);
+ temp = ERR_BAD_FRAME;
+ break;
+
default:
remove_lock(set_serializer);
temp = ERR_BROKEN_COMPILED_VARIABLE;
break;
}
+ if (value == UNASSIGNED_OBJECT)
+ value = bogus_unassigned;
+
/* Interpret() continues on the next page */
\f
/* Interpret(), continued */
-#else
+#else No_In_Line_Lookup
+ value = Val;
Set_Time_Zone(Zone_Lookup);
Restore_Env();
temp = Lex_Set(Fetch_Env(),
value);
Import_Val();
if (temp == PRIM_DONE)
- { End_Subproblem();
+ {
+ End_Subproblem();
Set_Time_Zone(Zone_Working);
break;
}
-#endif
+#endif No_In_Line_Lookup
Set_Time_Zone(Zone_Working);
Save_Env();
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.36 1987/04/16 02:26:04 jinx Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/lookup.h,v 9.37 1987/05/29 02:24:06 jinx Exp $ */
/* Macros and declarations for the variable lookup code. */
extern Pointer
*deep_lookup(),
- *lookup_fluid();
+ *lookup_fluid(),
+ *force_definition();
extern long
deep_lookup_end(),
\f
#define lookup_primitive_type_test() \
{ \
- if (Type_Code(Arg1) != GLOBAL_ENV) Arg_1_Type(TC_ENVIRONMENT); \
+ 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; \
+ PRIMITIVE_RETURN(Val); \
if (Result == PRIM_INTERRUPT) \
Primitive_Interrupt(); \
Primitive_Error(Result); \
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.37 1987/04/16 02:30:49 jinx Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/trap.h,v 9.38 1987/05/29 02:24:53 jinx Rel $ */
\f
/* Kinds of traps:
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_UNBOUND 2
#define TRAP_UNBOUND_DANGEROUS 3
#define TRAP_ILLEGAL 4
-#define TRAP_ILLEGAL_DANGEROUS 5 /* Unused. */
+#define TRAP_ILLEGAL_DANGEROUS 5
/* TRAP_MAX_IMMEDIATE is defined in const.h */
/* The following are not: */
-#define TRAP_NOP 10 /* Unused. */
+#define TRAP_NOP 10
#define TRAP_DANGEROUS 11
#define TRAP_FLUID 12
#define TRAP_FLUID_DANGEROUS 13
+#define TRAP_COMPILER_CACHED 14
+#define TRAP_COMPILER_CACHED_DANGEROUS 15
+
+#define TRAP_EXTENSION_TYPE TC_QUAD
/* Trap utilities */
#define DANGEROUS_ILLEGAL_OBJECT 0x32000005
#endif
+#define NOP_OBJECT Make_Unsigned_Fixnum(TRAP_NOP)
#define DANGEROUS_OBJECT Make_Unsigned_Fixnum(TRAP_DANGEROUS)
+#define REQUEST_RECACHE_OBJECT DANGEROUS_ILLEGAL_OBJECT
#if (TC_REFERENCE_TRAP != 0x32)
#include "error: trap.h and types.h are inconsistent"
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 9.55 1987/05/28 00:49:25 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 9.56 1987/05/29 02:25:04 jinx Exp $
This file contains version information for the microcode. */
\f
#define VERSION 9
#endif
#ifndef SUBVERSION
-#define SUBVERSION 55
+#define SUBVERSION 56
#endif
#ifndef UCODE_TABLES_FILENAME
projects / mit-scheme.git / commitdiff