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 0050adfe49186425b3ab3a4976f68cb05493767a..7381ba8add245de9225446179d0878a1d82549cc 100644
--- a/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c
+++ b/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c
@@ -75,13 +75,16 @@ static jmethodID LENGTH_MethodID;
static jmethodID Rf_asIntegerMethodID;
//static jmethodID Rf_asRealMethodID;
static jmethodID Rf_asCharMethodID;
+static jmethodID Rf_mkCharLenCEMethodID;
static jmethodID Rf_asLogicalMethodID;
static jmethodID Rf_PairToVectorListMethodID;
-static jclass SEXPTYPEClass;
static jmethodID gnuRCodeForObjectMethodID;
static jmethodID NAMED_MethodID;
+static jmethodID TYPEOF_MethodID;
static jmethodID DUPLICATE_ATTRIB_MethodID;
static jmethodID iS4ObjectMethodID;
+static jmethodID logObject_MethodID;
+
static jclass RExternalPtrClass;
static jmethodID createExternalPtrMethodID;
static jmethodID externalPtrGetAddrMethodID;
@@ -91,10 +94,13 @@ static jmethodID externalPtrSetAddrMethodID;
static jmethodID externalPtrSetTagMethodID;
static jmethodID externalPtrSetProtMethodID;
+static jclass CharSXPWrapperClass;
+static jfieldID CharXSPWrapperContentsFieldID;
+
void init_internals(JNIEnv *env) {
Rf_ScalarIntegerMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_ScalarInteger", "(I)Lcom/oracle/truffle/r/runtime/data/RIntVector;", 1);
Rf_ScalarDoubleMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_ScalarDouble", "(D)Lcom/oracle/truffle/r/runtime/data/RDoubleVector;", 1);
- Rf_ScalarStringMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_ScalarString", "(Ljava/lang/String;)Lcom/oracle/truffle/r/runtime/data/RStringVector;", 1);
+ Rf_ScalarStringMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_ScalarString", "(Ljava/lang/Object;)Lcom/oracle/truffle/r/runtime/data/RStringVector;", 1);
Rf_ScalarLogicalMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_ScalarLogical", "(I)Lcom/oracle/truffle/r/runtime/data/RLogicalVector;", 1);
Rf_consMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_cons", "(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;", 1);
Rf_evalMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_eval", "(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;", 1);
@@ -122,33 +128,35 @@ void init_internals(JNIEnv *env) {
Rf_lengthgetsMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_lengthgets", "(Ljava/lang/Object;I)Ljava/lang/Object;", 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);
- 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);
- 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);
+ 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);
+ 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);
SET_STRING_ELT_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "SET_STRING_ELT", "(Ljava/lang/Object;ILjava/lang/Object;)V", 1);
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;)[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);
+ STRING_ELT_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "STRING_ELT", "(Ljava/lang/Object;I)Ljava/lang/Object;", 1);
VECTOR_ELT_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "VECTOR_ELT", "(Ljava/lang/Object;I)Ljava/lang/Object;", 1);
LENGTH_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "LENGTH", "(Ljava/lang/Object;)I", 1);
Rf_asIntegerMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_asInteger", "(Ljava/lang/Object;)I", 1);
// Rf_asRealMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_asReal", "(Ljava/lang/Object;)D", 1);
- Rf_asCharMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_asChar", "(Ljava/lang/Object;)Ljava/lang/String;", 1);
+ Rf_asCharMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_asChar", "(Ljava/lang/Object;)Ljava/lang/Object;", 1);
+ Rf_mkCharLenCEMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_mkCharLenCE", "([BI)Ljava/lang/Object;", 1);
Rf_asLogicalMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_asLogical", "(Ljava/lang/Object;)I", 1);
Rf_PairToVectorListMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_PairToVectorList", "(Ljava/lang/Object;)Ljava/lang/Object;", 1);
- SEXPTYPEClass = checkFindClass(env, "com/oracle/truffle/r/runtime/gnur/SEXPTYPE");
- gnuRCodeForObjectMethodID = checkGetMethodID(env, SEXPTYPEClass, "gnuRCodeForObject", "(Ljava/lang/Object;)I", 1);
NAMED_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "NAMED", "(Ljava/lang/Object;)I", 1);
+ TYPEOF_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "TYPEOF", "(Ljava/lang/Object;)I", 1);
DUPLICATE_ATTRIB_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "DUPLICATE_ATTRIB", "(Ljava/lang/Object;Ljava/lang/Object;)V", 1);
iS4ObjectMethodID = checkGetMethodID(env, CallRFFIHelperClass, "isS4Object", "(Ljava/lang/Object;)I", 1);
+ logObject_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "logObject", "(Ljava/lang/Object;)V", 1);
+
RExternalPtrClass = checkFindClass(env, "com/oracle/truffle/r/runtime/data/RExternalPtr");
createExternalPtrMethodID = checkGetMethodID(env, RDataFactoryClass, "createExternalPtr", "(JLjava/lang/Object;Ljava/lang/Object;)Lcom/oracle/truffle/r/runtime/data/RExternalPtr;", 1);
externalPtrGetAddrMethodID = checkGetMethodID(env, RExternalPtrClass, "getAddr", "()J", 0);
@@ -157,6 +165,21 @@ void init_internals(JNIEnv *env) {
externalPtrSetAddrMethodID = checkGetMethodID(env, RExternalPtrClass, "setAddr", "(J)V", 0);
externalPtrSetTagMethodID = checkGetMethodID(env, RExternalPtrClass, "setTag", "(Ljava/lang/Object;)V", 0);
externalPtrSetProtMethodID = checkGetMethodID(env, RExternalPtrClass, "setProt", "(Ljava/lang/Object;)V", 0);
+
+ CharSXPWrapperClass = checkFindClass(env, "com/oracle/truffle/r/runtime/ffi/jnr/CallRFFIHelper$CharSXPWrapper");
+ CharXSPWrapperContentsFieldID = checkGetFieldID(env, CharSXPWrapperClass, "contents", "Ljava/lang/String;", 0);
+}
+
+static jstring stringFromCharSXP(JNIEnv *thisenv, SEXP charsxp) {
+#if VALIDATE_REFS
+ validateRef(thisenv, charsxp, "stringFromCharSXP");
+ if (!(*thisenv)->IsInstanceOf(thisenv, charsxp, CharSXPWrapperClass)) {
+
+ (*thisenv)->CallStaticVoidMethod(thisenv, CallRFFIHelperClass, logObject_MethodID, charsxp);
+ fatalError("only CharSXPWrapper expected in stringFromCharSXP");
+ }
+#endif
+ return (*thisenv)->GetObjectField(thisenv, charsxp, CharXSPWrapperContentsFieldID);
}
SEXP Rf_ScalarInteger(int value) {
@@ -357,9 +380,10 @@ SEXP Rf_install(const char *name) {
return checkRef(thisenv, result);
}
-SEXP Rf_installChar(SEXP name) {
+SEXP Rf_installChar(SEXP charsxp) {
JNIEnv *thisenv = getEnv();
- SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, RDataFactoryClass, createSymbolMethodID, name);
+ jstring string = stringFromCharSXP(thisenv, charsxp);
+ SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, RDataFactoryClass, createSymbolMethodID, string);
return checkRef(thisenv, result);
}
@@ -398,11 +422,9 @@ SEXP Rf_mkCharLen(const char *x, int y) {
SEXP Rf_mkCharLenCE(const char *x, int len, cetype_t enc) {
JNIEnv *thisenv = getEnv();
- char buf[len + 1];
- memcpy(buf, x, len);
- buf[len] = 0;
- // TODO encoding, assume UTF for now, zero terminated
- SEXP result = (*thisenv)->NewStringUTF(thisenv, buf);
+ jbyteArray bytes = (*thisenv)->NewByteArray(thisenv, len);
+ (*thisenv)->SetByteArrayRegion(thisenv, bytes, 0, len, x);
+ SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, Rf_mkCharLenCEMethodID, bytes, (int) enc);
return checkRef(thisenv, result);
}
@@ -668,24 +690,28 @@ void Rf_gsetVar(SEXP symbol, SEXP value, SEXP rho)
}
SEXP TAG(SEXP e) {
+ TRACE(TARG1, e);
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, TAG_MethodID, e);
return checkRef(thisenv, result);
}
SEXP PRINTNAME(SEXP e) {
+ TRACE(TARG1, e);
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, PRINTNAME_MethodID, e);
return checkRef(thisenv, result);
}
SEXP CAR(SEXP e) {
+ TRACE(TARG1, e);
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, CAR_MethodID, e);
return checkRef(thisenv, result);
}
SEXP CDR(SEXP e) {
+ TRACE(TARG1, e);
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, CDR_MethodID, e);
return checkRef(thisenv, result);
@@ -702,6 +728,7 @@ SEXP CDAR(SEXP e) {
}
SEXP CADR(SEXP e) {
+ TRACE(TARG1, e);
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, CADR_MethodID, e);
return checkRef(thisenv, result);
@@ -742,17 +769,20 @@ void SET_MISSING(SEXP x, int v) {
}
void SET_TAG(SEXP x, SEXP y) {
+ TRACE(TARG2, x, y);
JNIEnv *thisenv = getEnv();
(*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, SET_TAG_MethodID, x, y);
}
SEXP SETCAR(SEXP x, SEXP y) {
+ TRACE(TARG2, 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) {
+ TRACE(TARG2, x, y);
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, SETCDR_MethodID, x, y);
return checkRef(thisenv, result);
@@ -1041,18 +1071,21 @@ SEXP STRING_ELT(SEXP x, R_xlen_t i){
SEXP VECTOR_ELT(SEXP x, R_xlen_t i){
+ TRACE(TARG2d, x, i);
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, VECTOR_ELT_MethodID, x, i);
return checkRef(thisenv, result);
}
void SET_STRING_ELT(SEXP x, R_xlen_t i, SEXP v){
+ TRACE("%s(%p, %d, %p)", x, i, v);
JNIEnv *thisenv = getEnv();
(*thisenv)->CallStaticVoidMethod(thisenv, CallRFFIHelperClass, SET_STRING_ELT_MethodID, x, i, v);
}
SEXP SET_VECTOR_ELT(SEXP x, R_xlen_t i, SEXP v){
+ TRACE("%s(%p, %d, %p)", x, i, v);
JNIEnv *thisenv = getEnv();
(*thisenv)->CallStaticVoidMethod(thisenv, CallRFFIHelperClass, SET_VECTOR_ELT_MethodID, x, i, v);
return v;
@@ -1078,6 +1111,7 @@ SEXP Rf_asChar(SEXP x){
}
SEXP Rf_PairToVectorList(SEXP x){
+ TRACE(TARG1, x);
JNIEnv *thisenv = getEnv();
SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, Rf_PairToVectorListMethodID, x);
return checkRef(thisenv, result);
@@ -1117,8 +1151,9 @@ Rcomplex Rf_asComplex(SEXP x){
}
int TYPEOF(SEXP x) {
- JNIEnv *thisenv = getEnv();
- return (*thisenv)->CallStaticIntMethod(thisenv, SEXPTYPEClass, gnuRCodeForObjectMethodID, x);
+ TRACE(TARG1, x);
+ JNIEnv *thisenv = getEnv();
+ return (*thisenv)->CallStaticIntMethod(thisenv, CallRFFIHelperClass, TYPEOF_MethodID, x);
}
SEXP ATTRIB(SEXP x){
@@ -1172,15 +1207,13 @@ char *dgettext(const char *domainname, const char *msgid) {
return (char*) msgid;
}
-const char *R_CHAR(SEXP string) {
- TRACE("%s(%p)", string);
+const char *R_CHAR(SEXP charsxp) {
+ TRACE("%s(%p)", charsxp);
+ JNIEnv *thisenv = getEnv();
// This is nasty:
// 1. the resulting character array has to be copied and zero-terminated.
// 2. It causes an (inevitable?) memory leak
- JNIEnv *thisenv = getEnv();
-#if VALIDATE_REFS
- validateRef(thisenv, string, "R_CHAR");
-#endif
+ jstring string = stringFromCharSXP(thisenv, charsxp);
jsize len = (*thisenv)->GetStringUTFLength(thisenv, string);
const char *stringChars = (*thisenv)->GetStringUTFChars(thisenv, string, NULL);
char *copyChars = malloc(len + 1);
diff --git a/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.c b/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.c
index aee0e8150f5fc3623c0e948fda552ac500f00128..e26fc56a969deb22b707ace5f6c5acda2b2aeb29 100644
--- a/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.c
+++ b/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.c
@@ -35,6 +35,7 @@
jclass CallRFFIHelperClass;
jclass RDataFactoryClass;
jclass RRuntimeClass;
+jclass CharSXPWrapperClass;
static jclass RInternalErrorClass;
static jmethodID unimplementedMethodID;
@@ -293,3 +294,19 @@ jmethodID checkGetMethodID(JNIEnv *env, jclass klass, const char *name, const ch
}
return methodID;
}
+
+jfieldID checkGetFieldID(JNIEnv *env, jclass klass, const char *name, const char *sig, int isStatic) {
+ jfieldID fieldID = isStatic ? (*env)->GetStaticFieldID(env, klass, name, sig) : (*env)->GetFieldID(env, klass, name, sig);
+ if (fieldID == NULL) {
+ char buf[1024];
+ strcpy(buf, "failed to find ");
+ strcat(buf, isStatic ? "static" : "instance");
+ strcat(buf, " field ");
+ strcat(buf, name);
+ strcat(buf, "(");
+ strcat(buf, sig);
+ strcat(buf, ")");
+ (*env)->FatalError(env, buf);
+ }
+ return fieldID;
+}
diff --git a/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.h b/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.h
index a31fd8b65572e53996f2d90409c0951fecf5214f..24e89fee06e97133581fbffc8068055002666ba6 100644
--- a/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.h
+++ b/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.h
@@ -37,6 +37,7 @@ void setEnv(JNIEnv *env);
jclass checkFindClass(JNIEnv *env, const char *name);
jmethodID checkGetMethodID(JNIEnv *env, jclass klass, const char *name, const char *sig, int isStatic);
+jfieldID checkGetFieldID(JNIEnv *env, jclass klass, const char *name, const char *sig, int isStatic);
extern jmethodID createSymbolMethodID;
// use for an unimplemented API function
diff --git a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/generic/Generic_Tools.java b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/generic/Generic_Tools.java
index b1e671b8850640e01de0b1f7755f5e5c38ffac6d..082d05cbbe10dc8e11782fea68312a9a94065e5c 100644
--- a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/generic/Generic_Tools.java
+++ b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/generic/Generic_Tools.java
@@ -71,7 +71,7 @@ public class Generic_Tools implements ToolsRFFI {
SymbolInfo parseRd = ToolsProvider.toolsProvider().getParseRd();
return RFFIFactory.getRFFI().getCallRFFI().invokeCall(parseRd.address, parseRd.symbol, new Object[]{con, srcfile, verbose, fragment, basename, warningCalls, macros, warndups});
} catch (Throwable ex) {
- throw RInternalError.shouldNotReachHere();
+ throw RInternalError.shouldNotReachHere(ex, "error during Rd parsing");
} finally {
parseRdCritical.release();
}
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 5be652af7b240b8ec0f12f852d636e950d4bd46b..f3dfc4acf13bda69f53cb38e612995e9b1a9a454 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
@@ -22,6 +22,8 @@
*/
package com.oracle.truffle.r.runtime.ffi.jnr;
+import java.nio.charset.StandardCharsets;
+
import com.oracle.truffle.api.source.Source;
import com.oracle.truffle.r.runtime.RArguments;
import com.oracle.truffle.r.runtime.RError;
@@ -63,7 +65,6 @@ import com.oracle.truffle.r.runtime.data.model.RAbstractVector;
import com.oracle.truffle.r.runtime.env.REnvironment;
import com.oracle.truffle.r.runtime.env.REnvironment.PutException;
import com.oracle.truffle.r.runtime.gnur.SEXPTYPE;
-import com.oracle.truffle.r.runtime.ops.na.NACheck;
/**
* This class provides methods that match the functionality of the macro/function definitions in the
@@ -72,7 +73,23 @@ import com.oracle.truffle.r.runtime.ops.na.NACheck;
* files. These methods should never be called from normal FastR code.
*/
public class CallRFFIHelper {
- @SuppressWarnings("unused") private static final NACheck elementNACheck = NACheck.create();
+
+ private static final class CharSXPWrapper {
+ private final String contents;
+
+ CharSXPWrapper(String contents) {
+ this.contents = contents;
+ }
+
+ public String getContents() {
+ return contents;
+ }
+
+ @Override
+ public String toString() {
+ return "CHARSXP(" + contents + ")";
+ }
+ }
private static RuntimeException unimplemented() {
return unimplemented("");
@@ -112,16 +129,6 @@ public class CallRFFIHelper {
return clazz.cast(x);
}
- private static <T> T guaranteeInstanceOfOrNull(Object x, Class<T> clazz) {
- if (x == null) {
- return null;
- }
- if (!clazz.isInstance(x)) {
- guarantee(false, "unexpected type: " + x + " is " + x.getClass().getSimpleName() + " instead of " + clazz.getSimpleName());
- }
- return clazz.cast(x);
- }
-
// Checkstyle: stop method name check
public static RIntVector Rf_ScalarInteger(int value) {
@@ -136,8 +143,9 @@ public class CallRFFIHelper {
return RDataFactory.createDoubleVectorFromScalar(value);
}
- public static RStringVector Rf_ScalarString(String value) {
- return RDataFactory.createStringVectorFromScalar(value);
+ public static RStringVector Rf_ScalarString(Object value) {
+ CharSXPWrapper chars = guaranteeInstanceOf(value, CharSXPWrapper.class);
+ return RDataFactory.createStringVectorFromScalar(chars.getContents());
}
public static int Rf_asInteger(Object x) {
@@ -173,13 +181,31 @@ public class CallRFFIHelper {
}
}
- public static String Rf_asChar(Object x) {
- if (x instanceof String) {
- return (String) x;
- } else {
- guaranteeInstanceOf(x, RStringVector.class);
- return ((RStringVector) x).getDataAt(0);
+ public static Object Rf_asChar(Object x) {
+ if (x instanceof CharSXPWrapper) {
+ return x;
+ } else if (x instanceof RSymbol) {
+ return new CharSXPWrapper(((RSymbol) x).getName());
}
+
+ Object obj = RRuntime.asAbstractVector(x);
+ if (obj instanceof RAbstractVector) {
+ RAbstractVector vector = (RAbstractVector) obj;
+ if (vector.getLength() > 0) {
+ if (vector instanceof RAbstractStringVector) {
+ return new CharSXPWrapper(((RAbstractStringVector) vector).getDataAt(0));
+ } else {
+ unimplemented("asChar type " + x.getClass());
+ }
+ }
+ }
+
+ return new CharSXPWrapper(RRuntime.STRING_NA);
+ }
+
+ public static Object Rf_mkCharLenCE(byte[] bytes, @SuppressWarnings("unused") int encoding) {
+ // TODO: handle encoding properly
+ return new CharSXPWrapper(new String(bytes, StandardCharsets.UTF_8));
}
public static Object Rf_cons(Object car, Object cdr) {
@@ -395,6 +421,8 @@ public class CallRFFIHelper {
return ((RAbstractContainer) x).getLength();
} else if (x == RNull.instance) {
return 0;
+ } else if (x instanceof CharSXPWrapper) {
+ return ((CharSXPWrapper) x).getContents().length();
} else if (x instanceof Integer || x instanceof Double || x instanceof Byte || x instanceof String) {
return 1;
} else {
@@ -403,9 +431,9 @@ public class CallRFFIHelper {
}
public static void SET_STRING_ELT(Object x, int i, Object v) {
- // TODO error checks
- RStringVector xv = (RStringVector) x;
- xv.setElement(i, v);
+ RStringVector vector = guaranteeInstanceOf(x, RStringVector.class);
+ CharSXPWrapper element = guaranteeInstanceOf(v, CharSXPWrapper.class);
+ vector.setElement(i, element.getContents());
}
public static void SET_VECTOR_ELT(Object x, int i, Object v) {
@@ -474,15 +502,14 @@ public class CallRFFIHelper {
}
}
- public static String STRING_ELT(Object x, int i) {
- if (x instanceof String) {
- assert i == 0;
- return (String) x;
- } else if (x instanceof RStringVector) {
- return ((RStringVector) x).getDataAt(i);
- } else {
- throw unimplemented();
- }
+ public static void logObject(Object x) {
+ System.out.println("object " + x);
+ System.out.println("class " + x.getClass());
+ }
+
+ public static Object STRING_ELT(Object x, int i) {
+ RAbstractStringVector vector = guaranteeInstanceOf(RRuntime.asAbstractVector(x), RAbstractStringVector.class);
+ return new CharSXPWrapper(vector.getDataAt(i));
}
public static Object VECTOR_ELT(Object x, int i) {
@@ -502,6 +529,14 @@ public class CallRFFIHelper {
}
}
+ public static int TYPEOF(Object x) {
+ if (x instanceof CharSXPWrapper) {
+ return SEXPTYPE.CHARSXP.code;
+ } else {
+ return SEXPTYPE.gnuRCodeForObject(x);
+ }
+ }
+
public static Object Rf_duplicate(Object x) {
guaranteeInstanceOf(x, RAbstractVector.class);
return ((RAbstractVector) x).copy();
@@ -509,7 +544,7 @@ public class CallRFFIHelper {
public static Object PRINTNAME(Object x) {
guaranteeInstanceOf(x, RSymbol.class);
- return ((RSymbol) x).getName();
+ return new CharSXPWrapper(((RSymbol) x).getName());
}
public static Object TAG(Object e) {