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 34fffd989e026fb69fabde877bbf9dc5069cb7f4..d4d03e461c31ec6cdba4bf7e62e656b97e8dc370 100644 (file)
--- 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
 \f
@@ -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 e814fa3066b179217e7fe1079e754160c8eef32c..38d3bc33e1027decc09742d2ea1bbe8f0a709a42 100644 (file)
--- 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 865e09162d5a9df0be0cf3a6e6b3dd574e141aa7..964e448dfc34e03cde951a388cb488069291ef51 100644 (file)
--- 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