[Rcpp-devel] [Rcpp-commits] r223 - pkg/src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Dec 29 16:53:04 CET 2009
Author: romain
Date: 2009-12-29 16:53:03 +0100 (Tue, 29 Dec 2009)
New Revision: 223
Added:
pkg/src/exceptions.cpp
Removed:
pkg/src/exception_handling.cpp
Modified:
pkg/src/RcppSexp.cpp
pkg/src/RcppSexp.h
pkg/src/RcppXPtr.h
Log:
no problem
Modified: pkg/src/RcppSexp.cpp
===================================================================
--- pkg/src/RcppSexp.cpp 2009-12-29 15:20:19 UTC (rev 222)
+++ pkg/src/RcppSexp.cpp 2009-12-29 15:53:03 UTC (rev 223)
@@ -22,42 +22,43 @@
#include <RcppSexp.h>
#include <algorithm>
+#include <RcppSuperClass.h>
RcppSexp::RcppSexp(const bool & v) {
logTxt("RcppSexp from bool\n");
m_sexp = Rf_ScalarLogical(v);
- R_PreserveObject(m_sexp);
+ protect() ;
}
RcppSexp::RcppSexp(const double & v) {
logTxt("RcppSexp from double\n");
m_sexp = Rf_ScalarReal(v);
- R_PreserveObject(m_sexp);
+ protect() ;
}
RcppSexp::RcppSexp(const int & v) {
logTxt("RcppSexp from int\n");
m_sexp = Rf_ScalarInteger(v);
- R_PreserveObject(m_sexp);
+ protect() ;
}
RcppSexp::RcppSexp(const Rbyte & v) {
logTxt("RcppSexp from raw\n");
m_sexp = Rf_ScalarRaw(v);
- R_PreserveObject(m_sexp);
+ protect() ;
}
RcppSexp::RcppSexp(const std::string & v) {
logTxt("RcppSexp from std::string\n");
m_sexp = Rf_mkString(v.c_str());
- R_PreserveObject(m_sexp);
+ protect() ;
}
RcppSexp::RcppSexp(const std::vector<bool> & v) {
logTxt("RcppSexp from bool vector\n");
int n = v.size();
m_sexp = Rf_allocVector(LGLSXP, n);
- R_PreserveObject(m_sexp);
+ protect() ;
copy( v.begin(), v.end(), LOGICAL(m_sexp) ) ;
}
@@ -65,7 +66,7 @@
logTxt("RcppSexp from int vector\n");
int n = v.size();
m_sexp = Rf_allocVector(INTSXP, n);
- R_PreserveObject(m_sexp);
+ protect() ;
copy( v.begin(), v.end(), INTEGER(m_sexp) ) ;
}
@@ -73,7 +74,7 @@
logTxt("RcppSexp from double vector\n");
int n = v.size();
m_sexp = Rf_allocVector(REALSXP, n);
- R_PreserveObject(m_sexp);
+ protect() ;
copy( v.begin(), v.end(), REAL(m_sexp) ) ;
}
@@ -81,9 +82,7 @@
logTxt("RcppSexp from vector<Rbyte> \n");
int n = v.size();
m_sexp = Rf_allocVector(RAWSXP, n);
- R_PreserveObject(m_sexp);
- // copy the content of the byte vector
- // into the raw vector
+ protect() ;
copy( v.begin(), v.end(), RAW(m_sexp) ) ;
}
@@ -91,7 +90,7 @@
logTxt("RcppSexp from std::string vector\n");
int n = v.size();
m_sexp = Rf_allocVector(STRSXP, n);
- R_PreserveObject(m_sexp);
+ protect() ;
int i=0;
std::vector<std::string>::const_iterator it = v.begin() ;
while( i<n ){
@@ -107,7 +106,7 @@
logTxt("RcppSexp from set<int>\n");
int n = v.size();
m_sexp = Rf_allocVector(INTSXP, n);
- R_PreserveObject(m_sexp);
+ protect() ;
copy( v.begin(), v.end(), INTEGER(m_sexp) ) ;
}
@@ -115,7 +114,7 @@
logTxt("RcppSexp from set<double>\n");
int n = v.size();
m_sexp = Rf_allocVector(REALSXP, n);
- R_PreserveObject(m_sexp);
+ protect() ;
copy( v.begin(), v.end(), REAL(m_sexp) ) ;
}
@@ -123,9 +122,7 @@
logTxt("RcppSexp from set<Rbyte> \n");
int n = v.size();
m_sexp = Rf_allocVector(RAWSXP, n);
- R_PreserveObject(m_sexp);
- // copy the content of the byte vector
- // into the raw vector
+ protect() ;
copy( v.begin(), v.end(), RAW(m_sexp) ) ;
}
@@ -133,8 +130,8 @@
logTxt("RcppSexp from set<string>\n");
int n = v.size();
m_sexp = Rf_allocVector(STRSXP, n);
- R_PreserveObject(m_sexp);
- int i=0;
+ protect() ;
+ int i=0;
std::set<std::string>::iterator it = v.begin();
while( i<n ){
SET_STRING_ELT(m_sexp, i, Rf_mkChar(it->c_str()));
@@ -143,13 +140,8 @@
}
}
-
-
-
-
RcppSexp::~RcppSexp() {
- logTxt("dtor");
- R_ReleaseObject(m_sexp);
+ logTxt("~RcppSexp");
}
double RcppSexp::asDouble() const {
@@ -238,10 +230,6 @@
return std::string(CHAR(STRING_ELT(m_sexp,0)));
}
-SEXP RcppSexp::asSexp() const {
- return m_sexp;
-}
-
std::vector<bool> RcppSexp::asStdVectorBool() const {
int n = Rf_length(m_sexp);
std::vector<bool> v(n);
@@ -344,6 +332,28 @@
return v;
}
+
+
+
+
+RcppSexp::~RcppSexp() {
+ logTxt( "~RcppSexp" ) ;
+ release() ;
+}
+
+void RcppSexp::protect(){
+ if( !isProtected ){
+ isProtected = true ;
+ R_PreserveObject( m_sexp );
+ }
+}
+
+void RcppSexp::release(){
+ if( isProtected ){
+ R_ReleaseObject(m_sexp);
+ }
+}
+
std::vector<std::string> RcppSexp::attributeNames() const {
/* inspired from do_attributes at attrib.c */
@@ -367,16 +377,7 @@
return false; /* give up */
}
-RcppSexp RcppSexp::attr( const std::string& name) const{
- SEXP att = Rf_getAttrib( m_sexp, Rf_install( name.c_str() ) );
- return RcppSexp( att ) ;
+SEXP RcppSexp::attr( const std::string& name) const{
+ return Rf_getAttrib( m_sexp, Rf_install( name.c_str() ) );
}
-bool RcppSexp::isNULL() const{
- return m_sexp == R_NilValue ;
-}
-
-RcppSexp::operator SEXP() const{
- return m_sexp ;
-}
-
Modified: pkg/src/RcppSexp.h
===================================================================
--- pkg/src/RcppSexp.h 2009-12-29 15:20:19 UTC (rev 222)
+++ pkg/src/RcppSexp.h 2009-12-29 15:53:03 UTC (rev 223)
@@ -24,12 +24,29 @@
#define RcppSexp_h
#include <RcppCommon.h>
+#include <RcppSuperClass.h>
#include <set>
-class RcppSexp {
+class RcppSexp: public RcppSuperClass {
public:
- RcppSexp(SEXP sexp, int numprot=0) : m_sexp(sexp) { }
- RcppSexp() : m_sexp(R_NilValue) { }
+
+ /**
+ * wraps a SEXP. The SEXP is not automatically
+ * protected from garbage collection because it might be
+ * protected from elsewhere (e.g. if it comes from the
+ * R side). See protect and release for ways to protect
+ * the SEXP from garbage collection, and release to
+ * remove the protection
+ */
+ RcppSexp(SEXP m_sexp = R_NilValue) : m_sexp(m_sexp) {};
+
+ /**
+ * if this object is protected rom R's GC, then it is released
+ * and become subject to garbage collection. See protect
+ * and release member functions.
+ */
+ ~RcppSexp() ;
+
RcppSexp(const double & v);
RcppSexp(const int & v);
RcppSexp(const Rbyte & v);
@@ -47,13 +64,9 @@
RcppSexp(const std::set<std::string> & v);
RcppSexp(const std::set<Rbyte> & v);
- ~RcppSexp();
- /**
- * implicit conversion to SEXP
- */
- operator SEXP() const ;
-
+ /* we don't provide implicit converters because
+ of Item 5 in More Effective C++ */
bool asBool() const;
double asDouble() const;
int asInt() const;
@@ -64,18 +77,86 @@
std::vector<std::string> asStdVectorString() const;
std::vector<Rbyte> asStdVectorRaw() const;
std::vector<bool> asStdVectorBool() const;
- SEXP asSexp() const;
- /* attributes */
+
+ /**
+ * protects the wrapped SEXP from garbage collection. This
+ * calls the R_PreserveObject function on the underlying SEXP.
+ *
+ * Note that this does not use the PROTECT/UNPROTECT dance
+ */
+ void protect();
+
+ /**
+ * explicitely release this object to R garbage collection. This
+ * calls the R_ReleaseObject function on the underlying SEXP.
+ * This is automatically done by the destructor if we protected
+ * the SEXP (using the protect member function)
+ */
+ void release();
+
+ /**
+ * implicit conversion to SEXP
+ */
+ inline operator SEXP() const {
+ return m_sexp ;
+ }
+
+
+ /* attributes */
+
+ /**
+ * extracts the names of the attributes of the wrapped SEXP
+ */
std::vector<std::string> attributeNames() const ;
- bool hasAttribute( const std::string& attr) const ;
- RcppSexp attr( const std::string& name) const ;
- /* NULL */
- bool isNULL() const ;
+ /**
+ * Identifies if the SEXP has the given attribute
+ */
+ bool hasAttribute( const std::string& attr) const ;
-private:
- SEXP m_sexp;
+ /**
+ * extract the given attribute
+ */
+ SEXP attr( const std::string& name) const ;
+
+ /**
+ * is this object NULL
+ */
+ inline bool isNULL() const{
+ return m_sexp == R_NilValue ;
+ }
+
+ /**
+ * The SEXP typeof, calls TYPEOF on the underlying SEXP
+ */
+ inline int sexp_type() const {
+ return TYPEOF(m_sexp) ;
+ }
+
+ /**
+ * explicit conversion to SEXP
+ */
+ inline SEXP asSexp() const {
+ return m_sexp ;
+ }
+
+protected:
+
+ /**
+ * The SEXP this is wrapping
+ */
+ SEXP m_sexp ;
+
+ /**
+ * true if this protects the SEXP from garbage collection
+ * using R_ReleaseObject/R_PreserveObject strategy
+ *
+ * if this is true then the object will be release and become
+ * subject to R garbage collection when this object is deleted
+ */
+ bool isProtected ;
+
};
#endif
Modified: pkg/src/RcppXPtr.h
===================================================================
--- pkg/src/RcppXPtr.h 2009-12-29 15:20:19 UTC (rev 222)
+++ pkg/src/RcppXPtr.h 2009-12-29 15:53:03 UTC (rev 223)
@@ -23,7 +23,9 @@
#define RcppXPtr_h
#include <RcppCommon.h>
+#include <RcppSexp.h>
+
template <typename T>
void delete_finalizer(SEXP p){
if( TYPEOF(p) == EXTPTRSXP ){
@@ -33,7 +35,7 @@
}
template <typename T>
-class RcppXPtr {
+class RcppXPtr : public RcppSuperClass {
public:
/**
@@ -41,7 +43,7 @@
*
* @param xp external pointer to wrap
*/
- explicit RcppXPtr(SEXP m_sexp) ;
+ explicit RcppXPtr(SEXP m_sexp) : RcppSuperClass::RcppSuperClass(m_sexp){} ;
/**
* creates a new external pointer wrapping the dumb pointer p.
@@ -56,19 +58,8 @@
* 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
*/
@@ -94,43 +85,12 @@
*/
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();
-
- /**
- * implicit conversion to SEXP. So that we can return these
- * objects to the R side directly
- */
- operator SEXP() const ;
-
- 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) {
+RcppXPtr<T>::RcppXPtr(T* p, bool set_delete_finalizer = true) : RcppSuperClass::RcppSuperClass() {
m_sexp = R_MakeExternalPtr( (void*)p , R_NilValue, R_NilValue) ;
if( set_delete_finalizer ){
setDeleteFinalizer() ;
@@ -139,25 +99,11 @@
}
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 )) ;
}
@@ -177,14 +123,4 @@
return EXTPTR_TAG(m_sexp) ;
}
-template<typename T>
-SEXP RcppXPtr<T>::asSexp(){
- return m_sexp ;
-}
-
-template<typename T>
-RcppXPtr<T>::operator SEXP() const {
- return m_sexp ;
-}
-
#endif
Deleted: pkg/src/exception_handling.cpp
===================================================================
--- pkg/src/exception_handling.cpp 2009-12-29 15:20:19 UTC (rev 222)
+++ pkg/src/exception_handling.cpp 2009-12-29 15:53:03 UTC (rev 223)
@@ -1,81 +0,0 @@
-// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
-//
-// exception_handling.cpp: R/C++ interface class library -- common functions
-//
-// Copyright (C) 2009 - 2010 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/>.
-
-#include <Rcpp.h>
-#include <typeinfo>
-#include <exception>
-#include <exception_defines.h>
-#include <cxxabi.h>
-
-/* much inspired from the __verbose_terminate_handler of the GCC */
-void forward_uncaught_exceptions_to_r(){
-
- std::string exception_class ;
- bool has_exception_class = false;
- std::string exception_what ;
-
- // Make sure there was an exception; terminate is also called for an
- // attempt to rethrow when there is no suitable exception.
- std::type_info *t = abi::__cxa_current_exception_type();
- if (t){
- has_exception_class = true ;
- const char *name = t->name() ;
- // now we need to demangle "name"
-
- {
- int status = -1;
- char *dem = 0;
- dem = abi::__cxa_demangle(name, 0, 0, &status);
- if( status == 0){
- exception_class = dem ; /* great we can use the demangled name */
- free(dem);
- } else{
- exception_class = name ; /* just using the mangled name */
- }
- }
- }
-
- // If the exception is derived from std::exception, we can give more
- // information.
- try {
- __throw_exception_again;
-#ifdef __EXCEPTIONS
- } catch (std::exception &exc) {
- exception_what = exc.what() ;
-#endif
- } catch (...) {
- exception_what = "unrecognized exception" ;
- }
-
- 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"))
- ) ;
-}
-
-SEXP initUncaughtExceptionHandler(){
- void (*old_terminate)() = std::set_terminate(forward_uncaught_exceptions_to_r);
- return R_NilValue ;
-}
-
Copied: pkg/src/exceptions.cpp (from rev 222, pkg/src/exception_handling.cpp)
===================================================================
--- pkg/src/exceptions.cpp (rev 0)
+++ pkg/src/exceptions.cpp 2009-12-29 15:53:03 UTC (rev 223)
@@ -0,0 +1,81 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// exception_handling.cpp: R/C++ interface class library -- common functions
+//
+// Copyright (C) 2009 - 2010 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/>.
+
+#include <Rcpp.h>
+#include <typeinfo>
+#include <exception>
+#include <exception_defines.h>
+#include <cxxabi.h>
+
+/* much inspired from the __verbose_terminate_handler of the GCC */
+void forward_uncaught_exceptions_to_r(){
+
+ std::string exception_class ;
+ bool has_exception_class = false;
+ std::string exception_what ;
+
+ // Make sure there was an exception; terminate is also called for an
+ // attempt to rethrow when there is no suitable exception.
+ std::type_info *t = abi::__cxa_current_exception_type();
+ if (t){
+ has_exception_class = true ;
+ const char *name = t->name() ;
+ // now we need to demangle "name"
+
+ {
+ int status = -1;
+ char *dem = 0;
+ dem = abi::__cxa_demangle(name, 0, 0, &status);
+ if( status == 0){
+ exception_class = dem ; /* great we can use the demangled name */
+ free(dem);
+ } else{
+ exception_class = name ; /* just using the mangled name */
+ }
+ }
+ }
+
+ // If the exception is derived from std::exception, we can give more
+ // information.
+ try {
+ __throw_exception_again;
+#ifdef __EXCEPTIONS
+ } catch (std::exception &exc) {
+ exception_what = exc.what() ;
+#endif
+ } catch (...) {
+ exception_what = "unrecognized exception" ;
+ }
+
+ 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"))
+ ) ;
+}
+
+SEXP initUncaughtExceptionHandler(){
+ void (*old_terminate)() = std::set_terminate(forward_uncaught_exceptions_to_r);
+ return R_NilValue ;
+}
+
_______________________________________________
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