Skip to content

Commit 21ddbb9

Browse files
Enchufa2eddelbuettel
Enchufa2
authored and
eddelbuettel
committed
second pass at 'precious_{preserve,remove}'
1 parent 519909c commit 21ddbb9

File tree

8 files changed

+232
-121
lines changed

8 files changed

+232
-121
lines changed

‎inst/include/Rcpp/String.h‎

Lines changed: 170 additions & 45 deletions
Large diffs are not rendered by default.

‎inst/include/Rcpp/exceptions.h‎

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

‎inst/include/Rcpp/routines.h‎

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -41,8 +41,8 @@ namespace Rcpp{
4141

4242
void Rcpp_precious_init();
4343
void Rcpp_precious_teardown();
44-
void Rcpp_precious_preserve(SEXP object);
45-
void Rcpp_precious_remove(SEXP object);
44+
SEXP Rcpp_precious_preserve(SEXP object);
45+
void Rcpp_precious_remove(SEXP token);
4646
}
4747

4848
SEXP rcpp_get_stack_trace();
@@ -133,24 +133,24 @@ namespace Rcpp {
133133
}
134134

135135
inline attribute_hidden void Rcpp_precious_init() {
136-
typedef int (*Fun)(void);
136+
typedef void (*Fun)(void);
137137
static Fun fun = GET_CALLABLE("Rcpp_precious_init");
138138
fun();
139139
}
140140
inline attribute_hidden void Rcpp_precious_teardown() {
141-
typedef int (*Fun)(void);
141+
typedef void (*Fun)(void);
142142
static Fun fun = GET_CALLABLE("Rcpp_precious_teardown");
143143
fun();
144144
}
145-
inline attribute_hidden void Rcpp_precious_preserve(SEXP object) {
146-
typedef const char* (*Fun)(SEXP);
145+
inline attribute_hidden SEXP Rcpp_precious_preserve(SEXP object) {
146+
typedef SEXP (*Fun)(SEXP);
147147
static Fun fun = GET_CALLABLE("Rcpp_precious_preserve");
148-
fun(object);
148+
return fun(object);
149149
}
150-
inline attribute_hidden void Rcpp_precious_remove(SEXP object) {
151-
typedef const char* (*Fun)(SEXP);
150+
inline attribute_hidden void Rcpp_precious_remove(SEXP token) {
151+
typedef void (*Fun)(SEXP);
152152
static Fun fun = GET_CALLABLE("Rcpp_precious_remove");
153-
fun(object);
153+
fun(token);
154154
}
155155

156156
}

‎inst/include/Rcpp/storage/PreserveStorage.h‎

Lines changed: 11 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -7,15 +7,20 @@ namespace Rcpp{
77
class PreserveStorage {
88
public:
99

10-
PreserveStorage() : data(R_NilValue){}
10+
PreserveStorage() : data(R_NilValue), token(R_NilValue){}
1111

1212
~PreserveStorage(){
13-
Rcpp_ReleaseObject(data) ;
13+
Rcpp_ReleaseObject(token) ;
1414
data = R_NilValue;
15+
token = R_NilValue;
1516
}
1617

1718
inline void set__(SEXP x){
18-
data = Rcpp_ReplaceObject(data, x) ;
19+
if (data != x) {
20+
data = x;
21+
Rcpp_ReleaseObject(token);
22+
token = Rcpp_PreserveObject(data);
23+
}
1924

2025
// calls the update method of CLASS
2126
// this is where to react to changes in the underlying SEXP
@@ -28,7 +33,9 @@ namespace Rcpp{
2833

2934
inline SEXP invalidate__(){
3035
SEXP out = data ;
36+
Rcpp_ReleaseObject(token);
3137
data = R_NilValue ;
38+
token = R_NilValue ;
3239
return out ;
3340
}
3441

@@ -48,6 +55,7 @@ namespace Rcpp{
4855

4956
private:
5057
SEXP data ;
58+
SEXP token ;
5159
} ;
5260

5361
}

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

Lines changed: 7 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -41,23 +41,22 @@ template <typename T> class named_object {
4141
template <> class named_object<SEXP> {
4242
public: // #nocov start
4343
named_object( const std::string& name_, const SEXP& o_):
44-
name(name_), object(o_) {
45-
//R_PreserveObject(object);
46-
Rcpp_precious_preserve(object);
44+
name(name_), object(o_), token(R_NilValue) {
45+
token = Rcpp_precious_preserve(object);
4746
}
4847

4948
named_object( const named_object<SEXP>& other ) :
50-
name(other.name), object(other.object) {
51-
//R_PreserveObject(object);
52-
Rcpp_precious_preserve(object);
49+
name(other.name), object(other.object), token(other.token) {
50+
token = Rcpp_precious_preserve(object);
5351
}
5452
~named_object() {
55-
//R_ReleaseObject(object);
56-
Rcpp_precious_remove(object);
53+
Rcpp_precious_remove(token);
5754

5855
} // #nocov end
5956
const std::string& name;
6057
SEXP object;
58+
private:
59+
SEXP token;
6160
};
6261

6362

‎inst/include/Rcpp/unwindProtect.h‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -64,8 +64,7 @@ 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);
68-
Rcpp::Rcpp_precious_preserve(token);
67+
::R_PreserveObject(token);
6968

7069
throw LongjumpException(token);
7170
}

‎inst/include/RcppCommon.h‎

Lines changed: 5 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -77,8 +77,8 @@ 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);
80+
SEXP Rcpp_precious_preserve(SEXP object);
81+
void Rcpp_precious_remove(SEXP token);
8282

8383
namespace internal {
8484
SEXP Rcpp_eval_impl(SEXP expr, SEXP env);
@@ -90,35 +90,12 @@ namespace Rcpp {
9090
template <typename T> class named_object;
9191
}
9292

93-
// inline SEXP Rcpp_PreserveObject(SEXP x) {
94-
// if (x != R_NilValue) {
95-
// R_PreserveObject(x);
96-
// }
97-
// return x;
98-
// }
9993
inline SEXP Rcpp_PreserveObject(SEXP object) {
100-
Rcpp_precious_preserve(object);
101-
return object;
94+
return Rcpp_precious_preserve(object);
10295
}
10396

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);
111-
}
112-
113-
inline SEXP Rcpp_ReplaceObject(SEXP x, SEXP y) {
114-
115-
// if we are setting to the same SEXP as we already have, do nothing
116-
if (x != y) {
117-
Rcpp_ReleaseObject(x);
118-
Rcpp_PreserveObject(y);
119-
}
120-
121-
return y;
97+
inline void Rcpp_ReleaseObject(SEXP token) {
98+
Rcpp_precious_remove(token);
12299
}
123100

124101
}

‎src/barrier.cpp‎

Lines changed: 27 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -90,35 +90,39 @@ namespace Rcpp {
9090
static SEXP Rcpp_precious = R_NilValue;
9191
// [[Rcpp::register]]
9292
void Rcpp_precious_init() {
93-
Rcpp_precious = CONS(R_NilValue,R_NilValue);// set up
94-
R_PreserveObject(Rcpp_precious); // and protect
93+
Rcpp_precious = CONS(R_NilValue, R_NilValue); // set up
94+
R_PreserveObject(Rcpp_precious); // and protect
9595
}
9696
// [[Rcpp::register]]
9797
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;
98+
R_ReleaseObject(Rcpp_precious); // release resource
99+
}
100+
// [[Rcpp::register]]
101+
SEXP Rcpp_precious_preserve(SEXP object) {
102+
if (object == R_NilValue) {
103+
return R_NilValue;
117104
}
105+
PROTECT(object);
106+
SEXP cell = PROTECT(CONS(Rcpp_precious, CDR(Rcpp_precious)));
107+
SET_TAG(cell, object);
108+
SETCDR(Rcpp_precious, cell);
109+
if (CDR(cell) != R_NilValue) {
110+
SETCAR(CDR(cell), cell);
111+
}
112+
UNPROTECT(2);
113+
return cell;
118114
}
119115
// [[Rcpp::register]]
120-
void Rcpp_precious_remove(SEXP object) {
121-
SETCDR(Rcpp_precious, DeleteFromList(object, CDR(Rcpp_precious)));
116+
void Rcpp_precious_remove(SEXP token) {
117+
if (token == R_NilValue) {
118+
return;
119+
}
120+
SEXP before = CAR(token);
121+
SEXP after = CDR(token);
122+
SETCDR(before, after);
123+
if (after != R_NilValue) {
124+
SETCAR(after, before);
125+
}
122126
}
123127
}
124128

0 commit comments

Comments
 (0)