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



    if (SYMVALUE(hooksym) != R_UnboundValue &&
	SYMVALUE(R_QuoteSymbol) != R_UnboundValue) {
	PROTECT(qcall = LCONS(R_QuoteSymbol, LCONS(call, R_NilValue)));
	PROTECT(hcall = LCONS(qcall, R_NilValue));
	Rvsnprintf(buf, BUFSIZE - 1, format, ap);
	hcall = LCONS(mkString(buf), hcall);
	PROTECT(hcall = LCONS(hooksym, hcall));
	eval(hcall, R_GlobalEnv);
	UNPROTECT(3);
    }
    else vwarningcall_dflt(call, format, ap);

		PROTECT(oldstack);
		hooksym = install(".handleSimpleError");
		PROTECT(qcall = LCONS(R_QuoteSymbol,
				      LCONS(call, R_NilValue)));
		PROTECT(hcall = LCONS(qcall, R_NilValue));
		hcall = LCONS(mkString(buf), hcall);
		hcall = LCONS(ENTRY_HANDLER(entry), hcall);
		PROTECT(hcall = LCONS(hooksym, hcall));
		eval(hcall, R_GlobalEnv);
		UNPROTECT(4);
	    }

    rho = cptr->cloenv;
    PROTECT(klass = mkChar("error"));
    entry = mkHandlerEntry(klass, rho, R_RestartToken, rho, R_NilValue, TRUE);
    R_HandlerStack = CONS(entry, R_HandlerStack);
    UNPROTECT(1);
    PROTECT(name = mkString(browser ? "browser" : "tryRestart"));
    PROTECT(entry = allocVector(VECSXP, 2));
    PROTECT(SET_VECTOR_ELT(entry, 0, name));
    SET_VECTOR_ELT(entry, 1, R_MakeExternalPtr(cptr, R_NilValue, R_NilValue));
    setAttrib(entry, R_ClassSymbol, mkString("restart"));
    R_RestartStack = CONS(entry, R_RestartStack);
    UNPROTECT(3);
}
 
SEXP attribute_hidden do_dfltWarn(SEXP call, SEXP op, SEXP args, SEXP rho)

    if (list != R_NilValue)
	return CAR(list);
    else if (i == 1) {
	/**** need to pre-allocate */
	SEXP name, entry;
	PROTECT(name = mkString("abort"));
	entry = allocVector(VECSXP, 2);
	SET_VECTOR_ELT(entry, 0, name);
	SET_VECTOR_ELT(entry, 1, R_NilValue);
	setAttrib(entry, R_ClassSymbol, mkString("restart"));
	UNPROTECT(1);
	return entry;
    }
    else return R_NilValue;
}

