From ae68d1f3bb26e338b6611f1614c7e952b8158ba7 Mon Sep 17 00:00:00 2001
From: Mick Jordan <mick.jordan@oracle.com>
Date: Mon, 17 Aug 2015 15:53:58 -0700
Subject: [PATCH] bug fixes and extra functionality for MASS package
install/load
---
.../fficall/jni/src/alloc.c | 33 +++++++++++++++++++
.../fficall/jni/src/misc.c | 11 +++++++
.../fficall/jni/src/rf_functions.c | 17 +++++++++-
.../fficall/jni/src/rfficall.c | 2 ++
.../fficall/jni/src/rffiutils.h | 4 +++
.../r/nodes/builtin/base/BasePackage.java | 1 +
.../r/nodes/builtin/base/FileFunctions.java | 14 +++++---
.../truffle/r/nodes/builtin/base/Xtfrm.java | 33 +++++++++++++++++++
.../r/runtime/ffi/jnr/JNR_RFFIFactory.java | 6 ++++
9 files changed, 116 insertions(+), 5 deletions(-)
create mode 100644 com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Xtfrm.java
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 d974d45d9c..c46ae28e16 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 5be911f7d4..fb9dfbcf89 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 bd385fff86..72017f431d 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 a7680e164b..939c7a7a02 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 0e550a5d04..691a89c709 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 1e2d883251..2bf3ba82f7 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 8f50865fc7..8de3ec74ba 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 0000000000..d35f485be4
--- /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 5ab5cb3101..e6f420c416 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();
}
/**
--
GitLab