make-r-def.R

# [description]
#     Create a definition file (.def) from a .dll file, using objdump.
#
# [usage]
#
#     Rscript make-r-def.R something.dll something.def
#
# [references]
#    * https://www.cs.colorado.edu/~main/cs1300/doc/mingwfaq.html

args <- commandArgs(trailingOnly = TRUE)

IN_DLL_FILE <- args[[1L]]
OUT_DEF_FILE <- args[[2L]]
DLL_BASE_NAME <- basename(IN_DLL_FILE)

message(sprintf("Creating '%s' from '%s'", OUT_DEF_FILE, IN_DLL_FILE))

# system() will not raise an R exception if the process called
# fails. Wrapping it here to get that behavior.
#
# system() introduces a lot of overhead, at least on Windows,
# so trying processx if it is available
.pipe_shell_command_to_stdout <- function(command, args, out_file) {
    has_processx <- suppressMessages({
      suppressWarnings({
        require("processx")  # nolint: undesirable_function
      })
    })
    if (has_processx) {
        p <- processx::process$new(
            command = command
            , args = args
            , stdout = out_file
            , windows_verbatim_args = FALSE
        )
        invisible(p$wait())
    } else {
        message(paste0(
          "Using system2() to run shell commands. Installing "
          , "'processx' with install.packages('processx') might "
          , "make this faster."
        ))
        # shQuote() is necessary here since one of the arguments
        # is a file-path to R.dll, which may have spaces. processx
        # does such quoting but system2() does not
        exit_code <- system2(
            command = command
            , args = shoQuote(args)
            , stdout = out_file
        )
        if (exit_code != 0L) {
            stop(paste0("Command failed with exit code: ", exit_code))
        }
    }
    return(invisible(NULL))
}

# use objdump to dump all the symbols
OBJDUMP_FILE <- "objdump-out.txt"
.pipe_shell_command_to_stdout(
    command = "objdump"
    , args = c("-p", IN_DLL_FILE)
    , out_file = OBJDUMP_FILE
)

objdump_results <- readLines(OBJDUMP_FILE)
invisible(file.remove(OBJDUMP_FILE))

# Only one table in the objdump results matters for our purposes,
# see https://www.cs.colorado.edu/~main/cs1300/doc/mingwfaq.html
start_index <- which(
    grepl(
        pattern = "[Ordinal/Name Pointer] Table"  # nolint: non_portable_path
        , x = objdump_results
        , fixed = TRUE
    )
)
empty_lines <- which(objdump_results == "")
end_of_table <- empty_lines[empty_lines > start_index][1L]

# Read the contents of the table
exported_symbols <- objdump_results[(start_index + 1L):end_of_table]
exported_symbols <- gsub("\t", "", exported_symbols)
exported_symbols <- gsub(".*\\] ", "", exported_symbols)
exported_symbols <- gsub(" ", "", exported_symbols)

# Write R.def file
writeLines(
    text = c(
        paste0("LIBRARY \"", DLL_BASE_NAME, "\"")
        , "EXPORTS"
        , exported_symbols
    )
    , con = OUT_DEF_FILE
    , sep = "\n"
)
message(sprintf("Successfully created '%s'", OUT_DEF_FILE))