diff R/rdyncall/src/rdynload.c @ 0:0cfcc391201f

initial from svn dyncall-1745
author Daniel Adler
date Thu, 19 Mar 2015 22:26:28 +0100
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/R/rdyncall/src/rdynload.c	Thu Mar 19 22:26:28 2015 +0100
@@ -0,0 +1,71 @@
+/** ===========================================================================
+ ** R-Package: rdyncall
+ ** File: src/rdynload.c
+ ** Description: R bindings to dynload
+ **/
+
+#include <Rinternals.h>
+#include "dynload.h"
+
+/** ---------------------------------------------------------------------------
+ ** C-Function: r_dynload
+ ** Description: load shared library and return lib handle
+ ** R-Calling Convention: .Call
+ **
+ **/
+
+SEXP r_dynload(SEXP libpath_x)
+{
+  const char* libpath_S;
+  void* libHandle;
+
+  libpath_S = CHAR(STRING_ELT(libpath_x,0));
+  libHandle = dlLoadLibrary(libpath_S);
+
+  if (!libHandle)
+    return R_NilValue;
+
+  return R_MakeExternalPtr(libHandle, R_NilValue, R_NilValue);
+}
+
+/** ---------------------------------------------------------------------------
+ ** C-Function: r_dynunload
+ ** Description: unload shared library
+ ** R-Calling Convention: .Call
+ **
+ **/
+
+SEXP r_dynunload(SEXP libobj_x)
+{
+  void* libHandle;
+
+  if (TYPEOF(libobj_x) != EXTPTRSXP) error("first argument is not of type external ptr.");
+
+  libHandle = R_ExternalPtrAddr(libobj_x);
+
+  if (!libHandle) error("not a lib handle");
+
+  dlFreeLibrary( libHandle );
+
+  return R_NilValue;
+}
+
+/** ---------------------------------------------------------------------------
+ ** C-Function: r_dynsym
+ ** Description: resolve symbol
+ ** R-Calling Convention: .Call
+ **
+ **/
+
+SEXP r_dynsym(SEXP libh, SEXP symname_x, SEXP protectlib)
+{
+  void* libHandle;
+  const char* symbol;
+  void* addr;
+  SEXP protect;
+  libHandle = R_ExternalPtrAddr(libh);
+  symbol = CHAR(STRING_ELT(symname_x,0) );
+  addr = dlFindSymbol( libHandle, symbol );
+  protect = (LOGICAL(protectlib)[0]) ? libh : R_NilValue;
+  return (addr) ? R_MakeExternalPtr(addr, R_NilValue, protect) : R_NilValue;
+}