diff --git a/com.oracle.truffle.r.native/fficall/jni/src/listaccess.c b/com.oracle.truffle.r.native/fficall/jni/src/listaccess.c
index 89d264e651ab7192824fdd25e9c260b8f85d1ca2..d42f705aa86216456f96c062fdb1ae32dc7b54b1 100644
--- a/com.oracle.truffle.r.native/fficall/jni/src/listaccess.c
+++ b/com.oracle.truffle.r.native/fficall/jni/src/listaccess.c
@@ -24,67 +24,86 @@
#include "rffiutils.h"
static jmethodID CADR_MethodID;
+static jmethodID TAG_MethodID;
+static jmethodID PRINTNAME_MethodID;
static jmethodID CAR_MethodID;
static jmethodID CDR_MethodID;
static jmethodID SETCAR_MethodID;
static jmethodID SETCDR_MethodID;
void init_listaccess(JNIEnv *env) {
- CADR_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "CADR", "(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);
- 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);
+ CADR_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "CADR", "(Ljava/lang/Object;)Ljava/lang/Object;", 1);
+ TAG_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "TAG", "(Ljava/lang/Object;)Ljava/lang/Object;", 1);
+ 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);
+ 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);
}
SEXP TAG(SEXP e) {
- unimplemented("TAG");
+ JNIEnv *thisenv = getEnv();
+ SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, TAG_MethodID, e);
+ return checkRef(thisenv, result);
+}
+
+SEXP PRINTNAME(SEXP e) {
+ JNIEnv *thisenv = getEnv();
+ SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, PRINTNAME_MethodID, e);
+ return checkRef(thisenv, result);
}
SEXP CAR(SEXP e) {
- JNIEnv *thisenv = getEnv();
+ JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, CAR_MethodID, e);
return checkRef(thisenv, result);
}
SEXP CDR(SEXP e) {
- JNIEnv *thisenv = getEnv();
+ JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, CDR_MethodID, e);
return checkRef(thisenv, result);
}
SEXP CAAR(SEXP e) {
unimplemented("CAAR");
+ return NULL;
}
SEXP CDAR(SEXP e) {
unimplemented("CDAR");
+ return NULL;
}
SEXP CADR(SEXP e) {
- JNIEnv *thisenv = getEnv();
- SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, CADR_MethodID, e);
+ JNIEnv *thisenv = getEnv();
+ SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, CADR_MethodID, e);
return checkRef(thisenv, result);
}
SEXP CDDR(SEXP e) {
unimplemented("CDDR");
+ return NULL;
}
SEXP CADDR(SEXP e) {
unimplemented("CADDR");
+ return NULL;
}
SEXP CADDDR(SEXP e) {
unimplemented("CADDDR");
+ return NULL;
}
SEXP CAD4R(SEXP e) {
unimplemented("CAD4R");
+ return NULL;
}
int MISSING(SEXP x){
unimplemented("MISSING");
+ return 0;
}
void SET_MISSING(SEXP x, int v) {
@@ -96,30 +115,34 @@ void SET_TAG(SEXP x, SEXP y) {
}
SEXP SETCAR(SEXP x, SEXP y) {
- JNIEnv *thisenv = getEnv();
- SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, SETCAR_MethodID, x, y);
+ JNIEnv *thisenv = getEnv();
+ SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, SETCAR_MethodID, x, y);
return checkRef(thisenv, result);
}
SEXP SETCDR(SEXP x, SEXP y) {
- JNIEnv *thisenv = getEnv();
- SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, SETCDR_MethodID, x, y);
+ JNIEnv *thisenv = getEnv();
+ SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, SETCDR_MethodID, x, y);
return checkRef(thisenv, result);
}
SEXP SETCADR(SEXP x, SEXP y) {
unimplemented("SETCADR");
+ return NULL;
}
SEXP SETCADDR(SEXP x, SEXP y) {
unimplemented("SETCADDR");
+ return NULL;
}
SEXP SETCADDDR(SEXP x, SEXP y) {
unimplemented("SETCADDDR");
+ return NULL;
}
SEXP SETCAD4R(SEXP e, SEXP y) {
unimplemented("SETCAD4R");
+ return NULL;
}
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 e65b8fd3eed777b6a5759824e65679613b1693c2..7c7dfaf7dfc18fb1c285d9ddd78198b0959c01b2 100644
--- a/com.oracle.truffle.r.native/fficall/jni/src/misc.c
+++ b/com.oracle.truffle.r.native/fficall/jni/src/misc.c
@@ -101,12 +101,6 @@ int R_IsNaN(double x) {
return (*env)->CallStaticBooleanMethod(env, RRuntimeClass, isNAorNaNMethodID, x);
}
-void Rprintf(const char *msg, ...) {
- va_list argptr;
- va_start(argptr, msg);
- vprintf(msg, argptr);
-}
-
void REprintf(const char *x, ...) {
unimplemented("REprintf");
}
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 d12b27843470d3f842508c4c6f9129b04b19361e..701ba94083b67c316697dbf5a4b129752c44eb9d 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
@@ -48,6 +48,7 @@ static jmethodID Rf_errorMethodID;
static jmethodID Rf_NewHashedEnvMethodID;
static jmethodID Rf_rPsortMethodID;
static jmethodID Rf_iPsortMethodID;
+static jmethodID RprintfMethodID;
void init_rf_functions(JNIEnv *env) {
Rf_ScalarIntegerMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_ScalarInteger", "(I)Lcom/oracle/truffle/r/runtime/data/RIntVector;", 1);
@@ -70,6 +71,7 @@ void init_rf_functions(JNIEnv *env) {
Rf_allocateArrayMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_allocateArray", "(ILjava/lang/Object;)Ljava/lang/Object;", 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);
+ RprintfMethodID = checkGetMethodID(env, CallRFFIHelperClass, "printf", "(Ljava/lang/String;)V", 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);
}
@@ -462,6 +464,17 @@ void Rf_warning(const char *format, ...) {
(*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, Rf_warningMethodID, string);
}
+void Rprintf(const char *format, ...) {
+ char buf[8192];
+ va_list(ap);
+ va_start(ap,format);
+ Rvsnprintf(buf, BUFSIZE - 1, format, ap);
+ va_end(ap);
+ JNIEnv *thisenv = getEnv();
+ jstring string = (*thisenv)->NewStringUTF(thisenv, buf);
+ (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, RprintfMethodID, string);
+}
+
// Tools package support, not in public API
SEXP R_NewHashedEnv(SEXP parent, SEXP size) {
diff --git a/com.oracle.truffle.r.native/fficall/jni/src/rffiutils.c b/com.oracle.truffle.r.native/fficall/jni/src/rffiutils.c
index f253d4d0f78f22f071fe885dbc198cad8cbb734c..1dffea84bdb39b507ec6b35a660ae25387b7a8fb 100644
--- a/com.oracle.truffle.r.native/fficall/jni/src/rffiutils.c
+++ b/com.oracle.truffle.r.native/fficall/jni/src/rffiutils.c
@@ -229,7 +229,10 @@ void setEnv(JNIEnv *env) {
void *unimplemented(char *msg) {
JNIEnv *thisenv = getEnv();
- (*thisenv)->FatalError(thisenv, msg);
+ char buf[1024];
+ strcpy(buf, "unimplemented ");
+ strcat(buf, msg);
+ (*thisenv)->FatalError(thisenv, buf);
// to keep compiler happy
return NULL;
}
diff --git a/com.oracle.truffle.r.native/fficall/jni/src/unimplemented.c b/com.oracle.truffle.r.native/fficall/jni/src/unimplemented.c
new file mode 100644
index 0000000000000000000000000000000000000000..52af2ca1bcc41053c4eb2062770453d19ac9ffac
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/jni/src/unimplemented.c
@@ -0,0 +1,23 @@
+/*
+ * Copyright (c) 2015, 2015, 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
+ * under the terms of the GNU General Public License version 2 only, as
+ * published by the Free Software Foundation.
+ *
+ * This code is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+ * version 2 for more details (a copy is included in the LICENSE file that
+ * accompanied this code).
+ *
+ * You should have received a copy of the GNU General Public License version
+ * 2 along with this work; if not, write to the Free Software Foundation,
+ * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA.
+ *
+ * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA
+ * or visit www.oracle.com if you need additional information or have any
+ * questions.
+ */
+#include "rffiutils.h"
diff --git a/com.oracle.truffle.r.native/fficall/jni/src/variables.c b/com.oracle.truffle.r.native/fficall/jni/src/variables.c
index 15ac1ac69e05996d6b9d21b54a3cb7f1f6b2c39c..dd7340fd544d9cfc436717f8fd26c5eb3bdfaad0 100644
--- a/com.oracle.truffle.r.native/fficall/jni/src/variables.c
+++ b/com.oracle.truffle.r.native/fficall/jni/src/variables.c
@@ -51,6 +51,7 @@ SEXP R_BracketSymbol; /* "[" */
SEXP R_BraceSymbol; /* "{" */
SEXP R_ClassSymbol; /* "class" */
SEXP R_DeviceSymbol; /* ".Device" */
+SEXP R_DevicesSymbol; /* ".Devices" */
SEXP R_DimNamesSymbol; /* "dimnames" */
SEXP R_DimSymbol; /* "dim" */
SEXP R_DollarSymbol; /* "$" */
@@ -86,6 +87,15 @@ double R_NegInf; /* IEEE -Inf */
double R_NaReal; /* NA_REAL: IEEE */
int R_NaInt; /* NA_INTEGER:= INT_MIN currently */
+// from Defn.h
+const char* R_Home;
+const char* R_TempDir;
+Rboolean R_Visible; // ignored
+Rboolean R_interrupts_suspended; // ignored
+int R_interrupts_pending; // ignored
+Rboolean mbcslocale; // ignored
+Rboolean useaqua; // ignored
+
jmethodID getGlobalEnvMethodID;
jmethodID getBaseEnvMethodID;
jmethodID getBaseNamespaceMethodID;
@@ -95,28 +105,27 @@ jmethodID isInteractiveMethodID;
// R_GlobalEnv et al are not a variables in FASTR as they are RContext specific
SEXP FASTR_GlobalEnv() {
JNIEnv *env = getEnv();
- (*env)->CallStaticObjectMethod(env, CallRFFIHelperClass, getGlobalEnvMethodID);
+ return (*env)->CallStaticObjectMethod(env, CallRFFIHelperClass, getGlobalEnvMethodID);
}
SEXP FASTR_BaseEnv() {
JNIEnv *env = getEnv();
- (*env)->CallStaticObjectMethod(env, CallRFFIHelperClass, getBaseEnvMethodID);
+ return (*env)->CallStaticObjectMethod(env, CallRFFIHelperClass, getBaseEnvMethodID);
}
SEXP FASTR_BaseNamespace() {
JNIEnv *env = getEnv();
- (*env)->CallStaticObjectMethod(env, CallRFFIHelperClass, getBaseNamespaceMethodID);
+ return (*env)->CallStaticObjectMethod(env, CallRFFIHelperClass, getBaseNamespaceMethodID);
}
SEXP FASTR_NamespaceRegistry() {
JNIEnv *env = getEnv();
- (*env)->CallStaticObjectMethod(env, CallRFFIHelperClass, getNamespaceRegistryMethodID);
+ return (*env)->CallStaticObjectMethod(env, CallRFFIHelperClass, getNamespaceRegistryMethodID);
}
Rboolean FASTR_IsInteractive() {
JNIEnv *env = getEnv();
- int r = (*env)->CallStaticObjectMethod(env, CallRFFIHelperClass, isInteractiveMethodID);
- return r;
+ return (*env)->CallStaticIntMethod(env, CallRFFIHelperClass, isInteractiveMethodID);
}
@@ -140,13 +149,18 @@ void init_variables(JNIEnv *env, jobjectArray initialValues) {
int length = (*env)->GetArrayLength(env, initialValues);
int index;
+ int globalRefIndex = 0;
for (index = 0; index < length; index++) {
jobject variable = (*env)->GetObjectArrayElement(env, initialValues, index);
jstring nameString = (*env)->CallObjectMethod(env, variable, nameMethodID);
const char *nameChars = (*env)->GetStringUTFChars(env, nameString, NULL);
jobject value = (*env)->CallObjectMethod(env, variable, getValueMethodID);
if (value != NULL) {
- if (strcmp(nameChars, "R_NaN") == 0) {
+ if (strcmp(nameChars, "R_Home") == 0) {
+ R_Home = (*env)->GetStringUTFChars(env, value, NULL);
+ } else if (strcmp(nameChars, "R_TempDir") == 0) {
+ R_TempDir = (*env)->GetStringUTFChars(env, value, NULL);
+ } else if (strcmp(nameChars, "R_NaN") == 0) {
R_NaN = (*env)->CallDoubleMethod(env, value, doubleValueMethodID);
} else if (strcmp(nameChars, "R_PosInf") == 0) {
R_PosInf = (*env)->CallDoubleMethod(env, value, doubleValueMethodID);
@@ -155,9 +169,9 @@ void init_variables(JNIEnv *env, jobjectArray initialValues) {
} else if (strcmp(nameChars, "R_NaReal") == 0) {
R_NaReal = (*env)->CallDoubleMethod(env, value, doubleValueMethodID);
} else if (strcmp(nameChars, "R_NaInt") == 0) {
- R_NaInt = (*env)->CallIntMethod(env, value, doubleValueMethodID);
+ R_NaInt = (*env)->CallIntMethod(env, value, intValueMethodID);
} else {
- SEXP ref = mkNamedGlobalRef(env, index, value);
+ SEXP ref = mkNamedGlobalRef(env, globalRefIndex++, value);
if (strcmp(nameChars, "R_EmptyEnv") == 0) {
R_EmptyEnv = ref;
} else if (strcmp(nameChars, "R_NilValue") == 0) {
@@ -176,6 +190,8 @@ void init_variables(JNIEnv *env, jobjectArray initialValues) {
R_ClassSymbol = ref;
} else if (strcmp(nameChars, "R_DeviceSymbol") == 0) {
R_DeviceSymbol = ref;
+ } else if (strcmp(nameChars, "R_DevicesSymbol") == 0) {
+ R_DevicesSymbol = ref;
} else if (strcmp(nameChars, "R_DimNamesSymbol") == 0) {
R_DimNamesSymbol = ref;
} else if (strcmp(nameChars, "R_DimSymbol") == 0) {
diff --git a/com.oracle.truffle.r.native/fficall/jni/src/vectoraccess.c b/com.oracle.truffle.r.native/fficall/jni/src/vectoraccess.c
index 09331a5c51c76112fd5a08342fa2527042ac2d1c..6a23ac0e553114624b5e8ea8ace177c78d030bea 100644
--- a/com.oracle.truffle.r.native/fficall/jni/src/vectoraccess.c
+++ b/com.oracle.truffle.r.native/fficall/jni/src/vectoraccess.c
@@ -39,7 +39,7 @@ void init_vectoraccess(JNIEnv *env) {
SET_VECTOR_ELT_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "SET_VECTOR_ELT", "(Ljava/lang/Object;ILjava/lang/Object;)V", 1);
RAW_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "RAW", "(Ljava/lang/Object;)[B", 1);
REAL_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "REAL", "(Ljava/lang/Object;)[D", 1);
- LOGICAL_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "LOGICAL", "(Ljava/lang/Object;)[B", 1);
+ LOGICAL_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "LOGICAL", "(Ljava/lang/Object;)[I", 1);
INTEGER_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "INTEGER", "(Ljava/lang/Object;)[I", 1);
STRING_ELT_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "STRING_ELT", "(Ljava/lang/Object;I)Ljava/lang/String;", 1);
VECTOR_ELT_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "VECTOR_ELT", "(Ljava/lang/Object;I)Ljava/lang/Object;", 1);
@@ -48,68 +48,74 @@ void init_vectoraccess(JNIEnv *env) {
int LENGTH(SEXP x) {
- TRACE(TARG1, x);
- JNIEnv *thisenv = getEnv();
- return (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, LENGTH_MethodID, x);
+ TRACE(TARG1, x);
+ JNIEnv *thisenv = getEnv();
+ return (*thisenv)->CallStaticIntMethod(thisenv, CallRFFIHelperClass, LENGTH_MethodID, x);
}
R_len_t Rf_length(SEXP x) {
- return LENGTH(x);
+ return LENGTH(x);
}
R_xlen_t Rf_xlength(SEXP x) {
// xlength seems to be used for long vectors (no such thing in FastR at the moment)
- return LENGTH(x);
+ return LENGTH(x);
}
int TRUELENGTH(SEXP x){
- unimplemented("unimplemented");
+ unimplemented("unimplemented");
+ return 0;
}
void SETLENGTH(SEXP x, int v){
- unimplemented("SETLENGTH");
+ unimplemented("SETLENGTH");
}
void SET_TRUELENGTH(SEXP x, int v){
- unimplemented("SET_TRUELENGTH");
+ unimplemented("SET_TRUELENGTH");
}
R_xlen_t XLENGTH(SEXP x){
- unimplemented("XLENGTH");
+ // xlength seems to be used for long vectors (no such thing in FastR at the moment)
+ return LENGTH(x);
}
R_xlen_t XTRUELENGTH(SEXP x){
unimplemented("XTRUELENGTH");
+ return 0;
}
int IS_LONG_VEC(SEXP x){
unimplemented("IS_LONG_VEC");
+ return 0;
}
int LEVELS(SEXP x){
unimplemented("LEVELS");
+ return 0;
}
int SETLEVELS(SEXP x, int v){
unimplemented("SETLEVELS");
+ return 0;
}
int *LOGICAL(SEXP x){
TRACE(TARG1, x);
JNIEnv *thisenv = getEnv();
- jbyte *data = (jint *) findCopiedObject(thisenv, x);
+ jint *data = (jint *) findCopiedObject(thisenv, x);
if (data == NULL) {
jintArray intArray = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, LOGICAL_MethodID, x);
int len = (*thisenv)->GetArrayLength(thisenv, intArray);
- data = (*thisenv)->GetByteArrayElements(thisenv, intArray, NULL);
+ data = (*thisenv)->GetIntArrayElements(thisenv, intArray, NULL);
addCopiedObject(thisenv, x, LGLSXP, intArray, data);
}
return data;
@@ -143,20 +149,21 @@ Rbyte *RAW(SEXP x){
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);
+ 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);
}
- return data;
+ return data;
}
Rcomplex *COMPLEX(SEXP x){
unimplemented("COMPLEX");
+ return NULL;
}
@@ -189,9 +196,12 @@ SEXP SET_VECTOR_ELT(SEXP x, R_xlen_t i, SEXP v){
SEXP *STRING_PTR(SEXP x){
unimplemented("STRING_PTR");
+ return NULL;
}
SEXP *VECTOR_PTR(SEXP x){
unimplemented("VECTOR_PTR");
+ return NULL;
}
+
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 61f7a7e7d838231aa85fb903b114fc92dd898bf9..5a0572fb4e04cad581d50f042761b415baea8671 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
@@ -40,6 +40,43 @@ import com.oracle.truffle.r.runtime.ops.na.*;
public class CallRFFIHelper {
@SuppressWarnings("unused") private static final NACheck elementNACheck = NACheck.create();
+ private static RuntimeException unimplemented() {
+ return unimplemented("");
+ }
+
+ private static RuntimeException unimplemented(String message) {
+ System.out.println(message);
+ try {
+ throw RInternalError.unimplemented(message);
+ } catch (Error e) {
+ e.printStackTrace();
+ try {
+ Thread.sleep(100000);
+ } catch (InterruptedException e2) {
+ e2.printStackTrace();
+ }
+ throw e;
+ }
+ }
+
+ private static void guarantee(boolean condition) {
+ guarantee(condition, "");
+ }
+
+ private static void guarantee(boolean condition, String message) {
+ if (!condition) {
+ unimplemented(message);
+ }
+ }
+
+ private static void guaranteeInstanceOf(Object x, Class<?> clazz) {
+ if (x == null) {
+ guarantee(false, "unexpected type: null instead of " + clazz.getSimpleName());
+ } else if (!clazz.isInstance(x)) {
+ guarantee(false, "unexpected type: " + x + " is " + x.getClass().getSimpleName() + " instead of " + clazz.getSimpleName());
+ }
+ }
+
// Checkstyle: stop method name check
static RIntVector Rf_ScalarInteger(int value) {
@@ -61,40 +98,40 @@ public class CallRFFIHelper {
static int Rf_asInteger(Object x) {
if (x instanceof Integer) {
return ((Integer) x).intValue();
- } else if (x instanceof RIntVector) {
- return ((RIntVector) x).getDataAt(0);
+ } else if (x instanceof Double) {
+ return RRuntime.double2int((Double) x);
} else {
- throw RInternalError.unimplemented();
+ guaranteeInstanceOf(x, RIntVector.class);
+ return ((RIntVector) x).getDataAt(0);
}
}
static double Rf_asReal(Object x) {
if (x instanceof Double) {
return ((Double) x).doubleValue();
- } else if (x instanceof RDoubleVector) {
- return ((RDoubleVector) x).getDataAt(0);
+ } else if (x instanceof Byte) {
+ return RRuntime.logical2double((Byte) x);
} else {
- throw RInternalError.unimplemented();
+ guaranteeInstanceOf(x, RDoubleVector.class);
+ return ((RDoubleVector) x).getDataAt(0);
}
}
static int Rf_asLogical(Object x) {
if (x instanceof Byte) {
return ((Byte) x).intValue();
- } else if (x instanceof RLogicalVector) {
- return ((RLogicalVector) x).getDataAt(0);
} else {
- throw RInternalError.unimplemented();
+ guaranteeInstanceOf(x, RLogicalVector.class);
+ return ((RLogicalVector) x).getDataAt(0);
}
}
static String Rf_asChar(Object x) {
if (x instanceof String) {
return (String) x;
- } else if (x instanceof RStringVector) {
- return ((RStringVector) x).getDataAt(0);
} else {
- throw RInternalError.unimplemented();
+ guaranteeInstanceOf(x, RStringVector.class);
+ return ((RStringVector) x).getDataAt(0);
}
}
@@ -223,10 +260,12 @@ public class CallRFFIHelper {
return RDataFactory.createStringVector(new String[n], RDataFactory.COMPLETE_VECTOR);
case CPLXSXP:
return RDataFactory.createComplexVector(new double[2 * n], RDataFactory.COMPLETE_VECTOR);
+ case RAWSXP:
+ return RDataFactory.createRawVector(new byte[n]);
case VECSXP:
return RDataFactory.createList(n);
default:
- throw RInternalError.unimplemented();
+ throw unimplemented("unexpected SEXPTYPE " + type);
}
}
@@ -265,17 +304,19 @@ public class CallRFFIHelper {
case CPLXSXP:
return RDataFactory.createComplexVector(new double[2 * (nrow * ncol)], RDataFactory.COMPLETE_VECTOR, dims);
default:
- throw RInternalError.unimplemented();
+ throw unimplemented();
}
}
static int LENGTH(Object x) {
if (x instanceof RAbstractContainer) {
return ((RAbstractContainer) x).getLength();
+ } else if (x == RNull.instance) {
+ return 0;
} else if (x instanceof Integer || x instanceof Double || x instanceof Byte || x instanceof String) {
return 1;
} else {
- throw RInternalError.unimplemented();
+ throw unimplemented("unexpected value: " + x);
}
}
@@ -294,17 +335,30 @@ public class CallRFFIHelper {
static byte[] RAW(Object x) {
if (x instanceof RRawVector) {
return ((RRawVector) x).getDataWithoutCopying();
+ } else if (x instanceof RRaw) {
+ return new byte[]{((RRaw) x).getValue()};
} else {
- throw RInternalError.unimplemented();
+ throw unimplemented();
}
+ }
+ private static int toWideLogical(byte v) {
+ return RRuntime.isNA(v) ? Integer.MIN_VALUE : v;
}
- static byte[] LOGICAL(Object x) {
+ static int[] LOGICAL(Object x) {
if (x instanceof RLogicalVector) {
- return ((RLogicalVector) x).getDataWithoutCopying();
+ // TODO: this should not actually copy...
+ RLogicalVector vector = (RLogicalVector) x;
+ int[] array = new int[vector.getLength()];
+ for (int i = 0; i < vector.getLength(); i++) {
+ array[i] = toWideLogical(vector.getDataAt(i));
+ }
+ return array;
+ } else if (x instanceof Byte) {
+ return new int[]{toWideLogical((Byte) x)};
} else {
- throw RInternalError.unimplemented();
+ throw unimplemented();
}
}
@@ -312,16 +366,31 @@ public class CallRFFIHelper {
static int[] INTEGER(Object x) {
if (x instanceof RIntVector) {
return ((RIntVector) x).getDataWithoutCopying();
+ } else if (x instanceof RIntSequence) {
+ return ((RIntSequence) x).materialize().getDataWithoutCopying();
+ } else if (x instanceof Integer) {
+ return new int[]{(Integer) x};
+ } else if (x instanceof RLogicalVector) {
+ RLogicalVector vec = (RLogicalVector) x;
+ int[] result = new int[vec.getLength()];
+ for (int i = 0; i < result.length; i++) {
+ result[i] = vec.getDataAt(i);
+ }
+ return result;
} else {
- throw RInternalError.unimplemented();
+ guaranteeInstanceOf(x, Byte.class);
+ return new int[]{(Byte) x};
}
}
static double[] REAL(Object x) {
if (x instanceof RDoubleVector) {
return ((RDoubleVector) x).getDataWithoutCopying();
+ } else if (x instanceof RDoubleSequence) {
+ return ((RDoubleSequence) x).materialize().getDataWithoutCopying();
} else {
- throw RInternalError.unimplemented();
+ guaranteeInstanceOf(x, Double.class);
+ return new double[]{(Double) x};
}
}
@@ -332,7 +401,7 @@ public class CallRFFIHelper {
} else if (x instanceof RStringVector) {
return ((RStringVector) x).getDataAt(i);
} else {
- throw RInternalError.unimplemented();
+ throw unimplemented();
}
}
@@ -340,7 +409,7 @@ public class CallRFFIHelper {
if (x instanceof RList) {
return ((RList) x).getDataAt(i);
} else {
- throw RInternalError.unimplemented();
+ throw unimplemented();
}
}
@@ -348,45 +417,50 @@ public class CallRFFIHelper {
if (x instanceof RShareable) {
return ((RShareable) x).isShared() ? 1 : 0;
} else {
- throw RInternalError.unimplemented();
+ throw unimplemented();
}
}
static Object Rf_duplicate(Object x) {
- if (x instanceof RAbstractVector) {
- return ((RAbstractVector) x).copy();
- } else {
- throw RInternalError.unimplemented();
- }
+ guaranteeInstanceOf(x, RAbstractVector.class);
+ return ((RAbstractVector) x).copy();
+ }
+
+ static Object PRINTNAME(Object x) {
+ guaranteeInstanceOf(x, RSymbol.class);
+ return ((RSymbol) x).getName();
+ }
+
+ static Object TAG(Object e) {
+ guaranteeInstanceOf(e, RPairList.class);
+// System.out.println("TAG: " + e);
+ return ((RPairList) e).getTag();
}
static Object CAR(Object e) {
- if (e instanceof RPairList) {
- return ((RPairList) e).car();
- } else {
- throw RInternalError.unimplemented();
- }
+ guaranteeInstanceOf(e, RPairList.class);
+// System.out.print("CAR: " + e);
+ Object car = ((RPairList) e).car();
+// System.out.println(" = " + car);
+ return car;
}
static Object CDR(Object e) {
- if (e instanceof RPairList) {
- return ((RPairList) e).cdr();
- } else {
- throw RInternalError.unimplemented();
- }
+ guaranteeInstanceOf(e, RPairList.class);
+// System.out.print("CDR: " + e);
+ Object cdr = ((RPairList) e).cdr();
+// System.out.println(" = " + cdr);
+ return cdr;
}
static Object CADR(@SuppressWarnings("unused") Object x) {
- throw RInternalError.unimplemented();
+ throw unimplemented();
}
static Object SETCAR(Object x, Object y) {
- if (x instanceof RPairList) {
- ((RPairList) x).setCar(y);
- return x; // TODO check or y?
- } else {
- throw RInternalError.unimplemented();
- }
+ guaranteeInstanceOf(x, RPairList.class);
+ ((RPairList) x).setCar(y);
+ return x; // TODO check or y?
}
static Object SETCDR(Object x, Object y) {
@@ -427,4 +501,8 @@ public class CallRFFIHelper {
static int isS4Object(Object x) {
return x instanceof RS4Object ? 1 : 0;
}
+
+ static void printf(String message) {
+ RContext.getInstance().getConsoleHandler().print(message);
+ }
}
diff --git a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/CallRFFIWithJNI.java b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/CallRFFIWithJNI.java
index 8db325dcd80f634193a302dca4db3178ad1efb0f..7bb9ce2a1f665f61289a7e4581aa41dce8b1a67d 100644
--- a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/CallRFFIWithJNI.java
+++ b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/CallRFFIWithJNI.java
@@ -26,6 +26,7 @@ import java.util.concurrent.Semaphore;
import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary;
import com.oracle.truffle.r.runtime.FastROptions;
+import com.oracle.truffle.r.runtime.REnvVars;
import com.oracle.truffle.r.runtime.RError;
import com.oracle.truffle.r.runtime.RInternalError;
import com.oracle.truffle.r.runtime.RRuntime;
@@ -58,6 +59,8 @@ public class CallRFFIWithJNI implements CallRFFI {
private static final boolean ForceRTLDGlobal = false;
public enum RVariables {
+ R_Home(REnvVars.rHome()),
+ R_TempDir("/tmp/R_TMP"), // TODO: supply proper temp directory
R_NilValue(RNull.instance),
R_UnboundValue(RUnboundValue.instance),
R_MissingArg(RMissing.instance),
@@ -72,6 +75,7 @@ public class CallRFFIWithJNI implements CallRFFI {
R_BraceSymbol(RDataFactory.createSymbol("{")),
R_ClassSymbol(RDataFactory.createSymbol("class")),
R_DeviceSymbol(RDataFactory.createSymbol(".Device")),
+ R_DevicesSymbol(RDataFactory.createSymbol(".Devices")),
R_DimNamesSymbol(RDataFactory.createSymbol("dimnames")),
R_DimSymbol(RDataFactory.createSymbol("dim")),
R_DollarSymbol(RDataFactory.createSymbol("$")),
@@ -102,7 +106,7 @@ public class CallRFFIWithJNI implements CallRFFI {
R_NaInt(RRuntime.INT_NA),
R_BlankString(RDataFactory.createStringVectorFromScalar(""));
- private Object value;
+ private final Object value;
RVariables(Object value) {
this.value = value;
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/gnur/SEXPTYPE.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/gnur/SEXPTYPE.java
index ac6e69c202937490b948003e14d75120ccab5a4d..5fac432ac6303c5bc066df6bb0154826237ea84e 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/gnur/SEXPTYPE.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/gnur/SEXPTYPE.java
@@ -45,7 +45,7 @@ public enum SEXPTYPE {
BCODESXP(21), /* byte code */
EXTPTRSXP(22, RExternalPtr.class), /* external pointer */
WEAKREFSXP(23), /* weak reference */
- RAWSXP(24, RRawVector.class), /* raw bytes */
+ RAWSXP(24, new Class<?>[]{RRawVector.class, RRaw.class}), /* raw bytes */
S4SXP(25), /* S4 non-vector */
NEWSXP(30), /* fresh node created in new page */