0
|
1 /** ===========================================================================
|
|
2 ** R-Package: rdyncall
|
|
3 ** File: src/rdynload.c
|
|
4 ** Description: R bindings to dynload
|
|
5 **/
|
|
6
|
|
7 #include <Rinternals.h>
|
|
8 #include "dynload.h"
|
|
9
|
|
10 /** ---------------------------------------------------------------------------
|
|
11 ** C-Function: r_dynload
|
|
12 ** Description: load shared library and return lib handle
|
|
13 ** R-Calling Convention: .Call
|
|
14 **
|
|
15 **/
|
|
16
|
|
17 SEXP r_dynload(SEXP libpath_x)
|
|
18 {
|
|
19 const char* libpath_S;
|
|
20 void* libHandle;
|
|
21
|
|
22 libpath_S = CHAR(STRING_ELT(libpath_x,0));
|
|
23 libHandle = dlLoadLibrary(libpath_S);
|
|
24
|
|
25 if (!libHandle)
|
|
26 return R_NilValue;
|
|
27
|
|
28 return R_MakeExternalPtr(libHandle, R_NilValue, R_NilValue);
|
|
29 }
|
|
30
|
|
31 /** ---------------------------------------------------------------------------
|
|
32 ** C-Function: r_dynunload
|
|
33 ** Description: unload shared library
|
|
34 ** R-Calling Convention: .Call
|
|
35 **
|
|
36 **/
|
|
37
|
|
38 SEXP r_dynunload(SEXP libobj_x)
|
|
39 {
|
|
40 void* libHandle;
|
|
41
|
|
42 if (TYPEOF(libobj_x) != EXTPTRSXP) error("first argument is not of type external ptr.");
|
|
43
|
|
44 libHandle = R_ExternalPtrAddr(libobj_x);
|
|
45
|
|
46 if (!libHandle) error("not a lib handle");
|
|
47
|
|
48 dlFreeLibrary( libHandle );
|
|
49
|
|
50 return R_NilValue;
|
|
51 }
|
|
52
|
|
53 /** ---------------------------------------------------------------------------
|
|
54 ** C-Function: r_dynsym
|
|
55 ** Description: resolve symbol
|
|
56 ** R-Calling Convention: .Call
|
|
57 **
|
|
58 **/
|
|
59
|
|
60 SEXP r_dynsym(SEXP libh, SEXP symname_x, SEXP protectlib)
|
|
61 {
|
|
62 void* libHandle;
|
|
63 const char* symbol;
|
|
64 void* addr;
|
|
65 SEXP protect;
|
|
66 libHandle = R_ExternalPtrAddr(libh);
|
|
67 symbol = CHAR(STRING_ELT(symname_x,0) );
|
|
68 addr = dlFindSymbol( libHandle, symbol );
|
|
69 protect = (LOGICAL(protectlib)[0]) ? libh : R_NilValue;
|
|
70 return (addr) ? R_MakeExternalPtr(addr, R_NilValue, protect) : R_NilValue;
|
|
71 }
|