1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
### =========================================================================
### OpenMP thread control
### -------------------------------------------------------------------------
###
.normarg_nthread <- function(nthread)
{
if (!isSingleNumber(nthread))
stop(wmsg("'nthread' must be a single number"))
if (!is.integer(nthread))
nthread <- as.integer(nthread)
nthread
}
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### R wrappers to OpenMP thread control functions
###
### Wrapper to omp_get_num_procs().
### Returns 0 if OpenMP is not available (e.g. on macOS).
.get_num_procs <- function()
.Call2("C_get_num_procs", PACKAGE="SparseArray")
### Wrapper to omp_get_max_threads().
### Default is controlled by environment variable OMP_NUM_THREADS.
### Returns 0 if OpenMP is not available (e.g. on macOS).
.get_max_threads <- function()
.Call2("C_get_max_threads", PACKAGE="SparseArray")
### Wrapper to omp_set_num_threads().
### No-op if OpenMP is not available (e.g. on macOS).
### Returns previous omp_get_max_threads() value.
.set_max_threads <- function(nthread)
{
nthread <- .normarg_nthread(nthread)
.Call2("C_set_max_threads", nthread, PACKAGE="SparseArray")
}
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Get/set SparseArray option "nthread"
###
.default_SparseArray_nthread <- function()
{
nthread <- .get_max_threads()
if (nthread == 0L)
return(nthread)
n <- .get_num_procs() %/% 3L
if (nthread > n)
nthread <- n
if (nthread == 0L)
nthread <- 1L
nthread
}
get_SparseArray_nthread <- function()
{
default <- .default_SparseArray_nthread()
nthread <- get_SparseArray_option("nthread", default=default)
if (!isSingleNumber(nthread) || nthread < 0L)
warning(wmsg("invalid 'getOption(\"SparseArray\")$nthread'"))
nthread
}
set_SparseArray_nthread <- function(nthread=NULL)
{
if (.get_max_threads() == 0L) {
nthread <- 0L
} else if (is.null(nthread)) {
nthread <- .default_SparseArray_nthread()
} else {
nthread <- .normarg_nthread(nthread)
if (nthread < 1L)
stop(wmsg("'nthread' must be >= 1"))
}
set_SparseArray_option("nthread", nthread)
}
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### SparseArray.Call()
###
SparseArray.Call <- function(.NAME, ...)
{
prev_max_threads <- .set_max_threads(get_SparseArray_nthread())
on.exit(.set_max_threads(prev_max_threads))
.Call2(.NAME, ..., PACKAGE="SparseArray")
}
|
