Changed fintVarLocInFrame to use an opaque pointer and accessors

defined in envir.c to confine knowledge about internal binding
structure to that file.


git-svn-id: https://svn.r-project.org/R/trunk@16300 00db46b3-68df-0310-9c12-caf00c1e9a41

src/include/Defn.h

@@ -493,7 +493,6 @@ R_stdGen_ptr_t R_set_standardGeneric_ptr(R_stdGen_ptr_t new); /* set method */
 #define FetchMethod		Rf_FetchMethod
 #define findcontext		Rf_findcontext
 #define findVar1		Rf_findVar1
-#define findVarLocInFrame	Rf_findVarLocInFrame
 #define FrameClassFix		Rf_FrameClassFix
 #define framedepth		Rf_framedepth
 #define frameSubscript		Rf_frameSubscript
@@ -581,6 +580,13 @@ char*	R_HomeDir(void);
 Rboolean R_FileExists(char*);
 Rboolean R_HiddenFile(char*);
 
+/* environment cell access */
+typedef struct R_varloc_st *R_varloc_t;
+R_varloc_t R_findVarLocInFrame(SEXP, SEXP);
+SEXP R_GetVarLocValue(R_varloc_t);
+SEXP R_GetVarLocSymbol(R_varloc_t);
+void R_SetVarLocValue(R_varloc_t, SEXP);
+
 /* Other Internally Used Functions */
 
 void begincontext(RCNTXT*, int, SEXP, SEXP, SEXP, SEXP);
@@ -600,7 +606,6 @@ int factorsConform(SEXP, SEXP);
 SEXP FetchMethod(char *, char *, SEXP);
 void findcontext(int, SEXP, SEXP);
 SEXP findVar1(SEXP, SEXP, SEXPTYPE, int);
-SEXP findVarLocInFrame(SEXP, SEXP);
 void FrameClassFix(SEXP);
 int framedepth(RCNTXT*);
 SEXP frameSubscript(int, SEXP, SEXP);

src/main/envir.c

@@ -675,7 +675,7 @@ void unbindVar(SEXP symbol, SEXP rho)
 
 */
 
-SEXP findVarLocInFrame(SEXP rho, SEXP symbol)
+static SEXP findVarLocInFrame(SEXP rho, SEXP symbol)
 {
     int hashcode;
     SEXP frame, c;
@@ -693,11 +693,38 @@ SEXP findVarLocInFrame(SEXP rho, SEXP symbol)
 	}
 	hashcode = HASHVALUE(c) % HASHSIZE(HASHTAB(rho));
 	/* Will return 'R_NilValue' if not found */
-	return(R_HashGetLoc(hashcode, symbol, HASHTAB(rho)));
+	return R_HashGetLoc(hashcode, symbol, HASHTAB(rho));
     }
 }
 
 
+/*
+  External version and accessor functions. Returned value is cast as
+  an opaque pointer to insure it is only used by routines in this
+  group.  This allows the implementation to be changed without needing
+  to change other files.
+*/
+
+R_varloc_t R_findVarLocInFrame(SEXP rho, SEXP symbol)
+{
+    SEXP binding = findVarLocInFrame(rho, symbol);
+    return binding == R_NilValue ? NULL : (R_varloc_t) binding;
+}
+
+SEXP R_GetVarLocValue(R_varloc_t vl)
+{
+    return CAR((SEXP) vl);
+}
+
+SEXP R_GetVarLocSymbol(R_varloc_t vl)
+{
+    return TAG((SEXP) vl);
+}
+
+void R_SetVarLocValue(R_varloc_t vl, SEXP value)
+{
+    SETCAR((SEXP) vl, value);
+}
 
 
 /*----------------------------------------------------------------------

src/main/eval.c

@@ -954,7 +954,7 @@ SEXP do_function(SEXP call, SEXP op, SEXP args, SEXP rho)
  *  out efficiently using previously computed components.
  */
 
