[Rcpp-devel] [Rcpp-commits] r223 - pkg/src
Romain François
francoisromain at free.fr
Tue Dec 29 16:53:05 CET 2009
commited too fast, working on it, sorry.
On 12/29/2009 04:53 PM, noreply at r-forge.r-project.org wrote:
> 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 ;
> +}
> +
--
Romain Francois
Professional R Enthusiast
+33(0) 6 28 91 30 30
http://romainfrancois.blog.free.fr
|- http://tr.im/IlMh : CPP package: exposing C++ objects
|- http://tr.im/HlX9 : new package : bibtex
`- http://tr.im/Gq7i : ohloh
More information about the Rcpp-devel
mailing list