Skip to content

Commit 519909c

Browse files
eddelbuetteleddelbuettel
committed
first pass at 'precious_{preserve,remove}'
with thanks to @ltierney for the report in #1081 as well as a suggested alternative this branch reworks his idea somewhat to better fit how Rcpp sets itself up
1 parent c260499 commit 519909c

File tree

7 files changed

+107
-28
lines changed

7 files changed

+107
-28
lines changed

‎inst/include/Rcpp/exceptions.h

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -148,7 +148,8 @@ inline void resumeJump(SEXP token) {
148148
if (isLongjumpSentinel(token)) {
149149
token = getLongjumpToken(token);
150150
}
151-
::R_ReleaseObject(token);
151+
//::R_ReleaseObject(token);
152+
Rcpp_precious_remove(token);
152153
#if (defined(R_VERSION) && R_VERSION >= R_Version(3, 5, 0))
153154
::R_ContinueUnwind(token);
154155
#endif // #nocov end

‎inst/include/Rcpp/routines.h

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,11 @@ namespace Rcpp{
3838
}
3939
double mktime00(struct tm &);
4040
struct tm * gmtime_(const time_t * const);
41+
42+
void Rcpp_precious_init();
43+
void Rcpp_precious_teardown();
44+
void Rcpp_precious_preserve(SEXP object);
45+
void Rcpp_precious_remove(SEXP object);
4146
}
4247

4348
SEXP rcpp_get_stack_trace();
@@ -127,6 +132,27 @@ namespace Rcpp {
127132
return fun(x);
128133
}
129134

135+
inline attribute_hidden void Rcpp_precious_init() {
136+
typedef int (*Fun)(void);
137+
static Fun fun = GET_CALLABLE("Rcpp_precious_init");
138+
fun();
139+
}
140+
inline attribute_hidden void Rcpp_precious_teardown() {
141+
typedef int (*Fun)(void);
142+
static Fun fun = GET_CALLABLE("Rcpp_precious_teardown");
143+
fun();
144+
}
145+
inline attribute_hidden void Rcpp_precious_preserve(SEXP object) {
146+
typedef const char* (*Fun)(SEXP);
147+
static Fun fun = GET_CALLABLE("Rcpp_precious_preserve");
148+
fun(object);
149+
}
150+
inline attribute_hidden void Rcpp_precious_remove(SEXP object) {
151+
typedef const char* (*Fun)(SEXP);
152+
static Fun fun = GET_CALLABLE("Rcpp_precious_remove");
153+
fun(object);
154+
}
155+
130156
}
131157

132158
// The 'attribute_hidden' used here is a simple precessor defined from

‎inst/include/Rcpp/traits/named_object.h

