From 15c97abd390fef9b854b6de61ecb51ec5e872321 Mon Sep 17 00:00:00 2001
From: Mick Jordan <mick.jordan@oracle.com>
Date: Tue, 9 Jun 2015 11:55:37 -0700
Subject: [PATCH] FFI improvements; call parseRd through ToolsRFFI
---
.../truffle/r/library/tools/C_ParseRd.java | 17 +--
.../fficall/jni/Makefile | 6 +-
.../fficall/jni/src/externalptr.c | 6 +-
.../fficall/jni/src/listaccess.c | 10 +-
.../fficall/jni/src/misc.c | 4 +
.../fficall/jni/src/rf_functions.c | 33 +++---
.../fficall/jni/src/rfficall.c | 67 +++++++----
.../fficall/jni/src/rffiutils.c | 105 +++++++++++++++++-
.../fficall/jni/src/rffiutils.h | 36 +++++-
.../fficall/jni/src/typecoerce.c | 13 ++-
.../fficall/jni/src/vectoraccess.c | 24 ++--
.../library/tools/src/gramRd.c | 64 ++++++-----
.../library/tools/src/tools.h | 3 +-
.../r/runtime/ffi/jnr/CallRFFIHelper.java | 23 +++-
.../r/runtime/ffi/jnr/CallRFFIWithJNI.java | 58 +++++++---
.../r/runtime/ffi/jnr/JNR_RFFIFactory.java | 62 ++++++++++-
.../oracle/truffle/r/runtime/RContext.java | 4 +-
.../oracle/truffle/r/runtime/ffi/RFFI.java | 3 +
.../runtime/ffi/RFFIContextStateFactory.java | 52 +++++++++
.../truffle/r/runtime/ffi/RFFIFactory.java | 8 +-
.../truffle/r/runtime/ffi/StatsRFFI.java | 2 +-
.../truffle/r/runtime/ffi/ToolsRFFI.java | 34 +++---
.../packages/testrffi/testrffi/NAMESPACE | 7 +-
.../packages/testrffi/testrffi/R/testrffi.R | 20 ++--
.../packages/testrffi/testrffi/src/testrffi.c | 17 ++-
.../truffle/r/test/ExpectedTestOutput.test | 4 +-
.../r/test/rpackages/TestRPackages.java | 2 +-
27 files changed, 513 insertions(+), 171 deletions(-)
create mode 100644 com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFIContextStateFactory.java
rename com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/tools/ToolsNative.java => com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/ToolsRFFI.java (55%)
diff --git a/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/tools/C_ParseRd.java b/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/tools/C_ParseRd.java
index dc460817b1..0d6b1b37eb 100644
--- a/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/tools/C_ParseRd.java
+++ b/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/tools/C_ParseRd.java
@@ -28,24 +28,27 @@ import com.oracle.truffle.api.dsl.*;
import com.oracle.truffle.r.nodes.builtin.*;
import com.oracle.truffle.r.runtime.*;
import com.oracle.truffle.r.runtime.conn.*;
+import com.oracle.truffle.r.runtime.data.*;
import com.oracle.truffle.r.runtime.data.model.*;
import com.oracle.truffle.r.runtime.env.*;
+import com.oracle.truffle.r.runtime.ffi.*;
public abstract class C_ParseRd extends RExternalBuiltinNode.Arg7 {
- @SuppressWarnings("unused")
@Specialization
- protected Object parseRd(RConnection con, REnvironment srcfile, String encoding, byte verboseL, RAbstractStringVector basename, byte fragmentL, byte warningCallsL) {
- boolean verbose = RRuntime.fromLogical(verboseL);
- boolean fragment = RRuntime.fromLogical(fragmentL);
+ protected Object parseRd(RConnection con, REnvironment srcfile, @SuppressWarnings("unused") String encoding, byte verboseL, RAbstractStringVector basename, byte fragmentL, byte warningCallsL) {
if (RRuntime.isNA(warningCallsL)) {
throw RError.error(getEncapsulatingSourceSection(), RError.Message.INVALID_ARGUMENT, "warningCalls");
}
- boolean warningCalls = RRuntime.fromLogical(warningCallsL);
try (RConnection openConn = con.forceOpen("r")) {
- Object result = ToolsNative.provider().cParseRd(con, srcfile, verbose, fragment, basename.getDataAt(0), warningCalls);
- return result;
+ // @formatter:off
+ return RFFIFactory.getRFFI().getToolsRFFI().parseRd(openConn, srcfile,
+ RDataFactory.createLogicalVectorFromScalar(verboseL),
+ RDataFactory.createLogicalVectorFromScalar(fragmentL),
+ RDataFactory.createStringVectorFromScalar(basename.getDataAt(0)),
+ RDataFactory.createLogicalVectorFromScalar(warningCallsL));
+ // @formatter:on
} catch (IOException ex) {
throw RError.error(getEncapsulatingSourceSection(), RError.Message.GENERIC, ex.getMessage());
} catch (Throwable ex) {
diff --git a/com.oracle.truffle.r.native/fficall/jni/Makefile b/com.oracle.truffle.r.native/fficall/jni/Makefile
index a01d09c277..4b86d03522 100644
--- a/com.oracle.truffle.r.native/fficall/jni/Makefile
+++ b/com.oracle.truffle.r.native/fficall/jni/Makefile
@@ -34,6 +34,7 @@ endif
OBJ = lib
SRC = src
C_SOURCES := $(wildcard $(SRC)/*.c)
+C_HDRS := $(wildcard $(SRC)/*.h)
C_LIBNAME := librfficall$(DYLIB_EXT)
C_OBJECTS := $(subst $(SRC),$(OBJ),$(C_SOURCES:.c=.o))
C_LIB := $(TOPDIR)/builtinlibs/$(OBJ)/$(C_LIBNAME)
@@ -57,8 +58,11 @@ $(C_LIB): $(OBJ) $(C_OBJECTS)
$(OBJ):
mkdir -p $(OBJ)
-$(OBJ)/%.o: $(SRC)/%.c $(TOPDIR)/include/jni/include/Rinternals.h
+$(OBJ)/%.o: $(SRC)/%.c $(TOPDIR)/include/jni/include/Rinternals.h $(C_HDRS)
$(CC) $(CFLAGS) $(INCLUDES) -c $< -o $@
+
+$(OBJ)/%.E: $(SRC)/%.c $(TOPDIR)/include/jni/include/Rinternals.h
+ $(CC) -E $(CFLAGS) $(INCLUDES) -c $< > $@
clean:
rm -rf $(OBJ) $(C_LIB)
diff --git a/com.oracle.truffle.r.native/fficall/jni/src/externalptr.c b/com.oracle.truffle.r.native/fficall/jni/src/externalptr.c
index 79943a7a6f..8ab12aa582 100644
--- a/com.oracle.truffle.r.native/fficall/jni/src/externalptr.c
+++ b/com.oracle.truffle.r.native/fficall/jni/src/externalptr.c
@@ -46,7 +46,7 @@ void init_externalptr(JNIEnv *env) {
SEXP R_MakeExternalPtr(void *p, SEXP tag, SEXP prot) {
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, RDataFactoryClass, createExternalPtrMethodID, (jlong) p, tag, prot);
- return mkGlobalRef(thisenv, result);
+ return checkRef(thisenv, result);
}
void *R_ExternalPtrAddr(SEXP s) {
@@ -57,13 +57,13 @@ void *R_ExternalPtrAddr(SEXP s) {
SEXP R_ExternalPtrTag(SEXP s) {
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallObjectMethod(thisenv, s, externalPtrGetTagMethodID);
- return mkGlobalRef(thisenv, result);
+ return checkRef(thisenv, result);
}
SEXP R_ExternalPtrProt(SEXP s) {
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallObjectMethod(thisenv, s, externalPtrGetProtMethodID);
- return mkGlobalRef(thisenv, result);
+ return checkRef(thisenv, result);
}
void R_SetExternalPtrAddr(SEXP s, void *p) {
diff --git a/com.oracle.truffle.r.native/fficall/jni/src/listaccess.c b/com.oracle.truffle.r.native/fficall/jni/src/listaccess.c
index e185d60f9e..89d264e651 100644
--- a/com.oracle.truffle.r.native/fficall/jni/src/listaccess.c
+++ b/com.oracle.truffle.r.native/fficall/jni/src/listaccess.c
@@ -44,13 +44,13 @@ SEXP TAG(SEXP e) {
SEXP CAR(SEXP e) {
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, CAR_MethodID, e);
- return mkGlobalRef(thisenv, result);
+ return checkRef(thisenv, result);
}
SEXP CDR(SEXP e) {
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, CDR_MethodID, e);
- return mkGlobalRef(thisenv, result);
+ return checkRef(thisenv, result);
}
SEXP CAAR(SEXP e) {
@@ -64,7 +64,7 @@ SEXP CDAR(SEXP e) {
SEXP CADR(SEXP e) {
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, CADR_MethodID, e);
- return mkGlobalRef(thisenv, result);
+ return checkRef(thisenv, result);
}
SEXP CDDR(SEXP e) {
@@ -98,13 +98,13 @@ void SET_TAG(SEXP x, SEXP y) {
SEXP SETCAR(SEXP x, SEXP y) {
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, SETCAR_MethodID, x, y);
- return mkGlobalRef(thisenv, result);
+ return checkRef(thisenv, result);
}
SEXP SETCDR(SEXP x, SEXP y) {
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, SETCDR_MethodID, x, y);
- return mkGlobalRef(thisenv, result);
+ return checkRef(thisenv, result);
}
SEXP SETCADR(SEXP x, SEXP y) {
diff --git a/com.oracle.truffle.r.native/fficall/jni/src/misc.c b/com.oracle.truffle.r.native/fficall/jni/src/misc.c
index bc1a103019..5be911f7d4 100644
--- a/com.oracle.truffle.r.native/fficall/jni/src/misc.c
+++ b/com.oracle.truffle.r.native/fficall/jni/src/misc.c
@@ -29,10 +29,14 @@ void init_misc(JNIEnv *env) {
}
const char *R_CHAR(SEXP string) {
+ TRACE("%s(%p)", string);
// This is nasty:
// 1. the resulting character array has to be copied and zero-terminated.
// 2. It causes an (inevitable?) memory leak
JNIEnv *thisenv = getEnv();
+#if VALIDATE_REFS
+ validateRef(thisenv, string, "R_CHAR");
+#endif
jsize len = (*thisenv)->GetStringUTFLength(thisenv, string);
const char *stringChars = (*thisenv)->GetStringUTFChars(thisenv, string, NULL);
char *copyChars = malloc(len + 1);
diff --git a/com.oracle.truffle.r.native/fficall/jni/src/rf_functions.c b/com.oracle.truffle.r.native/fficall/jni/src/rf_functions.c
index c1dc500ba8..60b33b839e 100644
--- a/com.oracle.truffle.r.native/fficall/jni/src/rf_functions.c
+++ b/com.oracle.truffle.r.native/fficall/jni/src/rf_functions.c
@@ -41,6 +41,7 @@ static jmethodID Rf_getAttribMethodID;
static jmethodID Rf_setAttribMethodID;
static jmethodID Rf_isStringMethodID;
static jmethodID Rf_isNullMethodID;
+static jmethodID Rf_warningMethodID;
static jmethodID Rf_NewHashedEnvMethodID;
void init_rf_functions(JNIEnv *env) {
@@ -54,6 +55,7 @@ void init_rf_functions(JNIEnv *env) {
Rf_setAttribMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_setAttrib", "(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)V", 1);
Rf_isStringMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_isString", "(Ljava/lang/Object;)I", 1);
Rf_isNullMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_isNull", "(Ljava/lang/Object;)I", 1);
+ Rf_warningMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_warning", "(Ljava/lang/String;)V", 1);
createIntArrayMethodID = checkGetMethodID(env, RDataFactoryClass, "createIntVector", "(I)Lcom/oracle/truffle/r/runtime/data/RIntVector;", 1);
createDoubleArrayMethodID = checkGetMethodID(env, RDataFactoryClass, "createDoubleVector", "(I)Lcom/oracle/truffle/r/runtime/data/RDoubleVector;", 1);
createStringArrayMethodID = checkGetMethodID(env, RDataFactoryClass, "createStringVector", "(I)Lcom/oracle/truffle/r/runtime/data/RStringVector;", 1);
@@ -63,24 +65,27 @@ void init_rf_functions(JNIEnv *env) {
}
SEXP Rf_ScalarInteger(int value) {
+ TRACE("%s(%d)\n", value);
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, Rf_ScalarIntegerMethodID, value);
- return mkGlobalRef(thisenv, result);
+ return checkRef(thisenv, result);
}
SEXP Rf_ScalarReal(double value) {
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, Rf_ScalarDoubleMethodID, value);
- return mkGlobalRef(thisenv, result);
+ return checkRef(thisenv, result);
}
SEXP Rf_ScalarString(SEXP value) {
+ TRACE(TARG1, value);
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, Rf_ScalarStringMethodID, value);
- return mkGlobalRef(thisenv, result);
+ return checkRef(thisenv, result);
}
SEXP Rf_allocVector(SEXPTYPE t, R_xlen_t len) {
+ TRACE(TARG2d, t, len);
JNIEnv *thisenv = getEnv();
SEXP result;
switch (t) {
@@ -105,13 +110,13 @@ SEXP Rf_allocVector(SEXPTYPE t, R_xlen_t len) {
unimplemented("vector type not handled");
return NULL;
}
- return mkGlobalRef(thisenv, result);
+ return checkRef(thisenv, result);
}
SEXP Rf_cons(SEXP car, SEXP cdr) {
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, Rf_consMethodID, car, cdr);
- return mkGlobalRef(thisenv, result);
+ return checkRef(thisenv, result);
}
void Rf_defineVar(SEXP symbol, SEXP value, SEXP rho) {
@@ -122,13 +127,13 @@ void Rf_defineVar(SEXP symbol, SEXP value, SEXP rho) {
SEXP Rf_findVar(SEXP symbol, SEXP rho) {
JNIEnv *thisenv = getEnv();
SEXP result =(*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, Rf_findVarMethodID, symbol, rho);
- return mkGlobalRef(thisenv, result);
+ return checkRef(thisenv, result);
}
SEXP Rf_getAttrib(SEXP vec, SEXP name) {
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, Rf_getAttribMethodID, vec, name);
- return mkGlobalRef(thisenv, result);
+ return checkRef(thisenv, result);
}
SEXP Rf_setAttrib(SEXP vec, SEXP name, SEXP val) {
@@ -140,14 +145,14 @@ SEXP Rf_setAttrib(SEXP vec, SEXP name, SEXP val) {
SEXP Rf_duplicate(SEXP x) {
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, Rf_duplicateMethodID, x);
- return mkGlobalRef(thisenv, result);
+ return checkRef(thisenv, result);
}
SEXP Rf_install(const char *name) {
JNIEnv *thisenv = getEnv();
jstring string = (*thisenv)->NewStringUTF(thisenv, name);
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, createSymbolMethodID, string);
- return mkGlobalRef(thisenv, result);
+ return checkRef(thisenv, result);
}
Rboolean Rf_isNull(SEXP s) {
@@ -165,7 +170,7 @@ SEXP Rf_mkChar(const char *x) {
JNIEnv *thisenv = getEnv();
// TODO encoding, assume UTF for now
SEXP result = (*thisenv)->NewStringUTF(thisenv, x);
- return mkGlobalRef(thisenv, result);
+ return checkRef(thisenv, result);
}
SEXP Rf_mkCharLenCE(const char *x, int len, cetype_t enc) {
@@ -175,7 +180,7 @@ SEXP Rf_mkCharLenCE(const char *x, int len, cetype_t enc) {
buf[len] = 0;
// TODO encoding, assume UTF for now, zero terminated
SEXP result = (*thisenv)->NewStringUTF(thisenv, buf);
- return mkGlobalRef(thisenv, result);
+ return checkRef(thisenv, result);
}
SEXP Rf_mkString(const char *s) {
@@ -205,7 +210,9 @@ void Rf_warningcall(SEXP x, const char *msg, ...) {
}
void Rf_warning(const char *msg, ...) {
- unimplemented("Rf_warning");
+ JNIEnv *thisenv = getEnv();
+ jstring string = (*thisenv)->NewStringUTF(thisenv, msg);
+ (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, Rf_warningMethodID, string);
}
void Rprintf(const char *msg, ...) {
@@ -220,5 +227,5 @@ SEXP R_NewHashedEnv(SEXP parent, SEXP size) {
JNIEnv *thisenv = getEnv();
int sizeAsInt = Rf_asInteger(size);
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, RDataFactoryClass, Rf_NewHashedEnvMethodID, parent, NULL, JNI_TRUE, sizeAsInt);
- return mkGlobalRef(thisenv, result);
+ return checkRef(thisenv, result);
}
diff --git a/com.oracle.truffle.r.native/fficall/jni/src/rfficall.c b/com.oracle.truffle.r.native/fficall/jni/src/rfficall.c
index 3d466017f1..93090ab33f 100644
--- a/com.oracle.truffle.r.native/fficall/jni/src/rfficall.c
+++ b/com.oracle.truffle.r.native/fficall/jni/src/rfficall.c
@@ -56,39 +56,49 @@ typedef SEXP (*call10func)(SEXP arg1, SEXP arg2, SEXP arg3, SEXP arg4, SEXP arg5
JNIEXPORT jobject JNICALL
Java_com_oracle_truffle_r_runtime_ffi_jnr_CallRFFIWithJNI_call0(JNIEnv *env, jclass c, jlong address) {
- setEnv(env);
+ callEnter(env);
call0func call0 = (call0func) address;
- return (*call0)();
+ jobject result = (*call0)();
+ callExit(env);
+ return result;
}
JNIEXPORT jobject JNICALL
Java_com_oracle_truffle_r_runtime_ffi_jnr_CallRFFIWithJNI_call1(JNIEnv *env, jclass c, jlong address, jobject arg1) {
- setEnv(env);
+ callEnter(env);
call1func call1 = (call1func) address;
- return (*call1)(arg1);
+ jobject result = (*call1)(arg1);
+ callExit(env);
+ return result;
}
JNIEXPORT jobject JNICALL
Java_com_oracle_truffle_r_runtime_ffi_jnr_CallRFFIWithJNI_call2(JNIEnv *env, jclass c, jlong address, jobject arg1, jobject arg2) {
- setEnv(env);
+ callEnter(env);
call2func call2 = (call2func) address;
- return (*call2)(arg1, arg2);
+ jobject result = (*call2)(arg1, arg2);
+ callExit(env);
+ return result;
}
JNIEXPORT jobject JNICALL
Java_com_oracle_truffle_r_runtime_ffi_jnr_CallRFFIWithJNI_call3(JNIEnv *env, jclass c, jlong address, jobject arg1, jobject arg2,
jobject arg3) {
- setEnv(env);
+ callEnter(env);
call3func call3 = (call3func) address;
- return (*call3)(arg1, arg2, arg3);
+ jobject result = (*call3)(arg1, arg2, arg3);
+ callExit(env);
+ return result;
}
JNIEXPORT jobject JNICALL
Java_com_oracle_truffle_r_runtime_ffi_jnr_CallRFFIWithJNI_call4(JNIEnv *env, jclass c, jlong address, jobject arg1, jobject arg2,
jobject arg3, jobject arg4) {
- setEnv(env);
+ callEnter(env);
call4func call4 = (call4func) address;
- return (*call4)(arg1, arg2, arg3, arg4);
+ jobject result = (*call4)(arg1, arg2, arg3, arg4);
+ callExit(env);
+ return result;
}
JNIEXPORT jobject JNICALL
@@ -96,44 +106,54 @@ Java_com_oracle_truffle_r_runtime_ffi_jnr_CallRFFIWithJNI_call5(JNIEnv *env, jcl
jobject arg3, jobject arg4, jobject arg5) {
setEnv(env);
call5func call5 = (call5func) address;
- return (*call5)(arg1, arg2, arg3, arg4, arg5);
+ jobject result = (*call5)(arg1, arg2, arg3, arg4, arg5);
+ callExit(env);
+ return result;
}
JNIEXPORT jobject JNICALL
Java_com_oracle_truffle_r_runtime_ffi_jnr_CallRFFIWithJNI_call6(JNIEnv *env, jclass c, jlong address, jobject arg1, jobject arg2,
jobject arg3, jobject arg4, jobject arg5, jobject arg6) {
- setEnv(env);
+ callEnter(env);
call6func call6 = (call6func) address;
- return (*call6)(arg1, arg2, arg3, arg4, arg5, arg6);
+ jobject result = (*call6)(arg1, arg2, arg3, arg4, arg5, arg6);
+ callExit(env);
+ return result;
}
JNIEXPORT jobject JNICALL
Java_com_oracle_truffle_r_runtime_ffi_jnr_CallRFFIWithJNI_call7(JNIEnv *env, jclass c, jlong address, jobject arg1, jobject arg2,
jobject arg3, jobject arg4, jobject arg5, jobject arg6, jobject arg7) {
- setEnv(env);
+ callEnter(env);
call7func call7 = (call7func) address;
- return (*call7)(arg1, arg2, arg3, arg4, arg5, arg6, arg7);
+ jobject result = (*call7)(arg1, arg2, arg3, arg4, arg5, arg6, arg7);
+ callExit(env);
+ return result;
}
JNIEXPORT jobject JNICALL
Java_com_oracle_truffle_r_runtime_ffi_jnr_CallRFFIWithJNI_call8(JNIEnv *env, jclass c, jlong address, jobject arg1, jobject arg2,
jobject arg3, jobject arg4, jobject arg5, jobject arg6, jobject arg7, jobject arg8) {
- setEnv(env);
+ callEnter(env);
call8func call8 = (call8func) address;
- return (*call8)(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
+ jobject result = (*call8)(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
+ callExit(env);
+ return result;
}
JNIEXPORT jobject JNICALL
Java_com_oracle_truffle_r_runtime_ffi_jnr_CallRFFIWithJNI_call9(JNIEnv *env, jclass c, jlong address, jobject arg1, jobject arg2,
jobject arg3, jobject arg4, jobject arg5, jobject arg6, jobject arg7, jobject arg8, jobject arg9) {
- setEnv(env);
+ callEnter(env);
call9func call9 = (call9func) address;
- return (*call9)(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9);
+ jobject result = (*call9)(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9);
+ callExit(env);
+ return result;
}
JNIEXPORT jobject JNICALL
Java_com_oracle_truffle_r_runtime_ffi_jnr_CallRFFIWithJNI_call(JNIEnv *env, jclass c, jlong address, jobjectArray args) {
- setEnv(env);
+ callEnter(env);
jsize len = (*env)->GetArrayLength(env, args);
switch (len) {
case 10: {
@@ -148,7 +168,9 @@ Java_com_oracle_truffle_r_runtime_ffi_jnr_CallRFFIWithJNI_call(JNIEnv *env, jcla
jobject arg9 = (*env)->GetObjectArrayElement(env, args, 8);
jobject arg10 = (*env)->GetObjectArrayElement(env, args, 9);
call10func call10 = (call10func) address;
- return (*call10)(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10);
+ jobject result = (*call10)(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10);
+ callExit(env);
+ return result;
}
default:
@@ -161,9 +183,10 @@ typedef void (*callVoid1func)(SEXP arg1);
JNIEXPORT void JNICALL
Java_com_oracle_truffle_r_runtime_ffi_jnr_CallRFFIWithJNI_callVoid1(JNIEnv *env, jclass c, jlong address, jobject arg1) {
- setEnv(env);
+ callEnter(env);
callVoid1func call1 = (callVoid1func) address;
(*call1)(arg1);
+ callExit(env);
}
diff --git a/com.oracle.truffle.r.native/fficall/jni/src/rffiutils.c b/com.oracle.truffle.r.native/fficall/jni/src/rffiutils.c
index 9f8a8d5dc0..e16c70d7ff 100644
--- a/com.oracle.truffle.r.native/fficall/jni/src/rffiutils.c
+++ b/com.oracle.truffle.r.native/fficall/jni/src/rffiutils.c
@@ -22,6 +22,7 @@
*/
#include "rffiutils.h"
#include <string.h>
+#include <stdlib.h>
/*
* All calls pass through one of the call(N) methods, which carry the JNIEnv value,
@@ -38,11 +39,28 @@ static jmethodID validateMethodID;
JNIEnv *curenv = NULL;
-//#define DEBUG_CACHE 1
+#define DEBUG_CACHE 0
+#define TRACE_COPIES 0
#define CACHED_GLOBALREFS_TABLE_SIZE 100
static SEXP cachedGlobalRefs[CACHED_GLOBALREFS_TABLE_SIZE];
static SEXP checkCachedGlobalRef(JNIEnv *env, SEXP obj);
+typedef struct CopiedVectors_struct {
+ SEXPTYPE type;
+ SEXP obj;
+ void *jArray;
+ void *data;
+} CopiedVector;
+
+#define COPIED_VECTORS_INITIAL_SIZE 100
+// A table of vectors that have been accessed and whose contents, e.g. the actual data
+// as a primitive array have been copied and handed out to the native code.
+static CopiedVector *copiedVectors;
+// hwm of copiedVectors
+static int copiedVectorsIndex;
+static int copiedVectorsLength;
+
+
void init_utils(JNIEnv *env) {
curenv = env;
RDataFactoryClass = checkFindClass(env, "com/oracle/truffle/r/runtime/data/RDataFactory");
@@ -54,9 +72,78 @@ void init_utils(JNIEnv *env) {
for (int i = 0; i < CACHED_GLOBALREFS_TABLE_SIZE; i++) {
cachedGlobalRefs[i] = NULL;
}
+ copiedVectors = malloc(sizeof(CopiedVector) * COPIED_VECTORS_INITIAL_SIZE);
+ copiedVectorsLength = COPIED_VECTORS_INITIAL_SIZE;
+ copiedVectorsIndex = 0;
+}
+
+void callEnter(JNIEnv *env) {
+ setEnv(env);
+// printf("callEnter\n");
+}
+
+void callExit(JNIEnv *env) {
+// printf("callExit\n");
+ int i;
+ for (i = 0; i < copiedVectorsIndex; i++) {
+ CopiedVector cv = copiedVectors[i];
+ switch (cv.type) {
+ case INTSXP: {
+ jintArray intArray = (jintArray) cv.jArray;
+ (*env)->ReleaseIntArrayElements(env, intArray, (jint *)cv.data, 0);
+ break;
+ }
+ default:
+ fatalError("copiedVector type");
+ }
+ }
+ copiedVectorsIndex = 0;
+}
+
+void *findCopiedObject(JNIEnv *env, SEXP x) {
+ int i;
+ for (i = 0; i < copiedVectorsIndex; i++) {
+ CopiedVector cv = copiedVectors[i];
+ if ((*env)->IsSameObject(env, cv.obj, x)) {
+ void *data = cv.data;
+#if TRACE_COPIES
+ printf("findCopiedObject(%p): found %p\n", x, data);
+#endif
+ return data;
+ }
+ }
+#if TRACE_COPIES
+ printf("findCopiedObject(%p): not found\n", x);
+#endif
+ return NULL;
}
-SEXP mkGlobalRef(JNIEnv *env, SEXP obj) {
+void addCopiedObject(JNIEnv *env, SEXP x, SEXPTYPE type, void *jArray, void *data) {
+#if TRACE_COPIES
+ printf("addCopiedObject(%p, %p)\n", x, data);
+#endif
+ if (copiedVectorsIndex >= copiedVectorsLength) {
+ int newLength = 2 * copiedVectorsLength;
+ CopiedVector *newCopiedVectors = malloc(sizeof(CopiedVector) * newLength);
+ if (newCopiedVectors == NULL) {
+ fatalError("malloc failure");
+ }
+ memcpy(newCopiedVectors, copiedVectors, copiedVectorsLength * sizeof(CopiedVector));
+ free(copiedVectors);
+ copiedVectors = newCopiedVectors;
+ copiedVectorsLength = newLength;
+ }
+ copiedVectors[copiedVectorsIndex].obj = x;
+ copiedVectors[copiedVectorsIndex].data = data;
+ copiedVectors[copiedVectorsIndex].type = type;
+ copiedVectors[copiedVectorsIndex].jArray = jArray;
+ copiedVectorsIndex++;
+#if TRACE_COPIES
+ printf("copiedVectorsIndex: %d\n", copiedVectorsIndex);
+#endif
+}
+
+SEXP checkRef(JNIEnv *env, SEXP obj) {
SEXP result = checkCachedGlobalRef(env, obj);
return result;
}
@@ -86,13 +173,21 @@ static SEXP checkCachedGlobalRef(JNIEnv *env, SEXP obj) {
return ref;
}
}
+#if USE_GLOBAL
SEXP result = (*env)->NewGlobalRef(env, obj);
-#if DEBUG_CACHE
- printf("gref: new=%p\n", result);
+#else
+ SEXP result = obj;
#endif
return result;
}
+void validateRef(JNIEnv *env, SEXP x, const char *msg) {
+ jobjectRefType t = (*env)->GetObjectRefType(env, x);
+ if (t == JNIInvalidRefType) {
+ fatalError(msg);
+ }
+}
+
void validate(SEXP x) {
(*curenv)->CallStaticObjectMethod(curenv, CallRFFIHelperClass, validateMethodID, x);
}
@@ -126,7 +221,7 @@ jclass checkFindClass(JNIEnv *env, const char *name) {
strcat(buf, name);
(*env)->FatalError(env, buf);
}
- return mkGlobalRef(env, klass);
+ return (*env)->NewGlobalRef(env, klass);
}
jmethodID checkGetMethodID(JNIEnv *env, jclass klass, const char *name, const char *sig, int isStatic) {
diff --git a/com.oracle.truffle.r.native/fficall/jni/src/rffiutils.h b/com.oracle.truffle.r.native/fficall/jni/src/rffiutils.h
index 5044291545..ac4425e2c8 100644
--- a/com.oracle.truffle.r.native/fficall/jni/src/rffiutils.h
+++ b/com.oracle.truffle.r.native/fficall/jni/src/rffiutils.h
@@ -26,6 +26,8 @@
#include <jni.h>
#include <Rinternals.h>
+#define VALIDATE_REFS 1
+
JNIEnv *getEnv();
void setEnv(JNIEnv *env);
@@ -33,11 +35,28 @@ jclass checkFindClass(JNIEnv *env, const char *name);
jmethodID checkGetMethodID(JNIEnv *env, jclass klass, const char *name, const char *sig, int isStatic);
extern jmethodID createSymbolMethodID;
+// use for an unimplemented API function
void unimplemented(char *msg);
+// use for any fatal error
void fatalError(char *msg);
+// makes a call to the VM with x as an argument (for debugger validation)
void validate(SEXP x);
-SEXP mkGlobalRef(JNIEnv *env, SEXP);
-SEXP mkNamedGlobalRef(JNIEnv *env, int index, SEXP);
+// checks x against the list of canonical (named) refs, returning the canonical version if a match
+SEXP checkRef(JNIEnv *env, SEXP x);
+// creates a JNI global ref from x for slot index of the named refs table
+SEXP mkNamedGlobalRef(JNIEnv *env, int index, SEXP x);
+// validate a JNI reference
+void validateRef(JNIEnv *env, SEXP x, const char *msg);
+
+// entering a top-level JNI call
+void callEnter(JNIEnv *env);
+// exiting a top-level JNI call
+void callExit(JNIEnv *env);
+
+// find an object for which we have cached the internal rep
+void *findCopiedObject(JNIEnv *env, SEXP x);
+// add a new object to the internal rep cache
+void addCopiedObject(JNIEnv *env, SEXP x, SEXPTYPE type, void *jArray, void *data);
void init_variables(JNIEnv *env, jobjectArray initialValues);
void init_register(JNIEnv *env);
@@ -53,4 +72,17 @@ void init_utils(JNIEnv *env);
extern jclass RDataFactoryClass;
extern jclass CallRFFIHelperClass;
+#define TRACE_UPCALLS 0
+
+#define TARG1 "%s(%p)\n"
+#define TARG2 "%s(%p, %p)\n"
+#define TARG2d "%s(%p, %d)\n"
+
+#if TRACE_UPCALLS
+#define TRACE(format, ...) printf(format, __FUNCTION__, __VA_ARGS__)
+#else
+#define TRACE(format, ...)
+#endif
+
+
#endif /* RFFIUTILS_H */
diff --git a/com.oracle.truffle.r.native/fficall/jni/src/typecoerce.c b/com.oracle.truffle.r.native/fficall/jni/src/typecoerce.c
index 047414ba87..2782978855 100644
--- a/com.oracle.truffle.r.native/fficall/jni/src/typecoerce.c
+++ b/com.oracle.truffle.r.native/fficall/jni/src/typecoerce.c
@@ -25,19 +25,22 @@
static jmethodID Rf_asIntegerMethodID;
static jmethodID Rf_asRealMethodID;
static jmethodID Rf_asCharMethodID;
+static jmethodID Rf_asLogicalMethodID;
static jmethodID Rf_PairToVectorListMethodID;
void init_typecoerce(JNIEnv *env) {
Rf_asIntegerMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_asInteger", "(Ljava/lang/Object;)I", 1);
Rf_asRealMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_asReal", "(Ljava/lang/Object;)D", 1);
Rf_asCharMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_asChar", "(Ljava/lang/Object;)Ljava/lang/String;", 1);
+ Rf_asLogicalMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_asLogical", "(Ljava/lang/Object;)I", 1);
Rf_PairToVectorListMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_PairToVectorList", "(Ljava/lang/Object;)Ljava/lang/Object;", 1);
}
SEXP Rf_asChar(SEXP x){
+ TRACE(TARG1, x);
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, Rf_asCharMethodID, x);
- return mkGlobalRef(thisenv, result);
+ return checkRef(thisenv, result);
}
SEXP Rf_coerceVector(SEXP x, SEXPTYPE t){
@@ -47,7 +50,7 @@ SEXP Rf_coerceVector(SEXP x, SEXPTYPE t){
SEXP Rf_PairToVectorList(SEXP x){
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, Rf_PairToVectorListMethodID, x);
- return mkGlobalRef(thisenv, result);
+ return checkRef(thisenv, result);
}
SEXP Rf_VectorToPairList(SEXP x){
@@ -59,15 +62,19 @@ SEXP Rf_asCharacterFactor(SEXP x){
}
int Rf_asLogical(SEXP x){
- unimplemented("Rf_asLogical");
+ TRACE(TARG1, x);
+ JNIEnv *thisenv = getEnv();
+ return (*thisenv)->CallStaticIntMethod(thisenv, CallRFFIHelperClass, Rf_asLogicalMethodID, x);
}
int Rf_asInteger(SEXP x) {
+ TRACE(TARG1, x);
JNIEnv *thisenv = getEnv();
return (*thisenv)->CallStaticIntMethod(thisenv, CallRFFIHelperClass, Rf_asIntegerMethodID, x);
}
double Rf_asReal(SEXP x) {
+ TRACE(TARG1, x);
JNIEnv *thisenv = getEnv();
return (*thisenv)->CallStaticDoubleMethod(thisenv, CallRFFIHelperClass, Rf_asRealMethodID, x);
}
diff --git a/com.oracle.truffle.r.native/fficall/jni/src/vectoraccess.c b/com.oracle.truffle.r.native/fficall/jni/src/vectoraccess.c
index 771eb9d446..b3f0df097f 100644
--- a/com.oracle.truffle.r.native/fficall/jni/src/vectoraccess.c
+++ b/com.oracle.truffle.r.native/fficall/jni/src/vectoraccess.c
@@ -94,23 +94,22 @@ int SETLEVELS(SEXP x, int v){
unimplemented("SETLEVELS");
}
-
-
int *LOGICAL(SEXP x){
unimplemented("LOGICAL");
}
-
int *INTEGER(SEXP x){
+ TRACE(TARG1, x);
// TODO This does not support write access, e.g. INTEGER(x)[i]
JNIEnv *thisenv = getEnv();
- jintArray intarray = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, INTEGER_MethodID, x);
- int len = (*thisenv)->GetArrayLength(thisenv, intarray);
- jint *data = (*thisenv)->GetIntArrayElements(thisenv, intarray, NULL);
- void *result = malloc(len * 4);
- memcpy(result, data, len * 4);
- (*thisenv)->ReleaseIntArrayElements(thisenv, intarray, data, JNI_ABORT);
- return (int *) result;
+ jint *data = (jint *) findCopiedObject(thisenv, x);
+ if (data == NULL) {
+ jintArray intArray = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, INTEGER_MethodID, x);
+ int len = (*thisenv)->GetArrayLength(thisenv, intArray);
+ data = (*thisenv)->GetIntArrayElements(thisenv, intArray, NULL);
+ addCopiedObject(thisenv, x, INTSXP, intArray, data);
+ }
+ return data;
}
@@ -138,16 +137,17 @@ Rcomplex *COMPLEX(SEXP x){
SEXP STRING_ELT(SEXP x, R_xlen_t i){
+ TRACE(TARG2d, x, i);
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, STRING_ELT_MethodID, x, i);
- return mkGlobalRef(thisenv, result);
+ return checkRef(thisenv, result);
}
SEXP VECTOR_ELT(SEXP x, R_xlen_t i){
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, VECTOR_ELT_MethodID, x, i);
- return mkGlobalRef(thisenv, result);
+ return checkRef(thisenv, result);
}
void SET_INTEGER_ELT(SEXP x, R_xlen_t i, int v) {
diff --git a/com.oracle.truffle.r.native/library/tools/src/gramRd.c b/com.oracle.truffle.r.native/library/tools/src/gramRd.c
index 02a87523d0..ba2ae3a490 100644
--- a/com.oracle.truffle.r.native/library/tools/src/gramRd.c
+++ b/com.oracle.truffle.r.native/library/tools/src/gramRd.c
@@ -2858,22 +2858,18 @@ yyreturn:
return YYID (yyresult);
}
-
-
-extern void SET_INTEGER_ELT(SEXP x, R_xlen_t i, int v);
-
static SEXP xxpushMode(int newmode, int newitem, int neweqn)
{
SEXP ans;
PROTECT(ans = allocVector(INTSXP, 7));
- SET_INTEGER_ELT(ans, 0, parseState.xxmode); /* Lexer mode */
- SET_INTEGER_ELT(ans, 1, parseState.xxitemType); /* What is \item? */
- SET_INTEGER_ELT(ans, 2, parseState.xxbraceDepth); /* Brace depth used in RCODE and VERBATIM */
- SET_INTEGER_ELT(ans, 3, parseState.xxinRString); /* Quote char that started a string */
- SET_INTEGER_ELT(ans, 4, parseState.xxQuoteLine); /* Where the quote was */
- SET_INTEGER_ELT(ans, 5, parseState.xxQuoteCol); /* " */
- SET_INTEGER_ELT(ans, 6, parseState.xxinEqn); /* In the first arg to \eqn or \deqn: no escapes */
+ INTEGER(ans)[0] = parseState.xxmode; /* Lexer mode */
+ INTEGER(ans)[1] = parseState.xxitemType; /* What is \item? */
+ INTEGER(ans)[2] = parseState.xxbraceDepth; /* Brace depth used in RCODE and VERBATIM */
+ INTEGER(ans)[3] = parseState.xxinRString; /* Quote char that started a string */
+ INTEGER(ans)[4] = parseState.xxQuoteLine; /* Where the quote was */
+ INTEGER(ans)[5] = parseState.xxQuoteCol; /* " */
+ INTEGER(ans)[6] = parseState.xxinEqn; /* In the first arg to \eqn or \deqn: no escapes */
#if DEBUGMODE
Rprintf("xxpushMode(%d, %s) pushes %d, %s, %d\n", newmode, yytname[YYTRANSLATE(newitem)],
@@ -3358,13 +3354,13 @@ static SEXP makeSrcref(YYLTYPE *lloc, SEXP srcfile)
SEXP val;
PROTECT(val = allocVector(INTSXP, 6));
- SET_INTEGER_ELT(val, 0, lloc->first_line);
- SET_INTEGER_ELT(val, 1, lloc->first_byte);
- SET_INTEGER_ELT(val, 2, lloc->last_line);
- SET_INTEGER_ELT(val, 3, lloc->last_byte);
- SET_INTEGER_ELT(val, 4, lloc->first_column);
- SET_INTEGER_ELT(val, 5, lloc->last_column);
- setAttrib(val, R_SrcfileSymbol, srcfile);
+ INTEGER(val)[0] = lloc->first_line;
+ INTEGER(val)[1] = lloc->first_byte;
+ INTEGER(val)[2] = lloc->last_line;
+ INTEGER(val)[3] = lloc->last_byte;
+ INTEGER(val)[4] = lloc->first_column;
+ INTEGER(val)[5] = lloc->last_column;
+ setAttrib(val, R_SrcfileSymbol, srcfile);
setAttrib(val, R_ClassSymbol, mkString("srcref"));
UNPROTECT(1);
return val;
@@ -3462,8 +3458,9 @@ static int Rconn_fgetc(Rconnection con) {
return -1;
}
+extern JNIEnv *getEnv();
+
static Rconnection con_parse;
-static JNIEnv *jnienv;
static jmethodID getcMethodID;
/* need to handle incomplete last line */
@@ -3471,17 +3468,17 @@ static int con_getc(void)
{
int c;
static int last=-1000;
-
- c = (*jnienv)->CallIntMethod(jnienv, con_parse, getcMethodID, con_parse);
+ JNIEnv *env = getEnv();
+ c = (*env)->CallIntMethod(env, con_parse, getcMethodID, con_parse);
if (c == EOF && last != '\n') c = '\n';
return (last = c);
}
static
-SEXP R_ParseRd(JNIEnv *env, Rconnection con, ParseStatus *status, SEXP srcfile, Rboolean fragment)
+SEXP R_ParseRd(Rconnection con, ParseStatus *status, SEXP srcfile, Rboolean fragment)
{
con_parse = con;
- jnienv = env;
+ JNIEnv *env = getEnv();
jclass klass = (*env)->FindClass(env, "com/oracle/truffle/r/runtime/conn/RConnection");
getcMethodID = (*env)->GetMethodID(env, klass, "getc", "()I");
ptr_getc = con_getc;
@@ -4271,12 +4268,13 @@ static void PopState() {
.External2(C_parseRd,file, srcfile, encoding, verbose, basename, warningCalls)
If there is text then that is read and the other arguments are ignored.
+
+ This is derived fron the function of the same name in the GnuR version.
+ Argument checking has already been performed, however, the types of the
+ arguments are as per the GnuR version, just passed explicitly (.Call style)
+ rather then as a list.
*/
-JNIEXPORT jobject JNICALL
-Java_com_oracle_truffle_r_library_tools_ToolsNative_cParseRdNative(JNIEnv *env, jclass c, jobject con,
- jobject source, jboolean verbose, jboolean fragment, jstring basename, jboolean warningcalls)
-{
- setEnv(env);
+SEXP C_parseRd(SEXP con, SEXP source, SEXP verbose, SEXP fragment, SEXP basename, SEXP warningcalls) {
SEXP s = R_NilValue;
ParseStatus status;
@@ -4289,16 +4287,16 @@ Java_com_oracle_truffle_r_library_tools_ToolsNative_cParseRdNative(JNIEnv *env,
PushState();
- parseState.xxBasename = basename;
- wCalls = warningcalls;
+// parseState.xxDebugTokens = asInteger(verbose);
+ parseState.xxBasename = CHAR(STRING_ELT(basename, 0));
+ wCalls = asLogical(warningcalls);
- s = R_ParseRd(env, con, &status, source, fragment);
+ s = R_ParseRd(con, &status, source, asLogical(fragment));
PopState();
if (status != PARSE_OK) {
// TODO throw an exception
}
-
- return s;
+ return s;
}
/* "do_deparseRd"
diff --git a/com.oracle.truffle.r.native/library/tools/src/tools.h b/com.oracle.truffle.r.native/library/tools/src/tools.h
index a8e3b7d52a..699bd444fa 100644
--- a/com.oracle.truffle.r.native/library/tools/src/tools.h
+++ b/com.oracle.truffle.r.native/library/tools/src/tools.h
@@ -43,7 +43,8 @@ SEXP startHTTPD(SEXP sIP, SEXP sPort) { return NULL; }
SEXP stopHTTPD(void) { return NULL; }
SEXP C_parseLatex(SEXP call, SEXP op, SEXP args, SEXP env) { return NULL; }
-SEXP C_parseRd(SEXP call, SEXP op, SEXP args, SEXP env) { return NULL; }
+//SEXP C_parseRd(SEXP call, SEXP op, SEXP args, SEXP env);
+SEXP C_parseRd(SEXP con, SEXP source, SEXP verbose, SEXP fragment, SEXP basename, SEXP warningcalls);
SEXP C_deparseRd(SEXP e, SEXP state) { return NULL; }
#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 1826713ff9..6415c18dfd 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
@@ -73,6 +73,16 @@ public class CallRFFIHelper {
}
}
+ static int Rf_asLogical(Object x) {
+ if (x instanceof Byte) {
+ return ((Byte) x).intValue();
+ } else if (x instanceof RLogicalVector) {
+ return ((RLogicalVector) x).getDataAt(0);
+ } else {
+ throw RInternalError.unimplemented();
+ }
+ }
+
static String Rf_asChar(Object x) {
if (x instanceof String) {
return (String) x;
@@ -155,6 +165,10 @@ public class CallRFFIHelper {
return pl.toRList();
}
+ static void Rf_warning(String msg) {
+ RError.warning(RError.Message.GENERIC, msg);
+ }
+
static int LENGTH(Object x) {
if (x instanceof RAbstractContainer) {
return ((RAbstractContainer) x).getLength();
@@ -185,7 +199,7 @@ public class CallRFFIHelper {
static byte[] RAW(Object x) {
if (x instanceof RRawVector) {
- return ((RRawVector) x).getDataCopy();
+ return ((RRawVector) x).getDataWithoutCopying();
} else {
throw RInternalError.unimplemented();
}
@@ -194,14 +208,17 @@ public class CallRFFIHelper {
static int[] INTEGER(Object x) {
if (x instanceof RIntVector) {
- return ((RIntVector) x).getDataCopy();
+ return ((RIntVector) x).getDataWithoutCopying();
} else {
throw RInternalError.unimplemented();
}
}
static String STRING_ELT(Object x, int i) {
- if (x instanceof RStringVector) {
+ if (x instanceof String) {
+ assert i == 0;
+ return (String) x;
+ } else if (x instanceof RStringVector) {
return ((RStringVector) x).getDataAt(i);
} else {
throw RInternalError.unimplemented();
diff --git a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/CallRFFIWithJNI.java b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/CallRFFIWithJNI.java
index cf053bb071..c279442a7c 100644
--- a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/CallRFFIWithJNI.java
+++ b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/CallRFFIWithJNI.java
@@ -22,6 +22,8 @@
*/
package com.oracle.truffle.r.runtime.ffi.jnr;
+import java.util.concurrent.*;
+
import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary;
import com.oracle.truffle.api.source.*;
import com.oracle.truffle.r.runtime.*;
@@ -36,6 +38,8 @@ import com.oracle.truffle.r.runtime.ffi.DLL.SymbolInfo;
* maximum number of args (64). This implementation passes up to 9 arguments explicitly; beyond 9
* they are passed as an array and the JNI code has to call back to get the args (not very
* efficient).
+ *
+ * The JNI layer is not (currently) MT safe, so all calls are single threaded.
*/
public class CallRFFIWithJNI implements CallRFFI {
@@ -73,10 +77,14 @@ public class CallRFFIWithJNI implements CallRFFI {
initialize(INITIALIZE_VALUES);
}
- // @formatter:off
+ private static final Semaphore inCritical = new Semaphore(1, false);
+
public Object invokeCall(SymbolInfo symbolInfo, Object[] args) throws Throwable {
long address = symbolInfo.address;
- switch (args.length) {
+ try {
+ inCritical.acquire();
+ switch (args.length) {
+ // @formatter:off
case 0: return call0(address);
case 1: return call1(address, args[0]);
case 2: return call2(address, args[0], args[1]);
@@ -89,32 +97,54 @@ public class CallRFFIWithJNI implements CallRFFI {
case 9: return call9(address, args[0], args[1], args[2], args[3], args[4], args[5], args[6], args[7], args[8]);
default:
return call(address, args);
+ // @formatter:on
+ }
+ } finally {
+ inCritical.release();
}
}
public Object invokeExternal(SymbolInfo symbolInfo, Object[] args) throws Throwable {
- assert false;
- return null;
+ throw RInternalError.unimplemented(".External");
}
private static native void initialize(Object[] initialValues);
+
private static native Object call(long address, Object[] args);
+
private static native Object call0(long address);
+
private static native Object call1(long address, Object arg1);
+
private static native Object call2(long address, Object arg1, Object arg2);
- private static native Object call3(long address, Object arg1, Object arg2, Object arg3);
- private static native Object call4(long address, Object arg1, Object arg2, Object arg3, Object arg4);
- private static native Object call5(long address, Object arg1, Object arg2, Object arg3, Object arg4, Object arg5);
- private static native Object call6(long address, Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6);
- private static native Object call7(long address, Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7);
- private static native Object call8(long address, Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8);
- private static native Object call9(long address, Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9);
+
+ private static native Object call3(long address, Object arg1, Object arg2, Object arg3);
+
+ private static native Object call4(long address, Object arg1, Object arg2, Object arg3, Object arg4);
+
+ private static native Object call5(long address, Object arg1, Object arg2, Object arg3, Object arg4, Object arg5);
+
+ private static native Object call6(long address, Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6);
+
+ private static native Object call7(long address, Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7);
+
+ private static native Object call8(long address, Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8);
+
+ private static native Object call9(long address, Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9);
public void invokeVoidCall(SymbolInfo symbolInfo, Object[] args) throws Throwable {
long address = symbolInfo.address;
- switch (args.length) {
- case 1: callVoid1(address, args[0]); break;
- default: assert false;
+ try {
+ inCritical.acquire();
+ switch (args.length) {
+ case 1:
+ callVoid1(address, args[0]);
+ break;
+ default:
+ throw RInternalError.shouldNotReachHere();
+ }
+ } finally {
+ inCritical.release();
}
}
diff --git a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/JNR_RFFIFactory.java b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/JNR_RFFIFactory.java
index 09e818401f..5ab5cb3101 100644
--- a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/JNR_RFFIFactory.java
+++ b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/JNR_RFFIFactory.java
@@ -25,6 +25,7 @@ package com.oracle.truffle.r.runtime.ffi.jnr;
import java.io.*;
import java.nio.*;
import java.util.*;
+import java.util.concurrent.*;
import jnr.constants.platform.*;
import jnr.ffi.*;
@@ -33,13 +34,17 @@ import jnr.posix.*;
import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary;
import com.oracle.truffle.r.runtime.*;
+import com.oracle.truffle.r.runtime.RContext.ContextState;
+import com.oracle.truffle.r.runtime.conn.*;
+import com.oracle.truffle.r.runtime.data.*;
+import com.oracle.truffle.r.runtime.env.*;
import com.oracle.truffle.r.runtime.ffi.*;
import com.oracle.truffle.r.runtime.ffi.DLL.DLLInfo;
/**
* JNR/JNI-based factory.
*/
-public class JNR_RFFIFactory extends RFFIFactory implements RFFI, BaseRFFI, StatsRFFI, RApplRFFI, LapackRFFI, UserRngRFFI, PCRERFFI {
+public class JNR_RFFIFactory extends RFFIFactory implements RFFI, BaseRFFI, StatsRFFI, ToolsRFFI, RApplRFFI, LapackRFFI, UserRngRFFI, PCRERFFI {
public JNR_RFFIFactory() {
}
@@ -50,6 +55,17 @@ public class JNR_RFFIFactory extends RFFIFactory implements RFFI, BaseRFFI, Stat
getCallRFFI();
}
+ /**
+ * Placeholder class for context-specific native state.
+ */
+ private static class ContextStateImpl implements RContext.ContextState {
+
+ }
+
+ public ContextState newContext(RContext context, Object... objects) {
+ return new ContextStateImpl();
+ }
+
private static byte[] wrapChar(char v) {
return new byte[]{(byte) v};
}
@@ -468,6 +484,50 @@ public class JNR_RFFIFactory extends RFFIFactory implements RFFI, BaseRFFI, Stat
return stats().fft_work(a, wrapInt(nseg), wrapInt(n), wrapInt(nspn), wrapInt(isn), work, iwork);
}
+ // Tools
+
+ @Override
+ public ToolsRFFI getToolsRFFI() {
+ return this;
+ }
+
+ private static class ToolsProvider {
+ private static ToolsProvider tools;
+ private static DLL.SymbolInfo parseRd;
+
+ @TruffleBoundary
+ private ToolsProvider() {
+ System.load(LibPaths.getPackageLibPath("tools"));
+ parseRd = DLL.findSymbolInfo("C_parseRd", "tools");
+ }
+
+ static ToolsProvider toolsProvider() {
+ if (tools == null) {
+ tools = new ToolsProvider();
+ }
+ return tools;
+ }
+
+ DLL.SymbolInfo getParseRd() {
+ return parseRd;
+ }
+
+ }
+
+ private static final Semaphore parseRdCritical = new Semaphore(1, false);
+
+ public Object parseRd(RConnection con, REnvironment srcfile, RLogicalVector verbose, RLogicalVector fragment, RStringVector basename, RLogicalVector warningCalls) {
+ // The C code is not thread safe.
+ try {
+ parseRdCritical.acquire();
+ return getCallRFFI().invokeCall(ToolsProvider.toolsProvider().getParseRd(), new Object[]{con, srcfile, verbose, fragment, basename, warningCalls});
+ } catch (Throwable ex) {
+ throw RInternalError.shouldNotReachHere();
+ } finally {
+ parseRdCritical.release();
+ }
+ }
+
/*
* UserRng. This is a singleton instance, although the actual library may vary from run to run.
*/
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RContext.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RContext.java
index 2bf42fbe84..016dcd0ea1 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RContext.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RContext.java
@@ -39,6 +39,7 @@ import com.oracle.truffle.r.runtime.data.RPromise.Closure;
import com.oracle.truffle.r.runtime.env.*;
import com.oracle.truffle.r.runtime.env.frame.*;
import com.oracle.truffle.r.runtime.env.REnvironment.*;
+import com.oracle.truffle.r.runtime.ffi.*;
import com.oracle.truffle.r.runtime.rng.*;
/**
@@ -368,7 +369,8 @@ public final class RContext extends ExecutionContext {
RConnection(ConnectionSupport.class, false),
StdConnections(StdConnections.class, true),
RNG(RRNG.class, false),
- FrameSlotChangeMonitor(FrameSlotChangeMonitor.class, false);
+ FrameSlotChangeMonitor(FrameSlotChangeMonitor.class, false),
+ RFFI(RFFIContextStateFactory.class, false);
private final Class<? extends StateFactory> klass;
private StateFactory factory;
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFI.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFI.java
index fe9ea68616..17e532bf6b 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFI.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFI.java
@@ -31,6 +31,7 @@ package com.oracle.truffle.r.runtime.ffi;
* <li>{@link LapackRFFI}: the specific, typed, foreign functions required by the built-in
* {@code Lapack} functions.</li>
* <li>{@link StatsRFFI}: native functions in the {@code stats} package.</li>
+ * <li>{@link ToolsRFFI}: native functions in the {@code tools} package.</li>
* <li>{@link RApplRFFI}: the specific, typed, foreign functions required by the built-in
* {@code Linpack} functions.</li>
* <li>{@link CRFFI}: {@code .C} and {@code .Fortran} call interface.</li>
@@ -51,6 +52,8 @@ public interface RFFI {
StatsRFFI getStatsRFFI();
+ ToolsRFFI getToolsRFFI();
+
CRFFI getCRFFI();
CallRFFI getCallRFFI();
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFIContextStateFactory.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFIContextStateFactory.java
new file mode 100644
index 0000000000..b2fc96982c
--- /dev/null
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFIContextStateFactory.java
@@ -0,0 +1,52 @@
+/*
+ * Copyright (c) 2014, 2015, 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
+ * under the terms of the GNU General Public License version 2 only, as
+ * published by the Free Software Foundation.
+ *
+ * This code is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+ * version 2 for more details (a copy is included in the LICENSE file that
+ * accompanied this code).
+ *
+ * You should have received a copy of the GNU General Public License version
+ * 2 along with this work; if not, write to the Free Software Foundation,
+ * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA.
+ *
+ * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA
+ * or visit www.oracle.com if you need additional information or have any
+ * questions.
+ */
+package com.oracle.truffle.r.runtime.ffi;
+
+import com.oracle.truffle.r.runtime.*;
+import com.oracle.truffle.r.runtime.RContext.*;
+
+/**
+ * This is the factory-independent class referenced by {@link RContext} that manages the
+ * context-specific state for any given {@link RFFIFactory}. It simply forwards the calls to the
+ * actual factory.
+ */
+public class RFFIContextStateFactory implements StateFactory {
+ private static RFFIFactory theFactory;
+
+ public static void registerFactory(RFFIFactory factory) {
+ theFactory = factory;
+ }
+
+ public ContextState newContext(RContext context, Object... objects) {
+ return theFactory.newContext(context, objects);
+ }
+
+ public void systemInitialized(RContext context, ContextState state) {
+ theFactory.systemInitialized(context, state);
+ }
+
+ public void beforeDestroy(RContext context, ContextState state) {
+ theFactory.beforeDestroy(context, state);
+ }
+
+}
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFIFactory.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFIFactory.java
index 026d07024f..9433a030b5 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFIFactory.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFIFactory.java
@@ -30,12 +30,18 @@ import com.oracle.truffle.r.runtime.*;
/**
* Factory class for the different possible implementations of the {@link RFFI} interface. The
* choice of factory is made by the R engine and set here by the call to {@link #setRFFIFactory}.
+ *
+ * The RFFI may need to do special things in the case of multiple contexts, hence any given factory
+ * must support the {@link com.oracle.truffle.r.runtime.RContext.StateFactory} interface. However,
+ * since we don't know exactly which factory will be used, {@link RContext} references the
+ * {@link RFFIContextStateFactory} class.
*/
-public abstract class RFFIFactory {
+public abstract class RFFIFactory implements RContext.StateFactory {
protected static RFFI theRFFI;
public static void setRFFIFactory(RFFIFactory factory) {
+ RFFIContextStateFactory.registerFactory(factory);
theRFFI = factory.createRFFI();
}
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/StatsRFFI.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/StatsRFFI.java
index bc8d2c3300..a796d4fb61 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/StatsRFFI.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/StatsRFFI.java
@@ -23,7 +23,7 @@
package com.oracle.truffle.r.runtime.ffi;
/**
- * Interface to native (C) methods provides by the {@code stats} package.
+ * Interface to native (C) methods provided by the {@code stats} package.
*/
public interface StatsRFFI {
// Checkstyle: stop method name
diff --git a/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/tools/ToolsNative.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/ToolsRFFI.java
similarity index 55%
rename from com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/tools/ToolsNative.java
rename to com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/ToolsRFFI.java
index 6a542e825a..45bf274c10 100644
--- a/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/tools/ToolsNative.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/ToolsRFFI.java
@@ -20,27 +20,23 @@
* or visit www.oracle.com if you need additional information or have any
* questions.
*/
-package com.oracle.truffle.r.library.tools;
+package com.oracle.truffle.r.runtime.ffi;
import com.oracle.truffle.r.runtime.conn.*;
+import com.oracle.truffle.r.runtime.data.*;
import com.oracle.truffle.r.runtime.env.*;
-import com.oracle.truffle.r.runtime.ffi.*;
-
-public class ToolsNative {
- private static ToolsNative singleton;
-
- static ToolsNative provider() {
- if (singleton == null) {
- singleton = new ToolsNative();
- System.load(LibPaths.getPackageLibPath("tools"));
- }
- return singleton;
- }
-
- Object cParseRd(RConnection con, REnvironment srcfile, boolean verbose, boolean fragment, String basename, boolean warningCalls) {
- return cParseRdNative(con, srcfile, verbose, fragment, basename, warningCalls);
- }
-
- private static native Object cParseRdNative(RConnection con, REnvironment srcfile, boolean verbose, boolean fragment, String basename, boolean warningCalls);
+/**
+ * Interface to native (C) methods provided by the {@code tools} package.
+ */
+public interface ToolsRFFI {
+ /**
+ * This invokes the Rd parser, written in C, and part of GnuR, that does its work using the R
+ * FFI interface. The R code initially invokes this via {@code .External2(C_parseRd, ...)},
+ * which has a custom specialization in the implementation of the {@code .External2} buitin.
+ * That does some work in Java, and then calls this method to invoke the actual C code. We can't
+ * go straight to the GnuR C entry point as that makes GnuR-specific assumptions about, for
+ * example, how connections are implemented.
+ */
+ Object parseRd(RConnection con, REnvironment srcfile, RLogicalVector verbose, RLogicalVector fragment, RStringVector basename, RLogicalVector warningCalls);
}
diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/NAMESPACE b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/NAMESPACE
index 465189b97d..e8d3772855 100644
--- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/NAMESPACE
+++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/NAMESPACE
@@ -2,9 +2,4 @@
useDynLib(testrffi)
## and exported functions
-export(add_int)
-export(add_double)
-export(createIntVector)
-export(createExternalPtr)
-export(getExternalPtrAddr)
-export(test_TYPEOF)
+exportPattern("rffi\\..*")
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 efa57a3383..c3e6f9e793 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
@@ -1,23 +1,23 @@
-add_int <- function(a, b) {
- .Call("add_int", as.integer(a), as.integer(b), PACKAGE = "testrffi")
+rffi.addInt <- function(a, b) {
+ .Call("addInt", as.integer(a), as.integer(b), PACKAGE = "testrffi")
}
-add_double <- function(a, b) {
- .Call("add_double", as.double(a), as.double(b), PACKAGE = "testrffi")
+rffi.addDouble <- function(a, b) {
+ .Call("addDouble", as.double(a), as.double(b), PACKAGE = "testrffi")
}
-createIntVector <- function(n) {
- .Call("createIntVector", as.integer(n), PACKAGE = "testrffi")
+rffi.populateIntVector <- function(n) {
+ .Call("populateIntVector", as.integer(n), PACKAGE = "testrffi")
}
-createExternalPtr <- function(addr, tag, prot) {
+rffi.createExternalPtr <- function(addr, tag, prot) {
.Call("createExternalPtr", as.integer(addr), tag, prot, PACKAGE = "testrffi")
}
-getExternalPtrAddr <- function(eptr) {
+rffi.getExternalPtrAddr <- function(eptr) {
.Call("getExternalPtrAddr", eptr)
}
-test_TYPEOF <- function(x) {
- .Call("test_TYPEOF", x, PACKAGE = "testrffi")
+rffi.TYPEOF <- function(x) {
+ .Call("invoke_TYPEOF", x, 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 9ef4221195..d87674bc95 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
@@ -27,20 +27,27 @@
#include <Rdefines.h>
#include <Rinternals.h>
-SEXP add_int(SEXP a, SEXP b) {
+SEXP addInt(SEXP a, SEXP b) {
int aInt = INTEGER_VALUE(a);
int bInt = INTEGER_VALUE(b);
return ScalarInteger(aInt + bInt);
}
-SEXP add_double(SEXP a, SEXP b) {
+SEXP addDouble(SEXP a, SEXP b) {
double aDouble = NUMERIC_VALUE(a);
double bDouble = NUMERIC_VALUE(b);
return ScalarReal(aDouble + bDouble);
}
-SEXP createIntVector(SEXP n) {
- SEXP v = allocVector(INTSXP, INTEGER_VALUE(n));
+SEXP populateIntVector(SEXP n) {
+ SEXP v;
+ int intN = INTEGER_VALUE(n);
+ PROTECT(v = allocVector(INTSXP, intN));
+ int i;
+ for (i = 0; i < intN; i++) {
+ INTEGER(v)[i] = i;
+ }
+ UNPROTECT(1);
return v;
}
@@ -52,6 +59,6 @@ SEXP getExternalPtrAddr(SEXP eptr) {
return ScalarInteger((int) R_ExternalPtrAddr(eptr));
}
-SEXP test_TYPEOF(SEXP x) {
+SEXP invoke_TYPEOF(SEXP x) {
return ScalarInteger(TYPEOF(x));
}
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 29ca141940..671f41f708 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
@@ -102417,7 +102417,7 @@ attr(,"foo")
[7] 0.35201276 0.16919220 0.93579263 0.26084486
##com.oracle.truffle.r.test.rpackages.TestRPackages.testLoadTestRFFI
-#{ library("testrffi", lib.loc = "com.oracle.truffle.r.test/rpackages/testrlibs_user"); r1 <- add_int(2L, 3L); r2 <- add_double(2, 3); v <- createIntVector(2); v[1] <- 1; v[2] <- 2; detach("package:testrffi"); list(r1, r2, v) }
+#{ 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); detach("package:testrffi"); list(r1, r2, v) }
[[1]]
[1] 5
@@ -102425,7 +102425,7 @@ attr(,"foo")
[1] 5
[[3]]
-[1] 1 2
+[1] 0 1 2 3 4
##com.oracle.truffle.r.test.rpackages.TestRPackages.testLoadVanilla
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/rpackages/TestRPackages.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/rpackages/TestRPackages.java
index 8d68f81b8d..9024a7181d 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/rpackages/TestRPackages.java
+++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/rpackages/TestRPackages.java
@@ -157,7 +157,7 @@ public class TestRPackages extends TestBase {
@Test
public void testLoadTestRFFI() {
assertEval(TestBase.template(
- "{ library(\"testrffi\", lib.loc = \"%0\"); r1 <- add_int(2L, 3L); r2 <- add_double(2, 3); v <- createIntVector(2); v[1] <- 1; v[2] <- 2; detach(\"package:testrffi\"); list(r1, r2, v) }",
+ "{ library(\"testrffi\", lib.loc = \"%0\"); r1 <- rffi.addInt(2L, 3L); r2 <- rffi.addDouble(2, 3); v <- rffi.populateIntVector(5); detach(\"package:testrffi\"); list(r1, r2, v) }",
new String[]{packagePaths.rpackagesLibs.toString()}));
}
--
GitLab