Simplify lookup.c's interface.

Environment operations now take only symbols, and check.  The
interpreter now extracts symbols from variables, not lookup.c.

This prevents non-symbols from passing into strengthen_symbol and
weaken_symbol in intern.c, which would barf on them.

diff --git a/src/microcode/interp.c b/src/microcode/interp.c
index ef56c0d9d1a6ba212efd9bb1ef2b65616d547219..14058a871774b879736e07bd67c1127844a536df 100644 (file)
--- a/src/microcode/interp.c
+++ b/src/microcode/interp.c
@@ -576,7 +576,8 @@ Interpret (int pop_return_p)
     case TC_VARIABLE:
       {
        SCHEME_OBJECT val = GET_VAL;
-       long temp = (lookup_variable (GET_ENV, GET_EXP, (&val)));
+       SCHEME_OBJECT name = (GET_VARIABLE_SYMBOL (GET_EXP));
+       long temp = (lookup_variable (GET_ENV, name, (&val)));
        if (temp != PRIM_DONE)
          {
            /* Back out of the evaluation. */
@@ -765,8 +766,6 @@ Interpret (int pop_return_p)
        SCHEME_OBJECT val;
        long code;
 
-       if (!ENVIRONMENT_P (GET_VAL))
-         POP_RETURN_ERROR (ERR_BAD_FRAME);
        code = (lookup_variable (GET_VAL,
                                 (MEMORY_REF (GET_EXP, ACCESS_NAME)),
                                 (&val)));
@@ -785,14 +784,18 @@ Interpret (int pop_return_p)
 
     case RC_EXECUTE_ASSIGNMENT_FINISH:
       {
+       SCHEME_OBJECT variable = (MEMORY_REF (GET_EXP, ASSIGN_NAME));
        SCHEME_OBJECT old_val;
        long code;
 
        POP_ENV ();
-       code = (assign_variable (GET_ENV,
-                                (MEMORY_REF (GET_EXP, ASSIGN_NAME)),
-                                GET_VAL,
-                                (&old_val)));
+       if (TC_VARIABLE == (OBJECT_TYPE (variable)))
+         code = (assign_variable (GET_ENV,
+                                  (GET_VARIABLE_SYMBOL (variable)),
+                                  GET_VAL,
+                                  (&old_val)));
+       else
+         code = ERR_BAD_FRAME;
        if (code == PRIM_DONE)
          SET_VAL (old_val);
        else

diff --git a/src/microcode/lookup.c b/src/microcode/lookup.c
index 2d785e52d591b209f9a7fc5e53e08b7d43b99b18..93781f63b1503c46c0e37de1c2b3bce813830ed1 100644 (file)
--- a/src/microcode/lookup.c
+++ b/src/microcode/lookup.c
@@ -178,15 +178,10 @@ lookup_variable (SCHEME_OBJECT environment, SCHEME_OBJECT symbol,
   SCHEME_OBJECT * cell;
   SCHEME_OBJECT value;
 
-  if (!ENVIRONMENT_P (environment))
+  if (! ((ENVIRONMENT_P (environment)) && (SYMBOL_P (symbol))))
     return (ERR_BAD_FRAME);
 
-  cell
-    = (find_binding_cell (environment,
-                         (((OBJECT_TYPE (symbol)) == TC_VARIABLE)
-                          ? (GET_VARIABLE_SYMBOL (symbol))
-                          : symbol),
-                         0));
+  cell = (find_binding_cell (environment, symbol, 0));
   if (cell == 0)
     return (ERR_UNBOUND_VARIABLE);
 
@@ -324,15 +319,10 @@ long
 assign_variable (SCHEME_OBJECT environment, SCHEME_OBJECT symbol,
                 SCHEME_OBJECT value, SCHEME_OBJECT * value_ret)
 {
-  if (!ENVIRONMENT_P (environment))
+  if (! ((ENVIRONMENT_P (environment)) || (SYMBOL_P (symbol))))
     return (ERR_BAD_FRAME);
   {
-    SCHEME_OBJECT * cell
-      = (find_binding_cell (environment,
-                           (((OBJECT_TYPE (symbol)) == TC_VARIABLE)
-                            ? (GET_VARIABLE_SYMBOL (symbol))
-                            : symbol),
-                           0));
+    SCHEME_OBJECT * cell = (find_binding_cell (environment, symbol, 0));
     if (cell == 0)
       return (ERR_UNBOUND_VARIABLE);
     return (assign_variable_end (cell, value, value_ret, 0));
@@ -434,7 +424,7 @@ long
 define_variable (SCHEME_OBJECT environment, SCHEME_OBJECT symbol,
                 SCHEME_OBJECT value)
 {
-  if (!ENVIRONMENT_P (environment))
+  if (! ((ENVIRONMENT_P (environment)) || (SYMBOL_P (symbol))))
     return (ERR_BAD_FRAME);
 
   /* If there is already a binding, just assign to it.  */
@@ -552,7 +542,9 @@ link_variables (SCHEME_OBJECT target_environment, SCHEME_OBJECT target_symbol,
   SCHEME_OBJECT * target_cell;
 
   if (! ((ENVIRONMENT_P (target_environment))
-        && (ENVIRONMENT_P (source_environment))))
+        && (ENVIRONMENT_P (source_environment))
+        && (SYMBOL_P (target_symbol))
+        && (SYMBOL_P (source_symbol))))
     return (ERR_BAD_FRAME);
 
   source_cell = (find_binding_cell (source_environment, source_symbol, 0));