diff --git a/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c b/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c
index ca7edff095299b703d0ef15956476e5cbcf0a44d..2ab399a437127e09285780f687d2c59ea3fe03ec 100644
--- a/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c
+++ b/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c
@@ -148,7 +148,7 @@ void init_internals(JNIEnv *env) {
SET_VECTOR_ELT_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "SET_VECTOR_ELT", "(Ljava/lang/Object;ILjava/lang/Object;)V", 1);
RAW_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "RAW", "(Ljava/lang/Object;)[B", 1);
REAL_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "REAL", "(Ljava/lang/Object;)[D", 1);
- LOGICAL_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "LOGICAL", "(Ljava/lang/Object;)[I", 1);
+ LOGICAL_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "LOGICAL", "(Ljava/lang/Object;)[B", 1);
INTEGER_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "INTEGER", "(Ljava/lang/Object;)[I", 1);
STRING_ELT_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "STRING_ELT", "(Ljava/lang/Object;I)Ljava/lang/Object;", 1);
VECTOR_ELT_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "VECTOR_ELT", "(Ljava/lang/Object;I)Ljava/lang/Object;", 1);
@@ -1024,10 +1024,16 @@ int *LOGICAL(SEXP x){
JNIEnv *thisenv = getEnv();
jint *data = (jint *) findCopiedObject(thisenv, x);
if (data == NULL) {
- jintArray intArray = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, LOGICAL_MethodID, x);
- int len = (*thisenv)->GetArrayLength(thisenv, intArray);
- data = (*thisenv)->GetIntArrayElements(thisenv, intArray, NULL);
- addCopiedObject(thisenv, x, LGLSXP, intArray, data);
+ jbyteArray byteArray = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, LOGICAL_MethodID, x);
+ int len = (*thisenv)->GetArrayLength(thisenv, byteArray);
+ jbyte* internalData = (*thisenv)->GetByteArrayElements(thisenv, byteArray, NULL);
+ data = malloc(len * sizeof(int));
+ for (int i = 0; i < len; i++) {
+ char value = internalData[i];
+ data[i] = value == 0 ? FALSE : value == 1 ? TRUE : NA_INTEGER;
+ }
+ (*thisenv)->ReleaseByteArrayElements(thisenv, byteArray, internalData, JNI_ABORT);
+ addCopiedObject(thisenv, x, LGLSXP, byteArray, data);
}
return data;
}
diff --git a/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.c b/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.c
index e26fc56a969deb22b707ace5f6c5acda2b2aeb29..f009ca873b9f5227f8689deadb794c71fcaae750 100644
--- a/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.c
+++ b/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.c
@@ -97,11 +97,24 @@ jmp_buf *getErrorJmpBuf() {
void releaseCopiedVector(JNIEnv *env, CopiedVector cv) {
if (cv.obj != NULL) {
switch (cv.type) {
- case INTSXP: case LGLSXP: {
- jintArray intArray = (jintArray) cv.jArray;
- (*env)->ReleaseIntArrayElements(env, intArray, (jint *)cv.data, 0);
- break;
- }
+ case INTSXP: {
+ jintArray intArray = (jintArray) cv.jArray;
+ (*env)->ReleaseIntArrayElements(env, intArray, (jint *)cv.data, 0);
+ break;
+ }
+
+ case LGLSXP: {
+ // for LOGICAL, we need to convert back to 1-byte elements
+ jintArray byteArray = (jbyteArray) cv.jArray;
+ int len = (*env)->GetArrayLength(env, byteArray);
+ jbyte* internalData = (*env)->GetByteArrayElements(env, byteArray, NULL);
+ int* data = (int*) cv.data;
+ for (int i = 0; i < len; i++) {
+ internalData[i] = data[i] == NA_INTEGER ? 255 : (jbyte) data[i];
+ }
+ (*env)->ReleaseByteArrayElements(env, byteArray, internalData, 0);
+ break;
+ }
case REALSXP: {
jdoubleArray doubleArray = (jdoubleArray) cv.jArray;
@@ -137,14 +150,14 @@ void invalidateCopiedObject(JNIEnv *env, SEXP oldObj) {
CopiedVector cv = copiedVectors[i];
if ((*env)->IsSameObject(env, cv.obj, oldObj)) {
#if TRACE_COPIES
- printf("invalidateCopiedObject(%p): found\n", x);
+ printf("invalidateCopiedObject(%p): found\n", oldObj);
#endif
releaseCopiedVector(env, cv);
copiedVectors[i].obj = NULL;
}
}
#if TRACE_COPIES
- printf("invalidateCopiedObject(%p): not found\n", x);
+ printf("invalidateCopiedObject(%p): not found\n", oldObj);
#endif
}
diff --git a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/CallRFFIHelper.java b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/CallRFFIHelper.java
index b7aec853d767aabed18efe3c1f21770f95626615..0f111ee0ce09b054d39da5f04230805375193a3b 100644
--- a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/CallRFFIHelper.java
+++ b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/CallRFFIHelper.java
@@ -460,21 +460,11 @@ public class CallRFFIHelper {
}
}
- private static int toWideLogical(byte v) {
- return RRuntime.isNA(v) ? Integer.MIN_VALUE : v;
- }
-
- public static int[] LOGICAL(Object x) {
+ public static byte[] LOGICAL(Object x) {
if (x instanceof RLogicalVector) {
- // TODO: this should not actually copy...
- RLogicalVector vector = (RLogicalVector) x;
- int[] array = new int[vector.getLength()];
- for (int i = 0; i < vector.getLength(); i++) {
- array[i] = toWideLogical(vector.getDataAt(i));
- }
- return array;
+ return ((RLogicalVector) x).getDataWithoutCopying();
} else if (x instanceof Byte) {
- return new int[]{toWideLogical((Byte) x)};
+ return new byte[]{(Byte) x};
} else {
throw unimplemented();
}
diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/testrffi.R b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/testrffi.R
index bc33e2a7a9f060afbd1732784cf35e579373f3f3..0505d5234162ca2c32319731fdb6df0c03d99b85 100644
--- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/testrffi.R
+++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/testrffi.R
@@ -14,6 +14,10 @@ rffi.populateIntVector <- function(n) {
.Call("populateIntVector", as.integer(n), PACKAGE = "testrffi")
}
+rffi.populateLogicalVector <- function(n) {
+ .Call("populateLogicalVector", as.integer(n), PACKAGE = "testrffi")
+}
+
rffi.createExternalPtr <- function(addr, tag, prot) {
.Call("createExternalPtr", as.integer(addr), tag, prot, PACKAGE = "testrffi")
}
diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.c b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.c
index 1ed65e33a74d52c799dea0eeacaf1ae27740674e..25fe3356810e70836458d28314814a8a274940dc 100644
--- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.c
+++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.c
@@ -63,6 +63,18 @@ SEXP populateIntVector(SEXP n) {
return v;
}
+SEXP populateLogicalVector(SEXP n) {
+ SEXP v;
+ int intN = INTEGER_VALUE(n);
+ PROTECT(v = allocVector(LGLSXP, intN));
+ int i;
+ for (i = 0; i < intN; i++) {
+ LOGICAL(v)[i] = i == 0 ? TRUE : i == 1 ? NA_INTEGER : FALSE;
+ }
+ UNPROTECT(1);
+ return v;
+}
+
SEXP createExternalPtr(SEXP addr, SEXP tag, SEXP prot) {
return R_MakeExternalPtr((void *) (long) INTEGER_VALUE(addr), tag, prot);
}
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test
index 87e927a0a235c4e7ea39c6da5d15208e866a6e90..65b59b9e53af5db08ba70a9328f361095818e250 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test
+++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test
@@ -107383,7 +107383,7 @@ Error: unexpected '*' in:
##com.oracle.truffle.r.test.rpackages.TestRFFIPackage.testLoadTestRFFICall
-#{ library("testrffi", lib.loc = "com.oracle.truffle.r.test/rpackages/testrlibs_user"); r1 <- rffi.addInt(2L, 3L); r2 <- rffi.addDouble(2, 3); v <- rffi.populateIntVector(5); v2 <- rffi.dotCModifiedArguments(c(0,1,2,3)); v3<-rffi.isRString(character(0)); detach("package:testrffi"); list(r1, r2, v, v2, v3) }
+#{ library("testrffi", lib.loc = "com.oracle.truffle.r.test/rpackages/testrlibs_user"); r1 <- rffi.addInt(2L, 3L); r2 <- rffi.addDouble(2, 3); v <- rffi.populateIntVector(5); v2 <- rffi.dotCModifiedArguments(c(0,1,2,3)); v3<-rffi.isRString(character(0)); v4 <- rffi.populateLogicalVector(5); detach("package:testrffi"); list(r1, r2, v, v2, v3, v4) }
[[1]]
[1] 5
@@ -107410,6 +107410,9 @@ Error: unexpected '*' in:
[[5]]
[1] TRUE
+[[6]]
+[1] TRUE NA FALSE FALSE FALSE
+
##com.oracle.truffle.r.test.rpackages.TestRFFIPackage.testLoadTestRFFIExternal
#{ library("testrffi", lib.loc = "com.oracle.truffle.r.test/rpackages/testrlibs_user"); r1 <- rffi.dotExternalAccessArgs(1L, 3, c(1,2,3), c('a', 'b'), 'b', TRUE, as.raw(12)); detach("package:testrffi"); list(r1) }
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/rpackages/TestRFFIPackage.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/rpackages/TestRFFIPackage.java
index 6887a110500e809be5c19a3c22c4aede418de022..ea44a093b98e03e0f15478121257f3d3d7e2c06f 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/rpackages/TestRFFIPackage.java
+++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/rpackages/TestRFFIPackage.java
@@ -51,7 +51,7 @@ public class TestRFFIPackage extends TestRPackages {
new String[]{TestRPackages.libLoc()}));
assertEval(TestBase.template(
"{ library(\"testrffi\", lib.loc = \"%0\"); r1 <- rffi.addInt(2L, 3L); r2 <- rffi.addDouble(2, 3); v <- rffi.populateIntVector(5); v2 <- rffi.dotCModifiedArguments(c(0,1,2,3)); " +
- "v3<-rffi.isRString(character(0)); detach(\"package:testrffi\"); list(r1, r2, v, v2, v3) }",
+ "v3<-rffi.isRString(character(0)); v4 <- rffi.populateLogicalVector(5); detach(\"package:testrffi\"); list(r1, r2, v, v2, v3, v4) }",
new String[]{TestRPackages.libLoc()}));
}