C level try catch

result.md

$ 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

try_catch.c

#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 ;
}