@@ -54,20 +54,34 @@ inline void set_option(SEXP name, SEXP value) {
5454 SETCAR (opt, value);
5555}
5656
57- inline Rboolean& get_should_unwind_protect () {
57+ inline Rboolean* setup_should_unwind_protect () {
5858 SEXP should_unwind_protect_sym = Rf_install (" cpp11_should_unwind_protect" );
5959 SEXP should_unwind_protect_sexp = Rf_GetOption1 (should_unwind_protect_sym);
60+
6061 if (should_unwind_protect_sexp == R_NilValue) {
62+ // Allocate and initialize once, then let R manage it.
63+ // That makes this a shared global across all compilation units.
6164 should_unwind_protect_sexp = PROTECT (Rf_allocVector (LGLSXP, 1 ));
65+ SET_LOGICAL_ELT (should_unwind_protect_sexp, 0 , TRUE );
6266 detail::set_option (should_unwind_protect_sym, should_unwind_protect_sexp);
6367 UNPROTECT (1 );
6468 }
6569
66- Rboolean* should_unwind_protect =
67- reinterpret_cast <Rboolean*>(LOGICAL (should_unwind_protect_sexp));
68- should_unwind_protect[0 ] = TRUE ;
70+ return reinterpret_cast <Rboolean*>(LOGICAL (should_unwind_protect_sexp));
71+ }
72+
73+ inline Rboolean* access_should_unwind_protect () {
74+ // Setup is run once per compilation unit, but all compilation units
75+ // share the same global option, so each compilation unit's static pointer
76+ // will point to the same object.
77+ static Rboolean* p_should_unwind_protect = setup_should_unwind_protect ();
78+ return p_should_unwind_protect;
79+ }
80+
81+ inline Rboolean get_should_unwind_protect () { return *access_should_unwind_protect (); }
6982
70- return should_unwind_protect[0 ];
83+ inline void set_should_unwind_protect (Rboolean should_unwind_protect) {
84+ *access_should_unwind_protect () = should_unwind_protect;
7185}
7286
7387} // namespace detail
@@ -80,12 +94,11 @@ inline Rboolean& get_should_unwind_protect() {
8094template <typename Fun, typename = typename std::enable_if<std::is_same<
8195 decltype (std::declval<Fun&&>()()), SEXP>::value>::type>
8296SEXP unwind_protect(Fun&& code) {
83- static auto should_unwind_protect = detail::get_should_unwind_protect ();
84- if (should_unwind_protect == FALSE ) {
97+ if (detail::get_should_unwind_protect () == FALSE ) {
8598 return std::forward<Fun>(code)();
8699 }
87100
88- should_unwind_protect = FALSE ;
101+ detail::set_should_unwind_protect ( FALSE ) ;
89102
90103 static SEXP token = [] {
91104 SEXP res = R_MakeUnwindCont ();
@@ -95,7 +108,7 @@ SEXP unwind_protect(Fun&& code) {
95108
96109 std::jmp_buf jmpbuf;
97110 if (setjmp (jmpbuf)) {
98- should_unwind_protect = TRUE ;
111+ detail::set_should_unwind_protect ( TRUE ) ;
99112 throw unwind_exception (token);
100113 }
101114
@@ -120,7 +133,7 @@ SEXP unwind_protect(Fun&& code) {
120133 // unset it here before returning the value ourselves.
121134 SETCAR (token, R_NilValue);
122135
123- should_unwind_protect = TRUE ;
136+ detail::set_should_unwind_protect ( TRUE ) ;
124137
125138 return res;
126139}
0 commit comments