From: Chris Hanson Date: Sat, 2 Feb 2008 17:26:28 +0000 (+0000) Subject: Fix bug: a relatively rare circumstance was causing linked variables X-Git-Tag: 20090517-FFI~351 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=db75f4c06f2322b35b5dc351a882545e5b02c3cc;p=mit-scheme.git Fix bug: a relatively rare circumstance was causing linked variables to become unlinked. Specifically: 1. Load compiled code that creates a cache to variable A. 2. Link variable B to variable C. 3. Link variable B to variable A. After step (3), variable C was no longer linked to variable B, although B and A were still linked. The problem is that step (3) overwrites the cache in B with the cache in A, but C is unchanged. This has been fixed by leaving a forwarding link in the "old" cache and snapping the link on reference. Any outstanding copies of the "old" cache, such as that in C, are updated to point to the "new" cache the next time they're referenced. --- diff --git a/v7/src/microcode/lookup.c b/v7/src/microcode/lookup.c index 34fffd989..d4d03e461 100644 --- a/v7/src/microcode/lookup.c +++ b/v7/src/microcode/lookup.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Id: lookup.c,v 9.76 2008/01/30 20:02:14 cph Exp $ +$Id: lookup.c,v 9.77 2008/02/02 17:26:25 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -133,6 +133,8 @@ static SCHEME_OBJECT * scan_frame (SCHEME_OBJECT, SCHEME_OBJECT, int); static SCHEME_OBJECT * scan_procedure_bindings (SCHEME_OBJECT, SCHEME_OBJECT, SCHEME_OBJECT, int); +static SCHEME_OBJECT get_cell_cache + (SCHEME_OBJECT *); static unsigned long count_references (SCHEME_OBJECT *); static void update_assignment_references @@ -210,7 +212,7 @@ lookup_variable (SCHEME_OBJECT environment, SCHEME_OBJECT symbol, return (ERR_MACRO_BINDING); case TRAP_COMPILER_CACHED: - return (lookup_variable_cache ((GET_TRAP_CACHE (value)), value_ret)); + return (lookup_variable_cache ((get_cell_cache (cell)), value_ret)); default: return (ERR_ILLEGAL_REFERENCE_TRAP); @@ -365,7 +367,7 @@ assign_variable_end (SCHEME_OBJECT * cell, SCHEME_OBJECT value, case TRAP_COMPILER_CACHED: return (assign_variable_cache - ((GET_TRAP_CACHE (old_value)), value, value_ret, force_p)); + ((get_cell_cache (cell)), value, value_ret, force_p)); default: return (ERR_ILLEGAL_REFERENCE_TRAP); @@ -462,7 +464,7 @@ define_variable (SCHEME_OBJECT environment, SCHEME_OBJECT symbol, SCHEME_OBJECT old_cache = (((shadowed_cell != 0) && ((get_trap_kind (*shadowed_cell)) == TRAP_COMPILER_CACHED)) - ? (GET_TRAP_CACHE (*shadowed_cell)) + ? (get_cell_cache (shadowed_cell)) : SHARP_F); unsigned long length = (GET_EXTENDED_FRAME_LENGTH (environment)); SCHEME_OBJECT pair; @@ -568,10 +570,10 @@ link_variables (SCHEME_OBJECT target_environment, SCHEME_OBJECT target_symbol, if ((target_cell != 0) && ((get_trap_kind (*target_cell)) == TRAP_COMPILER_CACHED)) { - SCHEME_OBJECT target_cache = (GET_TRAP_CACHE (*target_cell)); + SCHEME_OBJECT target_cache = (get_cell_cache (target_cell)); if (source_kind == TRAP_COMPILER_CACHED) { - SCHEME_OBJECT source_cache = (GET_TRAP_CACHE (*source_cell)); + SCHEME_OBJECT source_cache = (get_cell_cache (source_cell)); if (source_cache == target_cache) /* Already linked. */ return (PRIM_DONE); @@ -590,6 +592,11 @@ link_variables (SCHEME_OBJECT target_environment, SCHEME_OBJECT target_symbol, #endif update_clone (source_cache); update_clone (target_cache); + + /* Leave a pointer behind so that other references to + source_cache are able to find the new cache. */ + SET_CACHE_VALUE (source_cache, LINKED_OBJECT); + SET_CACHE_CLONE (source_cache, target_cache); } else SET_CACHE_VALUE (target_cache, (*source_cell)); @@ -606,14 +613,11 @@ static void move_all_references (SCHEME_OBJECT from_cache, SCHEME_OBJECT to_cache, unsigned int reference_kind) { - SCHEME_OBJECT * palist = (GET_CACHE_REFERENCES (to_cache, reference_kind)); - { - SCHEME_OBJECT * pf = (GET_CACHE_REFERENCES (from_cache, reference_kind)); - (*palist) = (*pf); - (*pf) = EMPTY_LIST; - } + SCHEME_OBJECT * pfrom = (GET_CACHE_REFERENCES (from_cache, reference_kind)); + SCHEME_OBJECT * pto = (GET_CACHE_REFERENCES (to_cache, reference_kind)); + WALK_REFERENCES - (palist, + (pfrom, reference, { install_cache (to_cache, @@ -621,6 +625,11 @@ move_all_references (SCHEME_OBJECT from_cache, SCHEME_OBJECT to_cache, (GET_CACHE_REFERENCE_OFFSET (reference)), reference_kind); }); + + while (PAIR_P (*pto)) + pto = (PAIR_CDR_LOC (*pto)); + (*pto) = (*pfrom); + (*pfrom) = EMPTY_LIST; } #endif @@ -645,7 +654,7 @@ unbind_variable (SCHEME_OBJECT environment, SCHEME_OBJECT symbol, case TRAP_COMPILER_CACHED: { - SCHEME_OBJECT cache = (GET_TRAP_CACHE (*cell)); + SCHEME_OBJECT cache = (get_cell_cache (cell)); switch (get_trap_kind (GET_CACHE_VALUE (cache))) { case TRAP_UNBOUND: @@ -681,7 +690,7 @@ static long unbind_cached_variable (SCHEME_OBJECT * cell, SCHEME_OBJECT frame, SCHEME_OBJECT symbol) { - SCHEME_OBJECT cache = (GET_TRAP_CACHE (*cell)); + SCHEME_OBJECT cache = (get_cell_cache (cell)); SCHEME_OBJECT * shadowed_cell = (find_binding_cell ((GET_FRAME_PARENT (frame)), symbol, 0)); SCHEME_OBJECT dummy_cell = UNBOUND_OBJECT; @@ -896,7 +905,7 @@ add_cache_reference (SCHEME_OBJECT environment, SCHEME_OBJECT symbol, GC_CHECK ((2 * SPACE_PER_CACHE) + SPACE_PER_REFERENCE + SPACE_PER_UUO_LINK); DIE_IF_ERROR (guarantee_cache (cell)); { - SCHEME_OBJECT cache = (GET_TRAP_CACHE (*cell)); + SCHEME_OBJECT cache = (get_cell_cache (cell)); add_reference ((GET_CACHE_REFERENCES (cache, reference_kind)), symbol, block, offset); update_clone (cache); @@ -1016,7 +1025,7 @@ update_cache_references (SCHEME_OBJECT from_cache, SCHEME_OBJECT * to_cell, { DIE_IF_ERROR (guarantee_cache (to_cell)); { - SCHEME_OBJECT to_cache = (GET_TRAP_CACHE (*to_cell)); + SCHEME_OBJECT to_cache = (get_cell_cache (to_cell)); #ifdef CC_SUPPORT_P move_ref_pairs (from_cache, to_cache, CACHE_REFERENCES_LOOKUP, environment); @@ -1208,6 +1217,18 @@ get_trap_kind (SCHEME_OBJECT object) return (NON_TRAP_KIND); } +static SCHEME_OBJECT +get_cell_cache (SCHEME_OBJECT * cell) +{ + SCHEME_OBJECT cache = (GET_TRAP_CACHE (*cell)); + while ((GET_CACHE_VALUE (cache)) == LINKED_OBJECT) + { + cache = (GET_CACHE_CLONE (cache)); + SET_TRAP_CACHE ((*cell), cache); + } + return (cache); +} + static unsigned long count_references (SCHEME_OBJECT * palist) { diff --git a/v7/src/microcode/sdata.h b/v7/src/microcode/sdata.h index e814fa306..38d3bc33e 100644 --- a/v7/src/microcode/sdata.h +++ b/v7/src/microcode/sdata.h @@ -1,6 +1,6 @@ /* -*-C-*- -$Id: sdata.h,v 9.46 2008/01/30 20:02:20 cph Exp $ +$Id: sdata.h,v 9.47 2008/02/02 17:26:27 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -396,7 +396,11 @@ USA. #define GET_TRAP_EXTRA(object) \ (MEMORY_REF ((object), TRAP_EXTRA)) +#define SET_TRAP_EXTRA(object, extra) \ + MEMORY_SET ((object), TRAP_EXTRA, (extra)) + #define GET_TRAP_CACHE GET_TRAP_EXTRA +#define SET_TRAP_CACHE SET_TRAP_EXTRA #define CACHE_CELL HUNK3_CXR0 #define CACHE_CLONE HUNK3_CXR1 diff --git a/v7/src/microcode/trap.h b/v7/src/microcode/trap.h index 865e09162..964e448df 100644 --- a/v7/src/microcode/trap.h +++ b/v7/src/microcode/trap.h @@ -1,6 +1,6 @@ /* -*-C-*- -$Id: trap.h,v 9.55 2008/01/30 20:02:21 cph Exp $ +$Id: trap.h,v 9.56 2008/02/02 17:26:28 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -42,6 +42,7 @@ typedef unsigned long trap_kind_t; /* The following are immediate traps: */ #define TRAP_UNASSIGNED 0 #define TRAP_UNBOUND 2 +#define TRAP_LINKED 4 #define TRAP_EXPENSIVE 6 /* TRAP_MAX_IMMEDIATE is defined in object.h */ @@ -62,6 +63,10 @@ typedef unsigned long trap_kind_t; * A cache that is not stored in an environment. This is caused by referring to an unbound variable in an environment that does not inherit from the global environment. + TRAP_LINKED can only appear in a cache. It is left behind when two + caches are linked, so that references to the "old" cache can be + updated. In that case, the "new" cache is in the CACHE_CLONE + field. TRAP_EXPENSIVE can only appear in a "clone" cache. This causes assignments to this cache to trap out to the microcode, where the updating of the variable's associated UUO links can be performed. @@ -87,11 +92,13 @@ typedef unsigned long trap_kind_t; # if (TYPE_CODE_LENGTH == 8) # define UNASSIGNED_OBJECT 0x32000000 # define UNBOUND_OBJECT 0x32000002 +# define LINKED_OBJECT 0x32000004 # define EXPENSIVE_OBJECT 0x32000006 # endif # if (TYPE_CODE_LENGTH == 6) # define UNASSIGNED_OBJECT 0xc8000000 # define UNBOUND_OBJECT 0xc8000002 +# define LINKED_OBJECT 0xc8000004 # define EXPENSIVE_OBJECT 0xc8000006 # endif # if (TC_REFERENCE_TRAP != 0x32) @@ -102,6 +109,7 @@ typedef unsigned long trap_kind_t; #ifndef UNASSIGNED_OBJECT /* Safe version */ # define UNASSIGNED_OBJECT (MAKE_OBJECT (TC_REFERENCE_TRAP, TRAP_UNASSIGNED)) # define UNBOUND_OBJECT (MAKE_OBJECT (TC_REFERENCE_TRAP, TRAP_UNBOUND)) +# define LINKED_OBJECT (MAKE_OBJECT (TC_REFERENCE_TRAP, TRAP_LINKED)) # define EXPENSIVE_OBJECT (MAKE_OBJECT (TC_REFERENCE_TRAP, TRAP_EXPENSIVE)) #endif