[Swift-commit] r4059 - in SwiftApps/SwiftR/Swift: . R exec
noreply at svn.ci.uchicago.edu
noreply at svn.ci.uchicago.edu
Thu Feb 3 18:28:50 CST 2011
Author: tga
Date: 2011-02-03 18:28:49 -0600 (Thu, 03 Feb 2011)
New Revision: 4059
Modified:
SwiftApps/SwiftR/Swift/NAMESPACE
SwiftApps/SwiftR/Swift/R/Apply.R
SwiftApps/SwiftR/Swift/R/Export.R
SwiftApps/SwiftR/Swift/exec/SwiftRServer.R
SwiftApps/SwiftR/Swift/exec/start-swift
Log:
Checking in ongoing work on export mechanism.
It is not quite working yet, but there are only a couple of problems left ot resolve.
Modified: SwiftApps/SwiftR/Swift/NAMESPACE
===================================================================
--- SwiftApps/SwiftR/Swift/NAMESPACE 2011-02-03 22:22:36 UTC (rev 4058)
+++ SwiftApps/SwiftR/Swift/NAMESPACE 2011-02-04 00:28:49 UTC (rev 4059)
@@ -6,6 +6,10 @@
export(swiftDetach)
export(swiftDetachAll)
+export(swiftExport)
+export(swiftExportAll)
+export(swiftRemoveAll)
+
export(runAllSwiftTests)
export(basicSwiftTest)
exportPattern("^swiftTest")
Modified: SwiftApps/SwiftR/Swift/R/Apply.R
===================================================================
--- SwiftApps/SwiftR/Swift/R/Apply.R 2011-02-03 22:22:36 UTC (rev 4058)
+++ SwiftApps/SwiftR/Swift/R/Apply.R 2011-02-04 00:28:49 UTC (rev 4059)
@@ -148,7 +148,9 @@
writeRequestBatches <- function (func, arglists, initialexpr,
- reqdir, callsperbatch) {
+ reqdir, callsperbatch, exportlist=NULL) {
+
+ if (is.null(exportlist)) exportlist <- getOption(".swift.exports")
# Write the function call info out to cbatch.?.RData files in reqdir
# in batches of size specified by callsperbatch
# returns the number of batches written
@@ -168,7 +170,9 @@
arglistbatch[[i]] <- arglists[[arglist]]
arglist <- arglist +1
}
- rcall <- list(initializer=initialexpr,func=func,arglistbatch=arglistbatch)
+ rcall <- list(initializer=initialexpr,
+ imports=exportlist,
+ func=func,arglistbatch=arglistbatch)
save(rcall,
file=file.path(reqdir,
paste("cbatch.",as.character(batch),".Rdata",sep="")))
@@ -274,13 +278,13 @@
# Wait for reply from service
res <- readFifo(resultPipeName, timeout=timeout)
+ if (length(res) == 0) {
+ stop(paste("Zero length response on named pipe ", resultPipeName))
+ }
if (is.na(res)) {
stop(paste("Timeout of ", timeout, "ms exceeded when waiting",
"for response from swift server"))
}
- if (length(res) == 0) {
- stop(paste("Zero length response on named pipe ", resultPipeName))
- }
return (res)
}
Modified: SwiftApps/SwiftR/Swift/R/Export.R
===================================================================
--- SwiftApps/SwiftR/Swift/R/Export.R 2011-02-03 22:22:36 UTC (rev 4058)
+++ SwiftApps/SwiftR/Swift/R/Export.R 2011-02-04 00:28:49 UTC (rev 4059)
@@ -47,22 +47,17 @@
}
#TODO: not implemented
-swiftExport <- function (..., list=NULL) {
+swiftExport <- function (..., list=NULL, expFile=NULL) {
# List of object names (as R symbols or as strings)
# These will be passed directly to save() to be serialized
-
- cat("Got here")
- cat("Got here")
-
-
- #Pseudocode:
+ # TODO: For now,while testing, must manually specify location
# TODO: choose file location
# expFile <- ???
save(..., list=list, file=expFile)
exportList <- getOption(".swift.exports")
if (is.null(exportList))
exportList = list() #TODO: start with removeAll command?
- exportList[[length(exportList) + 1]] = c("export", expFile)
+ exportList[[length(exportList) + 1]] = c("import", expFile)
options(.swift.exports=exportList)
}
Modified: SwiftApps/SwiftR/Swift/exec/SwiftRServer.R
===================================================================
--- SwiftApps/SwiftR/Swift/exec/SwiftRServer.R 2011-02-03 22:22:36 UTC (rev 4058)
+++ SwiftApps/SwiftR/Swift/exec/SwiftRServer.R 2011-02-04 00:28:49 UTC (rev 4059)
@@ -46,6 +46,8 @@
}
doInit <- function(initializer) {
+ #print(sprintf("received initializer=%s latestInitializer=%s\n",
+ # initializer, latestInitializer));
if( initializer != latestInitializer) {
initialExpr <- parse(text=initializer)
eval(initialExpr)
@@ -54,32 +56,95 @@
}
}
+failBatch <- function(rcall, try.error, resultBatchFileName) {
+ # This function is called when an error occurs and
+ # no valid argument values can be produced
+ # It fills a result array with the try.error object
+ # and writes it to resultBatchFileName
+ result <- list()
+ for (c in 1:length(rcall$arglistbatch)) {
+ result[[c]] <- try.error
+ }
+ save(result,file=resultBatchFileName)
+}
+
runBatch <- function( callBatchFileName, resultBatchFileName )
{
- result <- list()
success <- try(load(callBatchFileName));
- if (!inherits(success, "try-error")) {
- success <- try(doInit(rcall$initializer))
+ if (inherits(success, "try-error")) {
+ failBatch(rcall, success, resultBatchFileName)
+ return
}
+ success <- try(doInit(rcall$initializer))
if (inherits(success, "try-error")) {
- # Load or initialiser failed, return an error for all elements
- for (c in 1:length(rcall$arglistbatch)) {
- result[[c]] <- success
- }
- save(result,file=resultBatchFileName)
+ failBatch(rcall, success, resultBatchFileName)
+ return
}
- else {
- # print(sprintf("received initializer=%s latestInitializer=%s\n",initializer, latestInitializer));
+ success <- try(loadImports(rcall$imports))
+ if (inherits(success, "try-error")) {
+ failBatch(rcall, success, resultBatchFileName)
+ }
- for(c in 1:length(rcall$arglistbatch)) {
- # FIXME: run this under try/catch and save error status in results object (need to make it a list: rval + error status)
- result[[c]] = try(do.call( rcall$func,
- as.list(rcall$arglistbatch[[c]] )))
- }
- save(result,file=resultBatchFileName)
+ result <- list()
+ for(c in 1:length(rcall$arglistbatch)) {
+ # FIXME: run this under try/catch and save error status
+ # in results object (need to make it a list: rval + error status)
+ result[[c]] = try(do.call( rcall$func,
+ as.list(rcall$arglistbatch[[c]] )))
}
+ save(result,file=resultBatchFileName)
}
+loadImports <- function (importlist) {
+ # importlist is a list of directives to be carried out in sequence.
+ # There are two distinct directives which appear in the first position:
+ # - removeAll removes all global R objects
+ # - import comes with an argument in the second position which is
+ # the location of an R file to import
+ for (imp in importlist) {
+ directive <- imp[1]
+ if (directive == "import") {
+ # Load the contents of the specified file
+ # into the global environment
+ file <- imp[2]
+ if (!exists(".swift.imported")) {
+ .swift.imported <<- new.env(hash=T, parent=emptyenv())
+ doImport <- TRUE
+ }
+ else {
+ # check to see if already imported
+ doImport <- !exists(file, envir=.swift.imported)
+ }
+ if (doImport) {
+ #TODO: load can fail with warning
+ load(file, envir=globalenv())
+ # if an error occurs here, assume calling function
+ # will catch it
+ assign(file, TRUE, envir=.swift.imported)
+ cat("Loaded file ", file, "\n")
+ }
+ else {
+ cat("Ignored file ", file, "\n")
+ }
+ }
+ else if (directive == "removeAll") {
+ # delete all visible objects in global environment
+ # TODO: need to record that we did this removeAll
+ cat("Deleting ", ls(envir=globalenv()))
+ #TODO: this fails because it deletes the functions in
+ # this file from the environment
+ rm(list=ls(envir=globalenv()))
+ # reset record of imported items
+ if (exists(".swift.imported", envir=globalenv()))
+ rm(.swift.imported, envir=globalenv())
+ cat("Deleted all")
+ }
+ else {
+ stop(paste("Invalid import directive", directive))
+ }
+ }
+}
+
cat("calling server: dir=",fifoDir,"\n")
setwd(fifoDir)
SwiftRFifoServer(fifoDir)
Modified: SwiftApps/SwiftR/Swift/exec/start-swift
===================================================================
--- SwiftApps/SwiftR/Swift/exec/start-swift 2011-02-03 22:22:36 UTC (rev 4058)
+++ SwiftApps/SwiftR/Swift/exec/start-swift 2011-02-04 00:28:49 UTC (rev 4059)
@@ -466,11 +466,14 @@
# Find and terminate R workers: they should register their PiD
# in a standard location based on the pid of this start-swift
# script
- for rwork in `(shopt -s nullglob; echo ../Rworkers/worker.$$/*/)`
- do
- kill `cat $rwork/R.pid` &> /dev/null
- rm -rf $rwork
- done
+ if [ "$keepdir" = "FALSE" ]
+ then
+ for rwork in `(shopt -s nullglob; echo ../Rworkers/worker.$$/*/)`
+ do
+ kill `cat $rwork/R.pid` &> /dev/null
+ rm -rf $rwork
+ done
+ fi
stdcleanup_end
exit 0
}
More information about the Swift-commit
mailing list