diff --git a/.gitignore b/.gitignore index ee4d3997..f2639ad9 100644 --- a/.gitignore +++ b/.gitignore @@ -9,3 +9,4 @@ cpp11test/src/*.so compile_flags.txt inst/doc vignettes/*_cache +compile_commands.json diff --git a/cpp11test/src/protect.cpp b/cpp11test/src/protect.cpp index 230317dc..04ddf0ac 100644 --- a/cpp11test/src/protect.cpp +++ b/cpp11test/src/protect.cpp @@ -18,8 +18,8 @@ [[cpp11::register]] void protect_one_cpp11_(SEXP x, int n) { for (R_xlen_t i = 0; i < n; ++i) { - SEXP p = cpp11::protect_sexp(x); - cpp11::release_protect(p); + SEXP p = cpp11::preserved.insert(x); + cpp11::preserved.release(p); } } @@ -63,12 +63,12 @@ [[cpp11::register]] void protect_many_cpp11_(int n) { std::vector res; for (R_xlen_t i = 0; i < n; ++i) { - res.push_back(cpp11::protect_sexp(Rf_ScalarInteger(n))); + res.push_back(cpp11::preserved.insert(Rf_ScalarInteger(n))); } for (R_xlen_t i = n - 1; i >= 0; --i) { SEXP x = res[i]; - cpp11::release_protect(x); + cpp11::preserved.release(x); res.pop_back(); } } diff --git a/cpp11test/src/test-sexp.cpp b/cpp11test/src/test-sexp.cpp index 59c15de0..c41e1e41 100644 --- a/cpp11test/src/test-sexp.cpp +++ b/cpp11test/src/test-sexp.cpp @@ -15,6 +15,7 @@ context("sexp-C++") { expect_true(Rf_inherits(out, "data.frame")); } + test_that("scalar constructors work") { using namespace cpp11::literals; cpp11::writable::list out({ diff --git a/inst/include/cpp11/doubles.hpp b/inst/include/cpp11/doubles.hpp index be3e6fac..abfea8b2 100644 --- a/inst/include/cpp11/doubles.hpp +++ b/inst/include/cpp11/doubles.hpp @@ -79,7 +79,7 @@ template <> inline r_vector::r_vector(std::initializer_list il) : cpp11::r_vector(safe[Rf_allocVector](REALSXP, il.size())), capacity_(il.size()) { - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); int n_protected = 0; try { @@ -95,7 +95,7 @@ inline r_vector::r_vector(std::initializer_list il) UNPROTECT(n_protected); }); } catch (const unwind_exception& e) { - release_protect(protect_); + preserved.release(protect_); UNPROTECT(n_protected); throw e; } @@ -106,8 +106,8 @@ inline void r_vector::reserve(R_xlen_t new_capacity) { data_ = data_ == R_NilValue ? safe[Rf_allocVector](REALSXP, new_capacity) : safe[Rf_xlengthgets](data_, new_capacity); SEXP old_protect = protect_; - protect_ = protect_sexp(data_); - release_protect(old_protect); + protect_ = preserved.insert(data_); + preserved.release(old_protect); data_p_ = REAL(data_); capacity_ = new_capacity; diff --git a/inst/include/cpp11/integers.hpp b/inst/include/cpp11/integers.hpp index 59466378..87414c7e 100644 --- a/inst/include/cpp11/integers.hpp +++ b/inst/include/cpp11/integers.hpp @@ -9,7 +9,7 @@ #include "cpp11/as.hpp" // for as_sexp #include "cpp11/attribute_proxy.hpp" // for attribute_proxy #include "cpp11/named_arg.hpp" // for named_arg -#include "cpp11/protect.hpp" // for protect_sexp, release_protect +#include "cpp11/protect.hpp" // for preserved #include "cpp11/r_vector.hpp" // for r_vector, r_vector<>::proxy #include "cpp11/sexp.hpp" // for sexp @@ -83,10 +83,10 @@ inline void r_vector::reserve(R_xlen_t new_capacity) { SEXP old_protect = protect_; // Protect the new data - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); // Release the old protection; - release_protect(old_protect); + preserved.release(old_protect); data_p_ = INTEGER(data_); capacity_ = new_capacity; @@ -96,7 +96,7 @@ template <> inline r_vector::r_vector(std::initializer_list il) : cpp11::r_vector(safe[Rf_allocVector](INTSXP, il.size())), capacity_(il.size()) { - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); int n_protected = 0; try { @@ -112,7 +112,7 @@ inline r_vector::r_vector(std::initializer_list il) UNPROTECT(n_protected); }); } catch (const unwind_exception& e) { - release_protect(protect_); + preserved.release(protect_); UNPROTECT(n_protected); throw e; } diff --git a/inst/include/cpp11/list.hpp b/inst/include/cpp11/list.hpp index 0cf0bb85..43c6fc23 100644 --- a/inst/include/cpp11/list.hpp +++ b/inst/include/cpp11/list.hpp @@ -5,7 +5,7 @@ #include "cpp11/R.hpp" // for SEXP, SEXPREC, SET_VECTOR_ELT #include "cpp11/attribute_proxy.hpp" // for attribute_proxy #include "cpp11/named_arg.hpp" // for named_arg -#include "cpp11/protect.hpp" // for protect_sexp, release_protect +#include "cpp11/protect.hpp" // for preserved #include "cpp11/r_string.hpp" // for r_string #include "cpp11/r_vector.hpp" // for r_vector, r_vector<>::proxy #include "cpp11/sexp.hpp" // for sexp @@ -75,7 +75,7 @@ template <> inline r_vector::r_vector(std::initializer_list il) : cpp11::r_vector(safe[Rf_allocVector](VECSXP, il.size())), capacity_(il.size()) { - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); auto it = il.begin(); for (R_xlen_t i = 0; i < capacity_; ++i, ++it) { SET_VECTOR_ELT(data_, i, *it); @@ -86,7 +86,7 @@ template <> inline r_vector::r_vector(std::initializer_list il) : cpp11::r_vector(safe[Rf_allocVector](VECSXP, il.size())), capacity_(il.size()) { - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); int n_protected = 0; try { @@ -102,7 +102,7 @@ inline r_vector::r_vector(std::initializer_list il) UNPROTECT(n_protected); }); } catch (const unwind_exception& e) { - release_protect(protect_); + preserved.release(protect_); UNPROTECT(n_protected); throw e; } @@ -114,8 +114,8 @@ inline void r_vector::reserve(R_xlen_t new_capacity) { : safe[Rf_xlengthgets](data_, new_capacity); SEXP old_protect = protect_; - protect_ = protect_sexp(data_); - release_protect(old_protect); + protect_ = preserved.insert(data_); + preserved.release(old_protect); capacity_ = new_capacity; } diff --git a/inst/include/cpp11/logicals.hpp b/inst/include/cpp11/logicals.hpp index b82db60b..e1c66ff0 100644 --- a/inst/include/cpp11/logicals.hpp +++ b/inst/include/cpp11/logicals.hpp @@ -7,7 +7,7 @@ #include "cpp11/R.hpp" // for Rboolean, SEXP, SEXPREC, Rf_all... #include "cpp11/attribute_proxy.hpp" // for attribute_proxy #include "cpp11/named_arg.hpp" // for named_arg -#include "cpp11/protect.hpp" // for protect_sexp, release_protect +#include "cpp11/protect.hpp" // for preserved #include "cpp11/r_vector.hpp" // for r_vector, r_vector<>::proxy #include "cpp11/sexp.hpp" // for sexp @@ -71,7 +71,7 @@ inline r_vector::proxy::operator Rboolean() const { template <> inline r_vector::r_vector(std::initializer_list il) : cpp11::r_vector(Rf_allocVector(LGLSXP, il.size())), capacity_(il.size()) { - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); auto it = il.begin(); for (R_xlen_t i = 0; i < capacity_; ++i, ++it) { SET_LOGICAL_ELT(data_, i, *it); @@ -82,7 +82,7 @@ template <> inline r_vector::r_vector(std::initializer_list il) : cpp11::r_vector(safe[Rf_allocVector](LGLSXP, il.size())), capacity_(il.size()) { - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); int n_protected = 0; try { @@ -98,7 +98,7 @@ inline r_vector::r_vector(std::initializer_list il) UNPROTECT(n_protected); }); } catch (const unwind_exception& e) { - release_protect(protect_); + preserved.release(protect_); UNPROTECT(n_protected); throw e; } @@ -109,9 +109,9 @@ inline void r_vector::reserve(R_xlen_t new_capacity) { data_ = data_ == R_NilValue ? safe[Rf_allocVector](LGLSXP, new_capacity) : safe[Rf_xlengthgets](data_, new_capacity); SEXP old_protect = protect_; - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); - release_protect(old_protect); + preserved.release(old_protect); data_p_ = reinterpret_cast(LOGICAL(data_)); capacity_ = new_capacity; diff --git a/inst/include/cpp11/protect.hpp b/inst/include/cpp11/protect.hpp index fe5f8aa4..4f50995e 100644 --- a/inst/include/cpp11/protect.hpp +++ b/inst/include/cpp11/protect.hpp @@ -25,82 +25,6 @@ class unwind_exception : public std::exception { unwind_exception(SEXP token_) : token(token_) {} }; -static SEXP preserve(SEXP obj) { - PROTECT(obj); - R_PreserveObject(obj); - UNPROTECT(1); - return obj; -} - -static SEXP protect_list = preserve(Rf_cons(R_NilValue, R_NilValue)); - -inline SEXP protect_sexp(SEXP obj) { - if (obj == R_NilValue) { - return R_NilValue; - } -#ifdef CPP11_USE_PRESERVE_OBJECT - R_PreserveObject(obj); - return obj; -#endif - PROTECT(obj); - - // Add a new cell that points to the previous end. - SEXP cell = PROTECT(Rf_cons(protect_list, CDR(protect_list))); - SET_TAG(cell, obj); - - SETCDR(protect_list, cell); - if (CDR(cell) != R_NilValue) { - SETCAR(CDR(cell), cell); - } - - UNPROTECT(2); - - return cell; -} - -inline void print_protect() { - SEXP head = protect_list; - while (head != R_NilValue) { - REprintf("%x CAR: %x CDR: %x TAG: %x\n", head, CAR(head), CDR(head), TAG(head)); - head = CDR(head); - } - REprintf("---\n"); -} - -/* This is currently unused, but client packages could use it to free leaked resources in - * older R versions if needed */ -inline void release_existing_protections() { -#if !defined(CPP11_USE_PRESERVE_OBJECT) - SEXP first = CDR(protect_list); - if (first != R_NilValue) { - SETCAR(first, R_NilValue); - SETCDR(protect_list, R_NilValue); - } -#endif -} - -inline void release_protect(SEXP protect) { - if (protect == R_NilValue) { - return; - } -#ifdef CPP11_USE_PRESERVE_OBJECT - R_ReleaseObject(protect); - return; -#endif - - SEXP before = CAR(protect); - SEXP after = CDR(protect); - - if (before == R_NilValue && after == R_NilValue) { - Rf_error("should never happen"); - } - - SETCDR(before, after); - if (after != R_NilValue) { - SETCAR(after, before); - } -} - #ifdef HAS_UNWIND_PROTECT namespace internal { @@ -279,4 +203,144 @@ void warning(const std::string& fmt, Args... args) { safe[Rf_warning](fmt.c_str(), args...); } +/// A doubly-linked list of preserved objects, allowing O(1) insertion/release of +/// objects compared to O(N preserved) with R_PreserveObject. +static struct { + SEXP insert(SEXP obj) { + if (obj == R_NilValue) { + return R_NilValue; + } + +#ifdef CPP11_USE_PRESERVE_OBJECT + PROTECT(obj); + R_PreserveObject(obj); + UNPROTECT(1); + return obj; +#endif + + PROTECT(obj); + + // Add a new cell that points to the previous end. + SEXP cell = PROTECT(Rf_cons(list_, CDR(list_))); + + SET_TAG(cell, obj); + + SETCDR(list_, cell); + + if (CDR(cell) != R_NilValue) { + SETCAR(CDR(cell), cell); + } + + UNPROTECT(2); + + return cell; + } + + void print() { + for (SEXP head = list_; head != R_NilValue; head = CDR(head)) { + REprintf("%x CAR: %x CDR: %x TAG: %x\n", head, CAR(head), CDR(head), TAG(head)); + } + REprintf("---\n"); + } + + // This is currently unused, but client packages could use it to free leaked resources + // in older R versions if needed + void release_all() { +#if !defined(CPP11_USE_PRESERVE_OBJECT) + SEXP first = CDR(list_); + if (first != R_NilValue) { + SETCAR(first, R_NilValue); + SETCDR(list_, R_NilValue); + } +#endif + } + + void release(SEXP token) { + if (token == R_NilValue) { + return; + } + +#ifdef CPP11_USE_PRESERVE_OBJECT + R_ReleaseObject(token); + return; +#endif + + SEXP before = CAR(token); + + SEXP after = CDR(token); + + if (before == R_NilValue && after == R_NilValue) { + Rf_error("should never happen"); + } + + SETCDR(before, after); + + if (after != R_NilValue) { + SETCAR(after, before); + } + } + + private: + // We deliberately avoid using safe[] in the below code, as this code runs + // when the shared library is loaded and will not be wrapped by + // `CPP11_UNWIND`, so if an error occurs we will not catch the C++ exception + // that safe emits. + static void set_option(SEXP name, SEXP value) { + SEXP opt = SYMVALUE(Rf_install(".Options")); + SEXP t = opt; + while (CDR(t) != R_NilValue) { + t = CDR(t); + } + SETCDR(t, Rf_allocList(1)); + opt = CDR(t); + SET_TAG(opt, name); + SETCAR(opt, value); + } + + static SEXP new_environment() { + SEXP new_env_sym = Rf_install("new.env"); + SEXP new_env_fun = Rf_findFun(new_env_sym, R_BaseEnv); + SEXP call = PROTECT(Rf_allocVector(LANGSXP, 1)); + SETCAR(call, new_env_fun); + SEXP res = Rf_eval(call, R_GlobalEnv); + UNPROTECT(1); + return res; + } + + // The preserve_env singleton is stored in an environment within an R global option. + // + // It is not constructed as a static variable directly since many + // translation units may be compiled, resulting in unrelated instances of each + // static variable. + // + // We cannot store it in the cpp11 namespace, as cpp11 likely will not be loaded by + // packages. + // We cannot store it in R's global environment, as that is against CRAN + // policies. + // We need to use a environment as option() and getOption duplicates their + // values, and duplicating the preserve pairlist causes the protection stack to + // overflow. + static SEXP get_preserve_env() { + static SEXP preserve_env = R_NilValue; + + if (preserve_env == R_NilValue) { + SEXP preserve_env_sym = Rf_install("cpp11_preserve_env"); + + preserve_env = Rf_GetOption1(preserve_env_sym); + + if (preserve_env == R_NilValue) { + preserve_env = new_environment(); + + SEXP preserve_list_sym = Rf_install("cpp11_preserve_list"); + Rf_defineVar(preserve_list_sym, Rf_cons(R_NilValue, R_NilValue), preserve_env); + set_option(preserve_env_sym, preserve_env); + } + } + + return preserve_env; + } + + SEXP list_ = Rf_findVarInFrame(get_preserve_env(), Rf_install("cpp11_preserve_list")); +} preserved; + } // namespace cpp11 diff --git a/inst/include/cpp11/r_vector.hpp b/inst/include/cpp11/r_vector.hpp index 3912e48e..628fe2b9 100644 --- a/inst/include/cpp11/r_vector.hpp +++ b/inst/include/cpp11/r_vector.hpp @@ -15,7 +15,7 @@ #include "cpp11/R.hpp" // for R_xlen_t, SEXP, SEXPREC, Rf_xle... #include "cpp11/attribute_proxy.hpp" // for attribute_proxy -#include "cpp11/protect.hpp" // for protect_sexp, release_protect +#include "cpp11/protect.hpp" // for preserved #include "cpp11/r_string.hpp" // for r_string #include "cpp11/sexp.hpp" // for sexp @@ -80,12 +80,12 @@ class r_vector { SEXP old_protect = protect_; data_ = rhs.data_; - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); is_altrep_ = rhs.is_altrep_; data_p_ = rhs.data_p_; length_ = rhs.length_; - release_protect(old_protect); + preserved.release(old_protect); return *this; }; @@ -94,12 +94,12 @@ class r_vector { SEXP old_protect = protect_; data_ = rhs.data_; - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); is_altrep_ = rhs.is_altrep_; data_p_ = rhs.data_p_; length_ = rhs.length_; - release_protect(old_protect); + preserved.release(old_protect); }; bool is_altrep() const; @@ -178,7 +178,7 @@ class r_vector { const_iterator find(const r_string& name) const; - ~r_vector() { release_protect(protect_); } + ~r_vector() { preserved.release(protect_); } private: SEXP data_ = R_NilValue; @@ -359,7 +359,7 @@ class r_vector : public cpp11::r_vector { template inline r_vector::r_vector(const SEXP data) : data_(valid_type(data)), - protect_(protect_sexp(data)), + protect_(preserved.insert(data)), is_altrep_(ALTREP(data)), data_p_(get_p(ALTREP(data), data)), length_(Rf_xlength(data)) {} @@ -367,7 +367,7 @@ inline r_vector::r_vector(const SEXP data) template inline r_vector::r_vector(const SEXP data, bool is_altrep) : data_(valid_type(data)), - protect_(protect_sexp(data)), + protect_(preserved.insert(data)), is_altrep_(is_altrep), data_p_(get_p(is_altrep, data)), length_(Rf_xlength(data)) {} @@ -630,23 +630,23 @@ inline typename r_vector::iterator r_vector::end() const { template inline r_vector::r_vector(const SEXP& data) : cpp11::r_vector(safe[Rf_shallow_duplicate](data)), - protect_(protect_sexp(data_)), + protect_(preserved.insert(data_)), capacity_(length_) {} template inline r_vector::r_vector(const SEXP& data, bool is_altrep) : cpp11::r_vector(safe[Rf_shallow_duplicate](data), is_altrep), - protect_(protect_sexp(data_)), + protect_(preserved.insert(data_)), capacity_(length_) {} template inline r_vector::r_vector(SEXP&& data) - : cpp11::r_vector(data), protect_(protect_sexp(data_)), capacity_(length_) {} + : cpp11::r_vector(data), protect_(preserved.insert(data_)), capacity_(length_) {} template inline r_vector::r_vector(SEXP&& data, bool is_altrep) : cpp11::r_vector(data, is_altrep), - protect_(protect_sexp(data_)), + protect_(preserved.insert(data_)), capacity_(length_) {} template @@ -678,7 +678,7 @@ inline r_vector::r_vector(R_xlen_t size) : r_vector() { template inline r_vector::~r_vector() { - release_protect(protect_); + preserved.release(protect_); } #ifdef LONG_VECTOR_SUPPORT @@ -761,12 +761,14 @@ inline typename r_vector::iterator r_vector::find(const r_string& name) co template inline r_vector::r_vector(const r_vector& rhs) : cpp11::r_vector(safe[Rf_shallow_duplicate](rhs)), - protect_(protect_sexp(data_)), + protect_(preserved.insert(data_)), capacity_(rhs.capacity_) {} template inline r_vector::r_vector(r_vector&& rhs) - : cpp11::r_vector(rhs), protect_(protect_sexp(data_)), capacity_(rhs.capacity_) { + : cpp11::r_vector(rhs), + protect_(preserved.insert(data_)), + capacity_(rhs.capacity_) { rhs.data_ = R_NilValue; rhs.protect_ = R_NilValue; } @@ -774,7 +776,7 @@ inline r_vector::r_vector(r_vector&& rhs) template inline r_vector::r_vector(const cpp11::r_vector& rhs) : cpp11::r_vector(safe[Rf_shallow_duplicate](rhs)), - protect_(protect_sexp(data_)), + protect_(preserved.insert(data_)), capacity_(rhs.length_) {} // We don't release the old object until the end in case we throw an exception @@ -790,9 +792,9 @@ inline r_vector& r_vector::operator=(const r_vector& rhs) { auto old_protect = protect_; data_ = safe[Rf_shallow_duplicate](rhs.data_); - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); - release_protect(old_protect); + preserved.release(old_protect); capacity_ = rhs.capacity_; @@ -810,9 +812,9 @@ inline r_vector& r_vector::operator=(r_vector&& rhs) { SEXP old_protect = protect_; data_ = rhs.data_; - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); - release_protect(old_protect); + preserved.release(old_protect); capacity_ = rhs.capacity_; diff --git a/inst/include/cpp11/raws.hpp b/inst/include/cpp11/raws.hpp index 6d9e0cba..ce82a541 100644 --- a/inst/include/cpp11/raws.hpp +++ b/inst/include/cpp11/raws.hpp @@ -8,7 +8,7 @@ #include "cpp11/R.hpp" // for RAW, SEXP, SEXPREC, Rf_allocVector #include "cpp11/attribute_proxy.hpp" // for attribute_proxy #include "cpp11/named_arg.hpp" // for named_arg -#include "cpp11/protect.hpp" // for protect_sexp, release_protect +#include "cpp11/protect.hpp" // for preserved #include "cpp11/r_vector.hpp" // for r_vector, r_vector<>::proxy #include "cpp11/sexp.hpp" // for sexp @@ -78,7 +78,7 @@ template <> inline r_vector::r_vector(std::initializer_list il) : cpp11::r_vector(safe[Rf_allocVector](RAWSXP, il.size())), capacity_(il.size()) { - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); auto it = il.begin(); for (R_xlen_t i = 0; i < capacity_; ++i, ++it) { data_p_[i] = *it; @@ -89,7 +89,7 @@ template <> inline r_vector::r_vector(std::initializer_list il) : cpp11::r_vector(safe[Rf_allocVector](RAWSXP, il.size())), capacity_(il.size()) { - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); int n_protected = 0; try { @@ -106,7 +106,7 @@ inline r_vector::r_vector(std::initializer_list il) UNPROTECT(n_protected); }); } catch (const unwind_exception& e) { - release_protect(protect_); + preserved.release(protect_); UNPROTECT(n_protected); throw e; } @@ -118,8 +118,8 @@ inline void r_vector::reserve(R_xlen_t new_capacity) { : safe[Rf_xlengthgets](data_, new_capacity); SEXP old_protect = protect_; - protect_ = protect_sexp(data_); - release_protect(old_protect); + protect_ = preserved.insert(data_); + preserved.release(old_protect); data_p_ = reinterpret_cast(RAW(data_)); capacity_ = new_capacity; diff --git a/inst/include/cpp11/sexp.hpp b/inst/include/cpp11/sexp.hpp index 73d59bd8..1517c5af 100644 --- a/inst/include/cpp11/sexp.hpp +++ b/inst/include/cpp11/sexp.hpp @@ -6,7 +6,7 @@ #include "cpp11/R.hpp" // for SEXP, SEXPREC, REAL_ELT, R_NilV... #include "cpp11/attribute_proxy.hpp" // for attribute_proxy -#include "cpp11/protect.hpp" // for protect_sexp, release_protect +#include "cpp11/protect.hpp" // for preserved namespace cpp11 { @@ -14,31 +14,37 @@ namespace cpp11 { class sexp { private: SEXP data_ = R_NilValue; - SEXP protect_ = R_NilValue; + SEXP preserve_token_ = R_NilValue; public: sexp() = default; - sexp(SEXP data) : data_(data), protect_(protect_sexp(data_)) { - // REprintf("created %x %x : %i\n", data_, protect_, protect_head_size()); + + sexp(SEXP data) : data_(data), preserve_token_(preserved.insert(data_)) { + // REprintf("created %x %x : %i\n", data_, preserve_token_, protect_head_size()); } + sexp(const sexp& rhs) { data_ = rhs.data_; - protect_ = protect_sexp(data_); - // REprintf("copied %x new protect %x : %i\n", rhs.data_, protect_, + preserve_token_ = preserved.insert(data_); + // REprintf("copied %x new protect %x : %i\n", rhs.data_, preserve_token_, // protect_head_size()); } + sexp(sexp&& rhs) { data_ = rhs.data_; - protect_ = rhs.protect_; + preserve_token_ = rhs.preserve_token_; rhs.data_ = R_NilValue; - rhs.protect_ = R_NilValue; + rhs.preserve_token_ = R_NilValue; // REprintf("moved %x : %i\n", rhs.data_, protect_head_size()); } + sexp& operator=(const sexp& rhs) { + preserved.release(preserve_token_); + data_ = rhs.data_; - protect_ = protect_sexp(data_); + preserve_token_ = preserved.insert(data_); // REprintf("assigned %x : %i\n", rhs.data_, protect_head_size()); return *this; } @@ -49,7 +55,7 @@ class sexp { //*this = tmp; //} - ~sexp() { release_protect(protect_); } + ~sexp() { preserved.release(preserve_token_); } attribute_proxy attr(const char* name) const { return attribute_proxy(*this, name); diff --git a/inst/include/cpp11/strings.hpp b/inst/include/cpp11/strings.hpp index 4614017f..311abe9c 100644 --- a/inst/include/cpp11/strings.hpp +++ b/inst/include/cpp11/strings.hpp @@ -7,7 +7,7 @@ #include "cpp11/as.hpp" // for as_sexp #include "cpp11/attribute_proxy.hpp" // for attribute_proxy #include "cpp11/named_arg.hpp" // for named_arg -#include "cpp11/protect.hpp" // for protect_sexp, unwind_protect +#include "cpp11/protect.hpp" // for preserved #include "cpp11/r_string.hpp" // for r_string #include "cpp11/r_vector.hpp" // for r_vector, r_vector<>::proxy #include "cpp11/sexp.hpp" // for sexp @@ -91,7 +91,7 @@ inline SEXP alloc_if_charsxp(const SEXP data) { template <> inline r_vector::r_vector(const SEXP& data) : cpp11::r_vector(alloc_or_copy(data)), - protect_(protect_sexp(data_)), + protect_(preserved.insert(data_)), capacity_(length_) { if (TYPEOF(data) == CHARSXP) { SET_STRING_ELT(data_, 0, data); @@ -101,7 +101,7 @@ inline r_vector::r_vector(const SEXP& data) template <> inline r_vector::r_vector(SEXP&& data) : cpp11::r_vector(alloc_if_charsxp(data)), - protect_(protect_sexp(data_)), + protect_(preserved.insert(data_)), capacity_(length_) { if (TYPEOF(data) == CHARSXP) { SET_STRING_ELT(data_, 0, data); @@ -124,7 +124,7 @@ template <> inline r_vector::r_vector(std::initializer_list il) : cpp11::r_vector(safe[Rf_allocVector](STRSXP, il.size())), capacity_(il.size()) { - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); int n_protected = 0; try { @@ -140,7 +140,7 @@ inline r_vector::r_vector(std::initializer_list il) UNPROTECT(n_protected); }); } catch (const unwind_exception& e) { - release_protect(protect_); + preserved.release(protect_); UNPROTECT(n_protected); throw e; } @@ -152,8 +152,8 @@ inline void r_vector::reserve(R_xlen_t new_capacity) { : safe[Rf_xlengthgets](data_, new_capacity); SEXP old_protect = protect_; - protect_ = protect_sexp(data_); - release_protect(old_protect); + protect_ = preserved.insert(data_); + preserved.release(old_protect); capacity_ = new_capacity; } diff --git a/tests/testthat/test-source.R b/tests/testthat/test-source.R index 1bb3c4c8..ef0d1b3b 100644 --- a/tests/testthat/test-source.R +++ b/tests/testthat/test-source.R @@ -15,9 +15,9 @@ test_that("cpp_source works with the `code` parameter", { return total; } ', clean = TRUE) - on.exit(dyn.unload(dll_info[["path"]])) + on.exit(dyn.unload(dll_info[["path"]])) - expect_equal(num_odd(as.integer(c(1:10, 15, 23))), 7) + expect_equal(num_odd(as.integer(c(1:10, 15, 23))), 7) }) test_that("cpp_source works with the `file` parameter", { diff --git a/vignettes/internals.Rmd b/vignettes/internals.Rmd index 3dfba0b3..c7b1649c 100644 --- a/vignettes/internals.Rmd +++ b/vignettes/internals.Rmd @@ -115,8 +115,8 @@ cpp11 uses an idea proposed by [Luke Tierney](https://github.com/RcppCore/Rcpp/i Each node in the list uses the head (`CAR`) part to point to the previous node, and the `CDR` part to point to the next node. The `TAG` is used to point to the object being protected. The head and tail of the list have `R_NilValue` as their `CAR` and `CDR` pointers respectively. -Calling `protect_sexp()` with a regular R object will add a new node to the list and return a protect token corresponding to the node added. -Calling `release_protect()` on this returned token will release the protection by unlinking the node from the linked list. +Calling `preserved.insert()` with a regular R object will add a new node to the list and return a protect token corresponding to the node added. +Calling `preserved.release()` on this returned token will release the protection by unlinking the node from the linked list. This scheme scales in O(1) time to release or insert an object vs O(N) or worse time with `R_PreserveObject()` / `R_ReleaseObject()`. @@ -146,5 +146,5 @@ None of these options is perfect, here are some pros and cons for each. 3. Was ruled out partially because the implementation would be somewhat tricky and more because performance would suffer greatly. 4. is what we now do in cpp11. It leaks protected objects when there are R API errors. -If packages are concerned about the leaked memory they can call `cpp11::release_existing_protections()` as needed to release the current protections for all objects managed by cpp11. +If packages are concerned about the leaked memory they can call `cpp11::preserved.release_all()` as needed to release the current protections for all objects managed by cpp11. This is not done automatically because in some cases the protections should persist beyond the `.Call()` boundry, e.g. in vroom altrep objects for example.