The R Project SVN R

Rev

Rev 26353 | Rev 26646 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 26353 Rev 26354
Line 48... Line 48...
48 
static int inWarning = 0;
 48 
static int inWarning = 0;
49 
static int inPrintWarnings = 0;
 49 
static int inPrintWarnings = 0;
50 
 
 50 
 
51 
static void try_jump_to_restart(void);
 51 
static void try_jump_to_restart(void);
52 
static void jump_to_top_ex(Rboolean, Rboolean, Rboolean, Rboolean, Rboolean);
 52 
static void jump_to_top_ex(Rboolean, Rboolean, Rboolean, Rboolean, Rboolean);
- 
 
 53 
static void signalInterrupt(void);
53 
 
 54 
 
54 
/* Interface / Calling Hierarchy :
 55 
/* Interface / Calling Hierarchy :
55 
 
 56 
 
56 
  R__stop()   -> do_error ->   errorcall --> jump_to_top_ex
 57 
  R__stop()   -> do_error ->   errorcall --> jump_to_top_ex
57 
			 /
 58 
			 /
Line 89... Line 90...
89 
    if (R_interrupts_suspended) {
 90 
    if (R_interrupts_suspended) {
90 
	R_interrupts_pending = 1;
 91 
	R_interrupts_pending = 1;
91 
	return;
 92 
	return;
92 
    }
 93 
    }
93 
    else R_interrupts_pending = 0;
 94 
    else R_interrupts_pending = 0;
- 
 
 95 
 
- 
 
 96 
    signalInterrupt();
94
97 
 
95 
    REprintf("\n");
 98 
    REprintf("\n");
96 
    /* Attempt to run user error option, save a traceback, show
 99 
    /* Attempt to run user error option, save a traceback, show
97 
       warnings, and reset console; also stop at restart (try/browser)
 100 
       warnings, and reset console; also stop at restart (try/browser)
98 
       frames.  Not clear this is what we really want, but this
 101 
       frames.  Not clear this is what we really want, but this
99 
       preserves current behavior */
 102 
       preserves current behavior */
Line 1123... Line 1126...
1123 
    R_HandlerStack = oldstack;
 1126 
    R_HandlerStack = oldstack;
1124 
    UNPROTECT(1);
 1127 
    UNPROTECT(1);
1125 
    return R_NilValue;
 1128 
    return R_NilValue;
1126 
}
 1129 
}
1127 
 
 1130 
 
- 
 
 1131 
static SEXP findInterruptHandler()
- 
 
 1132 
{
- 
 
 1133 
    SEXP list;
- 
 
 1134 
    for (list = R_HandlerStack; list != R_NilValue; list = CDR(list)) {
- 
 
 1135 
	SEXP entry = CAR(list);
- 
 
 1136 
	if (! strcmp(CHAR(ENTRY_CLASS(entry)), "interrupt") ||
- 
 
 1137 
	    ! strcmp(CHAR(ENTRY_CLASS(entry)), "condition"))
- 
 
 1138 
	    return list;
- 
 
 1139 
    }
- 
 
 1140 
    return R_NilValue;
- 
 
 1141 
}
- 
 
 1142 
 
- 
 
 1143 
static SEXP getInterruptCondition()
- 
 
 1144 
{
- 
 
 1145 
    /**** FIXME: should probably pre-allocate this */
- 
 
 1146 
    SEXP cond, class;
- 
 
 1147 
    PROTECT(cond = allocVector(VECSXP, 0));
- 
 
 1148 
    PROTECT(class = allocVector(STRSXP, 2));
- 
 
 1149 
    SET_STRING_ELT(class, 0, mkChar("interrupt"));
- 
 
 1150 
    SET_STRING_ELT(class, 1, mkChar("condition"));
- 
 
 1151 
    R_set_class(cond, class, R_NilValue);
- 
 
 1152 
    UNPROTECT(2);
- 
 
 1153 
    return cond;
- 
 
 1154 
}
- 
 
 1155 
 
- 
 
 1156 
static void signalInterrupt(void)
- 
 
 1157 
{
- 
 
 1158 
    SEXP list, cond, oldstack;
- 
 
 1159 
 
- 
 
 1160 
    PROTECT(oldstack = R_HandlerStack);
- 
 
 1161 
    while ((list = findInterruptHandler()) != R_NilValue) {
- 
 
 1162 
	SEXP entry = CAR(list);
- 
 
 1163 
	R_HandlerStack = CDR(list);
- 
 
 1164 
	PROTECT(cond = getInterruptCondition());
- 
 
 1165 
	if (IS_CALLING_ENTRY(entry)) {
- 
 
 1166 
	    SEXP h = ENTRY_HANDLER(entry);
- 
 
 1167 
	    SEXP hcall = LCONS(h, LCONS(cond, R_NilValue));
- 
 
 1168 
	    PROTECT(hcall);
- 
 
 1169 
	    eval(hcall, R_GlobalEnv);
- 
 
 1170 
	    UNPROTECT(1);
- 
 
 1171 
	}
- 
 
 1172 
	else gotoExitingHandler(cond, R_NilValue, entry);
- 
 
 1173 
	UNPROTECT(1);
- 
 
 1174 
    }
- 
 
 1175 
    R_HandlerStack = oldstack;
- 
 
 1176 
    UNPROTECT(1);
- 
 
 1177 
}
- 
 
 1178 
 
1128 
void R_InsertRestartHandlers(RCNTXT *cptr, Rboolean browser)
 1179 
void R_InsertRestartHandlers(RCNTXT *cptr, Rboolean browser)
1129 
{
 1180 
{
1130 
    SEXP class, rho, entry, name;
 1181 
    SEXP class, rho, entry, name;
1131 
 
 1182 
 
1132 
    if ((cptr->handlerstack != R_HandlerStack ||
 1183 
    if ((cptr->handlerstack != R_HandlerStack ||