Re: [Rd] Using R_MakeExternalPtr

From: Hin-Tak Leung <hin-tak.leung_at_cimr.cam.ac.uk>
Date: Fri, 27 Jul 2007 21:19:31 +0100

As others as commented, everything going in/out of the .Call() interface needs to be SEXP (even if it does nothing and you are returning R_NilValue).

Secondly, your attached code is both (1) too long, and (2) incomplete.

You should write some *simple* R code that uses only soamInit() and soamUnInit() (the latter is missing and you had not included it), Then fill the middle with soamSubmit(). Nobody really want to read your 60+ line of R code (too long) and incomplete C code (too short) to work out what's broken. Use complete and short examples to illustrate your problem!

Also, you seem to take for granted that the typo/length of Argument in soamSubmit() are those you think they are... e.g. I would put in say, for example:

if ((JobID == R_NilValue) || ( TYPEOF(JobID) != INTSXP)) {

     Rprintf("JobID unexpected!\n");
     return R_NilValue;

}

Just to be on the safe side. You may find some surprises there - trying to do INTEGER() on a REALSXP, or vice versa can be dangerous.

I am still not convinced that your segfault is to do with externalptr - e.g. the '.Call() must return SEXP' is a basic R extension usage and you didn't understand that one.

Jonathan Zhou wrote:
> Hi all,
>
> 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);
>
> SEXP out = R_MakeExternalPtr((void*)temp, R_NilValue, R_NilValue);
>
> 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);
> }
> }



R-devel_at_r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel Received on Fri 27 Jul 2007 - 20:23:40 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 Sat 28 Jul 2007 - 16:36:44 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.