Rev 48623	Rev 48811
Line 1458...	Line 1458...
1458	`if (SYMVALUE(hooksym) != R_UnboundValue &&`	1458	`if (SYMVALUE(hooksym) != R_UnboundValue &&`
1459	`SYMVALUE(R_QuoteSymbol) != R_UnboundValue) {`	1459	`SYMVALUE(R_QuoteSymbol) != R_UnboundValue) {`
1460	`PROTECT(qcall = LCONS(R_QuoteSymbol, LCONS(call, R_NilValue)));`	1460	`PROTECT(qcall = LCONS(R_QuoteSymbol, LCONS(call, R_NilValue)));`
1461	`PROTECT(hcall = LCONS(qcall, R_NilValue));`	1461	`PROTECT(hcall = LCONS(qcall, R_NilValue));`
1462	`Rvsnprintf(buf, BUFSIZE - 1, format, ap);`	1462	`Rvsnprintf(buf, BUFSIZE - 1, format, ap);`
1463	`hcall = LCONS(ScalarString(mkChar(buf)), hcall);`	1463	`hcall = LCONS(mkString(buf), hcall);`
1464	`PROTECT(hcall = LCONS(hooksym, hcall));`	1464	`PROTECT(hcall = LCONS(hooksym, hcall));`
1465	`eval(hcall, R_GlobalEnv);`	1465	`eval(hcall, R_GlobalEnv);`
1466	`UNPROTECT(3);`	1466	`UNPROTECT(3);`
1467	`}`	1467	`}`
1468	`else vwarningcall_dflt(call, format, ap);`	1468	`else vwarningcall_dflt(call, format, ap);`
Line 1503...	Line 1503...
1503	`PROTECT(oldstack);`	1503	`PROTECT(oldstack);`
1504	`hooksym = install(".handleSimpleError");`	1504	`hooksym = install(".handleSimpleError");`
1505	`PROTECT(qcall = LCONS(R_QuoteSymbol,`	1505	`PROTECT(qcall = LCONS(R_QuoteSymbol,`
1506	`LCONS(call, R_NilValue)));`	1506	`LCONS(call, R_NilValue)));`
1507	`PROTECT(hcall = LCONS(qcall, R_NilValue));`	1507	`PROTECT(hcall = LCONS(qcall, R_NilValue));`
1508	`hcall = LCONS(ScalarString(mkChar(buf)), hcall);`	1508	`hcall = LCONS(mkString(buf), hcall);`
1509	`hcall = LCONS(ENTRY_HANDLER(entry), hcall);`	1509	`hcall = LCONS(ENTRY_HANDLER(entry), hcall);`
1510	`PROTECT(hcall = LCONS(hooksym, hcall));`	1510	`PROTECT(hcall = LCONS(hooksym, hcall));`
1511	`eval(hcall, R_GlobalEnv);`	1511	`eval(hcall, R_GlobalEnv);`
1512	`UNPROTECT(4);`	1512	`UNPROTECT(4);`
1513	`}`	1513	`}`
Line 1639...	Line 1639...
1639	`rho = cptr->cloenv;`	1639	`rho = cptr->cloenv;`
1640	`PROTECT(klass = mkChar("error"));`	1640	`PROTECT(klass = mkChar("error"));`
1641	`entry = mkHandlerEntry(klass, rho, R_RestartToken, rho, R_NilValue, TRUE);`	1641	`entry = mkHandlerEntry(klass, rho, R_RestartToken, rho, R_NilValue, TRUE);`
1642	`R_HandlerStack = CONS(entry, R_HandlerStack);`	1642	`R_HandlerStack = CONS(entry, R_HandlerStack);`
1643	`UNPROTECT(1);`	1643	`UNPROTECT(1);`
1644	`PROTECT(name = ScalarString(mkChar(browser ? "browser" : "tryRestart")));`	1644	`PROTECT(name = mkString(browser ? "browser" : "tryRestart"));`
1645	`PROTECT(entry = allocVector(VECSXP, 2));`	1645	`PROTECT(entry = allocVector(VECSXP, 2));`
1646	`PROTECT(SET_VECTOR_ELT(entry, 0, name));`	1646	`PROTECT(SET_VECTOR_ELT(entry, 0, name));`
1647	`SET_VECTOR_ELT(entry, 1, R_MakeExternalPtr(cptr, R_NilValue, R_NilValue));`	1647	`SET_VECTOR_ELT(entry, 1, R_MakeExternalPtr(cptr, R_NilValue, R_NilValue));`
1648	`setAttrib(entry, R_ClassSymbol, ScalarString(mkChar("restart")));`	1648	`setAttrib(entry, R_ClassSymbol, mkString("restart"));`
1649	`R_RestartStack = CONS(entry, R_RestartStack);`	1649	`R_RestartStack = CONS(entry, R_RestartStack);`
1650	`UNPROTECT(3);`	1650	`UNPROTECT(3);`
1651	`}`	1651	`}`
1652		1652
1653	`SEXP attribute_hidden do_dfltWarn(SEXP call, SEXP op, SEXP args, SEXP rho)`	1653	`SEXP attribute_hidden do_dfltWarn(SEXP call, SEXP op, SEXP args, SEXP rho)`
Line 1699...	Line 1699...
1699	`if (list != R_NilValue)`	1699	`if (list != R_NilValue)`
1700	`return CAR(list);`	1700	`return CAR(list);`
1701	`else if (i == 1) {`	1701	`else if (i == 1) {`
1702	`/**** need to pre-allocate */`	1702	`/**** need to pre-allocate */`
1703	`SEXP name, entry;`	1703	`SEXP name, entry;`
1704	`PROTECT(name = ScalarString(mkChar("abort")));`	1704	`PROTECT(name = mkString("abort"));`
1705	`entry = allocVector(VECSXP, 2);`	1705	`entry = allocVector(VECSXP, 2);`
1706	`SET_VECTOR_ELT(entry, 0, name);`	1706	`SET_VECTOR_ELT(entry, 0, name);`
1707	`SET_VECTOR_ELT(entry, 1, R_NilValue);`	1707	`SET_VECTOR_ELT(entry, 1, R_NilValue);`
1708	`setAttrib(entry, R_ClassSymbol, ScalarString(mkChar("restart")));`	1708	`setAttrib(entry, R_ClassSymbol, mkString("restart"));`
1709	`UNPROTECT(1);`	1709	`UNPROTECT(1);`
1710	`return entry;`	1710	`return entry;`
1711	`}`	1711	`}`
1712	`else return R_NilValue;`	1712	`else return R_NilValue;`
1713	`}`	1713	`}`

The R Project SVN R

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