diff --git a/com.oracle.truffle.r.native/fficall/jni/src/alloc.c b/com.oracle.truffle.r.native/fficall/jni/src/alloc.c
index d974d45d9cb5c6acae7a3864eeda99ecad9fd0ad..c46ae28e16eeab94bdfb84067be6fae5ff16a672 100644
--- a/com.oracle.truffle.r.native/fficall/jni/src/alloc.c
+++ b/com.oracle.truffle.r.native/fficall/jni/src/alloc.c
@@ -12,10 +12,43 @@
#include "rffiutils.h"
#include <stdlib.h>
+#define T_MEM_TABLE_INITIAL_SIZE 0
+// The table of transient objects that have been allocated dur the current FFI call
+static void **tMemTable;
+// hwm of tMemTable
+static int tMemTableIndex;
+static int tMemTableLength;
void init_alloc(JNIEnv *env) {
+ tMemTable = malloc(sizeof(void*) * T_MEM_TABLE_INITIAL_SIZE);
+ tMemTableLength = T_MEM_TABLE_INITIAL_SIZE;
+ tMemTableIndex = 0;
+}
+
+// Memory that is auto-reclaimed across FFI calls
+char *R_alloc(size_t n, int size) {
+ void *p = R_chk_alloc(n, size);
+ if (tMemTableIndex >= tMemTableLength) {
+ int newLength = 2 * tMemTableLength;
+ void *newtMemTable = malloc(sizeof(void*) * newLength);
+ if (newtMemTable == NULL) {
+ fatalError("malloc failure");
+ }
+ memcpy(newtMemTable, tMemTable, tMemTableLength * sizeof(void*));
+ free(tMemTable);
+ tMemTable = newtMemTable;
+ tMemTableLength = newLength;
+ }
+ tMemTable[tMemTableIndex] = p;
+ return (char*) p;
}
+void allocExit() {
+ int i;
+ for (i = 0; i < tMemTableIndex; i++) {
+ free(tMemTable[i]);
+ }
+}
void *R_chk_calloc(size_t nelem, size_t elsize) {
void *p;
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 5be911f7d48f0091454bfa966e06afd1ce3774fc..fb9dfbcf8909b17e411a91b68784ba6d2d5d08ce 100644
--- a/com.oracle.truffle.r.native/fficall/jni/src/misc.c
+++ b/com.oracle.truffle.r.native/fficall/jni/src/misc.c
@@ -45,3 +45,14 @@ const char *R_CHAR(SEXP string) {
return copyChars;
}
+void R_isort(int *x, int n) {
+ unimplemented("R_isort");
+}
+
+void R_rsort(double *x, int n) {
+ unimplemented("R_rsort");
+}
+
+void R_CheckUserInterrupt() {
+// TODO (we don't even do this in the Java code)
+}
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 bd385fff8652d8589aaca1fac742bcceac6f1dcc..72017f431d1336d1253209194f98387b1ee9d104 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
@@ -44,6 +44,8 @@ static jmethodID Rf_isNullMethodID;
static jmethodID Rf_warningMethodID;
static jmethodID Rf_errorMethodID;
static jmethodID Rf_NewHashedEnvMethodID;
+static jmethodID Rf_rPsortMethodID;
+static jmethodID Rf_iPsortMethodID;
void init_rf_functions(JNIEnv *env) {
Rf_ScalarIntegerMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_ScalarInteger", "(I)Lcom/oracle/truffle/r/runtime/data/RIntVector;", 1);
@@ -64,6 +66,8 @@ void init_rf_functions(JNIEnv *env) {
createListMethodID = checkGetMethodID(env, RDataFactoryClass, "createList", "(I)Lcom/oracle/truffle/r/runtime/data/RList;", 1);
Rf_duplicateMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_duplicate", "(Ljava/lang/Object;)Ljava/lang/Object;", 1);
Rf_NewHashedEnvMethodID = checkGetMethodID(env, RDataFactoryClass, "createNewEnv", "(Lcom/oracle/truffle/r/runtime/env/REnvironment;Ljava/lang/String;ZI)Lcom/oracle/truffle/r/runtime/env/REnvironment;", 1);
+// Rf_rPsortMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_rPsort", "(Lcom/oracle/truffle/r/runtime/data/RDoubleVector;II)", 1);
+// Rf_iPsortMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_iPsort", "(Lcom/oracle/truffle/r/runtime/data/RIntVector;II)", 1);
}
SEXP Rf_ScalarInteger(int value) {
@@ -210,7 +214,7 @@ void Rf_error(const char *msg, ...) {
// and, if it finds any, does not return, but throws a different exception than RError.
// We definitely need to exit the FFI call and we certainly cannot return to our caller.
// So we call CallRFFIHelper.Rf_error to throw the RError exception. When the pending
- // exception (whatever it is) is observed by JNI, he call to Rf_error will return where we do a
+ // exception (whatever it is) is observed by JNI, the call to Rf_error will return where we do a
// non-local transfer of control back to the entry point (which will cleanup).
JNIEnv *thisenv = getEnv();
jstring string = (*thisenv)->NewStringUTF(thisenv, msg);
@@ -246,3 +250,14 @@ SEXP R_NewHashedEnv(SEXP parent, SEXP size) {
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, RDataFactoryClass, Rf_NewHashedEnvMethodID, parent, NULL, JNI_TRUE, sizeAsInt);
return checkRef(thisenv, result);
}
+
+void Rf_iPsort(int *x, int n, int k)
+{
+ JNIEnv *thisenv = getEnv();
+ unimplemented("Rf_iPsort");
+}
+
+void Rf_rPsort(double *x, int n, int k) {
+ JNIEnv *thisenv = getEnv();
+ unimplemented("Rf_rPsort");
+}
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 a7680e164b54df50ef6b837c6c670f8a9d9b1e4d..939c7a7a026266bf85a0017d058d226e2633d60c 100644
--- a/com.oracle.truffle.r.native/fficall/jni/src/rfficall.c
+++ b/com.oracle.truffle.r.native/fficall/jni/src/rfficall.c
@@ -36,6 +36,8 @@ Java_com_oracle_truffle_r_runtime_ffi_jnr_CallRFFIWithJNI_initialize(JNIEnv *env
init_typecoerce(env);
init_attrib(env);
init_misc(env);
+ init_rng(env);
+ init_optim(env);
init_vectoraccess(env);
init_listaccess(env);
}
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 0e550a5d04545380c669fa4c32e6c72e6748be3a..691a89c7090216d91b71625d8242f1784a274448 100644
--- a/com.oracle.truffle.r.native/fficall/jni/src/rffiutils.h
+++ b/com.oracle.truffle.r.native/fficall/jni/src/rffiutils.h
@@ -53,6 +53,8 @@ void validateRef(JNIEnv *env, SEXP x, const char *msg);
void callEnter(JNIEnv *env, jmp_buf *error_exit);
// exiting a top-level JNI call
void callExit(JNIEnv *env);
+// called by callExit to deallocate transient memory
+void allocExit();
jmp_buf *getErrorJmpBuf();
@@ -68,6 +70,8 @@ void init_externalptr(JNIEnv *env);
void init_typecoerce(JNIEnv *env);
void init_attrib(JNIEnv *env);
void init_misc(JNIEnv *env);
+void init_rng(JNIEnv *env);
+void init_optim(JNIEnv *env);
void init_vectoraccess(JNIEnv *env);
void init_listaccess(JNIEnv *env);
void init_utils(JNIEnv *env);
diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/BasePackage.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/BasePackage.java
index 1e2d883251e280e898961c1db1babc76046eb090..2bf3ba82f733a4c4d5610cef66858c710505b2aa 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/BasePackage.java
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/BasePackage.java
@@ -502,5 +502,6 @@ public class BasePackage extends RBuiltinPackage {
add(WhichFunctions.Which.class, WhichFunctionsFactory.WhichNodeGen::create);
add(WhichFunctions.WhichMax.class, WhichFunctionsFactory.WhichMaxNodeGen::create);
add(WhichFunctions.WhichMin.class, WhichFunctionsFactory.WhichMinNodeGen::create);
+ add(Xtfrm.class, XtfrmNodeGen::create);
}
}
diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/FileFunctions.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/FileFunctions.java
index 8f50865fc7c9d66b2590fdad2c8778a7c19bf40b..8de3ec74ba656feb691a5b4f233c34bd793faaa4 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/FileFunctions.java
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/FileFunctions.java
@@ -307,15 +307,21 @@ public class FileFunctions {
// @formatter:on
}
+ private static void updateComplete(int slot, boolean[] complete, boolean update) {
+ if (complete[slot]) {
+ complete[slot] = update;
+ }
+ }
+
private static void setColumnValue(Column column, Object[] data, boolean[] complete, int index, Object value) {
int slot = column.ordinal();
// @formatter:off
switch(column) {
- case size: ((double[]) data[slot])[index] = (double) value; complete[slot] = (double) value != RRuntime.DOUBLE_NA; return;
- case isdir: ((byte[]) data[slot])[index] = (byte) value; complete[slot] = (byte) value != RRuntime.LOGICAL_NA; return;
+ case size: ((double[]) data[slot])[index] = (double) value; updateComplete(slot, complete, (double) value != RRuntime.DOUBLE_NA); return;
+ case isdir: ((byte[]) data[slot])[index] = (byte) value; updateComplete(slot, complete, (byte) value != RRuntime.LOGICAL_NA); return;
case mode: case mtime: case ctime: case atime:
- case uid: case gid: ((int[]) data[slot])[index] = (int) value; complete[slot] = (int) value != RRuntime.INT_NA; return;
- case uname: case grname: ((String[]) data[slot])[index] = (String) value; complete[slot] = (String) value != RRuntime.STRING_NA; return;
+ case uid: case gid: ((int[]) data[slot])[index] = (int) value; updateComplete(slot, complete, (int) value != RRuntime.INT_NA); return;
+ case uname: case grname: ((String[]) data[slot])[index] = (String) value; updateComplete(slot, complete, (String) value != RRuntime.STRING_NA); return;
default: throw RInternalError.shouldNotReachHere();
}
// @formatter:on
diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Xtfrm.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Xtfrm.java
new file mode 100644
index 0000000000000000000000000000000000000000..d35f485be4bfb99b545f75e02db7b0a6af57858d
--- /dev/null
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Xtfrm.java
@@ -0,0 +1,33 @@
+package com.oracle.truffle.r.nodes.builtin.base;
+
+import static com.oracle.truffle.r.runtime.RBuiltinKind.*;
+import static com.oracle.truffle.r.runtime.RDispatch.*;
+
+import com.oracle.truffle.api.*;
+import com.oracle.truffle.api.dsl.*;
+import com.oracle.truffle.api.frame.*;
+import com.oracle.truffle.r.nodes.builtin.*;
+import com.oracle.truffle.r.nodes.builtin.base.GetFunctionsFactory.*;
+import com.oracle.truffle.r.runtime.*;
+import com.oracle.truffle.r.runtime.data.*;
+import com.oracle.truffle.r.runtime.nodes.*;
+
+@RBuiltin(name = "xtfrm", kind = PRIMITIVE, parameterNames = {"x"}, dispatch = INTERNAL_GENERIC)
+public abstract class Xtfrm extends RBuiltinNode {
+ @Child private GetFunctions.Get getNode;
+
+ @Specialization
+ protected Object xtfrm(VirtualFrame frame, Object x) {
+ /*
+ * Although this is a PRIMITIVE, there is an xtfrm.default that we must call if "x" is not
+ * of a class that already has an xtfrm.class function defined. We only get here in the
+ * default case.
+ */
+ if (getNode == null) {
+ CompilerDirectives.transferToInterpreterAndInvalidate();
+ getNode = insert(GetNodeGen.create(new RNode[4], null, null));
+ }
+ RFunction func = (RFunction) getNode.execute(frame, "xtfrm.default", RArguments.getEnvironment(frame), RType.Function.getName(), RRuntime.LOGICAL_TRUE);
+ return RContext.getEngine().evalFunction(func, x);
+ }
+}
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 5ab5cb310179a7c07a00f5b663c3c50a8827eee0..e6f420c416215c781878fd9b187eacb367246552 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
@@ -53,6 +53,12 @@ public class JNR_RFFIFactory extends RFFIFactory implements RFFI, BaseRFFI, Stat
protected void initialize() {
// This must load early as package libraries reference symbols in it.
getCallRFFI();
+ /*
+ * Some package C code calls these functions and, therefore, expects the linpack symbols to
+ * be available, which will not be the case unless one of the functions has already been
+ * called from R code. So we eagerly load the library to define the symbols.
+ */
+ linpack();
}
/**