build tbb stub from static library on older toolchains

NEWS.md

@@ -1,5 +1,11 @@
 # RcppParallel (development version)
 
+* Fixed installation on Windows toolchains providing an older (non-oneTBB)
+  copy of TBB, e.g. Rtools42: the tbb stub library is now built by
+  re-exporting the static TBB library, rather than wrapping the oneTBB
+  runtime (which is unavailable there). In addition, stale stub build
+  artifacts from a different toolchain are no longer reused.
+
 * Fixed installation on Windows systems whose Rtools does not provide TBB
   (R < 4.2.0): configure no longer requires cmake there, and the tbb stub
   library is no longer built when the TBB backend is disabled.

R/zzz.R

@@ -25,27 +25,27 @@ loadTbbLibrary <- function(name) {
       # which on Windows points at Rtools and holds only static libraries
       path <- archSystemFile("lib", paste0(name, ".dll"))
       if (!file.exists(path)) {
-         verboseMessage("TBB library '%s' not found in package 'lib' folder; skipping", name)
+         verboseMessage("tbb library '%s' not found in package 'lib' folder; skipping", name)
          return(NULL)
       }
 
-      verboseMessage("loading TBB library '%s'", path)
+      verboseMessage("loading tbb library '%s'", path)
       return(dyn.load(path, local = FALSE, now = TRUE))
 
    }
 
    path <- tbbLibraryPath(name)
    if (is.null(path)) {
-      verboseMessage("TBB library '%s' could not be resolved; skipping", name)
+      verboseMessage("tbb library '%s' could not be resolved; skipping", name)
       return(NULL)
    }
 
    if (!file.exists(path)) {
-      warning("TBB library ", shQuote(name), " not found.")
+      warning("tbb library ", shQuote(name), " not found.")
       return(NULL)
    }
 
-   verboseMessage("loading TBB library '%s'", path)
+   verboseMessage("loading tbb library '%s'", path)
    dyn.load(path, local = FALSE, now = TRUE)
 
 }

src/install.libs.R

@@ -85,32 +85,82 @@
       if (file.exists(tbbDll)) {
          writeLines("** tbb.dll already exists; skipping tbb stub library")
       } else {
-         writeLines("** creating tbb stub library")
-         status <- system("R CMD SHLIB -o tbb-compat/tbb.dll tbb-compat/tbb-compat.cpp")
-         if (status != 0)
-            stop("error building tbb stub library")
-         file.copy("tbb-compat/tbb.dll", file.path(tbbDest, "tbb.dll"))
+         buildTbbStub(tbbDest)
       }
    }
 
 }
 
+# Build the tbb.dll stub that downstream packages link ('-ltbb' via e.g.
+# StanHeaders) and that older binaries resolve their imports against.
+buildTbbStub <- function(tbbDest) {
+
+   # remove artifacts from prior builds, which may have been produced
+   # by a different toolchain or against a different TBB; 'make' would
+   # otherwise consider them up-to-date and re-ship them as-is
+   unlink(c("tbb-compat/tbb.dll", Sys.glob("tbb-compat/*.o")))
+
+   tbbInc <- Sys.getenv("TBB_INC")
+   if (!nzchar(tbbInc))
+      tbbInc <- TBB_INC
+
+   if (file.exists(file.path(tbbInc, "oneapi"))) {
+
+      # with oneTBB, the stub provides the old TBB ABI's
+      # task_scheduler_observer entry point on top of the new runtime
+      writeLines("** creating tbb stub library")
+      status <- system("R CMD SHLIB -o tbb-compat/tbb.dll tbb-compat/tbb-compat.cpp")
+      if (status != 0)
+         stop("error building tbb stub library")
+
+   } else {
+
+      # with older versions of TBB (e.g. Rtools42), tbb-compat.cpp cannot
+      # build -- there is no oneTBB runtime to wrap -- but the static
+      # library already provides the old ABI, so re-export it wholesale
+      writeLines("** creating tbb stub library (from static tbb)")
+
+      tbbLib <- Sys.getenv("TBB_LIB")
+      if (!nzchar(tbbLib))
+         tbbLib <- TBB_LIB
+
+      cxx <- system("R CMD config CXX", intern = TRUE)
+      archive <- file.path(tbbLib, sprintf("lib%s.a", TBB_NAME))
+      command <- paste(
+         cxx,
+         "-shared -static-libgcc",
+         "-o tbb-compat/tbb.dll",
+         "-Wl,--whole-archive", shQuote(archive), "-Wl,--no-whole-archive",
+         "-lssp"
+      )
+
+      writeLines(command)
+      status <- system(command)
+      if (status != 0)
+         stop("error building tbb stub library")
+
+   }
+
+   file.copy("tbb-compat/tbb.dll", file.path(tbbDest, "tbb.dll"))
+
+}
+
 # Report which TBB libraries are about to be installed, and from where.
 # Stale or unexpected libraries copied here have historically been a
 # subtle source of load failures in downstream packages, so make the
 # provenance easy to spot in installation logs.
 logTbbLibraries <- function(tbbLibs, source) {
    if (length(tbbLibs)) {
-      fmt <- "** copying TBB libraries from '%s' [%s]"
+      fmt <- "** copying tbb libraries from '%s' [%s]"
       writeLines(sprintf(fmt, source, paste(basename(tbbLibs), collapse = ", ")))
    } else {
-      writeLines(sprintf("** no TBB libraries found in '%s'", source))
+      writeLines(sprintf("** no tbb libraries found in '%s'", source))
    }
 }
 
 useTbbPreamble <- function(tbbInc) {
 
-   writeLines(sprintf("** copying TBB headers from '%s'", tbbInc))
+   writeLines(sprintf("** copying tbb headers from '%s'", tbbInc))
    dir.create("../inst/include", recursive = TRUE, showWarnings = FALSE)
    for (suffix in c("oneapi", "serial", "tbb")) {
       tbbPath <- file.path(tbbInc, suffix)
@@ -119,7 +169,7 @@ useTbbPreamble <- function(tbbInc) {
       }
    }
 
-   patchTbbMachineHeader("../inst/include/oneapi/tbb/detail/_machine.h")
+   invisible(patchTbbMachineHeader("../inst/include/oneapi/tbb/detail/_machine.h"))
 
 }
 

tools/config/cleanup.R

@@ -7,6 +7,8 @@
 # install, so nothing is lost by removing these
 unlink("src/tbb/build", recursive = TRUE)
 unlink("src/tbb/build-tbb", recursive = TRUE)
+unlink("src/tbb-compat/tbb.dll")
+unlink(Sys.glob("src/tbb-compat/*.o"))
 unlink("inst/lib",  recursive = TRUE)
 unlink("inst/libs", recursive = TRUE)
 unlink("inst/include/index.html", recursive = TRUE)