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@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
