2121#include < Rcpp/Interrupt.h>
2222#include < Rversion.h>
2323
24- // outer definition from RcppCommon.h
25- #if defined(RCPP_USE_UNWIND_PROTECT)
26- #if (defined(RCPP_PROTECTED_EVAL) && defined(R_VERSION) && R_VERSION >= R_Version(3, 5, 0))
27- // file-local and only used here
28- #define RCPP_USE_PROTECT_UNWIND
29- #endif
24+ #if (defined(RCPP_PROTECTED_EVAL) && defined(R_VERSION) && R_VERSION >= R_Version(3, 5, 0))
25+ #define RCPP_USE_PROTECT_UNWIND
26+ #include < csetjmp>
3027#endif
3128
29+
3230namespace Rcpp {
3331namespace internal {
3432
@@ -39,18 +37,17 @@ namespace internal {
3937 SEXP env;
4038 EvalData (SEXP expr_, SEXP env_) : expr(expr_), env(env_) { }
4139 };
40+ struct EvalUnwindData {
41+ std::jmp_buf jmpbuf;
42+ };
4243
43- inline void Rcpp_maybe_throw (void * data, Rboolean jump) {
44+ // First jump back to the protected context with a C longjmp because
45+ // `Rcpp_protected_eval()` is called from C and we can't safely throw
46+ // exceptions across C frames.
47+ inline void Rcpp_maybe_throw (void * unwind_data, Rboolean jump) {
4448 if (jump) {
45- SEXP token = static_cast <SEXP>(data);
46-
47- // Keep the token protected while unwinding because R code might run
48- // in C++ destructors. Can't use PROTECT() for this because
49- // UNPROTECT() might be called in a destructor, for instance if a
50- // Shield<SEXP> is on the stack.
51- ::R_PreserveObject (token);
52-
53- throw LongjumpException (token);
49+ EvalUnwindData* data = static_cast <EvalUnwindData*>(unwind_data);
50+ longjmp (data->jmpbuf , 1 );
5451 }
5552 }
5653
@@ -80,9 +77,21 @@ namespace internal {
8077
8178 inline SEXP Rcpp_fast_eval (SEXP expr, SEXP env) {
8279 internal::EvalData data (expr, env);
80+ internal::EvalUnwindData unwind_data;
8381 Shield<SEXP> token (::R_MakeUnwindCont ());
82+
83+ if (setjmp (unwind_data.jmpbuf )) {
84+ // Keep the token protected while unwinding because R code might run
85+ // in C++ destructors. Can't use PROTECT() for this because
86+ // UNPROTECT() might be called in a destructor, for instance if a
87+ // Shield<SEXP> is on the stack.
88+ ::R_PreserveObject (token);
89+
90+ throw internal::LongjumpException (token);
91+ }
92+
8493 return ::R_UnwindProtect (internal::Rcpp_protected_eval, &data,
85- internal::Rcpp_maybe_throw, token ,
94+ internal::Rcpp_maybe_throw, &unwind_data ,
8695 token);
8796 }
8897
@@ -112,11 +121,7 @@ inline SEXP Rcpp_eval(SEXP expr, SEXP env) {
112121 SET_TAG (CDDR (call), ::Rf_install (" error" ));
113122 SET_TAG (CDDR (CDR (call)), ::Rf_install (" interrupt" ));
114123
115- #if defined(RCPP_USE_UNWIND_PROTECT)
116- Shield<SEXP> res (::Rf_eval (call, R_GlobalEnv)) // execute the call
117- #else
118124 Shield<SEXP> res (internal::Rcpp_eval_impl (call, R_GlobalEnv));
119- #endif
120125
121126 // check for condition results (errors, interrupts)
122127 if (Rf_inherits (res, " condition" )) {
@@ -125,12 +130,7 @@ inline SEXP Rcpp_eval(SEXP expr, SEXP env) {
125130
126131 Shield<SEXP> conditionMessageCall (::Rf_lang2 (::Rf_install (" conditionMessage" ), res));
127132
128- #if defined(RCPP_USE_UNWIND_PROTECT)
129- Shield<SEXP> conditionMessage (internal::Rcpp_eval_impl (conditionMessageCall,
130- R_GlobalEnv));
131- #else
132- Shield<SEXP> conditionMessage (::Rf_eval (conditionMessageCall, R_GlobalEnv));
133- #endif
133+ Shield<SEXP> conditionMessage (internal::Rcpp_eval_impl (conditionMessageCall, R_GlobalEnv));
134134 throw eval_error (CHAR (STRING_ELT (conditionMessage, 0 )));
135135 }
136136
0 commit comments