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 518f113231213200799ef7efe1103ec93a5dbd9a..533787d5d3e80c48fa6efcbdf35c4414e0f72161 100644
--- a/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c
+++ b/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c
@@ -61,6 +61,7 @@ static jmethodID TAG_MethodID;
static jmethodID PRINTNAME_MethodID;
static jmethodID CAR_MethodID;
static jmethodID CDR_MethodID;
+static jmethodID CDDR_MethodID;
static jmethodID SET_TAG_MethodID;
static jmethodID SETCAR_MethodID;
static jmethodID SETCDR_MethodID;
@@ -87,6 +88,7 @@ static jmethodID OBJECT_MethodID;
static jmethodID DUPLICATE_ATTRIB_MethodID;
static jmethodID isS4ObjectMethodID;
static jmethodID logObject_MethodID;
+static jmethodID R_do_MAKE_CLASS_MethodID;
static jclass RExternalPtrClass;
static jmethodID createExternalPtrMethodID;
@@ -129,6 +131,7 @@ void init_internals(JNIEnv *env) {
Rf_anyDuplicatedMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_anyDuplicated", "(Ljava/lang/Object;I)I", 1);
Rf_NewHashedEnvMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_createNewEnv", "(Lcom/oracle/truffle/r/runtime/env/REnvironment;Ljava/lang/String;ZI)Lcom/oracle/truffle/r/runtime/env/REnvironment;", 1);
RprintfMethodID = checkGetMethodID(env, CallRFFIHelperClass, "printf", "(Ljava/lang/String;)V", 1);
+ R_do_MAKE_CLASS_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "R_do_MAKE_CLASS", "(Ljava/lang/String;)Ljava/lang/Object;", 1);
R_FindNamespaceMethodID = checkGetMethodID(env, CallRFFIHelperClass, "R_FindNamespace", "(Ljava/lang/Object;)Ljava/lang/Object;", 1);
Rf_GetOption1MethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_GetOption1", "(Ljava/lang/Object;)Ljava/lang/Object;", 1);
Rf_gsetVarMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_gsetVar", "(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)V", 1);
@@ -141,6 +144,7 @@ void init_internals(JNIEnv *env) {
PRINTNAME_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "PRINTNAME", "(Ljava/lang/Object;)Ljava/lang/Object;", 1);
CAR_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "CAR", "(Ljava/lang/Object;)Ljava/lang/Object;", 1);
CDR_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "CDR", "(Ljava/lang/Object;)Ljava/lang/Object;", 1);
+ CDDR_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "CDDR", "(Ljava/lang/Object;)Ljava/lang/Object;", 1);
SET_TAG_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "SET_TAG", "(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;", 1);
SETCAR_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "SETCAR", "(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;", 1);
SETCDR_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "SETCDR", "(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;", 1);
@@ -774,8 +778,10 @@ SEXP CADR(SEXP e) {
}
SEXP CDDR(SEXP e) {
- unimplemented("CDDR");
- return NULL;
+ TRACE(TARG1, e);
+ JNIEnv *thisenv = getEnv();
+ SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, CDDR_MethodID, e);
+ return checkRef(thisenv, result);
}
SEXP CDDDR(SEXP e) {
@@ -1279,9 +1285,19 @@ const char *R_CHAR(SEXP charsxp) {
return copyChars;
}
-void *(R_DATAPTR)(SEXP x) {
- unimplemented("R_DATAPTR");
- return NULL;
+void *DATAPTR(SEXP x) {
+ int type = TYPEOF(x);
+ if (type == INTSXP) {
+ return INTEGER(x);
+ } else if (type == REALSXP) {
+ return REAL(x);
+ } else if (type == LGLSXP) {
+ return LOGICAL(x);
+ } else {
+ printf("DATAPTR %d\n", type);
+ unimplemented("R_DATAPTR");
+ return NULL;
+ }
}
void R_qsort_I (double *v, int *II, int i, int j) {
@@ -1422,7 +1438,9 @@ int R_has_slot(SEXP obj, SEXP name) {
}
SEXP R_do_MAKE_CLASS(const char *what) {
- return unimplemented("R_do_MAKE_CLASS");
+ JNIEnv *thisenv = getEnv();
+ jstring string = (*thisenv)->NewStringUTF(thisenv, what);
+ return (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, R_do_MAKE_CLASS_MethodID, string);
}
SEXP R_getClassDef (const char *what) {
diff --git a/com.oracle.truffle.r.native/include/ed_Rinternals b/com.oracle.truffle.r.native/include/ed_Rinternals
index 9d9f7d806ac9f43faa136b74f0b1d7203cd4003f..7aaafb1cd67144dfa7bfab280f75ba96bc8861f8 100644
--- a/com.oracle.truffle.r.native/include/ed_Rinternals
+++ b/com.oracle.truffle.r.native/include/ed_Rinternals
@@ -12,6 +12,8 @@ a
i
#ifdef FASTR
typedef void *SEXP;
+#define DATAPTR(x) R_DATAPTR(x)
+void *(R_DATAPTR)(SEXP x);
#else
.
+1
diff --git a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/CallRFFIHelper.java b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/CallRFFIHelper.java
index dbc9d2dc9bfb59a5bfe699c5380a2b2e7f0fb694..db41c4c438d9bf67570cc3bdb114837bc654493d 100644
--- a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/CallRFFIHelper.java
+++ b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/CallRFFIHelper.java
@@ -230,11 +230,17 @@ public class CallRFFIHelper {
}
}
+ public static Object R_do_MAKE_CLASS(String clazz) {
+ RFunction getClass = (RFunction) RContext.getRRuntimeASTAccess().forcePromise(REnvironment.getRegisteredNamespace("methods").get("getClass"));
+ return RContext.getEngine().evalFunction(getClass, null, RCaller.createInvalid(null), clazz);
+ }
+
public static Object Rf_findVar(Object symbolArg, Object envArg) {
return findVarInFrameHelper(symbolArg, envArg, true);
}
- public static Object Rf_findVarInFrame(Object symbolArg, Object envArg) {
+ public static Object Rf_findVarInFrame(Object envArg, Object symbolArg) {
+ // important: this functions does have a different signature than findVar
return findVarInFrameHelper(symbolArg, envArg, false);
}
@@ -258,7 +264,6 @@ public class CallRFFIHelper {
env = env.getParent();
}
return RUnboundValue.instance;
-
}
public static Object Rf_getAttrib(Object obj, Object name) {
@@ -588,20 +593,50 @@ public class CallRFFIHelper {
public static Object CAR(Object e) {
guaranteeInstanceOf(e, RPairList.class);
- Object car = ((RPairList) e).car();
- return car;
+ return ((RPairList) e).car();
}
public static Object CDR(Object e) {
- guaranteeInstanceOf(e, RPairList.class);
- Object cdr = ((RPairList) e).cdr();
- return cdr;
+ if (e instanceof RLanguage) {
+ RLanguage lang = (RLanguage) e;
+ int length = RContext.getRRuntimeASTAccess().getLength(lang);
+ Object obj = RNull.instance;
+
+ // TODO: missing argument names in the tags
+ for (int i = length - 1; i >= 1; i--) {
+ Object element = RContext.getRRuntimeASTAccess().getDataAtAsObject(lang, i);
+ obj = RDataFactory.createPairList(element, obj);
+ }
+
+ return obj;
+ } else {
+ guaranteeInstanceOf(e, RPairList.class);
+ return ((RPairList) e).cdr();
+ }
+ }
+
+ public static Object CDDR(Object e) {
+ if (e instanceof RLanguage) {
+ RLanguage lang = (RLanguage) e;
+ int length = RContext.getRRuntimeASTAccess().getLength(lang);
+ Object obj = RNull.instance;
+
+ // TODO: missing argument names in the tags
+ for (int i = length - 1; i >= 2; i--) {
+ Object element = RContext.getRRuntimeASTAccess().getDataAtAsObject(lang, i);
+ obj = RDataFactory.createPairList(element, obj);
+ }
+
+ return obj;
+ } else {
+ guaranteeInstanceOf(e, RPairList.class);
+ return ((RPairList) e).cddr();
+ }
}
public static Object CADR(Object e) {
guaranteeInstanceOf(e, RPairList.class);
- Object cadr = ((RPairList) e).cadr();
- return cadr;
+ return ((RPairList) e).cadr();
}
public static Object SET_TAG(Object x, Object y) {