Skip to content

Commit c4adc01

Browse files
kevinusheykevinushey
committed
some refactoring
1 parent d9e7ecb commit c4adc01

File tree

5 files changed

+141
-69
lines changed

5 files changed

+141
-69
lines changed

‎DESCRIPTION‎

Lines changed: 0 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -33,8 +33,3 @@ License: GPL (>= 2)
3333
URL: https://rcppcore.github.io/RcppParallel/, https://github.com/RcppCore/RcppParallel
3434
BugReports: https://github.com/RcppCore/RcppParallel/issues
3535
Biarch: TRUE
36-
Collate:
37-
'build.R'
38-
'hooks.R'
39-
'options.R'
40-
'skeleton.R'

‎R/build.R‎

Lines changed: 99 additions & 64 deletions
Original file line numberDiff line numberDiff line change
@@ -28,98 +28,133 @@ RcppParallelLibs <- function() {
2828

2929
# Inline plugin used by sourceCpp.
3030
inlineCxxPlugin <- function() {
31+
32+
env <- list(
33+
PKG_CXXFLAGS = tbbCxxFlags(),
34+
PKG_LIBS = tbbLdFlags()
35+
)
36+
3137
list(
32-
env = list(
33-
PKG_CXXFLAGS = tbbCxxFlags(),
34-
PKG_LIBS = tbbLdFlags()
35-
),
36-
includes = "#include <RcppParallel.h>",
38+
env = env,
39+
body = identity,
40+
includes = "#include <RcppParallel.h>",
3741
LinkingTo = "RcppParallel",
38-
body = function(x) x,
39-
Depends = "RcppParallel"
42+
Depends = "RcppParallel"
4043
)
44+
4145
}
4246

4347
tbbCxxFlags <- function() {
4448

45-
flags <- c()
49+
flags <- character()
4650

4751
# opt-in to TBB on Windows
48-
if (Sys.info()['sysname'] == "Windows")
49-
flags <- paste(flags, "-DRCPP_PARALLEL_USE_TBB=1")
50-
51-
if (dir.exists(Sys.getenv("TBB_INC"))) {
52-
TBB_INC <- asBuildPath(Sys.getenv("TBB_INC"))
53-
54-
if (file.exists(file.path(TBB_INC, "tbb", "version.h"))) {
55-
flags <- paste0("-I", shQuote(TBB_INC), " -DTBB_INTERFACE_NEW")
56-
} else {
57-
flags <- paste0("-I", shQuote(TBB_INC))
58-
}
52+
if (is_windows())
53+
flags <- c(flags, "-DRCPP_PARALLEL_USE_TBB=1")
54+
55+
# if TBB_INC is set, apply those library paths
56+
tbbInc <- Sys.getenv("TBB_INC", unset = NA)
57+
if (!is.na(tbbInc)) {
58+
59+
# add include path
60+
flags <- c(flags, paste0("-I", shQuote(asBuildPath(tbbInc))))
61+
62+
# prefer new interface if version.h exists
63+
versionPath <- file.path(tbbInc, "tbb/version.h")
64+
if (file.exists(versionPath))
65+
flags <- c(flags, "-DTBB_INTERFACE_NEW")
66+
5967
}
6068

61-
flags
69+
# return flags as string
70+
paste(flags, collapse = " ")
71+
6272
}
6373

6474
# Return the linker flags requried for TBB on this platform
6575
tbbLdFlags <- function() {
66-
# on Windows and Solaris we need to explicitly link against tbb.dll
67-
if ((Sys.info()['sysname'] %in% c("Windows", "SunOS")) && !isSparc()) {
68-
tbb <- tbbLibPath()
69-
paste("-L", shQuote(asBuildPath(dirname(tbb))), " -ltbb -ltbbmalloc", sep = "")
70-
} else if (dir.exists(Sys.getenv("TBB_LIB"))) {
71-
TBB_LIB <- asBuildPath(Sys.getenv("TBB_LIB"))
72-
paste0("-L", shQuote(TBB_LIB), " -Wl,-rpath,", TBB_LIB, " -ltbb -ltbbmalloc")
73-
} else {
74-
""
76+
77+
# shortcut if TBB_LIB defined
78+
tbbLib <- Sys.getenv("TBB_LIB", unset = NA)
79+
if (!is.na(tbbLib)) {
80+
fmt <- "-L%1$s -Wl,-rpath,%1$s -ltbb -ltbbmalloc"
81+
return(sprintf(fmt, asBuildPath(tbbLib)))
82+
}
83+
84+
# on Windows and Solaris, we need to explicitly link
85+
needsExplicitFlags <- is_windows() || (is_solaris() && !is_sparc())
86+
if (needsExplicitFlags) {
87+
libPath <- asBuildPath(dirname(tbbLibPath()))
88+
libFlag <- paste0("-L", shQuote(libPath))
89+
return(paste(libFlag, "-ltbb", "-ltbbmalloc"))
7590
}
91+
92+
# nothing required on other platforms
93+
""
94+
7695
}
7796

7897
# Determine the platform-specific path to the TBB library
7998
tbbLibPath <- function(suffix = "") {
80-
sysname <- Sys.info()['sysname']
81-
tbbSupported <- list(
82-
"Darwin" = paste("libtbb", suffix, ".dylib", sep = ""),
83-
"Linux" = paste("libtbb", suffix, ".so.2", sep = ""),
84-
"Windows" = paste("tbb", suffix, ".dll", sep = ""),
85-
"SunOS" = paste("libtbb", suffix, ".so", sep = "")
99+
100+
# library paths for different OSes
101+
sysname <- Sys.info()[["sysname"]]
102+
103+
tbbLibNames <- list(
104+
"Darwin" = paste0("libtbb", suffix, ".dylib"),
105+
"Windows" = paste0("tbb", suffix, ".dll"),
106+
"SunOS" = paste0("libtbb", suffix, ".so"),
107+
"Linux" = paste0("libtbb", suffix, c(".so", ".so.2"))
86108
)
87109

88-
if (dir.exists(Sys.getenv("TBB_LIB"))) {
89-
TBB_LIB <- asBuildPath(Sys.getenv("TBB_LIB"))
90-
asBuildPath(file.path(TBB_LIB, paste("libtbb", suffix, ".so", sep = "")))
91-
} else {
92-
if ((sysname %in% names(tbbSupported)) && !isSparc()) {
93-
libDir <- "lib/"
94-
if (sysname == "Windows")
95-
libDir <- paste(libDir, .Platform$r_arch, "/", sep="")
96-
97-
tbb_path <- system.file(paste(libDir, tbbSupported[[sysname]], sep = ""),
98-
package = "RcppParallel")
99-
if (sysname == "Linux" && !file.exists(tbb_path)) {
100-
system.file(paste(libDir, "libtbb", suffix, ".so", sep =""),
101-
package = "RcppParallel")
102-
} else {
103-
tbb_path
104-
}
105-
} else {
106-
NULL
107-
}
110+
# shortcut if TBB_LIB is defined
111+
tbbLib <- Sys.getenv("TBB_LIB", unset = NA)
112+
if (!is.na(tbbLib)) {
113+
libPaths <- file.path(tbbLib, tbbLibNames[[sysname]])
114+
for (libPath in libPaths)
115+
if (file.exists(libPath))
116+
return(asBuildPath(libPath))
117+
}
118+
119+
# otherwise, construct library path as appropriate for arch
120+
isCompatible <-
121+
!is_sparc() &&
122+
!is.null(tbbLibNames[[sysname]])
123+
124+
if (!isCompatible)
125+
return(NULL)
126+
127+
# construct library path
128+
arch <- .Platform$r_arch
129+
components <- c("lib", if (nzchar(arch)) arch)
130+
libDir <- paste(components, collapse = "/")
131+
132+
# form path to bundled tbb component
133+
libNames <- tbbLibNames[[sysname]]
134+
for (libName in libNames) {
135+
tbbName <- file.path(libDir, libName)
136+
tbbPath <- system.file(tbbName, package = "RcppParallel")
137+
if (file.exists(tbbPath))
138+
return(tbbPath)
108139
}
109-
}
110140

111-
isSparc <- function() {
112-
Sys.info()['sysname'] == "SunOS" && Sys.info()[["machine"]] != "i86pc"
113141
}
114142

115143
# Helper function to ape the behavior of the R build system
116144
# when providing paths to libraries
117145
asBuildPath <- function(path) {
118-
if (.Platform$OS.type == "windows") {
119-
path <- normalizePath(path)
120-
if (grepl(' ', path, fixed=TRUE))
121-
path <- utils::shortPathName(path)
122-
path <- gsub("\\\\", "/", path)
123-
}
146+
147+
# nothing to do for non-Windows
148+
if (!is_windows())
149+
return(path)
150+
151+
# normalize paths using forward slashes
152+
path <- normalizePath(path, winslash = "/", mustWork = FALSE)
153+
154+
# prefer short path names if the path has spaces
155+
if (grepl(" ", path, fixed = TRUE))
156+
path <- utils::shortPathName(path)
157+
158+
# return path
124159
return(path)
125160
}

‎R/hooks.R‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,7 @@ mallocDllInfo <- NULL
1313
dllInfo <<- dyn.load(tbb, local = FALSE, now = TRUE)
1414
}
1515
}
16+
1617
tbbMalloc <- tbbLibPath("malloc")
1718
if (!is.null(tbbMalloc)) {
1819
if (!file.exists(tbbMalloc)) {
@@ -35,7 +36,9 @@ mallocDllInfo <- NULL
3536
# unload tbb if we loaded it
3637
if (!is.null(dllInfo))
3738
dyn.unload(dllInfo[["path"]])
39+
3840
# unload tbbmalloc if we loaded it
3941
if (!is.null(mallocDllInfo))
4042
dyn.unload(mallocDllInfo[["path"]])
43+
4144
}

‎R/platform.R‎

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
2+
is_windows <- function() {
3+
.Platform$OS.type == "windows"
4+
}
5+
6+
is_unix <- function() {
7+
.Platform$OS.type == "unix"
8+
}
9+
10+
is_solaris <- function() {
11+
Sys.info()[["sysname"]] == "SunOS"
12+
}
13+
14+
is_sparc <- function() {
15+
info <- Sys.info()
16+
all(
17+
info[["sysname"]] == "SunOS",
18+
info[["machine"]] != "i86pc"
19+
)
20+
}
21+
22+

‎tools/tbb/update-tbb.R‎

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,17 @@
1+
2+
# update as appropriate for new TBB releases, then re-run script
3+
url <- "https://github.com/oneapi-src/oneTBB/archive/refs/tags/v2021.1.1.tar.gz"
4+
5+
owd <- setwd("src")
6+
unlink("tbb", recursive = TRUE)
7+
download.file(url, destfile = basename(url), mode = "wb")
8+
9+
before <- list.files()
10+
untar(basename(url))
11+
after <- list.files()
12+
13+
folder <- setdiff(after, before)
14+
print(folder)
15+
file.rename(folder, "tbb")
16+
17+
unlink(basename(url))

0 commit comments

Comments
 (0)