[Rd] Using R_MakeExternalPtr

[Ross Boylan]

See at bottom for an example.
On Wed, 2007-07-25 at 11:26 -0700, Jonathan Zhou wrote:
> Hi Hin-Tak,
> 
> Here is the R code function in where I called the two C++ and further below
> are the 2 C++ functions I used to create the externalptr and use it :
> 
> soam.Rapply <- function (x, func, ...,
>                           join.method=cbind,
>                           njobs,
>                           batch.size=100,
>                           packages=NULL,
>                           savelist=NULL)
> {
>    if(missing(njobs))
>        njobs <- max(1,ceiling(nrow(x)/batch.size))
> 
>    if(!is.matrix(x) && !is.data.frame(x))
>        stop("x must be a matrix or data frame")
> 
>    if(njobs>1)
>        {rowSet <- lapply(splitIndices(nrow(x), njobs), function(i) x[i, ,
> drop = FALSE])} else {rowSet <- list(x)}
> 
>    sesCon <- .Call("soamInit")
> 
>    script <- " "
> 
>    fname <- tempfile(pattern = "Rsoam_data", tmpdir = getwd())
>    file(fname, open="w+")
>    if(!is.null(savelist)) {
>        dump(savelist, fname)
>        script<-readLines(fname)
>    }
> 
>    if(!is.null(packages))
>    for(counter in 1:length(packages))
>    {
>        temp<-call("library", packages[counter], character.only=TRUE)
>        dput(temp, fname)
>        pack.call<-readLines(fname)
>        script<-append(script, pack.call)
>    }
> 
>    for(counter in 1:njobs)
>    {
>        caller <- paste("caller", counter, sep = "")
>        soam.call<-call("dput", call("apply", X=rowSet[[counter]], MARGIN=1,
> FUN=func), caller)
>        dput(soam.call, fname)
>        soam.call<-readLines(fname)
> 
>        temp<-append(script, soam.call)
>        final.script = temp[1]
>        for(count in 2:length(temp)){
>            final.script<-paste(final.script, temp[count], "\n")}
> 
>        .Call("soamSubmit", counter, sesCon, final.script, packages)
>    }
> 
>    .Call("soamGetResults", sesCon, njobs, join.method, parent.frame())
> 
>    for(job in 1:njobs)
>    {
>        caller <- paste("result", job, sep = "")
>        temp = dget(caller)
>        if(job==1) {retval=temp} else {retval=join.method(retval,temp)}
>    }
> 
>    .Call("soamUninit")
> 
>    retval
> }
> 
> *** Here are the 2 C++ functions:
> 
> extern "C"
> {
> SEXP soamInit ()
> {
>    // Initialize the API
>    SoamFactory::initialize();
> 
>    // Set up application specific information to be supplied to Symphony
>    char appName[] = "SampleAppCPP";
> 
>    // Set up application authentication information using the default
> security provider
>    DefaultSecurityCallback securityCB("Guest", "Guest");
> 
>    // Connect to the specified application
>    ConnectionPtr conPtr = SoamFactory::connect(appName, &securityCB);
> 
>    // Set up session creation attributes
>    SessionCreationAttributes attributes;
>    attributes.setSessionName("mySession");
>    attributes.setSessionType("ShortRunningTasks");
>    attributes.setSessionFlags(SF_RECEIVE_SYNC);
> 
>    // Create a synchronous session
>    Session* sesPtr = conPtr->createSession(attributes);
// I use Rf_protect, though I'd be surprised if that matters given your
use
> 
>    SEXP out = R_MakeExternalPtr((void*)temp, R_NilValue, R_NilValue);
> 
// temp?  don't you mean sesPtr?
>    return out;
> }
> }
> 
> extern "C"
> {
>  void soamSubmit       (SEXP jobID,            //job ID
>                         SEXP sesCon,           //session pointer
>                         SEXP caller,                   //objects
>                         SEXP pack)                     //packages
> {
>        char* savelist = CHAR(STRING_ELT(caller, 0));
>        string strTemp = "";
>        int job = INTEGER(jobID)[0];
> 
>        void* temp = R_ExternalPtrAddr(sesCon);
>        Session* sesPtr = reinterpret_cast<Session*>(temp);
> 
>    // Create a message
>        MyMessage inMsg(job, /*pack,*/ savelist);
> 
>    // Send it
>    TaskInputHandlePtr input = sesPtr->sendTaskInput(&inMsg);
> }
> }

I've been able to get things working with this pattern (which also is
about assuring memory is freed)
Here's the pattern:
// I needed R_NO_REMAP to avoid name collisions.  You may not.
#define R_NO_REMAP 1
#include <R.h>
#include <Rinternals.h>

extern "C" {
// returns an |ExternalPtr|
SEXP makeManager(
        @<makeManager args@>);


// user should not need to call
// cleanup
void finalizeManager(SEXP ptr);

}

SEXP makeManager(
        @<makeManager args@>){
    // .... stuff

    Manager* pmanager = new Manager(pd, pm.release(), 
        *INTEGER(stepNumerator), *INTEGER(stepDenominator),
        (*INTEGER(isexact)) != 0);
    
    // one example didn't use |PROTECT()|
    SEXP ptr;
    Rf_protect(ptr = R_MakeExternalPtr(pmanager, R_NilValue,
R_NilValue));
    R_RegisterCFinalizer(ptr, (R_CFinalizer_t) finalizeManager);
    Rf_unprotect(1);
    return ptr;

}

void finalizeManager(SEXP ptr){
  Manager *pmanager = static_cast<Manager *>(R_ExternalPtrAddr(ptr));
  delete pmanager;
  R_ClearExternalPtr(ptr);
}

I'd love to hear from those more knowledgeable about whether I did
that right, and whether the FinalizerEx call can assure cleanup on
exit.

Make manager needes to be called from R like this
      mgr <- .Call("makeManager", args)


The to use it I have things like this:
// ptr is the value returned by |makeManager()|
// |do_what| is an integer requesting the kind of operation
SEXP compute(SEXP ptr, SEXP do_what){
  using namespace mspath;
  Manager *pmanager = static_cast<Manager *>(R_ExternalPtrAddr(ptr));
// you can probably stop reading there
  SEXP newvec;
  Rf_protect(newvec = Rf_allocVector(REALSXP, 6u));
  double *returned = REAL(newvec);
  std::stringstream serror;
  try { 
      pmanager->go(returned, *INTEGER(do_what));
      *returned *= -2;
    } catch(std::exception& exc) {
      serror << "Caught exception: " << exc.what();
    } catch(...) {
      serror << "Some non-standard exception was thrown" <<
std::endl;
    }
    if (! serror.str().empty()) {
      finalizeManager(ptr);  // kill manager
      Rf_error("%s", serror.str().c_str());
    }
   Rf_unprotect(1);
   return newvec;
}