Mercurial > pub > dyncall > bindings

comparison R/rdyncall/R/dynbind.R @ 0:0cfcc391201f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
initial from svn dyncall-1745
author Daniel Adler
date Thu, 19 Mar 2015 22:26:28 +0100
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:0cfcc391201f
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 }