diff -Nru r-cran-multicore-0.1-7/debian/changelog r-cran-multicore-0.2/debian/changelog --- r-cran-multicore-0.1-7/debian/changelog 2014-05-18 00:27:13.000000000 +0000 +++ r-cran-multicore-0.2/debian/changelog 2014-05-18 00:27:13.000000000 +0000 @@ -1,3 +1,12 @@ +r-cran-multicore (0.2-1) unstable; urgency=low + + * New upstream release + + * debian/control: Set Build-Depends: to current R version + * debian/control: Set Standards-Version: to current version + + -- Dirk Eddelbuettel Sat, 17 May 2014 06:49:00 -0500 + r-cran-multicore (0.1-7-2) unstable; urgency=low * debian/control: Set Build-Depends: to current R version diff -Nru r-cran-multicore-0.1-7/debian/control r-cran-multicore-0.2/debian/control --- r-cran-multicore-0.1-7/debian/control 2014-05-18 00:27:13.000000000 +0000 +++ r-cran-multicore-0.2/debian/control 2014-05-18 00:27:13.000000000 +0000 @@ -2,8 +2,8 @@ Section: gnu-r Priority: optional Maintainer: Dirk Eddelbuettel -Build-Depends: debhelper (>= 7.0.0), r-base-dev (>= 3.0.0~20130327), cdbs -Standards-Version: 3.9.4 +Build-Depends: debhelper (>= 7.0.0), r-base-dev (>= 3.1.0), cdbs +Standards-Version: 3.9.5 Homepage: http://www.rforge.net/multicore Package: r-cran-multicore diff -Nru r-cran-multicore-0.1-7/DESCRIPTION r-cran-multicore-0.2/DESCRIPTION --- r-cran-multicore-0.1-7/DESCRIPTION 2011-09-08 04:11:11.000000000 +0000 +++ r-cran-multicore-0.2/DESCRIPTION 2014-05-17 09:42:59.000000000 +0000 @@ -1,19 +1,17 @@ Package: multicore -Version: 0.1-7 -Title: Parallel processing of R code on machines with multiple cores or - CPUs -Author: Simon Urbanek -Maintainer: Simon Urbanek -Depends: R (>= 2.0.0) -Description: This package provides a way of running parallel - computations in R on machines with multiple cores or CPUs. Jobs - can share the entire initial workspace and it provides methods - for results collection. +Version: 0.2 +Title: A stub package to ease transition to 'parallel'. +Author: Simon Urbanek +Maintainer: CRAN team +Depends: R (>= 2.14.0) +Imports: parallel, tools +Description: A stub package to ease transition to 'parallel'. + It imports from 'parallel' or 'tools' and re-exports most of the + functionality formerly in package 'multicore'. + This will be removed from CRAN during 2014. License: GPL-2 -SystemRequirements: POSIX-compliant OS (essentially anything but - Windows; some Windows variants are supported experimentally, - your mileage may vary) OS_type: unix -URL: http://www.rforge.net/multicore/ +Packaged: 2014-05-17 09:39:13 UTC; ripley +NeedsCompilation: no Repository: CRAN -Date/Publication: 2011-09-08 04:11:11 +Date/Publication: 2014-05-17 11:42:59 diff -Nru r-cran-multicore-0.1-7/man/children.Rd r-cran-multicore-0.2/man/children.Rd --- r-cran-multicore-0.1-7/man/children.Rd 2011-09-08 01:57:38.000000000 +0000 +++ r-cran-multicore-0.2/man/children.Rd 1970-01-01 00:00:00.000000000 +0000 @@ -1,86 +0,0 @@ -\name{children} -\alias{children} -\alias{readChild} -\alias{readChildren} -\alias{selectChildren} -\alias{sendChildStdin} -\alias{kill} -\title{ - Functions for management of parallel children processes -} -\description{ - \code{children} returns currently active children - - \code{readChild} reads data from a given child process - - \code{selectChildren} checks children for available data - - \code{readChildren} checks children for available data and reads - from the first child that has available data - - \code{sendChildStdin} sends string (or data) to child's standard input - - \code{kill} sends a signal to a child process -} -\section{Warning}{ - This is a very low-level API for expert use only. If you are - interested in user-level parallel execution use - \code{\link{mclapply}}, \code{\link{parallel}} and friends instead. -} -\usage{ -children(select) -readChild(child) -readChildren(timeout = 0) -selectChildren(children = NULL, timeout = 0) -sendChildStdin(child, what) -kill(process, signal = SIGINT) -} -\arguments{ -\item{select}{if omitted, all active children are returned, otherwise - \code{select} should be a list of processes and only those form the - list that are active will be returned.} -\item{child}{child process (object of the class \code{childProcess}) or a -process ID (pid)} -\item{timeout}{timeout (in seconds, fractions supported) to wait -before giving up. Negative numbers mean wait indefinitely (strongly -discouraged as it blocks R and may be removed in the future).} -\item{children}{list of child processes or a single child process -object or a vector of process IDs or \code{NULL}. If \code{NULL} -behaves as if all currently known children were supplied.} -\item{what}{character or raw vector. In the former case elements are -collapsed using the newline chracter. (But no trailing newline is -added at the end!)} -\item{process}{process (object of the class \code{process}) or a -process ID (pid)} -\item{signal}{signal to send (one of \code{SIG...} constants -- see -\code{\link{signals}} -- or a valid integer signal number)} -} -\value{ - \code{children} returns a list of child processes (or an empty list) - - \code{readChild} and \code{readChildren} return a raw vector with a - \code{"pid"} attribute if data were available, integer vector of - length one with the process ID if a child terminated or \code{NULL} - if the child no longer exists (no children at all for - \code{readChildren}). - - \code{selectChildren} returns \code{TRUE} is the timeout was reached, - \code{FALSE} if an error occurred (e.g. if the master process was - interrupted) or an integer vector of process IDs with children that - have data available. - - \code{sendChildStdin} sends given content to the standard input - (stdin) of the child process. Note that if the master session was - interactive, it will also be echoed on the standard output of the - master process (unless disabled). The function is vector-compatible, - so you can specify more than one child as a list or a vector of - process IDs. - - \code{kill} returns \code{TRUE}. -} -\seealso{ - \code{\link{fork}}, \code{\link{sendMaster}}, - \code{\link{parallel}}, \code{\link{mclapply}} -} -\author{Simon Urbanek} -\keyword{interface} diff -Nru r-cran-multicore-0.1-7/man/fork.Rd r-cran-multicore-0.2/man/fork.Rd --- r-cran-multicore-0.1-7/man/fork.Rd 2011-09-08 01:57:38.000000000 +0000 +++ r-cran-multicore-0.2/man/fork.Rd 1970-01-01 00:00:00.000000000 +0000 @@ -1,80 +0,0 @@ -\name{fork} -\alias{fork} -\alias{exit} -\title{ - Fork a copy of the current R process -} -\description{ - \code{fork} creates a new child process as a copy of the current R process - - \code{exit} closes the current child process, informing the master process as necessary -} -\section{Warning}{ - This is a very low-level API for expert use only. If you are - interested in user-level parallel execution use - \code{\link{mclapply}}, \code{\link{parallel}} and friends instead. -} -\usage{ -fork() -exit(exit.code = 0L, send = NULL) -} -\arguments{ -\item{exit.code}{process exit code. Currently it is not used by -multicore, but other applciations might. By convention 0 signifies -clean exit, 1 an error.} -\item{send}{if not \code{NULL} send this data before exiting -(equivalent to using \code{\link{sendMaster}})} -} -\value{ - \code{fork} returns an object of the class \code{childProcess} (to - the master) and \code{masterProcess} (to the child). - - \code{exit} never returns -} -\details{ - The \code{fork} function provides an interface to the \code{fork} - system call. In addition it sets up a pipe between the master and - child process that can be used to send data from the child process - to the master (see \code{\link{sendMaster}}) and child's stdin is - re-mapped to another pipe held by the master process (see - \code{link{sendChildStdin}}). - - If you are not familiar with the \code{fork} system call, do not - use this function since it leads to very complex inter-process - interactions among the R processes involved. - - In a nutshell \code{fork} spawns a copy (child) of the current - process, that can work in parallel to the master (parent) - process. At the point of forking both processes share exactly the - same state including the workspace, global options, loaded packages - etc. Forking is relatively cheap in modern operating systems and no - real copy of the used memory is created, instead both processes - share the same memory and only modified parts are copied. This makes - \code{fork} an ideal tool for parallel processing since there is no - need to setup the parallel working environment, data and code is - shared automatically from the start. - - It is \emph{strongly discouraged} to use \code{fork} in GUI or - embedded environments, because it leads to several processes sharing - the same GUI which will likely cause chaos (and possibly - crashes). Child processes should never use on-screen graphics - devices. -} -\note{ - Windows opearting system lacks the \code{fork} system call so it - cannot be used with multicore. -} -\seealso{ - \code{\link{parallel}}, \code{\link{sendMaster}} -} -\examples{ - p <- fork() - if (inherits(p, "masterProcess")) { - cat("I'm a child! ", Sys.getpid(), "\n") - exit(,"I was a child") - } - cat("I'm the master\n") - unserialize(readChildren(1.5)) -} -\author{Simon Urbanek} -\keyword{interface} diff -Nru r-cran-multicore-0.1-7/man/mclapply.Rd r-cran-multicore-0.2/man/mclapply.Rd --- r-cran-multicore-0.1-7/man/mclapply.Rd 2011-09-08 01:57:38.000000000 +0000 +++ r-cran-multicore-0.2/man/mclapply.Rd 1970-01-01 00:00:00.000000000 +0000 @@ -1,93 +0,0 @@ -\name{mclapply} -\alias{mclapply} -\title{ - Parallel version of lapply -} -\description{ - \code{mclapply} is a parallelized version of \code{\link{lapply}}, - it returns a list of the same length as \code{X}, each element of - which is the result of applying \code{FUN} to the corresponding - element of \code{X}. -} -\usage{ -mclapply(X, FUN, ..., mc.preschedule = TRUE, mc.set.seed = TRUE, - mc.silent = FALSE, mc.cores = getOption("cores"), mc.cleanup = TRUE) -} -\arguments{ -\item{X}{a vector (atomic or list) or an expressions vector. Other -objects (including classed objects) will be coerced by -\code{\link{as.list}}.} -\item{FUN}{the function to be applied to each element of \code{X}} -\item{...}{optional arguments to \code{FUN}} -\item{mc.preschedule}{if set to \code{TRUE} then the computation is -first divided to (at most) as many jobs are there are cores and then -the jobs are started, each job possibly covering more than one -value. If set to \code{FALSE} then one job is spawned for each value -of \code{X} sequentially (if used with \code{mc.set.seed=FALSE} then -random number sequences will be identical for all values). The former -is better for short computations or large number of values in -\code{X}, the latter is better for jobs that have high variance of -completion time and not too many values of \code{X}.} -\item{mc.set.seed}{if set to \code{TRUE} then each parallel process -first sets its seed to something different from other -processes. Otherwise all processes start with the same (namely -current) seed.} -\item{mc.silent}{if set to \code{TRUE} then all output on stdout will be -suppressed for all parallel processes spawned (stderr is not affected).} -\item{mc.cores}{The number of cores to use, i.e. how many processes - will be spawned (at most)} -\item{mc.cleanup}{if set to \code{TRUE} then all children that have been - spawned by this function will be killed (by sending \code{SIGTERM}) - before this function returns. Under normal circumstances - \code{mclapply} waits for the children to deliver results, so this - option usually has only effect when \code{mclapply} is interrupted. - If set to \code{FALSE} then child processes are collected, but not - forcefully terminated. As a special case this argument can be set to - the signal value that should be used to kill the children instead of - \code{SIGTERM}.} -} -\value{ - A list. -} -\details{ - \code{mclapply} is a parallelized version of \code{lapply}, but there - is an important difference: \code{mclapply} does not affect the - calling environment in any way, the only side-effect is the delivery - of the result (with the exception of a fall-back to \code{lapply} when - there is only one core). - - By default (\code{mc.preschedule=TRUE}) the input vector/list \code{X} - is split into as many parts as there are cores (currently the values - are spread across the cores sequentially, i.e. first value to core - 1, second to core 2, ... (core + 1)-th value to core 1 etc.) and - then one process is spawned to each core and the results are - collected. - - Due to the parallel nature of the execution random numbers are not - sequential (in the random number sequence) as they would be in - \code{lapply}. They are sequential for each spawned process, but not - all jobs as a whole. - - In addition, each process is running the job inside \code{try(..., - silent=TRUE)} so if error occur they will be stored as - \code{try-error} objects in the list. - - Note: the number of file descriptors is usually limited by the - operating system, so you may have trouble using more than 100 cores - or so (see \code{ulimit -n} or similar in your OS documentation) - unless you raise the limit of permissible open file descriptors - (fork will fail with "unable to create a pipe"). -} -\seealso{ - \code{\link{parallel}}, \code{\link{collect}} -} -\examples{ - mclapply(1:30, rnorm) - # use the same random numbers for all values - set.seed(1) - mclapply(1:30, rnorm, mc.preschedule=FALSE, mc.set.seed=FALSE) - # something a bit bigger - albeit still useless :P - unlist(mclapply(1:32, function(x) sum(rnorm(1e7)))) -} -\author{Simon Urbanek} -\keyword{interface} diff -Nru r-cran-multicore-0.1-7/man/multicore-package.Rd r-cran-multicore-0.2/man/multicore-package.Rd --- r-cran-multicore-0.1-7/man/multicore-package.Rd 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-multicore-0.2/man/multicore-package.Rd 2014-05-14 08:04:01.000000000 +0000 @@ -0,0 +1,41 @@ +\name{multicore-package} +\alias{multicore-package} +\alias{multicore} +\alias{SIGCHLD} +\alias{SIGHUP} +\alias{SIGINT} +\alias{SIGKILL} +\alias{SIGQUIT} +\alias{SIGSTOP} +\alias{SIGTERM} +\alias{SIGUSR1} +\alias{SIGUSR2} +\alias{children} +\alias{collect} +\alias{exit} +\alias{fork} +\alias{kill} +\alias{mclapply} +\alias{mcparallel} +\alias{parallel} +\alias{processID} +\alias{pvec} + +\title{ +The 'multicore' Package +} +\description{ + Package \pkg{multicore} was superseded by \pkg{parallel} in 2011. This + is a transitional stub which will be removed during 2014. + + Most of the objects previously provided by \pkg{multicore} have been + imported here from \pkg{parallel} or \pkg{tools} and exported. + + Objects \code{SIGALARM}, \code{SIGINFO}, \code{readChild}, + \code{readChildren}, \code{selectChildren}, \code{sendChildStdin} and + \code{sendMaster} are no longer available. +} +\examples{ +### consult the corresponding help pages in package 'parallel' +} +\keyword{ package } diff -Nru r-cran-multicore-0.1-7/man/multicore.Rd r-cran-multicore-0.2/man/multicore.Rd --- r-cran-multicore-0.1-7/man/multicore.Rd 2011-09-08 01:57:38.000000000 +0000 +++ r-cran-multicore-0.2/man/multicore.Rd 1970-01-01 00:00:00.000000000 +0000 @@ -1,105 +0,0 @@ -\name{multicore} -\alias{multicore} -\alias{process} -\alias{childProcess} -\alias{masterProcess} -\alias{parallelJob} -\title{ - multicore R package for parallel processing of R code -} -\description{ -\emph{multicore} is an R package that provides functions for parallel -execution of R code on machines with multiple cores or CPUs. Unlike -other parallel processing methods all jobs share the full state of -R when spawned, so no data or code needs to be initialized. The -actual spawning is very fast as well since no new R instance needs to -be started. -} -\section{Pivotal functions}{ -\code{\link{mclapply}} - parallelized version of \code{\link{lapply}} - -\code{\link{pvec}} - parallelization of vectorized functions - -\code{\link{parallel}} and \code{\link{collect}} - functions to -evaluate R expressions in parallel and collect the results. -} -\section{Low-level functions}{ -Those function should be used only by experienced users understanding -the interaction of the master (parent) process and the child processes -(jobs) as well as the system-level mechanics involved. - -See \code{\link{fork}} help page for the principles of forking -parallel processes and system-level functions, \code{\link{children}} -and \code{\link{sendMaster}} help pages for management and -communication between the parent and child processes. -} -\section{Classes}{ -\emph{multicore} defines a few informal (S3) classes: - -\code{process} is a list with a named entry \code{pid} containing the -process ID. - -\code{childProcess} is a subclass of \code{process} representing a -child process of the current R process. A child process is a special -process that can send messages to the parent process. The list may -contain additional entries for IPC (more precisely file descriptors), -however those are considered internal. - -\code{masterProcess} is a subclass of \code{process} representing a -handle that is passed to a child process by \code{\link{fork}}. - -\code{parallelJob} is a subclass of \code{childProcess} representing a -child process created using the \code{\link{parallel}} function. It -may (optionally) contain a \code{name} entry -- a character vector -of the length one as the name of the job. -} -\section{Options}{ -By default functions that spawn jobs across cores use the -\code{"cores"} option (see \code{\link{options}}) to determine how -many cores (or CPUs) will be used (unless specified directly). If this -option is not set, \emph{multicore} uses by default as many cores as -there are available. (Note: \emph{cores} in this document refer to -virtual cores. Modern CPUs can have more virutal cores than physical -cores to accommodate simultaneous multithreading. For example, a machine -with two quad-core Xeon W5590 processors has combined eight physical -cores but 16 virtual cores. Also note that it is often beneficial to -schedule more tasks than cores.) - -The number of available cores is determined on startup using the -(non-exported) \code{detectCores()} function. It should work on most -commonly used unix systems (Mac OS X, Linux, Solaris and IRIX), but -there is no standard way of determining the number of cores, so -please contact me (with \code{sessionInfo()} output and the test) if -you have tests for other platforms. If in doubt, use -\code{multicore:::detectCores(all.tests=TRUE)} to see whether your -platform is covered by one of the already existing tests. If multicore -cannot determine the number of cores (the above returns \code{NA}), it -will default to 8 (which should be fine for most modern desktop -systems). -} -\section{Warning}{ -\emph{multicore} uses the \code{fork} system call to spawn a copy of -the current process which performs the compultations in -parallel. Modern operating systems use copy-on-write approach which -makes this so appealing for parallel computation since only objects -modified during the computation will be actually copied and all other -memory is directly shared. - -However, the copy shares everything including any user interface -elements. This can cause havoc since let's say one window now suddenly -belongs to two processes. Therefore \emph{multicore} should be -preferrably used in console R and code executed in parallel may -never use GUIs or on-screen devices. - -An (experimental) way to avoid some such problems in some GUI -environments (those using pipes or sockets) is to use -\code{multicore:::closeAll()} in each child process immediately after -it is spawned. -} -\seealso{ - \code{\link{parallel}}, \code{\link{mclapply}}, - \code{\link{fork}}, \code{\link{sendMaster}}, \code{\link{children}} - and \code{\link{signals}} -} -\author{Simon Urbanek} -\keyword{interface} diff -Nru r-cran-multicore-0.1-7/man/parallel.Rd r-cran-multicore-0.2/man/parallel.Rd --- r-cran-multicore-0.1-7/man/parallel.Rd 2011-09-08 01:57:38.000000000 +0000 +++ r-cran-multicore-0.2/man/parallel.Rd 1970-01-01 00:00:00.000000000 +0000 @@ -1,96 +0,0 @@ -\name{parallel} -\alias{parallel} -\alias{collect} -\alias{mcparallel} -\title{ - Evaluate an expression asynchronously in a separate process -} -\description{ - \code{parallel} starts a parallel process which evaluates the given expression. - - \code{mcparallel} is a synonym for \code{parallel} that can be used - at top level if \code{parallel} is masked by other packages. It - should not be used in other packages since it's just a shortcut for - importing \code{multicore::parallel}. - - \code{collect} collects results from parallel processes. -} -\usage{ -parallel(expr, name, mc.set.seed = FALSE, silent = FALSE) -mcparallel(expr, name, mc.set.seed = FALSE, silent = FALSE) -collect(jobs, wait = TRUE, timeout = 0, intermediate = FALSE) -} -\arguments{ -\item{expr}{expression to evaluate (do \emph{not} use any on-screen -devices or GUI elements in this code)} -\item{name}{an optional name (character vector of length one) that can be associated with the job.} -\item{mc.set.seed}{if set to \code{TRUE} then the random number -generator is seeded such that it is different from any other -process. Otherwise it will be the same as in the current R session.} -\item{silent}{if set to \code{TRUE} then all output on stdout will be -suppressed (stderr is not affected).} -\item{jobs}{list of jobs (or a single job) to collect results -for. Alternatively \code{jobs} can also be an integer vector of -process IDs. If omitted \code{collect} will wait for all currently -existing children.} -\item{wait}{if set to \code{FALSE} it checks for any results that are -available within \code{timeout} seconds from now, otherwise it waits -for all specified jobs to finish.} -\item{timeout}{timeout (in seconds) to check for job results - applies -only if \code{wait} is \code{FALSE}.} -\item{intermediate}{\code{FALSE} or a function which will be called while -\code{collect} waits for results. The function will be called with one -parameter which is the list of results received so far.} -} -\value{ - \code{parallel} returns an object of the class \code{parallelJob} - which is in turn a \code{childProcess}. - - \code{collect} returns any results that are available in a list. The - results will have the same order as the specified jobs. If there are - multiple jobs and a job has a name it will be used to name the - result, otherwise its process ID will be used. -} -\details{ - \code{parallel} evaluates the \code{expr} expression in parallel to - the current R process. Everything is shared read-only (or in fact - copy-on-write) between the parallel process and the current process, - i.e. no side-effects of the expression affect the main process. The - result of the parallel execution can be collected using - \code{collect} function. - - \code{collect} function collects any available results from parallel - jobs (or in fact any child process). If \code{wait} is \code{TRUE} - then \code{collect} waits for all specified jobs to finish before - returning a list containing the last reported result for each - job. If \code{wait} is \code{FALSE} then \code{collect} merely - checks for any results available at the moment and will not wait for - jobs to finish. If \code{jobs} is specified, jobs not listed there - will not be affected or acted upon. - - Note: If \code{expr} uses low-level \code{multicore} functions such - as \code{\link{sendMaster}} a single job can deliver results - multiple times and it is the responsibility of the user to interpret - them correctly. \code{collect} will return \code{NULL} for a - terminating job that has sent its results already after which the - job is no longer available. -} -\seealso{ - \code{\link{mclapply}}, \code{\link{sendMaster}} -} -\examples{ - p <- parallel(1:10) - q <- parallel(1:20) - collect(list(p, q)) # wait for jobs to finish and collect all results - - p <- parallel(1:10) - collect(p, wait=FALSE, 10) # will retrieve the result (since it's fast) - collect(p, wait=FALSE) # will signal the job as terminating - collect(p, wait=FALSE) # there is no such job - - # a naive parallelized lapply can be created using parallel alone: - jobs <- lapply(1:10, function(x) parallel(rnorm(x), name=x)) - collect(jobs) -} -\author{Simon Urbanek} -\keyword{interface} diff -Nru r-cran-multicore-0.1-7/man/process.Rd r-cran-multicore-0.2/man/process.Rd --- r-cran-multicore-0.1-7/man/process.Rd 2011-09-08 01:57:38.000000000 +0000 +++ r-cran-multicore-0.2/man/process.Rd 1970-01-01 00:00:00.000000000 +0000 @@ -1,33 +0,0 @@ -\name{process} -\alias{processID} -\alias{print.process} -\title{ - Function to query objects of the class process -} -\description{ - \code{processID} returns the process IDs for the given processes. It - raises an error if \code{process} is not an object of the class - \code{\link{process}} or a list of such objects. - - \code{print} methods shows the process ID and its class name. -} -\usage{ -processID(process) -\method{print}{process}(x, \dots) -} -\arguments{ -\item{process}{process (object of the class \code{process}) or a list -of such objects.} -\item{x}{process to print} -\item{...}{ignored} -} -\value{ - \code{processID} returns an integer vector contatining the process IDs. - - \code{print} returns \code{NULL} invisibly -} -\seealso{ - \code{\link{fork}} -} -\author{Simon Urbanek} -\keyword{interface} diff -Nru r-cran-multicore-0.1-7/man/pvec.Rd r-cran-multicore-0.2/man/pvec.Rd --- r-cran-multicore-0.1-7/man/pvec.Rd 2011-09-08 01:57:38.000000000 +0000 +++ r-cran-multicore-0.2/man/pvec.Rd 1970-01-01 00:00:00.000000000 +0000 @@ -1,97 +0,0 @@ -\name{pvec} -\alias{pvec} -\title{ -Parallelize a vector map function -} -\description{ -\code{pvec} parellelizes the execution of a function on vector elements -by splitting the vector and submitting each part to one core. The -function must be a vectorized map, i.e. it takes a vector input and -creates a vector output of exactly the same length as the input which -doesn't depend on the partition of the vector. -} -\usage{ -pvec(v, FUN, ..., mc.set.seed = TRUE, mc.silent = FALSE, - mc.cores = getOption("cores"), mc.cleanup = TRUE) -} -\arguments{ - \item{v}{vector to operate on} - \item{FUN}{function to call on each part of the vector} - \item{\dots}{any further arguments passed to \code{FUN} after the vector} - \item{mc.set.seed}{if set to \code{TRUE} then each parallel process - first sets its seed to something different from other - processes. Otherwise all processes start with the same (namely - current) seed.} - \item{mc.silent}{if set to \code{TRUE} then all output on stdout will - be suppressed for all parallel processes spawned (stderr is not - affected).} - \item{mc.cores}{The number of cores to use, i.e. how many processes - will be spawned (at most)} - \item{mc.cleanup}{flag specifying whether children should be - terminated when the master is aborted (see description of this - argument in \code{\link{mclapply}} for details)} -} -\details{ - \code{pvec} parallelizes \code{FUN(x, ...)} where \code{FUN} is a - function that returns a vector of the same length as - \code{x}. \code{FUN} must also be pure (i.e., without side-effects) - since side-effects are not collected from the parallel processes. The - vector is split into nearly identically sized subvectors on which - \code{FUN} is run. Although it is in principle possible to use - functions that are not necessarily maps, the interpretation would be - case-specific as the splitting is in theory arbitrary and a warning is - given in such cases. - - The major difference between \code{pvec} and \code{\link{mclapply}} is - that \code{mclapply} will run \code{FUN} on each element separately - whereas \code{pvec} assumes that \code{c(FUN(x[1]), FUN(x[2]))} is - equivalent to \code{FUN(x[1:2])} and thus will split into as many - calls to \code{FUN} as there are cores, each handling a subset - vector. This makes it much more efficient than \code{mclapply} but - requires the above assumption on \code{FUN}. -} -\value{ - The result of the computation - in a successful case it should be of - the same length as \code{v}. If an error ocurred or the function was - not a map the result may be shorter and a warning is given. -} -%\references{ -%} -%\author{ -%} -\note{ - Due to the nature of the parallelization error handling does not - follow the usual rules since errors will be returned as strings and - killed child processes will show up simply as non-existent - data. Therefore it is the responsibiliy of the user to check the - length of the result to make sure it is of the correct - size. \code{pvec} raises a warning if that is the case since it dos - not know whether such outcome is intentional or not. -} -\seealso{ -\code{\link{parallel}}, \code{\link{mclapply}} -} -\examples{ - x <- pvec(1:1000, sqrt) - stopifnot(all(x == sqrt(1:1000))) - - # a common use is to convert dates to unix time in large datasets - # as that is an awfully slow operation - # so let's get some random dates first - dates <- sprintf('\%04d-\%02d-\%02d', as.integer(2000+rnorm(1e5)), - as.integer(runif(1e5,1,12)), as.integer(runif(1e5,1,28))) - - # this takes 4s on a 2.6GHz Mac Pro - system.time(a <- as.POSIXct(dates)) - - # this takes 0.5s on the same machine (8 cores, 16 HT) - system.time(b <- pvec(dates, as.POSIXct)) - - stopifnot(all(a == b)) - - # using mclapply for this is much slower because each value - # will require a separate call to as.POSIXct() - system.time(c <- unlist(mclapply(dates, as.POSIXct))) - -} -\keyword{interface} diff -Nru r-cran-multicore-0.1-7/man/sendMaster.Rd r-cran-multicore-0.2/man/sendMaster.Rd --- r-cran-multicore-0.1-7/man/sendMaster.Rd 2011-09-08 01:57:38.000000000 +0000 +++ r-cran-multicore-0.2/man/sendMaster.Rd 1970-01-01 00:00:00.000000000 +0000 @@ -1,30 +0,0 @@ -\name{sendMaster} -\alias{sendMaster} -\title{ - Sends data from the child to to the master process -} -\description{ - \code{sendMaster} Sends data from the child to to the master process -} -\usage{ -sendMaster(what) -} -\arguments{ -\item{what}{data to send to the master process. If \code{what} is not -a raw vetor, \code{what} will be serialized into a raw vector. Do NOT -send an empty raw vector - it is reserved for internal use.} -} -\value{ - returns \code{TRUE} -} -\details{ - Any child process (created by \code{\link{fork}} directly or by - \code{\link{parallel}} indirectly) can send data to the parent - (master) process. Usually this is used to deliver results from the - parallel child processes to the master process. -} -\seealso{ - \code{\link{parallel}}, \code{\link{fork}} -} -\author{Simon Urbanek} -\keyword{interface} diff -Nru r-cran-multicore-0.1-7/man/signals.Rd r-cran-multicore-0.2/man/signals.Rd --- r-cran-multicore-0.1-7/man/signals.Rd 2011-09-08 01:57:38.000000000 +0000 +++ r-cran-multicore-0.2/man/signals.Rd 1970-01-01 00:00:00.000000000 +0000 @@ -1,49 +0,0 @@ -\name{signals} -\alias{signals} -\alias{SIGALRM} -\alias{SIGCHLD} -\alias{SIGHUP} -\alias{SIGINFO} -\alias{SIGINT} -\alias{SIGKILL} -\alias{SIGQUIT} -\alias{SIGSTOP} -\alias{SIGTERM} -\alias{SIGUSR1} -\alias{SIGUSR2} -\title{ - Signal constants (subset) -} -\description{ -\code{SIGALRM} alarm clock - -\code{SIGCHLD} to parent on child stop or exit - -\code{SIGHUP} hangup - -\code{SIGINFO} information request - -\code{SIGINT} interrupt - -\code{SIGKILL} kill (cannot be caught or ignored) - -\code{SIGQUIT} quit - -\code{SIGSTOP} sendable stop signal not from tty - -\code{SIGTERM} software termination signal from kill - -\code{SIGUSR1} user defined signal 1 - -\code{SIGUSR2} user defined signal 2 -} -\details{ - See \code{man signal} in your OS for details. The above codes can be - used in conjunction with the \code{\link{kill}} function to send - signals to processes. -} -\seealso{ - \code{\link{kill}} -} -\author{Simon Urbanek} -\keyword{interface} diff -Nru r-cran-multicore-0.1-7/MD5 r-cran-multicore-0.2/MD5 --- r-cran-multicore-0.1-7/MD5 2011-09-08 04:11:11.000000000 +0000 +++ r-cran-multicore-0.2/MD5 2014-05-17 09:42:59.000000000 +0000 @@ -1,24 +1,4 @@ -8a5bb2273d6610652b9ec3c5ec0a65c6 *DESCRIPTION -062b4319652c953308e5557b551d0a04 *NAMESPACE -5ace0e9b2b4b1cb54b0ea329b5ffe4e1 *NEWS -db201bd4f13c7ca369fb105e515b1ec5 *R/fork.R -e1106d81c77dbed838844157035a7c9a *R/mclapply.R -752a8d97c266a72ca9d3f13e8a8b7e64 *R/parallel.R -df61185cd5bff484ce25fdceb4b261d5 *R/print.R -52f28f21f4a0734840780ea98fea97b5 *R/pvec.R -7027660308ddbdb17f2a4d72e8b43464 *R/zzz.R -e525b9e60989eabbc3c816461651ac48 *man/children.Rd -a5bbdeb96be4c98320cc67ec227c69f3 *man/fork.Rd -d97ed592a2d3a4bc5db5817d737d0848 *man/mclapply.Rd -17ffb7dca1bad364d1959adda73ccd5f *man/multicore.Rd -62bac5b35ab94deb2b62c505ee932bf7 *man/parallel.Rd -0319df886a2a7a74d76bb5d34ebcf610 *man/process.Rd -afc3ce0d941fd86261ff19f27c5deabc *man/pvec.Rd -5cd47bb2fa413f0410a220833ec6a737 *man/sendMaster.Rd -35fab0e5ff984b7ec511c67dccf3b88e *man/signals.Rd -929e9090521f8c895a2bde7dbd1c4889 *src/Makevars.win -380dfe7b5b024a970d9faab673a3ae3f *src/fork.c -fd19daceed1512fcaf95843968cd555c *src/forknt.c -5c4765cd647a166397a6e2991bef0773 *src/perf.c -4809c18e318e3d0703b3213507a68783 *src/winfix.c -9c27c366ddd6854b5a9b6894566cd3f2 *src/winfix.h +3ff2d08377efe61066cb1b69f72cf5c7 *DESCRIPTION +b5621784581f5e644476b6eb7d9fc5b3 *NAMESPACE +533c47844c1d55dc691bfcac0706f5bf *R/zzz.R +f3231bce0b8579b3e159db7523da95fa *man/multicore-package.Rd diff -Nru r-cran-multicore-0.1-7/NAMESPACE r-cran-multicore-0.2/NAMESPACE --- r-cran-multicore-0.1-7/NAMESPACE 2011-09-08 01:57:38.000000000 +0000 +++ r-cran-multicore-0.2/NAMESPACE 2014-05-14 07:49:18.000000000 +0000 @@ -1,5 +1,11 @@ -exportPattern("^SIG") -export(fork, readChild, readChildren, selectChildren, children, kill, exit, sendMaster, sendChildStdin, processID) -export(mclapply, parallel, collect, mcparallel, pvec) -S3method(print, process) -useDynLib(multicore) + +importFrom(parallel, mclapply, pvec, mccollect, mcparallel) +export(mclapply, pvec, mcparallel) + +export(children, collect, exit, fork, kill, parallel, processID) + +importFrom(tools, SIGCHLD, SIGHUP, SIGINT, SIGKILL, + SIGQUIT, SIGSTOP, SIGTERM, SIGUSR1, SIGUSR2) +export(SIGCHLD, SIGHUP, SIGINT, SIGKILL, + SIGQUIT, SIGSTOP, SIGTERM, SIGUSR1, SIGUSR2) + diff -Nru r-cran-multicore-0.1-7/NEWS r-cran-multicore-0.2/NEWS --- r-cran-multicore-0.1-7/NEWS 2011-09-08 01:57:38.000000000 +0000 +++ r-cran-multicore-0.2/NEWS 1970-01-01 00:00:00.000000000 +0000 @@ -1,107 +0,0 @@ - NEWS/ChangeLog for multicore ------------------------------- - -0.1-7 2011-09-07 - o fix a bug introduced in 0.1-6 error checking for - non-pre-scheduled jobs - - -0.1-6 2011-09-02 - o mclapply() will issue a warning if any of the results is of - the class "try-error". For prescheduled calls the warning will - include the index of the core(s) that failed - to facilitate - debugging of the user code. - - o minor performance improvements were made by creating results - lists in C code and by resolving all native routines at load - time. - - o bugfix: errors in prescheduled mclapply could result in - incorrectly returned objects - - o bugfix: parallel() treated raw vector results as the result of - serialized objects - thus arbitrary raw vectors were not alowed. - (Thanks to Jeroen Ooms for reporting) - - -0.1-5 2011-03-09 - o fix an issue in mclapply() and mc.prechedule = FALSE when NULL - results are involved (thanks to Ralf Tautenhahn for reporting) - - -0.1-4 2011-02-11 - o added (experimental) support for Windows - Note: it (sort of) works on Windows 2k and XP only. Vista and - Windows 7 is not supported due to changes to the kernel. Since - Vista it becomes increasingly unlikely that multicore will be - possible on Windows in general. - - o added cores detection for FreeBSD (thanks to Gunnar Schaefer) - - o added pvec() function which splits up the call of a vectorized - map function across cores and re-combines them. It is useful - for computation on large vectors. - - o added mc.cleanup argument (by default TRUE) which terminates - child processes in the case of user interrupt (or error) in - the master process. - - o children() allows to check the status of a subset of active - processes using the select argument. - - o multicore now attempts to automatically disable event loop - processing on Mac OS X in forked children. For Quartz - Cocoa event loop this requires R 2.12.2 or higher. - This allows the use of multicore in R for Mac GUI. - - -0.1-3 2009-02-02 - o simplify the internal management of child processes and - consequently remove bugs that lead to poor feeding of cores - in mclapply() when no precheduling was used - - -0.1-2 2009-01-09 - o added mc.preschedule parameter to mclappy() which (if FALSE) - allows on-demand distribution of FUN calls across cores. - - o added "silent" parmeter to parallel() and mclapply() - suppressing output on stdout in child processes - - o added internal functions closeStdout(), closeStrerr(), - closeFD(), closeAll(), isChild(), childrenDescriptors() and - masterDescriptor() - - o selectChildren() implicitly checks for and removes zombies - - o removed spurious debugging output in mclapply() - - o fixed cases in which mclapply() would not preserve names - - o fixed child list management - - o in order to make sure that children cannot die before the - master can collect results, children will specifically wait - for the master to allow them to exit (SIGUSR1 is used for this - purpose, so don't use it directly unless you want a child to - exit even if the master didn't release it). - - -0.1-1 2009-01-03 - o added name parameter to parallel(), accordingly collect() - names the results if the job name is present - - o bug fix: collect() returned early if no jobs responded for a - while - - o bug fix: internal list of children could get corrupted when a - child was removed (all preceding children were removed as well) - - o added better debugging support. Set PKG_CFLAGS=-DMC_DEBUG to - enable debugging output on stdout (it is purposefully not sent - to the R console to prevent output processing issues in child - processes) - - -0.1-0 2009-01-02 - o initial release diff -Nru r-cran-multicore-0.1-7/R/fork.R r-cran-multicore-0.2/R/fork.R --- r-cran-multicore-0.1-7/R/fork.R 2011-09-08 01:57:37.000000000 +0000 +++ r-cran-multicore-0.2/R/fork.R 1970-01-01 00:00:00.000000000 +0000 @@ -1,96 +0,0 @@ -# --- multicore --- low-level functions --- - -# selected signals -SIGHUP <- 1L -SIGINT <- 2L -SIGQUIT <- 3L -SIGKILL <- 9L -SIGTERM <- 15L -SIGALRM <- 14L -SIGSTOP <- 17L -SIGCHLD <- 20L -SIGINFO <- 29L -SIGUSR1 <- 30L -SIGUSR2 <- 31L - -fork <- function() { - r <- .Call(mc_fork) - structure(list(pid=r[1], fd=r[2:3]), class=c(ifelse(r[1]!=0L,"childProcess","masterProcess"),"process")) -} - -readChildren <- function(timeout=0) - .Call(read_children, as.double(timeout)) - -readChild <- function(child) { - if (inherits(child, "process")) child <- processID(child) - if (!is.numeric(child)) stop("invalid child argument") - .Call(read_child, as.integer(child)) -} - -selectChildren <- function(children=NULL, timeout=0) { - if (!length(children)) children <- integer(0) - if (inherits(children, "process")) children <- processID(children) - if (is.list(children)) children <- unlist(lapply(children, function(x) if (inherits(x, "process")) x$pid else stop("children must be a list of processes or a single process"))) - if (!is.numeric(children)) stop("children must be a list of processes or a single process") - .Call(select_children, as.double(timeout), as.integer(children)) -} - -rmChild <- function(child) { - if (inherits(child, "process")) child <- processID(child) - if (!is.numeric(child)) stop("invalid child argument") - .Call(rm_child, as.integer(child)) -} - -kill <- function(process, signal=SIGINT) { - process <- processID(process) - unlist(lapply(process, function(p) .Call(mc_kill, as.integer(p), as.integer(signal)))) -} - -sendMaster <- function(what) { - if (!is.raw(what)) what <- serialize(what, NULL, FALSE) - .Call(send_master, what) -} - -processID <- function(process) - if (inherits(process, "process")) process$pid else if (is.list(process)) unlist(lapply(process, processID)) else stop("process must be of the class `process'") - -sendChildStdin <- function(child, what) { - if (inherits(child, "process") || is.list(child)) child <- processID(child) - if (!is.numeric(child) || !length(child)) stop("child must be a valid child process") - child <- as.integer(child) - if (is.character(what)) what <- charToRaw(paste(what, collapse='\n')) - if (!is.raw(what)) stop("what must be a character or raw vector") - unlist(lapply(child, function(p) .Call(send_child_stdin, p, what))) -} - -exit <- function(exit.code=0L, send=NULL) { - if (!is.null(send)) try(sendMaster(send), silent=TRUE) - .Call(mc_exit, as.integer(exit.code)) -} - -children <- function(select) { - p <- .Call(mc_children) - if (!missing(select)) p <- p[p %in% processID(select)] - lapply(p, function(x) structure(list(pid=x), class=c("childProcess", "process"))) -} - -childrenDescriptors <- function(index=0L) - .Call(mc_fds, as.integer(index)) - -masterDescriptor <- function() .Call(mc_master_fd) - -isChild <- function() .Call(mc_is_child) - -# those could be really written as closeFD(1L) and closeFD(2L), but historically ... -closeStdout <- function() .Call(close_stdout) -closeStderr <- function() .Call(close_stderr) -closeFD <- function(fds) .Call(close_fds, as.integer(fds)) -closeAll <- function(includeStd=FALSE) { - if (!isChild()) { warning("closeAll() is a no-op in the master process"); return(invisible(FALSE)) } - fds <- masterDescriptor() - if (identical(fds, -1L)) fds <- integer(0) - if (includeStd) fds <- c(1L, 2L, fds) - mf <- max(fds) + 16L # take a few more ... - # close all but those that we actually use - closeFD((1:mf)[-fds]) -} diff -Nru r-cran-multicore-0.1-7/R/mclapply.R r-cran-multicore-0.2/R/mclapply.R --- r-cran-multicore-0.1-7/R/mclapply.R 2011-09-08 01:57:37.000000000 +0000 +++ r-cran-multicore-0.2/R/mclapply.R 1970-01-01 00:00:00.000000000 +0000 @@ -1,130 +0,0 @@ -mclapply <- function(X, FUN, ..., mc.preschedule=TRUE, mc.set.seed=TRUE, mc.silent=FALSE, mc.cores=getOption("cores"), mc.cleanup=TRUE) { - env <- parent.frame() - cores <- mc.cores - if (is.null(cores)) cores <- volatile$detectedCores - cores <- as.integer(cores) - jobs <- list() - cleanup <- function() { - # kill children if cleanup is requested - if (length(jobs) && mc.cleanup) { - ## first take care of uncollected children - collect(children(jobs), FALSE) - kill(children(jobs), if (is.integer(mc.cleanup)) mc.cleanup else SIGTERM) - collect(children(jobs)) - } - if (length(jobs)) { - ## just in case there are zombies - collect(children(jobs), FALSE) - } - } - on.exit(cleanup()) - if (!mc.preschedule) { # sequential (non-scheduled) - FUN <- match.fun(FUN) - if (length(X) <= cores) { # all-out, we can use one-shot parallel - jobs <- lapply(seq(X), function(i) parallel(FUN(X[[i]], ...), name=names(X)[i], mc.set.seed=mc.set.seed, silent=mc.silent)) - res <- collect(jobs) - if (length(res) == length(X)) names(res) <- names(X) - has.errors <- sum(sapply(res, inherits, "try-error")) - if (has.errors) warning(has.errors, "of all function calls resulted in an error") - return(res) - } else { # more complicated, we have to wait for jobs selectively - sx <- seq(X) - res <- .Call(create_list, length(sx)) - names(res) <- names(X) - ent <- rep(FALSE, length(X)) # values entered (scheduled) - fin <- rep(FALSE, length(X)) # values finished - jobid <- 1:cores - jobs <- lapply(jobid, function(i) parallel(FUN(X[[i]], ...), mc.set.seed=mc.set.seed, silent=mc.silent)) - jobsp <- processID(jobs) - ent[jobid] <- TRUE - has.errors <- 0L - while (!all(fin)) { - s <- selectChildren(jobs, 0.5) - if (is.null(s)) break # no children -> no hope - if (is.integer(s)) for (ch in s) { - ji <- which(jobsp == ch)[1] - ci <- jobid[ji] - r <- readChild(ch) - if (is.raw(r)) { - child.res <- unserialize(r) - if (inherits(child.res, "try-error")) has.errors <- has.errors + 1L - # we can't jsut assign it since a NULL assignment would remove it from the list - if (!is.null(child.res)) res[[ci]] <- child.res - } else { - fin[ci] <- TRUE -# cat("fin: "); print(fin) -# cat("res: "); print(unlist(lapply(res, is.null))) - if (!all(ent)) { # still something to do, spawn a new job - nexti <- which(!ent)[1] - jobid[ji] <- nexti - jobs[[ji]] <- parallel(FUN(X[[nexti]], ...), mc.set.seed=mc.set.seed, silent=mc.silent) - jobsp[ji] <- processID(jobs[[ji]]) - ent[nexti] <- TRUE - } - } - } - } - if (has.errors) warning(has.errors, "of all function calls resulted in an error") - return(res) - } - } - if (length(X) < cores) cores <- length(X) - if (cores < 2) return(lapply(X, FUN, ...)) - sindex <- lapply(1:cores, function(i) seq(i,length(X), by=cores)) - schedule <- lapply(1:cores, function(i) X[seq(i,length(X), by=cores)]) - ch <- list() - res <- .Call(create_list, length(X)) - names(res) <- names(X) - cp <- rep(0L, cores) - fin <- rep(FALSE, cores) - dr <- rep(FALSE, cores) - inner.do <- function(core) { - S <- schedule[[core]] - f <- fork() - if (inherits(f, "masterProcess")) { # child process - on.exit(exit(1,structure("fatal error in wrapper code",class="try-error"))) - if (isTRUE(mc.set.seed)) set.seed(Sys.getpid()) - if (isTRUE(mc.silent)) closeStdout() - sendMaster(try(lapply(S, FUN, ...), silent=TRUE)) - exit(0) - } - jobs[[core]] <<- ch[[core]] <<- f - cp[core] <<- f$pid - NULL - } - job.res <- lapply(1:cores, inner.do) - ac <- cp[cp > 0] - has.errors <- integer(0) - while (!all(fin)) { - s <- selectChildren(ac, 1) - if (is.null(s)) break # no children -> no hope we get anything - if (is.integer(s)) for (ch in s) { - a <- readChild(ch) - if (is.integer(a)) { - core <- which(cp == a) - fin[core] <- TRUE - } else if (is.raw(a)) { - core <- which(cp == attr(a, "pid")) - ijr <- unserialize(a) - if (inherits(ijr, "try-error")) { - has.errors <- c(has.errors, core) - ijr <- rep(list(ijr), length(schedule[[core]])) - } - job.res[[core]] <- ijr - dr[core] <- TRUE - } - } - } - for (i in 1:cores) res[sindex[[i]]] <- job.res[[i]] - if (length(has.errors)) { - if (length(has.errors) == cores) - warning("all scheduled cores encountered errors in user code") - else if (length(has.errors) == 1L) - warning("scheduled core ", has.errors, " encountered error in user code, all values of the job will be affected") - else - warning("scheduled cores ",paste(has.errors, sep=", "), " encountered errors in user code, all values of the jobs will be affected") - } - res -} - -#mcapply(1:4, function(i) i+1) diff -Nru r-cran-multicore-0.1-7/R/parallel.R r-cran-multicore-0.2/R/parallel.R --- r-cran-multicore-0.1-7/R/parallel.R 2011-09-08 01:57:37.000000000 +0000 +++ r-cran-multicore-0.2/R/parallel.R 1970-01-01 00:00:00.000000000 +0000 @@ -1,51 +0,0 @@ -parallel <- function(expr, name, mc.set.seed=FALSE, silent=FALSE) { - f <- fork() - env <- parent.frame() - if (inherits(f, "masterProcess")) { - on.exit(exit(1, structure("fatal error in wrapper code",class="try-error"))) - if (isTRUE(mc.set.seed)) set.seed(Sys.getpid()) - if (isTRUE(silent)) closeStdout() - sendMaster(serialize(try(eval(expr, env), silent=TRUE), NULL, FALSE)) - exit(0) - } - if (!missing(name) && !is.null(name)) f$name <- as.character(name)[1] - class(f) <- c("parallelJob", class(f)) - f -} - -# synonym for parallel in case someone masks us -mcparallel <- parallel - -collect <- function(jobs, wait=TRUE, timeout=0, intermediate=FALSE) { - if (missing(jobs)) jobs <- children() - if (!length(jobs)) return (NULL) - if (isTRUE(intermediate)) intermediate <- str - if (!wait) { - s <- selectChildren(jobs, timeout) - if (is.logical(s) || !length(s)) return(NULL) - lapply(s, function(x) { r <- readChild(x); if (is.raw(r)) unserialize(r) else NULL }) - } else { - pids <- if (inherits(jobs, "process") || is.list(jobs)) processID(jobs) else jobs - if (!length(pids)) return(NULL) - if (!is.numeric(pids)) stop("invalid jobs argument") - pids <- as.integer(pids) - pnames <- as.character(pids) - if (!inherits(jobs, "process") && is.list(jobs)) - for(i in seq(jobs)) if (!is.null(jobs[[i]]$name)) pnames[i] <- as.character(jobs[[i]]$name) - res <- lapply(pids, function(x) NULL) - names(res) <- pnames - fin <- rep(FALSE, length(jobs)) - while (!all(fin)) { - s <- selectChildren(pids, 0.5) - if (is.integer(s)) { - for (pid in s) { - r <- readChild(pid) - if (is.integer(r) || is.null(r)) fin[pid==pids] <- TRUE - if (is.raw(r)) res[[which(pid==pids)]] <- unserialize(r) - } - if (is.function(intermediate)) intermediate(res) - } else if (all(is.na(match(pids, processID(children()))))) break - } - res - } -} diff -Nru r-cran-multicore-0.1-7/R/print.R r-cran-multicore-0.2/R/print.R --- r-cran-multicore-0.1-7/R/print.R 2011-09-08 01:57:37.000000000 +0000 +++ r-cran-multicore-0.2/R/print.R 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -print.process <- function(x, ...) cat(paste(" ",class(x)[1],": processID=",x$pid,"\n",sep='')) diff -Nru r-cran-multicore-0.1-7/R/pvec.R r-cran-multicore-0.2/R/pvec.R --- r-cran-multicore-0.1-7/R/pvec.R 2011-09-08 01:57:37.000000000 +0000 +++ r-cran-multicore-0.2/R/pvec.R 1970-01-01 00:00:00.000000000 +0000 @@ -1,42 +0,0 @@ -pvec <- function(v, FUN, ..., mc.set.seed=TRUE, mc.silent=FALSE, mc.cores=getOption("cores"), mc.cleanup=TRUE) { - if (!is.vector(v)) stop("v must be a vector") - - env <- parent.frame() - cores <- mc.cores - if (is.null(cores)) cores <- volatile$detectedCores - cores <- as.integer(cores) - - n <- length(v) - l <- if (n < cores) as.list(v) else { - # compute the scheduling, making it as fair as possible - il <- as.integer(n / cores) - xc <- n - il * cores - sl <- rep(il, cores) - if (xc) sl[1:xc] <- il + 1 - si <- cumsum(c(1L, sl)) - se <- si + c(sl, 0L) - 1L - lapply(1:cores, function(ix) v[si[ix]:se[ix]]) - } - jobs <- NULL - cleanup <- function() { - ## kill children if cleanup is requested - if (length(jobs) && mc.cleanup) { - ## first take care of uncollected children - collect(children(jobs), FALSE) - kill(children(jobs), if (is.integer(mc.cleanup)) mc.cleanup else SIGTERM) - collect(children(jobs)) - } - if (length(jobs)) { - ## just in case there are zombies - collect(children(jobs), FALSE) - } - } - on.exit(cleanup()) - FUN <- match.fun(FUN) - jobs <- lapply(seq(cores), function(i) parallel(FUN(l[[i]], ...), name=i, mc.set.seed=mc.set.seed, silent=mc.silent)) - res <- collect(jobs) - names(res) <- NULL - res <- do.call(c, res) - if (length(res) != n) warning("some results may be missing, folded or caused an error") - res -} diff -Nru r-cran-multicore-0.1-7/R/zzz.R r-cran-multicore-0.2/R/zzz.R --- r-cran-multicore-0.1-7/R/zzz.R 2011-09-08 01:57:37.000000000 +0000 +++ r-cran-multicore-0.2/R/zzz.R 2014-05-14 08:06:27.000000000 +0000 @@ -1,37 +1,19 @@ -# this envoronment holds any volatile variables we may want to keep inside the package volatile <- new.env(TRUE, emptyenv()) -# detect the number of [virtual] CPUs (cores) -detectCores <- function(all.tests = FALSE) { - # feel free to add tests - those are the only ones I could test [SU] - systems <- list(darwin = "/usr/sbin/sysctl -n hw.ncpu 2>/dev/null", - freebsd = "/sbin/sysctl -n hw.ncpu 2>/dev/null", - linux = "grep processor /proc/cpuinfo 2>/dev/null|wc -l", - irix = c("hinv |grep Processors|sed 's: .*::'", "hinv|grep '^Processor '|wc -l"), - solaris = "/usr/sbin/psrinfo -v|grep 'Status of.*processor'|wc -l") - for (i in seq(systems)) - if(all.tests || length(grep(paste("^", names(systems)[i], sep=''), R.version$os))) - for (cmd in systems[i]) { - a <- gsub("^ +","",system(cmd, TRUE)[1]) - if (length(grep("^[1-9]", a))) return(as.integer(a)) - } - NA -} - -.register.addr <- c("mc_fork", "read_children", "read_child", "select_children", - "rm_child", "send_master", "send_child_stdin", "mc_exit", "mc_children", - "mc_fds", "mc_master_fd", "mc_is_child", "close_stdout", "close_stderr", - "close_fds", "create_list", "mc_kill") - +detectCores <- parallel::detectCores .onLoad <- function(libname, pkgname) { cores <- detectCores() volatile$detectedCoresSuccess <- !is.na(cores) - if (is.na(cores)) cores <- 8L # a fallback expecting higher-end desktop ... + if (is.na(cores)) cores <- 2L # a fallback expecting higher-end desktop ... volatile$detectedCores <- cores - ## register all native routines - env <- topenv() - addr <- getNativeSymbolInfo(.register.addr, pkgname) - for (name in .register.addr) - env[[name]] <- addr[[name]]$address - TRUE } +.onAttach <- function(libname, pkgname) + packageStartupMessage("WARNING: multicore has been superseded and will be removed shortly") + +children <- parallel:::children +collect <- mccollect +exit <- parallel:::mcexit +fork <- parallel:::mcfork +kill <- parallel:::mckill +parallel <- mcparallel +processID <- parallel:::processID diff -Nru r-cran-multicore-0.1-7/src/fork.c r-cran-multicore-0.2/src/fork.c --- r-cran-multicore-0.1-7/src/fork.c 2011-09-08 01:57:38.000000000 +0000 +++ r-cran-multicore-0.2/src/fork.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,665 +0,0 @@ -/* multicore R package - - fork.c - interface to system-level tools for sawning copies of the current - process and IPC - - (C)Copyright 2008-11 Simon Urbanek - - see package DESCRIPTION for licensing terms */ - -#include -#include - -#ifndef WIN32 -/* --- plain unix parte --- */ -#include -#include -#else -/* --- work arounds for Windows --- */ -#include -#include "winfix.h" -#define read _read -#define write _write -#define close _close -#define select pipe_select -#endif -#include - -#include -#include -#include /* for AQUA */ -#if HAVE_AQUA -#include -#endif - -#ifndef FILE_LOG -/* use printf instead of Rprintf for debugging to avoid forked console interactions */ -#define Dprintf printf -#else -/* logging into a file */ -#include -void Dprintf(char *format, ...) { - va_list (args); - va_start (args, format); - FILE *f = fopen("mc_debug.txt", "a"); - if (f) { - fprintf(f, "%d> ", getpid()); - vfprintf(f, format, args); - fclose(f); - } - va_end (args); -} -#endif - -typedef struct child_info { - pid_t pid; - int pfd, sifd; -#ifdef WIN32 - HANDLE mutex; /* mutex for releasing a child */ -#endif - struct child_info *next; -} child_info_t; - -static child_info_t *children; - -static int master_fd = -1; -static int is_master = 1; - -static int rm_child_(int pid) { - child_info_t *ci = children, *prev = 0; -#ifdef MC_DEBUG - Dprintf("removing child %d\n", pid); -#endif - while (ci) { - if (ci->pid == pid) { -#ifdef WIN32 - HANDLE mutex = ci->mutex; -#endif - /* make sure we close all descriptors */ - if (ci->pfd > 0) { close(ci->pfd); ci->pfd = -1; } - if (ci->sifd > 0) { close(ci->sifd); ci->sifd = -1; } - /* now remove it from the list */ - if (prev) prev->next = ci->next; - else children = ci->next; - free(ci); -#ifdef WIN32 - ReleaseMutex(mutex); - CloseHandle(mutex); - /* just in case doesn't really work ... */ - TerminateProcess((HANDLE) pid, 0); -#else - kill(pid, SIGUSR1); /* send USR1 to the child to make sure it exits */ -#endif - return 1; - } - prev = ci; - ci = ci->next; - } -#ifdef MC_DEBUG - Dprintf("WARNING: child %d was to be removed but it doesn't exist\n", pid); -#endif - return 0; -} - -#ifndef STDIN_FILENO -#define STDIN_FILENO 0 -#endif -#ifndef STDOUT_FILENO -#define STDOUT_FILENO 1 -#endif -#ifndef STDERR_FILENO -#define STDERR_FILENO 2 -#endif - -static int child_can_exit = 0, child_exit_status = -1; - -#ifndef WIN32 -static void child_sig_handler(int sig) { - if (sig == SIGUSR1) { -#ifdef MC_DEBUG - Dprintf("child process %d got SIGUSR1; child_exit_status=%d\n", getpid(), child_exit_status); -#endif - child_can_exit = 1; - if (child_exit_status >= 0) - exit(child_exit_status); - } -} -#else -HANDLE child_release_mutex; -#endif - -#if HAVE_AQUA -/* from aqua.c */ -extern void (*ptr_R_ProcessEvents)(void); - -static int find_quartz_symbols = 1; -void (*QuartzCocoa_InhibitEventLoop)(int); -typedef void (*QuartzCocoa_InhibitEventLoop_t)(int); - -/* unfortunately Rdynload.h forgets to declare it so the API is broken - we need to fix it */ -struct Rf_RegisteredNativeSymbol { - NativeSymbolType type; - void *fn, *dll; -}; - -/* check whether Quartz is loaded (if not, returns -1) and if so returns 1 is QuartzCocoa_InhibitEventLoop has been found 0 otherwise */ -static int getQuartzSymbols() { - if (find_quartz_symbols) { - R_RegisteredNativeSymbol symbol = {R_ANY_SYM, NULL, NULL}; - if (R_FindSymbol("getQuartzAPI", "", &symbol)) { /* is Quartz loaded? if not, we have nothing to worry about */ - /* unfortunately R disables dynamic lookup in grDevices so we need to get at it manually - this means that we need to get the corresponding DllInfo to enable it, then look up the symbol and disable it again */ - SEXP getNativeSymbolInfo = install("getNativeSymbolInfo"); - SEXP nsi = eval(lang2(getNativeSymbolInfo, mkString("getQuartzAPI")), R_GlobalEnv); - /* get nsi[[3]][[2]] which should be the path (we verify every step) */ - if (TYPEOF(nsi) == VECSXP && LENGTH(nsi) > 2) { - SEXP pkg = VECTOR_ELT(nsi, 2); - if (TYPEOF(pkg) == VECSXP && LENGTH(pkg) > 1) { - SEXP dpath = VECTOR_ELT(pkg, 1); - if (TYPEOF(dpath) == STRSXP && LENGTH(dpath) > 0) { - /* this is technically unnecessary since nsi actually contains - the EXTPTR holding the DllInfo, gut we'll play it safe here */ - DllInfo *dll = R_getDllInfo(CHAR(STRING_ELT(dpath, 0))); - if (dll) { - struct Rf_RegisteredNativeSymbol { NativeSymbolType type; void *fn, *dll; } symbol = { R_ANY_SYM, NULL, NULL }; - R_useDynamicSymbols(dll, TRUE); /* turn on dynamic symbols */ - /* it would be faster to use R_dlsym since we already have DllInfo but that is hidden so let's waste more cycles.. */ - QuartzCocoa_InhibitEventLoop = (QuartzCocoa_InhibitEventLoop_t) R_FindSymbol("QuartzCocoa_InhibitEventLoop", "grDevices", (R_RegisteredNativeSymbol*) &symbol); - R_useDynamicSymbols(dll, FALSE); /* turn them off - we got what we want */ - } - } - } - } - /* do not try again since we did all the work */ - find_quartz_symbols = 0; - } - } - return find_quartz_symbols ? -1 : ((QuartzCocoa_InhibitEventLoop) ? 1 : 0); -} -#else -static int getQuartzSymbols() { return -1; } -#endif - -SEXP mc_fork() { - int pipefd[2]; - int sipfd[2]; - pid_t pid; - SEXP res = allocVector(INTSXP, 3); - int *res_i = INTEGER(res); - if (pipe(pipefd)) error("Unable to create a pipe."); - if (pipe(sipfd)) { - close(pipefd[0]); close(pipefd[1]); - error("Unable to create a pipe."); - } -#ifdef WIN32 - { - SECURITY_ATTRIBUTES sa = { sizeof(SECURITY_ATTRIBUTES), NULL, TRUE }; - child_release_mutex = CreateMutex(&sa, TRUE, NULL); - } -#endif - getQuartzSymbols(); /* initialize Quartz symbols if needed (noop on non-Aqua systems) */ - - pid = fork(); - if (pid == -1) { - perror("fork"); - close(pipefd[0]); close(pipefd[1]); - close(sipfd[0]); close(sipfd[1]); -#ifdef WIN32 - CloseHandle(child_release_mutex); -#endif - error("Unable to fork."); - } - res_i[0] = (int) pid; - if (pid == 0) { /* child */ - close(pipefd[0]); /* close read end */ - master_fd = res_i[1] = pipefd[1]; - is_master = 0; -#if HAVE_AQUA - ptr_R_ProcessEvents = NULL; /* disable ProcessEvent since we can't call CF from now on */ -#endif - /* re-map stdin */ - dup2(sipfd[0], STDIN_FILENO); - close(sipfd[0]); - /* master uses USR1 to signal that the child process can terminate */ - child_exit_status = -1; - child_can_exit = 0; -#ifndef WIN32 - signal(SIGUSR1, child_sig_handler); -#endif -#if HAVE_AQUA - /* Quartz runs the event loop so we need to stop it if we can */ - if (QuartzCocoa_InhibitEventLoop) - QuartzCocoa_InhibitEventLoop(1); -#endif -#ifdef MC_DEBUG - Dprintf("child process %d started\n", getpid()); -#endif - } else { /* master process */ - child_info_t *ci; - close(pipefd[1]); /* close write end of the data pipe */ - close(sipfd[0]); /* close read end of the child-stdin pipe */ - res_i[1] = pipefd[0]; - res_i[2] = sipfd[1]; -#ifdef MC_DEBUG - Dprintf("parent registers new child %d\n", pid); -#endif - /* register the new child and its pipes */ - ci = (child_info_t*) malloc(sizeof(child_info_t)); - if (!ci) error("Memory allocation error."); - ci->pid = pid; - ci->pfd = pipefd[0]; - ci->sifd= sipfd[1]; -#ifdef WIN32 - ci->mutex = child_release_mutex; - /* since we're now forked, the pipes (and mutex) should not be inherited by other children (note that this may mess up FD handling but children should not use those anyway) */ - SetHandleInformation((HANDLE)_get_osfhandle(ci->pfd), HANDLE_FLAG_INHERIT, 0); - SetHandleInformation((HANDLE)_get_osfhandle(ci->sifd), HANDLE_FLAG_INHERIT, 0); - SetHandleInformation(child_release_mutex, HANDLE_FLAG_INHERIT, 0); -#if 0 - /* also Windows doesn't support concurrent stdout/err, so we can close them */ - close(STDOUT_FILENO); - close(STDERR_FILENO); - /* ok, the next one is insane - we abuse R_SetWin32 to clear out (possibly suicidal) callbacks */ - structRstart s; - s.rhome = R_Home; - s.home = getenv("HOME"); - s.CharacterMode = RTerm; - s.ReadConsole - s.WriteConsole - s.WriteConsoleEx - s.CallBack - s.ShowMessage - s.YesNoCancel - s.Busy - s.NoRenviron = 1; - R_SetWin32(&s); -#endif - -#endif - ci->next = children; - children = ci; - } - return res; -} - -SEXP close_stdout() { - close(STDOUT_FILENO); - return R_NilValue; -} - -SEXP close_stderr() { - close(STDERR_FILENO); - return R_NilValue; -} - -SEXP close_fds(SEXP sFDS) { - int *fd, fds, i = 0; - if (TYPEOF(sFDS) != INTSXP) error("descriptors must be integers"); - fds = LENGTH(sFDS); - fd = INTEGER(sFDS); - while (i < fds) close(fd[i++]); - return ScalarLogical(1); -} - -SEXP send_master(SEXP what) { - unsigned char *b; - unsigned int len = 0, i = 0; - if (is_master) error("only children can send data to the master process"); - if (master_fd == -1) error("there is no pipe to the master process"); - if (TYPEOF(what) != RAWSXP) error("content to send must be RAW, use serialize if needed"); - len = LENGTH(what); - b = RAW(what); -#ifdef MC_DEBUG - Dprintf("child %d: send_master (%d bytes)\n", getpid(), len); -#endif - if (write(master_fd, &len, sizeof(len)) != sizeof(len)) { - close(master_fd); - master_fd = -1; - error("write error, closing pipe to the master"); - } - while (i < len) { - int n = write(master_fd, b + i, len - i); - if (n < 1) { - close(master_fd); - master_fd = -1; - error("write error, closing pipe to the master"); - } - i += n; - } - return ScalarLogical(1); -} - -SEXP send_child_stdin(SEXP sPid, SEXP what) { - unsigned char *b; - unsigned int len = 0, i = 0, fd; - int pid = asInteger(sPid); - if (!is_master) error("only master (parent) process can send data to a child process"); - if (TYPEOF(what) != RAWSXP) error("what must be a raw vector"); - child_info_t *ci = children; - while (ci) { - if (ci->pid == pid) break; - ci = ci -> next; - } - if (!ci) error("child %d doesn't exist", pid); - len = LENGTH(what); - b = RAW(what); - fd = ci -> sifd; - while (i < len) { - int n = write(fd, b + i, len - i); - if (n < 1) - error("write error"); - i += n; - } - return ScalarLogical(1); -} - -SEXP select_children(SEXP sTimeout, SEXP sWhich) { - int maxfd = 0, sr, zombies = 0; - unsigned int wlen = 0, wcount = 0; - SEXP res; - int *res_i, *which = 0; - child_info_t *ci = children; - fd_set fs; - struct timeval tv = { 0, 0 }, *tvp = &tv; - if (isReal(sTimeout) && LENGTH(sTimeout) == 1) { - double tov = asReal(sTimeout); - if (tov < 0.0) tvp = 0; /* Note: I'm not sure we really should allow this .. */ - else { - tv.tv_sec = (int) tov; - tv.tv_usec = (int) ((tov - ((double) tv.tv_sec)) * 1000000.0); - } - } - if (TYPEOF(sWhich) == INTSXP && LENGTH(sWhich)) { - which = INTEGER(sWhich); - wlen = LENGTH(sWhich); - } -#ifndef WIN32 - { int wstat; while (waitpid(-1, &wstat, WNOHANG) > 0) {}; } /* check for zombies */ -#endif - FD_ZERO(&fs); - while (ci && ci->pid) { - if (ci->pfd == -1) zombies++; - if (ci->pfd > maxfd) maxfd = ci->pfd; - if (ci->pfd > 0) { - if (which) { /* check for the FD only if it's on the list */ - unsigned int k = 0; - while (k < wlen) if (which[k++] == ci->pid) { FD_SET(ci->pfd, &fs); wcount++; break; } - } else - FD_SET(ci->pfd, &fs); - } - ci = ci -> next; - } -#ifdef MC_DEBUG - Dprintf("select_children: maxfd=%d, wlen=%d, wcount=%d, zombies=%d, timeout=%d:%d\n", maxfd, wlen, wcount, zombies, (int)tv.tv_sec, (int)tv.tv_usec); -#endif - if (zombies) { /* oops, this should never really hapen - it did while we had a bug in rm_child_ but hopefully not anymore */ - while (zombies) { /* this is rather more complicated than it should be if we used pointers to delete, but well ... */ - ci = children; - while (ci) { - if (ci->pfd == -1) { -#ifdef MC_DEBUG - Dprintf("detected zombie: pid=%d, pfd=%d, sifd=%d\n", ci->pid, ci->pfd, ci->sifd); -#endif - rm_child_(ci->pid); - zombies--; - break; - } - ci = ci->next; - } - if (!ci) break; - } - } - if (maxfd == 0 || (wlen && !wcount)) return R_NilValue; /* NULL signifies no children to tend to */ - sr = select(maxfd + 1, &fs, 0, 0, tvp); -#ifdef MC_DEBUG - Dprintf(" sr = %d\n", sr); -#endif - if (sr < 0) { - perror("select"); - return ScalarLogical(0); /* FALSE on select error */ - } - if (sr < 1) return ScalarLogical(1); /* TRUE on timeout */ - ci = children; - maxfd = 0; - while (ci && ci->pid) { /* pass 1 - count the FDs (in theory not necessary since that's what select should have returned) */ - if (ci->pfd > 0 && FD_ISSET(ci->pfd, &fs)) maxfd++; - ci = ci -> next; - } - ci = children; -#ifdef MC_DEBUG - Dprintf(" - read select %d children: ", maxfd); -#endif - res = allocVector(INTSXP, maxfd); - res_i = INTEGER(res); - while (ci && ci->pid) { /* pass 2 - fill the array */ - if (ci->pfd > 0 && FD_ISSET(ci->pfd, &fs)) (res_i++)[0] = ci->pid; -#ifdef MC_DEBUG - if (ci->pfd > 0 && FD_ISSET(ci->pfd, &fs)) Dprintf("%d ", ci->pid); -#endif - ci = ci -> next; - } -#ifdef MC_DEBUG - Dprintf("\n"); -#endif - return res; -} - -static SEXP read_child_ci(child_info_t *ci) { - unsigned int len = 0; - int fd = ci->pfd; - int n = read(fd, &len, sizeof(len)); -#ifdef MC_DEBUG - Dprintf(" read_child_ci(%d) - read length returned %d\n", ci->pid, n); -#endif - if (n != sizeof(len) || len == 0) { /* error or child is exiting */ - int pid = ci->pid; - close(fd); - ci->pfd = -1; - rm_child_(pid); - return ScalarInteger(pid); - } else { - SEXP rv = allocVector(RAWSXP, len); - unsigned char *rvb = RAW(rv); - unsigned int i = 0; - while (i < len) { - n = read(fd, rvb + i, len - i); -#ifdef MC_DEBUG - Dprintf(" read_child_ci(%d) - read %d at %d returned %d\n", ci->pid, len-i, i, n); -#endif - if (n < 1) { - int pid = ci->pid; - close(fd); - ci->pfd = -1; - rm_child_(pid); - return ScalarInteger(pid); - } - i += n; - } - PROTECT(rv); - { - SEXP pa = allocVector(INTSXP, 1); - INTEGER(pa)[0] = ci->pid; - setAttrib(rv, install("pid"), pa); - } - UNPROTECT(1); - return rv; - } -} - -SEXP read_child(SEXP sPid) { - int pid = asInteger(sPid); - child_info_t *ci = children; - while (ci) { - if (ci->pid == pid) break; - ci = ci->next; - } -#ifdef MC_DEBUG - if (!ci) Dprintf("read_child(%d) - pid is not in the list of children\n", pid); -#endif - if (!ci) return R_NilValue; /* if the child doesn't exist anymore, returns NULL */ - return read_child_ci(ci); -} - -SEXP read_children(SEXP sTimeout) { - int maxfd = 0, sr; - child_info_t *ci = children; - fd_set fs; - struct timeval tv = { 0, 0 }, *tvp = &tv; - if (isReal(sTimeout) && LENGTH(sTimeout) == 1) { - double tov = asReal(sTimeout); - if (tov < 0.0) tvp = 0; /* Note: I'm not sure we really should allow this .. */ - else { - tv.tv_sec = (int) tov; - tv.tv_usec = (int) ((tov - ((double) tv.tv_sec)) * 1000000.0); - } - } -#ifndef WIN32 - { int wstat; while (waitpid(-1, &wstat, WNOHANG) > 0) {}; } /* check for zombies */ -#endif - FD_ZERO(&fs); - while (ci && ci->pid) { - if (ci->pfd > maxfd) maxfd = ci->pfd; - if (ci->pfd > 0) FD_SET(ci->pfd, &fs); - ci = ci -> next; - } -#ifdef MC_DEBUG - Dprintf("read_children: maxfd=%d, timeout=%d:%d\n", maxfd, (int)tv.tv_sec, (int)tv.tv_usec); -#endif - if (maxfd == 0) return R_NilValue; /* NULL signifies no children to tend to */ - sr = select(maxfd+1, &fs, 0, 0, tvp); -#ifdef MC_DEBUG - Dprintf("sr = %d\n", sr); -#endif - if (sr < 0) { - perror("select"); - return ScalarLogical(0); /* FALSE on select error */ - } - if (sr < 1) return ScalarLogical(1); /* TRUE on timeout */ - ci = children; - while (ci && ci->pid) { - if (ci->pfd > 0 && FD_ISSET(ci->pfd, &fs)) break; - ci = ci -> next; - } -#ifdef MC_DEBUG - Dprintf("set ci=%p (%d, %d)\n", (void*) ci, ci?ci->pid:0, ci?ci->pfd:0); -#endif - /* this should never occur really - select signalled a read handle - but none of the handles is set - let's treat it as a timeout */ - if (!ci) return ScalarLogical(1); - else - return read_child_ci(ci); - /* we should never land here */ - return R_NilValue; -} - -SEXP rm_child(SEXP sPid) { - int pid = asInteger(sPid); - return ScalarLogical(rm_child_(pid)); -} - -SEXP mc_children() { - unsigned int count = 0; - SEXP res; - int *pids; - child_info_t *ci = children; - while (ci && ci->pid > 0) { - count++; - ci = ci->next; - } - res = allocVector(INTSXP, count); - if (count) { - pids = INTEGER(res); - ci = children; - while (ci && ci->pid > 0) { - (pids++)[0] = ci->pid; - ci = ci->next; - } - } - return res; -} - -SEXP mc_fds(SEXP sFdi) { - int fdi = asInteger(sFdi); - unsigned int count = 0; - SEXP res; - child_info_t *ci = children; - while (ci && ci->pid > 0) { - count++; - ci = ci->next; - } - res = allocVector(INTSXP, count); - if (count) { - int *fds = INTEGER(res); - ci = children; - while (ci && ci->pid > 0) { - (fds++)[0] = (fdi == 0) ? ci->pfd : ci->sifd; - ci = ci->next; - } - } - return res; -} - - -SEXP mc_master_fd() { - return ScalarInteger(master_fd); -} - -SEXP mc_is_child() { - return ScalarLogical(is_master?0:1); -} - -SEXP mc_kill(SEXP sPid, SEXP sSig) { -#ifdef WIN32 - error("signals are not supported on Windows"); - return R_NilValue; -#else - int pid = asInteger(sPid); - int sig = asInteger(sSig); - if (kill((pid_t) pid, sig)) - error("Kill failed."); - return ScalarLogical(1); -#endif -} - -SEXP mc_exit(SEXP sRes) { - int res = asInteger(sRes); -#ifdef MC_DEBUG - Dprintf("child %d: exit called\n", getpid()); -#endif - if (is_master) error("exit can only be used in a child process"); - if (master_fd != -1) { /* send 0 to signify that we're leaving */ - unsigned int len = 0; - write(master_fd, &len, sizeof(len)); - /* make sure the pipe is closed before we enter any waiting */ - close(master_fd); - master_fd = -1; - } -#ifdef WIN32 - /* master locks the mutex until it's ready to collect the result */ - WaitForSingleObject(child_release_mutex, INFINITE); -#else - if (!child_can_exit) { -#ifdef MC_DEBUG - Dprintf("child %d is waiting for permission to exit\n", getpid()); -#endif - while (!child_can_exit) { - sleep(1); - } - } -#endif - -#ifdef MC_DEBUG - Dprintf("child %d: exiting\n", getpid()); -#endif - exit(res); - error("exit failed"); - return R_NilValue; -} - -/* this is not really necessary, since from R you can simply use - is.loaded("QuartzCocoa_InhibitEventLoop") and it will be TRUE if we - got to it. */ -SEXP mc_can_disable_quartz() { - return Rf_ScalarLogical(getQuartzSymbols()); -} diff -Nru r-cran-multicore-0.1-7/src/forknt.c r-cran-multicore-0.2/src/forknt.c --- r-cran-multicore-0.1-7/src/forknt.c 2011-09-08 01:57:38.000000000 +0000 +++ r-cran-multicore-0.2/src/forknt.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,281 +0,0 @@ -/* Implementation of COW fork() using NTDLL API for Windows systems - - (C)Copyright 2009 Simon Urbanek - - This code is partially based on the book - "Windows NT/2000 Native API Reference" by Gary Nebbett - (Sams Publishing, 2000, ISBN 1-57870-199-6) - - */ - -#ifdef WIN32 - -#include -#include - -/* winternl.h is not part of MinGW so we have to declare whatever is needed */ - -#pragma mark ntdll API types - -typedef LONG NTSTATUS; - -typedef struct _SYSTEM_HANDLE_INFORMATION { - ULONG ProcessId; - UCHAR ObjectTypeNumber; - UCHAR Flags; - USHORT Handle; - PVOID Object; - ACCESS_MASK GrantedAccess; -} SYSTEM_HANDLE_INFORMATION, *PSYSTEM_HANDLE_INFORMATION; - -typedef struct _OBJECT_ATTRIBUTES { - ULONG Length; - HANDLE RootDirectory; - PVOID /* really PUNICODE_STRING */ ObjectName; - ULONG Attributes; - PVOID SecurityDescriptor; /* type SECURITY_DESCRIPTOR */ - PVOID SecurityQualityOfService; /* type SECURITY_QUALITY_OF_SERVICE */ -} OBJECT_ATTRIBUTES, *POBJECT_ATTRIBUTES; - -typedef enum _MEMORY_INFORMATION_{ - MemoryBasicInformation, - MemoryWorkingSetList, - MemorySectionName, - MemoryBasicVlmInformation -} MEMORY_INFORMATION_CLASS; - -typedef struct _CLIENT_ID { - HANDLE UniqueProcess; - HANDLE UniqueThread; -} CLIENT_ID, *PCLIENT_ID; - -typedef struct _USER_STACK { - PVOID FixedStackBase; - PVOID FixedStackLimit; - PVOID ExpandableStackBase; - PVOID ExpandableStackLimit; - PVOID ExpandableStackBottom; -} USER_STACK, *PUSER_STACK; - -typedef LONG KPRIORITY; -typedef ULONG_PTR KAFFINITY; -typedef KAFFINITY *PKAFFINITY; - -typedef struct _THREAD_BASIC_INFORMATION { - NTSTATUS ExitStatus; - PVOID TebBaseAddress; - CLIENT_ID ClientId; - KAFFINITY AffinityMask; - KPRIORITY Priority; - KPRIORITY BasePriority; -} THREAD_BASIC_INFORMATION, *PTHREAD_BASIC_INFORMATION; - -typedef enum _THREAD_INFORMATION_CLASS { - ThreadBasicInformation, - ThreadTimes, - ThreadPriority, - ThreadBasePriority, - ThreadAffinityMask, - ThreadImpersonationToken, - ThreadDescriptorTableEntry, - ThreadEnableAlignmentFaultFixup, - ThreadEventPair, - ThreadQuerySetWin32StartAddress, - ThreadZeroTlsCell, - ThreadPerformanceCount, - ThreadAmILastThread, - ThreadIdealProcessor, - ThreadPriorityBoost, - ThreadSetTlsArrayAddress, - ThreadIsIoPending, - ThreadHideFromDebugger -} THREAD_INFORMATION_CLASS, *PTHREAD_INFORMATION_CLASS; - -typedef enum _SYSTEM_INFORMATION_CLASS { SystemHandleInformation = 0x10 } SYSTEM_INFORMATION_CLASS; - -#pragma mark ntdll API - function entry points - -typedef NTSTATUS (NTAPI *ZwWriteVirtualMemory_t)(IN HANDLE ProcessHandle, - IN PVOID BaseAddress, - IN PVOID Buffer, - IN ULONG NumberOfBytesToWrite, - OUT PULONG NumberOfBytesWritten OPTIONAL); -typedef NTSTATUS (NTAPI *ZwCreateProcess_t)(OUT PHANDLE ProcessHandle, - IN ACCESS_MASK DesiredAccess, - IN POBJECT_ATTRIBUTES ObjectAttributes, - IN HANDLE InheriteFromProcessHandle, - IN BOOLEAN InheritHandles, - IN HANDLE SectionHandle OPTIONAL, - IN HANDLE DebugPort OPTIONAL, - IN HANDLE ExceptionPort OPTIONAL); -typedef NTSTATUS (WINAPI *ZwQuerySystemInformation_t)(SYSTEM_INFORMATION_CLASS SystemInformationClass, - PVOID SystemInformation, - ULONG SystemInformationLength, - PULONG ReturnLength); -typedef NTSTATUS (NTAPI *ZwQueryVirtualMemory_t)(IN HANDLE ProcessHandle, - IN PVOID BaseAddress, - IN MEMORY_INFORMATION_CLASS MemoryInformationClass, - OUT PVOID MemoryInformation, - IN ULONG MemoryInformationLength, - OUT PULONG ReturnLength OPTIONAL); -typedef NTSTATUS (NTAPI *ZwGetContextThread_t)(IN HANDLE ThreadHandle, OUT PCONTEXT Context); -typedef NTSTATUS (NTAPI *ZwCreateThread_t)(OUT PHANDLE ThreadHandle, - IN ACCESS_MASK DesiredAccess, - IN POBJECT_ATTRIBUTES ObjectAttributes, - IN HANDLE ProcessHandle, - OUT PCLIENT_ID ClientId, - IN PCONTEXT ThreadContext, - IN PUSER_STACK UserStack, - IN BOOLEAN CreateSuspended); -typedef NTSTATUS (NTAPI *ZwResumeThread_t)(IN HANDLE ThreadHandle, OUT PULONG SuspendCount OPTIONAL); -typedef NTSTATUS (NTAPI *ZwClose_t)(IN HANDLE ObjectHandle); -typedef NTSTATUS (NTAPI *ZwQueryInformationThread_t)(IN HANDLE ThreadHandle, - IN THREAD_INFORMATION_CLASS ThreadInformationClass, - OUT PVOID ThreadInformation, - IN ULONG ThreadInformationLength, - OUT PULONG ReturnLength OPTIONAL ); - -/* function pointers */ -static ZwCreateProcess_t ZwCreateProcess; -static ZwQuerySystemInformation_t ZwQuerySystemInformation; -static ZwQueryVirtualMemory_t ZwQueryVirtualMemory; -static ZwCreateThread_t ZwCreateThread; -static ZwGetContextThread_t ZwGetContextThread; -static ZwResumeThread_t ZwResumeThread; -static ZwClose_t ZwClose; -static ZwQueryInformationThread_t ZwQueryInformationThread; -static ZwWriteVirtualMemory_t ZwWriteVirtualMemory; - -/* macro definitions */ - -#define NtCurrentProcess() ((HANDLE)-1) -#define NtCurrentThread() ((HANDLE) -2) -/* we use really the Nt versions - so the following is just for completeness */ -#define ZwCurrentProcess() NtCurrentProcess() -#define ZwCurrentThread() NtCurrentThread() - -#define STATUS_INFO_LENGTH_MISMATCH ((NTSTATUS)0xC0000004L) -#define STATUS_SUCCESS ((NTSTATUS)0x00000000L) - -#pragma mark -- helper functions -- - -#ifdef INHERIT_ALL -/* set all handles belonging to this process as inheritable */ -static void set_inherit_all() -{ - ULONG n = 0x1000; - PULONG p = (PULONG) calloc(n, sizeof(ULONG)); - - /* some guesswork to allocate a structure that will fit it all */ - while (ZwQuerySystemInformation(SystemHandleInformation, p, n * sizeof(ULONG), 0) == STATUS_INFO_LENGTH_MISMATCH) { - free(p); - n *= 2; - p = (PULONG) calloc(n, sizeof(ULONG)); - } - - /* p points to an ULONG with the count, the entries follow (hence p[0] is the size and p[1] is where the first entry starts */ - PSYSTEM_HANDLE_INFORMATION h = (PSYSTEM_HANDLE_INFORMATION)(p + 1); - - ULONG pid = GetCurrentProcessId(); - ULONG i = 0, count = *p; - - while (i < count) { - if (h[i].ProcessId == pid) - SetHandleInformation((HANDLE)(ULONG) h[i].Handle, HANDLE_FLAG_INHERIT, HANDLE_FLAG_INHERIT); - i++; - } - free(p); -} -#endif - -/* setjmp env for the jump back into the fork() function */ -static jmp_buf jenv; - -/* entry point for our child thread process - just longjmp into fork */ -static int child_entry(void) { - longjmp(jenv, 1); - return 0; -} - -/* initialize NTDLL entry points */ -static int init_NTAPI(void) { - HANDLE ntdll = GetModuleHandle("ntdll"); - if (ntdll == NULL) return -1; - ZwCreateProcess = (ZwCreateProcess_t) GetProcAddress(ntdll, "ZwCreateProcess"); - ZwQuerySystemInformation = (ZwQuerySystemInformation_t) GetProcAddress(ntdll, "ZwQuerySystemInformation"); - ZwQueryVirtualMemory = (ZwQueryVirtualMemory_t) GetProcAddress(ntdll, "ZwQueryVirtualMemory"); - ZwCreateThread = (ZwCreateThread_t) GetProcAddress(ntdll, "ZwCreateThread"); - ZwGetContextThread = (ZwGetContextThread_t) GetProcAddress(ntdll, "ZwGetContextThread"); - ZwResumeThread = (ZwResumeThread_t) GetProcAddress(ntdll, "ZwResumeThread"); - ZwQueryInformationThread = (ZwQueryInformationThread_t) GetProcAddress(ntdll, "ZwQueryInformationThread"); - ZwWriteVirtualMemory = (ZwWriteVirtualMemory_t) GetProcAddress(ntdll, "ZwWriteVirtualMemory"); - ZwClose = (ZwClose_t) GetProcAddress(ntdll, "ZwClose"); - /* in theory we chould check all of them - but I guess that would be a waste of time ... */ - return (!ZwCreateProcess) ? -1 : 0; -} - -#pragma mark -- fork() -- - -int fork(void) { - if (setjmp(jenv) != 0) return 0; /* return as a child */ - - /* check whether the entry points are initilized and get them if necessary */ - if (!ZwCreateProcess && init_NTAPI()) return -1; - -#ifdef INHERIT_ALL - /* make sure all handles are inheritable */ - set_inherit_all(); -#endif - - HANDLE hProcess = 0, hThread = 0; - OBJECT_ATTRIBUTES oa = { sizeof(oa) }; - - /* create forked process */ - ZwCreateProcess(&hProcess, PROCESS_ALL_ACCESS, &oa, NtCurrentProcess(), TRUE, 0, 0, 0); - - CONTEXT context = {CONTEXT_FULL | CONTEXT_DEBUG_REGISTERS | CONTEXT_FLOATING_POINT}; - - /* set the Eip for the child process to our child function */ - ZwGetContextThread(NtCurrentThread(), &context); - context.Eip = (ULONG)child_entry; - - MEMORY_BASIC_INFORMATION mbi; - ZwQueryVirtualMemory(NtCurrentProcess(), (PVOID)context.Esp, MemoryBasicInformation, &mbi, sizeof mbi, 0); - - USER_STACK stack = {0, 0, (PCHAR)mbi.BaseAddress + mbi.RegionSize, mbi.BaseAddress, mbi.AllocationBase}; - CLIENT_ID cid; - - /* create thread using the modified context and stack */ - ZwCreateThread(&hThread, THREAD_ALL_ACCESS, &oa, hProcess, &cid, &context, &stack, TRUE); - - /* copy exception table */ - THREAD_BASIC_INFORMATION tbi; - ZwQueryInformationThread(NtCurrentThread(), ThreadBasicInformation, &tbi, sizeof tbi, 0); - PNT_TIB tib = (PNT_TIB)tbi.TebBaseAddress; - ZwQueryInformationThread(hThread, ThreadBasicInformation, &tbi, sizeof tbi, 0); - ZwWriteVirtualMemory(hProcess, tbi.TebBaseAddress, &tib->ExceptionList, sizeof tib->ExceptionList, 0); - - /* start (resume really) the child */ - ZwResumeThread(hThread, 0); - - /* clean up */ - ZwClose(hThread); - ZwClose(hProcess); - - /* exit with child's pid */ - return (int)cid.UniqueProcess; -} - - -/* Dear Emacs, please be nice and use - Local Variables: - mode:c - tab-width: 4 - c-basic-offset:4 - End: -*/ - -#else -/* unix has fork() already */ -#include -#endif diff -Nru r-cran-multicore-0.1-7/src/Makevars.win r-cran-multicore-0.2/src/Makevars.win --- r-cran-multicore-0.1-7/src/Makevars.win 2011-09-08 01:57:38.000000000 +0000 +++ r-cran-multicore-0.2/src/Makevars.win 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -PKG_LIBS=-lwsock32 diff -Nru r-cran-multicore-0.1-7/src/perf.c r-cran-multicore-0.2/src/perf.c --- r-cran-multicore-0.1-7/src/perf.c 2011-09-08 01:57:38.000000000 +0000 +++ r-cran-multicore-0.2/src/perf.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,12 +0,0 @@ -/* performance-enhancing functions */ - -#define USE_RINTERNALS 1 - -#include - -SEXP create_list(SEXP sLength) { - int len = Rf_asInteger(sLength); - if (len < 1) len = 0; - return Rf_allocVector(VECSXP, len); -} - diff -Nru r-cran-multicore-0.1-7/src/winfix.c r-cran-multicore-0.2/src/winfix.c --- r-cran-multicore-0.1-7/src/winfix.c 2011-09-08 01:57:38.000000000 +0000 +++ r-cran-multicore-0.2/src/winfix.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,40 +0,0 @@ -/* work-arounds and fixes for Windows */ - -#ifdef WIN32 - -#include -#include "winfix.h" - -/* Wait for any of the descriptors to become signalled. The implementation uses WaitForMultipleObjects which can only signal one object at a time, so in fact the result will be -1, 0 or 1. Also note that we are using readfds *only*, all others are ignored. */ -int pipe_select(int nfds, fd_set *readfds, fd_set *writefds, fd_set *errorfds, struct timeval *timeout) -{ - HANDLE h[MAXIMUM_WAIT_OBJECTS]; - int fd[MAXIMUM_WAIT_OBJECTS]; - DWORD n, hs = 0, tout = INFINITE; - int i = 0, sii = -1; - - while (i < nfds) { - if (FD_ISSET(i, readfds)) { - h[hs] = (HANDLE) _get_osfhandle(i); - fd[hs++] = i; - if (hs >= MAXIMUM_WAIT_OBJECTS) break; - } - i++; - } - if (hs < 1) return -1; - if (timeout) tout = (timeout->tv_sec * 1000) + (timeout->tv_usec / 1000); - n = WaitForMultipleObjects(hs, h, FALSE, tout); - if (n >= WAIT_OBJECT_0 && n - WAIT_OBJECT_0 < hs) sii = (int) (n - WAIT_OBJECT_0); - else if (n >= WAIT_ABANDONED_0 && n - WAIT_ABANDONED_0 < hs) sii = (int) (n - WAIT_ABANDONED_0); - if (n == WAIT_FAILED) return -1; - if (sii == -1) return 0; - else { - FD_ZERO(readfds); - FD_SET(fd[n - WAIT_OBJECT_0], readfds); - } - return 1; -} -#else -/* this is only a dummy to avoid warning by various compilers about empty files, superfluous semicolons etc. */ -typedef int foo_t; -#endif diff -Nru r-cran-multicore-0.1-7/src/winfix.h r-cran-multicore-0.2/src/winfix.h --- r-cran-multicore-0.1-7/src/winfix.h 2011-09-08 01:57:38.000000000 +0000 +++ r-cran-multicore-0.2/src/winfix.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,17 +0,0 @@ -#include -#include /* for _O_BINARY */ - -/* our implementation from windows/forknt.c */ -extern int fork(); - -/* our own implementation of select using WaitForMultipleObjects */ -int pipe_select(int xfd, fd_set *sr, fd_set *sw, fd_set *se, struct timeval *timeout); - -#define sleep(X) Sleep((X) * 1000) -#define pipe(fds) _pipe(fds, 4096, _O_BINARY) - -/* Windows includes re-define ERROR which is used by R .. */ -#ifdef ERROR -#undef ERROR -#endif -