The R Project SVN – R – Diff – /branches/R-exp-R5/src/main/context.c

  *			at exit from the closure (normal or abnormal).
  *	cend		a pointer to function which executes if there is
  *			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:
+ *
  *	CTXT_TOPLEVEL	The toplevel context
  *	CTXT_BREAK	target for "break"
     R_BCNodeStackTop = cptr->nodestack;
 # ifdef BC_INT_STACK
     R_BCIntStackTop = cptr->intstack;
 # endif
 #endif
+    R_Srcref = cptr->srcref;
+}
 /* jumpfun - jump to the named context */
     cptr->nodestack = R_BCNodeStackTop;
 # ifdef BC_INT_STACK
     cptr->intstack = R_BCIntStackTop;
 # endif
 #endif
+    cptr->srcref = R_Srcref;
     R_GlobalContext = cptr;
+}
 /* endcontext - end an execution context */
 SEXP attribute_hidden R_syscall(int n, RCNTXT *cptr)
+{
     /* 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
 	n = - n;
     if(n < 0)
 	errorcall(R_GlobalContext->call,
 		  _("not that many frames on the stack"));
     while (cptr->nextcontext != NULL) {
 	if (cptr->callflag & CTXT_FUNCTION ) {
-	    if (n == 0)
+	    if (n == 0) {
-		return (duplicate(cptr->call));
+	    	PROTECT(result = duplicate(cptr->call));
+	    	if (cptr->srcref && !isNull(cptr->srcref))
+	    	    setAttrib(result, R_SrcrefSymbol, duplicate(cptr->srcref));
+	    	UNPROTECT(1);
+	    	return result;
-	    else
+	    } else
 		n--;
+	}
 	cptr = cptr->nextcontext;
+    }
-    if (n == 0 && cptr->nextcontext == NULL)
+    if (n == 0 && cptr->nextcontext == NULL) {
-	return (duplicate(cptr->call));
+	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 */
+}
 SEXP attribute_hidden R_sysfunction(int n, RCNTXT *cptr)

The R Project SVN R

(root)/branches/R-exp-R5/src/main/context.c @ 63243 – Rev 48600 → 48623