[Rd] Callbacks seems to get GCed.

[Bernd Schoeller]

Dear Duncan,

Thank you for your suggestion. I did not know about R_PreserveObject, this is exactly what we needed. You have been very helpful.

Regards,
  Bernd

On Thu, 08 Jan 2009 15:59:25 +0100, Duncan Temple Lang <duncan at wald.ucdavis.edu> wrote:

>
> 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
>



-- 
Bernd Schoeller, PhD, CTO
Comerge AG, Technoparkstrasse 1, CH-8055 Zurich, www.comerge.net