diff --git a/NEWS.md b/NEWS.md index b74b84c3..ada3a2be 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # cpp11 (development version) +* Fixed a performance issue related to nested `unwind_protect()` calls (#298). + * Minor performance improvements to the cpp11 protect code. (@kevinushey) * Silenced an unknown attribute warning specific to the Intel compiler diff --git a/inst/include/cpp11/protect.hpp b/inst/include/cpp11/protect.hpp index 2948b494..acab13d6 100644 --- a/inst/include/cpp11/protect.hpp +++ b/inst/include/cpp11/protect.hpp @@ -54,20 +54,34 @@ inline void set_option(SEXP name, SEXP value) { SETCAR(opt, value); } -inline Rboolean& get_should_unwind_protect() { +inline Rboolean* setup_should_unwind_protect() { SEXP should_unwind_protect_sym = Rf_install("cpp11_should_unwind_protect"); SEXP should_unwind_protect_sexp = Rf_GetOption1(should_unwind_protect_sym); + if (should_unwind_protect_sexp == R_NilValue) { + // Allocate and initialize once, then let R manage it. + // That makes this a shared global across all compilation units. should_unwind_protect_sexp = PROTECT(Rf_allocVector(LGLSXP, 1)); + SET_LOGICAL_ELT(should_unwind_protect_sexp, 0, TRUE); detail::set_option(should_unwind_protect_sym, should_unwind_protect_sexp); UNPROTECT(1); } - Rboolean* should_unwind_protect = - reinterpret_cast(LOGICAL(should_unwind_protect_sexp)); - should_unwind_protect[0] = TRUE; + return reinterpret_cast(LOGICAL(should_unwind_protect_sexp)); +} + +inline Rboolean* access_should_unwind_protect() { + // Setup is run once per compilation unit, but all compilation units + // share the same global option, so each compilation unit's static pointer + // will point to the same object. + static Rboolean* p_should_unwind_protect = setup_should_unwind_protect(); + return p_should_unwind_protect; +} + +inline Rboolean get_should_unwind_protect() { return *access_should_unwind_protect(); } - return should_unwind_protect[0]; +inline void set_should_unwind_protect(Rboolean should_unwind_protect) { + *access_should_unwind_protect() = should_unwind_protect; } } // namespace detail @@ -80,12 +94,11 @@ inline Rboolean& get_should_unwind_protect() { template ()()), SEXP>::value>::type> SEXP unwind_protect(Fun&& code) { - static auto should_unwind_protect = detail::get_should_unwind_protect(); - if (should_unwind_protect == FALSE) { + if (detail::get_should_unwind_protect() == FALSE) { return std::forward(code)(); } - should_unwind_protect = FALSE; + detail::set_should_unwind_protect(FALSE); static SEXP token = [] { SEXP res = R_MakeUnwindCont(); @@ -95,7 +108,7 @@ SEXP unwind_protect(Fun&& code) { std::jmp_buf jmpbuf; if (setjmp(jmpbuf)) { - should_unwind_protect = TRUE; + detail::set_should_unwind_protect(TRUE); throw unwind_exception(token); } @@ -120,7 +133,7 @@ SEXP unwind_protect(Fun&& code) { // unset it here before returning the value ourselves. SETCAR(token, R_NilValue); - should_unwind_protect = TRUE; + detail::set_should_unwind_protect(TRUE); return res; }