Re: [Rd] Using R_MakeExternalPtr

From: Ross Boylan <ross_at_biostat.ucsf.edu>
Date: Wed, 25 Jul 2007 20:55:30 -0700

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

R-devel_at_r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel Received on Thu 26 Jul 2007 - 03:58:47 GMT

Archive maintained by Robert King, hosted by the discipline of statistics at the University of Newcastle, Australia.
Archive generated by hypermail 2.2.0, at Thu 26 Jul 2007 - 11:36:37 GMT.

Mailing list information is available at https://stat.ethz.ch/mailman/listinfo/r-devel. Please read the posting guide before posting to the list.