Merge pull request #84 from snoweye/master

0.4-3 on CRAN

Author: snoweye

ChangeLog

@@ -1,3 +1,9 @@
+2020-01-26: Ver. 0.4-3
+  * Change "execmpi()" to finalize current mpi first.
+
+2019-12-01: Ver. 0.4-2
+  * Fix multiple definition warnings due to "-fno-common" as default in gcc-10.
+
 2019-11-21: Ver. 0.4-1
   * Remove "00LOCK-pbdMPI/00new/" from Makeconf generated by Makevars.win for
     64bit MS-MPI library only.

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: pbdMPI
-Version: 0.4-1
-Date: 2019-11-21
+Version: 0.4-3
+Date: 2020-01-24
 Title: Programming with Big Data -- Interface to MPI
 Authors@R: c(person("Wei-Chen", "Chen", role = c("aut", "cre"), email =
         "wccsnow@gmail.com"),

R/util_execmpi.r

@@ -1,7 +1,8 @@
 ### Utility
 
 execmpi <- function(spmd.code = NULL, spmd.file = NULL,
-    mpicmd = NULL, nranks = 2L, verbose = TRUE){
+    mpicmd = NULL, nranks = 1L, rscmd = NULL, verbose = TRUE,
+    disable.current.mpi = TRUE){
   ### Check # of ranks.
   nranks <- as.integer(nranks)
   if(nranks <= 0){
@@ -21,7 +22,7 @@ execmpi <- function(spmd.code = NULL, spmd.file = NULL,
 
     ### Dump spmd.code to a temp file, execute
     spmd.file <- tempfile()
-    on.exit(unlink(spmd.file))
+    # on.exit(unlink(spmd.file))
     conn <- file(spmd.file, open = "wt")
     writeLines(spmd.code, conn)
     close(conn)
@@ -72,11 +73,13 @@ execmpi <- function(spmd.code = NULL, spmd.file = NULL,
   }
 
   ### Find Rscript.
-  if(Sys.info()[['sysname']] == "Windows"){
-    rscmd <- paste(Sys.getenv("R_HOME"), "/bin", Sys.getenv("R_ARCH_BIN"),
-                   "/Rscript", sep = "")
-  } else{
-    rscmd <- paste(Sys.getenv("R_HOME"), "/bin/Rscript", sep = "")
+  if(is.null(rscmd)){
+    if(Sys.info()[['sysname']] == "Windows"){
+      rscmd <- paste(Sys.getenv("R_HOME"), "/bin", Sys.getenv("R_ARCH_BIN"),
+                     "/Rscript", sep = "")
+    } else{
+      rscmd <- paste(Sys.getenv("R_HOME"), "/bin/Rscript", sep = "")
+    }
   }
 
   ### Make a cmd.
@@ -88,8 +91,9 @@ execmpi <- function(spmd.code = NULL, spmd.file = NULL,
   } else{
     log.file <- tempfile()
     on.exit(unlink(log.file), add = TRUE)
-    cmd <- paste(mpicmd, "-np", nranks, rscmd, spmd.file,
-                 ">", log.file, "2>&1 & echo \"PID=$!\" &", sep = " ")
+    cmd <- paste(mpicmd, " -np ", nranks, " ",
+                 rscmd, " -e \"source('", spmd.file, "')\" ",
+                 "> ", log.file, " 2>&1 & echo \"PID=$!\" &", sep = "")
   }
   if(verbose){
     cat(">>> MPI command:\n", cmd, "\n", sep = "")
@@ -100,6 +104,10 @@ execmpi <- function(spmd.code = NULL, spmd.file = NULL,
     ret <- system(cmd, intern = TRUE, ignore.stdout = FALSE,
                   ignore.stderr = FALSE, wait = TRUE)
   } else{
+    if((!is.finalized()) && disable.current.mpi){
+      finalize(mpi.finalize = TRUE)
+    }
+ 
     tmp <- system(cmd, intern = TRUE, ignore.stdout = FALSE,
                   ignore.stderr = FALSE, wait = FALSE)
     if(verbose){

man/uu_execmpi.Rd

@@ -5,20 +5,24 @@
 \description{
   This function basically saves code in a spmd.file and executes
   MPI via R's system call e.g.
-  \code{system("mpiexec -np 2 Rscript spmd.file")}.
+  \code{system("mpiexec -np 1 Rscript spmd.file")}.
 }
 \usage{
 execmpi(spmd.code = NULL, spmd.file = NULL,
-    mpicmd = NULL, nranks = 2L, verbose = TRUE)
+    mpicmd = NULL, nranks = 1L, rscmd = NULL, verbose = TRUE,
+    disable.current.mpi = TRUE)
 runmpi(spmd.code = NULL, spmd.file = NULL,
-    mpicmd = NULL, nranks = 2L, verbose = TRUE)
+    mpicmd = NULL, nranks = 1L, rscmd = NULL, verbose = TRUE,
+    disable.current.mpi = TRUE)
 }
 \arguments{
   \item{spmd.code}{SPMD code to be run via mpicmd and \code{Rscript}.}
   \item{spmd.file}{a file contains SPMD code to be run via mpicmd and \code{Rscript}.}
   \item{mpicmd}{MPI executable command. If \code{NULL}, system default will be searched.}
   \item{nranks}{number of processes to run the SPMD code envoked by mpicmd.}
+  \item{rscmd}{\code{Rscript} executable command. If \code{NULL}, system default will be searched.}
   \item{verbose}{print SPMD code outputs and MPI messages.}
+  \item{disable.current.mpi}{force to finalize the current MPI comm if any, for unix-alike system only.}
 }
 \details{
   When the \code{spmd.code} is \code{NULL}: The code should be already
@@ -36,14 +40,14 @@ runmpi(spmd.code = NULL, spmd.file = NULL,
   used to dump \code{spmd.code}.
 
   For Unix-alike systems, the command
-  \code{cmd <- paste(mpicmd, "-np", nranks, "Rscript", spmd.file, ">", log.file, " 2>&1 & echo \"PID=$!\" &")}
+  \code{cmd <- paste(mpicmd, "-np", nranks, rscmd, spmd.file, ">", log.file, " 2>&1 & echo \"PID=$!\" &")}
   is executed via \code{system(cmd, intern = TRUE, wait = FALSE, ignore.stdout = TRUE, ignore.stderr = TRUE)}. The \code{log.file} is a temporary file to
   save the outputs from the \code{spmd.code}. The results saved to the
   \code{log.file} will be read back in and \code{cat} and \code{return}
   to R.
 
   For Windows, the \code{cmd} will be
-  \code{paste(mpicmd, "-np", nranks, "Rscript", spmd.file)}
+  \code{paste(mpicmd, "-np", nranks, rscmd, spmd.file)}
   and is executed via
   \code{system(cmd, intern = TRUE, wait = FALSE, ignore.stdout = TRUE, ignore.stderr = TRUE)}.
 }
@@ -52,6 +56,23 @@ runmpi(spmd.code = NULL, spmd.file = NULL,
   in Linux-alike systems. For Windows, the MPI job is always wait until
   it is complete.
 }
+\note{
+  For Unix-alike systems,
+  in new R and MPI, the \code{pbdMPI::execmpi(...)} may
+  carry the current MPI \code{comm} into \code{system(cmd, ...)} calls.
+  Because the \code{comm} has been established/loaded by the
+  \code{init()} call because of \code{::},
+  the \code{mpiexec} inside the \code{system(cmd, ...)} calls
+  will be confused with the exist \code{comm}.
+
+  Consider that \code{pbdMPI::execmpi(...)} is typically called in
+  interactive mode (or actually only done for CRAN check in most case),
+  an argument \code{disable.current.mpi = TRUE} is added/needed to finalize
+  the existing \code{comm} first before \code{system(cmd, ...)} be executed.
+
+  This function is NOT recommended for running SPMD programs.
+  The recommended way is to run under shell command.
+}
 \references{
   Programming with Big Data in R Website:
   \url{http://r-pbd.org/}

src/pkg_constant.h

@@ -20,7 +20,7 @@ static char VARIABLE_IS_NOT_USED *LOAD_LOCATION[N_LOAD_LOCATION] =
 	{"UNSET", "Rmpi", "pbdMPI", "VisIt", "pncdf4"};
 
 #define __LOAD_LOCATION__	PBDMPI
-int WHO_LOAD_FIRST;
+extern int WHO_LOAD_FIRST;
 // Whom need to take care free memory.
 
 #define MPI_APTS_R_NAME		".__MPI_APTS__"

src/pkg_global.h

@@ -39,7 +39,7 @@ struct _rmpi_array_pointers{
 	int *STATUS_MAXSIZE;
 	int *REQUEST_MAXSIZE;
 };
-rmpi_array_pointers MPI_APTS, *MPI_APTS_ptr;
+extern rmpi_array_pointers MPI_APTS, *MPI_APTS_ptr;
 
 /* In "pkg_tools.c". */
 SEXP arrange_MPI_APTS();

src/pkg_tools.c

@@ -8,6 +8,9 @@
 #include "pkg_global.h"
 #include <stdint.h>
 
+rmpi_array_pointers MPI_APTS, *MPI_APTS_ptr = NULL;
+int WHO_LOAD_FIRST;
+
 SEXP arrange_MPI_APTS(){
         SEXP R_apts;