-static SEXP evalseq(SEXP expr, SEXP rho, int forcelocal, SEXP tmploc)
+static SEXP evalseq(SEXP expr, SEXP rho, int forcelocal, R_varloc_t tmploc)
 {
     SEXP val, nval, nexpr;
     if (isNull(expr))
@@ -973,8 +973,8 @@ static SEXP evalseq(SEXP expr, SEXP rho, int forcelocal, SEXP tmploc)
     else if (isLanguage(expr)) {
 	PROTECT(expr);
 	PROTECT(val = evalseq(CADR(expr), rho, forcelocal, tmploc));
-	SETCAR(tmploc, CAR(val));
-	PROTECT(nexpr = LCONS(TAG(tmploc), CDDR(expr)));
+	R_SetVarLocValue(tmploc, CAR(val));
+	PROTECT(nexpr = LCONS(R_GetVarLocSymbol(tmploc), CDDR(expr)));
 	PROTECT(nexpr = LCONS(CAR(expr), nexpr));
 	nval = eval(nexpr, rho);
 	UNPROTECT(4);
@@ -992,7 +992,8 @@ static char *asym[] = {":=", "<-", "<<-", "="};
 
 static SEXP applydefine(SEXP call, SEXP op, SEXP args, SEXP rho)
 {
-    SEXP expr, lhs, rhs, saverhs, tmp, tmp2, tmploc;
+    SEXP expr, lhs, rhs, saverhs, tmp, tmp2;
+    R_varloc_t tmploc;
     char buf[32];
 
     expr = CAR(args);
@@ -1024,12 +1025,7 @@ static SEXP applydefine(SEXP call, SEXP op, SEXP args, SEXP rho)
     if (rho == R_NilValue)
 	errorcall(call, "cannot do complex assignments in NULL environment");
     defineVar(R_TmpvalSymbol, R_NilValue, rho);
-    tmploc = findVarLocInFrame(rho, R_TmpvalSymbol);
-#ifdef OLD
-    tmploc = FRAME(rho);
-    while(tmploc != R_NilValue && TAG(tmploc) != R_TmpvalSymbol)
-	tmploc = CDR(tmploc);
-#endif
+    tmploc = R_findVarLocInFrame(rho, R_TmpvalSymbol);
 
     /*  Do a partial evaluation down through the LHS. */
     lhs = evalseq(CADR(expr), rho, PRIMVAL(op)==1, tmploc);
@@ -1041,22 +1037,24 @@ static SEXP applydefine(SEXP call, SEXP op, SEXP args, SEXP rho)
 	sprintf(buf, "%s<-", CHAR(PRINTNAME(CAR(expr))));
 	tmp = install(buf);
 	UNPROTECT(1);
-	SETCAR(tmploc, CAR(lhs));
+	R_SetVarLocValue(tmploc, CAR(lhs));
 	PROTECT(tmp2 = mkPROMISE(rhs, rho));
 	SET_PRVALUE(tmp2, rhs);
-	PROTECT(rhs = replaceCall(tmp, TAG(tmploc), CDDR(expr), tmp2));
+	PROTECT(rhs = replaceCall(tmp, R_GetVarLocSymbol(tmploc), CDDR(expr),
+				  tmp2));
 	rhs = eval(rhs, rho);
 	UNPROTECT(2);
 	PROTECT(rhs);
 	lhs = CDR(lhs);
 	expr = CADR(expr);
     }
     sprintf(buf, "%s<-", CHAR(PRINTNAME(CAR(expr))));
-    SETCAR(tmploc, CAR(lhs));
+    R_SetVarLocValue(tmploc, CAR(lhs));
     PROTECT(tmp = mkPROMISE(CADR(args), rho));
     SET_PRVALUE(tmp, rhs);
     PROTECT(expr = assignCall(install(asym[PRIMVAL(op)]), CDR(lhs),
-			      install(buf), TAG(tmploc), CDDR(expr), tmp));
+			      install(buf), R_GetVarLocSymbol(tmploc),
+			      CDDR(expr), tmp));
     expr = eval(expr, rho);
     UNPROTECT(5);
     unbindVar(R_TmpvalSymbol, rho);