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.

diff --git a/src/microcode/lookup.c b/src/microcode/lookup.c
index 57136407fafbbbe6dc33b586ba10937c3687e837..78fb1834509b01f95b2b4f72e8f0460620c849d9 100644 (file)
--- 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));
+}
 \f
 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 *