From 23d84bea096470539466f2f8ce249b6687bc214d Mon Sep 17 00:00:00 2001
From: stepan <stepan.sindelar@oracle.com>
Date: Fri, 9 Jun 2017 13:52:15 +0200
Subject: [PATCH] Support strings in FortranAndCFunction and JNI FFI
 implementation.

---
 .../oracle/truffle/r/ffi/impl/jni/JNI_C.java  | 11 +++-
 .../fficall/src/jni/c_rffi.c                  | 64 ++++++++++++++-----
 com.oracle.truffle.r.native/version.source    |  2 +-
 .../base/foreign/FortranAndCFunctions.java    | 55 +++++++++++++++-
 .../truffle/r/runtime/data/RStringVector.java | 13 ++++
 .../oracle/truffle/r/runtime/ffi/CRFFI.java   |  2 +-
 .../testrffi/testrffi/tests/simpleTests.R     |  5 +-
 7 files changed, 130 insertions(+), 22 deletions(-)

diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/jni/JNI_C.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/jni/JNI_C.java
index 2739f2ab28..824e34a248 100644
--- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/jni/JNI_C.java
+++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/jni/JNI_C.java
@@ -44,12 +44,19 @@ public class JNI_C implements CRFFI {
                 if (traceEnabled()) {
                     traceDownCall(nativeCallInfo.name, args);
                 }
-                c(nativeCallInfo.address.asAddress(), args);
+                boolean hasStrings = false;
+                for (int i = 0; i < args.length; i++) {
+                    if (args[i] instanceof byte[][]) {
+                        hasStrings = true;
+                        break;
+                    }
+                }
+                c(nativeCallInfo.address.asAddress(), args, hasStrings);
             }
         }
     }
 
