On Sep 3, 2009, at 7:15 PM, Saptarshi Guha wrote:
Hello,
I'm evaluating this expression
expression({ for(x in 1:5){ .Call('rh_status','x') }})
a million times from a program with R embedded in it. I have
attached reproducible code that crashes with
Program received signal SIGSEGV, Segmentation fault.
0x00002b499ca40a6e in R_gc_internal (size_needed=0) at memory.c:1309
1309 FORWARD_NODE(R_PPStack[i]);
Current language: auto; currently c
(bt output below)
The code crashes with R-2.8 on both OS X (10.5) and Linux (Linux
2.6.18-128.4.1.el5 #1 SMP Thu Jul 23 19:59:19 EDT 2009 x86_64 x86_64
x86_64 GNU/Linux)
Most of the code has been taken from the R extensions website, I
would appreciate any pointers to why this is crashing.
code can be found at the end of the email.
Try -Wall when compiling your code - it will tell you what's wrong:
a.cc:54: warning: control reaches end of non-void function
You simply forgot to add return to rh_status so it's returning junk
which crashes (since it's not a valid SEXP).
Cheers,
Simon
Much thanks for your time
Regards
Saptarshi
BT OUTPUT:
#0 0x00002b499ca40a6e in R_gc_internal (size_needed=0) at memory.c:
1309
#1 0x00002b499ca42bc0 in Rf_cons (car=0x484ba98, cdr=0x484ba98) at
memory.c:1766
#2 0x00002b499ca1e39d in Rf_evalList (el=0x4cd0f30, rho=0x488ca48,
op=0x5077148) at eval.c:1489
#3 0x00002b499ca1de4d in Rf_eval (e=0x4cd1010, rho=0x488ca48) at
eval.c:480
#4 0x00002b499ca1ea82 in do_begin (call=0x4cd1048, op=0x486a830,
args=0x4cd1080, rho=0x488ca48) at eval.c:1174
#5 0x00002b499ca1dda6 in Rf_eval (e=0x4cd1048, rho=0x488ca48) at
eval.c:461
#6 0x00002b499ca21720 in do_for (call=0x4cd1160, op=0x4868540,
args=0x4cd1128, rho=0x488ca48) at eval.c:1073
#7 0x00002b499ca1dda6 in Rf_eval (e=0x4cd1160, rho=0x488ca48) at
eval.c:461
#8 0x00002b499ca1ea82 in do_begin (call=0x4cd1198, op=0x486a830,
args=0x4cd11d0, rho=0x488ca48) at eval.c:1174
#9 0x00002b499ca1dda6 in Rf_eval (e=0x4cd1198, rho=0x488ca48) at
eval.c:461
#10 0x00002b499ca22494 in do_eval (call=0x49893f8, op=0x487ed08,
args=<value optimized out>, rho=0x511ec40) at eval.c:1752
#11 0x00002b499ca4b74e in do_internal (call=<value optimized out>,
op=<value optimized out>, args=<value optimized out>, env=0x511ec40)
at names.c:1140
#12 0x00002b499ca1dda6 in Rf_eval (e=0x4987c90, rho=0x511ec40) at
eval.c:461
#13 0x00002b499ca200c1 in Rf_applyClosure (call=0x4ccfca0,
op=0x4988080, arglist=0x511ed20, rho=0x488ca48,
suppliedenv=0x488ca80) at eval.c:667
#14 0x00002b499ca1dc78 in Rf_eval (e=0x4ccfca0, rho=0x488ca48) at
eval.c:505
#15 0x0000000000401412 in main (argc=1, argv=0x7fff9e67c358) at
fugu.cc:126
To compile:
g++ -g -O0 `R CMD config --cppflags` `R CMD config --ldflags` fugu.cc
//////////////
//CODE:
/////////////
#include <iostream>
#define R_NO_REMAP
#include <Rversion.h>
#include <R.h>
#include <Rdefines.h>
#include <Rinternals.h>
#include <Rinterface.h>
#include <Rembedded.h>
#include <R_ext/Boolean.h>
#include <R_ext/Parse.h>
#include <R_ext/Rdynload.h>
const int i___ = 1;
#define is_bigendian() ( (*(char*)&i___) == 0 )
extern void (*ptr_R_ShowMessage)(const char *);
extern void (*ptr_R_WriteConsole)(const char *, int);
extern int (*ptr_R_ReadConsole)(char *, unsigned char *, int, int);
extern void (*ptr_R_WriteConsoleEx)(const char *, int , int );
SEXP rh_status(SEXP);
static uint8_t SET_STATUS = 0x02;
static R_CallMethodDef callMethods [] = {
{"rh_status",(DL_FUNC)&rh_status,1},
{NULL, NULL, 0}
};
uint32_t reverseUInt (uint32_t i) {
uint8_t c1, c2, c3, c4;
if (is_bigendian()) {
return i;
} else {
c1 = i & 255;
c2 = (i >> 8) & 255;
c3 = (i >> 16) & 255;
c4 = (i >> 24) & 255;
return ((uint32_t)c1 << 24) + ((uint32_t)c2 << 16) +
((uint32_t)c3 << 8) + c4;
}
}
SEXP rh_status(SEXP mess){
if(TYPEOF(mess)!=STRSXP){
return R_NilValue;
}
char *status = (char*)CHAR(STRING_ELT( mess , 0));
// fwrite(&SET_STATUS,sizeof(uint8_t),1,stderr);
// uint32_t stle = strlen(status);
// uint32_t len_rev = reverseUInt(stle);
// fwrite(&len_rev,sizeof(uint32_t),1,stderr);
// fwrite(status,stle,1,stderr);
}
SEXP rexpress(const char* cmd)
{
SEXP cmdSexp, cmdexpr, ans = R_NilValue;
int i,Rerr;
ParseStatus status;
PROTECT(cmdSexp = Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(cmdSexp, 0, Rf_mkChar(cmd));
cmdexpr = PROTECT(R_ParseVector(cmdSexp, -1, &status, R_NilValue));
if (status != PARSE_OK) {
UNPROTECT(2);
return(R_NilValue);
}
for(i = 0; i < Rf_length(cmdexpr); i++)
ans = R_tryEval(VECTOR_ELT(cmdexpr, i),NULL,&Rerr);
UNPROTECT(2);
return(ans);
}
int embedR(int argc, char **argv){
structRstart rp;
Rstart Rp = &rp;
R_DefParams(Rp);
Rp->NoRenviron = 0;
Rp->R_Interactive = (Rboolean)1;
R_SetParams(Rp);
R_SignalHandlers=0;
if (!getenv("R_HOME")) {
fprintf(stderr, "R_HOME is not set. Please set all required
environment variables before running this program.\n");
return(-1);
}
int stat= Rf_initialize_R(argc,(char **) argv);
if (stat<0) {
fprintf(stderr,"Failed to initialize embedded R!:%d\n",stat);
return(-2);
}
R_Outputfile = NULL;
R_Consolefile = NULL;
R_Interactive = (Rboolean)1;
// ptr_R_ShowMessage = Re_ShowMessage;
// ptr_R_WriteConsoleEx =Re_WriteConsoleEx;
// ptr_R_WriteConsole = NULL;
// ptr_R_ReadConsole = NULL;
return(0);
}
int main(int argc, char **argv){
if (embedR(argc,argv))
exit(1);
setup_Rmainloop();
DllInfo *info = R_getEmbeddingDllInfo();
R_registerRoutines(info, NULL, callMethods, NULL, NULL);
SEXP runner1,runner2;
PROTECT(runner1=rexpress("expression({ for(x in 1:5){ .Call
('rh_status','x') }})"));
if (runner1 == R_NilValue){
UNPROTECT(1);
exit(1);
}
PROTECT(runner2=Rf_lang2(Rf_install("eval"),runner1));
if(runner2==NILSXP){
UNPROTECT(2);
exit(1);
}
int mapbuf_cnt = 0;
for(;;){
if(mapbuf_cnt >1000000) exit(0);
Rf_eval(runner2 ,R_GlobalEnv);
mapbuf_cnt++;
}
UNPROTECT(2);
}
______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
