From saptarshi.guha at gmail.com  Fri Sep  4 05:49:10 2009
From: saptarshi.guha at gmail.com (Saptarshi Guha)
Date: Thu, 3 Sep 2009 23:49:10 -0400
Subject: [Rd] Running an expression 1MN times using embedded R
In-Reply-To: <83CA908A-67BD-470A-A627-6B4D51E8414A@r-project.org>
References: <F088461E-A558-40F8-8197-9BD72759EA74@gmail.com> 
	<83CA908A-67BD-470A-A627-6B4D51E8414A@r-project.org>
Message-ID: <1e7471d50909032049m5fe1214aj7095c485e9f9a311@mail.gmail.com>

Oh!Thanks much. Worked perfectly.
Hadn't realized the importance of -Wall.

Regards
saptarshi


On Thu, Sep 3, 2009 at 7:27 PM, Simon
Urbanek<simon.urbanek at r-project.org> wrote:
>
> 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
>>
>>
>
>



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