[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