Commit e8aab7f2 authored by Radford Neal's avatar Radford Neal

eval-related performance tweaks, moves cold code out of eval.c

parent 899a87eb
......@@ -321,6 +321,8 @@
Rf_StringFromReal
Rf_VectorIndex
Rf_allocCharsxp
Rf_apply_debug_finish
Rf_apply_debug_setup
Rf_apply_non_function_error
Rf_arg_missing_error
Rf_asLogicalNoNA_error
......@@ -408,6 +410,7 @@
Rf_setRVector
Rf_setenvsymbits
Rf_ssort
Rf_start_browser
Rf_stirlerr
Rf_substituteList
Rf_ucstomb
......
......@@ -1361,6 +1361,7 @@ extern0 Rboolean known_to_be_utf8 INI_as(FALSE);
# define sortVector Rf_sortVector
# define SrcrefPrompt Rf_SrcrefPrompt
# define ssort Rf_ssort
# define start_browser Rf_start_browser
# define StringFromComplex Rf_StringFromComplex
# define StringFromInteger Rf_StringFromInteger
# define StringFromLogical Rf_StringFromLogical
......@@ -1454,6 +1455,8 @@ SEXP Rf_EnsureString(SEXP);
SEXP Rf_allocCharsxp(R_len_t);
SEXP alloc_or_reuse (SEXP, SEXP, SEXPTYPE, int, int, int);
SEXP Rf_append(SEXP, SEXP); /* apparently unused now */
SEXP Rf_apply_debug_finish (SEXP, SEXP);
SEXP Rf_apply_debug_setup (SEXP, SEXP, SEXP, SEXP, SEXP);
SEXP Rf_attributes_dup (SEXP, SEXP);
SEXP bcEval(SEXP, SEXP, Rboolean);
SEXP bytecodeExpr(SEXP);
......@@ -1592,6 +1595,7 @@ int R_isMissing(SEXP symbol, SEXP rho);
void sortVector(SEXP, Rboolean);
void SrcrefPrompt(const char *, SEXP);
void ssort(SEXP*,int);
void start_browser (SEXP, SEXP, SEXP, SEXP);
int StrToInternal(const char *);
SEXP substituteList(SEXP, SEXP);
void R_trace_call(SEXP, SEXP);
......
......@@ -652,4 +652,35 @@ INLINE_FUN const char *Rf_translateChar (SEXP x)
return TYPE_ETC(x) == CHARSXP ? CHAR(x) : Rf_translateChar_nontrivial(x);
}
/* This function extracts one srcref, and confirms the format. It is
passed an index and the array and length from getBlockSrcrefs. */
INLINE_FUN SEXP getSrcref(SEXP *refs, int len, int ind)
{
if (ind < len) {
SEXP result = refs[ind];
if (TYPEOF(result) == INTSXP && LENGTH(result) >= 6)
return result;
}
return R_NilValue;
}
/* This function gets the srcref attribute from a statement block,
and confirms it's in the expected format */
INLINE_FUN void getBlockSrcrefs(SEXP call, SEXP **refs, int *len)
{
SEXP srcrefs = getAttrib00(call, R_SrcrefSymbol);
if (TYPEOF(srcrefs) == VECSXP) {
*refs = (SEXP *) DATAPTR(srcrefs);
*len = LENGTH(srcrefs);
}
else
{ *len = 0;
}
}
#endif /* R_INLINES_H_ */
......@@ -217,22 +217,6 @@ static SEXP do_compilepkgs(SEXP call, SEXP op, SEXP args, SEXP rho)
return ScalarLogicalMaybeConst(old);
}
static void printcall (SEXP call, SEXP rho)
{
int old_bl = R_BrowseLines;
int blines = asInteger(GetOption1(install("deparse.max.lines")));
if (blines != NA_INTEGER && blines > 0) R_BrowseLines = blines;
PrintValueRec(call,rho);
R_BrowseLines = old_bl;
}
static void start_browser (SEXP call, SEXP op, SEXP stmt, SEXP env)
{
SrcrefPrompt("debug", R_Srcref);
PrintValue(stmt);
do_browser(call, op, R_NilValue, env);
}
static int R_bcVersion = 7;
static int R_bcMinVersion = 6;
......
This diff is collapsed.
......@@ -924,6 +924,80 @@ SEXP attribute_hidden EnsureString(SEXP s)
return s;
}
attribute_hidden void SrcrefPrompt(const char * prefix, SEXP srcref)
{
/* If we have a valid srcref, use it */
if (srcref && srcref != R_NilValue) {
if (TYPEOF(srcref) == VECSXP) srcref = VECTOR_ELT(srcref, 0);
SEXP srcfile = getAttrib00(srcref, R_SrcfileSymbol);
if (TYPEOF(srcfile) == ENVSXP) {
SEXP filename = findVar(install("filename"), srcfile);
if (isString(filename) && length(filename)) {
Rprintf(_("%s at %s#%d: "),prefix,CHAR(STRING_ELT(filename,0)),
asInteger(srcref));
return;
}
}
}
/* default: */
Rprintf("%s: ", prefix);
}
attribute_hidden void start_browser (SEXP call, SEXP op, SEXP stmt, SEXP env)
{
if (stmt == R_NilValue || isLanguage(stmt) && CAR(stmt) == R_BraceSymbol)
return;
SrcrefPrompt("debug", R_Srcref);
PrintValue(stmt);
do_browser(call, op, R_NilValue, env);
}
/* Part of applyClosure, etc. put here to reduce code size there. */
attribute_hidden SEXP Rf_apply_debug_setup
(SEXP call, SEXP op, SEXP rho, SEXP body, SEXP newrho)
{
SET_RDEBUG(newrho, 1);
if (RSTEP(op)) SET_RSTEP(op, 0);
SEXP savesrcref; SEXP *srcrefs; int len;
/* switch to interpreted version when debugging compiled code */
if (TYPEOF(body) == BCODESXP)
body = bytecodeExpr(body);
Rprintf("debugging in: ");
int old_bl = R_BrowseLines;
int blines = asInteger(GetOption1(install("deparse.max.lines")));
if (blines != NA_INTEGER && blines > 0) R_BrowseLines = blines;
PrintValueRec(call,newrho);
R_BrowseLines = old_bl;
savesrcref = R_Srcref;
getBlockSrcrefs(body,&srcrefs,&len);
PROTECT(R_Srcref = getSrcref(srcrefs,len,0));
SrcrefPrompt("debug", R_Srcref);
PrintValue(body);
do_browser(call, op, R_NilValue, newrho);
R_Srcref = savesrcref;
UNPROTECT(1);
return body;
}
attribute_hidden SEXP Rf_apply_debug_finish (SEXP call, SEXP rho)
{
Rprintf("exiting from: ");
int old_bl = R_BrowseLines;
int blines = asInteger(GetOption1(install("deparse.max.lines")));
if (blines != NA_INTEGER && blines > 0) R_BrowseLines = blines;
PrintValueRec(call,rho);
R_BrowseLines = old_bl;
}
/* Allocate space for the result of an operation, or reuse the space for
one of its operands, if it has NAMEDCNT of zero. Attributes are assumed
to be taken from the operands, with the first operand's attributes taking
......
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