[Rcpp-devel] [Rcpp-commits] r220 - in pkg: . inst inst/examples/RcppInline src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Dec 29 10:30:13 CET 2009
Author: romain
Date: 2009-12-29 10:30:12 +0100 (Tue, 29 Dec 2009)
New Revision: 220
Added:
pkg/inst/examples/RcppInline/external_pointer.r
pkg/src/RcppXPtr.h
Modified:
pkg/DESCRIPTION
pkg/inst/ChangeLog
pkg/src/Rcpp.h
pkg/src/RcppExample.cpp
pkg/src/exception_handling.cpp
Log:
added smart external pointers template class RcppXPtr<typename T>
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2009-12-28 11:23:31 UTC (rev 219)
+++ pkg/DESCRIPTION 2009-12-29 09:30:12 UTC (rev 220)
@@ -1,6 +1,6 @@
Package: Rcpp
Title: Rcpp R/C++ interface package
-Version: 0.7.0.3
+Version: 0.7.0.4
Date: $Date$
Author: Dirk Eddelbuettel and Romain Francois, with contributions
by Simon Urbanek and David Reiss; based on code written during
Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog 2009-12-28 11:23:31 UTC (rev 219)
+++ pkg/inst/ChangeLog 2009-12-29 09:30:12 UTC (rev 220)
@@ -1,3 +1,20 @@
+2009-12-29 Romain Francois <francoisromain at free.fr>
+
+ * src/RcppXPtr.h: new smart external pointer wrapper. The RcppXPtr
+ template can be used to wrap a external pointer (SEXP) so that it
+ looks like the dumb pointer it is wrapping (as far as the * and ->
+ operator are concerned). The template parameter controls the type
+ of object that is wrapped by the pointer.
+
+ * src/Rcpp.h: importing the RcppXPtr.h header
+
+ * src/RcppExample.cpp: added an example of RcppXPtr usage
+
+ * inst/examples/RcppInline/external_pointer.r: added example using
+ the RcppXPtr template
+
+ * DESCRIPTION: marking this as 0.7.0.4
+
2009-12-28 Romain Francois <francoisromain at free.fr>
* R/exceptions.R: s/uncaught_cpp_exception/cpp_exception/ and added a
Added: pkg/inst/examples/RcppInline/external_pointer.r
===================================================================
--- pkg/inst/examples/RcppInline/external_pointer.r (rev 0)
+++ pkg/inst/examples/RcppInline/external_pointer.r 2009-12-29 09:30:12 UTC (rev 220)
@@ -0,0 +1,59 @@
+#!/usr/bin/r -t
+#
+# Copyright (C) 2009 Romain Francois
+#
+# This file is part of Rcpp.
+#
+# Rcpp is free software: you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 2 of the License, or
+# (at your option) any later version.
+#
+# Rcpp is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
+
+require(Rcpp)
+require(inline)
+
+funx <- cfunction(signature(), '
+ /* creating a pointer to a vector<int> */
+ std::vector<int>* v = new std::vector<int> ;
+ v->push_back( 1 ) ;
+ v->push_back( 2 ) ;
+
+ /* wrap the pointer as an external pointer */
+ /* this automatically protected the external pointer from R garbage
+ collection until p goes out of scope. */
+ RcppXPtr< std::vector<int> > p(v) ;
+
+ /* return it back to R, since p goes out of scope after the return
+ the external pointer is no more protected by p, but it gets
+ protected by being on the R side */
+ return( p.asSexp() ) ;
+
+', Rcpp=TRUE, verbose=FALSE)
+xp <- funx()
+stopifnot( identical( typeof( xp ), "externalptr" ) )
+
+# passing the pointer back to C++
+funx <- cfunction(signature(x = "externalptr" ), '
+ /* wrapping x as smart external pointer */
+ /* The SEXP based constructor does not protect the SEXP from
+ garbage collection automatically, it is already protected
+ because it comes from the R side, however if you want to keep
+ the RcppXPtr object on the C(++) side
+ and return something else to R, you need to protect the external
+ pointer, by using the protect member function */
+ RcppXPtr< std::vector<int> > p(x) ;
+
+ /* just return the front of the vector as a SEXP */
+ return( RcppSexp( p->front() ).asSexp() ) ;
+', Rcpp=TRUE, verbose=FALSE)
+front <- funx(xp)
+stopifnot( identical( front, 1L ) )
+
Property changes on: pkg/inst/examples/RcppInline/external_pointer.r
___________________________________________________________________
Name: svn:executable
+ *
Modified: pkg/src/Rcpp.h
===================================================================
--- pkg/src/Rcpp.h 2009-12-28 11:23:31 UTC (rev 219)
+++ pkg/src/Rcpp.h 2009-12-29 09:30:12 UTC (rev 220)
@@ -41,5 +41,6 @@
#include <RcppStringVectorView.h>
#include <RcppVector.h>
#include <RcppVectorView.h>
+#include <RcppXPtr.h>
#endif
Modified: pkg/src/RcppExample.cpp
===================================================================
--- pkg/src/RcppExample.cpp 2009-12-28 11:23:31 UTC (rev 219)
+++ pkg/src/RcppExample.cpp 2009-12-29 09:30:12 UTC (rev 220)
@@ -461,3 +461,18 @@
return rl;
}
+
+RcppExport SEXP RcppXPtrExample_create_external_pointer(){
+ std::vector<int> *v = new std::vector<int> ;
+ v->push_back( 1 ) ;
+ v->push_back( 2 ) ;
+ RcppXPtr< std::vector<int> > p(v) ;
+ return p.asSexp() ;
+}
+
+RcppExport SEXP RcppXPtrExample_get_external_pointer(SEXP x){
+ RcppXPtr< std::vector<int> > p(x) ;
+ return Rf_ScalarInteger( p->back( ) ) ;
+}
+
+
Added: pkg/src/RcppXPtr.h
===================================================================
--- pkg/src/RcppXPtr.h (rev 0)
+++ pkg/src/RcppXPtr.h 2009-12-29 09:30:12 UTC (rev 220)
@@ -0,0 +1,179 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// RcppXPtr.h: Rcpp R/C++ interface class library -- smart external pointers
+//
+// Copyright (C) 2009 Romain Francois
+//
+// This file is part of Rcpp.
+//
+// Rcpp is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 2 of the License, or
+// (at your option) any later version.
+//
+// Rcpp is distributed in the hope that it will be useful, but
+// WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
+
+#ifndef RcppXPtr_h
+#define RcppXPtr_h
+
+#include <RcppCommon.h>
+
+template <typename T>
+void delete_finalizer(SEXP p){
+ if( TYPEOF(p) == EXTPTRSXP ){
+ T* ptr = (T*) EXTPTR_PTR(p) ;
+ delete ptr ;
+ }
+}
+
+template <typename T>
+class RcppXPtr {
+ public:
+
+ /**
+ * constructs a RcppXPtr wrapping the external pointer (EXTPTRSXP SEXP)
+ *
+ * @param xp external pointer to wrap
+ */
+ explicit RcppXPtr(SEXP m_sexp) ;
+
+ /**
+ * creates a new external pointer wrapping the dumb pointer p.
+ * This calls R_PreserveObject to prevent the external pointer
+ * from R garbage collection
+ *
+ * @param p dumb pointer to some object
+ * @param set_delete_finalizer if set to true, a finalizer will
+ * be registered for the external pointer. The finalizer
+ * is called when the xp is garbage collected. The finalizer
+ * is merely a call to the delete operator or the pointer
+ * so you need to make sure the pointer can be deleted.
+ */
+ explicit RcppXPtr(T* p, bool set_delete_finalizer) ;
+
+ /**
+ * if this was built using the SEXP constructor, and no call
+ * to protect was issued, the destructor
+ * does nothing
+ *
+ * if built using the dumb pointer constructor or a call to
+ * protect was issued, then the external
+ * pointer is released (using R_ReleaseObject), so
+ */
+ ~RcppXPtr() ;
+
+ /**
+ * Returns a reference to the object wrapped. This allows this
+ * object to look and feel like a dumb pointer to T
+ */
+ T& operator*() const ;
+
+ /**
+ * Returns the dumb pointer. This allows to call the -> operator
+ * on this as if it was the dumb pointer
+ */
+ T* operator->() const ;
+
+ /**
+ * Returns the 'protected' part of the external pointer, this is
+ * the SEXP that is passed in as the third argument of the
+ * R_MakeExternalPointer function. See Writing R extensions
+ */
+ SEXP getProtected() ;
+
+ /**
+ * Returns the 'tag' part of the external pointer, this is the
+ * SEXP that is passed in as the 2nd argument of the
+ * R_MakeExternalPointer function. See Writing R extensions
+ */
+ SEXP getTag() ;
+
+ /**
+ * force this external pointer to be protected from R garbage collection
+ */
+ void protect() ;
+
+ void setDeleteFinalizer() ;
+
+ /**
+ * Returns the external pointer (suitable to send to the R side)
+ */
+ SEXP asSexp();
+
+ private:
+
+ /**
+ * The external pointer
+ */
+ SEXP m_sexp;
+
+ /**
+ * set to true if this objects protects the external pointer
+ * from R garbage collection (R_PreserveObject/R_ReleaseObject)
+ */
+ bool isProtected;
+};
+
+template<typename T>
+RcppXPtr<T>::RcppXPtr(SEXP m_sexp) : m_sexp(m_sexp), isProtected(false) {}
+
+template<typename T>
+RcppXPtr<T>::RcppXPtr(T* p, bool set_delete_finalizer = true) : isProtected(false) {
+ m_sexp = R_MakeExternalPtr( (void*)p , R_NilValue, R_NilValue) ;
+ if( set_delete_finalizer ){
+ setDeleteFinalizer() ;
+ }
+ protect() ;
+}
+
+template<typename T>
+void RcppXPtr<T>::protect(){
+ R_PreserveObject( m_sexp ) ;
+ isProtected = true ;
+}
+
+template<typename T>
+void RcppXPtr<T>::setDeleteFinalizer(){
+ R_RegisterCFinalizerEx( m_sexp, delete_finalizer<T> , FALSE) ;
+}
+
+
+template<typename T>
+RcppXPtr<T>::~RcppXPtr(){
+ if( isProtected ){
+ R_ReleaseObject( m_sexp ) ;
+ }
+}
+
+template<typename T>
+T& RcppXPtr<T>::operator*() const {
+ return *((T*)EXTPTR_PTR( m_sexp )) ;
+}
+
+template<typename T>
+T* RcppXPtr<T>::operator->() const {
+ return (T*)(EXTPTR_PTR(m_sexp));
+}
+
+template<typename T>
+SEXP RcppXPtr<T>::getProtected(){
+ return EXTPTR_PROT(m_sexp) ;
+}
+
+template<typename T>
+SEXP RcppXPtr<T>::getTag(){
+ return EXTPTR_TAG(m_sexp) ;
+}
+
+template<typename T>
+SEXP RcppXPtr<T>::asSexp(){
+ return m_sexp ;
+}
+
+#endif
Modified: pkg/src/exception_handling.cpp
===================================================================
--- pkg/src/exception_handling.cpp 2009-12-28 11:23:31 UTC (rev 219)
+++ pkg/src/exception_handling.cpp 2009-12-29 09:30:12 UTC (rev 220)
@@ -1,6 +1,6 @@
// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
//
-// RcppCommon.cpp: R/C++ interface class library -- common functions
+// exception_handling.cpp: R/C++ interface class library -- common functions
//
// Copyright (C) 2009 - 2010 Romain Francois
//
@@ -66,8 +66,11 @@
}
Rf_eval(
- Rf_lang3( Rf_install("cpp_exception"), Rf_mkString(exception_what.c_str()), has_exception_class ? Rf_mkString(exception_class.c_str()) : R_NilValue ),
- R_FindNamespace(Rf_mkString("Rcpp"))
+ Rf_lang3(
+ Rf_install("cpp_exception"),
+ Rf_mkString(exception_what.c_str()),
+ has_exception_class ? Rf_mkString(exception_class.c_str()) : R_NilValue
+ ), R_FindNamespace(Rf_mkString("Rcpp"))
) ;
}
SEXP initUncaughtExceptionHandler(){
_______________________________________________
Rcpp-commits mailing list
Rcpp-commits at lists.r-forge.r-project.org
https://lists.r-forge.r-project.org/cgi-bin/mailman/listinfo/rcpp-commits
More information about the Rcpp-devel
mailing list