From 1d8a9318f3d1c7a632ef5e0e0f8d998dbaf457f0 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sat, 13 Oct 2018 19:44:40 -0700 Subject: [PATCH] Fix bug: reference caches weren't working right without global env. The problem arises when there's a compiled file that does something like this: (define foo ...) ... foo What happens is that the linker creates a cache for 'foo' before evaluating code; there's no binding for 'foo' yet but one is needed for the cache. In the case where the evaluation environment extends to the global environment, this is handled by making a placeholder in the global environment. However, if the topmost frame is not the global environment, it was creating a dummy cell that wasn't connected to any environment. Consequently, when the definition was evaluated, it created a new binding, but since there was no old binding in the environment chain, the dummy cache wasn't updated to the new binding's cell. I've fixed this by forcing the creation of an unbound cell in the outermost environment (i.e. the one with the null environment as its parent). This is essentially the same solution that's used when the global environment is present, with the outermost environment playing the role of global. --- src/microcode/lookup.c | 48 ++++++++++++++++++++++++++---------------- 1 file changed, 30 insertions(+), 18 deletions(-) diff --git a/src/microcode/lookup.c b/src/microcode/lookup.c index 57136407f..78fb18345 100644 --- a/src/microcode/lookup.c +++ b/src/microcode/lookup.c @@ -137,6 +137,8 @@ static long assign_variable_end (SCHEME_OBJECT *, SCHEME_OBJECT, SCHEME_OBJECT *, int); static long assign_variable_cache (SCHEME_OBJECT, SCHEME_OBJECT, SCHEME_OBJECT *, int); +static SCHEME_OBJECT * extend_environment + (SCHEME_OBJECT, SCHEME_OBJECT, SCHEME_OBJECT); static long guarantee_extension_space (SCHEME_OBJECT); static long allocate_frame_extension @@ -486,8 +488,6 @@ define_variable (SCHEME_OBJECT environment, SCHEME_OBJECT symbol, && ((get_trap_kind (*shadowed_cell)) == TRAP_COMPILER_CACHED)) ? (GET_TRAP_CACHE (*shadowed_cell)) : SHARP_F); - unsigned long length = (GET_EXTENDED_FRAME_LENGTH (environment)); - SCHEME_OBJECT pair; /* Make sure there is enough space available to move any references that need moving. */ @@ -498,18 +498,26 @@ define_variable (SCHEME_OBJECT environment, SCHEME_OBJECT symbol, : 0)); /* Create the binding. */ - pair = (cons (symbol, (MAP_TO_UNASSIGNED (value)))); - ((GET_EXTENDED_FRAME_BINDINGS (environment)) [length]) = pair; - SET_EXTENDED_FRAME_LENGTH (environment, (length + 1)); + SCHEME_OBJECT * cell = (extend_environment (environment, symbol, value)); /* Move any references that need moving. */ return ((old_cache != SHARP_F) - ? (update_cache_references - (old_cache, (PAIR_CDR_LOC (pair)), environment, symbol)) + ? (update_cache_references (old_cache, cell, environment, symbol)) : PRIM_DONE); } } + +static SCHEME_OBJECT * +extend_environment (SCHEME_OBJECT environment, SCHEME_OBJECT symbol, + SCHEME_OBJECT value) +{ + SCHEME_OBJECT pair = (cons (symbol, (MAP_TO_UNASSIGNED (value)))); + unsigned long length = (GET_EXTENDED_FRAME_LENGTH (environment)); + ((GET_EXTENDED_FRAME_BINDINGS (environment)) [length]) = pair; + SET_EXTENDED_FRAME_LENGTH (environment, (length + 1)); + return (PAIR_CDR_LOC (pair)); +} static long guarantee_extension_space (SCHEME_OBJECT environment) @@ -915,13 +923,14 @@ add_cache_reference (SCHEME_OBJECT environment, SCHEME_OBJECT symbol, { SCHEME_OBJECT frame = 0; SCHEME_OBJECT * cell = (find_binding_cell (environment, symbol, (&frame))); - SCHEME_OBJECT dummy_cell = UNBOUND_OBJECT; if (cell == 0) - /* There's no binding for the variable, and we don't have access - to the global environment. The compiled code needs a cache, so - we'll install one, but it won't be attached to any environment - structure. */ - cell = (&dummy_cell); + { + /* There's no binding for the variable, and we don't have access + to the global environment. The compiled code needs a cache, so + we'll install one that's attached to the outermost frame. */ + DIE_IF_ERROR (guarantee_extension_space (frame)); + cell = (extend_environment (frame, symbol, UNBOUND_OBJECT)); + } else if (GLOBAL_FRAME_P (frame)) strengthen_symbol (symbol); /* This procedure must complete to keep the data structures @@ -1195,11 +1204,16 @@ static SCHEME_OBJECT * find_binding_cell (SCHEME_OBJECT environment, SCHEME_OBJECT symbol, SCHEME_OBJECT * frame_ret) { + assert (ENVIRONMENT_P (environment)); SCHEME_OBJECT frame = environment; while (1) { SCHEME_OBJECT * cell = (scan_frame (frame, symbol, 0)); - if ((cell != 0) || (!PROCEDURE_FRAME_P (frame))) + if ((cell != 0) + /* This is safe because if 'frame' was the global frame then + 'cell' would be non-null. Therefore 'frame' must be a + procedure frame. */ + || (!ENVIRONMENT_P (GET_FRAME_PARENT (frame)))) { if (frame_ret != 0) (*frame_ret) = frame; @@ -1233,10 +1247,8 @@ scan_frame (SCHEME_OBJECT frame, SCHEME_OBJECT symbol, int find_unbound_p) (scan_procedure_bindings ((GET_FRAME_PROCEDURE (frame)), frame, symbol, find_unbound_p)); } - else if (GLOBAL_FRAME_P (frame)) - return (SYMBOL_GLOBAL_VALUE_CELL (symbol)); - else - return (0); + assert (GLOBAL_FRAME_P (frame)); + return (SYMBOL_GLOBAL_VALUE_CELL (symbol)); } static SCHEME_OBJECT * -- 2.25.1