thr3ads.net - R devel - [Rd] Running an expression 1MN times using embedded R [Sep 2009]

If this information is useful, please help other people find it:
Share via:

Saptarshi Guha

2009-Sep-03 23:15 UTC

[Rd] Running an expression 1MN times using embedded R

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.



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

Simon Urbanek

2009-Sep-03 23:27 UTC

head link

[Rd] Running an expression 1MN times using embedded R

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 at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-devel
>
>

R devel - Sep 2009 - Running an expression 1MN times using embedded R

[Rd] Running an expression 1MN times using embedded R

[Rd] Running an expression 1MN times using embedded R