[Rcpp-commits] r2815 - in pkg/Rcpp: . inst/include inst/include/Rcpp src

[noreply at r-forge.r-project.org]

Author: romain
Date: 2010-12-23 11:46:30 +0100 (Thu, 23 Dec 2010)
New Revision: 2815

Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/inst/include/Rcpp/RObject.h
   pkg/Rcpp/inst/include/RcppCommon.h
   pkg/Rcpp/src/RObject.cpp
Log:
using class SEXPstack to manage garbage collection more efficiently

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2010-12-22 16:23:58 UTC (rev 2814)
+++ pkg/Rcpp/ChangeLog	2010-12-23 10:46:30 UTC (rev 2815)
@@ -1,3 +1,9 @@
+2010-12-23  Romain Francois <romain at r-enthusiasts.com>
+
+	* inst/include/Rcpp/RObject.h: New internal class SEXPstack to handle 
+	garbage collection. Presumably more efficient than R_PreserveObject and
+	R_ReleaseObject
+
 2010-12-22  Dirk Eddelbuettel  <edd at debian.org>
 
 	* inst/unitTests/runit.Vector.R: Applied patch by Christian Gunning

Modified: pkg/Rcpp/inst/include/Rcpp/RObject.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/RObject.h	2010-12-22 16:23:58 UTC (rev 2814)
+++ pkg/Rcpp/inst/include/Rcpp/RObject.h	2010-12-23 10:46:30 UTC (rev 2815)
@@ -26,6 +26,25 @@
 
 namespace Rcpp{ 
 
+    namespace internal{
+     
+        class SEXPstack {
+        public:
+            SEXPstack() ;
+            void preserve( SEXP ) ;
+            void release( SEXP ) ;
+        private:
+            SEXP stack ;
+            SEXP* data ;
+            int len, top ;
+            
+            void grow( ) ;
+        } ;
+    
+    }
+    
+    
+    
 class RObject {
 public:
    	
@@ -162,7 +181,7 @@
 		 * @param rhs another slot proxy
 		 */
 		SlotProxy& operator=(const SlotProxy& rhs) ;
-		
+		  
 		/**
 		 * lhs use. Assigns the slot by wrapping the rhs object
 		 *
@@ -265,8 +284,10 @@
     
 private:
 
-    void preserve(){ if( m_sexp != R_NilValue ) Rcpp_PreserveObject(m_sexp) ; } 
-    void release() { if( m_sexp != R_NilValue ) Rcpp_ReleaseObject(m_sexp) ; } 
+    static internal::SEXPstack PPstack ;
+    
+    void preserve(){ if( m_sexp != R_NilValue ) PPstack.preserve(m_sexp) ; } 
+    void release() { if( m_sexp != R_NilValue ) PPstack.release(m_sexp) ; } 
     virtual void update() {
         RCPP_DEBUG_1( "RObject::update(SEXP = <%p> )", m_sexp ) ; 
     } ;

Modified: pkg/Rcpp/inst/include/RcppCommon.h
===================================================================
--- pkg/Rcpp/inst/include/RcppCommon.h	2010-12-22 16:23:58 UTC (rev 2814)
+++ pkg/Rcpp/inst/include/RcppCommon.h	2010-12-23 10:46:30 UTC (rev 2815)
@@ -132,9 +132,6 @@
 
 #include <Rcpp/complex.h>
 
-inline void Rcpp_PreserveObject( SEXP object ) { R_PreserveObject(object) ; } 
-inline void Rcpp_ReleaseObject( SEXP object )  { R_PreserveObject(object) ; }
-
 #include <Rcpp/barrier.h>
 
 #define RcppExport extern "C"

Modified: pkg/Rcpp/src/RObject.cpp
===================================================================
--- pkg/Rcpp/src/RObject.cpp	2010-12-22 16:23:58 UTC (rev 2814)
+++ pkg/Rcpp/src/RObject.cpp	2010-12-23 10:46:30 UTC (rev 2815)
@@ -23,7 +23,45 @@
 #include <Rcpp/RObject.h>
 
 namespace Rcpp {
+namespace internal{
 
+    SEXPstack::SEXPstack() : 
+        stack( Rf_allocVector(VECSXP,1000) ), 
+        data( get_vector_ptr(stack) ), 
+        len( 1000 ), 
+        top( 0 )
+    {
+      R_PreserveObject( stack ) ;  
+    }
+    
+    void SEXPstack::preserve( SEXP object){
+        if( top == len-1) grow() ;
+        SET_VECTOR_ELT( stack, top++, object ) ;
+    }
+    
+    void SEXPstack::release( SEXP object ){
+        int n = top - 1 ;
+        while( n > -1 && data[n] != object ) n-- ;
+        while( n < top - 1 ){ 
+            data[n] = data[n+1] ; 
+            n++ ;
+        }
+        data[--top] = R_NilValue ;
+    }
+    
+    void SEXPstack::grow( ){
+        int newsize = len * 2 ;
+        SEXP x = PROTECT( Rf_allocVector( VECSXP, newsize ) ) ;
+        SEXP* x_data = get_vector_ptr( x) ;
+        std::copy( data, data + len, x_data ) ;
+        stack = x ;
+        UNPROTECT(1);
+        data = x_data ;
+    }
+}
+
+internal::SEXPstack RObject::PPstack ;    
+    
 void RObject::setSEXP(SEXP x){
     RCPP_DEBUG_1( "RObject::setSEXP(SEXP = <%p> )", x ) ;