diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/shell/RCommand.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/shell/RCommand.java
index ee7e0b1aedda41b65891cb4b3a5bc8577e71819d..e57311a77fa0d86af77c5cdba35562896f8a214e 100644
--- a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/shell/RCommand.java
+++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/shell/RCommand.java
@@ -243,15 +243,12 @@ public class RCommand {
* logging the report will go to a file, so we print a message on
* the console as well.
*/
- consoleHandler.println("internal error: " + e.getMessage() + " (see fastr_errors.log)");
RInternalError.reportError(e);
+ consoleHandler.println("internal error: " + e.getMessage() + " (see fastr_errors.log)");
} else {
- /*
- * This should never happen owing to earlier invariants of
- * converting everything else to an RInternalError
- */
- consoleHandler.println("unexpected internal error (" + e.getClass().getSimpleName() + "); " + e.getMessage());
+ // Something else, e.g. NPE
RInternalError.reportError(e);
+ consoleHandler.println("unexpected internal error (" + e.getClass().getSimpleName() + "); " + e.getMessage());
}
}
continue REPL;
diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/shell/REmbedded.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/shell/REmbedded.java
index 2dd95afdfd4df88f31ad901f94fe40fb6a7ef702..7f13d4cc0f93bb2c8b72a004ee5e31b184fadcda 100644
--- a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/shell/REmbedded.java
+++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/shell/REmbedded.java
@@ -114,9 +114,12 @@ public class REmbedded {
runRmainloop(vm);
}
+ /**
+ * Upcalled from embedded mode to commit suicide.
+ */
@SuppressWarnings("unused")
private static void R_Suicide(String msg) {
- // TODO implement
+ Utils.exit(2);
}
}
diff --git a/com.oracle.truffle.r.native/fficall/src/jni/Rembedded.c b/com.oracle.truffle.r.native/fficall/src/jni/Rembedded.c
index 3b1cbfe0ac19ce8b186f0c02724e04fc4b760128..785fdab402c221fc64eddde824297b5d61287b8a 100644
--- a/com.oracle.truffle.r.native/fficall/src/jni/Rembedded.c
+++ b/com.oracle.truffle.r.native/fficall/src/jni/Rembedded.c
@@ -438,6 +438,10 @@ JNIEXPORT void JNICALL Java_com_oracle_truffle_r_runtime_ffi_jnr_JNI_1REmbed_nat
(*ptr_R_CleanUp)(x, y, z);
}
+JNIEXPORT void JNICALL Java_com_oracle_truffle_r_runtime_ffi_jnr_JNI_1REmbed_nativeSuicide(JNIEnv *jniEnv, jclass c, jstring string) {
+ const char *cbuf = (*jniEnv)->GetStringUTFChars(jniEnv, string, NULL);
+ (*ptr_R_Suicide)(cbuf);
+}
void uR_PolledEvents(void) {
unimplemented("R_PolledEvents");
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 3d88384fb1884329d4ecc2119451e47704ea5633..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,121 +135,187 @@ 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) {
- switch (cv.type) {
- 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;
- (*env)->ReleaseDoubleArrayElements(env, doubleArray, (jdouble *)cv.data, 0);
- break;
-
- }
-
- case RAWSXP: {
- jbyteArray byteArray = (jbyteArray) cv.jArray;
- (*env)->ReleaseByteArrayElements(env, byteArray, (jbyte *)cv.data, 0);
- break;
-
- }
- default:
- fatalError("copiedVector type");
- }
- }
-}
-
void callExit(JNIEnv *env) {
-// fprintf(traceFile, "callExit\n");
- int i;
- for (i = 0; i < copiedVectorsIndex; i++) {
- releaseCopiedVector(env, copiedVectors[i]);
+ int oldHwm = nativeArrayTableHwmStack[callDepth - 1];
+ for (int i = oldHwm; i < nativeArrayTableHwm; i++) {
+ releaseNativeArray(env, i);
}
- copiedVectorsIndex = 0;
+ nativeArrayTableHwm = oldHwm;
+ callDepth--;
}
-void invalidateCopiedObject(JNIEnv *env, SEXP oldObj) {
+void invalidateNativeArray(JNIEnv *env, SEXP oldObj) {
int i;
- for (i = 0; i < copiedVectorsIndex; i++) {
- CopiedVector cv = copiedVectors[i];
+ for (i = 0; i < nativeArrayTableHwm; i++) {
+ NativeArrayElem cv = nativeArrayTable[i];
if ((*env)->IsSameObject(env, cv.obj, oldObj)) {
-#if TRACE_COPIES
- fprintf(traceFile, "invalidateCopiedObject(%p): found\n", oldObj);
+#if TRACE_NATIVE_ARRAYS
+ fprintf(traceFile, "invalidateNativeArray(%p): found\n", oldObj);
#endif
- releaseCopiedVector(env, cv);
- copiedVectors[i].obj = NULL;
+ releaseNativeArray(env, &cv);
+ nativeArrayTable[i].obj = NULL;
}
}
-#if TRACE_COPIES
- fprintf(traceFile, "invalidateCopiedObject(%p): not found\n", oldObj);
+#if TRACE_NATIVE_ARRAYS
+ fprintf(traceFile, "invalidateNativeArray(%p): not found\n", oldObj);
#endif
}
-void *findCopiedObject(JNIEnv *env, SEXP x) {
+static void *findNativeArray(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);
+ 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;
+ return data;
+ }
}
}
-#if TRACE_COPIES
- fprintf(traceFile, "findCopiedObject(%p): not found\n", x);
+#if TRACE_NATIVE_ARRAYS
+ fprintf(traceFile, "findNativeArray(%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);
+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
- if (copiedVectorsIndex >= copiedVectorsLength) {
- int newLength = 2 * copiedVectorsLength;
- CopiedVector *newCopiedVectors = calloc(newLength, sizeof(CopiedVector));
- if (newCopiedVectors == NULL) {
+ // 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(newCopiedVectors, copiedVectors, copiedVectorsLength * sizeof(CopiedVector));
- free(copiedVectors);
- copiedVectors = newCopiedVectors;
- copiedVectorsLength = newLength;
+ memcpy(newnativeArrayTable, nativeArrayTable, nativeArrayTableLength * sizeof(NativeArrayElem));
+ free(nativeArrayTable);
+ nativeArrayTable = newnativeArrayTable;
+ nativeArrayTableLength = newLength;
}
- 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);
+ 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;
+ (*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);
+ free(data); // was malloc'ed in addNativeArray
+ break;
+ }
+
+ case REALSXP: {
+ jdoubleArray doubleArray = (jdoubleArray) cv.jArray;
+ (*env)->ReleaseDoubleArrayElements(env, doubleArray, (jdouble *)cv.data, 0);
+ break;
+
+ }
+
+ case RAWSXP: {
+ jbyteArray byteArray = (jbyteArray) cv.jArray;
+ (*env)->ReleaseByteArrayElements(env, byteArray, (jbyte *)cv.data, 0);
+ break;
+
+ }
+ default:
+ fatalError("releaseNativeArray type");
+ }
+ // free up the slot
+ cv.obj = NULL;
+ }
}
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 ee3ee6a5b7c9e200364beb863db28c61f9c19bee..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);
@@ -86,10 +87,10 @@ extern jclass RRuntimeClass;
extern FILE *traceFile;
// tracing/debugging support, set to 1 and recompile to enable
-#define TRACE_UPCALLS 1 // trace upcalls
+#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 */
diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Gc.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Gc.java
index 6de029a68e68a984b81fcd88e9c16c1421cbc9a7..c2f7807c20c3beed3310ea433b4780382dab178e 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Gc.java
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Gc.java
@@ -40,9 +40,7 @@ public abstract class Gc extends RBuiltinNode {
@SuppressWarnings("unused")
@Specialization
protected RDoubleVector gc(RAbstractLogicalVector verbose, RAbstractLogicalVector reset) {
- // manually triggering gc in Java is typically not a terribly good idea so we don't do it
- // here at all
-
+ System.gc();
// TODO: somehow produce the (semi?) correct values
double[] data = new double[14];
Arrays.fill(data, RRuntime.DOUBLE_NA);
diff --git a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/RFFIUtils.java b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/RFFIUtils.java
index 07e8dfbf1bd9c0c7335de2aee6b139a4e18e67d8..227c57c707f1194a82ff8aacab27d17ae03d6a09 100644
--- a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/RFFIUtils.java
+++ b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/RFFIUtils.java
@@ -25,9 +25,12 @@ package com.oracle.truffle.r.runtime.ffi;
import java.io.FileDescriptor;
import java.io.FileOutputStream;
import java.io.IOException;
-import java.io.PrintStream;
+import java.io.OutputStream;
+import java.nio.file.Path;
+
import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary;
import com.oracle.truffle.r.runtime.FastROptions;
+import com.oracle.truffle.r.runtime.Utils;
import com.oracle.truffle.r.runtime.context.RContext;
import com.oracle.truffle.r.runtime.data.RPairList;
import com.oracle.truffle.r.runtime.data.RSymbol;
@@ -58,24 +61,20 @@ public class RFFIUtils {
* In embedded mode can't trust that cwd is writeable, so output placed in /tmp. Also, tag with
* time in event of multiple concurrent instances (which happens with RStudio).
*/
- private static final String tracePathPrefix = "/tmp/fastr_trace_nativecalls.log-";
- private static FileOutputStream traceFileStream;
- private static PrintStream traceStream;
+ private static final String TRACEFILE = "fastr_trace_nativecalls.log";
+ private static OutputStream traceStream;
+ /**
+ * Records the call depth. TBD: make context specific
+ */
+ private static int depth;
- private static void initialize() {
+ public static void initialize() {
if (!initialized) {
traceEnabled = alwaysTrace || FastROptions.TraceNativeCalls.getBooleanValue();
if (traceEnabled) {
if (RContext.isEmbedded()) {
if (traceStream == null) {
- String tracePath = tracePathPrefix + Long.toString(System.currentTimeMillis());
- try {
- traceFileStream = new FileOutputStream(tracePath);
- traceStream = new PrintStream(traceFileStream);
- } catch (IOException ex) {
- System.err.println(ex.getMessage());
- System.exit(1);
- }
+ initTraceStream();
}
} else {
traceStream = System.out;
@@ -85,14 +84,28 @@ public class RFFIUtils {
}
}
+ private static void initTraceStream() {
+ Path tracePath = Utils.getLogPath(TRACEFILE);
+ try {
+ traceStream = new FileOutputStream(tracePath.toString());
+ } catch (IOException ex) {
+ System.err.println(ex.getMessage());
+ System.exit(1);
+ }
+ }
+
/**
- * Upcalled from native when tracing to get FD of the {@link #traceFileStream}. Allows the same
- * fd to be used on both sides of the JNI boundary.
+ * Upcalled from native when tracing to get FD of the {@link #traceStream}. Allows the same fd
+ * to be used on both sides of the JNI boundary.
*/
@SuppressWarnings("unused")
private static FileDescriptor getTraceFileDescriptor() {
try {
- return traceFileStream.getFD();
+ if (traceStream == null) {
+ // Happens if native has tracing enabled and Java does not
+ initTraceStream();
+ }
+ return ((FileOutputStream) traceStream).getFD();
} catch (IOException ex) {
System.err.println(ex.getMessage());
System.exit(1);
@@ -101,10 +114,10 @@ public class RFFIUtils {
}
private enum CallMode {
- UP("Up"),
- UP_RETURN("UpReturn"),
- DOWN("Down"),
- DOWN_RETURN("DownReturn");
+ UP("U"),
+ UP_RETURN("UR"),
+ DOWN("D"),
+ DOWN_RETURN("DR");
private final String printName;
@@ -114,34 +127,45 @@ public class RFFIUtils {
}
public static void traceUpCall(String name, Object... args) {
- traceCall(CallMode.UP, name, args);
+ traceCall(CallMode.UP, name, depth, args);
}
- public static void traceUpCallReturn(String name, Object... args) {
- traceCall(CallMode.UP_RETURN, name, args);
+ public static void traceUpCallReturn(String name, Object result) {
+ traceCall(CallMode.UP_RETURN, name, depth, result);
}
public static void traceDownCall(String name, Object... args) {
- traceCall(CallMode.DOWN, name, args);
+ traceCall(CallMode.DOWN, name, ++depth, args);
+ }
+
+ public static void traceDownCallReturn(String name, Object result) {
+ traceCall(CallMode.DOWN_RETURN, name, depth--, result);
}
public static boolean traceEnabled() {
return traceEnabled;
}
- private static void traceCall(CallMode mode, String name, Object... args) {
- initialize();
+ private static void traceCall(CallMode mode, String name, int depthValue, Object... args) {
+ assert initialized;
if (traceEnabled) {
StringBuffer sb = new StringBuffer();
sb.append("CallRFFI[");
sb.append(mode.printName);
+ sb.append(':');
+ sb.append(depthValue);
sb.append(']');
sb.append(name);
sb.append('(');
printArgs(sb, args);
sb.append(')');
- traceStream.println(sb.toString());
- traceStream.flush();
+ try {
+ traceStream.write(sb.toString().getBytes());
+ traceStream.write('\n');
+ traceStream.flush();
+ } catch (IOException ex) {
+ // ignore
+ }
}
}
diff --git a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/JNI_CallRFFI.java b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/JNI_CallRFFI.java
index 0964f60ebd84d23a2fd8a7b28791755277029172..eb25283160677833f15438587ba2057b938d8b54 100644
--- a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/JNI_CallRFFI.java
+++ b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/JNI_CallRFFI.java
@@ -23,8 +23,8 @@
package com.oracle.truffle.r.runtime.ffi.jnr;
import static com.oracle.truffle.r.runtime.ffi.RFFIUtils.traceDownCall;
-
-import java.util.concurrent.Semaphore;
+import static com.oracle.truffle.r.runtime.ffi.RFFIUtils.traceDownCallReturn;
+import static com.oracle.truffle.r.runtime.ffi.RFFIUtils.traceEnabled;
import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary;
import com.oracle.truffle.r.runtime.RInternalError;
@@ -32,6 +32,7 @@ import com.oracle.truffle.r.runtime.ffi.CallRFFI;
import com.oracle.truffle.r.runtime.ffi.DLL;
import com.oracle.truffle.r.runtime.ffi.DLL.DLLException;
import com.oracle.truffle.r.runtime.ffi.LibPaths;
+import com.oracle.truffle.r.runtime.ffi.RFFIUtils;
import com.oracle.truffle.r.runtime.ffi.RFFIVariables;
/**
@@ -66,37 +67,48 @@ public class JNI_CallRFFI implements CallRFFI {
throw new RInternalError(ex, "error while loading " + librffiPath);
}
System.load(librffiPath);
- traceDownCall("initialize");
- initialize(RFFIVariables.values());
- }
+ RFFIUtils.initialize();
+ if (traceEnabled()) {
+ traceDownCall("initialize");
+ }
+ try {
+ initialize(RFFIVariables.values());
+ } finally {
+ if (traceEnabled()) {
+ traceDownCallReturn("initialize", null);
+ }
- private static final Semaphore inCritical = new Semaphore(1, false);
+ }
+ }
@Override
- public Object invokeCall(long address, String name, Object[] args) {
- traceDownCall(name, args);
+ public synchronized Object invokeCall(long address, String name, Object[] args) {
+ Object result = null;
+ if (traceEnabled()) {
+ traceDownCall(name, args);
+ }
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]);
- case 3: return call3(address, args[0], args[1], args[2]);
- case 4: return call4(address, args[0], args[1], args[2], args[3]);
- case 5: return call5(address, args[0], args[1], args[2], args[3], args[4]);
- case 6: return call6(address, args[0], args[1], args[2], args[3], args[4], args[5]);
- case 7: return call7(address, args[0], args[1], args[2], args[3], args[4], args[5], args[6]);
- case 8: return call8(address, args[0], args[1], args[2], args[3], args[4], args[5], args[6], args[7]);
- case 9: return call9(address, args[0], args[1], args[2], args[3], args[4], args[5], args[6], args[7], args[8]);
+ case 0: result = call0(address); break;
+ case 1: result = call1(address, args[0]); break;
+ case 2: result = call2(address, args[0], args[1]); break;
+ case 3: result = call3(address, args[0], args[1], args[2]); break;
+ case 4: result = call4(address, args[0], args[1], args[2], args[3]); break;
+ case 5: result = call5(address, args[0], args[1], args[2], args[3], args[4]); break;
+ case 6: result = call6(address, args[0], args[1], args[2], args[3], args[4], args[5]); break;
+ case 7: result = call7(address, args[0], args[1], args[2], args[3], args[4], args[5], args[6]); break;
+ case 8: result = call8(address, args[0], args[1], args[2], args[3], args[4], args[5], args[6], args[7]); break;
+ case 9: result = call9(address, args[0], args[1], args[2], args[3], args[4], args[5], args[6], args[7], args[8]); break;
default:
- return call(address, args);
+ result = call(address, args); break;
// @formatter:on
}
- } catch (InterruptedException ex) {
- throw RInternalError.shouldNotReachHere();
+ return result;
} finally {
- inCritical.release();
+ if (traceEnabled()) {
+ traceDownCallReturn(name, result);
+ }
}
}
@@ -129,10 +141,11 @@ public class JNI_CallRFFI implements CallRFFI {
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);
@Override
- public void invokeVoidCall(long address, String name, Object[] args) {
- traceDownCall(name, args);
+ public synchronized void invokeVoidCall(long address, String name, Object[] args) {
+ if (traceEnabled()) {
+ traceDownCall(name, args);
+ }
try {
- inCritical.acquire();
switch (args.length) {
case 0:
callVoid0(address);
@@ -143,9 +156,10 @@ public class JNI_CallRFFI implements CallRFFI {
default:
throw RInternalError.shouldNotReachHere();
}
- } catch (InterruptedException ex) {
} finally {
- inCritical.release();
+ if (traceEnabled()) {
+ traceDownCallReturn(name, null);
+ }
}
}
@@ -154,27 +168,25 @@ public class JNI_CallRFFI implements CallRFFI {
private static native void callVoid1(long address, Object arg1);
@Override
- public void setTempDir(String tempDir) {
- traceDownCall("setTempDir", tempDir);
- try {
- inCritical.acquire();
- RFFIVariables.setTempDir(tempDir);
- nativeSetTempDir(tempDir);
- } catch (InterruptedException ex) {
- } finally {
- inCritical.release();
+ public synchronized void setTempDir(String tempDir) {
+ if (traceEnabled()) {
+ traceDownCall("setTempDir", tempDir);
+ }
+ RFFIVariables.setTempDir(tempDir);
+ nativeSetTempDir(tempDir);
+ if (traceEnabled()) {
+ traceDownCallReturn("setTempDir", null);
}
}
@Override
- public void setInteractive(boolean interactive) {
- traceDownCall("setInteractive", interactive);
- try {
- inCritical.acquire();
- nativeSetInteractive(interactive);
- } catch (InterruptedException ex) {
- } finally {
- inCritical.release();
+ public synchronized void setInteractive(boolean interactive) {
+ if (traceEnabled()) {
+ traceDownCall("setInteractive", interactive);
+ }
+ nativeSetInteractive(interactive);
+ if (traceEnabled()) {
+ traceDownCallReturn("setInteractive", null);
}
}
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RCmdOptions.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RCmdOptions.java
index b4c1b37c54a42b09e97e252c2ff092e7a8fcf312..9437a68768d529f3211d64ddd7b0f976ff3e7f5b 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RCmdOptions.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RCmdOptions.java
@@ -88,10 +88,6 @@ public final class RCmdOptions {
SLAVE(RCmdOptionType.BOOLEAN, true, "slave", false, "Make R run as quietly as possible"),
INTERACTIVE(RCmdOptionType.BOOLEAN, true, "interactive", false, "Force an interactive session"),
VERBOSE(RCmdOptionType.BOOLEAN, true, "verbose", false, "Print more information about progress"),
- DEBUGGER(RCmdOptionType.STRING, true, "d", "debugger=NAME", null, "Run R through debugger NAME"),
- DEBUGGER_ARGS(RCmdOptionType.STRING, false, "debugger-args=ARGS", null, "Pass ARGS as arguments to the debugger"),
- GUI(RCmdOptionType.STRING, false, "g TYPE", "gui=TYPE", null, "Use TYPE as GUI; possible values are 'X11' (default)\nand 'Tk'."),
- ARCH(RCmdOptionType.STRING, false, "arch=NAME", null, "Specify a sub-architecture"),
ARGS(RCmdOptionType.BOOLEAN, true, "args", false, "Skip the rest of the command line"),
FILE(RCmdOptionType.STRING, true, "f FILE", "file=FILE", null, "Take input from 'FILE'"),
EXPR(RCmdOptionType.REPEATED_STRING, true, "e EXPR", null, null, "Execute 'EXPR' and exit"),
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RInternalError.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RInternalError.java
index 8208e1a3c4f43fc69596d5e91f8dfa118422e5ee..17fcab5f0bede00e64fd466d767abf374976494a 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RInternalError.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RInternalError.java
@@ -29,13 +29,14 @@ import java.io.PrintStream;
import java.io.PrintWriter;
import java.io.StringWriter;
import java.nio.charset.StandardCharsets;
-import java.nio.file.FileSystems;
import java.nio.file.Files;
+import java.nio.file.Path;
import java.nio.file.StandardOpenOption;
import java.util.Date;
import com.oracle.truffle.api.CompilerDirectives;
import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary;
+import com.oracle.truffle.r.runtime.context.RContext;
/**
* This class is intended to be used for internal errors that do not correspond to R errors.
@@ -149,7 +150,8 @@ public final class RInternalError extends Error {
System.err.println(verboseStackTrace);
}
if (FastROptions.PrintErrorStacktracesToFile.getBooleanValue()) {
- try (BufferedWriter writer = Files.newBufferedWriter(FileSystems.getDefault().getPath(REnvVars.rHome(), "fastr_errors.log"), StandardCharsets.UTF_8, StandardOpenOption.APPEND,
+ Path logfile = Utils.getLogPath("fastr_errors.log");
+ try (BufferedWriter writer = Files.newBufferedWriter(logfile, StandardCharsets.UTF_8, StandardOpenOption.APPEND,
StandardOpenOption.CREATE)) {
writer.append(new Date().toString()).append('\n');
writer.append(out.toString()).append('\n');
@@ -157,6 +159,9 @@ public final class RInternalError extends Error {
} catch (IOException e) {
e.printStackTrace();
}
+ if (RContext.isEmbedded()) {
+ Utils.rSuicide("FastR internal error");
+ }
}
}
}
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/Utils.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/Utils.java
index c4b71e1c6b205d6762a01225d0694ddaa127c116..b73330f0497ebdce00c34bfa10c358399daf30b0 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/Utils.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/Utils.java
@@ -153,21 +153,17 @@ public final class Utils {
* polyglot context are.
*/
RPerfStats.report();
- if (RContext.getInstance() != null && RContext.getInstance().getStartParams() != null && RContext.getInstance().getStartParams().getDebugInitFile()) {
- throw new DebugExitException();
- } else {
- try {
- /*
- * This is not the proper way to dispose a PolyglotEngine, but it doesn't matter
- * since we're going to System.exit anyway.
- */
- RContext.getInstance().destroy();
- } catch (Throwable t) {
- // ignore
- }
- System.exit(status);
- return null;
+ try {
+ /*
+ * This is not the proper way to dispose a PolyglotEngine, but it doesn't matter since
+ * we're going to System.exit anyway.
+ */
+ RContext.getInstance().destroy();
+ } catch (Throwable t) {
+ // ignore
}
+ System.exit(status);
+ return null;
}
public static RuntimeException fail(String msg) {
@@ -250,6 +246,17 @@ public final class Utils {
wdState().setCurrent(path);
}
+ /**
+ * Returns a {@link Path} for a log file with base name {@code fileName}, taking into account
+ * whether the system is running in embedded mode.
+ */
+ public static Path getLogPath(String fileName) {
+ String root = RContext.isEmbedded() ? "/tmp" : REnvVars.rHome();
+ int pid = RFFIFactory.getRFFI().getBaseRFFI().getpid();
+ String baseName = RContext.isEmbedded() ? fileName + "-" + Integer.toString(pid) : fileName;
+ return FileSystems.getDefault().getPath(root, baseName);
+ }
+
/**
* Performs "~" expansion and also checks whether we need to take special case over relative
* paths due to the curwd having moved from the initial setting. In the latter case, if the path
diff --git a/com.oracle.truffle.r.test.native/embedded/src/main.c b/com.oracle.truffle.r.test.native/embedded/src/main.c
index df885026aeca182dd0357a14c0a86df0efee84fa..5e89d7595d912d11fc3bab1babd3652497ac4112 100644
--- a/com.oracle.truffle.r.test.native/embedded/src/main.c
+++ b/com.oracle.truffle.r.test.native/embedded/src/main.c
@@ -70,6 +70,7 @@ void testR_CleanUp(SA_TYPE x, int y, int z) {
void testR_Suicide(const char *msg) {
printf("testR_Suicide: %s\n",msg);
+ (ptr_stdR_Suicide(msg));
}
int testR_ReadConsole(const char *prompt, unsigned char *buf, int len, int h) {
@@ -101,6 +102,7 @@ int main(int argc, char **argv) {
R_SetParams(Rp);
ptr_stdR_CleanUp = ptr_R_CleanUp;
ptr_R_CleanUp = &testR_CleanUp;
+ ptr_stdR_Suicide = ptr_R_Suicide;
ptr_R_Suicide = &testR_Suicide;
ptr_R_ReadConsole = &testR_ReadConsole;
ptr_R_WriteConsole = &testR_WriteConsole;
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 8df3af80f21eedb13da8598f4cb8a6c7d4a64881..d0f3fe92421d46382610fa11dec26a610ee811aa 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
@@ -58,3 +58,16 @@ rffi.rhome_dir <- function() {
.Call("rHomeDir", PACKAGE = "testrffi")
}
+rffi.upcalled <- function(v) {
+ gc()
+ .Call("nestedCall2", PACKAGE = "testrffi", v)
+}
+
+rffi.nested.call1 <- function() {
+ upcall <- quote(rffi.upcalled(v))
+ v <- c(10L, 20L, 30L)
+ env <- new.env()
+ assign("v", v, env)
+ .Call("nestedCall1", PACKAGE = "testrffi", upcall, env)
+}
+
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 aadc29d3f13cb4b668d007a7f31be44c5c464a69..6bf9acba57df7e2a5eaa0ee76cf4135ca6cc0d2d 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
@@ -150,7 +150,7 @@ SEXP tryEval(SEXP expr, SEXP env) {
}
SET_VECTOR_ELT(v, 0, r);
SET_VECTOR_ELT(v, 1, ScalarLogical(error));
- UNPROTECT(v);
+ UNPROTECT(1);
return v;
}
@@ -159,3 +159,42 @@ SEXP rHomeDir() {
return ScalarString(mkChar(dir));
}
+SEXP nestedCall1(SEXP upcall, SEXP env) {
+ SEXP vec;
+ PROTECT(vec = allocVector(INTSXP, 10));
+ int *vecstar = INTEGER(vec);
+ for (int i = 0; i < 10; i++) {
+ vecstar[i] = i + 1;
+ }
+ SEXP upcallResult = tryEval(upcall, env);
+ int *vecstar2 = INTEGER(vec);
+ int ok = vecstar == vecstar2;
+ if (ok) {
+ for (int i = 0; i < 10; i++) {
+ if (vecstar[i] != i + 1) {
+ ok = 0;
+ break;
+ }
+ }
+ }
+ SEXP result;
+ PROTECT(result = allocVector(VECSXP, 2));
+ SET_VECTOR_ELT(result, 0, upcallResult);
+ SET_VECTOR_ELT(result, 1, ScalarLogical(ok));
+ UNPROTECT(2);
+ return result;
+}
+
+SEXP nestedCall2(SEXP v) {
+ SEXP sumVec;
+ PROTECT(sumVec = allocVector(INTSXP, 1));
+ int len = Rf_length(v);
+ int sum = 0;
+ for (int i = 0; i < len; i++) {
+ sum += INTEGER(v)[i];
+ }
+ INTEGER(sumVec)[0] = sum;
+ UNPROTECT(1);
+ return sumVec;
+}
+