From 1c482c4bdbc985dc529925bfd7636cceba4060d6 Mon Sep 17 00:00:00 2001
From: Miloslav Metelka <miloslav.metelka@oracle.com>
Date: Thu, 9 Mar 2017 18:16:09 +0100
Subject: [PATCH] Implemented Rf_copyMatrix() and related fixes.
---
.../fficall/src/jni/Rinternals.c | 112 +++++++++--
com.oracle.truffle.r.native/version.source | 2 +-
.../truffle/r/nodes/builtin/base/Prod.java | 59 +++++-
.../r/nodes/ffi/FFIUpCallRootNode.java | 6 +
.../r/nodes/ffi/JavaUpCallsRFFIImpl.java | 186 +++++++++++++++++-
.../oracle/truffle/r/nodes/ffi/MiscNodes.java | 66 +++++++
.../truffle/r/nodes/ffi/RFFIUpCallMethod.java | 3 +
.../r/nodes/ffi/TracingUpCallsRFFIImpl.java | 36 ++++
.../objects/CollectGenericArgumentsNode.java | 7 +-
.../truffle/r/runtime/ffi/StdUpCallsRFFI.java | 13 ++
.../truffle/r/test/ExpectedTestOutput.test | 40 ++++
.../r/test/builtins/TestBuiltin_prod.java | 12 +-
12 files changed, 520 insertions(+), 22 deletions(-)
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 9efedd0f00..7a21ecaa62 100644
--- a/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c
+++ b/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c
@@ -91,6 +91,9 @@ jmethodID logNotCharSXPWrapperMethodID;
static jmethodID STRING_ELT_MethodID;
static jmethodID VECTOR_ELT_MethodID;
static jmethodID LENGTH_MethodID;
+static jmethodID R_do_slot_MethodID;
+static jmethodID R_do_slot_assign_MethodID;
+static jmethodID R_MethodsNamespaceMethodID;
static jmethodID Rf_asIntegerMethodID;
static jmethodID Rf_asRealMethodID;
static jmethodID Rf_asCharMethodID;
@@ -105,6 +108,8 @@ static jmethodID TYPEOF_MethodID;
static jmethodID OBJECT_MethodID;
static jmethodID DUPLICATE_ATTRIB_MethodID;
static jmethodID IS_S4_OBJECTMethodID;
+static jmethodID SET_S4_OBJECTMethodID;
+static jmethodID UNSET_S4_OBJECTMethodID;
static jmethodID R_tryEvalMethodID;
static jmethodID RDEBUGMethodID;
static jmethodID SET_RDEBUGMethodID;
@@ -114,6 +119,7 @@ static jmethodID ENCLOSMethodID;
static jmethodID PRVALUEMethodID;
static jmethodID R_lsInternal3MethodID;
static jmethodID R_do_MAKE_CLASS_MethodID;
+static jmethodID R_do_new_object_MethodID;
static jmethodID PRSEENMethodID;
static jmethodID PRENVMethodID;
static jmethodID R_PromiseExprMethodID;
@@ -171,6 +177,7 @@ void init_internals(JNIEnv *env) {
Rf_classgetsMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_classgets", "(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;", 0);
RprintfMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rprintf", "(Ljava/lang/Object;)V", 0);
R_do_MAKE_CLASS_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "R_do_MAKE_CLASS", "(Ljava/lang/Object;)Ljava/lang/Object;", 0);
+ R_do_new_object_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "R_do_new_object", "(Ljava/lang/Object;)Ljava/lang/Object;", 0);
R_FindNamespaceMethodID = checkGetMethodID(env, UpCallsRFFIClass, "R_FindNamespace", "(Ljava/lang/Object;)Ljava/lang/Object;", 0);
R_BindingIsLockedID = checkGetMethodID(env, UpCallsRFFIClass, "R_BindingIsLocked", "(Ljava/lang/Object;Ljava/lang/Object;)I", 0);
Rf_GetOption1MethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_GetOption1", "(Ljava/lang/Object;)Ljava/lang/Object;", 0);
@@ -201,6 +208,9 @@ void init_internals(JNIEnv *env) {
STRING_ELT_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "STRING_ELT", "(Ljava/lang/Object;I)Ljava/lang/Object;", 0);
VECTOR_ELT_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "VECTOR_ELT", "(Ljava/lang/Object;I)Ljava/lang/Object;", 0);
LENGTH_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "LENGTH", "(Ljava/lang/Object;)I", 0);
+ R_do_slot_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "R_do_slot", "(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;", 0);
+ R_do_slot_assign_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "R_do_slot_assign", "(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;", 0);
+ R_MethodsNamespaceMethodID = checkGetMethodID(env, UpCallsRFFIClass, "R_MethodsNamespace", "()Ljava/lang/Object;", 0);
Rf_asIntegerMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_asInteger", "(Ljava/lang/Object;)I", 0);
Rf_asRealMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_asReal", "(Ljava/lang/Object;)D", 0);
Rf_asCharMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_asChar", "(Ljava/lang/Object;)Ljava/lang/Object;", 0);
@@ -214,6 +224,8 @@ void init_internals(JNIEnv *env) {
OBJECT_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "OBJECT", "(Ljava/lang/Object;)I", 0);
DUPLICATE_ATTRIB_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "DUPLICATE_ATTRIB", "(Ljava/lang/Object;Ljava/lang/Object;)V", 0);
IS_S4_OBJECTMethodID = checkGetMethodID(env, UpCallsRFFIClass, "IS_S4_OBJECT", "(Ljava/lang/Object;)I", 0);
+ SET_S4_OBJECTMethodID = checkGetMethodID(env, UpCallsRFFIClass, "SET_S4_OBJECT", "(Ljava/lang/Object;)V", 0);
+ UNSET_S4_OBJECTMethodID = checkGetMethodID(env, UpCallsRFFIClass, "UNSET_S4_OBJECT", "(Ljava/lang/Object;)V", 0);
R_tryEvalMethodID = checkGetMethodID(env, UpCallsRFFIClass, "R_tryEval", "(Ljava/lang/Object;Ljava/lang/Object;Z)Ljava/lang/Object;", 0);
RDEBUGMethodID = checkGetMethodID(env, UpCallsRFFIClass, "RDEBUG", "(Ljava/lang/Object;)I", 0);
SET_RDEBUGMethodID = checkGetMethodID(env, UpCallsRFFIClass, "SET_RDEBUG", "(Ljava/lang/Object;I)V", 0);
@@ -477,6 +489,7 @@ SEXP Rf_install(const char *name) {
JNIEnv *thisenv = getEnv();
jstring string = (*thisenv)->NewStringUTF(thisenv, name);
SEXP result = (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, Rf_installMethodID, string);
+ addGlobalRef(thisenv, result, 1);
return checkRef(thisenv, result);
}
@@ -1377,10 +1390,13 @@ int IS_S4_OBJECT(SEXP x) {
}
void SET_S4_OBJECT(SEXP x) {
- unimplemented("SET_S4_OBJECT");
+ JNIEnv *env = getEnv();
+ (*env)->CallVoidMethod(env, UpCallsRFFIObject, SET_S4_OBJECTMethodID, x);
}
+
void UNSET_S4_OBJECT(SEXP x) {
- unimplemented("UNSET_S4_OBJECT");
+ JNIEnv *env = getEnv();
+ (*env)->CallVoidMethod(env, UpCallsRFFIObject, UNSET_S4_OBJECTMethodID, x);
}
Rboolean R_ToplevelExec(void (*fun)(void *), void *data) {
@@ -1595,11 +1611,17 @@ void R_RunWeakRefFinalizer(SEXP w) {
}
SEXP R_do_slot(SEXP obj, SEXP name) {
- return unimplemented("R_do_slot");
+ TRACE(TARGp, obj, name);
+ JNIEnv *thisenv = getEnv();
+ SEXP result = (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, R_do_slot_MethodID, obj, name);
+ return checkRef(thisenv, result);
}
-SEXP R_do_slot_assign(SEXP obj, SEXP name, SEXP value) {
- return unimplemented("R_do_slot_assign");
+SEXP R_do_slot_assign(SEXP obj, SEXP name, SEXP value) { // Same like R_set_slot
+ TRACE(TARGp, obj, name, value);
+ JNIEnv *thisenv = getEnv();
+ SEXP result = (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, R_do_slot_assign_MethodID, obj, name, value);
+ return checkRef(thisenv, result);
}
int R_has_slot(SEXP obj, SEXP name) {
@@ -1615,17 +1637,84 @@ SEXP R_do_MAKE_CLASS(const char *what) {
SEXP R_getClassDef (const char *what) {
return unimplemented("R_getClassDef");
}
-
+
SEXP R_do_new_object(SEXP class_def) {
- return unimplemented("R_do_new_object");
+ JNIEnv *thisenv = getEnv();
+ SEXP result = (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, R_do_new_object_MethodID, class_def);
+ return checkRef(thisenv, result);
}
int R_check_class_and_super(SEXP x, const char **valid, SEXP rho) {
- return (int) unimplemented("R_check_class_and_super");
+ int ans;
+ SEXP cl = PROTECT(asChar(getAttrib(x, R_ClassSymbol)));
+ const char *class = CHAR(cl);
+ for (ans = 0; ; ans++) {
+ if (!strlen(valid[ans])) // empty string
+ break;
+ if (!strcmp(class, valid[ans])) {
+ UNPROTECT(1); /* cl */
+ return ans;
+ }
+ }
+ /* if not found directly, now search the non-virtual super classes :*/
+ if(IS_S4_OBJECT(x)) {
+ /* now try the superclasses, i.e., try is(x, "...."); superCl :=
+ .selectSuperClasses(getClass("....")@contains, dropVirtual=TRUE) */
+ SEXP classExts, superCl, _call;
+ // install() results cached anyway so the following variables could be non-static if needed
+ static SEXP s_contains = NULL, s_selectSuperCl = NULL;
+ int i;
+ if(!s_contains) {
+ s_contains = install("contains");
+ s_selectSuperCl = install(".selectSuperClasses");
+ }
+ SEXP classDef = PROTECT(R_getClassDef(class));
+ PROTECT(classExts = R_do_slot(classDef, s_contains));
+ PROTECT(_call = lang3(s_selectSuperCl, classExts,
+ /* dropVirtual = */ ScalarLogical(1)));
+ superCl = eval(_call, rho);
+ UNPROTECT(3); /* _call, classExts, classDef */
+ PROTECT(superCl);
+ for(i=0; i < LENGTH(superCl); i++) {
+ const char *s_class = CHAR(STRING_ELT(superCl, i));
+ for (ans = 0; ; ans++) {
+ if (!strlen(valid[ans]))
+ break;
+ if (!strcmp(s_class, valid[ans])) {
+ UNPROTECT(2); /* superCl, cl */
+ return ans;
+ }
+ }
+ }
+ UNPROTECT(1); /* superCl */
+ }
+ UNPROTECT(1); /* cl */
+ return -1;
}
int R_check_class_etc (SEXP x, const char **valid) {
- return (int) unimplemented("R_check_class_etc");
+ // install() results cached anyway so the following variables could be non-static if needed
+ static SEXP meth_classEnv = NULL;
+ SEXP cl = getAttrib(x, R_ClassSymbol), rho = R_GlobalEnv, pkg;
+ if (!meth_classEnv)
+ meth_classEnv = install(".classEnv");
+
+ pkg = getAttrib(cl, R_PackageSymbol); /* ==R== packageSlot(class(x)) */
+ if (!isNull(pkg)) { /* find rho := correct class Environment */
+ SEXP clEnvCall;
+ // FIXME: fails if 'methods' is not loaded.
+ PROTECT(clEnvCall = lang2(meth_classEnv, cl));
+ JNIEnv *thisenv = getEnv();
+ SEXP methodsNamespace = (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, R_MethodsNamespaceMethodID);
+ rho = eval(clEnvCall, methodsNamespace);
+ UNPROTECT(1);
+ if (!isEnvironment(rho))
+ error(_("could not find correct environment; please report!"));
+ }
+ PROTECT(rho);
+ int res = R_check_class_and_super(x, valid, rho);
+ UNPROTECT(1);
+ return res;
}
SEXP R_PreserveObject(SEXP x) {
@@ -1648,11 +1737,12 @@ Rboolean R_compute_identical(SEXP x, SEXP y, int flags) {
}
void Rf_copyListMatrix(SEXP s, SEXP t, Rboolean byrow) {
- JNIEnv *thisenv = getEnv();
+ JNIEnv *thisenv = getEnv();
(*thisenv)->CallIntMethod(thisenv, UpCallsRFFIObject, Rf_copyListMatrixMethodID, s, t, byrow);
}
void Rf_copyMatrix(SEXP s, SEXP t, Rboolean byrow) {
- JNIEnv *thisenv = getEnv();
+ JNIEnv *thisenv = getEnv();
(*thisenv)->CallIntMethod(thisenv, UpCallsRFFIObject, Rf_copyMatrixMethodID, s, t, byrow);
}
+
diff --git a/com.oracle.truffle.r.native/version.source b/com.oracle.truffle.r.native/version.source
index 3c032078a4..d6b24041cf 100644
--- a/com.oracle.truffle.r.native/version.source
+++ b/com.oracle.truffle.r.native/version.source
@@ -1 +1 @@
-18
+19
diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Prod.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Prod.java
index 132a964889..34cd247dd9 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Prod.java
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Prod.java
@@ -15,12 +15,16 @@ import static com.oracle.truffle.r.runtime.builtins.RBehavior.PURE;
import static com.oracle.truffle.r.runtime.builtins.RBuiltinKind.PRIMITIVE;
import com.oracle.truffle.api.CompilerDirectives;
+import com.oracle.truffle.api.dsl.Fallback;
import com.oracle.truffle.api.dsl.Specialization;
import com.oracle.truffle.r.nodes.builtin.RBuiltinNode;
+import com.oracle.truffle.r.runtime.RError;
import com.oracle.truffle.r.runtime.RRuntime;
import com.oracle.truffle.r.runtime.builtins.RBuiltin;
import com.oracle.truffle.r.runtime.data.RArgsValuesAndNames;
import com.oracle.truffle.r.runtime.data.RComplex;
+import com.oracle.truffle.r.runtime.data.RNull;
+import com.oracle.truffle.r.runtime.data.RTypedValue;
import com.oracle.truffle.r.runtime.data.model.RAbstractComplexVector;
import com.oracle.truffle.r.runtime.data.model.RAbstractDoubleVector;
import com.oracle.truffle.r.runtime.data.model.RAbstractIntVector;
@@ -49,12 +53,53 @@ public abstract class Prod extends RBuiltinNode {
@Specialization
protected Object prod(RArgsValuesAndNames args) {
+ int argsLen = args.getLength();
+ if (argsLen == 0) {
+ return 1d;
+ }
if (prodRecursive == null) {
CompilerDirectives.transferToInterpreterAndInvalidate();
prodRecursive = insert(ProdNodeGen.create());
}
- // TODO: eventually handle multiple vectors properly
- return prodRecursive.executeObject(args.getArgument(0));
+ Object ret = prodRecursive.executeObject(args.getArgument(0));
+ if (argsLen != 1) {
+ double prodReal;
+ double prodImg;
+ boolean complex;
+ if (ret instanceof RComplex) {
+ RComplex c = (RComplex) ret;
+ prodReal = c.getRealPart();
+ prodImg = c.getImaginaryPart();
+ complex = true;
+ } else {
+ prodReal = (Double) ret;
+ prodImg = 0d;
+ complex = false;
+ }
+ for (int i = 1; i < argsLen; i++) {
+ Object aProd = prodRecursive.executeObject(args.getArgument(i));
+ double aProdReal;
+ double aProdImg;
+ if (aProd instanceof RComplex) {
+ RComplex c = (RComplex) aProd;
+ aProdReal = c.getRealPart();
+ aProdImg = c.getImaginaryPart();
+ complex = true;
+ } else {
+ aProdReal = (Double) aProd;
+ aProdImg = 0d;
+ }
+ if (complex) {
+ RComplex c = prod.op(prodReal, prodImg, aProdReal, aProdImg);
+ prodReal = c.getRealPart();
+ prodImg = c.getImaginaryPart();
+ } else {
+ prodReal = prod.op(prodReal, aProdReal);
+ }
+ }
+ ret = complex ? RComplex.valueOf(prodReal, prodImg) : prodReal;
+ }
+ return ret;
}
@Specialization
@@ -93,4 +138,14 @@ public abstract class Prod extends RBuiltinNode {
}
return product;
}
+
+ @Specialization
+ protected double prod(RNull n) {
+ return 1d;
+ }
+
+ @Fallback
+ protected Object prod(Object o) {
+ throw RError.error(this, RError.Message.INVALID_TYPE_ARGUMENT, ((RTypedValue) RRuntime.asAbstractVector(o)).getRType().getName());
+ }
}
diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/FFIUpCallRootNode.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/FFIUpCallRootNode.java
index e7d26f933b..475f51bdfd 100644
--- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/FFIUpCallRootNode.java
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/FFIUpCallRootNode.java
@@ -35,6 +35,9 @@ import com.oracle.truffle.r.nodes.ffi.ListAccessNodesFactory.CARNodeGen;
import com.oracle.truffle.r.nodes.ffi.ListAccessNodesFactory.CDDRNodeGen;
import com.oracle.truffle.r.nodes.ffi.ListAccessNodesFactory.CDRNodeGen;
import com.oracle.truffle.r.nodes.ffi.MiscNodesFactory.LENGTHNodeGen;
+import com.oracle.truffle.r.nodes.ffi.MiscNodesFactory.RDoNewObjectNodeGen;
+import com.oracle.truffle.r.nodes.ffi.MiscNodesFactory.RDoSlotNodeGen;
+import com.oracle.truffle.r.nodes.ffi.MiscNodesFactory.RDoSlotAssignNodeGen;
import com.oracle.truffle.r.runtime.RInternalError;
import com.oracle.truffle.r.runtime.context.RContext;
@@ -91,6 +94,9 @@ public final class FFIUpCallRootNode extends RootNode {
FFIUpCallRootNode.add(RFFIUpCallMethod.CADDR, CADDRNodeGen::create);
FFIUpCallRootNode.add(RFFIUpCallMethod.CDDR, CDDRNodeGen::create);
FFIUpCallRootNode.add(RFFIUpCallMethod.LENGTH, LENGTHNodeGen::create);
+ FFIUpCallRootNode.add(RFFIUpCallMethod.R_do_new_object, RDoNewObjectNodeGen::create);
+ FFIUpCallRootNode.add(RFFIUpCallMethod.R_do_slot, RDoSlotNodeGen::create);
+ FFIUpCallRootNode.add(RFFIUpCallMethod.R_do_slot_assign, RDoSlotAssignNodeGen::create);
}
}
diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/JavaUpCallsRFFIImpl.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/JavaUpCallsRFFIImpl.java
index 2c78c9fbb6..2bb4cee421 100644
--- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/JavaUpCallsRFFIImpl.java
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/JavaUpCallsRFFIImpl.java
@@ -80,13 +80,20 @@ import com.oracle.truffle.r.runtime.data.RPairList;
import com.oracle.truffle.r.runtime.data.RPromise;
import com.oracle.truffle.r.runtime.data.RRaw;
import com.oracle.truffle.r.runtime.data.RRawVector;
-import com.oracle.truffle.r.runtime.data.RS4Object;
import com.oracle.truffle.r.runtime.data.RSequence;
import com.oracle.truffle.r.runtime.data.RShareable;
import com.oracle.truffle.r.runtime.data.RStringVector;
import com.oracle.truffle.r.runtime.data.RSymbol;
+import com.oracle.truffle.r.runtime.data.RTypedValue;
import com.oracle.truffle.r.runtime.data.RUnboundValue;
+import com.oracle.truffle.r.runtime.data.model.RAbstractComplexVector;
+import com.oracle.truffle.r.runtime.data.model.RAbstractContainer;
+import com.oracle.truffle.r.runtime.data.model.RAbstractDoubleVector;
+import com.oracle.truffle.r.runtime.data.model.RAbstractIntVector;
+import com.oracle.truffle.r.runtime.data.model.RAbstractListBaseVector;
import com.oracle.truffle.r.runtime.data.model.RAbstractListVector;
+import com.oracle.truffle.r.runtime.data.model.RAbstractLogicalVector;
+import com.oracle.truffle.r.runtime.data.model.RAbstractRawVector;
import com.oracle.truffle.r.runtime.data.model.RAbstractStringVector;
import com.oracle.truffle.r.runtime.data.model.RAbstractVector;
import com.oracle.truffle.r.runtime.env.REnvironment;
@@ -99,6 +106,8 @@ import com.oracle.truffle.r.runtime.nodes.DuplicationHelper;
import com.oracle.truffle.r.runtime.nodes.RNode;
import com.oracle.truffle.r.runtime.nodes.RSyntaxNode;
import com.oracle.truffle.r.runtime.rng.RRNG;
+import java.util.Map;
+import java.util.concurrent.ConcurrentHashMap;
/**
* This class provides a simple Java-based implementation of {@link UpCallsRFFI}, where all the
@@ -114,6 +123,8 @@ import com.oracle.truffle.r.runtime.rng.RRNG;
*/
public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI {
+ private final Map<String, Object> nameSymbolCache = new ConcurrentHashMap<>();
+
// Checkstyle: stop method name check
@Override
@@ -197,6 +208,11 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI {
return RContext.getEngine().evalFunction(getClass, null, RCaller.createInvalid(null), null, clazz);
}
+ @Override
+ public Object R_do_new_object(Object classDef) {
+ return FFIUpCallRootNode.getCallTarget(RFFIUpCallMethod.R_do_new_object).call(classDef);
+ }
+
@Override
public Object Rf_findVar(Object symbolArg, Object envArg) {
return findVarInFrameHelper(envArg, symbolArg, true);
@@ -319,7 +335,13 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI {
@Override
public Object Rf_install(Object name) {
- return RDataFactory.createSymbolInterned((String) name);
+ String nameStr = (String) name;
+ Object ret = nameSymbolCache.get(nameStr);
+ if (ret == null) {
+ ret = RDataFactory.createSymbolInterned(nameStr);
+ nameSymbolCache.put(nameStr, ret);
+ }
+ return ret;
}
@Override
@@ -798,13 +820,140 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI {
}
@Override
- public void Rf_copyListMatrix(Object s, Object t, int byrow) {
+ public void Rf_copyListMatrix(Object t, Object s, int byrow) {
throw unimplemented();
}
@Override
- public void Rf_copyMatrix(Object s, Object t, int byrow) {
- throw unimplemented();
+ public void Rf_copyMatrix(Object t, Object s, int byRow) {
+ int tRows = RRuntime.nrows(t);
+ int tCols = RRuntime.ncols(t);
+ final Object sav = RRuntime.asAbstractVector(s);
+ ContainerItemCopier c;
+ if (sav instanceof RAbstractContainer) {
+ int sLen = ((RAbstractContainer) sav).getLength();
+ if (sav instanceof RAbstractIntVector) {
+ c = new ContainerItemCopier() {
+ private final RAbstractIntVector sv = (RAbstractIntVector) sav;
+ private final RAbstractIntVector tv = (RAbstractIntVector) t;
+ private final Object tvStore = tv.getInternalStore();
+
+ @Override
+ public void copy(int sIdx, int tIdx) {
+ tv.setDataAt(tvStore, tIdx, sv.getDataAt(sIdx));
+ }
+ };
+ } else if (sav instanceof RAbstractDoubleVector) {
+ c = new ContainerItemCopier() {
+ private final RAbstractDoubleVector sv = (RAbstractDoubleVector) sav;
+ private final RAbstractDoubleVector tv = (RAbstractDoubleVector) t;
+ private final Object tvStore = tv.getInternalStore();
+
+ @Override
+ public void copy(int sIdx, int tIdx) {
+ tv.setDataAt(tvStore, tIdx, sv.getDataAt(sIdx));
+ }
+ };
+ } else if (sav instanceof RAbstractLogicalVector) {
+ c = new ContainerItemCopier() {
+ private final RAbstractLogicalVector sv = (RAbstractLogicalVector) sav;
+ private final RAbstractLogicalVector tv = (RAbstractLogicalVector) t;
+ private final Object tvStore = tv.getInternalStore();
+
+ @Override
+ public void copy(int sIdx, int tIdx) {
+ tv.setDataAt(tvStore, tIdx, sv.getDataAt(sIdx));
+ }
+ };
+ } else if (sav instanceof RAbstractComplexVector) {
+ c = new ContainerItemCopier() {
+ private final RAbstractComplexVector sv = (RAbstractComplexVector) sav;
+ private final RAbstractComplexVector tv = (RAbstractComplexVector) t;
+ private final Object tvStore = tv.getInternalStore();
+
+ @Override
+ public void copy(int sIdx, int tIdx) {
+ tv.setDataAt(tvStore, tIdx, sv.getDataAt(sIdx));
+ }
+ };
+ } else if (sav instanceof RAbstractStringVector) {
+ c = new ContainerItemCopier() {
+ private final RAbstractStringVector sv = (RAbstractStringVector) sav;
+ private final RAbstractStringVector tv = (RAbstractStringVector) t;
+ private final Object tvStore = tv.getInternalStore();
+
+ @Override
+ public void copy(int sIdx, int tIdx) {
+ tv.setDataAt(tvStore, tIdx, sv.getDataAt(sIdx));
+ }
+ };
+ } else if (sav instanceof RAbstractRawVector) {
+ c = new ContainerItemCopier() {
+ private final RAbstractRawVector sv = (RAbstractRawVector) sav;
+ private final RAbstractRawVector tv = (RAbstractRawVector) t;
+ private final Object tvStore = tv.getInternalStore();
+
+ @Override
+ public void copy(int sIdx, int tIdx) {
+ tv.setRawDataAt(tvStore, tIdx, sv.getRawDataAt(sIdx));
+ }
+ };
+ } else if (sav instanceof RAbstractListBaseVector) {
+ c = new ContainerItemCopier() {
+ private final RAbstractListBaseVector sv = (RAbstractListBaseVector) sav;
+ private final RAbstractListBaseVector tv = (RAbstractListBaseVector) t;
+ private final Object tvStore = tv.getInternalStore();
+
+ @Override
+ public void copy(int sIdx, int tIdx) {
+ tv.setDataAt(tvStore, tIdx, sv.getDataAt(sIdx));
+ }
+ };
+ } else {
+ throw unimplemented();
+ }
+ if (byRow != 0) {
+ int sIdx = 0;
+ for (int i = 0; i < tRows; i++) {
+ int tIdx = i;
+ for (int j = 0; j < tCols; j++) {
+ c.copy(sIdx, tIdx);
+ sIdx++;
+ if (sIdx >= sLen) {
+ sIdx -= sLen;
+ }
+ tIdx += tRows;
+ }
+ }
+ } else { // Copy by column
+ int tLen = ((RAbstractContainer) t).getLength();
+ if (sLen >= tLen) {
+ for (int i = 0; i < tLen; i++) {
+ c.copy(i, i);
+ }
+ } else { // Recycle needed
+ int sIdx = 0;
+ for (int i = 0; i < tLen; i++) {
+ c.copy(sIdx, i);
+ if (sIdx >= sLen) {
+ sIdx -= sLen;
+ }
+ }
+ }
+ }
+
+ } else { // source is non-RAbstractContainer
+ throw unimplemented();
+ }
+ }
+
+ /**
+ * Helper interface for {@link #Rf_copyMatrix(java.lang.Object, java.lang.Object, int)} that
+ * copies from source index in an (internally held) source container into target index in a
+ * target container.
+ */
+ interface ContainerItemCopier {
+ void copy(int sIdx, int tIdx);
}
@Override
@@ -966,7 +1115,17 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI {
@Override
public int IS_S4_OBJECT(Object x) {
- return x instanceof RS4Object ? 1 : 0;
+ return ((x instanceof RTypedValue) && ((RTypedValue) x).isS4()) ? 1 : 0;
+ }
+
+ @Override
+ public void SET_S4_OBJECT(Object x) {
+ guaranteeInstanceOf(x, RTypedValue.class).setS4();
+ }
+
+ @Override
+ public void UNSET_S4_OBJECT(Object x) {
+ guaranteeInstanceOf(x, RTypedValue.class).unsetS4();
}
@Override
@@ -1264,4 +1423,19 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI {
return conn.isSeekable();
}
+ @Override
+ public Object R_do_slot(Object o, Object name) {
+ return FFIUpCallRootNode.getCallTarget(RFFIUpCallMethod.R_do_slot).call(o, name);
+ }
+
+ @Override
+ public Object R_do_slot_assign(Object o, Object name, Object value) {
+ return FFIUpCallRootNode.getCallTarget(RFFIUpCallMethod.R_do_slot_assign).call(o, name, value);
+ }
+
+ @Override
+ public Object R_MethodsNamespace() {
+ return REnvironment.getRegisteredNamespace("methods");
+ }
+
}
diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/MiscNodes.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/MiscNodes.java
index f3e2f0edc2..3a1ee7f7de 100644
--- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/MiscNodes.java
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/MiscNodes.java
@@ -26,8 +26,15 @@ import com.oracle.truffle.api.CompilerDirectives;
import com.oracle.truffle.api.dsl.Fallback;
import com.oracle.truffle.api.dsl.Specialization;
import com.oracle.truffle.api.dsl.TypeSystemReference;
+import com.oracle.truffle.r.nodes.access.AccessSlotNode;
+import com.oracle.truffle.r.nodes.access.AccessSlotNodeGen;
+import com.oracle.truffle.r.nodes.access.UpdateSlotNode;
+import com.oracle.truffle.r.nodes.access.UpdateSlotNodeGen;
+import com.oracle.truffle.r.nodes.objects.NewObject;
+import com.oracle.truffle.r.nodes.objects.NewObjectNodeGen;
import com.oracle.truffle.r.runtime.RError;
import com.oracle.truffle.r.runtime.data.RNull;
+import com.oracle.truffle.r.runtime.data.RSymbol;
import com.oracle.truffle.r.runtime.data.RTypes;
import com.oracle.truffle.r.runtime.data.model.RAbstractContainer;
import com.oracle.truffle.r.runtime.ffi.CharSXPWrapper;
@@ -80,4 +87,63 @@ public final class MiscNodes {
throw RError.error(RError.SHOW_CALLER2, RError.Message.LENGTH_MISAPPLIED, SEXPTYPE.gnuRTypeForObject(obj).name());
}
}
+
+ @TypeSystemReference(RTypes.class)
+ abstract static class RDoSlotNode extends FFIUpCallNode.Arg2 {
+
+ @Child private AccessSlotNode accessSlotNode;
+
+ RDoSlotNode() {
+ accessSlotNode = AccessSlotNodeGen.create(false);
+ }
+
+ @Specialization
+ Object doSlot(Object o, RSymbol nameSym) {
+ return accessSlotNode.executeAccess(o, nameSym.getName());
+ }
+
+ @Fallback
+ Object doSlot(@SuppressWarnings("unused") Object o, @SuppressWarnings("unused") Object name) {
+ throw RError.error(RError.SHOW_CALLER2, RError.Message.INVALID_ARGUMENT_OF_TYPE, "name", SEXPTYPE.gnuRTypeForObject(name).name());
+ }
+
+ }
+
+ @TypeSystemReference(RTypes.class)
+ abstract static class RDoSlotAssignNode extends FFIUpCallNode.Arg3 {
+
+ @Child private UpdateSlotNode updateSlotNode;
+
+ RDoSlotAssignNode() {
+ updateSlotNode = UpdateSlotNodeGen.create();
+ }
+
+ @Specialization
+ Object doSlotAssign(Object o, String name, Object value) {
+ return updateSlotNode.executeUpdate(o, name, value);
+ }
+
+ @Fallback
+ Object doSlot(@SuppressWarnings("unused") Object o, Object name, @SuppressWarnings("unused") Object value) {
+ throw RError.error(RError.SHOW_CALLER2, RError.Message.INVALID_ARGUMENT_OF_TYPE, "name", SEXPTYPE.gnuRTypeForObject(name).name());
+ }
+
+ }
+
+ @TypeSystemReference(RTypes.class)
+ abstract static class RDoNewObjectNode extends FFIUpCallNode.Arg1 {
+
+ @Child private NewObject newObjectNode;
+
+ RDoNewObjectNode() {
+ newObjectNode = NewObjectNodeGen.create();
+ }
+
+ @Specialization
+ Object doNewObject(Object classDef) {
+ return newObjectNode.execute(classDef);
+ }
+
+ }
+
}
diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/RFFIUpCallMethod.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/RFFIUpCallMethod.java
index 25d2f9f385..f3a19b0033 100644
--- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/RFFIUpCallMethod.java
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/RFFIUpCallMethod.java
@@ -81,6 +81,9 @@ public enum RFFIUpCallMethod {
R_WriteConnection("(sint32, object) : sint32"),
R_computeIdentical("(object, object, sint32) : sint32"),
R_do_MAKE_CLASS("(string) : object"),
+ R_do_new_object("(object) : object"),
+ R_do_slot("(object, object) : object"),
+ R_do_slot_assign("(object, object, object) : object"),
R_getContextCall("(object) : object"),
R_getContextEnv("(object) : object"),
R_getContextFun("(object) : object"),
diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/TracingUpCallsRFFIImpl.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/TracingUpCallsRFFIImpl.java
index b89d83cc56..9ad307eea7 100644
--- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/TracingUpCallsRFFIImpl.java
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/TracingUpCallsRFFIImpl.java
@@ -117,6 +117,12 @@ final class TracingUpCallsRFFIImpl implements UpCallsRFFI {
return delegate.R_do_MAKE_CLASS(clazz);
}
+ @Override
+ public Object R_do_new_object(Object classDef) {
+ RFFIUtils.traceUpCall("R_do_new_object", classDef);
+ return delegate.R_do_new_object(classDef);
+ }
+
@Override
public Object Rf_findVar(Object symbolArg, Object envArg) {
RFFIUtils.traceUpCall("Rf_findVar", symbolArg, envArg);
@@ -579,6 +585,18 @@ final class TracingUpCallsRFFIImpl implements UpCallsRFFI {
return delegate.IS_S4_OBJECT(x);
}
+ @Override
+ public void SET_S4_OBJECT(Object x) {
+ RFFIUtils.traceUpCall("setS4Object");
+ delegate.SET_S4_OBJECT(x);
+ }
+
+ @Override
+ public void UNSET_S4_OBJECT(Object x) {
+ RFFIUtils.traceUpCall("unsetS4Object");
+ delegate.UNSET_S4_OBJECT(x);
+ }
+
@Override
public void Rprintf(Object message) {
RFFIUtils.traceUpCall("Rprintf", message);
@@ -789,4 +807,22 @@ final class TracingUpCallsRFFIImpl implements UpCallsRFFI {
return delegate.isSeekable(x);
}
+ @Override
+ public Object R_do_slot(Object o, Object name) {
+ RFFIUtils.traceUpCall("R_do_slot", o, name);
+ return delegate.R_do_slot(o, name);
+ }
+
+ @Override
+ public Object R_do_slot_assign(Object o, Object name, Object value) {
+ RFFIUtils.traceUpCall("R_do_slot", o, name, value);
+ return delegate.R_do_slot_assign(o, name, value);
+ }
+
+ @Override
+ public Object R_MethodsNamespace() {
+ RFFIUtils.traceUpCall("R_MethodsNamespace");
+ return delegate.R_MethodsNamespace();
+ }
+
}
diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/objects/CollectGenericArgumentsNode.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/objects/CollectGenericArgumentsNode.java
index 3acb958ef9..6b57fd298b 100644
--- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/objects/CollectGenericArgumentsNode.java
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/objects/CollectGenericArgumentsNode.java
@@ -1,5 +1,5 @@
/*
- * Copyright (c) 2015, 2016, Oracle and/or its affiliates. All rights reserved.
+ * Copyright (c) 2015, 2017, 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
@@ -39,7 +39,9 @@ import com.oracle.truffle.r.nodes.function.PromiseHelperNode;
import com.oracle.truffle.r.nodes.function.PromiseHelperNode.PromiseCheckHelperNode;
import com.oracle.truffle.r.runtime.Utils;
import com.oracle.truffle.r.runtime.data.RDataFactory;
+import com.oracle.truffle.r.runtime.data.REmpty;
import com.oracle.truffle.r.runtime.data.RList;
+import com.oracle.truffle.r.runtime.data.RMissing;
import com.oracle.truffle.r.runtime.data.RPromise;
import com.oracle.truffle.r.runtime.data.RStringVector;
import com.oracle.truffle.r.runtime.data.RSymbol;
@@ -90,6 +92,9 @@ public abstract class CollectGenericArgumentsNode extends RBaseNode {
throw new SlowPathException();
}
Object value = argReads[i].execute(frame);
+ if (value == REmpty.instance || value == RMissing.instance) {
+ value = null;
+ }
result[i] = valueMissingProfile.profile(value == null) ? "missing" : classHierarchyNodes[i].executeString(promiseHelper.checkEvaluate(frame, value));
}
return RDataFactory.createStringVector(result, RDataFactory.COMPLETE_VECTOR);
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/StdUpCallsRFFI.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/StdUpCallsRFFI.java
index dceb6d282d..75132c6fe4 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/StdUpCallsRFFI.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/StdUpCallsRFFI.java
@@ -22,6 +22,7 @@
*/
package com.oracle.truffle.r.runtime.ffi;
+import com.oracle.truffle.r.runtime.conn.ConnectionSupport.BaseRConnection;
import com.oracle.truffle.r.runtime.data.RDoubleVector;
import com.oracle.truffle.r.runtime.data.RExternalPtr;
import com.oracle.truffle.r.runtime.data.RIntVector;
@@ -73,6 +74,8 @@ public interface StdUpCallsRFFI {
Object R_do_MAKE_CLASS(@RFFICstring Object clazz);
+ Object R_do_new_object(Object classDef);
+
/**
* WARNING: argument order reversed from Rf_findVarInFrame!
*/
@@ -216,6 +219,10 @@ public interface StdUpCallsRFFI {
int IS_S4_OBJECT(Object x);
+ void SET_S4_OBJECT(Object x);
+
+ void UNSET_S4_OBJECT(Object x);
+
void Rprintf(@RFFICstring Object message);
void GetRNGstate();
@@ -270,4 +277,10 @@ public interface StdUpCallsRFFI {
boolean isSeekable(Object x);
+ Object R_do_slot(Object o, Object name);
+
+ Object R_do_slot_assign(Object o, Object name, Object value);
+
+ Object R_MethodsNamespace();
+
}
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 98500f6ccb..339c400826 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
@@ -44815,6 +44815,42 @@ age 0.00561 0.012 0.00872 0.22 1.0 0.64000
sex -1.65487 0.483 0.38527 11.74 1.0 0.00061
frailty(id, dist = 't', c 20.33 13.9 0.12000
+##com.oracle.truffle.r.test.builtins.TestBuiltin_prod.testProd#
+#{prod('a')}
+Error in prod("a") : invalid 'type' (character) of argument
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_prod.testProd#
+#{prod()}
+[1] 1
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_prod.testProd#
+#{prod(2+3i,42)}
+[1] 84+126i
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_prod.testProd#
+#{prod(2+3i,42+5i)}
+[1] 69+136i
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_prod.testProd#
+#{prod(2+3i,c())}
+[1] 2+3i
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_prod.testProd#
+#{prod(42,2+3i)}
+[1] 84+126i
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_prod.testProd#
+#{prod(NULL)}
+[1] 1
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_prod.testProd#
+#{prod(c())}
+[1] 1
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_prod.testProd#
+#{prod(c(),c())}
+[1] 1
+
##com.oracle.truffle.r.test.builtins.TestBuiltin_prod.testProd#
#{prod(c(1+2i))}
[1] 1+2i
@@ -44847,6 +44883,10 @@ frailty(id, dist = 't', c 20.33 13.9 0.12000
#{prod(c(TRUE, TRUE))}
[1] 1
+##com.oracle.truffle.r.test.builtins.TestBuiltin_prod.testProd#
+#{prod(list())}
+Error in prod(list()) : invalid 'type' (list) of argument
+
##com.oracle.truffle.r.test.builtins.TestBuiltin_prod.testProdNa#Ignored.Unknown#
#{prod(c(1,2,3,4,5,NA),FALSE)}
[1] NA
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_prod.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_prod.java
index 264a3af783..4adffd95dc 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_prod.java
+++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_prod.java
@@ -4,7 +4,7 @@
* http://www.gnu.org/licenses/gpl-2.0.html
*
* Copyright (c) 2012-2014, Purdue University
- * Copyright (c) 2013, 2016, Oracle and/or its affiliates
+ * Copyright (c) 2013, 2017, Oracle and/or its affiliates
*
* All rights reserved.
*/
@@ -82,6 +82,16 @@ public class TestBuiltin_prod extends TestBase {
assertEval("{prod(c(1+2i,1+3i,1+45i))}");
assertEval("{prod(c(TRUE, TRUE))}");
assertEval("{prod(c(TRUE, FALSE))}");
+ assertEval("{prod()}");
+ assertEval("{prod(NULL)}");
+ assertEval("{prod(c())}");
+ assertEval("{prod(c(),c())}");
+ assertEval("{prod(2+3i,c())}");
+ assertEval("{prod(2+3i,42+5i)}");
+ assertEval("{prod(2+3i,42)}");
+ assertEval("{prod(42,2+3i)}");
+ assertEval("{prod('a')}");
+ assertEval("{prod(list())}");
}
@Test
--
GitLab