/* -*-C-*-
-Copyright (c) 1987 Massachusetts Institute of Technology
+Copyright (c) 1988 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
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.c,v 9.38 1987/11/17 08:14:11 jinx Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/lookup.c,v 9.39 1988/05/03 19:18:47 jinx Exp $
*
* This file contains symbol lookup and modification routines. See
* Hal Abelson for a paper describing and justifying the algorithm.
#include "locks.h"
#include "trap.h"
#include "lookup.h"
-#include "primitive.h"
/* NOTE:
Although this code has been parallelized, it has not been
*/
Pointer fake_variable_object[3];
+\f
+/* scan_frame searches a frame for a given name.
+ If it finds the names, it stores into hunk the path by which it was
+ found, so that future references do not spend the time to find it
+ again. It returns a pointer to the value cell, or a null pointer
+ cell if the variable was not found in this frame.
+ */
+
+extern Pointer *scan_frame();
+
+Pointer *
+scan_frame(frame, sym, hunk, depth, unbound_valid_p)
+ Pointer frame, sym, *hunk;
+ long depth;
+ Boolean unbound_valid_p;
+{
+ Lock_Handle compile_serializer;
+ fast Pointer *scan, temp;
+ fast long count;
+
+ temp = Vector_Ref(frame, ENVIRONMENT_FUNCTION);
+ if (OBJECT_TYPE(temp) == AUX_LIST_TYPE)
+ {
+ /* Search for an auxiliary binding. */
+
+ Pointer *start;
+
+ scan = Get_Pointer(temp);
+ start = scan;
+ count = Lexical_Offset(scan[AUX_LIST_COUNT]);
+ scan += AUX_LIST_FIRST;
+
+ while (--count >= 0)
+ {
+ if (Fast_Vector_Ref(*scan, CONS_CAR) == sym)
+ {
+ Pointer *cell;
+
+ cell = Nth_Vector_Loc(*scan, CONS_CDR);
+ if (Fetch(cell[0]) == DANGEROUS_UNBOUND_OBJECT)
+ {
+ /* A dangerous unbound object signals that
+ a definition here must become dangerous,
+ but is not a real bining.
+ */
+ return (unbound_valid_p ? (cell) : ((Pointer *) NULL));
+ }
+ setup_lock(compile_serializer, hunk);
+ hunk[VARIABLE_COMPILED_TYPE] = Make_Non_Pointer(AUX_REF, depth);
+ hunk[VARIABLE_OFFSET] = Make_Local_Offset(scan - start);
+ remove_lock(compile_serializer);
+ return (cell);
+ }
+ scan += 1;
+ }
+ temp = Vector_Ref(temp, ENV_EXTENSION_PROCEDURE);
+ }
+\f
+ /* Search for a formal parameter. */
+
+ temp = Fast_Vector_Ref(Fast_Vector_Ref(temp, PROCEDURE_LAMBDA_EXPR),
+ LAMBDA_FORMALS);
+ for (count = Vector_Length(temp) - 1,
+ scan = Nth_Vector_Loc(temp, VECTOR_DATA + 1);
+ count > 0;
+ count -= 1,
+ scan += 1)
+ {
+ if (*scan == sym)
+ {
+ fast long offset;
+
+ offset = 1 + Vector_Length(temp) - count;
+
+ setup_lock(compile_serializer, hunk);
+ if (depth != 0)
+ {
+ hunk[VARIABLE_COMPILED_TYPE] = Make_Non_Pointer(FORMAL_REF, depth);
+ hunk[VARIABLE_OFFSET] = Make_Local_Offset(offset);
+ }
+ else
+ {
+ hunk[VARIABLE_COMPILED_TYPE] = Make_Local_Offset(offset);
+ hunk[VARIABLE_OFFSET] = NIL;
+ }
+ remove_lock(compile_serializer);
+
+ return (Nth_Vector_Loc(frame, offset));
+ }
+ }
+
+ return ((Pointer *) NULL);
+}
+\f
/* The lexical lookup procedure.
deep_lookup searches env for an occurrence of sym. When it finds
it, it stores into hunk the path by which it was found, so that
Pointer env, sym, *hunk;
{
Lock_Handle compile_serializer;
- fast Pointer frame, *scan;
+ fast Pointer frame;
fast long depth;
for (depth = 0, frame = env;
frame = Fast_Vector_Ref(Vector_Ref(frame, ENVIRONMENT_FUNCTION),
PROCEDURE_ENVIRONMENT))
{
- fast Pointer temp;
-
- temp = Vector_Ref(frame, ENVIRONMENT_FUNCTION);
-\f
- if (OBJECT_TYPE(temp) == AUX_LIST_TYPE)
- {
- /* Search for an auxiliary binding. */
+ fast Pointer *cell;
- fast long count;
- Pointer *start;
-
- scan = Get_Pointer(temp);
- start = scan;
- count = Lexical_Offset(scan[AUX_LIST_COUNT]);
- scan += AUX_LIST_FIRST;
-
- while (--count >= 0)
- {
- if (Fast_Vector_Ref(*scan, CONS_CAR) == sym)
- {
- Pointer *cell;
-
- cell = Nth_Vector_Loc(*scan, CONS_CDR);
- if (Fetch(cell[0]) == DANGEROUS_UNBOUND_OBJECT)
- {
- /* A dangerous unbound object signals that
- a definition here must become dangerous,
- but is not a real bining.
- */
- goto do_next_frame;
- }
- setup_lock(compile_serializer, hunk);
- hunk[VARIABLE_COMPILED_TYPE] = Make_Non_Pointer(AUX_REF, depth);
- hunk[VARIABLE_OFFSET] = Make_Local_Offset(scan - start);
- remove_lock(compile_serializer);
- return cell;
- }
- scan += 1;
- }
- temp = Vector_Ref(temp, ENV_EXTENSION_PROCEDURE);
- }
-\f
+ cell = scan_frame(frame, sym, hunk, depth, false);
+ if (cell != ((Pointer *) NULL))
{
- /* Search for a formal parameter. */
-
- fast long count;
-
- temp = Fast_Vector_Ref(Fast_Vector_Ref(temp, PROCEDURE_LAMBDA_EXPR),
- LAMBDA_FORMALS);
- for (count = Vector_Length(temp) - 1,
- scan = Nth_Vector_Loc(temp, VECTOR_DATA + 1);
- count > 0;
- count -= 1,
- scan += 1)
- if (*scan == sym)
- {
- long offset;
-
- offset = 1 + Vector_Length(temp) - count;
-
- setup_lock(compile_serializer, hunk);
- if (depth != 0)
- {
- hunk[VARIABLE_COMPILED_TYPE] = Make_Non_Pointer(FORMAL_REF, depth);
- hunk[VARIABLE_OFFSET] = Make_Local_Offset(offset);
- }
- else
- {
- hunk[VARIABLE_COMPILED_TYPE] = Make_Local_Offset(offset);
- hunk[VARIABLE_OFFSET] = NIL;
- }
- remove_lock(compile_serializer);
-
- return Nth_Vector_Loc(frame, offset);
- }
+ return (cell);
}
-
-do_next_frame:
- continue;
}
+
/* The reference is global. */
if (OBJECT_DATUM(frame) != GO_TO_GLOBAL)
{
- return unbound_trap_object;
+ return (unbound_trap_object);
}
setup_lock(compile_serializer, hunk);
hunk[VARIABLE_OFFSET] = NIL;
remove_lock(compile_serializer);
- return Nth_Vector_Loc(sym, SYMBOL_GLOBAL_VALUE);
+ return (Nth_Vector_Loc(sym, SYMBOL_GLOBAL_VALUE));
}
\f
/* Full lookup end code.
FUTURE_VARIABLE_SPLICE (((Pointer) cell), 0, Val);
if (!(REFERENCE_TRAP_P(Val)))
{
- return PRIM_DONE;
+ return (PRIM_DONE);
}
/* Remarks:
*/
case TRAP_UNASSIGNED:
- return ERR_UNASSIGNED_VARIABLE;
+ return (ERR_UNASSIGNED_VARIABLE);
case TRAP_UNASSIGNED_DANGEROUS:
return_value = ERR_UNASSIGNED_VARIABLE;
break;
case TRAP_DANGEROUS:
- {
- Pointer trap_value;
+ {
+ Pointer trap_value;
- trap_value = Val;
- Val = (Vector_Ref (trap_value, TRAP_EXTRA));
- FUTURE_VARIABLE_SPLICE (trap_value, TRAP_EXTRA, Val);
- }
+ trap_value = Val;
+ Val = (Vector_Ref (trap_value, TRAP_EXTRA));
+ FUTURE_VARIABLE_SPLICE (trap_value, TRAP_EXTRA, Val);
return_value = PRIM_DONE;
break;
+ }
case TRAP_FLUID:
case TRAP_FLUID_DANGEROUS:
break;
case TRAP_UNBOUND:
- return ERR_UNBOUND_VARIABLE;
+ return (ERR_UNBOUND_VARIABLE);
case TRAP_UNBOUND_DANGEROUS:
return_value = ERR_UNBOUND_VARIABLE;
} while (repeat_p);
- return return_value;
+ return (return_value);
}
\f
/* Simple lookup finalization.
if (!(REFERENCE_TRAP_P(Val)))
{
- return PRIM_DONE;
+ return (PRIM_DONE);
}
get_trap_kind(trap_kind, Val);
case TRAP_FLUID_DANGEROUS:
case TRAP_COMPILER_CACHED_DANGEROUS:
return
- deep_lookup_end(deep_lookup(env, hunk[VARIABLE_SYMBOL], hunk),
- hunk);
+ (deep_lookup_end(deep_lookup(env, hunk[VARIABLE_SYMBOL], hunk),
+ hunk));
case TRAP_COMPILER_CACHED:
cell = Nth_Vector_Loc(Vector_Ref(Val, TRAP_EXTRA),
goto lookup_end_restart;
case TRAP_UNBOUND:
- return ERR_UNBOUND_VARIABLE;
+ return (ERR_UNBOUND_VARIABLE);
case TRAP_UNASSIGNED:
- return ERR_UNASSIGNED_VARIABLE;
+ return (ERR_UNASSIGNED_VARIABLE);
default:
- return ERR_ILLEGAL_REFERENCE_TRAP;
+ return (ERR_ILLEGAL_REFERENCE_TRAP);
}
}
\f
if (return_value != PRIM_DONE)
{
- return return_value;
+ return (return_value);
}
}
else
remove_lock(compile_serializer);
}
- return return_value;
+ return (return_value);
}
#undef ABORT
{
*cell = value;
remove_lock(set_serializer);
- return PRIM_DONE;
+ return (PRIM_DONE);
}
get_trap_kind(temp, Val);
case TRAP_COMPILER_CACHED_DANGEROUS:
remove_lock(set_serializer);
return
- deep_assignment_end(deep_lookup(env, hunk[VARIABLE_SYMBOL], hunk),
- hunk,
- value,
- false);
+ (deep_assignment_end(deep_lookup(env, hunk[VARIABLE_SYMBOL], hunk),
+ hunk,
+ value,
+ false));
\f
case TRAP_COMPILER_CACHED:
{
*/
remove_lock(set_serializer);
- return deep_assignment_end(cell, hunk, value, false);
+ return (deep_assignment_end(cell, hunk, value, false));
}
cell = Nth_Vector_Loc(extension, TRAP_EXTENSION_CELL);
update_lock(set_serializer, cell);
break;
}
remove_lock(set_serializer);
- return temp;
+ return (temp);
}
\f
/* Finds the fluid value cell associated with the reference trap on
fluids = Fluid_Bindings;
if (Fluids_Debug)
+ {
Print_Expression(fluids, "Searching fluid bindings");
+ }
while (PAIR_P(fluids))
{
if (this_pair[CONS_CAR] == trap)
{
if (Fluids_Debug)
+ {
fprintf(stderr, "Fluid found.\n");
+ }
- return &this_pair[CONS_CDR];
+ return (&this_pair[CONS_CDR]);
}
fluids = Fast_Vector_Ref(fluids, CONS_CDR);
/* Not found in fluid binding alist, so use default. */
if (Fluids_Debug)
+ {
fprintf(stderr, "Fluid not found, using default.\n");
+ }
- return Nth_Vector_Loc(trap, TRAP_EXTRA);
+ return (Nth_Vector_Loc(trap, TRAP_EXTRA));
}
\f
/* Utilities for definition.
{
remove_lock(set_serializer);
Request_GC(2);
- return PRIM_INTERRUPT;
+ return (PRIM_INTERRUPT);
}
trap = Make_Pointer(TC_REFERENCE_TRAP, Free);
*Free++ = DANGEROUS_OBJECT;
*Free++ = *cell;
*cell = trap;
remove_lock(set_serializer);
- return PRIM_DONE;
+ return (PRIM_DONE);
}
\f
get_trap_kind(temp, *cell);
long compiler_uncache();
remove_lock(set_serializer);
- return compiler_uncache(cell, sym);
+ return (compiler_uncache(cell, sym));
}
case TRAP_FLUID:
break;
}
remove_lock(set_serializer);
- return temp;
+ return (temp);
}
\f
/* The core of the incremental definition mechanism.
definition, extending the frames appropriately, and uncaching any
compiled code reference caches which might be affected by the new
definition.
+
+ *UNDEFINE*: If (local?) undefine is ever implemented, it suffices
+ to set the value cell to DANGEROUS_UNBOUND_OBJECT, uncache all the
+ compiler cached variables to the location, and rewrite the code
+ below slightly as implied by the comments tagged *UNDEFINE*.
*/
long
if (OBJECT_TYPE(env) == GLOBAL_ENV)
{
+ /* *UNDEFINE*: If undefine is ever implemented, this code need not
+ change: There are no shadowed bindings that need to be
+ recached.
+ */
if (OBJECT_DATUM(env) != GO_TO_GLOBAL)
{
- if (original_frame_p)
- return ERR_BAD_FRAME;
- return PRIM_DONE;
+ return (original_frame_p ? ERR_BAD_FRAME : PRIM_DONE);
}
else if (original_frame_p)
- return redefinition(Nth_Vector_Loc(sym, SYMBOL_GLOBAL_VALUE),
- value);
-
- else return dangerize(Nth_Vector_Loc(sym, SYMBOL_GLOBAL_VALUE), sym);
+ {
+ return (redefinition(Nth_Vector_Loc(sym, SYMBOL_GLOBAL_VALUE),
+ value));
+ }
+ else
+ {
+ return (dangerize(Nth_Vector_Loc(sym, SYMBOL_GLOBAL_VALUE), sym));
+ }
}
-
+\f
the_procedure = Vector_Ref(env, ENVIRONMENT_FUNCTION);
if (OBJECT_TYPE(the_procedure) == AUX_LIST_TYPE)
the_procedure = Vector_Ref(the_procedure, ENV_EXTENSION_PROCEDURE);
scan = Nth_Vector_Loc(formals, VECTOR_DATA + 1);
count > 0;
count -= 1)
+ {
+ /* *UNDEFINE*: If undefine is ever implemented, this code must
+ check whether the value is DANGEROUS_UNBOUND_OBJECT, and if
+ so, a search must be done to cause the shadowed compiler
+ cached variables to be recached, as in the aux case below.
+ */
if (*scan++ == sym)
{
long offset;
offset = 1 + Vector_Length(formals) - count;
if (original_frame_p)
- return redefinition(Nth_Vector_Loc(env, offset), value);
+ {
+ return (redefinition(Nth_Vector_Loc(env, offset), value));
+ }
else
- return dangerize(Nth_Vector_Loc(env, offset), sym);
+ {
+ return (dangerize(Nth_Vector_Loc(env, offset), sym));
+ }
}
+ }
}
\f
/* Guarantee that there is an extension slot. */
{
remove_lock(extension_serializer);
Request_GC(AUX_LIST_INITIAL_SIZE);
- return PRIM_INTERRUPT;
+ return (PRIM_INTERRUPT);
}
scan = Free;
extension = Make_Pointer(AUX_LIST_TYPE, scan);
/* This is done only because of compiler cached variables.
In their absence, this conditional is unnecessary.
- Note that this would also have to be done for formal
- bindings if we allowed "undefinition" of variables.
+
+ *UNDEFINE*: This would also have to be done for other kinds
+ of bindings if undefine is ever implemented. See the
+ comments above.
*/
if (Fetch(scan[0]) == DANGEROUS_UNBOUND_OBJECT)
{
fake_variable_object),
sym);
if (temp != PRIM_DONE)
- return temp;
+ {
+ return (temp);
+ }
}
if (original_frame_p)
- return redefinition(scan, value);
+ {
+ return (redefinition(scan, value));
+ }
else
- return dangerize(scan, sym);
+ {
+ return (dangerize(scan, sym));
+ }
}
scan += 1;
}
}
-
+\f
/* Not found in this frame at all. */
{
sym, NIL, false);
if (temp != PRIM_DONE)
- return temp;
+ {
+ return (temp);
+ }
\f
/* Proceed to extend the frame:
- If the frame is the one where the definition is occurring,
{
remove_lock(extension_serializer);
Request_GC(i);
- return PRIM_INTERRUPT;
+ return (PRIM_INTERRUPT);
}
fast_free = Free;
{
remove_lock(extension_serializer);
Request_GC(2);
- return PRIM_INTERRUPT;
+ return (PRIM_INTERRUPT);
}
{
scan[AUX_LIST_COUNT] = Make_Local_Offset(temp + 1);
}
remove_lock(extension_serializer);
- return PRIM_DONE;
+ return (PRIM_DONE);
}
}
\f
hunk = Get_Pointer(var);
lookup(cell, env, hunk, repeat_lex_ref_lookup);
- return lookup_end(cell, env, hunk);
+ return (lookup_end(cell, env, hunk));
}
long
Symbol_Lex_Ref(env, sym)
Pointer env, sym;
{
- return deep_lookup_end(deep_lookup(env, sym, fake_variable_object),
- fake_variable_object);
+ return (deep_lookup_end(deep_lookup(env, sym, fake_variable_object),
+ fake_variable_object));
}
long
hunk = Get_Pointer(var);
lookup(cell, env, hunk, repeat_lex_set_lookup);
- return assignment_end(cell, env, hunk, value);
+ return (assignment_end(cell, env, hunk, value));
}
long
Symbol_Lex_Set(env, sym, value)
Pointer env, sym, value;
{
- return deep_assignment_end(deep_lookup(env, sym, fake_variable_object),
- fake_variable_object,
- value,
- false);
+ return (deep_assignment_end(deep_lookup(env, sym, fake_variable_object),
+ fake_variable_object,
+ value,
+ false));
}
\f
long
long result;
if (Define_Debug)
+ {
fprintf(stderr,
"\n;; Local_Set: defining %s.",
Scheme_String_To_C_String(Vector_Ref(sym, SYMBOL_NAME)));
+ }
result = extend_frame(env, sym, value, true);
Val = sym;
- return result;
+ return (result);
}
long
long reference_result;
{
if (reference_result == ERR_UNASSIGNED_VARIABLE)
- {
- Val = UNASSIGNED_OBJECT;
- return (PRIM_DONE);
- }
+ {
+ Val = UNASSIGNED_OBJECT;
+ return (PRIM_DONE);
+ }
else
+ {
return (reference_result);
+ }
}
long
long reference_result;
{
switch (reference_result)
- {
+ {
case ERR_UNASSIGNED_VARIABLE:
Val = TRUTH;
return (PRIM_DONE);
default:
return (reference_result);
- }
+ }
}
+\f
+extern long
+ Symbol_Lex_unassigned_p(),
+ Symbol_Lex_unbound_p();
long
Symbol_Lex_unassigned_p( frame, symbol)
result = Symbol_Lex_Ref( frame, symbol);
switch (result)
- {
+ {
case ERR_UNASSIGNED_VARIABLE:
case PRIM_DONE:
- {
- Val = NIL;
- return (PRIM_DONE);
- }
+ {
+ Val = NIL;
+ return (PRIM_DONE);
+ }
case ERR_UNBOUND_VARIABLE:
- {
- Val = TRUTH;
- return (PRIM_DONE);
- }
+ {
+ Val = TRUTH;
+ return (PRIM_DONE);
+ }
default:
return (result);
- }
+ }
}
\f
/* force_definition is used when access to the global environment is
fast Pointer previous;
if (OBJECT_TYPE(env) == GLOBAL_ENV)
+ {
return ((Pointer *) NULL);
-
+ }
+
do
{
previous = env;
\f
/* Fast variable reference mechanism for compiled code.
- compiler_cache_reference is the core of the variable caching mechanism.
+ compiler_cache is the core of the variable caching mechanism.
- It creates a variable cache for the variable specified by (name,
- env) if needed, and stores it or a related object in the location
+ It creates a variable cache for the variable at the specified cell,
+ if needed, and stores it or a related object in the location
specified by (block, offset). It adds this reference to the
appropriate reference list for further updating.
updated to point to it.
*/
+extern long compiler_cache();
+
long
-compiler_cache_reference(env, name, block, offset, kind)
- Pointer env, name, block;
+compiler_cache(cell, name, block, offset, kind)
+ fast Pointer *cell;
+ Pointer name, block;
long offset, kind;
{
Lock_Handle set_serializer;
- fast Pointer *cell, trap, references, extension;
+ fast Pointer trap, references, extension;
Pointer trap_value, store_trap_tag, store_extension;
long trap_kind, return_value;
-
- cell = deep_lookup(env, name, fake_variable_object);
- if (cell == unbound_trap_object)
- {
- long message;
-
- cell = force_definition(env, name, &message);
- if (message != PRIM_DONE)
- return message;
- }
store_trap_tag = NIL;
store_extension = NIL;
trap_kind = TRAP_COMPILER_CACHED;
-\f
+
setup_lock(set_serializer, cell);
trap = *cell;
trap_value = trap;
-
+\f
if (REFERENCE_TRAP_P(trap))
{
long old_trap_kind;
default:
remove_lock(set_serializer);
- return ERR_ILLEGAL_REFERENCE_TRAP;
+ return (ERR_ILLEGAL_REFERENCE_TRAP);
}
}
\f
{
remove_lock(set_serializer);
Request_GC(MAXIMUM_CACHE_SIZE);
- return PRIM_INTERRUPT;
+ return (PRIM_INTERRUPT);
}
#endif
{
remove_lock(set_serializer);
Request_GC(7);
- return PRIM_INTERRUPT;
+ return (PRIM_INTERRUPT);
}
#endif
update_lock(set_serializer,
Nth_Vector_Loc(extension, TRAP_EXTENSION_CELL));
}
+
+ if (block == NIL)
+ {
+ /* It is not really from compiled code.
+ The environment linking stuff wants a cc cache instead.
+ */
+ remove_lock(set_serializer);
+ return (PRIM_DONE);
+ }
\f
/* There already is a compiled code cache.
Maybe this should clean up all the cache lists?
{
remove_lock(set_serializer);
Request_GC(4);
- return PRIM_INTERRUPT;
+ return (PRIM_INTERRUPT);
}
#endif
store_extension = Make_Pointer(TRAP_EXTENSION_TYPE, Free);
if (return_value != PRIM_DONE)
{
remove_lock(set_serializer);
- return return_value;
+ return (return_value);
}
}
\f
}
remove_lock(set_serializer);
- return return_value;
+ return (return_value);
}
\f
+/* This procedure invokes cache_reference after finding the top-level
+ value cell associated with (env, name).
+ */
+
+long
+compiler_cache_reference(env, name, block, offset, kind)
+ Pointer env, name, block;
+ long offset, kind;
+{
+ Pointer *cell;
+
+ cell = deep_lookup(env, name, fake_variable_object);
+ if (cell == unbound_trap_object)
+ {
+ long message;
+
+ cell = force_definition(env, name, &message);
+ if (message != PRIM_DONE)
+ {
+ return (message);
+ }
+ }
+ return (compiler_cache(cell, name, block, offset, kind));
+}
+
/* This procedure updates all the references in the cached reference
list pointed at by slot to hold value. It also eliminates "empty"
pairs (pairs whose weakly held block has vanished).
{
Fast_Vector_Set(pair, CONS_CAR, block);
Fast_Vector_Set(pair, CONS_CDR, offset);
- return PRIM_DONE;
+ return (PRIM_DONE);
}
slot = Nth_Vector_Loc(*slot, CONS_CDR);
}
if (GC_allocate_test(4))
{
Request_GC(4);
- return PRIM_INTERRUPT;
+ return (PRIM_INTERRUPT);
}
*slot = Make_Pointer(TC_LIST, Free);
*Free++ = block;
*Free++ = offset;
- return PRIM_DONE;
+ return (PRIM_DONE);
}
\f
/* compiler_uncache_slot uncaches all references in the list pointed
if (GC_allocate_test(4))
{
Request_GC(4);
- return PRIM_INTERRUPT;
+ return (PRIM_INTERRUPT);
}
new_extension = Make_Pointer(TRAP_EXTENSION_TYPE, Free);
*Free++ = REQUEST_RECACHE_OBJECT;
block,
Get_Integer(offset));
if (result != PRIM_DONE)
- return result;
+ return (result);
}
else
{
}
*slot = Fast_Vector_Ref(temp, CONS_CDR);
}
- return PRIM_DONE;
+ return (PRIM_DONE);
}
\f
/* compiler_uncache is invoked when a redefinition occurs.
TRAP_REFERENCES_ASSIGNMENT,
TRAP_REFERENCES_OPERATOR};
+extern long compiler_uncache();
+
long
compiler_uncache(value_cell, sym)
Pointer *value_cell, sym;
if (!(REFERENCE_TRAP_P(val)))
{
remove_lock(set_serializer);
- return PRIM_DONE;
+ return (PRIM_DONE);
}
\f
get_trap_kind(trap_kind, val);
(trap_kind != TRAP_COMPILER_CACHED_DANGEROUS))
{
remove_lock(set_serializer);
- return PRIM_DONE;
+ return (PRIM_DONE);
}
extension = Fast_Vector_Ref(val, TRAP_EXTRA);
if (temp != PRIM_DONE)
{
remove_lock(set_serializer);
- return temp;
+ return (temp);
}
}
Fast_Vector_Set(extension, TRAP_EXTENSION_CLONE, NIL);
remove_lock(set_serializer);
- return PRIM_DONE;
+ return (PRIM_DONE);
}
\f
/* recache_uuo_links is invoked when an assignment occurs to a
Fast_Vector_Set(extension, TRAP_EXTENSION_CELL, old_value);
}
- return return_value;
+ return (return_value);
}
/* This kludge is due to the lack of closures. */
{
extern long make_fake_uuo_link();
- return make_fake_uuo_link(extension, block, offset);
+ return (make_fake_uuo_link(extension, block, offset));
}
\f
long
Get_Integer(Fast_Vector_Ref(pair, CONS_CDR)));
if (return_value != PRIM_DONE)
{
- return return_value;
+ return (return_value);
}
slot = Nth_Vector_Loc(*slot, CONS_CDR);
}
fix_references(Nth_Vector_Loc(references, TRAP_REFERENCES_ASSIGNMENT),
extension);
}
- return PRIM_DONE;
+ return (PRIM_DONE);
}
\f
/* compiler_reference_trap is called when a reference occurs to a compiled
if (Vector_Ref(extension, TRAP_EXTENSION_CELL) != REQUEST_RECACHE_OBJECT)
{
- return (*handler)(Nth_Vector_Loc(extension, TRAP_EXTENSION_CELL),
- fake_variable_object);
+ return ((*handler)(Nth_Vector_Loc(extension, TRAP_EXTENSION_CELL),
+ fake_variable_object));
}
block = Fast_Vector_Ref(extension, TRAP_EXTENSION_BLOCK);
offset,
kind);
if (temp != PRIM_DONE)
- return temp;
+ {
+ return (temp);
+ }
\f
switch(kind)
{
extern Pointer extract_uuo_link();
Val = extract_uuo_link(block, offset);
- return PRIM_DONE;
+ return (PRIM_DONE);
}
case TRAP_REFERENCES_ASSIGNMENT:
Pointer extension;
extension = extract_variable_cache(block, offset);
- return (*handler)(Nth_Vector_Loc(extension, TRAP_EXTENSION_CELL),
- fake_variable_object);
+ return ((*handler)(Nth_Vector_Loc(extension, TRAP_EXTENSION_CELL),
+ fake_variable_object));
}
}
}
Pointer name, block;
long offset;
{
- return compiler_cache_reference(compiled_block_environment(block),
- name, block, offset,
- TRAP_REFERENCES_LOOKUP);
+ return (compiler_cache_reference(compiled_block_environment(block),
+ name, block, offset,
+ TRAP_REFERENCES_LOOKUP));
}
long
Pointer name, block;
long offset;
{
- return compiler_cache_reference(compiled_block_environment(block),
- name, block, offset,
- TRAP_REFERENCES_ASSIGNMENT);
+ return (compiler_cache_reference(compiled_block_environment(block),
+ name, block, offset,
+ TRAP_REFERENCES_ASSIGNMENT));
}
long
Pointer name, block;
long offset;
{
- return compiler_cache_reference(compiled_block_environment(block),
- name, block, offset,
- TRAP_REFERENCES_OPERATOR);
+ return (compiler_cache_reference(compiled_block_environment(block),
+ name, block, offset,
+ TRAP_REFERENCES_OPERATOR));
}
\f
extern long complr_operator_reference_trap();
TRAP_REFERENCES_OPERATOR,
deep_lookup_end);
if (temp != PRIM_DONE)
+ {
return temp;
+ }
*frame_slot = Val;
- return PRIM_DONE;
+ return (PRIM_DONE);
}
Pointer
compiler_var_error(extension, environment)
Pointer extension, environment;
{
- return Vector_Ref(extension, TRAP_EXTENSION_NAME);
+ return (Vector_Ref(extension, TRAP_EXTENSION_NAME));
}
/* Utility for compiler_assignment_trap, below.
compiler_assignment_end(cell, hunk)
Pointer *cell, *hunk;
{
- return
- deep_assignment_end(cell, hunk, saved_compiler_assignment_value, false);
+ return (deep_assignment_end(cell, hunk,
+ saved_compiler_assignment_value, false));
}
\f
/* More compiled code interface procedures */
compiler_lookup_trap(extension)
Pointer extension;
{
- return compiler_reference_trap(extension,
- TRAP_REFERENCES_LOOKUP,
- deep_lookup_end);
+ return (compiler_reference_trap(extension,
+ TRAP_REFERENCES_LOOKUP,
+ deep_lookup_end));
}
long
Pointer extension, value;
{
saved_compiler_assignment_value = value;
- return compiler_reference_trap(extension,
- TRAP_REFERENCES_ASSIGNMENT,
- compiler_assignment_end);
-}
-\f
-/* Primitives built on the procedures above. */
-
-/* (LEXICAL-ASSIGNMENT ENVIRONMENT SYMBOL VALUE)
- Sets the value of the variable with the name given in SYMBOL, as
- seen in the lexical ENVIRONMENT, to the specified VALUE.
- Returns the previous value.
-
- It's indistinguishable from evaluating
- (set! <symbol> <value>) in <environment>.
-*/
-Built_In_Primitive(Prim_Lexical_Assignment, 3, "LEXICAL-ASSIGNMENT", 0x0)
-Define_Primitive(Prim_Lexical_Assignment, 3, "LEXICAL-ASSIGNMENT")
-{
- Primitive_3_Args();
-
- standard_lookup_primitive(Symbol_Lex_Set(Arg1, Arg2, Arg3));
-}
-
-/* (LEXICAL-REFERENCE ENVIRONMENT SYMBOL)
- Returns the value of the variable with the name given in SYMBOL,
- as seen in the lexical ENVIRONMENT.
-
- Indistinguishable from evaluating <symbol> in <environment>.
-*/
-Built_In_Primitive(Prim_Lexical_Reference, 2, "LEXICAL-REFERENCE", 0x12)
-Define_Primitive(Prim_Lexical_Reference, 2, "LEXICAL-REFERENCE")
-{
- Primitive_2_Args();
-
- standard_lookup_primitive(Symbol_Lex_Ref(Arg1, Arg2));
-}
-
-/* (LOCAL-REFERENCE ENVIRONMENT SYMBOL)
- Identical to LEXICAL_REFERENCE, here for histerical reasons.
-*/
-Built_In_Primitive(Prim_Local_Reference, 2, "LOCAL-REFERENCE", 0x1)
-Define_Primitive(Prim_Local_Reference, 2, "LOCAL-REFERENCE")
-{
- Primitive_2_Args();
-
- standard_lookup_primitive(Symbol_Lex_Ref(Arg1, Arg2));
-}
-\f
-/* (LOCAL-ASSIGNMENT ENVIRONMENT SYMBOL VALUE)
- Should be called *DEFINE.
-
- If the variable specified by SYMBOL already exists in the
- lexical ENVIRONMENT, then its value there is changed to VALUE.
- Otherwise a new binding is created in that environment linking
- the specified variable to the value. Returns SYMBOL.
-
- Indistinguishable from evaluating
- (define <symbol> <value>) in <environment>.
-*/
-Built_In_Primitive(Prim_Local_Assignment, 3, "LOCAL-ASSIGNMENT", 0x2)
-Define_Primitive(Prim_Local_Assignment, 3, "LOCAL-ASSIGNMENT")
-{
- Primitive_3_Args();
-
- standard_lookup_primitive(Local_Set(Arg1, Arg2, Arg3));
-}
-
-/* (LEXICAL-UNASSIGNED? ENVIRONMENT SYMBOL)
- Returns #!TRUE if the variable corresponding to SYMBOL is bound
- but has the special UNASSIGNED value in ENVIRONMENT. Returns
- NIL otherwise. Does a complete lexical search for SYMBOL
- starting in ENVIRONMENT.
- The special form (unassigned? <symbol>) is built on top of this.
-*/
-Built_In_Primitive(Prim_Unassigned_Test, 2, "LEXICAL-UNASSIGNED?", 0x18)
-Define_Primitive(Prim_Unassigned_Test, 2, "LEXICAL-UNASSIGNED?")
-{
- Primitive_2_Args();
-
- standard_lookup_primitive(Symbol_Lex_unassigned_p(Arg1, Arg2));
-}
-
-/* (LEXICAL-UNBOUND? ENVIRONMENT SYMBOL)
- Returns #!TRUE if the variable corresponding to SYMBOL has no
- binding in ENVIRONMENT. Returns NIL otherwise. Does a complete
- lexical search for SYMBOL starting in ENVIRONMENT.
- The special form (unbound? <symbol>) is built on top of this.
-*/
-Built_In_Primitive(Prim_Unbound_Test, 2, "LEXICAL-UNBOUND?", 0x33)
-Define_Primitive(Prim_Unbound_Test, 2, "LEXICAL-UNBOUND?")
-{
- Primitive_2_Args();
-
- standard_lookup_primitive(Symbol_Lex_unbound_p(Arg1, Arg2));
-}
-\f
-/* (LEXICAL-UNREFERENCEABLE? ENVIRONMENT SYMBOL)
- Returns #T if evaluating <symbol> in <environment> would cause
- a variable lookup error (unbound or unassigned).
-*/
-Built_In_Primitive(Prim_Unreferenceable_Test, 2,
- "LEXICAL-UNREFERENCEABLE?", 0x13)
-Define_Primitive(Prim_Unreferenceable_Test, 2,
- "LEXICAL-UNREFERENCEABLE?")
-{
- long Result;
- Primitive_2_Args();
-
- lookup_primitive_type_test();
- Result = Symbol_Lex_Ref(Arg1, Arg2);
- switch (Result)
- { case PRIM_DONE:
- PRIMITIVE_RETURN(NIL);
-
- case PRIM_INTERRUPT:
- Primitive_Interrupt();
- /*NOTREACHED*/
-
- case ERR_UNASSIGNED_VARIABLE:
- case ERR_UNBOUND_VARIABLE:
- PRIMITIVE_RETURN(TRUTH);
-
- default:
- Primitive_Error(Result);
- }
- /*NOTREACHED*/
+ return (compiler_reference_trap(extension,
+ TRAP_REFERENCES_ASSIGNMENT,
+ compiler_assignment_end));
}
/* -*-C-*-
-Copyright (c) 1987 Massachusetts Institute of Technology
+Copyright (c) 1988 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
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.39 1987/10/05 18:35:30 jinx Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/lookup.h,v 9.40 1988/05/03 19:21:57 jinx Exp $ */
/* Macros and declarations for the variable lookup code. */
#else
-#define Lexical_Offset(Ind) Get_Integer(Ind)
+#define Lexical_Offset(Ind) OBJECT_DATUM(Ind)
#define Make_Local_Offset(Ind) Make_Non_Pointer(LOCAL_REF, Ind)
#endif
#define verify(type_code, variable, code, label) \
{ \
variable = code; \
- if (Type_Code(Fetch(hunk[VARIABLE_COMPILED_TYPE])) != \
+ if (OBJECT_TYPE(Fetch(hunk[VARIABLE_COMPILED_TYPE])) != \
type_code) \
goto label; \
}
\
frame = Fetch(hunk[VARIABLE_COMPILED_TYPE]); \
\
- switch (Type_Code(frame)) \
+ switch (OBJECT_TYPE(frame)) \
{ \
case GLOBAL_REF: \
/* frame is a pointer to the same symbol. */ \
/* Done here rather than in a separate case because of \
peculiarities of the bobcat compiler. \
*/ \
- cell = ((Type_Code(frame) == UNCOMPILED_REF) ? \
+ cell = ((OBJECT_TYPE(frame) == UNCOMPILED_REF) ? \
uncompiled_trap_object : \
illegal_trap_object); \
break; \
} \
\
frame = Vector_Ref(frame, ENVIRONMENT_FUNCTION); \
- if (Type_Code(frame) != AUX_LIST_TYPE) \
+ if (OBJECT_TYPE(frame) != AUX_LIST_TYPE) \
{ \
cell = uncompiled_trap_object; \
break; \
cell = Nth_Vector_Loc(frame, CONS_CDR); \
break; \
}
-\f
-#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) \
- PRIMITIVE_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*/ \
-}
-
-
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.33 1988/04/27 01:10:33 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.34 1988/05/03 19:22:09 jinx Exp $
Copyright (c) 1988 Massachusetts Institute of Technology
#define VERSION 10
#endif
#ifndef SUBVERSION
-#define SUBVERSION 33
+#define SUBVERSION 34
#endif
#ifndef UCODE_TABLES_FILENAME
/* -*-C-*-
-Copyright (c) 1987 Massachusetts Institute of Technology
+Copyright (c) 1988 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
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.c,v 9.38 1987/11/17 08:14:11 jinx Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/lookup.c,v 9.39 1988/05/03 19:18:47 jinx Exp $
*
* This file contains symbol lookup and modification routines. See
* Hal Abelson for a paper describing and justifying the algorithm.
#include "locks.h"
#include "trap.h"
#include "lookup.h"
-#include "primitive.h"
/* NOTE:
Although this code has been parallelized, it has not been
*/
Pointer fake_variable_object[3];
+\f
+/* scan_frame searches a frame for a given name.
+ If it finds the names, it stores into hunk the path by which it was
+ found, so that future references do not spend the time to find it
+ again. It returns a pointer to the value cell, or a null pointer
+ cell if the variable was not found in this frame.
+ */
+
+extern Pointer *scan_frame();
+
+Pointer *
+scan_frame(frame, sym, hunk, depth, unbound_valid_p)
+ Pointer frame, sym, *hunk;
+ long depth;
+ Boolean unbound_valid_p;
+{
+ Lock_Handle compile_serializer;
+ fast Pointer *scan, temp;
+ fast long count;
+
+ temp = Vector_Ref(frame, ENVIRONMENT_FUNCTION);
+ if (OBJECT_TYPE(temp) == AUX_LIST_TYPE)
+ {
+ /* Search for an auxiliary binding. */
+
+ Pointer *start;
+
+ scan = Get_Pointer(temp);
+ start = scan;
+ count = Lexical_Offset(scan[AUX_LIST_COUNT]);
+ scan += AUX_LIST_FIRST;
+
+ while (--count >= 0)
+ {
+ if (Fast_Vector_Ref(*scan, CONS_CAR) == sym)
+ {
+ Pointer *cell;
+
+ cell = Nth_Vector_Loc(*scan, CONS_CDR);
+ if (Fetch(cell[0]) == DANGEROUS_UNBOUND_OBJECT)
+ {
+ /* A dangerous unbound object signals that
+ a definition here must become dangerous,
+ but is not a real bining.
+ */
+ return (unbound_valid_p ? (cell) : ((Pointer *) NULL));
+ }
+ setup_lock(compile_serializer, hunk);
+ hunk[VARIABLE_COMPILED_TYPE] = Make_Non_Pointer(AUX_REF, depth);
+ hunk[VARIABLE_OFFSET] = Make_Local_Offset(scan - start);
+ remove_lock(compile_serializer);
+ return (cell);
+ }
+ scan += 1;
+ }
+ temp = Vector_Ref(temp, ENV_EXTENSION_PROCEDURE);
+ }
+\f
+ /* Search for a formal parameter. */
+
+ temp = Fast_Vector_Ref(Fast_Vector_Ref(temp, PROCEDURE_LAMBDA_EXPR),
+ LAMBDA_FORMALS);
+ for (count = Vector_Length(temp) - 1,
+ scan = Nth_Vector_Loc(temp, VECTOR_DATA + 1);
+ count > 0;
+ count -= 1,
+ scan += 1)
+ {
+ if (*scan == sym)
+ {
+ fast long offset;
+
+ offset = 1 + Vector_Length(temp) - count;
+
+ setup_lock(compile_serializer, hunk);
+ if (depth != 0)
+ {
+ hunk[VARIABLE_COMPILED_TYPE] = Make_Non_Pointer(FORMAL_REF, depth);
+ hunk[VARIABLE_OFFSET] = Make_Local_Offset(offset);
+ }
+ else
+ {
+ hunk[VARIABLE_COMPILED_TYPE] = Make_Local_Offset(offset);
+ hunk[VARIABLE_OFFSET] = NIL;
+ }
+ remove_lock(compile_serializer);
+
+ return (Nth_Vector_Loc(frame, offset));
+ }
+ }
+
+ return ((Pointer *) NULL);
+}
+\f
/* The lexical lookup procedure.
deep_lookup searches env for an occurrence of sym. When it finds
it, it stores into hunk the path by which it was found, so that
Pointer env, sym, *hunk;
{
Lock_Handle compile_serializer;
- fast Pointer frame, *scan;
+ fast Pointer frame;
fast long depth;
for (depth = 0, frame = env;
frame = Fast_Vector_Ref(Vector_Ref(frame, ENVIRONMENT_FUNCTION),
PROCEDURE_ENVIRONMENT))
{
- fast Pointer temp;
-
- temp = Vector_Ref(frame, ENVIRONMENT_FUNCTION);
-\f
- if (OBJECT_TYPE(temp) == AUX_LIST_TYPE)
- {
- /* Search for an auxiliary binding. */
+ fast Pointer *cell;
- fast long count;
- Pointer *start;
-
- scan = Get_Pointer(temp);
- start = scan;
- count = Lexical_Offset(scan[AUX_LIST_COUNT]);
- scan += AUX_LIST_FIRST;
-
- while (--count >= 0)
- {
- if (Fast_Vector_Ref(*scan, CONS_CAR) == sym)
- {
- Pointer *cell;
-
- cell = Nth_Vector_Loc(*scan, CONS_CDR);
- if (Fetch(cell[0]) == DANGEROUS_UNBOUND_OBJECT)
- {
- /* A dangerous unbound object signals that
- a definition here must become dangerous,
- but is not a real bining.
- */
- goto do_next_frame;
- }
- setup_lock(compile_serializer, hunk);
- hunk[VARIABLE_COMPILED_TYPE] = Make_Non_Pointer(AUX_REF, depth);
- hunk[VARIABLE_OFFSET] = Make_Local_Offset(scan - start);
- remove_lock(compile_serializer);
- return cell;
- }
- scan += 1;
- }
- temp = Vector_Ref(temp, ENV_EXTENSION_PROCEDURE);
- }
-\f
+ cell = scan_frame(frame, sym, hunk, depth, false);
+ if (cell != ((Pointer *) NULL))
{
- /* Search for a formal parameter. */
-
- fast long count;
-
- temp = Fast_Vector_Ref(Fast_Vector_Ref(temp, PROCEDURE_LAMBDA_EXPR),
- LAMBDA_FORMALS);
- for (count = Vector_Length(temp) - 1,
- scan = Nth_Vector_Loc(temp, VECTOR_DATA + 1);
- count > 0;
- count -= 1,
- scan += 1)
- if (*scan == sym)
- {
- long offset;
-
- offset = 1 + Vector_Length(temp) - count;
-
- setup_lock(compile_serializer, hunk);
- if (depth != 0)
- {
- hunk[VARIABLE_COMPILED_TYPE] = Make_Non_Pointer(FORMAL_REF, depth);
- hunk[VARIABLE_OFFSET] = Make_Local_Offset(offset);
- }
- else
- {
- hunk[VARIABLE_COMPILED_TYPE] = Make_Local_Offset(offset);
- hunk[VARIABLE_OFFSET] = NIL;
- }
- remove_lock(compile_serializer);
-
- return Nth_Vector_Loc(frame, offset);
- }
+ return (cell);
}
-
-do_next_frame:
- continue;
}
+
/* The reference is global. */
if (OBJECT_DATUM(frame) != GO_TO_GLOBAL)
{
- return unbound_trap_object;
+ return (unbound_trap_object);
}
setup_lock(compile_serializer, hunk);
hunk[VARIABLE_OFFSET] = NIL;
remove_lock(compile_serializer);
- return Nth_Vector_Loc(sym, SYMBOL_GLOBAL_VALUE);
+ return (Nth_Vector_Loc(sym, SYMBOL_GLOBAL_VALUE));
}
\f
/* Full lookup end code.
FUTURE_VARIABLE_SPLICE (((Pointer) cell), 0, Val);
if (!(REFERENCE_TRAP_P(Val)))
{
- return PRIM_DONE;
+ return (PRIM_DONE);
}
/* Remarks:
*/
case TRAP_UNASSIGNED:
- return ERR_UNASSIGNED_VARIABLE;
+ return (ERR_UNASSIGNED_VARIABLE);
case TRAP_UNASSIGNED_DANGEROUS:
return_value = ERR_UNASSIGNED_VARIABLE;
break;
case TRAP_DANGEROUS:
- {
- Pointer trap_value;
+ {
+ Pointer trap_value;
- trap_value = Val;
- Val = (Vector_Ref (trap_value, TRAP_EXTRA));
- FUTURE_VARIABLE_SPLICE (trap_value, TRAP_EXTRA, Val);
- }
+ trap_value = Val;
+ Val = (Vector_Ref (trap_value, TRAP_EXTRA));
+ FUTURE_VARIABLE_SPLICE (trap_value, TRAP_EXTRA, Val);
return_value = PRIM_DONE;
break;
+ }
case TRAP_FLUID:
case TRAP_FLUID_DANGEROUS:
break;
case TRAP_UNBOUND:
- return ERR_UNBOUND_VARIABLE;
+ return (ERR_UNBOUND_VARIABLE);
case TRAP_UNBOUND_DANGEROUS:
return_value = ERR_UNBOUND_VARIABLE;
} while (repeat_p);
- return return_value;
+ return (return_value);
}
\f
/* Simple lookup finalization.
if (!(REFERENCE_TRAP_P(Val)))
{
- return PRIM_DONE;
+ return (PRIM_DONE);
}
get_trap_kind(trap_kind, Val);
case TRAP_FLUID_DANGEROUS:
case TRAP_COMPILER_CACHED_DANGEROUS:
return
- deep_lookup_end(deep_lookup(env, hunk[VARIABLE_SYMBOL], hunk),
- hunk);
+ (deep_lookup_end(deep_lookup(env, hunk[VARIABLE_SYMBOL], hunk),
+ hunk));
case TRAP_COMPILER_CACHED:
cell = Nth_Vector_Loc(Vector_Ref(Val, TRAP_EXTRA),
goto lookup_end_restart;
case TRAP_UNBOUND:
- return ERR_UNBOUND_VARIABLE;
+ return (ERR_UNBOUND_VARIABLE);
case TRAP_UNASSIGNED:
- return ERR_UNASSIGNED_VARIABLE;
+ return (ERR_UNASSIGNED_VARIABLE);
default:
- return ERR_ILLEGAL_REFERENCE_TRAP;
+ return (ERR_ILLEGAL_REFERENCE_TRAP);
}
}
\f
if (return_value != PRIM_DONE)
{
- return return_value;
+ return (return_value);
}
}
else
remove_lock(compile_serializer);
}
- return return_value;
+ return (return_value);
}
#undef ABORT
{
*cell = value;
remove_lock(set_serializer);
- return PRIM_DONE;
+ return (PRIM_DONE);
}
get_trap_kind(temp, Val);
case TRAP_COMPILER_CACHED_DANGEROUS:
remove_lock(set_serializer);
return
- deep_assignment_end(deep_lookup(env, hunk[VARIABLE_SYMBOL], hunk),
- hunk,
- value,
- false);
+ (deep_assignment_end(deep_lookup(env, hunk[VARIABLE_SYMBOL], hunk),
+ hunk,
+ value,
+ false));
\f
case TRAP_COMPILER_CACHED:
{
*/
remove_lock(set_serializer);
- return deep_assignment_end(cell, hunk, value, false);
+ return (deep_assignment_end(cell, hunk, value, false));
}
cell = Nth_Vector_Loc(extension, TRAP_EXTENSION_CELL);
update_lock(set_serializer, cell);
break;
}
remove_lock(set_serializer);
- return temp;
+ return (temp);
}
\f
/* Finds the fluid value cell associated with the reference trap on
fluids = Fluid_Bindings;
if (Fluids_Debug)
+ {
Print_Expression(fluids, "Searching fluid bindings");
+ }
while (PAIR_P(fluids))
{
if (this_pair[CONS_CAR] == trap)
{
if (Fluids_Debug)
+ {
fprintf(stderr, "Fluid found.\n");
+ }
- return &this_pair[CONS_CDR];
+ return (&this_pair[CONS_CDR]);
}
fluids = Fast_Vector_Ref(fluids, CONS_CDR);
/* Not found in fluid binding alist, so use default. */
if (Fluids_Debug)
+ {
fprintf(stderr, "Fluid not found, using default.\n");
+ }
- return Nth_Vector_Loc(trap, TRAP_EXTRA);
+ return (Nth_Vector_Loc(trap, TRAP_EXTRA));
}
\f
/* Utilities for definition.
{
remove_lock(set_serializer);
Request_GC(2);
- return PRIM_INTERRUPT;
+ return (PRIM_INTERRUPT);
}
trap = Make_Pointer(TC_REFERENCE_TRAP, Free);
*Free++ = DANGEROUS_OBJECT;
*Free++ = *cell;
*cell = trap;
remove_lock(set_serializer);
- return PRIM_DONE;
+ return (PRIM_DONE);
}
\f
get_trap_kind(temp, *cell);
long compiler_uncache();
remove_lock(set_serializer);
- return compiler_uncache(cell, sym);
+ return (compiler_uncache(cell, sym));
}
case TRAP_FLUID:
break;
}
remove_lock(set_serializer);
- return temp;
+ return (temp);
}
\f
/* The core of the incremental definition mechanism.
definition, extending the frames appropriately, and uncaching any
compiled code reference caches which might be affected by the new
definition.
+
+ *UNDEFINE*: If (local?) undefine is ever implemented, it suffices
+ to set the value cell to DANGEROUS_UNBOUND_OBJECT, uncache all the
+ compiler cached variables to the location, and rewrite the code
+ below slightly as implied by the comments tagged *UNDEFINE*.
*/
long
if (OBJECT_TYPE(env) == GLOBAL_ENV)
{
+ /* *UNDEFINE*: If undefine is ever implemented, this code need not
+ change: There are no shadowed bindings that need to be
+ recached.
+ */
if (OBJECT_DATUM(env) != GO_TO_GLOBAL)
{
- if (original_frame_p)
- return ERR_BAD_FRAME;
- return PRIM_DONE;
+ return (original_frame_p ? ERR_BAD_FRAME : PRIM_DONE);
}
else if (original_frame_p)
- return redefinition(Nth_Vector_Loc(sym, SYMBOL_GLOBAL_VALUE),
- value);
-
- else return dangerize(Nth_Vector_Loc(sym, SYMBOL_GLOBAL_VALUE), sym);
+ {
+ return (redefinition(Nth_Vector_Loc(sym, SYMBOL_GLOBAL_VALUE),
+ value));
+ }
+ else
+ {
+ return (dangerize(Nth_Vector_Loc(sym, SYMBOL_GLOBAL_VALUE), sym));
+ }
}
-
+\f
the_procedure = Vector_Ref(env, ENVIRONMENT_FUNCTION);
if (OBJECT_TYPE(the_procedure) == AUX_LIST_TYPE)
the_procedure = Vector_Ref(the_procedure, ENV_EXTENSION_PROCEDURE);
scan = Nth_Vector_Loc(formals, VECTOR_DATA + 1);
count > 0;
count -= 1)
+ {
+ /* *UNDEFINE*: If undefine is ever implemented, this code must
+ check whether the value is DANGEROUS_UNBOUND_OBJECT, and if
+ so, a search must be done to cause the shadowed compiler
+ cached variables to be recached, as in the aux case below.
+ */
if (*scan++ == sym)
{
long offset;
offset = 1 + Vector_Length(formals) - count;
if (original_frame_p)
- return redefinition(Nth_Vector_Loc(env, offset), value);
+ {
+ return (redefinition(Nth_Vector_Loc(env, offset), value));
+ }
else
- return dangerize(Nth_Vector_Loc(env, offset), sym);
+ {
+ return (dangerize(Nth_Vector_Loc(env, offset), sym));
+ }
}
+ }
}
\f
/* Guarantee that there is an extension slot. */
{
remove_lock(extension_serializer);
Request_GC(AUX_LIST_INITIAL_SIZE);
- return PRIM_INTERRUPT;
+ return (PRIM_INTERRUPT);
}
scan = Free;
extension = Make_Pointer(AUX_LIST_TYPE, scan);
/* This is done only because of compiler cached variables.
In their absence, this conditional is unnecessary.
- Note that this would also have to be done for formal
- bindings if we allowed "undefinition" of variables.
+
+ *UNDEFINE*: This would also have to be done for other kinds
+ of bindings if undefine is ever implemented. See the
+ comments above.
*/
if (Fetch(scan[0]) == DANGEROUS_UNBOUND_OBJECT)
{
fake_variable_object),
sym);
if (temp != PRIM_DONE)
- return temp;
+ {
+ return (temp);
+ }
}
if (original_frame_p)
- return redefinition(scan, value);
+ {
+ return (redefinition(scan, value));
+ }
else
- return dangerize(scan, sym);
+ {
+ return (dangerize(scan, sym));
+ }
}
scan += 1;
}
}
-
+\f
/* Not found in this frame at all. */
{
sym, NIL, false);
if (temp != PRIM_DONE)
- return temp;
+ {
+ return (temp);
+ }
\f
/* Proceed to extend the frame:
- If the frame is the one where the definition is occurring,
{
remove_lock(extension_serializer);
Request_GC(i);
- return PRIM_INTERRUPT;
+ return (PRIM_INTERRUPT);
}
fast_free = Free;
{
remove_lock(extension_serializer);
Request_GC(2);
- return PRIM_INTERRUPT;
+ return (PRIM_INTERRUPT);
}
{
scan[AUX_LIST_COUNT] = Make_Local_Offset(temp + 1);
}
remove_lock(extension_serializer);
- return PRIM_DONE;
+ return (PRIM_DONE);
}
}
\f
hunk = Get_Pointer(var);
lookup(cell, env, hunk, repeat_lex_ref_lookup);
- return lookup_end(cell, env, hunk);
+ return (lookup_end(cell, env, hunk));
}
long
Symbol_Lex_Ref(env, sym)
Pointer env, sym;
{
- return deep_lookup_end(deep_lookup(env, sym, fake_variable_object),
- fake_variable_object);
+ return (deep_lookup_end(deep_lookup(env, sym, fake_variable_object),
+ fake_variable_object));
}
long
hunk = Get_Pointer(var);
lookup(cell, env, hunk, repeat_lex_set_lookup);
- return assignment_end(cell, env, hunk, value);
+ return (assignment_end(cell, env, hunk, value));
}
long
Symbol_Lex_Set(env, sym, value)
Pointer env, sym, value;
{
- return deep_assignment_end(deep_lookup(env, sym, fake_variable_object),
- fake_variable_object,
- value,
- false);
+ return (deep_assignment_end(deep_lookup(env, sym, fake_variable_object),
+ fake_variable_object,
+ value,
+ false));
}
\f
long
long result;
if (Define_Debug)
+ {
fprintf(stderr,
"\n;; Local_Set: defining %s.",
Scheme_String_To_C_String(Vector_Ref(sym, SYMBOL_NAME)));
+ }
result = extend_frame(env, sym, value, true);
Val = sym;
- return result;
+ return (result);
}
long
long reference_result;
{
if (reference_result == ERR_UNASSIGNED_VARIABLE)
- {
- Val = UNASSIGNED_OBJECT;
- return (PRIM_DONE);
- }
+ {
+ Val = UNASSIGNED_OBJECT;
+ return (PRIM_DONE);
+ }
else
+ {
return (reference_result);
+ }
}
long
long reference_result;
{
switch (reference_result)
- {
+ {
case ERR_UNASSIGNED_VARIABLE:
Val = TRUTH;
return (PRIM_DONE);
default:
return (reference_result);
- }
+ }
}
+\f
+extern long
+ Symbol_Lex_unassigned_p(),
+ Symbol_Lex_unbound_p();
long
Symbol_Lex_unassigned_p( frame, symbol)
result = Symbol_Lex_Ref( frame, symbol);
switch (result)
- {
+ {
case ERR_UNASSIGNED_VARIABLE:
case PRIM_DONE:
- {
- Val = NIL;
- return (PRIM_DONE);
- }
+ {
+ Val = NIL;
+ return (PRIM_DONE);
+ }
case ERR_UNBOUND_VARIABLE:
- {
- Val = TRUTH;
- return (PRIM_DONE);
- }
+ {
+ Val = TRUTH;
+ return (PRIM_DONE);
+ }
default:
return (result);
- }
+ }
}
\f
/* force_definition is used when access to the global environment is
fast Pointer previous;
if (OBJECT_TYPE(env) == GLOBAL_ENV)
+ {
return ((Pointer *) NULL);
-
+ }
+
do
{
previous = env;
\f
/* Fast variable reference mechanism for compiled code.
- compiler_cache_reference is the core of the variable caching mechanism.
+ compiler_cache is the core of the variable caching mechanism.
- It creates a variable cache for the variable specified by (name,
- env) if needed, and stores it or a related object in the location
+ It creates a variable cache for the variable at the specified cell,
+ if needed, and stores it or a related object in the location
specified by (block, offset). It adds this reference to the
appropriate reference list for further updating.
updated to point to it.
*/
+extern long compiler_cache();
+
long
-compiler_cache_reference(env, name, block, offset, kind)
- Pointer env, name, block;
+compiler_cache(cell, name, block, offset, kind)
+ fast Pointer *cell;
+ Pointer name, block;
long offset, kind;
{
Lock_Handle set_serializer;
- fast Pointer *cell, trap, references, extension;
+ fast Pointer trap, references, extension;
Pointer trap_value, store_trap_tag, store_extension;
long trap_kind, return_value;
-
- cell = deep_lookup(env, name, fake_variable_object);
- if (cell == unbound_trap_object)
- {
- long message;
-
- cell = force_definition(env, name, &message);
- if (message != PRIM_DONE)
- return message;
- }
store_trap_tag = NIL;
store_extension = NIL;
trap_kind = TRAP_COMPILER_CACHED;
-\f
+
setup_lock(set_serializer, cell);
trap = *cell;
trap_value = trap;
-
+\f
if (REFERENCE_TRAP_P(trap))
{
long old_trap_kind;
default:
remove_lock(set_serializer);
- return ERR_ILLEGAL_REFERENCE_TRAP;
+ return (ERR_ILLEGAL_REFERENCE_TRAP);
}
}
\f
{
remove_lock(set_serializer);
Request_GC(MAXIMUM_CACHE_SIZE);
- return PRIM_INTERRUPT;
+ return (PRIM_INTERRUPT);
}
#endif
{
remove_lock(set_serializer);
Request_GC(7);
- return PRIM_INTERRUPT;
+ return (PRIM_INTERRUPT);
}
#endif
update_lock(set_serializer,
Nth_Vector_Loc(extension, TRAP_EXTENSION_CELL));
}
+
+ if (block == NIL)
+ {
+ /* It is not really from compiled code.
+ The environment linking stuff wants a cc cache instead.
+ */
+ remove_lock(set_serializer);
+ return (PRIM_DONE);
+ }
\f
/* There already is a compiled code cache.
Maybe this should clean up all the cache lists?
{
remove_lock(set_serializer);
Request_GC(4);
- return PRIM_INTERRUPT;
+ return (PRIM_INTERRUPT);
}
#endif
store_extension = Make_Pointer(TRAP_EXTENSION_TYPE, Free);
if (return_value != PRIM_DONE)
{
remove_lock(set_serializer);
- return return_value;
+ return (return_value);
}
}
\f
}
remove_lock(set_serializer);
- return return_value;
+ return (return_value);
}
\f
+/* This procedure invokes cache_reference after finding the top-level
+ value cell associated with (env, name).
+ */
+
+long
+compiler_cache_reference(env, name, block, offset, kind)
+ Pointer env, name, block;
+ long offset, kind;
+{
+ Pointer *cell;
+
+ cell = deep_lookup(env, name, fake_variable_object);
+ if (cell == unbound_trap_object)
+ {
+ long message;
+
+ cell = force_definition(env, name, &message);
+ if (message != PRIM_DONE)
+ {
+ return (message);
+ }
+ }
+ return (compiler_cache(cell, name, block, offset, kind));
+}
+
/* This procedure updates all the references in the cached reference
list pointed at by slot to hold value. It also eliminates "empty"
pairs (pairs whose weakly held block has vanished).
{
Fast_Vector_Set(pair, CONS_CAR, block);
Fast_Vector_Set(pair, CONS_CDR, offset);
- return PRIM_DONE;
+ return (PRIM_DONE);
}
slot = Nth_Vector_Loc(*slot, CONS_CDR);
}
if (GC_allocate_test(4))
{
Request_GC(4);
- return PRIM_INTERRUPT;
+ return (PRIM_INTERRUPT);
}
*slot = Make_Pointer(TC_LIST, Free);
*Free++ = block;
*Free++ = offset;
- return PRIM_DONE;
+ return (PRIM_DONE);
}
\f
/* compiler_uncache_slot uncaches all references in the list pointed
if (GC_allocate_test(4))
{
Request_GC(4);
- return PRIM_INTERRUPT;
+ return (PRIM_INTERRUPT);
}
new_extension = Make_Pointer(TRAP_EXTENSION_TYPE, Free);
*Free++ = REQUEST_RECACHE_OBJECT;
block,
Get_Integer(offset));
if (result != PRIM_DONE)
- return result;
+ return (result);
}
else
{
}
*slot = Fast_Vector_Ref(temp, CONS_CDR);
}
- return PRIM_DONE;
+ return (PRIM_DONE);
}
\f
/* compiler_uncache is invoked when a redefinition occurs.
TRAP_REFERENCES_ASSIGNMENT,
TRAP_REFERENCES_OPERATOR};
+extern long compiler_uncache();
+
long
compiler_uncache(value_cell, sym)
Pointer *value_cell, sym;
if (!(REFERENCE_TRAP_P(val)))
{
remove_lock(set_serializer);
- return PRIM_DONE;
+ return (PRIM_DONE);
}
\f
get_trap_kind(trap_kind, val);
(trap_kind != TRAP_COMPILER_CACHED_DANGEROUS))
{
remove_lock(set_serializer);
- return PRIM_DONE;
+ return (PRIM_DONE);
}
extension = Fast_Vector_Ref(val, TRAP_EXTRA);
if (temp != PRIM_DONE)
{
remove_lock(set_serializer);
- return temp;
+ return (temp);
}
}
Fast_Vector_Set(extension, TRAP_EXTENSION_CLONE, NIL);
remove_lock(set_serializer);
- return PRIM_DONE;
+ return (PRIM_DONE);
}
\f
/* recache_uuo_links is invoked when an assignment occurs to a
Fast_Vector_Set(extension, TRAP_EXTENSION_CELL, old_value);
}
- return return_value;
+ return (return_value);
}
/* This kludge is due to the lack of closures. */
{
extern long make_fake_uuo_link();
- return make_fake_uuo_link(extension, block, offset);
+ return (make_fake_uuo_link(extension, block, offset));
}
\f
long
Get_Integer(Fast_Vector_Ref(pair, CONS_CDR)));
if (return_value != PRIM_DONE)
{
- return return_value;
+ return (return_value);
}
slot = Nth_Vector_Loc(*slot, CONS_CDR);
}
fix_references(Nth_Vector_Loc(references, TRAP_REFERENCES_ASSIGNMENT),
extension);
}
- return PRIM_DONE;
+ return (PRIM_DONE);
}
\f
/* compiler_reference_trap is called when a reference occurs to a compiled
if (Vector_Ref(extension, TRAP_EXTENSION_CELL) != REQUEST_RECACHE_OBJECT)
{
- return (*handler)(Nth_Vector_Loc(extension, TRAP_EXTENSION_CELL),
- fake_variable_object);
+ return ((*handler)(Nth_Vector_Loc(extension, TRAP_EXTENSION_CELL),
+ fake_variable_object));
}
block = Fast_Vector_Ref(extension, TRAP_EXTENSION_BLOCK);
offset,
kind);
if (temp != PRIM_DONE)
- return temp;
+ {
+ return (temp);
+ }
\f
switch(kind)
{
extern Pointer extract_uuo_link();
Val = extract_uuo_link(block, offset);
- return PRIM_DONE;
+ return (PRIM_DONE);
}
case TRAP_REFERENCES_ASSIGNMENT:
Pointer extension;
extension = extract_variable_cache(block, offset);
- return (*handler)(Nth_Vector_Loc(extension, TRAP_EXTENSION_CELL),
- fake_variable_object);
+ return ((*handler)(Nth_Vector_Loc(extension, TRAP_EXTENSION_CELL),
+ fake_variable_object));
}
}
}
Pointer name, block;
long offset;
{
- return compiler_cache_reference(compiled_block_environment(block),
- name, block, offset,
- TRAP_REFERENCES_LOOKUP);
+ return (compiler_cache_reference(compiled_block_environment(block),
+ name, block, offset,
+ TRAP_REFERENCES_LOOKUP));
}
long
Pointer name, block;
long offset;
{
- return compiler_cache_reference(compiled_block_environment(block),
- name, block, offset,
- TRAP_REFERENCES_ASSIGNMENT);
+ return (compiler_cache_reference(compiled_block_environment(block),
+ name, block, offset,
+ TRAP_REFERENCES_ASSIGNMENT));
}
long
Pointer name, block;
long offset;
{
- return compiler_cache_reference(compiled_block_environment(block),
- name, block, offset,
- TRAP_REFERENCES_OPERATOR);
+ return (compiler_cache_reference(compiled_block_environment(block),
+ name, block, offset,
+ TRAP_REFERENCES_OPERATOR));
}
\f
extern long complr_operator_reference_trap();
TRAP_REFERENCES_OPERATOR,
deep_lookup_end);
if (temp != PRIM_DONE)
+ {
return temp;
+ }
*frame_slot = Val;
- return PRIM_DONE;
+ return (PRIM_DONE);
}
Pointer
compiler_var_error(extension, environment)
Pointer extension, environment;
{
- return Vector_Ref(extension, TRAP_EXTENSION_NAME);
+ return (Vector_Ref(extension, TRAP_EXTENSION_NAME));
}
/* Utility for compiler_assignment_trap, below.
compiler_assignment_end(cell, hunk)
Pointer *cell, *hunk;
{
- return
- deep_assignment_end(cell, hunk, saved_compiler_assignment_value, false);
+ return (deep_assignment_end(cell, hunk,
+ saved_compiler_assignment_value, false));
}
\f
/* More compiled code interface procedures */
compiler_lookup_trap(extension)
Pointer extension;
{
- return compiler_reference_trap(extension,
- TRAP_REFERENCES_LOOKUP,
- deep_lookup_end);
+ return (compiler_reference_trap(extension,
+ TRAP_REFERENCES_LOOKUP,
+ deep_lookup_end));
}
long
Pointer extension, value;
{
saved_compiler_assignment_value = value;
- return compiler_reference_trap(extension,
- TRAP_REFERENCES_ASSIGNMENT,
- compiler_assignment_end);
-}
-\f
-/* Primitives built on the procedures above. */
-
-/* (LEXICAL-ASSIGNMENT ENVIRONMENT SYMBOL VALUE)
- Sets the value of the variable with the name given in SYMBOL, as
- seen in the lexical ENVIRONMENT, to the specified VALUE.
- Returns the previous value.
-
- It's indistinguishable from evaluating
- (set! <symbol> <value>) in <environment>.
-*/
-Built_In_Primitive(Prim_Lexical_Assignment, 3, "LEXICAL-ASSIGNMENT", 0x0)
-Define_Primitive(Prim_Lexical_Assignment, 3, "LEXICAL-ASSIGNMENT")
-{
- Primitive_3_Args();
-
- standard_lookup_primitive(Symbol_Lex_Set(Arg1, Arg2, Arg3));
-}
-
-/* (LEXICAL-REFERENCE ENVIRONMENT SYMBOL)
- Returns the value of the variable with the name given in SYMBOL,
- as seen in the lexical ENVIRONMENT.
-
- Indistinguishable from evaluating <symbol> in <environment>.
-*/
-Built_In_Primitive(Prim_Lexical_Reference, 2, "LEXICAL-REFERENCE", 0x12)
-Define_Primitive(Prim_Lexical_Reference, 2, "LEXICAL-REFERENCE")
-{
- Primitive_2_Args();
-
- standard_lookup_primitive(Symbol_Lex_Ref(Arg1, Arg2));
-}
-
-/* (LOCAL-REFERENCE ENVIRONMENT SYMBOL)
- Identical to LEXICAL_REFERENCE, here for histerical reasons.
-*/
-Built_In_Primitive(Prim_Local_Reference, 2, "LOCAL-REFERENCE", 0x1)
-Define_Primitive(Prim_Local_Reference, 2, "LOCAL-REFERENCE")
-{
- Primitive_2_Args();
-
- standard_lookup_primitive(Symbol_Lex_Ref(Arg1, Arg2));
-}
-\f
-/* (LOCAL-ASSIGNMENT ENVIRONMENT SYMBOL VALUE)
- Should be called *DEFINE.
-
- If the variable specified by SYMBOL already exists in the
- lexical ENVIRONMENT, then its value there is changed to VALUE.
- Otherwise a new binding is created in that environment linking
- the specified variable to the value. Returns SYMBOL.
-
- Indistinguishable from evaluating
- (define <symbol> <value>) in <environment>.
-*/
-Built_In_Primitive(Prim_Local_Assignment, 3, "LOCAL-ASSIGNMENT", 0x2)
-Define_Primitive(Prim_Local_Assignment, 3, "LOCAL-ASSIGNMENT")
-{
- Primitive_3_Args();
-
- standard_lookup_primitive(Local_Set(Arg1, Arg2, Arg3));
-}
-
-/* (LEXICAL-UNASSIGNED? ENVIRONMENT SYMBOL)
- Returns #!TRUE if the variable corresponding to SYMBOL is bound
- but has the special UNASSIGNED value in ENVIRONMENT. Returns
- NIL otherwise. Does a complete lexical search for SYMBOL
- starting in ENVIRONMENT.
- The special form (unassigned? <symbol>) is built on top of this.
-*/
-Built_In_Primitive(Prim_Unassigned_Test, 2, "LEXICAL-UNASSIGNED?", 0x18)
-Define_Primitive(Prim_Unassigned_Test, 2, "LEXICAL-UNASSIGNED?")
-{
- Primitive_2_Args();
-
- standard_lookup_primitive(Symbol_Lex_unassigned_p(Arg1, Arg2));
-}
-
-/* (LEXICAL-UNBOUND? ENVIRONMENT SYMBOL)
- Returns #!TRUE if the variable corresponding to SYMBOL has no
- binding in ENVIRONMENT. Returns NIL otherwise. Does a complete
- lexical search for SYMBOL starting in ENVIRONMENT.
- The special form (unbound? <symbol>) is built on top of this.
-*/
-Built_In_Primitive(Prim_Unbound_Test, 2, "LEXICAL-UNBOUND?", 0x33)
-Define_Primitive(Prim_Unbound_Test, 2, "LEXICAL-UNBOUND?")
-{
- Primitive_2_Args();
-
- standard_lookup_primitive(Symbol_Lex_unbound_p(Arg1, Arg2));
-}
-\f
-/* (LEXICAL-UNREFERENCEABLE? ENVIRONMENT SYMBOL)
- Returns #T if evaluating <symbol> in <environment> would cause
- a variable lookup error (unbound or unassigned).
-*/
-Built_In_Primitive(Prim_Unreferenceable_Test, 2,
- "LEXICAL-UNREFERENCEABLE?", 0x13)
-Define_Primitive(Prim_Unreferenceable_Test, 2,
- "LEXICAL-UNREFERENCEABLE?")
-{
- long Result;
- Primitive_2_Args();
-
- lookup_primitive_type_test();
- Result = Symbol_Lex_Ref(Arg1, Arg2);
- switch (Result)
- { case PRIM_DONE:
- PRIMITIVE_RETURN(NIL);
-
- case PRIM_INTERRUPT:
- Primitive_Interrupt();
- /*NOTREACHED*/
-
- case ERR_UNASSIGNED_VARIABLE:
- case ERR_UNBOUND_VARIABLE:
- PRIMITIVE_RETURN(TRUTH);
-
- default:
- Primitive_Error(Result);
- }
- /*NOTREACHED*/
+ return (compiler_reference_trap(extension,
+ TRAP_REFERENCES_ASSIGNMENT,
+ compiler_assignment_end));
}
/* -*-C-*-
-Copyright (c) 1987 Massachusetts Institute of Technology
+Copyright (c) 1988 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
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.39 1987/10/05 18:35:30 jinx Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/lookup.h,v 9.40 1988/05/03 19:21:57 jinx Exp $ */
/* Macros and declarations for the variable lookup code. */
#else
-#define Lexical_Offset(Ind) Get_Integer(Ind)
+#define Lexical_Offset(Ind) OBJECT_DATUM(Ind)
#define Make_Local_Offset(Ind) Make_Non_Pointer(LOCAL_REF, Ind)
#endif
#define verify(type_code, variable, code, label) \
{ \
variable = code; \
- if (Type_Code(Fetch(hunk[VARIABLE_COMPILED_TYPE])) != \
+ if (OBJECT_TYPE(Fetch(hunk[VARIABLE_COMPILED_TYPE])) != \
type_code) \
goto label; \
}
\
frame = Fetch(hunk[VARIABLE_COMPILED_TYPE]); \
\
- switch (Type_Code(frame)) \
+ switch (OBJECT_TYPE(frame)) \
{ \
case GLOBAL_REF: \
/* frame is a pointer to the same symbol. */ \
/* Done here rather than in a separate case because of \
peculiarities of the bobcat compiler. \
*/ \
- cell = ((Type_Code(frame) == UNCOMPILED_REF) ? \
+ cell = ((OBJECT_TYPE(frame) == UNCOMPILED_REF) ? \
uncompiled_trap_object : \
illegal_trap_object); \
break; \
} \
\
frame = Vector_Ref(frame, ENVIRONMENT_FUNCTION); \
- if (Type_Code(frame) != AUX_LIST_TYPE) \
+ if (OBJECT_TYPE(frame) != AUX_LIST_TYPE) \
{ \
cell = uncompiled_trap_object; \
break; \
cell = Nth_Vector_Loc(frame, CONS_CDR); \
break; \
}
-\f
-#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) \
- PRIMITIVE_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*/ \
-}
-
-
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.33 1988/04/27 01:10:33 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.34 1988/05/03 19:22:09 jinx Exp $
Copyright (c) 1988 Massachusetts Institute of Technology
#define VERSION 10
#endif
#ifndef SUBVERSION
-#define SUBVERSION 33
+#define SUBVERSION 34
#endif
#ifndef UCODE_TABLES_FILENAME
projects / mit-scheme.git / commitdiff