// [[Rcpp::internal]] SEXP rcpp_error_recorder(SEXP e){ SEXP cache = get_rcpp_cache() ; // error occured set_error_occured( cache, Rf_ScalarLogical(TRUE) ) ; // current error set_current_error(cache, e ) ; return R_NilValue ; }
// [[Rcpp::register]] SEXP reset_current_error(){ SEXP cache = get_rcpp_cache() ; // error occured set_error_occured( cache, Rf_ScalarLogical(FALSE) ) ; // current error set_current_error( cache, R_NilValue ) ; // stack trace SET_VECTOR_ELT( cache, 3, R_NilValue ) ; return R_NilValue ; }
SEXP init_Rcpp_cache(){ SEXP getNamespaceSym = Rf_install("getNamespace"); // cannot be gc()'ed once in symbol table Rcpp::Shield<SEXP> RCPP( Rf_eval(Rf_lang2( getNamespaceSym, Rf_mkString("Rcpp") ), R_GlobalEnv) ) ; Rcpp::Shield<SEXP> cache( Rf_allocVector( VECSXP, RCPP_CACHE_SIZE ) ); // the Rcpp namespace SET_VECTOR_ELT( cache, 0, RCPP ) ; set_error_occured( cache, Rf_ScalarLogical(FALSE) ) ; // error occured set_current_error( cache, R_NilValue ) ; // current error SET_VECTOR_ELT( cache, 3, R_NilValue ) ; // stack trace SET_VECTOR_ELT( cache, RCPP_HASH_CACHE_INDEX, Rf_allocVector(INTSXP, RCPP_HASH_CACHE_INITIAL_SIZE) ) ; Rf_defineVar( Rf_install(".rcpp_cache"), cache, RCPP ); return cache ; }
SEXP init_Rcpp_cache(){ SEXP getNamespaceSym = Rf_install("getNamespace"); // cannot be gc()'ed once in symbol table SEXP RCPP = PROTECT( Rf_eval(Rf_lang2( getNamespaceSym, Rf_mkString("Rcpp") ), R_GlobalEnv) ) ; SEXP cache = PROTECT( Rf_allocVector( VECSXP, RCPP_CACHE_SIZE ) ); // the Rcpp namespace SET_VECTOR_ELT( cache, 0, RCPP ) ; set_error_occured( cache, Rf_ScalarLogical(FALSE) ) ; // error occured set_current_error( cache, R_NilValue ) ; // current error SET_VECTOR_ELT( cache, 3, R_NilValue ) ; // stack trace SET_VECTOR_ELT( cache, RCPP_HASH_CACHE_INDEX, Rf_allocVector(INTSXP, RCPP_HASH_CACHE_INITIAL_SIZE) ) ; SEXP stack = PROTECT(Rf_allocVector(VECSXP, RCPP_PROTECT_STACK_INITIAL_SIZE)) ; // we use true length to store "top" SET_TRUELENGTH(stack, -1 ) ; SET_VECTOR_ELT( cache, RCPP_PROTECTION_STACK_INDEX, stack ) ; Rf_defineVar( Rf_install(".rcpp_cache"), cache, RCPP ); UNPROTECT(3) ; return cache ; }