Skip to content

Instantly share code, notes, and snippets.

@romainfrancois
Last active Aug 29, 2015
Embed
What would you like to do?
C level try catch
$ R CMD SHLIB try_catch.c
clang -I/Library/Frameworks/R.framework/Resources/include -DNDEBUG  -I/usr/local/include    -fPIC  -g -O3 -Wall -pipe -c try_catch.c -o try_catch.o
clang -dynamiclib -Wl,-headerpad_max_install_names -undefined dynamic_lookup -single_module -multiply_defined suppress -L/usr/local/lib -L/usr/local/lib -o try_catch.so try_catch.o -F/Library/Frameworks/R.framework/.. -framework R -Wl,-framework -Wl,CoreFoundation

When throwing a real condition, e.g. a simpleError, I can get hold of it

romain@naxos /tmp $ Rscript -e "dyn.load('try_catch.so') ; .Call( 'test', 1L)"
[[1]]
<simpleError: boom>

[[2]]
NULL

[[3]]
NULL

When using Rf_error, I get NULL:

romain@naxos /tmp $ Rscript -e "dyn.load('try_catch.so') ; .Call( 'test', 2L)"
[[1]]
NULL

[[2]]
NULL

[[3]]
NULL

Also NULL when throwing a simple error, e.g. with stop( "boom" )

romain@naxos /tmp $ Rscript -e "dyn.load('try_catch.so') ; .Call( 'test', 3L)"
[[1]]
NULL

[[2]]
NULL

[[3]]
NULL
#define R_NO_REMAP
#define USE_RINTERNALS
#include <R.h>
#include <Rinternals.h>
#include <setjmp.h>
#define JMP_BUF sigjmp_buf
enum {
CTXT_TOPLEVEL = 0,
CTXT_NEXT = 1,
CTXT_BREAK = 2,
CTXT_LOOP = 3, /* break OR next target */
CTXT_FUNCTION = 4,
CTXT_CCODE = 8,
CTXT_RETURN = 12,
CTXT_BROWSER = 16,
CTXT_GENERIC = 20,
CTXT_RESTART = 32,
CTXT_BUILTIN = 64 /* used in profiling */
};
#ifdef BC_INT_STACK
typedef union { void *p; int i; } IStackval;
#endif
typedef struct RPRSTACK {
SEXP promise;
struct RPRSTACK *next;
} RPRSTACK;
typedef struct RCNTXT {
struct RCNTXT *nextcontext; /* The next context up the chain */
int callflag; /* The context "type" */
JMP_BUF cjmpbuf; /* C stack and register information */
int cstacktop; /* Top of the pointer protection stack */
int evaldepth; /* evaluation depth at inception */
SEXP promargs; /* Promises supplied to closure */
SEXP callfun; /* The closure called */
SEXP sysparent; /* environment the closure was called from */
SEXP call; /* The call that effected this context*/
SEXP cloenv; /* The environment */
SEXP conexit; /* Interpreted "on.exit" code */
void (*cend)(void *); /* C "on.exit" thunk */
void *cenddata; /* data for C "on.exit" thunk */
void *vmax; /* top of R_alloc stack */
int intsusp; /* interrupts are suspended */
SEXP handlerstack; /* condition handler stack */
SEXP restartstack; /* stack of available restarts */
struct RPRSTACK *prstack; /* stack of pending promises */
SEXP *nodestack;
#ifdef BC_INT_STACK
IStackval *intstack;
#endif
SEXP srcref; /* The source line in effect */
int browserfinish; /* should browser finish this context without stopping */
} RCNTXT ;
extern SEXP R_HandlerStack ;
extern RCNTXT* R_GlobalContext;
extern SEXP R_ReturnedValue ;
static int testcase = 1 ;
void fun(void* data){
RCNTXT* c = R_GlobalContext ;
SEXP entry = PROTECT( Rf_allocVector( VECSXP, 5 ) );
SET_VECTOR_ELT( entry, 0, Rf_mkChar("error") ) ;
// SET_VECTOR_ELT( entry, 1, c->cloenv );
SET_VECTOR_ELT( entry, 3, c->cloenv );
SET_VECTOR_ELT( entry, 4, Rf_allocVector( VECSXP, 3 ) ) ;
SETLEVELS(entry, FALSE);
R_HandlerStack = Rf_cons( entry, R_NilValue ) ;
UNPROTECT(1) ;
c->callflag = CTXT_FUNCTION ;
switch( testcase){
case 1:
{
// case 1: with a real condition. I'm getting what I want.
Rf_eval( Rf_lang2( Rf_install("stop"),
Rf_lang2( Rf_install( "simpleError" ), Rf_mkString("boom") )
), R_GlobalEnv) ;
break ;
}
case 2:
{
// case 2: internal Rf_error call. I get NULL
Rf_error( "boom") ;
break ;
}
case 3:
{
// case 3: a simple error. I get NULL
Rf_eval( Rf_lang2( Rf_install("stop"), Rf_mkString("booom") ), R_GlobalEnv ) ;
break ;
}
default: break ;
}
// this is not printed, which is exactly what I expect
Rprintf( "not printed\n" ) ;
}
SEXP test(SEXP what){
testcase = INTEGER(what)[0] ;
R_ToplevelExec( &fun, NULL ) ;
return R_ReturnedValue ;
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment