SEXP attribute_hidden do_debug(SEXP call, SEXP op, SEXP args, SEXP rho)
{
SEXP ans = R_NilValue;
checkArity(op,args);
#define find_char_fun \
if (isValidString(CAR(args))) { \
SEXP s; \
PROTECT(s = installTrChar(STRING_ELT(CAR(args), 0))); \
SETCAR(args, findFun(s, rho)); \
UNPROTECT(1); \
}
find_char_fun
if (TYPEOF(CAR(args)) != CLOSXP && TYPEOF(CAR(args)) != SPECIALSXP
&& TYPEOF(CAR(args)) != BUILTINSXP )
errorcall(call, _("argument must be a closure"));
switch(PRIMVAL(op)) {
case 0:
SET_RDEBUG(CAR(args), 1);
break;
case 1:
if( RDEBUG(CAR(args)) != 1 )
warningcall(call, "argument is not being debugged");
SET_RDEBUG(CAR(args), 0);
break;
case 2:
ans = ScalarLogical(RDEBUG(CAR(args)));
break;
case 3:
SET_RSTEP(CAR(args), 1);
break;
}
return ans;
}
static int ParseBrowser(SEXP CExpr, SEXP rho)
{
int rval = 0;
if (isSymbol(CExpr)) {
const char *expr = CHAR(PRINTNAME(CExpr));
if (!strcmp(expr, "c") || !strcmp(expr, "cont")) {
rval = 1;
SET_RDEBUG(rho, 0);
} else if (!strcmp(expr, "f")) {
rval = 1;
RCNTXT *cntxt = R_GlobalContext;
while (cntxt != R_ToplevelContext
&& !(cntxt->callflag & (CTXT_RETURN | CTXT_LOOP))) {
cntxt = cntxt->nextcontext;
}
cntxt->browserfinish = 1;
SET_RDEBUG(rho, 1);
R_BrowserLastCommand = 'f';
} else if (!strcmp(expr, "help")) {
rval = 2;
printBrowserHelp();
} else if (!strcmp(expr, "n")) {
rval = 1;
SET_RDEBUG(rho, 1);
R_BrowserLastCommand = 'n';
} else if (!strcmp(expr, "Q")) {
/* Run onexit/cend code for everything above the target.
The browser context is still on the stack, so any error
will drop us back to the current browser. Not clear
this is a good thing. Also not clear this should still
be here now that jump_to_toplevel is used for the
jump. */
R_run_onexits(R_ToplevelContext);
/* this is really dynamic state that should be managed as such */
SET_RDEBUG(rho, 0); /*PR#1721*/
jump_to_toplevel();
} else if (!strcmp(expr, "s")) {
rval = 1;
SET_RDEBUG(rho, 1);
R_BrowserLastCommand = 's';
} else if (!strcmp(expr, "where")) {
rval = 2;
printwhere();
/* SET_RDEBUG(rho, 1); */
}
}
return rval;
}
SEXP attribute_hidden do_sysbrowser(SEXP call, SEXP op, SEXP args, SEXP rho)
{
SEXP rval=R_NilValue;
RCNTXT *cptr;
int n;
checkArity(op, args);
n = asInteger(CAR(args));
if(n < 1 ) error(_("number of contexts must be positive"));
/* first find the closest browser context */
cptr = R_GlobalContext;
while (cptr != R_ToplevelContext) {
if (cptr->callflag == CTXT_BROWSER) {
break;
}
cptr = cptr->nextcontext;
}
/* error if not a browser context */
if( !(cptr->callflag == CTXT_BROWSER) )
error(_("no browser context to query"));
switch (PRIMVAL(op)) {
case 1: /* text */
case 2: /* condition */
/* first rewind to the right place if needed */
/* note we want n>1, as we have already */
/* rewound to the first context */
if( n > 1 ) {
while (cptr != R_ToplevelContext && n > 0 ) {
if (cptr->callflag == CTXT_BROWSER) {
n--;
break;
}
cptr = cptr->nextcontext;
}
}
if( !(cptr->callflag == CTXT_BROWSER) )
error(_("not that many calls to browser are active"));
if( PRIMVAL(op) == 1 )
rval = CAR(cptr->promargs);
else
rval = CADR(cptr->promargs);
break;
case 3: /* turn on debugging n levels up */
while ( (cptr != R_ToplevelContext) && n > 0 ) {
if (cptr->callflag & CTXT_FUNCTION)
n--;
cptr = cptr->nextcontext;
}
if( !(cptr->callflag & CTXT_FUNCTION) )
error(_("not that many functions on the call stack"));
else
SET_RDEBUG(cptr->cloenv, 1);
break;
}
return(rval);
}
/* browser(text = "", condition = NULL, expr = TRUE, skipCalls = 0L)
* ------- but also called from ./eval.c */
SEXP attribute_hidden do_browser(SEXP call, SEXP op, SEXP args, SEXP rho)
{
RCNTXT *saveToplevelContext;
RCNTXT *saveGlobalContext;
RCNTXT thiscontext, returncontext, *cptr;
int savestack, browselevel;
SEXP ap, topExp, argList;
/* argument matching */
PROTECT(ap = list4(R_NilValue, R_NilValue, R_NilValue, R_NilValue));
SET_TAG(ap, install("text"));
SET_TAG(CDR(ap), install("condition"));
SET_TAG(CDDR(ap), install("expr"));
SET_TAG(CDDDR(ap), install("skipCalls"));
argList = matchArgs(ap, args, call);
UNPROTECT(1);
PROTECT(argList);
/* substitute defaults */
if(CAR(argList) == R_MissingArg)
SETCAR(argList, mkString(""));
if(CADR(argList) == R_MissingArg)
SETCAR(CDR(argList), R_NilValue);
if(CADDR(argList) == R_MissingArg)
SETCAR(CDDR(argList), ScalarLogical(1));
if(CADDDR(argList) == R_MissingArg)
SETCAR(CDDDR(argList), ScalarInteger(0));
/* return if 'expr' is not TRUE */
if( !asLogical(CADDR(argList)) ) {
UNPROTECT(1);
return R_NilValue;
}
/* Save the evaluator state information */
/* so that it can be restored on exit. */
browselevel = countContexts(CTXT_BROWSER, 1);
savestack = R_PPStackTop;
PROTECT(topExp = R_CurrentExpr);
saveToplevelContext = R_ToplevelContext;
saveGlobalContext = R_GlobalContext;
if (!RDEBUG(rho)) {
int skipCalls = asInteger(CADDDR(argList));
cptr = R_GlobalContext;
while ( ( !(cptr->callflag & CTXT_FUNCTION) || skipCalls--)
&& cptr->callflag )
cptr = cptr->nextcontext;
Rprintf("Called from: ");
int tmp = asInteger(GetOption(install("deparse.max.lines"), R_BaseEnv));
if(tmp != NA_INTEGER && tmp > 0) R_BrowseLines = tmp;
if( cptr != R_ToplevelContext ) {
PrintValueRec(cptr->call, rho);
SET_RDEBUG(cptr->cloenv, 1);
} else
Rprintf("top level \n");
R_BrowseLines = 0;
}
R_ReturnedValue = R_NilValue;
/* Here we establish two contexts. The first */
/* of these provides a target for return */
/* statements which a user might type at the */
/* browser prompt. The (optional) second one */
/* acts as a target for error returns. */
begincontext(&returncontext, CTXT_BROWSER, call, rho,
R_BaseEnv, argList, R_NilValue);
if (!SETJMP(returncontext.cjmpbuf)) {
begincontext(&thiscontext, CTXT_RESTART, R_NilValue, rho,
R_BaseEnv, R_NilValue, R_NilValue);
if (SETJMP(thiscontext.cjmpbuf)) {
SET_RESTART_BIT_ON(thiscontext.callflag);
R_ReturnedValue = R_NilValue;
R_Visible = FALSE;
}
R_GlobalContext = &thiscontext;
R_InsertRestartHandlers(&thiscontext, TRUE);
R_ReplConsole(rho, savestack, browselevel+1);
endcontext(&thiscontext);
}
endcontext(&returncontext);
/* Reset the interpreter state. */
R_CurrentExpr = topExp;
UNPROTECT(1);
R_PPStackTop = savestack;
UNPROTECT(1);
R_CurrentExpr = topExp;
R_ToplevelContext = saveToplevelContext;
R_GlobalContext = saveGlobalContext;
return R_ReturnedValue;
}
