Commit a8e7cfc5 authored by Radford Neal's avatar Radford Neal

First version released on github

parent 204b861f
Defines a revisecontext function, that is used to avoid the deletion
and recreation of a context during the setup for applying a function.
......@@ -939,6 +939,7 @@ extern0 Rboolean known_to_be_utf8 INI_as(FALSE);
# define RealFromInteger Rf_RealFromInteger
# define RealFromLogical Rf_RealFromLogical
# define RealFromString Rf_RealFromString
# define revisecontext Rf_revisecontext
# define Seql Rf_Seql
# define Scollate Rf_Scollate
# define sortVector Rf_sortVector
......@@ -1172,6 +1173,7 @@ SEXP Rf_vectorSubscript(int, SEXP, int*, SEXP (*)(SEXP,SEXP),
#ifdef R_USE_SIGNALS
void begincontext(RCNTXT*, int, SEXP, SEXP, SEXP, SEXP, SEXP);
void revisecontext(SEXP, SEXP);
SEXP dynamicfindVar(SEXP, RCNTXT*);
void endcontext(RCNTXT*);
int framedepth(RCNTXT*);
......
......@@ -271,6 +271,17 @@ void endcontext(RCNTXT * cptr)
}
/* revisecontext - change environments in a context
The revised context differs from the previous one only in env and sysp. */
void revisecontext (SEXP env, SEXP sysp)
{
R_GlobalContext->sysparent = sysp;
R_GlobalContext->cloenv = env;
}
/* findcontext - find the correct context */
void attribute_hidden findcontext(int mask, SEXP env, SEXP val)
......
......@@ -742,23 +742,20 @@ static SEXP applyClosure_v (SEXP call, SEXP op, SEXP arglist, SEXP rho,
R_jit_enabled = old_enabled;
}
/* Set up a context with the call in it so error has access to it */
/* Set up a context with the call in it for use if an error occurs below
in matchArgs or from running out of memory (eg, in NewEnvironment). */
begincontext(&cntxt, CTXT_RETURN, call, savedrho, rho, arglist, op);
/* Build a list which matches the actual (unevaluated) arguments
to the formal paramters. Build a new environment which
contains the matched pairs. Ideally this environment sould be
hashed. */
contains the matched pairs. Note that actuals is protected via
newrho. */
PROTECT(actuals = matchArgs(formals, NULL, 0, arglist, call));
actuals = matchArgs(formals, NULL, 0, arglist, call);
PROTECT(newrho = NewEnvironment(R_NilValue, actuals, savedrho));
/* no longer passes formals, since matchArg now puts tags in actuals */
/* Use the default code for unbound formals. FIXME: It looks like
this code should preceed the building of the environment so that
this will also go into the hash table. */
/* This piece of code is destructively modifying the actuals list,
which is now also the list of bindings in the frame of newrho.
This is one place where internal structure of environment
......@@ -794,20 +791,18 @@ static SEXP applyClosure_v (SEXP call, SEXP op, SEXP arglist, SEXP rho,
}
}
/* Terminate the previous context and start a new one with the
correct environment. */
UNPROTECT(1); /* newrho, which will be protected below via revised context*/
endcontext(&cntxt);
/* Change the previously-set-up context to have the correct environment.
/* If we have a generic function we need to use the sysparent of
If we have a generic function we need to use the sysparent of
the generic as the sysparent of the method because the method
is a straight substitution of the generic. */
is a straight substitution of the generic. */
if( R_GlobalContext->callflag == CTXT_GENERIC )
begincontext(&cntxt, CTXT_RETURN, call,
newrho, R_GlobalContext->sysparent, arglist, op);
if (R_GlobalContext->nextcontext->callflag == CTXT_GENERIC)
revisecontext (newrho, R_GlobalContext->nextcontext->sysparent);
else
begincontext(&cntxt, CTXT_RETURN, call, newrho, rho, arglist, op);
revisecontext (newrho, rho);
/* The default return value is NULL. FIXME: Is this really needed
or do we always get a sensible value returned? */
......@@ -889,7 +884,7 @@ static SEXP applyClosure_v (SEXP call, SEXP op, SEXP arglist, SEXP rho,
Rprintf("exiting from: ");
PrintValueRec(call, rho);
}
UNPROTECT(3);
UNPROTECT(1); /* tmp */
return (tmp);
}
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment