From 0899d273f4995087bf99907143373644cd8ee566 Mon Sep 17 00:00:00 2001
From: stepan <stepan.sindelar@oracle.com>
Date: Mon, 22 May 2017 14:26:18 +0200
Subject: [PATCH] Implement exporting pkg native functions to other packages
 native code.

---
 .../fficall/src/jni/Rdynload_fastr.c          |  8 +++-
 com.oracle.truffle.r.native/version.source    |  2 +-
 .../r/runtime/ffi/jni/JNI_PkgInit.java        | 28 +++++++++++---
 .../com/oracle/truffle/r/runtime/RError.java  |  1 -
 .../com/oracle/truffle/r/runtime/ffi/DLL.java | 38 ++++++++++++++++++-
 5 files changed, 66 insertions(+), 11 deletions(-)

diff --git a/com.oracle.truffle.r.native/fficall/src/jni/Rdynload_fastr.c b/com.oracle.truffle.r.native/fficall/src/jni/Rdynload_fastr.c
index ebf731f63f..88a5b6e9b3 100644
--- a/com.oracle.truffle.r.native/fficall/src/jni/Rdynload_fastr.c
+++ b/com.oracle.truffle.r.native/fficall/src/jni/Rdynload_fastr.c
@@ -22,6 +22,7 @@ static jclass RegisteredNativeSymbolClass;
 
 static jmethodID registerRoutinesID;
 static jmethodID registerCCallableID;
+static jmethodID getCCallableID;
 static jmethodID useDynamicSymbolsID;
 static jmethodID forceSymbolsID;
 static jmethodID setDotSymbolValuesID;
@@ -36,6 +37,7 @@ void init_dynload(JNIEnv *env) {
 
     registerRoutinesID = checkGetMethodID(env, JNI_PkgInitClass, "registerRoutines", "(Lcom/oracle/truffle/r/runtime/ffi/DLL$DLLInfo;IIJ)V", 1);
     registerCCallableID = checkGetMethodID(env, JNI_PkgInitClass, "registerCCallable", "(Ljava/lang/String;Ljava/lang/String;J)V", 1);
+    getCCallableID = checkGetMethodID(env, JNI_PkgInitClass, "getCCallable", "(Ljava/lang/String;Ljava/lang/String;)J", 1);
     useDynamicSymbolsID = checkGetMethodID(env, JNI_PkgInitClass, "useDynamicSymbols", "(Lcom/oracle/truffle/r/runtime/ffi/DLL$DLLInfo;I)I", 1);
     forceSymbolsID = checkGetMethodID(env, JNI_PkgInitClass, "forceSymbols", "(Lcom/oracle/truffle/r/runtime/ffi/DLL$DLLInfo;I)I", 1);
     setDotSymbolValuesID = checkGetMethodID(env, JNI_PkgInitClass, "setDotSymbolValues", "(Ljava/lang/String;JI)Lcom/oracle/truffle/r/runtime/ffi/DLL$DotSymbol;", 1);
@@ -139,8 +141,10 @@ Rboolean R_forceSymbols(DllInfo *dllInfo, Rboolean value) {
 }
 
 DL_FUNC R_GetCCallable(const char *package, const char *name) {
-	unimplemented("R_GetCCallable");
-	return NULL;
+    JNIEnv *thisenv = getEnv();
+    jstring packageString = (*thisenv)->NewStringUTF(thisenv, package);
+    jstring nameString = (*thisenv)->NewStringUTF(thisenv, name);
+    return (DL_FUNC) (*thisenv)->CallStaticObjectMethod(thisenv, JNI_PkgInitClass, getCCallableID, packageString, nameString);
 }
 
 DL_FUNC R_FindSymbol(char const *name, char const *pkg,
diff --git a/com.oracle.truffle.r.native/version.source b/com.oracle.truffle.r.native/version.source
index 2bd5a0a98a..409940768f 100644
--- a/com.oracle.truffle.r.native/version.source
+++ b/com.oracle.truffle.r.native/version.source
@@ -1 +1 @@
-22
+23
diff --git a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jni/JNI_PkgInit.java b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jni/JNI_PkgInit.java
index d5c2450edf..0cf12986f0 100644
--- a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jni/JNI_PkgInit.java
+++ b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jni/JNI_PkgInit.java
@@ -1,5 +1,5 @@
 /*
- * Copyright (c) 2015, 2016, Oracle and/or its affiliates. All rights reserved.
+ * Copyright (c) 2015, 2017, Oracle and/or its affiliates. All rights reserved.
  * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
  *
  * This code is free software; you can redistribute it and/or modify it
@@ -22,8 +22,11 @@
  */
 package com.oracle.truffle.r.runtime.ffi.jni;
 
+import com.oracle.truffle.r.runtime.RError;
+import com.oracle.truffle.r.runtime.RError.Message;
 import com.oracle.truffle.r.runtime.RInternalError;
 import com.oracle.truffle.r.runtime.ffi.DLL;
+import com.oracle.truffle.r.runtime.ffi.DLL.CEntry;
 import com.oracle.truffle.r.runtime.ffi.DLL.DLLInfo;
 import com.oracle.truffle.r.runtime.ffi.DLL.DotSymbol;
 import com.oracle.truffle.r.runtime.ffi.DLL.SymbolHandle;
@@ -43,13 +46,18 @@ final class JNI_PkgInit {
 
     @SuppressWarnings("unused")
     private static void registerCCallable(String pkgName, String functionName, long address) {
-        // TBD
+        DLLInfo lib = safeFindLibrary(pkgName);
+        lib.registerCEntry(new CEntry(functionName, new SymbolHandle(address)));
     }
 
     @SuppressWarnings("unused")
-    private static long getCCallable(String pkgName, String functionName) {
-        // TBD
-        throw RInternalError.unimplemented();
+    public static long getCCallable(String pkgName, String functionName) {
+        DLLInfo lib = safeFindLibrary(pkgName);
+        CEntry result = lib.lookupCEntry(functionName);
+        if (result == null) {
+            throw RError.error(RError.NO_CALLER, Message.UNKNOWN_OBJECT, functionName);
+        }
+        return result.address.asAddress();
     }
 
     /**
@@ -77,4 +85,14 @@ final class JNI_PkgInit {
     public static int findSymbol(String name, String pkg, DLL.RegisteredNativeSymbol rns) {
         throw RInternalError.unimplemented();
     }
+
+    private static DLLInfo safeFindLibrary(String pkgName) {
+        DLLInfo lib = DLL.findLibrary(pkgName);
+        if (lib == null) {
+            // It seems GNU R would create an C entry even for non-existing package, we are more
+            // defensive
+            throw RError.error(RError.NO_CALLER, Message.DLL_NOT_LOADED, pkgName);
+        }
+        return lib;
+    }
 }
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RError.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RError.java
index fbb3953558..c5936f84fe 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RError.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RError.java
@@ -590,7 +590,6 @@ public final class RError extends RuntimeException {
         NROW_ZERO("nr(0 for non-null data"),
         CANNOT_EXCEED_X("'%s' cannot exceed %s(x) = %d"),
         SAMPLE_LARGER_THAN_POPULATION("cannot take a sample larger than the population when 'replace(FALSE'\n"),
-        SAMPLE_OBJECT_NOT_FOUND("object '%s' not found"),
         ERROR_IN_SAMPLE("Error in sample.int(x, size, replace, prob) :  "),
         INCORRECT_NUM_PROB("incorrect number of probabilities"),
         NA_IN_PROB_VECTOR("NA in probability vector"),
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/DLL.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/DLL.java
index 2bb5d9a64a..b6969e1e37 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/DLL.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/DLL.java
@@ -17,8 +17,8 @@ import java.util.concurrent.atomic.AtomicInteger;
 
 import com.oracle.truffle.api.CompilerAsserts;
 import com.oracle.truffle.api.CompilerDirectives;
-import com.oracle.truffle.api.Truffle;
 import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary;
+import com.oracle.truffle.api.Truffle;
 import com.oracle.truffle.api.frame.FrameDescriptor;
 import com.oracle.truffle.api.frame.VirtualFrame;
 import com.oracle.truffle.api.interop.TruffleObject;
@@ -180,6 +180,7 @@ public class DLL {
         private boolean dynamicLookup;
         private boolean forceSymbols;
         private final DotSymbol[][] nativeSymbols = new DotSymbol[NativeSymbolType.values().length][];
+        private ArrayList<CEntry> cEntryTable = null;
 
         private DLLInfo(String name, String path, boolean dynamicLookup, Object handle) {
             this.id = ID.getAndIncrement();
@@ -229,6 +230,24 @@ public class DLL {
             }
         }
 
+        public void registerCEntry(CEntry entry) {
+            if (cEntryTable == null) {
+                cEntryTable = new ArrayList<>();
+            }
+            cEntryTable.add(entry);
+        }
+
+        public CEntry lookupCEntry(String symbol) {
+            if (cEntryTable != null) {
+                for (CEntry entry : cEntryTable) {
+                    if (entry.symbol.equals(symbol)) {
+                        return entry;
+                    }
+                }
+            }
+            return null;
+        }
+
         /**
          * Return array of values that can be plugged directly into an {@code RList}.
          */
@@ -256,7 +275,7 @@ public class DLL {
         }
     }
 
-    public static class SymbolInfo {
+    public static final class SymbolInfo {
         public final DLLInfo libInfo;
         public final String symbol;
         public final SymbolHandle address;
@@ -305,6 +324,21 @@ public class DLL {
         }
     }
 
+    /**
+     * R has an interface for exporting and importing functions between packages' native code. The
+     * functions have to be exported, i.e. registered in a directory, called CEntry table in GNU R.
+     * Another package can they as the directory for address or a function with specified name.
+     */
+    public static final class CEntry {
+        public final String symbol;
+        public final SymbolHandle address;
+
+        public CEntry(String symbol, SymbolHandle address) {
+            this.symbol = symbol;
+            this.address = address;
+        }
+    }
+
     /**
      * Abstracts the way that DLL function symbols are represented, either as a machine address (
      * {@link Long}) or a {@link TruffleObject}. At the present time, both forms can exists within a
-- 
GitLab