Lines changed: 7 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -42,15 +42,19 @@ template <> class named_object<SEXP> {
4242
public: // #nocov start
4343
named_object( const std::string& name_, const SEXP& o_):
4444
name(name_), object(o_) {
45-
R_PreserveObject(object);
45+
//R_PreserveObject(object);
46+
Rcpp_precious_preserve(object);
4647
}
4748

4849
named_object( const named_object<SEXP>& other ) :
4950
name(other.name), object(other.object) {
50-
R_PreserveObject(object);
51+
//R_PreserveObject(object);
52+
Rcpp_precious_preserve(object);
5153
}
5254
~named_object() {
53-
R_ReleaseObject(object);
55+
//R_ReleaseObject(object);
56+
Rcpp_precious_remove(object);
57+
5458
} // #nocov end
5559
const std::string& name;
5660
SEXP object;

‎inst/include/Rcpp/unwindProtect.h

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -64,7 +64,8 @@ inline SEXP unwindProtect(SEXP (*callback)(void* data), void* data) {
6464
// in C++ destructors. Can't use PROTECT() for this because
6565
// UNPROTECT() might be called in a destructor, for instance if a
6666
// Shield<SEXP> is on the stack.
67-
::R_PreserveObject(token);
67+
//::R_PreserveObject(token);
68+
Rcpp::Rcpp_precious_preserve(token);
6869

6970
throw LongjumpException(token);
7071
}

‎inst/include/RcppCommon.h

Lines changed: 19 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -77,6 +77,9 @@ namespace Rcpp {
7777
SEXP Rcpp_fast_eval(SEXP expr_, SEXP env);
7878
SEXP Rcpp_eval(SEXP expr_, SEXP env = R_GlobalEnv);
7979

80+
void Rcpp_precious_preserve(SEXP object);
81+
void Rcpp_precious_remove(SEXP object);
82+
8083
namespace internal {
8184
SEXP Rcpp_eval_impl(SEXP expr, SEXP env);
8285
}
@@ -87,17 +90,24 @@ namespace Rcpp {
8790
template <typename T> class named_object;
8891
}
8992

90-
inline SEXP Rcpp_PreserveObject(SEXP x) {
91-
if (x != R_NilValue) {
92-
R_PreserveObject(x);
93-
}
94-
return x;
93+
// inline SEXP Rcpp_PreserveObject(SEXP x) {
94+
// if (x != R_NilValue) {
95+
// R_PreserveObject(x);
96+
// }
97+
// return x;
98+
// }
99+
inline SEXP Rcpp_PreserveObject(SEXP object) {
100+
Rcpp_precious_preserve(object);
101+
return object;
95102
}
96103

97-
inline void Rcpp_ReleaseObject(SEXP x) {
98-
if (x != R_NilValue) {
99-
R_ReleaseObject(x);
100-
}
104+
// inline void Rcpp_ReleaseObject(SEXP x) {
105+
// if (x != R_NilValue) {
106+
// R_ReleaseObject(x);
107+
// }
108+
// }
109+
inline void Rcpp_ReleaseObject(SEXP object) {
110+
Rcpp_precious_remove(object);
101111
}
102112

103113
inline SEXP Rcpp_ReplaceObject(SEXP x, SEXP y) {

‎src/barrier.cpp

Lines changed: 37 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,6 @@
1-
// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 4 -*-
2-
//
31
// barrier.cpp: Rcpp R/C++ interface class library -- write barrier
42
//
5-
// Copyright (C) 2010 - 2019 Dirk Eddelbuettel and Romain Francois
3+
// Copyright (C) 2010 - 2020 Dirk Eddelbuettel and Romain Francois
64
//
75
// This file is part of Rcpp.
86
//
@@ -88,6 +86,42 @@ static SEXP Rcpp_cache = R_NilValue;
8886
#define RCPP_HASH_CACHE_INITIAL_SIZE 1024
8987
#endif
9088

89+
namespace Rcpp {
90+
static SEXP Rcpp_precious = R_NilValue;
91+
// [[Rcpp::register]]
92+
void Rcpp_precious_init() {
93+
Rcpp_precious = CONS(R_NilValue,R_NilValue);// set up
94+
R_PreserveObject(Rcpp_precious); // and protect
95+
}
96+
// [[Rcpp::register]]
97+
void Rcpp_precious_teardown() {
98+
R_ReleaseObject(Rcpp_precious); // release resource
99+
}
100+
// [[Rcpp::register]]
101+
void Rcpp_precious_preserve(SEXP object) {
102+
SETCDR(Rcpp_precious, CONS(object, CDR(Rcpp_precious)));
103+
}
104+
SEXP DeleteFromList(SEXP object, SEXP list) {
105+
if (CAR(list) == object)
106+
return CDR(list);
107+
else {
108+
SEXP last = list;
109+
for (SEXP head = CDR(list); head != R_NilValue; head = CDR(head)) {
110+
if (CAR(head) == object) {
111+
SETCDR(last, CDR(head));
112+
return list;
113+
}
114+
else last = head;
115+
}
116+
return list;
117+
}
118+
}
119+
// [[Rcpp::register]]
120+
void Rcpp_precious_remove(SEXP object) {
121+
SETCDR(Rcpp_precious, DeleteFromList(object, CDR(Rcpp_precious)));
122+
}
123+
}
124+
91125
// only used for debugging
92126
SEXP get_rcpp_cache() {
93127
if (! Rcpp_cache_know) {

‎src/rcpp_init.cpp

Lines changed: 14 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,6 @@
1-
// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*-
2-
//
31
// Rcpp_init.cpp : Rcpp R/C++ interface class library -- Initialize and register
42
//
5-
// Copyright (C) 2010 - 2017 John Chambers, Dirk Eddelbuettel and Romain Francois
3+
// Copyright (C) 2010 - 2020 John Chambers, Dirk Eddelbuettel and Romain Francois
64
//
75
// This file is part of Rcpp.
86
//
@@ -121,22 +119,27 @@ void registerFunctions(){
121119
RCPP_REGISTER(error_occured)
122120
RCPP_REGISTER(rcpp_get_current_error)
123121
// RCPP_REGISTER(print)
122+
RCPP_REGISTER(Rcpp_precious_init)
123+
RCPP_REGISTER(Rcpp_precious_teardown)
124+
RCPP_REGISTER(Rcpp_precious_preserve)
125+
RCPP_REGISTER(Rcpp_precious_remove)
124126
#undef RCPP_REGISTER
125127
}
126128

127-
128-
extern "C" void R_unload_Rcpp(DllInfo *) { // #nocov start
129-
// Release resources
130-
} // #nocov end
129+
extern "C" void R_unload_Rcpp(DllInfo *) { // #nocov start
130+
Rcpp::Rcpp_precious_teardown(); // release resource
131+
} // #nocov end
131132

132133
extern "C" void R_init_Rcpp(DllInfo* dllinfo) {
133134
setCurrentScope(0);
134135

135-
registerFunctions(); // call wrapper to register export symbols
136+
registerFunctions(); // call wrapper to register export symbols
137+
138+
R_useDynamicSymbols(dllinfo, FALSE); // set up symbol symbol lookup (cf R 3.4.0)
136139

137-
R_useDynamicSymbols(dllinfo, FALSE); // set up symbol symbol lookup (cf R 3.4.0)
140+
init_Rcpp_cache(); // init the cache
138141

139-
init_Rcpp_cache(); // init the cache
142+
Rcpp::Rcpp_precious_init();
140143

141-
init_Rcpp_routines(dllinfo); // init routines
144+
init_Rcpp_routines(dllinfo); // init routines
142145
}

0 commit comments

Comments
 (0)