avoid need for R_NilValue checks in protect code (#285)

* avoid need for R_NilValue checks in protect code

* tweak comments + names

* typo

* fix comments

* backwards compatibility?

* code comments

* satisfy grumpy formatter

---------

Co-authored-by: Romain François <romain@rstudio.com>

Author: kevinushey

NEWS.md

@@ -1,5 +1,7 @@
 # cpp11 (development version)
 
+* Minor performance improvements to the cpp11 protect code. (@kevinushey)
+
 * Silenced an unknown attribute warning specific to the Intel compiler
   (r-lib/systemfonts#98).
 

inst/include/cpp11/protect.hpp

@@ -315,16 +315,18 @@ static struct {
 
     static SEXP list_ = get_preserve_list();
 
-    // Add a new cell that points to the previous end.
-    SEXP cell = PROTECT(Rf_cons(list_, CDR(list_)));
+    // Get references to head, tail of the precious list.
+    SEXP head = list_;
+    SEXP tail = CDR(list_);
 
+    // Add a new cell that points to the current head + tail.
+    SEXP cell = PROTECT(Rf_cons(head, tail));
     SET_TAG(cell, obj);
 
-    SETCDR(list_, cell);
-
-    if (CDR(cell) != R_NilValue) {
-      SETCAR(CDR(cell), cell);
-    }
+    // Update the head + tail to point at the newly-created cell,
+    // effectively inserting that cell between the current head + tail.
+    SETCDR(head, cell);
+    SETCAR(tail, cell);
 
     UNPROTECT(2);
 
@@ -352,29 +354,25 @@ static struct {
 #endif
   }
 
-  void release(SEXP token) {
-    if (token == R_NilValue) {
+  void release(SEXP cell) {
+    if (cell == R_NilValue) {
       return;
     }
 
 #ifdef CPP11_USE_PRESERVE_OBJECT
-    R_ReleaseObject(token);
+    R_ReleaseObject(cell);
     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);
+    // Get a reference to the cells before and after the token.
+    SEXP lhs = CAR(cell);
+    SEXP rhs = CDR(cell);
 
-    if (after != R_NilValue) {
-      SETCAR(after, before);
-    }
+    // Remove the cell from the precious list -- effectively, we do this
+    // by updating the 'lhs' and 'rhs' references to point at each-other,
+    // effectively removing any references to the cell in the pairlist.
+    SETCDR(lhs, rhs);
+    SETCAR(rhs, lhs);
   }
 
  private:
@@ -414,18 +412,24 @@ static struct {
 
   static SEXP get_preserve_list() {
     static SEXP preserve_list = R_NilValue;
-
     if (TYPEOF(preserve_list) != LISTSXP) {
       preserve_list = get_preserve_xptr_addr();
       if (TYPEOF(preserve_list) != LISTSXP) {
-        preserve_list = Rf_cons(R_NilValue, R_NilValue);
+        preserve_list = Rf_cons(R_NilValue, Rf_cons(R_NilValue, R_NilValue));
         R_PreserveObject(preserve_list);
         set_preserve_xptr(preserve_list);
       }
+
+      // NOTE: Because older versions of cpp11 (<= 0.4.2) initialized the
+      // precious_list with a single cell, we might need to detect and update
+      // an existing empty precious list so that we have a second cell following.
+      if (CDR(preserve_list) == R_NilValue)
+        SETCDR(preserve_list, Rf_cons(R_NilValue, R_NilValue));
     }
 
     return preserve_list;
   }
-}  // namespace cpp11
-preserved;
+
+} preserved;
+
 }  // namespace cpp11