allow customization of RcppParallel backend at runtime

Author: kevinushey

R/hooks.R

@@ -25,13 +25,6 @@ mallocDllInfo <- NULL
    # load the package library
    library.dynam("RcppParallel", pkgname, libname)
 
-   # set default thread options
-   numThreads <- "auto"
-   numThreadsEnv <- Sys.getenv("RCPP_PARALLEL_NUM_THREADS", unset = NA)
-   if (!is.na(numThreadsEnv))
-      setThreadOptions(numThreads = as.integer(numThreadsEnv))
-   else
-      setThreadOptions(numThreads = "auto")
 }
 
 .onUnload <- function(libpath) {

inst/NEWS

@@ -1,5 +1,7 @@
-RcppParallel 4.4.5 (UNRELEASED)
+RcppParallel 5.0.0 (UNRELEASED)
 ------------------------------------------------------------------------
+* RcppParallel backend can now be customized with RCPP_PARALLEL_BACKEND
+  environment variable (supported values are 'tbb' and 'tinythread')
 * Fixed issue when compiling RcppParallel on macOS Catalina
 * Fixed issue when compiling RcppParallel with Rtools40
 

inst/include/RcppParallel.h

@@ -10,44 +10,53 @@
 // compatibility with CRAN packages not previously configured
 // to link to TBB in Makevars.win)
 #ifndef RCPP_PARALLEL_USE_TBB
-#if defined(__APPLE__) || defined(__gnu_linux__) || ((defined(__sun) && defined(__SVR4) && !defined(__sparc)))
-#define RCPP_PARALLEL_USE_TBB 1
-#include "RcppParallel/TBB.h"
-#else
-#define RCPP_PARALLEL_USE_TBB 0
-#endif
+# if defined(__APPLE__) || defined(__gnu_linux__) || (defined(__sun) && defined(__SVR4) && !defined(__sparc))
+#  define RCPP_PARALLEL_USE_TBB 1
+# else
+#  define RCPP_PARALLEL_USE_TBB 0
+# endif
 #endif
 
 #if RCPP_PARALLEL_USE_TBB
-  #include "RcppParallel/TBB.h"
+# include "RcppParallel/TBB.h"
 #endif
 
+#include "RcppParallel/Backend.h"
+
 #include "RcppParallel/RVector.h"
 #include "RcppParallel/RMatrix.h"
 
 namespace RcppParallel {
 
-inline void parallelFor(std::size_t begin, std::size_t end, 
-                        Worker& worker, std::size_t grainSize = 1) {
-                           
+inline void parallelFor(std::size_t begin,
+                        std::size_t end, 
+                        Worker& worker,
+                        std::size_t grainSize = 1)
+{
 #if RCPP_PARALLEL_USE_TBB
-   tbbParallelFor(begin, end, worker, grainSize);
+   if (internal::backend() == internal::BACKEND_TBB)
+      tbbParallelFor(begin, end, worker, grainSize);
+   else
+      ttParallelFor(begin, end, worker, grainSize);
 #else
    ttParallelFor(begin, end, worker, grainSize);
 #endif
-
 }
 
 template <typename Reducer>
-inline void parallelReduce(std::size_t begin, std::size_t end, 
-                           Reducer& reducer, std::size_t grainSize = 1) {
-                              
+inline void parallelReduce(std::size_t begin,
+                           std::size_t end, 
+                           Reducer& reducer,
+                           std::size_t grainSize = 1)
+{
 #if RCPP_PARALLEL_USE_TBB
-   tbbParallelReduce(begin, end, reducer, grainSize);
+   if (internal::backend() == internal::BACKEND_TBB)
+      tbbParallelReduce(begin, end, reducer, grainSize);
+   else
+      ttParallelReduce(begin, end, reducer, grainSize);
 #else
    ttParallelReduce(begin, end, reducer, grainSize);
 #endif
-
 }
 
 } // namespace RcppParallel

inst/include/RcppParallel/Backend.h

@@ -0,0 +1,78 @@
+
+#ifndef __RCPP_PARALLEL_BACKEND__
+#define __RCPP_PARALLEL_BACKEND__
+
+#include <cstdlib>
+#include <cstring>
+
+extern "C" {
+   void REprintf(const char*, ...);
+}
+
+namespace RcppParallel {
+namespace internal {
+
+enum backend_type {
+   BACKEND_TBB,
+   BACKEND_TINYTHREAD
+};
+
+#if RCPP_PARALLEL_USE_TBB
+
+inline backend_type defaultBackend()
+{
+   return BACKEND_TBB;
+}
+
+#else
+
+inline backend_type defaultBackend()
+{
+   return BACKEND_TINYTHREAD;
+}
+
+#endif
+
+
+
+inline const char* backendToString(backend_type backend)
+{
+   switch (backend)
+   {
+   case BACKEND_TBB:        return "tbb";
+   case BACKEND_TINYTHREAD: return "tinythread";
+   }
+}
+
+inline backend_type backend()
+{
+   const char* requestedBackend = std::getenv("RCPP_PARALLEL_BACKEND");
+   if (requestedBackend == NULL)
+   {
+      return defaultBackend();
+   }
+   else if (std::strcmp(requestedBackend, "tbb") == 0)
+   {
+#if RCPP_PARALLEL_USE_TBB
+      return BACKEND_TBB;
+#else
+      REprintf("tbb backend is not available; using tinythread instead\n");
+      return BACKEND_TINYTHREAD;
+#endif
+   }
+   else if (strcmp(requestedBackend, "tinythread") == 0)
+   {
+      return BACKEND_TINYTHREAD;
+   }
+   else
+   {
+      const char* fmt = "unknown parallel backend '%s'; using '%s' instead\n";
+      REprintf(fmt, requestedBackend, backendToString(defaultBackend()));
+      return defaultBackend();
+   }
+}
+
+} // namespace internal
+} // namespace RcppParallel
+
+#endif /* __RCPP_PARALLEL_BACKEND__ */

inst/include/RcppParallel/TinyThread.h

@@ -2,12 +2,12 @@
 #define __RCPP_PARALLEL_TINYTHREAD__
 
 #include <cstdlib>
+#include <cstdio>
 
 #include "Common.h"
 
 #include <tthread/tinythread.h>
 
-#include <stdio.h>
 
 #include <vector>
 

tests/doRUnit.R

@@ -1,16 +1,21 @@
-stopifnot(require(RUnit, quietly=TRUE))
-stopifnot(require(Rcpp, quietly=TRUE))
-stopifnot(require(RcppParallel, quietly=TRUE))
+stopifnot(require(RUnit, quietly = TRUE))
+stopifnot(require(Rcpp, quietly = TRUE))
+stopifnot(require(RcppParallel, quietly = TRUE))
 
 ## Set a seed to make the test deterministic
 set.seed(42)
 
+# Don't use TBB
+Sys.setenv(RCPP_PARALLEL_BACKEND = "tinythread")
+
 ## Define tests
-suite <- defineTestSuite(name="RcppParallel Unit Tests",
-                         dirs=system.file("tests", package = "RcppParallel"))
+suite <- defineTestSuite(
+   name = "RcppParallel Unit Tests",
+   dirs = system.file("tests", package = "RcppParallel")
+)
 
 ## Based on practice in Rcpp to avoid some test failures
-Sys.setenv("R_TESTS"="")
+Sys.setenv("R_TESTS" = "")
 
 ## Run tests
 tests <- runTestSuite(suite)
@@ -22,9 +27,11 @@ printTextProtocol(tests)
 if (getErrors(tests)$nFail > 0) {
    stop("TEST FAILED!")
 }
+
 if (getErrors(tests)$nErr > 0) {
    stop("TEST HAD ERRORS!")
 }
+
 if (getErrors(tests)$nTestFunc < 1) {
    stop("NO TEST FUNCTIONS RUN!")
 }