From duncan at wald.ucdavis.edu  Thu Jan  8 15:59:25 2009
From: duncan at wald.ucdavis.edu (Duncan Temple Lang)
Date: Thu, 8 Jan 2009 06:59:25 -0800
Subject: [Rd] Callbacks seems to get GCed.
In-Reply-To: <op.unfzxlt6olvcyz@lcp>
References: <op.unfzxlt6olvcyz@lcp>
Message-ID: <20090108145925.GA31368@wald.ucdavis.edu>


Hi Bernd

There are two problems here.
Firstly, routines that are invoked  via the .Call() interface
must return a SEXP, not a void.  (void is for .C()-callable
routines.) 

The more serious problem is that yes, you are PROTECT'ing
the callbacks when you set them, but PROTECT'ing is
for the duration of the .Call() invocation, not throughout
a session. I imagine you are seeing stack imbalance messages
as you do not UNPROTECT() within the .Call() to set the
callbacks.

Because the setting of the callbacks and using them 
is asynchronous, or not part of the same .Call(),
you can use R_PreserveObject() rather than PROTECT().
That prohibits the object from  being garbage collected.


 D.

Bernd Schoeller wrote:
> Dear list,
> 
> I am trying to implement a publish-subscribe mechanism in for an embedded  
> R interpreter. But somehow my registered closures seem to get collected by  
> the GC, even though I have protected them. I have reducted my code to the  
> following sample. Sorry if it is a little verbose.
> 
> The first couple of call of calls still work, but at some point one of the  
> callbacks (callback1 in my case) changes its type.
> 
> Regards and thanks for any help,
>   Bernd
> 
> #include <stdio.h>
> #include <stdlib.h>
> 
> #define R_INTERFACE_PTRS 1
> 
> #include <Rversion.h>
> #include <Rembedded.h>
> #include <Rinternals.h>
> #include <Rdefines.h>
> #include <R_ext/Parse.h>
> #include <R_ext/Rdynload.h>
> #include <R_ext/RStartup.h>
> #include <Rinterface.h>
> 
> SEXP callback1;
> SEXP callback2;
> 
> void set_callback1(SEXP func) {
>   PROTECT(callback1 = func);
> }
> 
> void set_callback2(SEXP func) {
>   PROTECT(callback2 = func);
> }
> 
> R_CMethodDef cMethods[] = {
>   {NULL}
> };
> 
> R_CallMethodDef callMethods[] = {
>   {"set_callback1", (DL_FUNC) &set_callback1, 1},
>   {"set_callback2", (DL_FUNC) &set_callback2, 1},
>   {NULL}
> };
> 
> void r_trigger_callback1()
> {
>   int errorOccurred;
>   SEXP f = NULL;
> 
>   f = allocVector(LANGSXP, 1);
>   SETCAR(f, callback1);
>   PROTECT(f);
>   R_tryEval(f, R_GlobalEnv, &errorOccurred);
>   UNPROTECT(1);
> }
> 
> void r_trigger_callback2()
> {
>   int errorOccurred;
>   SEXP f = NULL;
> 
>   f = allocVector(LANGSXP, 1);
>   SETCAR(f, callback2);
>   PROTECT(f);
>   R_tryEval(f, R_GlobalEnv, &errorOccurred);
>   UNPROTECT(1);
> }
> 
> 
> void r_exec(char *code)
> {
>   SEXP cmdSexp, cmdExpr = R_NilValue;
>   ParseStatus status;
>   int i,errorOccurred;
>   SEXP e;
> 	
>   PROTECT (cmdSexp = allocVector (STRSXP, 1));
>   SET_STRING_ELT (cmdSexp, 0, mkChar (code));
>   PROTECT (cmdExpr = R_ParseVector (cmdSexp,-1,&status,R_NilValue));
>   UNPROTECT_PTR (cmdSexp);
> 
>   if (status == PARSE_OK) {		
>     for (i = 0; i < length (cmdExpr); i++) {
>       PROTECT(e = VECTOR_ELT (cmdExpr,i));
>       R_tryEval(e, R_GlobalEnv, &errorOccurred);
>       UNPROTECT_PTR(e);
>       if (errorOccurred) {
> 	return;		
>       }
>     }
>   }
> }
> 
> void initR()
> {
>   char *argv[] = {"REmbeddedPascal", "--gui=none", "--silent",  
> "--no-save"};
>   int argc = 4;
>   DllInfo *info;
> 
>   setenv("R_HOME","/usr/lib/R",0);
> 
>   structRstart rp;
>   Rstart Rp = &rp;
> 
>   R_setStartTime();
>   R_DefParams(Rp);
> 
>   Rp->R_Quiet = TRUE;
>   Rp->RestoreAction = SA_RESTORE;
>   Rp->SaveAction = SA_NOSAVE;
>   R_SetParams(Rp);
> 
>   R_Interactive = TRUE;
> 
>   Rf_initialize_R(argc, argv);
>   setup_Rmainloop();
>   R_ReplDLLinit();
>   info = R_getEmbeddingDllInfo();
>   R_registerRoutines(info, cMethods, callMethods, NULL, NULL);
> }
> 
> int main (int argc, char** argv)
> {
>   int i;
>   initR();
> 
>   r_exec("x <- function (f) { .Call(\"set_callback1\",f); }");
>   r_exec("y <- function (f) { .Call(\"set_callback2\",f); }");
>   r_exec("x(function() { print(\"A\"); })");
>   r_exec("y(function() { print(\"B\"); })");
> 
>   for (i = 0; i < 100000; i++) {
>     r_trigger_callback1();
>     r_trigger_callback2();
>   }
> 
>   Rf_endEmbeddedR(0);
> }
> 
> 
> -- 
> Bernd Schoeller, PhD, CTO
> Comerge AG, Technoparkstrasse 1, CH-8055 Zurich, www.comerge.net
> 
> ______________________________________________
> R-devel at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-devel

-- 
"There are men who can think no deeper than a fact" - Voltaire


Duncan Temple Lang                duncan at wald.ucdavis.edu
Department of Statistics          work:  (530) 752-4782
4210 Mathematical Sciences Bldg.  fax:   (530) 752-7099
One Shields Ave.
University of California at Davis
Davis, CA 95616, USA



-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 189 bytes
Desc: not available
URL: <https://stat.ethz.ch/pipermail/r-devel/attachments/20090108/c6f51898/attachment.bin>


[Rd] Callbacks seems to get GCed.
Duncan Temple Lang