The R Project SVN R

Rev

Rev 26266 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 26266 Rev 26606
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 1088... Line 1091...
1088 
    return R_NilValue;
 1091 
    return R_NilValue;
1089 
}
 1092 
}
1090 
 
 1093 
 
1091 
SEXP do_signalCondition(SEXP call, SEXP op, SEXP args, SEXP rho)
 1094 
SEXP do_signalCondition(SEXP call, SEXP op, SEXP args, SEXP rho)
1092 
{
 1095 
{
1093 
    SEXP list, cond, msg, ecall;
 1096 
    SEXP list, cond, msg, ecall, oldstack;
1094 
 
 1097 
 
1095 
    checkArity(op, args);
 1098 
    checkArity(op, args);
1096 
 
 1099 
 
1097 
    cond = CAR(args);
 1100 
    cond = CAR(args);
1098 
    msg = CADR(args);
 1101 
    msg = CADR(args);
1099 
    ecall = CADDR(args);
 1102 
    ecall = CADDR(args);
1100 
 
 1103 
 
- 
 
 1104 
    PROTECT(oldstack = R_HandlerStack);
1101 
    while ((list = findConditionHandler(cond)) != R_NilValue) {
 1105 
    while ((list = findConditionHandler(cond)) != R_NilValue) {
1102 
	SEXP entry = CAR(list);
 1106 
	SEXP entry = CAR(list);
1103 
	R_HandlerStack = CDR(list);
 1107 
	R_HandlerStack = CDR(list);
1104 
	if (IS_CALLING_ENTRY(entry)) {
 1108 
	if (IS_CALLING_ENTRY(entry)) {
1105 
	    SEXP h = ENTRY_HANDLER(entry);
 1109 
	    SEXP h = ENTRY_HANDLER(entry);
Line 1115... Line 1119...
1115 
		PROTECT(hcall);
 1119 
		PROTECT(hcall);
1116 
		eval(hcall, R_GlobalEnv);
 1120 
		eval(hcall, R_GlobalEnv);
1117 
		UNPROTECT(1);
 1121 
		UNPROTECT(1);
1118 
	    }
 1122 
	    }
1119 
	}
 1123 
	}
1120 
	else gotoExitingHandler(cond, call, entry);
 1124 
	else gotoExitingHandler(cond, ecall, entry);
1121 
    }
 1125 
    }
- 
 
 1126 
    R_HandlerStack = oldstack;
- 
 
 1127 
    UNPROTECT(1);
1122 
    return R_NilValue;
 1128 
    return R_NilValue;
1123 
}
 1129 
}
1124 
 
 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 
 
1125 
void R_InsertRestartHandlers(RCNTXT *cptr, Rboolean browser)
 1179 
void R_InsertRestartHandlers(RCNTXT *cptr, Rboolean browser)
1126 
{
 1180 
{
1127 
    SEXP class, rho, entry, name;
 1181 
    SEXP class, rho, entry, name;
1128 
 
 1182 
 
1129 
    if ((cptr->handlerstack != R_HandlerStack ||
 1183 
    if ((cptr->handlerstack != R_HandlerStack ||