|
0
|
1 # Package: rdyncall
|
|
|
2 # File: R/dynbind.R
|
|
|
3 # Description: single-entry front-end to dynamic binding of library functions
|
|
|
4
|
|
|
5 dynbind <- function(libnames, signature, envir=parent.frame(), callmode="default", pat=NULL, replace=NULL, funcptr=FALSE)
|
|
|
6 {
|
|
|
7 # load shared library
|
|
|
8 libh <- dynfind(libnames)
|
|
|
9 if ( is.null(libh) )
|
|
|
10 {
|
|
|
11 cat("dynbind error: Unable to find shared library '", libnames[[1]], "'.\n",sep="")
|
|
|
12 cat("For details how to install dynport shared libs, type: ?'rdyncall-demos' might help.\n")
|
|
|
13 cat("If there is no information about your OS, consult the projects page how to build and install the shared library for your operating-system.\n")
|
|
|
14 cat("Make sure the shared library can be found at the default system places or adjust environment variables (e.g. %PATH% or $LD_LIBRARY_PATH).\n")
|
|
|
15 stop("unable to find shared library '", libnames[[1]], "'.\n", call.=FALSE)
|
|
|
16 }
|
|
|
17
|
|
|
18 # -- convert library signature to signature table
|
|
|
19
|
|
|
20 # eat white spaces
|
|
|
21 sigtab <- gsub("[ \n\t]*","",signature)
|
|
|
22 # split functions at ';'
|
|
|
23 sigtab <- strsplit(sigtab, ";")[[1]]
|
|
|
24 # split name/call signature at '('
|
|
|
25 sigtab <- strsplit(sigtab, "\\(")
|
|
|
26
|
|
|
27 # -- install functions
|
|
|
28
|
|
|
29 # make function call symbol
|
|
|
30 dyncallfunc <- as.symbol( paste(".dyncall.",callmode, sep="") )
|
|
|
31 # report info
|
|
|
32 syms.failed <- character(0)
|
|
|
33
|
|
|
34 for (i in seq(along=sigtab))
|
|
|
35 {
|
|
|
36 symname <- sigtab[[i]][[1]]
|
|
|
37 rname <- if (!is.null(pat)) sub(pat, replace, symname) else symname
|
|
|
38 signature <- sigtab[[i]][[2]]
|
|
|
39 # lookup symbol
|
|
|
40 address <- .dynsym( libh, symname )
|
|
|
41
|
|
|
42 if (!is.null(address))
|
|
|
43 {
|
|
|
44 # make call function f
|
|
|
45 f <- function(...) NULL
|
|
|
46 if (funcptr)
|
|
|
47 {
|
|
|
48 body(f) <- substitute( dyncallfunc( .unpack(address,0,"p"), signature,...), list(dyncallfunc=dyncallfunc,address=address,signature=signature) )
|
|
|
49 }
|
|
|
50 else
|
|
|
51 {
|
|
|
52 body(f) <- substitute( dyncallfunc(address, signature,...), list(dyncallfunc=dyncallfunc,address=address,signature=signature) )
|
|
|
53 }
|
|
|
54 environment(f) <- envir # NEW
|
|
|
55 # install symbol
|
|
|
56 assign( rname, f, envir=envir)
|
|
|
57 }
|
|
|
58 else
|
|
|
59 {
|
|
|
60 syms.failed <- c(syms.failed,symname)
|
|
|
61 }
|
|
|
62 }
|
|
|
63 # return dynbind.report
|
|
|
64 x <- list(libhandle=libh, unresolved.symbols=syms.failed)
|
|
|
65 class(x) <- "dynbind.report"
|
|
|
66 return(x)
|
|
|
67 }
|
