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 bdb2015fbbbfd2f1ae29a8409a35f4df3944aa57..d5522e24ac464009129d58a17c612d804feb70ab 100644
--- a/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c
+++ b/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c
@@ -75,10 +75,10 @@ static jmethodID SYMVALUE_MethodID;
static jmethodID SET_SYMVALUE_MethodID;
static jmethodID SET_STRING_ELT_MethodID;
static jmethodID SET_VECTOR_ELT_MethodID;
-static jmethodID RAW_MethodID;
-static jmethodID INTEGER_MethodID;
-static jmethodID REAL_MethodID;
-static jmethodID LOGICAL_MethodID;
+jmethodID RAW_MethodID;
+jmethodID INTEGER_MethodID;
+jmethodID REAL_MethodID;
+jmethodID LOGICAL_MethodID;
static jmethodID STRING_ELT_MethodID;
static jmethodID VECTOR_ELT_MethodID;
static jmethodID LENGTH_MethodID;
@@ -528,24 +528,25 @@ int Rf_nrows(SEXP x) {
SEXP Rf_protect(SEXP x) {
+ TRACE(TARGp, x);
return x;
}
void Rf_unprotect(int x) {
- // TODO perhaps we can use this
+ TRACE(TARGp, x);
}
void R_ProtectWithIndex(SEXP x, PROTECT_INDEX *y) {
-
+ TRACE(TARGpd, x,y);
}
void R_Reprotect(SEXP x, PROTECT_INDEX y) {
-
+ TRACE(TARGpd, x,y);
}
void Rf_unprotect_ptr(SEXP x) {
- // TODO perhaps we can use this
+ TRACE(TARGp, x);
}
#define BUFSIZE 8192
@@ -1105,58 +1106,28 @@ int SETLEVELS(SEXP x, int v){
int *LOGICAL(SEXP x){
TRACE(TARGp, x);
JNIEnv *thisenv = getEnv();
- jint *data = (jint *) findCopiedObject(thisenv, x);
- if (data == NULL) {
- 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);
- }
+ jint *data = (jint *) getNativeArray(thisenv, x, LGLSXP);
return data;
}
int *INTEGER(SEXP x){
TRACE(TARGp, x);
JNIEnv *thisenv = getEnv();
- 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);
- }
+ jint *data = (jint *) getNativeArray(thisenv, x, INTSXP);
return data;
}
Rbyte *RAW(SEXP x){
JNIEnv *thisenv = getEnv();
- jbyte *data = (jbyte *) findCopiedObject(thisenv, x);
- if (data == NULL) {
- jbyteArray byteArray = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, RAW_MethodID, x);
- int len = (*thisenv)->GetArrayLength(thisenv, byteArray);
- data = (*thisenv)->GetByteArrayElements(thisenv, byteArray, NULL);
- addCopiedObject(thisenv, x, RAWSXP, byteArray, data);
- }
- return (Rbyte*) data;
+ Rbyte *data = (Rbyte*) getNativeArray(thisenv, x, RAWSXP);
+ return data;
}
double *REAL(SEXP x){
JNIEnv *thisenv = getEnv();
- jdouble *data = (jdouble *) findCopiedObject(thisenv, x);
- if (data == NULL) {
- jdoubleArray doubleArray = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, REAL_MethodID, x);
- int len = (*thisenv)->GetArrayLength(thisenv, doubleArray);
- data = (*thisenv)->GetDoubleArrayElements(thisenv, doubleArray, NULL);
- addCopiedObject(thisenv, x, REALSXP, doubleArray, data);
- }
+ jdouble *data = (jdouble *) getNativeArray(thisenv, x, REALSXP);
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 9640c79cbb77f77dcb24ee6e32f1d5282b818301..43f13021a505226076c73c73e19162c98ce54186 100644
--- a/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.c
+++ b/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.c
@@ -30,8 +30,7 @@
* that needs to be saved for reuse in the many R functions such as Rf_allocVector.
* Currently only single threaded access is permitted (via a semaphore in CallRFFIWithJNI)
* so we are safe to use static variables. TODO Figure out where to store such state
- * (portably) for MT use. JNI provides no help. N.B. The MT restriction also precludes
- * recursive calls.
+ * (portably) for MT use. JNI provides no help.
*/
jclass CallRFFIHelperClass;
jclass RDataFactoryClass;
@@ -54,26 +53,37 @@ static int alwaysUseGlobal = 0;
static SEXP *cachedGlobalRefs;
static int cachedGlobalRefsLength;
-typedef struct CopiedVectors_struct {
+// Data structure for managing the required copying of
+// Java arrays to return C arrays, e.g, int*.
+// N.B. There are actually two levels to this as FastR
+// wraps, e.g., int[] in an RIntVector.
+typedef struct nativeArrayTable_struct {
SEXPTYPE type;
- SEXP obj;
- void *jArray;
- void *data;
-} CopiedVector;
+ SEXP obj; // The jobject (SEXP) that data is derived from (e.g, RIntVector)
+ void *jArray; // the jarray corresponding to obj
+ void *data; // the (possibly) copied (or pinned) data from JNI GetXXXArrayElements
+} NativeArrayElem;
-#define COPIED_VECTORS_INITIAL_SIZE 64
+#define NATIVE_ARRAY_TABLE_INITIAL_SIZE 64
// 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;
+static NativeArrayElem *nativeArrayTable;
+// hwm of nativeArrayTable
+static int nativeArrayTableHwm;
+static int nativeArrayTableLength;
+static void releaseNativeArray(JNIEnv *env, int index);
static int isEmbedded = 0;
void setEmbedded() {
isEmbedded = 1;
}
+// native down call depth, indexes nativeArrayTableHwmStack
+int callDepth;
+
+#define NATIVE_ARRAY_TABLE_HWM_STACK_SIZE 16
+int nativeArrayTableHwmStack[NATIVE_ARRAY_TABLE_HWM_STACK_SIZE] ;
+
void init_utils(JNIEnv *env) {
curenv = env;
if (TRACE_ENABLED && traceFile == NULL) {
@@ -92,6 +102,8 @@ void init_utils(JNIEnv *env) {
fprintf(stderr, "%s, %d", "failed to fdopen trace file on JNI side\n", errno);
exit(1);
}
+ // no buffering
+ setvbuf(traceFile, (char*) NULL, _IONBF, 0);
}
}
RDataFactoryClass = checkFindClass(env, "com/oracle/truffle/r/runtime/data/RDataFactory");
@@ -103,9 +115,9 @@ void init_utils(JNIEnv *env) {
validateMethodID = checkGetMethodID(env, CallRFFIHelperClass, "validate", "(Ljava/lang/Object;)Ljava/lang/Object;", 1);
cachedGlobalRefs = calloc(CACHED_GLOBALREFS_INITIAL_SIZE, sizeof(SEXP));
cachedGlobalRefsLength = CACHED_GLOBALREFS_INITIAL_SIZE;
- copiedVectors = calloc(COPIED_VECTORS_INITIAL_SIZE, sizeof(CopiedVector));
- copiedVectorsLength = COPIED_VECTORS_INITIAL_SIZE;
- copiedVectorsIndex = 0;
+ nativeArrayTable = calloc(NATIVE_ARRAY_TABLE_INITIAL_SIZE, sizeof(NativeArrayElem));
+ nativeArrayTableLength = NATIVE_ARRAY_TABLE_INITIAL_SIZE;
+ nativeArrayTableHwm = 0;
}
const char *stringToChars(JNIEnv *jniEnv, jstring string) {
@@ -123,18 +135,147 @@ const char *stringToChars(JNIEnv *jniEnv, jstring string) {
void callEnter(JNIEnv *env, jmp_buf *jmpbuf) {
setEnv(env);
callErrorJmpBuf = jmpbuf;
-// printf("callEnter\n");
+ if (callDepth >= NATIVE_ARRAY_TABLE_HWM_STACK_SIZE) {
+ fatalError("call stack overflow\n");
+ }
+ nativeArrayTableHwmStack[callDepth] = nativeArrayTableHwm;
+ callDepth++;
}
jmp_buf *getErrorJmpBuf() {
return callErrorJmpBuf;
}
-void releaseCopiedVector(JNIEnv *env, CopiedVector cv) {
- if (cv.obj != NULL) {
-#if TRACE_COPIES
- fprintf(traceFile, "releaseCopiedVector(%p)\n", cv.obj);
+void callExit(JNIEnv *env) {
+ int oldHwm = nativeArrayTableHwmStack[callDepth - 1];
+ for (int i = oldHwm; i < nativeArrayTableHwm; i++) {
+ releaseNativeArray(env, i);
+ }
+ nativeArrayTableHwm = oldHwm;
+ callDepth--;
+}
+
+void invalidateNativeArray(JNIEnv *env, SEXP oldObj) {
+ int i;
+ for (i = 0; i < nativeArrayTableHwm; i++) {
+ NativeArrayElem cv = nativeArrayTable[i];
+ if ((*env)->IsSameObject(env, cv.obj, oldObj)) {
+#if TRACE_NATIVE_ARRAYS
+ fprintf(traceFile, "invalidateNativeArray(%p): found\n", oldObj);
+#endif
+ releaseNativeArray(env, &cv);
+ nativeArrayTable[i].obj = NULL;
+ }
+ }
+#if TRACE_NATIVE_ARRAYS
+ fprintf(traceFile, "invalidateNativeArray(%p): not found\n", oldObj);
+#endif
+}
+
+static void *findNativeArray(JNIEnv *env, SEXP x) {
+ int i;
+ for (i = 0; i < nativeArrayTableHwm; i++) {
+ NativeArrayElem cv = nativeArrayTable[i];
+ if (cv.obj != NULL) {
+ if ((*env)->IsSameObject(env, cv.obj, x)) {
+ void *data = cv.data;
+#if TRACE_NATIVE_ARRAYS
+ fprintf(traceFile, "findNativeArray(%p): found %p\n", x, data);
+#endif
+ return data;
+ }
+ }
+ }
+#if TRACE_NATIVE_ARRAYS
+ fprintf(traceFile, "findNativeArray(%p): not found\n", x);
+#endif
+ return NULL;
+}
+
+static void addNativeArray(JNIEnv *env, SEXP x, SEXPTYPE type, void *jArray, void *data) {
+#if TRACE_NATIVE_ARRAYS
+ fprintf(traceFile, "addNativeArray(x=%p, t=%p, ix=%d)\n", x, data, nativeArrayTableHwm);
+#endif
+ // check for overflow
+ if (nativeArrayTableHwm >= nativeArrayTableLength) {
+ int newLength = 2 * nativeArrayTableLength;
+ NativeArrayElem *newnativeArrayTable = calloc(newLength, sizeof(NativeArrayElem));
+ if (newnativeArrayTable == NULL) {
+ fatalError("FFI copied vectors table expansion failure");
+ }
+ memcpy(newnativeArrayTable, nativeArrayTable, nativeArrayTableLength * sizeof(NativeArrayElem));
+ free(nativeArrayTable);
+ nativeArrayTable = newnativeArrayTable;
+ nativeArrayTableLength = newLength;
+ }
+ nativeArrayTable[nativeArrayTableHwm].obj = x;
+ nativeArrayTable[nativeArrayTableHwm].data = data;
+ nativeArrayTable[nativeArrayTableHwm].type = type;
+ nativeArrayTable[nativeArrayTableHwm].jArray = jArray;
+ nativeArrayTableHwm++;
+}
+
+void *getNativeArray(JNIEnv *thisenv, SEXP x, SEXPTYPE type) {
+ void *data = findNativeArray(thisenv, x);
+ jboolean isCopy;
+ if (data == NULL) {
+ jarray jArray;
+ switch (type) {
+ case INTSXP: {
+ jintArray intArray = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, INTEGER_MethodID, x);
+ int len = (*thisenv)->GetArrayLength(thisenv, intArray);
+ data = (*thisenv)->GetIntArrayElements(thisenv, intArray, &isCopy);
+ jArray = intArray;
+ break;
+ }
+
+ case REALSXP: {
+ jdoubleArray doubleArray = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, REAL_MethodID, x);
+ int len = (*thisenv)->GetArrayLength(thisenv, doubleArray);
+ data = (*thisenv)->GetDoubleArrayElements(thisenv, doubleArray, &isCopy);
+ jArray = doubleArray;
+ break;
+ }
+
+ case RAWSXP: {
+ jbyteArray byteArray = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, RAW_MethodID, x);
+ int len = (*thisenv)->GetArrayLength(thisenv, byteArray);
+ data = (*thisenv)->GetByteArrayElements(thisenv, byteArray, &isCopy);
+ jArray = byteArray;
+ break;
+ }
+
+ case LGLSXP: {
+ // Special treatment becuase R FFI wants int* and FastR represents using byte[]
+ jbyteArray byteArray = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, LOGICAL_MethodID, x);
+ int len = (*thisenv)->GetArrayLength(thisenv, byteArray);
+ jbyte* internalData = (*thisenv)->GetByteArrayElements(thisenv, byteArray, &isCopy);
+ int* idata = malloc(len * sizeof(int));
+ for (int i = 0; i < len; i++) {
+ char value = internalData[i];
+ idata[i] = value == 0 ? FALSE : value == 1 ? TRUE : NA_INTEGER;
+ }
+ (*thisenv)->ReleaseByteArrayElements(thisenv, byteArray, internalData, JNI_ABORT);
+ jArray = byteArray;
+ data = idata;
+ break;
+ }
+
+ default:
+ fatalError("getNativeArray: unexpected type");
+
+ }
+ addNativeArray(thisenv, x, type, jArray, data);
+ }
+ return data;
+}
+
+static void releaseNativeArray(JNIEnv *env, int i) {
+ NativeArrayElem cv = nativeArrayTable[i];
+#if TRACE_NATIVE_ARRAYS
+ fprintf(traceFile, "releaseNativeArray(x=%p, ix=%d)\n", cv.obj, i);
#endif
+ if (cv.obj != NULL) {
switch (cv.type) {
case INTSXP: {
jintArray intArray = (jintArray) cv.jArray;
@@ -152,6 +293,7 @@ void releaseCopiedVector(JNIEnv *env, CopiedVector cv) {
internalData[i] = data[i] == NA_INTEGER ? 255 : (jbyte) data[i];
}
(*env)->ReleaseByteArrayElements(env, byteArray, internalData, 0);
+ free(data); // was malloc'ed in addNativeArray
break;
}
@@ -169,78 +311,11 @@ void releaseCopiedVector(JNIEnv *env, CopiedVector cv) {
}
default:
- fatalError("copiedVector type");
- }
- }
-}
-
-void callExit(JNIEnv *env) {
-// fprintf(traceFile, "callExit\n");
- int i;
- for (i = 0; i < copiedVectorsIndex; i++) {
- releaseCopiedVector(env, copiedVectors[i]);
- }
- copiedVectorsIndex = 0;
-}
-
-void invalidateCopiedObject(JNIEnv *env, SEXP oldObj) {
- int i;
- for (i = 0; i < copiedVectorsIndex; i++) {
- CopiedVector cv = copiedVectors[i];
- if ((*env)->IsSameObject(env, cv.obj, oldObj)) {
-#if TRACE_COPIES
- fprintf(traceFile, "invalidateCopiedObject(%p): found\n", oldObj);
-#endif
- releaseCopiedVector(env, cv);
- copiedVectors[i].obj = NULL;
- }
- }
-#if TRACE_COPIES
- fprintf(traceFile, "invalidateCopiedObject(%p): not found\n", oldObj);
-#endif
-}
-
-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
- fprintf(traceFile, "findCopiedObject(%p): found %p\n", x, data);
-#endif
- return data;
- }
- }
-#if TRACE_COPIES
- fprintf(traceFile, "findCopiedObject(%p): not found\n", x);
-#endif
- return NULL;
-}
-
-void addCopiedObject(JNIEnv *env, SEXP x, SEXPTYPE type, void *jArray, void *data) {
-#if TRACE_COPIES
- fprintf(traceFile, "addCopiedObject(%p, %p)\n", x, data);
-#endif
- if (copiedVectorsIndex >= copiedVectorsLength) {
- int newLength = 2 * copiedVectorsLength;
- CopiedVector *newCopiedVectors = calloc(newLength, sizeof(CopiedVector));
- if (newCopiedVectors == NULL) {
- fatalError("FFI copied vectors table expansion failure");
+ fatalError("releaseNativeArray type");
}
- memcpy(newCopiedVectors, copiedVectors, copiedVectorsLength * sizeof(CopiedVector));
- free(copiedVectors);
- copiedVectors = newCopiedVectors;
- copiedVectorsLength = newLength;
+ // free up the slot
+ cv.obj = NULL;
}
- copiedVectors[copiedVectorsIndex].obj = x;
- copiedVectors[copiedVectorsIndex].data = data;
- copiedVectors[copiedVectorsIndex].type = type;
- copiedVectors[copiedVectorsIndex].jArray = jArray;
- copiedVectorsIndex++;
-#if TRACE_COPIES
- fprintf(traceFile, "copiedVectorsIndex: %d\n", copiedVectorsIndex);
-#endif
}
static SEXP checkCachedGlobalRef(JNIEnv *env, SEXP obj, int useGlobal) {
diff --git a/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.h b/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.h
index bc3ba3dbd35922ddc7ba31ba2b1c91fb3ee4176e..62da16cdcf08af4579691d82e5b5d7b427c627f7 100644
--- a/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.h
+++ b/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.h
@@ -62,11 +62,12 @@ void allocExit();
jmp_buf *getErrorJmpBuf();
-// 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 invalidateCopiedObject(JNIEnv *env, SEXP oldObj);
+// Given the x denotes an R vector type, return a pointer to
+// the data as a C array
+void *getNativeArray(JNIEnv *env, SEXP x, SEXPTYPE type);
+// Rare case where an operation changes the internal
+// data and thus the old C array should be invalidated
+void invalidateNativeArray(JNIEnv *env, SEXP oldObj);
void init_rmath(JNIEnv *env);
void init_variables(JNIEnv *env, jobjectArray initialValues);
@@ -88,8 +89,8 @@ extern FILE *traceFile;
// tracing/debugging support, set to 1 and recompile to enable
#define TRACE_UPCALLS 0 // trace upcalls
#define TRACE_REF_CACHE 0 // trace JNI reference cache
-#define TRACE_COPIES 0 // trace copying of internal arrays
-#define TRACE_ENABLED TRACE_UPCALLS || TRACE_REF_CACHE || TRACE_COPIES
+#define TRACE_NATIVE_ARRAYS 0 // trace generation of internal arrays
+#define TRACE_ENABLED TRACE_UPCALLS || TRACE_REF_CACHE || TRACE_NATIVE_ARRAYS
#define TARGp "%s(%p)\n"
#define TARGpp "%s(%p, %p)\n"
@@ -111,4 +112,11 @@ extern FILE *traceFile;
// convert a string into a char*
const char *stringToChars(JNIEnv *jniEnv, jstring string);
+extern jmethodID INTEGER_MethodID;
+extern jmethodID LOGICAL_MethodID;
+extern jmethodID REAL_MethodID;
+extern jmethodID RAW_MethodID;
+
+extern int callDepth;
+
#endif /* RFFIUTILS_H */