On 5/24/2009 10:23 AM, Romain Francois wrote:
Duncan Murdoch wrote:
On 23/05/2009 4:55 PM, Robert Gentleman wrote:
Kynn Jones wrote:
[snip]
and you have a breakpoint in bar, you could not (easily)
distinguish which of
the two calls to bar was active. There is no line counter or anything
of that
sort available.
The evaluator doesn't pay any attention to srcref records, so this is
still true, but it would be possible to keep the srcref on the stack
as well as all the other info there.
Please
Here's a patch file that does this. (Will it make it through to the
mailing list? We'll see.) It's still in progress, so I'm not even
ready to put it into R-devel, but you're welcome to try it out.
The basic idea is that it attaches srcref attributes to the values
returned from sys.calls (which won't be displayed, but if you want to
play with them you can) and to .Traceback (which traceback() will
display). debug() will also show them.
Not sure what bad side effects (e.g. on execution time) this has.
Duncan Murdoch
I've written code (and I think I sent it to you last year) that can do
things like replacing the statement coming from a particular line of a
file with whatever code you like; this could be used in writing a nice
source-level debugger.
yes
Duncan Murdoch
best wishes
Robert
Index: src/include/Defn.h
===================================================================
--- src/include/Defn.h (revision 48618)
+++ src/include/Defn.h (working copy)
@@ -493,6 +493,7 @@
IStackval *intstack;
# endif
#endif
+ SEXP srcref; /* The source line in effect */
} RCNTXT, *context;
/* The Various Context Types.
@@ -678,6 +679,7 @@
extern0 Rboolean R_ShowWarnCalls INI_as(FALSE);
extern0 Rboolean R_ShowErrorCalls INI_as(FALSE);
extern0 int R_NShowCalls INI_as(50);
+extern0 SEXP R_Srcref;
LibExtern Rboolean utf8locale INI_as(FALSE); /* is this a UTF-8 locale? */
LibExtern Rboolean mbcslocale INI_as(FALSE); /* is this a MBCS locale? */
Index: src/library/base/R/traceback.R
===================================================================
--- src/library/base/R/traceback.R (revision 48618)
+++ src/library/base/R/traceback.R (working copy)
@@ -25,7 +25,12 @@
else {
for(i in 1L:n) {
label <- paste(n-i+1L, ": ", sep="")
- m <- length(x[[i]])
+ m <- length(x[[i]])
+ if (!is.null(srcref <- attr(x[[i]], "srcref"))) {
+ srcfile <- attr(srcref, "srcfile")
+ x[[i]][m] <- paste(x[[i]][m], " at ", # as.character(srcref,
useSource=FALSE), sep="")
+ basename(srcfile$filename), "#", srcref[1L]+1,
sep="")
+ }
if(m > 1)
label <- c(label, rep(substr(" ", 1L,
nchar(label, type="w")),
@@ -35,7 +40,7 @@
sep = "\n")
cat(label[max.lines+1L], " ...\n")
} else
- cat(paste(label, x[[i]], sep=""), sep="\n")
+ cat(paste(label, x[[i]], sep=""), sep="\n")
}
}
invisible()
Index: src/main/context.c
===================================================================
--- src/main/context.c (revision 48618)
+++ src/main/context.c (working copy)
@@ -50,6 +50,7 @@
* non-local return (i.e. an error)
* cenddata a void pointer to data for cend to use
* vmax the current setting of the R_alloc stack
+ * srcref the srcref at the time of the call
*
* Context types can be one of:
*
@@ -182,6 +183,7 @@
R_BCIntStackTop = cptr->intstack;
# endif
#endif
+ R_Srcref = cptr->srcref;
}
@@ -242,6 +244,7 @@
cptr->intstack = R_BCIntStackTop;
# endif
#endif
+ cptr->srcref = R_Srcref;
R_GlobalContext = cptr;
}
@@ -394,6 +397,8 @@
{
/* negative n counts back from the current frame */
/* positive n counts up from the globalEnv */
+ SEXP result;
+
if (n > 0)
n = framedepth(cptr) - n;
else
@@ -403,15 +408,24 @@
_("not that many frames on the stack"));
while (cptr->nextcontext != NULL) {
if (cptr->callflag & CTXT_FUNCTION ) {
- if (n == 0)
- return (duplicate(cptr->call));
- else
+ if (n == 0) {
+ PROTECT(result = duplicate(cptr->call));
+ if (cptr->srcref && !isNull(cptr->srcref))
+ setAttrib(result, R_SrcrefSymbol, duplicate(cptr->srcref));
+ UNPROTECT(1);
+ return result;
+ } else
n--;
}
cptr = cptr->nextcontext;
}
- if (n == 0 && cptr->nextcontext == NULL)
- return (duplicate(cptr->call));
+ if (n == 0 && cptr->nextcontext == NULL) {
+ PROTECT(result = duplicate(cptr->call));
+ if (!isNull(cptr->srcref))
+ setAttrib(result, R_SrcrefSymbol, duplicate(cptr->srcref));
+ UNPROTECT(1);
+ return result;
+ }
errorcall(R_GlobalContext->call, _("not that many frames on the stack"));
return R_NilValue; /* just for -Wall */
}
Index: src/main/errors.c
===================================================================
--- src/main/errors.c (revision 48618)
+++ src/main/errors.c (working copy)
@@ -1294,6 +1294,8 @@
skip--;
else {
SETCAR(t, deparse1(c->call, 0, DEFAULTDEPARSE));
+ if (c->srcref && !isNull(c->srcref))
+ setAttrib(CAR(t), R_SrcrefSymbol, duplicate(c->srcref));
t = CDR(t);
}
}
Index: src/main/eval.c
===================================================================
--- src/main/eval.c (revision 48618)
+++ src/main/eval.c (working copy)
@@ -349,6 +349,10 @@
{
SEXP op, tmp;
static int evalcount = 0;
+
+ /* Save the current srcref context. */
+
+ SEXP srcrefsave = R_Srcref;
/* The use of depthsave below is necessary because of the
possibility of non-local returns from evaluation. Without this
@@ -515,6 +519,7 @@
UNIMPLEMENTED_TYPE("eval", e);
}
R_EvalDepth = depthsave;
+ R_Srcref = srcrefsave;
return (tmp);
}
@@ -1191,20 +1196,29 @@
SEXP attribute_hidden do_begin(SEXP call, SEXP op, SEXP args, SEXP rho)
{
- SEXP s;
- if (args == R_NilValue) {
- s = R_NilValue;
- }
- else {
- while (args != R_NilValue) {
+ SEXP s = R_NilValue;
+ if (args != R_NilValue) {
+ SEXP srcrefs = getAttrib(call, R_SrcrefSymbol);
+ Rboolean usesrcrefs = !isNull(srcrefs);
+ int i = 1;
+ R_Srcref = R_NilValue;
+ while (args != R_NilValue) {
+ if (usesrcrefs) PROTECT(R_Srcref = VECTOR_ELT(srcrefs, i++));
if (DEBUG(rho)) {
- Rprintf("debug: ");
+ if (usesrcrefs) {
+ SEXP srcfile = getAttrib(R_Srcref, R_SrcfileSymbol);
+ SEXP filename = findVar(install("filename"), srcfile);
+ Rprintf("debug at %s#%d: ", CHAR(STRING_ELT(filename, 0)),
INTEGER(R_Srcref)[0]);
+ } else
+ Rprintf("debug: ");
PrintValue(CAR(args));
do_browser(call, op, R_NilValue, rho);
}
s = eval(CAR(args), rho);
+ if (usesrcrefs) UNPROTECT(1);
args = CDR(args);
}
+ R_Srcref = R_NilValue;
}
return s;
}
Index: src/main/main.c
===================================================================
--- src/main/main.c (revision 48618)
+++ src/main/main.c (working copy)
@@ -980,11 +980,18 @@
{
RCNTXT *cptr;
int lct = 1;
+ SEXP srcref;
for (cptr = R_GlobalContext; cptr; cptr = cptr->nextcontext) {
if ((cptr->callflag & (CTXT_FUNCTION | CTXT_BUILTIN)) &&
(TYPEOF(cptr->call) == LANGSXP)) {
- Rprintf("where %d: ", lct++);
+ Rprintf("where %d", lct++);
+ if (cptr->srcref && !isNull(srcref = cptr->srcref)) {
+ SEXP srcfile = getAttrib(srcref, R_SrcfileSymbol);
+ SEXP filename = findVar(install("filename"), srcfile);
+ Rprintf(" at %s#%d", CHAR(STRING_ELT(filename, 0)),
INTEGER(srcref)[0]);
+ }
+ Rprintf(": ");
PrintValue(cptr->call);
}
}
Index: src/main/memory.c
===================================================================
--- src/main/memory.c (revision 48618)
+++ src/main/memory.c (working copy)
@@ -1653,6 +1653,9 @@
/* Unbound values which are to be preserved through GCs */
R_PreciousList = R_NilValue;
+
+ /* The current source line */
+ R_Srcref = R_NilValue;
}
/* Since memory allocated from the heap is non-moving, R_alloc just
______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
