Skip to content

Commit 981c556

Browse files
simonbeyer1simonbeyer1
committed
Repaired compile bugfix on Win machines
1 parent a77f42e commit 981c556

4 files changed

Lines changed: 58 additions & 196 deletions

File tree

‎NAMESPACE‎

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -186,11 +186,9 @@ export(getEquations)
186186
export(getFluxes)
187187
export(getLinVars)
188188
export(getLocalDLLs)
189-
export(getObjfiles)
190189
export(getObservables)
191190
export(getParameters)
192191
export(getReactions)
193-
export(getSourcefiles)
194192
export(getStepIndices)
195193
export(getSteps)
196194
export(ggopen)

‎R/tools.R‎

Lines changed: 58 additions & 158 deletions
Original file line numberDiff line numberDiff line change
@@ -461,182 +461,82 @@ expand.grid.alt <- function(seq1, seq2) {
461461
#' }
462462
#'
463463
#' @export
464-
compile <- function(..., output = NULL, args = NULL, cores = 1, verbose = FALSE) {
464+
compile <- function(..., output=NULL, args=NULL, cores=1, verbose=FALSE){
465465

466-
objects <- list(...)
467-
obj.names <- as.character(substitute(list(...)))[-1]
468-
if (!length(objects)) stop("No objects provided.")
469-
470-
# --- helpers ---------------------------------------------------------------
471-
Rbin <- shQuote(file.path(R.home("bin"), "R"))
472-
cfg <- function(x) system(paste(Rbin, "CMD config", x), intern = TRUE)
473-
474-
# --- collect source files --------------------------------------------------
475-
files <- NULL
476-
for (i in seq_along(objects)) {
477-
if (inherits(objects[[i]], c("obsfn", "parfn", "prdfn"))) {
478-
fn <- modelname(objects[[i]])
479-
fn <- outer(
480-
fn,
481-
c("", "_deriv", "_s", "_s2", "_sdcv", "_dfdx", "_dfdp"),
482-
paste0
483-
)
484-
f <- c(paste0(fn, ".c"), paste0(fn, ".cpp"))
485-
files <- union(files, f[file.exists(f)])
486-
}
487-
}
488-
if (!length(files))
489-
stop("No source files found.")
490-
491-
roots <- sub("\\.(c|cpp)$", "", files)
492-
so <- .Platform$dynlib.ext
493-
494-
has_c <- any(grepl("\\.c$", files, ignore.case = TRUE))
495-
has_cxx <- any(grepl("\\.cpp$", files, ignore.case = TRUE))
496-
497-
# --- flags -----------------------------------------------------------------
498-
opt <- if (is.null(args) || !nzchar(args)) "-O3 -DNDEBUG" else args
499-
inc <- paste0("-I", shQuote(system.file("include", package = "CppODE")))
466+
## save & restore env
467+
old <- Sys.getenv(c("PKG_CFLAGS","PKG_CXXFLAGS","PKG_CPPFLAGS"), unset=NA)
468+
on.exit({
469+
for(n in names(old))
470+
if(is.na(old[n])) Sys.unsetenv(n) else Sys.setenv(structure(old[n],names=n))
471+
}, add=TRUE)
500472

501-
cflags <- if (.Platform$OS.type == "windows") opt else paste("-fPIC", opt)
502-
cxxflags <- paste(
503-
"-std=c++20",
504-
if (.Platform$OS.type == "windows") opt else paste("-fPIC", opt)
505-
)
473+
objs <- list(...); if(!length(objs)) stop("No objects")
474+
obj.names <- as.character(substitute(list(...)))[-1]
475+
Rbin <- shQuote(file.path(R.home("bin"),"R"))
476+
so <- .Platform$dynlib.ext
477+
478+
files <- unique(unlist(lapply(objs, \(o){
479+
if(!inherits(o,c("obsfn","parfn","prdfn"))) return(NULL)
480+
b <- outer(modelname(o),
481+
c("","_deriv","_s","_s2","_sdcv","_dfdx","_dfdp"),
482+
paste0)
483+
f <- c(paste0(b,".c"),paste0(b,".cpp"))
484+
f[file.exists(f)]
485+
})))
486+
if(!length(files)) stop("No source files found")
487+
488+
files <- normalizePath(files, winslash="/", mustWork=TRUE)
489+
roots <- sub("\\.(c|cpp)$","",basename(files))
490+
491+
pic <- if(.Platform$OS.type=="windows") "" else "-fPIC"
492+
base <- paste("-O3 -ffp-contract=fast", pic)
493+
if(!is.null(args) && nzchar(args)) base <- paste(base, args)
506494

507495
Sys.setenv(
508-
PKG_CPPFLAGS = inc,
509-
PKG_CFLAGS = cflags,
510-
PKG_CXXFLAGS = cxxflags
496+
PKG_CFLAGS = base,
497+
PKG_CXXFLAGS = paste("-std=c++20", base),
498+
PKG_CPPFLAGS = paste0("-I", shQuote(system.file("include",package="CppODE")))
511499
)
512-
on.exit(Sys.setenv(PKG_CPPFLAGS="", PKG_CFLAGS="", PKG_CXXFLAGS=""), add = TRUE)
513-
514-
# --- report toolchain ------------------------------------------------------
515-
strip_std <- function(x) trimws(gsub("(^| )-std=[^ ]+", "", x))
516-
get_std <- function(x) if (grepl("-std=", x)) sub(".*-std=([^ ]+).*", "\\1", x) else NA
517-
518-
if (has_c) {
519-
std <- get_std(cflags)
520-
cat(sprintf(
521-
"using C compiler: %s%s [%s]\n",
522-
strip_std(cfg("CC")),
523-
if (!is.na(std)) sprintf(" (standard: %s)", std) else "",
524-
trimws(gsub("(^| )-std=[^ ]+", "", cflags))
525-
))
526-
}
527500

528-
if (has_cxx) {
529-
std <- get_std(cxxflags)
530-
cat(sprintf(
531-
"using C++ compiler: %s%s [%s]\n",
532-
strip_std(cfg("CXX")),
533-
if (!is.na(std)) sprintf(" (standard: %s)", std) else "",
534-
trimws(gsub("(^| )-std=[^ ]+", "", cxxflags))
535-
))
536-
}
501+
## toolchain report
502+
cfg <- \(x) system(paste(shQuote(file.path(R.home("bin"),"R")),"CMD config",x),intern=TRUE)
503+
strip <- \(x) trimws(gsub("(^| )-std=[^ ]+","",x))
537504

538-
# --- parallel backend (foreach) --------------------------------------------
539-
`%doit%` <- foreach::`%do%`
540-
if (cores > 1) {
541-
if (.Platform$OS.type == "windows") {
542-
cl <- parallel::makeCluster(cores)
543-
on.exit(parallel::stopCluster(cl), add = TRUE)
544-
doParallel::registerDoParallel(cl)
545-
} else {
546-
doParallel::registerDoParallel(cores = cores)
547-
on.exit(doParallel::stopImplicitCluster(), add = TRUE)
548-
}
549-
`%doit%` <- foreach::`%dopar%`
550-
}
505+
if(any(grepl("\\.c$",files)))
506+
cat(sprintf("using C compiler: %s [%s]\n",
507+
strip(cfg("CC")), trimws(Sys.getenv("PKG_CFLAGS"))))
508+
509+
if(any(grepl("\\.cpp$",files)))
510+
cat(sprintf("using C++ compiler: %s [%s]\n",
511+
strip(cfg("CXX")), trimws(Sys.getenv("PKG_CXXFLAGS"))))
551512

552-
# --- unload old libs --------------------------------------------------------
553-
invisible(lapply(c(roots, output), function(r)
554-
if (!is.null(r)) try(dyn.unload(paste0(r, so)), silent = TRUE)
555-
))
513+
invisible(lapply(c(roots,output),\(x)
514+
if(!is.null(x)) try(dyn.unload(paste0(x,so)),silent=TRUE)))
556515

557-
# --- compile ----------------------------------------------------------------
558-
foreach::foreach(i = seq_along(files)) %doit% {
559-
out <- system(paste(Rbin, "CMD COMPILE", shQuote(files[i])), intern = TRUE)
560-
if (verbose) cat(out, sep = "\n")
516+
run <- \(cmd){
517+
if(verbose) cat(cmd,"\n")
518+
if(system(cmd,ignore.stdout=!verbose,ignore.stderr=!verbose)!=0)
519+
stop("Compilation failed")
561520
}
562521

563-
# --- link -------------------------------------------------------------------
564-
if (is.null(output)) {
565-
566-
## set metadata for each object
567-
for (i in seq_along(objects)) {
568-
src <- files[grepl(paste0("^", modelname(objects[[i]])), files)]
569-
obj <- sub("\\.(c|cpp)$", ".o", src)
570-
attr(objects[[i]], "sourcefiles") <- src
571-
attr(objects[[i]], "objfiles") <- obj
572-
}
573-
574-
## load individual shared libraries
575-
for (r in roots)
576-
dyn.load(paste0(r, so))
577-
522+
if(is.null(output)){
523+
if(.Platform$OS.type=="unix" && cores>1)
524+
parallel::mclapply(files, \(f) run(paste(Rbin,"CMD SHLIB",shQuote(f))), mc.cores=cores)
525+
else
526+
for(f in files) run(paste(Rbin,"CMD SHLIB",shQuote(f)))
527+
for(r in roots) dyn.load(paste0(r,so))
578528
} else {
579-
580-
for (i in seq_along(objects)) {
581-
eval(parse(
582-
text = paste0("modelname(", obj.names[i], ") <<- '", output, "'")
583-
))
584-
src <- files[grepl(paste0("^", output), files)]
585-
obj <- sub("\\.(c|cpp)$", ".o", src)
586-
attr(objects[[i]], "sourcefiles") <- src
587-
attr(objects[[i]], "objfiles") <- obj
588-
}
589-
590-
out <- system(paste(
591-
Rbin, "CMD SHLIB",
592-
paste(shQuote(sub("\\.(c|cpp)$", ".o", files)), collapse = " "),
593-
"-o", paste0(output, so),
594-
opt
595-
), intern = TRUE)
596-
597-
if (verbose) cat(out, sep = "\n")
598-
599-
dyn.load(paste0(output, so))
529+
out <- paste0(dirname(files[1]),"/",output,so)
530+
run(paste(Rbin,"CMD SHLIB",paste(shQuote(files),collapse=" "),"-o",shQuote(out)))
531+
dyn.load(out)
532+
for(nm in obj.names)
533+
eval.parent(parse(text=paste0("modelname(",nm,") <- '",output,"'")))
600534
}
601535

602536
invisible(TRUE)
603537
}
604538

605539

606-
607-
#' Get objfiles attribute
608-
#'
609-
#' @description The objfiles attribute contains the paths to compiled object files
610-
#' associated with a dMod function object.
611-
#'
612-
#' @param ... objects of type `prdfn`, `parfn`, `objfn`
613-
#' @return character vector of object file paths
614-
#'
615-
#' @export
616-
getObjfiles <- function(...) {
617-
Reduce("union", lapply(list(...), function(x) attr(x, "objfiles")))
618-
}
619-
620-
621-
#' Get sourcefiles attribute
622-
#'
623-
#' @description
624-
#' The `sourcefiles` attribute contains the paths to C or C++ source files
625-
#' associated with a compiled dMod function object.
626-
#'
627-
#' @param ... Objects of type `prdfn`, `parfn`, or `obsfn`.
628-
#'
629-
#' @return
630-
#' A character vector of source file paths.
631-
#'
632-
#' @export
633-
getSourcefiles <- function(...) {
634-
Reduce("union", lapply(list(...), function(x) attr(x, "sourcefiles")))
635-
}
636-
637-
638-
639-
640540
#' Determine loaded DLLs available in working directory
641541
#'
642542
#' @return Character vector with the names of the loaded DLLs available in the working directory

‎man/getObjfiles.Rd‎

Lines changed: 0 additions & 18 deletions
This file was deleted.

‎man/getSourcefiles.Rd‎

Lines changed: 0 additions & 18 deletions
This file was deleted.

0 commit comments

Comments
 (0)