-    private static native void c(long address, Object[] args);
+    private static native void c(long address, Object[] args, boolean hasStrings);
 
     @Override
     public InvokeCNode createInvokeCNode() {
diff --git a/com.oracle.truffle.r.native/fficall/src/jni/c_rffi.c b/com.oracle.truffle.r.native/fficall/src/jni/c_rffi.c
index d41a946620..c4f9325efe 100644
--- a/com.oracle.truffle.r.native/fficall/src/jni/c_rffi.c
+++ b/com.oracle.truffle.r.native/fficall/src/jni/c_rffi.c
@@ -22,6 +22,7 @@
  */
 
 #include <rffiutils.h>
+#include <stdbool.h>
 
 static jclass intArrayClass;
 static jclass doubleArrayClass;
@@ -330,17 +331,8 @@ typedef void (*c65func)(void *arg1, void *arg2, void *arg3, void *arg4, void *ar
         void *arg57, void *arg58, void *arg59, void *arg60, void *arg61, void *arg62, void *arg63, void *arg64,
         void *arg65);
 
-
-JNIEXPORT void JNICALL
-Java_com_oracle_truffle_r_ffi_impl_jni_JNI_1C_c(JNIEnv *env, jclass c, jlong address, jobjectArray args) {
-	int len = (*env)->GetArrayLength(env, args);
-	void *cargs[len];
-	jobject jarrays[len];
-	for (int i = 0; i < len; i++) {
-		jarrays[i] = (*env)->GetObjectArrayElement(env, args, i);
-		cargs[i] = (*env)->GetPrimitiveArrayCritical(env, jarrays[i], NULL);
-	}
-	switch (len) {
+static void doCall(jlong address, int len, void** cargs) {
+  switch (len) {
     case 0: {
         c0func c0 = (c0func) address;
         (*c0)();
@@ -969,9 +961,51 @@ Java_com_oracle_truffle_r_ffi_impl_jni_JNI_1C_c(JNIEnv *env, jclass c, jlong add
         break;
     }
 	}
-
-	for (int i = 0; i < len; i++) {
-		(*env)->ReleasePrimitiveArrayCritical(env, jarrays[i], cargs[i], 0);
-	}
 }
 
+// Note: hasStrings indicates that the args array may contain 2 dimensional byte arrays, which represent string vectors.
+JNIEXPORT void JNICALL
+Java_com_oracle_truffle_r_ffi_impl_jni_JNI_1C_c(JNIEnv *env, jclass c, jlong address, jobjectArray args, jboolean hasStrings) {
+  int len = (*env)->GetArrayLength(env, args);
+  void *cargs[len];     // pointers to primitive arrays suitable for the actual c call
+  jobject jarrays[len]; // jarray instances corresponding to cargs native counterparts
+  jobject *dim2[len];   // if corresponding jarray[i] is 2-dimensional, this holds the array of jarrays, otherwise NULL
+  jclass byteArrayClass = NULL;
+  if (hasStrings) {
+      byteArrayClass = (*env)->FindClass(env, "[[B");
+  }
+
+  for (int i = 0; i < len; i++) {
+    jarrays[i] = (*env)->GetObjectArrayElement(env, args, i);
+    bool isString = hasStrings && (*env)->IsInstanceOf(env, jarrays[i], byteArrayClass);
+    if (isString) {
+      int len2 = (*env)->GetArrayLength(env, jarrays[i]);
+      dim2[i] = calloc(sizeof(jobject), len2);
+      const char **strArgs = calloc(sizeof(const char*), len2);
+      cargs[i] = strArgs;
+      for (int j = 0; j < len2; j++) {
+        dim2[i][j] = (*env)->GetObjectArrayElement(env, jarrays[i], j);
+        strArgs[j] = (*env)->GetPrimitiveArrayCritical(env, dim2[i][j], NULL);
+      }
+    } else {
+      dim2[i] = NULL;
+      cargs[i] = (*env)->GetPrimitiveArrayCritical(env, jarrays[i], NULL);
+    }
+  }
+
+  doCall(address, len, cargs);
+
+  for (int i = 0; i < len; i++) {
+    if (dim2[i] != NULL) {
+      int len2 = (*env)->GetArrayLength(env, jarrays[i]);
+      const char **strArgs = (const char**) cargs[i];
+      for (int j = 0; j < len2; j++) {
+        (*env)->ReleasePrimitiveArrayCritical(env, dim2[i][j], (void*) strArgs[j], 0);
+      }
+      free(dim2[i]);
+      free(cargs[i]);
+    } else {
+      (*env)->ReleasePrimitiveArrayCritical(env, jarrays[i], cargs[i], 0);
+    }
+  }
+}
diff --git a/com.oracle.truffle.r.native/version.source b/com.oracle.truffle.r.native/version.source
index 7273c0fa8c..6f4247a625 100644
--- a/com.oracle.truffle.r.native/version.source
+++ b/com.oracle.truffle.r.native/version.source
@@ -1 +1 @@
-25
+26
diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/foreign/FortranAndCFunctions.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/foreign/FortranAndCFunctions.java
index afdff5f5bc..b1c2b49fce 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/foreign/FortranAndCFunctions.java
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/foreign/FortranAndCFunctions.java
@@ -14,6 +14,8 @@ package com.oracle.truffle.r.nodes.builtin.base.foreign;
 import static com.oracle.truffle.r.runtime.builtins.RBehavior.COMPLEX;
 import static com.oracle.truffle.r.runtime.builtins.RBuiltinKind.PRIMITIVE;
 
+import java.nio.charset.Charset;
+
 import com.oracle.truffle.api.CompilerAsserts;
 import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary;
 import com.oracle.truffle.api.dsl.Cached;
@@ -32,6 +34,7 @@ import com.oracle.truffle.r.runtime.data.RArgsValuesAndNames;
 import com.oracle.truffle.r.runtime.data.RDataFactory;
 import com.oracle.truffle.r.runtime.data.RList;
 import com.oracle.truffle.r.runtime.data.RMissing;
+import com.oracle.truffle.r.runtime.data.RString;
 import com.oracle.truffle.r.runtime.data.RStringVector;
 import com.oracle.truffle.r.runtime.data.model.RAbstractDoubleVector;
 import com.oracle.truffle.r.runtime.data.model.RAbstractIntVector;
@@ -56,11 +59,13 @@ public class FortranAndCFunctions {
         private static final int SCALAR_DOUBLE = 0;
         private static final int SCALAR_INT = 1;
         private static final int SCALAR_LOGICAL = 2;
-        @SuppressWarnings("unused") private static final int SCALAR_STRING = 3;
+        private static final int SCALAR_STRING = 3;
         private static final int VECTOR_DOUBLE = 10;
         private static final int VECTOR_INT = 11;
         private static final int VECTOR_LOGICAL = 12;
-        @SuppressWarnings("unused") private static final int VECTOR_STRING = 12;
+        private static final int VECTOR_STRING = 13;
+
+        private static final Charset charset = Charset.forName("US-ASCII");
 
         @Child protected ExtractNativeCallInfoNode extractSymbolInfo = ExtractNativeCallInfoNodeGen.create();
         @Child private CRFFI.InvokeCNode invokeCNode = RFFIFactory.getRFFI().getCRFFI().createInvokeCNode();
@@ -98,6 +103,14 @@ public class FortranAndCFunctions {
                         dataAsInt[j] = RRuntime.isNA(data[j]) ? RRuntime.INT_NA : data[j];
                     }
                     nativeArgs[i] = checkNAs(node, i + 1, dataAsInt);
+                } else if (arg instanceof RAbstractStringVector) {
+                    argTypes[i] = VECTOR_STRING;
+                    checkNAs(node, i + 1, (RAbstractStringVector) arg);
+                    nativeArgs[i] = encodeStrings((RAbstractStringVector) arg);
+                } else if (arg instanceof String) {
+                    argTypes[i] = SCALAR_STRING;
+                    checkNAs(node, i + 1, RString.valueOf((String) arg));
+                    nativeArgs[i] = new byte[][]{encodeString((String) arg)};
                 } else if (arg instanceof Double) {
                     argTypes[i] = SCALAR_DOUBLE;
                     nativeArgs[i] = checkNAs(node, i + 1, new double[]{(double) arg});
@@ -133,6 +146,12 @@ public class FortranAndCFunctions {
                         }
                         results[i] = RDataFactory.createLogicalVector(nativeByteArgs, RDataFactory.COMPLETE_VECTOR);
                         break;
+                    case SCALAR_STRING:
+                        results[i] = RDataFactory.createStringVector(decodeStrings((byte[][]) nativeArgs[i]), RDataFactory.COMPLETE_VECTOR);
+                        break;
+                    case VECTOR_STRING:
+                        results[i] = ((RAbstractStringVector) array[i]).materialize().copyResetData(decodeStrings((byte[][]) nativeArgs[i]));
+                        break;
                     case VECTOR_DOUBLE:
                         results[i] = ((RAbstractDoubleVector) array[i]).materialize().copyResetData((double[]) nativeArgs[i]);
                         break;
@@ -163,6 +182,15 @@ public class FortranAndCFunctions {
             return data;
         }
 
+        private static void checkNAs(RBuiltinNode node, int argIndex, RAbstractStringVector data) {
+            CompilerAsserts.neverPartOfCompilation();
+            for (int i = 0; i < data.getLength(); i++) {
+                if (RRuntime.isNA(data.getDataAt(i))) {
+                    throw node.error(RError.Message.NA_IN_FOREIGN_FUNCTION_CALL, argIndex);
+                }
+            }
+        }
+
         private static double[] checkNAs(RBuiltinNode node, int argIndex, double[] data) {
             CompilerAsserts.neverPartOfCompilation();
             for (int i = 0; i < data.length; i++) {
@@ -184,6 +212,29 @@ public class FortranAndCFunctions {
             }
             return RDataFactory.createStringVector(listArgNames, RDataFactory.COMPLETE_VECTOR);
         }
+
+        private static Object encodeStrings(RAbstractStringVector vector) {
+            byte[][] result = new byte[vector.getLength()][];
+            for (int i = 0; i < vector.getLength(); i++) {
+                result[i] = encodeString(vector.getDataAt(i));
+            }
+            return result;
+        }
+
+        private static byte[] encodeString(String str) {
+            byte[] bytes = str.getBytes(charset);
+            byte[] result = new byte[bytes.length + 1];
+            System.arraycopy(bytes, 0, result, 0, bytes.length);
+            return result;
+        }
+
+        private static String[] decodeStrings(byte[][] bytes) {
+            String[] result = new String[bytes.length];
+            for (int i = 0; i < bytes.length; i++) {
+                result[i] = new String(bytes[i], charset);
+            }
+            return result;
+        }
     }
 
     /**
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringVector.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringVector.java
index 32e0a2c866..712b3deb8d 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringVector.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringVector.java
@@ -94,6 +94,19 @@ public final class RStringVector extends RVector<String[]> implements RAbstractS
         return copy;
     }
 
+    public RStringVector copyResetData(String[] newData) {
+        boolean isComplete = true;
+        for (int i = 0; i < newData.length; i++) {
+            if (RRuntime.isNA(newData[i])) {
+                isComplete = false;
+                break;
+            }
+        }
+        RStringVector result = new RStringVector(newData, isComplete, null);
+        setAttributes(result);
+        return result;
+    }
+
     /**
      * Intended for external calls where a copy is not needed. WARNING: think carefully before using
      * this method rather than {@link #getDataCopy()}.
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/CRFFI.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/CRFFI.java
index 8d0949631e..f5b547d987 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/CRFFI.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/CRFFI.java
@@ -32,7 +32,7 @@ public interface CRFFI {
         /**
          * Invoke the native method identified by {@code symbolInfo} passing it the arguments in
          * {@code args}. The values in {@code args} should be native types,e.g., {@code double[]}
-         * not {@code RDoubleVector}.
+         * not {@code RDoubleVector}. Strings are already converted to 2-dimensional byte arrays.
          */
         public abstract void execute(NativeCallInfo nativeCallInfo, Object[] args);
     }
diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/simpleTests.R b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/simpleTests.R
index 92cf03a236..3ddc39c96e 100644
--- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/simpleTests.R
+++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/simpleTests.R
@@ -21,4 +21,7 @@ rffi.isRString("hello")
 rffi.isRString(NULL)
 rffi.interactive()
 x <- 1; rffi.findvar("x", globalenv())
-x <- "12345"; rffi.char_length(x)
\ No newline at end of file
+x <- "12345"; rffi.char_length(x)
+
+# loess invokes loess_raw native function passing in string value as argument and that is what we test here.
+loess(dist ~ speed, cars);
-- 
GitLab