Callbacks seems to get GCed.

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