From 99383e263a5cb86df56c690c9edc3ca44fea53ea Mon Sep 17 00:00:00 2001
From: Mick Jordan <mick.jordan@oracle.com>
Date: Thu, 28 May 2015 18:00:25 -0700
Subject: [PATCH] RFFI implementation to support digest package
---
.../fficall/jni/src/alloc.c | 38 +++
.../fficall/jni/src/attrib.c | 80 ++++++
.../fficall/jni/src/externalptr.c | 84 +++++++
.../fficall/jni/src/finalizer.c | 47 ++++
.../fficall/jni/src/misc.c | 43 ++++
.../fficall/jni/src/register.c | 142 +++++++++++
.../fficall/jni/src/rf_functions.c | 101 ++++++++
.../fficall/jni/src/rfficall.c | 228 +-----------------
.../fficall/jni/src/rffiutils.c | 88 +++++++
.../fficall/jni/src/rffiutils.h | 43 ++++
.../fficall/jni/src/typecoerce.c | 72 ++++++
.../fficall/jni/src/vectoraccess.c | 149 ++++++++++++
.../nodes/builtin/base/DynLoadFunctions.java | 2 +-
.../builtin/base/HiddenInternalFunctions.java | 2 +-
.../nodes/builtin/base/PrettyPrinterNode.java | 2 +-
.../builtin/base/SerializeFunctions.java | 13 +
.../r/runtime/ffi/jnr/CallRFFIHelper.java | 80 ++++--
.../r/runtime/ffi/jnr/CallRFFIWithJNI.java | 5 +-
.../oracle/truffle/r/runtime/RSerialize.java | 71 +-----
.../r/runtime/conn/ConnectionSupport.java | 2 +-
.../truffle/r/runtime/data/RDataFactory.java | 8 +-
.../truffle/r/runtime/data/RExternalPtr.java | 34 ++-
.../truffle/r/runtime/data/RFFIAccess.java | 36 +++
.../truffle/r/runtime/data/RStringVector.java | 6 +
.../truffle/r/runtime/data/RVector.java | 2 +-
.../com/oracle/truffle/r/runtime/ffi/DLL.java | 5 +-
.../truffle/r/runtime/gnur/SEXPTYPE.java | 50 ++++
.../packages/testrffi/testrffi/NAMESPACE | 3 +
.../packages/testrffi/testrffi/R/testrffi.R | 12 +
.../packages/testrffi/testrffi/src/testrffi.c | 12 +
mx.fastr/copyrights/overrides | 1 +
31 files changed, 1150 insertions(+), 311 deletions(-)
create mode 100644 com.oracle.truffle.r.native/fficall/jni/src/alloc.c
create mode 100644 com.oracle.truffle.r.native/fficall/jni/src/attrib.c
create mode 100644 com.oracle.truffle.r.native/fficall/jni/src/externalptr.c
create mode 100644 com.oracle.truffle.r.native/fficall/jni/src/finalizer.c
create mode 100644 com.oracle.truffle.r.native/fficall/jni/src/misc.c
create mode 100644 com.oracle.truffle.r.native/fficall/jni/src/register.c
create mode 100644 com.oracle.truffle.r.native/fficall/jni/src/rf_functions.c
create mode 100644 com.oracle.truffle.r.native/fficall/jni/src/rffiutils.c
create mode 100644 com.oracle.truffle.r.native/fficall/jni/src/rffiutils.h
create mode 100644 com.oracle.truffle.r.native/fficall/jni/src/typecoerce.c
create mode 100644 com.oracle.truffle.r.native/fficall/jni/src/vectoraccess.c
create mode 100644 com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RFFIAccess.java
diff --git a/com.oracle.truffle.r.native/fficall/jni/src/alloc.c b/com.oracle.truffle.r.native/fficall/jni/src/alloc.c
new file mode 100644
index 0000000000..26e4e14319
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/jni/src/alloc.c
@@ -0,0 +1,38 @@
+/*
+ * This material is distributed under the GNU General Public License
+ * Version 2. You may review the terms of this license at
+ * http://www.gnu.org/licenses/gpl-2.0.html
+ *
+ * Copyright (c) 1995-2015, The R Core Team
+ * Copyright (c) 2003, The R Foundation
+ * Copyright (c) 2015, Oracle and/or its affiliates
+ *
+ * All rights reserved.
+ */
+#include "rffiutils.h"
+
+void init_alloc(JNIEnv *env) {
+
+}
+
+
+void *R_chk_calloc(size_t nelem, size_t elsize) {
+ void *p;
+ #ifndef HAVE_WORKING_CALLOC
+ if(nelem == 0)
+ return(NULL);
+ #endif
+ p = calloc(nelem, elsize);
+ if(!p) /* problem here is that we don't have a format for size_t. */
+ error(_("'Calloc' could not allocate memory (%.0f of %u bytes)"),
+ (double) nelem, elsize);
+ return(p);
+}
+
+void *R_chk_realloc(void *p, size_t size) {
+ unimplemented("R_chk_realloc");
+}
+
+void R_chk_free(void *p) {
+ unimplemented("R_chk_free");
+}
diff --git a/com.oracle.truffle.r.native/fficall/jni/src/attrib.c b/com.oracle.truffle.r.native/fficall/jni/src/attrib.c
new file mode 100644
index 0000000000..503bcbcd52
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/jni/src/attrib.c
@@ -0,0 +1,80 @@
+/*
+ * 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"
+
+static jclass SEXPTYPEClass;
+static jmethodID gnuRCodeForObjectMethodID;
+static jmethodID NAMED_MethodID;
+
+void init_attrib(JNIEnv *env) {
+ 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);
+}
+
+int TYPEOF(SEXP x) {
+ JNIEnv *thisenv = getEnv();
+ return (*thisenv)->CallStaticIntMethod(thisenv, SEXPTYPEClass, gnuRCodeForObjectMethodID, x);
+}
+
+SEXP ATTRIB(SEXP x){
+ unimplemented("ATTRIB");
+}
+
+int OBJECT(SEXP x){
+ unimplemented("OBJECT");
+}
+
+int MARK(SEXP x){
+ unimplemented("MARK");
+}
+
+int NAMED(SEXP x){
+ JNIEnv *thisenv = getEnv();
+ return (*thisenv)->CallStaticIntMethod(thisenv, CallRFFIHelperClass, NAMED_MethodID, x);
+}
+
+int REFCNT(SEXP x){
+ unimplemented("REFCNT");
+}
+
+void SET_OBJECT(SEXP x, int v){
+ unimplemented("SET_OBJECT");
+}
+
+void SET_TYPEOF(SEXP x, int v){
+ unimplemented("SET_TYPEOF");
+}
+
+void SET_NAMED(SEXP x, int v){
+ unimplemented("SET_NAMED");
+}
+
+void SET_ATTRIB(SEXP x, SEXP v){
+ unimplemented("SET_ATTRIB");
+}
+
+void DUPLICATE_ATTRIB(SEXP to, SEXP from){
+ unimplemented("DUPLICATE_ATTRIB");
+}
+
diff --git a/com.oracle.truffle.r.native/fficall/jni/src/externalptr.c b/com.oracle.truffle.r.native/fficall/jni/src/externalptr.c
new file mode 100644
index 0000000000..1c2203ff84
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/jni/src/externalptr.c
@@ -0,0 +1,84 @@
+/*
+ * 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"
+
+static jclass RExternalPtrClass;
+static jmethodID createExternalPtrMethodID;
+static jmethodID externalPtrGetAddrMethodID;
+static jmethodID externalPtrGetTagMethodID;
+static jmethodID externalPtrGetProtMethodID;
+static jmethodID externalPtrSetAddrMethodID;
+static jmethodID externalPtrSetTagMethodID;
+static jmethodID externalPtrSetProtMethodID;
+
+void init_externalptr(JNIEnv *env) {
+ 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);
+ externalPtrGetTagMethodID = checkGetMethodID(env, RExternalPtrClass, "getTag", "()Ljava/lang/Object;", 0);
+ externalPtrGetProtMethodID = checkGetMethodID(env, RExternalPtrClass, "getProt", "()Ljava/lang/Object;", 0);
+ 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);
+
+}
+
+SEXP R_MakeExternalPtr(void *p, SEXP tag, SEXP prot) {
+ JNIEnv *thisenv = getEnv();
+ return (*thisenv)->CallStaticObjectMethod(thisenv, RDataFactoryClass, createExternalPtrMethodID, (jlong) p, tag, prot);
+}
+
+void *R_ExternalPtrAddr(SEXP s) {
+ JNIEnv *thisenv = getEnv();
+ return (void *) (*thisenv)->CallLongMethod(thisenv, s, externalPtrGetAddrMethodID);
+}
+
+SEXP R_ExternalPtrTag(SEXP s) {
+ JNIEnv *thisenv = getEnv();
+ return (*thisenv)->CallObjectMethod(thisenv, s, externalPtrGetTagMethodID);
+}
+
+SEXP R_ExternalPtrProt(SEXP s) {
+ JNIEnv *thisenv = getEnv();
+ return (*thisenv)->CallObjectMethod(thisenv, s, externalPtrGetProtMethodID);
+}
+
+void R_SetExternalPtrAddr(SEXP s, void *p) {
+ JNIEnv *thisenv = getEnv();
+ (*thisenv)->CallLongMethod(thisenv, s, externalPtrSetAddrMethodID, (jlong) p);
+}
+
+void R_SetExternalPtrTag(SEXP s, SEXP tag) {
+ JNIEnv *thisenv = getEnv();
+ (*thisenv)->CallObjectMethod(thisenv, s, externalPtrSetTagMethodID, tag);
+}
+
+void R_SetExternalPtrProt(SEXP s, SEXP p) {
+ JNIEnv *thisenv = getEnv();
+ (*thisenv)->CallObjectMethod(thisenv, s, externalPtrSetProtMethodID, p);
+}
+
+void R_ClearExternalPtr(SEXP s) {
+ R_SetExternalPtrAddr(s, NULL);
+}
+
diff --git a/com.oracle.truffle.r.native/fficall/jni/src/finalizer.c b/com.oracle.truffle.r.native/fficall/jni/src/finalizer.c
new file mode 100644
index 0000000000..9486719ca5
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/jni/src/finalizer.c
@@ -0,0 +1,47 @@
+/*
+ * 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"
+
+void init_finalizer(JNIEnv *env) {
+
+}
+
+
+void R_RegisterFinalizer(SEXP s, SEXP fun) {
+
+}
+void R_RegisterCFinalizer(SEXP s, R_CFinalizer_t fun) {
+
+}
+
+void R_RegisterFinalizerEx(SEXP s, SEXP fun, Rboolean onexit) {
+
+}
+
+void R_RegisterCFinalizerEx(SEXP s, R_CFinalizer_t fun, Rboolean onexit) {
+
+}
+
+void R_RunPendingFinalizers(void) {
+
+}
diff --git a/com.oracle.truffle.r.native/fficall/jni/src/misc.c b/com.oracle.truffle.r.native/fficall/jni/src/misc.c
new file mode 100644
index 0000000000..bc1a103019
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/jni/src/misc.c
@@ -0,0 +1,43 @@
+/*
+ * 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"
+#include <stdlib.h>
+#include <string.h>
+
+
+void init_misc(JNIEnv *env) {
+}
+
+const char *R_CHAR(SEXP string) {
+ // 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();
+ jsize len = (*thisenv)->GetStringUTFLength(thisenv, string);
+ const char *stringChars = (*thisenv)->GetStringUTFChars(thisenv, string, NULL);
+ char *copyChars = malloc(len + 1);
+ memcpy(copyChars, stringChars, len);
+ copyChars[len] = 0;
+ return copyChars;
+}
+
diff --git a/com.oracle.truffle.r.native/fficall/jni/src/register.c b/com.oracle.truffle.r.native/fficall/jni/src/register.c
new file mode 100644
index 0000000000..99c875d58b
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/jni/src/register.c
@@ -0,0 +1,142 @@
+/*
+ * 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"
+#include <Rdynload.h>
+
+// Registering routines from loaded shared libraries
+
+static jclass DLLClass;
+static jclass DotSymbolClass;
+
+static jmethodID registerRoutinesID;
+static jmethodID registerCCallableID;
+static jmethodID useDynamicSymbolsID;
+static jmethodID forceSymbolsID;
+static jmethodID setDotSymbolValuesID;
+
+void init_register(JNIEnv *env) {
+ DLLClass = checkFindClass(env, "com/oracle/truffle/r/runtime/ffi/DLL");
+ DotSymbolClass = checkFindClass(env, "com/oracle/truffle/r/runtime/ffi/DLL$DotSymbol");
+
+ registerRoutinesID = checkGetMethodID(env, DLLClass, "registerRoutines", "(Lcom/oracle/truffle/r/runtime/ffi/DLL$DLLInfo;IIJ)V", 1);
+ registerCCallableID = checkGetMethodID(env, DLLClass, "registerCCallable", "(Ljava/lang/String;Ljava/lang/String;J)V", 1);
+ useDynamicSymbolsID = checkGetMethodID(env, DLLClass, "useDynamicSymbols", "(Lcom/oracle/truffle/r/runtime/ffi/DLL$DLLInfo;I)I", 1);
+ forceSymbolsID = checkGetMethodID(env, DLLClass, "forceSymbols", "(Lcom/oracle/truffle/r/runtime/ffi/DLL$DLLInfo;I)I", 1);
+ setDotSymbolValuesID = checkGetMethodID(env, DLLClass, "setDotSymbolValues", "(Ljava/lang/String;JI)Lcom/oracle/truffle/r/runtime/ffi/DLL$DotSymbol;", 1);
+}
+
+// Must match ordinal value for DLL.NativeSymbolType
+#define C_NATIVE_TYPE 0
+#define CALL_NATIVE_TYPE 1
+#define FORTRAN_NATIVE_TYPE 2
+#define EXTERNAL_NATIVE_TYPE 3
+
+int
+R_registerRoutines(DllInfo *info, const R_CMethodDef * const croutines,
+ const R_CallMethodDef * const callRoutines,
+ const R_FortranMethodDef * const fortranRoutines,
+ const R_ExternalMethodDef * const externalRoutines) {
+ // In theory we could create all the data here and pass it up, but in practice there were inexplicable
+ // Hotspot SEGV crashes creating Java arrays and Java objects in this function
+ JNIEnv *thisenv = getEnv();
+ int num;
+ if (croutines) {
+ for(num = 0; croutines[num].name != NULL; num++) {;}
+ (*thisenv)->CallStaticVoidMethod(thisenv, DLLClass, registerRoutinesID, info, C_NATIVE_TYPE, num, croutines);
+ }
+ if (callRoutines) {
+ for(num = 0; callRoutines[num].name != NULL; num++) {;}
+ (*thisenv)->CallStaticVoidMethod(thisenv, DLLClass, registerRoutinesID, info, CALL_NATIVE_TYPE, num, callRoutines);
+ }
+ if (fortranRoutines) {
+ for(num = 0; fortranRoutines[num].name != NULL; num++) {;}
+ (*thisenv)->CallStaticVoidMethod(thisenv, DLLClass, registerRoutinesID, info, FORTRAN_NATIVE_TYPE, num, fortranRoutines);
+ }
+ if (externalRoutines) {
+ for(num = 0; externalRoutines[num].name != NULL; num++) {;}
+ (*thisenv)->CallStaticVoidMethod(thisenv, DLLClass, registerRoutinesID, info, EXTERNAL_NATIVE_TYPE, num, externalRoutines);
+ }
+ return 1;
+}
+
+void R_RegisterCCallable(const char *package, const char *name, DL_FUNC fptr) {
+ JNIEnv *thisenv = getEnv();
+// printf("pkgname %s, name %s\n", package, name);
+ jstring packageString = (*thisenv)->NewStringUTF(thisenv, package);
+ jstring nameString = (*thisenv)->NewStringUTF(thisenv, name);
+ (*thisenv)->CallStaticVoidMethod(thisenv, DLLClass, registerCCallableID, packageString, nameString, fptr);
+}
+
+JNIEXPORT jobject JNICALL
+Java_com_oracle_truffle_r_runtime_ffi_DLL_setSymbol(JNIEnv *env, jclass c, jint nstOrd, jlong routinesAddr, jint index) {
+ const char *name;
+ long fun;
+ int numArgs;
+
+ switch (nstOrd) {
+ case C_NATIVE_TYPE: {
+ R_CMethodDef *croutines = (R_CMethodDef *) routinesAddr;
+ name = croutines[index].name;
+ fun = (long) croutines[index].fun;
+ numArgs = croutines[index].numArgs;
+ break;
+ }
+ case CALL_NATIVE_TYPE: {
+ R_CallMethodDef *callRoutines = (R_CallMethodDef *) routinesAddr;
+ name = callRoutines[index].name;
+ fun = (long) callRoutines[index].fun;
+ numArgs = callRoutines[index].numArgs;
+ break;
+ }
+ case FORTRAN_NATIVE_TYPE: {
+ R_FortranMethodDef * fortranRoutines = (R_FortranMethodDef *) routinesAddr;
+ name = fortranRoutines[index].name;
+ fun = (long) fortranRoutines[index].fun;
+ numArgs = fortranRoutines[index].numArgs;
+ break;
+ }
+ case EXTERNAL_NATIVE_TYPE: {
+ R_ExternalMethodDef * externalRoutines = (R_ExternalMethodDef *) routinesAddr;
+ name = externalRoutines[index].name;
+ fun = (long) externalRoutines[index].fun;
+ numArgs = externalRoutines[index].numArgs;
+ break;
+ }
+ default: (*env)->FatalError(env, "NativeSymbolType out of range");
+ }
+// printf("name %s, fun %0lx, numArgs %d\n", name, fun, numArgs);
+ jstring nameString = (*env)->NewStringUTF(env, name);
+ return (*env)->CallStaticObjectMethod(env, DLLClass, setDotSymbolValuesID, nameString, fun, numArgs);
+
+}
+
+Rboolean R_useDynamicSymbols(DllInfo *dllInfo, Rboolean value) {
+ JNIEnv *thisenv = getEnv();
+ return (*thisenv)->CallStaticIntMethod(thisenv, DLLClass, useDynamicSymbolsID, dllInfo, value);
+}
+
+Rboolean R_forceSymbols(DllInfo *dllInfo, Rboolean value) {
+ JNIEnv *thisenv = getEnv();
+ return (*thisenv)->CallStaticIntMethod(thisenv, DLLClass, forceSymbolsID, dllInfo, value);
+
+}
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
new file mode 100644
index 0000000000..bc5ad202fe
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/jni/src/rf_functions.c
@@ -0,0 +1,101 @@
+/*
+ * 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"
+
+// Most of the functions with a Rf_ prefix
+// TODO Lots missing yet
+
+static jmethodID Rf_scalarIntegerMethodID;
+static jmethodID Rf_scalarDoubleMethodID;
+static jmethodID createIntArrayMethodID;
+static jmethodID createDoubleArrayMethodID;
+static jmethodID createStringArrayMethodID;
+static jmethodID Rf_duplicateMethodID;
+static jmethodID createSymbolMethodID;
+
+void init_rf_functions(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);
+ createIntArrayMethodID = checkGetMethodID(env, RDataFactoryClass, "createIntVector", "(I)Lcom/oracle/truffle/r/runtime/data/RIntVector;", 1);
+ createDoubleArrayMethodID = checkGetMethodID(env, RDataFactoryClass, "createDoubleVector", "(I)Lcom/oracle/truffle/r/runtime/data/RDoubleVector;", 1);
+ createStringArrayMethodID = checkGetMethodID(env, RDataFactoryClass, "createStringVector", "(I)Lcom/oracle/truffle/r/runtime/data/RStringVector;", 1);
+ Rf_duplicateMethodID = checkGetMethodID(env, CallRFFIHelperClass, "Rf_duplicate", "(Ljava/lang/Object;)Ljava/lang/Object;", 1);
+ createSymbolMethodID = checkGetMethodID(env, RDataFactoryClass, "createSymbol", "(Ljava/lang/String;)Lcom/oracle/truffle/r/runtime/data/RSymbol;", 1);
+}
+
+SEXP Rf_ScalarInteger(int value) {
+ JNIEnv *thisenv = getEnv();
+ return (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, Rf_scalarIntegerMethodID, value);
+}
+
+SEXP Rf_ScalarReal(double value) {
+ JNIEnv *thisenv = getEnv();
+ return (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, Rf_scalarDoubleMethodID, value);
+}
+
+SEXP Rf_allocVector(SEXPTYPE t, R_xlen_t len) {
+ JNIEnv *thisenv = getEnv();
+ switch (t) {
+ case INTSXP: {
+ return (*thisenv)->CallStaticObjectMethod(thisenv, RDataFactoryClass, createIntArrayMethodID, len);
+ }
+ case REALSXP: {
+ return (*thisenv)->CallStaticObjectMethod(thisenv, RDataFactoryClass, createDoubleArrayMethodID, len);
+ }
+ case STRSXP: {
+ return (*thisenv)->CallStaticObjectMethod(thisenv, RDataFactoryClass, createStringArrayMethodID, len);
+ }
+ default:
+ unimplemented("vector type not handled");
+ return NULL;
+ }
+}
+
+SEXP Rf_duplicate(SEXP x) {
+ JNIEnv *thisenv = getEnv();
+ return (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, Rf_duplicateMethodID, x);
+}
+
+void Rf_error(const char *msg, ...) {
+ unimplemented("Rf_error");
+}
+
+SEXP Rf_install(const char *name) {
+ JNIEnv *thisenv = getEnv();
+ jstring string = (*thisenv)->NewStringUTF(thisenv, name);
+ return (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, createSymbolMethodID, string);
+}
+
+SEXP Rf_mkChar(const char *x) {
+ JNIEnv *thisenv = getEnv();
+ // TODO encoding, assume UTF for now
+ return (*thisenv)->NewStringUTF(thisenv, x);
+}
+
+SEXP Rf_protect(SEXP x) {
+ // TODO perhaps we can use this
+}
+
+void Rf_unprotect(int x) {
+ // TODO perhaps we can use this
+}
diff --git a/com.oracle.truffle.r.native/fficall/jni/src/rfficall.c b/com.oracle.truffle.r.native/fficall/jni/src/rfficall.c
index 6463f6af29..30aaddfc3b 100644
--- a/com.oracle.truffle.r.native/fficall/jni/src/rfficall.c
+++ b/com.oracle.truffle.r.native/fficall/jni/src/rfficall.c
@@ -10,230 +10,26 @@
* All rights reserved.
*/
+#include "rffiutils.h"
#include <string.h>
-#include <jni.h>
-#include <Rinternals.h>
-#include <Rdynload.h>
-
-/*
- * All calls pass through one of the call(N) methods, which carry the JNIEnv value,
- * which needs to be saved for reuse in the many R functions such as Rf_allocVector.
- * FastR is not currently multi-threaded so the value can safely be stored in a static.
- */
-
-static JNIEnv *curenv = NULL;
-
-JNIEnv *getEnv() {
-// printf("getEnv()=%p\n", curenv);
- return curenv;
-}
-
-void setEnv(JNIEnv *env) {
-// printf("setEnv(%p)\n", env);
- curenv = env;
-}
-
-static jclass RDataFactoryClass;
-static jclass CallRFFIHelperClass;
-static jclass DLLClass;
-static jclass DotSymbolClass;
-
-static jmethodID scalarIntegerMethodID;
-static jmethodID scalarDoubleMethodID;
-static jmethodID createIntArrayMethodID;
-static jmethodID createDoubleArrayMethodID;
-static jmethodID getIntDataAtZeroID;
-static jmethodID getDoubleDataAtZeroID;
-static jmethodID registerRoutinesID;
-static jmethodID registerCCallableID;
-static jmethodID useDynamicSymbolsID;
-static jmethodID forceSymbolsID;
-static jmethodID setDotSymbolValuesID;
-
-static jclass checkFindClass(JNIEnv *env, const char *name);
-static jmethodID checkGetMethodID(JNIEnv *env, jclass klass, const char *name, const char *sig, int isStatic);
+SEXP R_NilValue;
JNIEXPORT void JNICALL
-Java_com_oracle_truffle_r_runtime_ffi_jnr_CallRFFIWithJNI_initialize(JNIEnv *env, jclass c) {
- RDataFactoryClass = checkFindClass(env, "com/oracle/truffle/r/runtime/data/RDataFactory");
- CallRFFIHelperClass = checkFindClass(env, "com/oracle/truffle/r/runtime/ffi/jnr/CallRFFIHelper");
- DLLClass = checkFindClass(env, "com/oracle/truffle/r/runtime/ffi/DLL");
- DotSymbolClass = checkFindClass(env, "com/oracle/truffle/r/runtime/ffi/DLL$DotSymbol");
-
- scalarIntegerMethodID = checkGetMethodID(env, CallRFFIHelperClass, "ScalarInteger", "(I)Lcom/oracle/truffle/r/runtime/data/RIntVector;", 1);
- scalarDoubleMethodID = checkGetMethodID(env, CallRFFIHelperClass, "ScalarDouble", "(D)Lcom/oracle/truffle/r/runtime/data/RDoubleVector;", 1);
- createIntArrayMethodID = checkGetMethodID(env, RDataFactoryClass, "createIntVector", "(I)Lcom/oracle/truffle/r/runtime/data/RIntVector;", 1);
- createDoubleArrayMethodID = checkGetMethodID(env, RDataFactoryClass, "createDoubleVector", "(I)Lcom/oracle/truffle/r/runtime/data/RDoubleVector;", 1);
- getIntDataAtZeroID = checkGetMethodID(env, CallRFFIHelperClass, "getIntDataAtZero", "(Ljava/lang/Object;)I", 1);
- getDoubleDataAtZeroID = checkGetMethodID(env, CallRFFIHelperClass, "getDoubleDataAtZero", "(Ljava/lang/Object;)D", 1);
- registerRoutinesID = checkGetMethodID(env, DLLClass, "registerRoutines", "(Lcom/oracle/truffle/r/runtime/ffi/DLL$DLLInfo;IIJ)V", 1);
- registerCCallableID = checkGetMethodID(env, DLLClass, "registerCCallable", "(Ljava/lang/String;Ljava/lang/String;J)V", 1);
- useDynamicSymbolsID = checkGetMethodID(env, DLLClass, "useDynamicSymbols", "(Lcom/oracle/truffle/r/runtime/ffi/DLL$DLLInfo;I)I", 1);
- forceSymbolsID = checkGetMethodID(env, DLLClass, "forceSymbols", "(Lcom/oracle/truffle/r/runtime/ffi/DLL$DLLInfo;I)I", 1);
- setDotSymbolValuesID = checkGetMethodID(env, DLLClass, "setDotSymbolValues", "(Ljava/lang/String;JI)Lcom/oracle/truffle/r/runtime/ffi/DLL$DotSymbol;", 1);
-}
-
-// Must match ordinal value for DLL.NativeSymbolType
-#define C_NATIVE_TYPE 0
-#define CALL_NATIVE_TYPE 1
-#define FORTRAN_NATIVE_TYPE 2
-#define EXTERNAL_NATIVE_TYPE 3
-
-int
-R_registerRoutines(DllInfo *info, const R_CMethodDef * const croutines,
- const R_CallMethodDef * const callRoutines,
- const R_FortranMethodDef * const fortranRoutines,
- const R_ExternalMethodDef * const externalRoutines) {
- // In theory we could create all the data here and pass it up, but in practice there were inexplicable
- // Hotspot SEGV crashes creating Java arrays and Java objects in this function
- JNIEnv *thisenv = getEnv();
- int num;
- if (croutines) {
- for(num = 0; croutines[num].name != NULL; num++) {;}
- (*thisenv)->CallStaticVoidMethod(thisenv, DLLClass, registerRoutinesID, info, C_NATIVE_TYPE, num, croutines);
- }
- if (callRoutines) {
- for(num = 0; callRoutines[num].name != NULL; num++) {;}
- (*thisenv)->CallStaticVoidMethod(thisenv, DLLClass, registerRoutinesID, info, CALL_NATIVE_TYPE, num, callRoutines);
- }
- if (fortranRoutines) {
- for(num = 0; fortranRoutines[num].name != NULL; num++) {;}
- (*thisenv)->CallStaticVoidMethod(thisenv, DLLClass, registerRoutinesID, info, FORTRAN_NATIVE_TYPE, num, fortranRoutines);
- }
- if (externalRoutines) {
- for(num = 0; externalRoutines[num].name != NULL; num++) {;}
- (*thisenv)->CallStaticVoidMethod(thisenv, DLLClass, registerRoutinesID, info, EXTERNAL_NATIVE_TYPE, num, externalRoutines);
- }
- return 1;
-}
-
-void R_RegisterCCallable(const char *package, const char *name, DL_FUNC fptr) {
- JNIEnv *thisenv = getEnv();
-// printf("pkgname %s, name %s\n", package, name);
- jstring packageString = (*thisenv)->NewStringUTF(thisenv, package);
- jstring nameString = (*thisenv)->NewStringUTF(thisenv, name);
- (*thisenv)->CallStaticVoidMethod(thisenv, DLLClass, registerCCallableID, packageString, nameString, fptr);
-}
-
-JNIEXPORT jobject JNICALL
-Java_com_oracle_truffle_r_runtime_ffi_DLL_setSymbol(JNIEnv *env, jclass c, jint nstOrd, jlong routinesAddr, jint index) {
- const char *name;
- long fun;
- int numArgs;
-
- switch (nstOrd) {
- case C_NATIVE_TYPE: {
- R_CMethodDef *croutines = (R_CMethodDef *) routinesAddr;
- name = croutines[index].name;
- fun = (long) croutines[index].fun;
- numArgs = croutines[index].numArgs;
- break;
- }
- case CALL_NATIVE_TYPE: {
- R_CallMethodDef *callRoutines = (R_CallMethodDef *) routinesAddr;
- name = callRoutines[index].name;
- fun = (long) callRoutines[index].fun;
- numArgs = callRoutines[index].numArgs;
- break;
- }
- case FORTRAN_NATIVE_TYPE: {
- R_FortranMethodDef * fortranRoutines = (R_FortranMethodDef *) routinesAddr;
- name = fortranRoutines[index].name;
- fun = (long) fortranRoutines[index].fun;
- numArgs = fortranRoutines[index].numArgs;
- break;
- }
- case EXTERNAL_NATIVE_TYPE: {
- R_ExternalMethodDef * externalRoutines = (R_ExternalMethodDef *) routinesAddr;
- name = externalRoutines[index].name;
- fun = (long) externalRoutines[index].fun;
- numArgs = externalRoutines[index].numArgs;
- break;
- }
- default: (*env)->FatalError(env, "NativeSymbolType out of range");
- }
-// printf("name %s, fun %0lx, numArgs %d\n", name, fun, numArgs);
- jstring nameString = (*env)->NewStringUTF(env, name);
- return (*env)->CallStaticObjectMethod(env, DLLClass, setDotSymbolValuesID, nameString, fun, numArgs);
-
-}
-
-Rboolean R_useDynamicSymbols(DllInfo *dllInfo, Rboolean value) {
- JNIEnv *thisenv = getEnv();
- return (*thisenv)->CallStaticIntMethod(thisenv, DLLClass, useDynamicSymbolsID, dllInfo, value);
-}
-
-Rboolean R_forceSymbols(DllInfo *dllInfo, Rboolean value) {
- JNIEnv *thisenv = getEnv();
- return (*thisenv)->CallStaticIntMethod(thisenv, DLLClass, forceSymbolsID, dllInfo, value);
-
-}
-
-SEXP Rf_ScalarInteger(int value) {
- JNIEnv *thisenv = getEnv();
- return (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, scalarIntegerMethodID, value);
-}
-
-SEXP Rf_ScalarReal(double value) {
- JNIEnv *thisenv = getEnv();
- return (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, scalarDoubleMethodID, value);
-}
-
-SEXP Rf_allocVector(SEXPTYPE t, R_xlen_t len) {
- JNIEnv *thisenv = getEnv();
- switch (t) {
- case INTSXP: {
- return (*thisenv)->CallStaticObjectMethod(thisenv, RDataFactoryClass, createIntArrayMethodID, len);
- }
- case REALSXP: {
- return (*thisenv)->CallStaticObjectMethod(thisenv, RDataFactoryClass, createDoubleArrayMethodID, len);
- }
- default:
- (*thisenv)->FatalError(thisenv, "vector type not handled");
- return NULL;
- }
-}
-
-int Rf_asInteger(SEXP x) {
- JNIEnv *thisenv = getEnv();
- return (*thisenv)->CallStaticIntMethod(thisenv, CallRFFIHelperClass, getIntDataAtZeroID, x);
-}
+Java_com_oracle_truffle_r_runtime_ffi_jnr_CallRFFIWithJNI_initialize(JNIEnv *env, jclass c, jobject RNullInstance) {
+ init_utils(env);
-double Rf_asReal(SEXP x) {
- JNIEnv *thisenv = getEnv();
- return (*thisenv)->CallStaticDoubleMethod(thisenv, CallRFFIHelperClass, getDoubleDataAtZeroID, x);
-}
+ R_NilValue = RNullInstance;
-// Class/method search
-static jclass checkFindClass(JNIEnv *env, const char *name) {
- jclass klass = (*env)->FindClass(env, name);
- if (klass == NULL) {
- char buf[1024];
- strcpy(buf, "failed to find class ");
- strcat(buf, name);
- (*env)->FatalError(env, buf);
- }
- return klass;
+ init_register(env);
+ init_rf_functions(env);
+ init_externalptr(env);
+ init_typecoerce(env);
+ init_attrib(env);
+ init_misc(env);
+ init_vectoraccess(env);
}
-static jmethodID checkGetMethodID(JNIEnv *env, jclass klass, const char *name, const char *sig, int isStatic) {
- jmethodID methodID = isStatic ? (*env)->GetStaticMethodID(env, klass, name, sig) : (*env)->GetMethodID(env, klass, name, sig);
- if (methodID == NULL) {
- char buf[1024];
- strcpy(buf, "failed to find ");
- strcat(buf, isStatic ? "static" : "instance");
- strcat(buf, " method ");
- strcat(buf, name);
- strcat(buf, "(");
- strcat(buf, sig);
- strcat(buf, ")");
- (*env)->FatalError(env, buf);
- }
- return methodID;
-}
-
-
// Boilerplate methods for the actual calls
diff --git a/com.oracle.truffle.r.native/fficall/jni/src/rffiutils.c b/com.oracle.truffle.r.native/fficall/jni/src/rffiutils.c
new file mode 100644
index 0000000000..8f8493efe0
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/jni/src/rffiutils.c
@@ -0,0 +1,88 @@
+/*
+ * 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"
+#include <string.h>
+
+/*
+ * All calls pass through one of the call(N) methods, which carry the JNIEnv value,
+ * which needs to be saved for reuse in the many R functions such as Rf_allocVector.
+ * FastR is not currently multi-threaded so the value can safely be stored in a static.
+ */
+jclass CallRFFIHelperClass;
+jclass RDataFactoryClass;
+
+static jclass RInternalErrorClass;
+static jmethodID unimplementedMethodID;
+
+JNIEnv *curenv = NULL;
+
+void init_utils(JNIEnv *env) {
+ curenv = env;
+ RDataFactoryClass = checkFindClass(env, "com/oracle/truffle/r/runtime/data/RDataFactory");
+ CallRFFIHelperClass = checkFindClass(env, "com/oracle/truffle/r/runtime/ffi/jnr/CallRFFIHelper");
+ RInternalErrorClass = checkFindClass(env, "com/oracle/truffle/r/runtime/RInternalError");
+ unimplementedMethodID = checkGetMethodID(env, RInternalErrorClass, "unimplemented", "(Ljava/lang/String;)Ljava/lang/RuntimeException;", 1);
+}
+
+JNIEnv *getEnv() {
+// printf("getEnv()=%p\n", curenv);
+ return curenv;
+}
+
+void setEnv(JNIEnv *env) {
+// printf("setEnv(%p)\n", env);
+ curenv = env;
+}
+
+void unimplemented(char *msg) {
+ JNIEnv *thisenv = getEnv();
+ (*thisenv)->FatalError(thisenv, msg);
+}
+
+// Class/method search
+jclass checkFindClass(JNIEnv *env, const char *name) {
+ jclass klass = (*env)->FindClass(env, name);
+ if (klass == NULL) {
+ char buf[1024];
+ strcpy(buf, "failed to find class ");
+ strcat(buf, name);
+ (*env)->FatalError(env, buf);
+ }
+ return klass;
+}
+
+jmethodID checkGetMethodID(JNIEnv *env, jclass klass, const char *name, const char *sig, int isStatic) {
+ jmethodID methodID = isStatic ? (*env)->GetStaticMethodID(env, klass, name, sig) : (*env)->GetMethodID(env, klass, name, sig);
+ if (methodID == NULL) {
+ char buf[1024];
+ strcpy(buf, "failed to find ");
+ strcat(buf, isStatic ? "static" : "instance");
+ strcat(buf, " method ");
+ strcat(buf, name);
+ strcat(buf, "(");
+ strcat(buf, sig);
+ strcat(buf, ")");
+ (*env)->FatalError(env, buf);
+ }
+ return methodID;
+}
diff --git a/com.oracle.truffle.r.native/fficall/jni/src/rffiutils.h b/com.oracle.truffle.r.native/fficall/jni/src/rffiutils.h
new file mode 100644
index 0000000000..be85ea9dea
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/jni/src/rffiutils.h
@@ -0,0 +1,43 @@
+/*
+ * 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.
+ */
+#ifndef RFFIUTILS_H
+#define RFFIUTILS_H
+
+#include <jni.h>
+#include <Rinternals.h>
+
+JNIEnv *getEnv();
+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);
+void unimplemented(char *msg);
+
+void init_externalptr(JNIEnv *env);
+
+extern jclass RDataFactoryClass;
+extern jclass CallRFFIHelperClass;
+extern SEXP R_NilValue;
+
+
+#endif /* RFFIUTILS_H */
diff --git a/com.oracle.truffle.r.native/fficall/jni/src/typecoerce.c b/com.oracle.truffle.r.native/fficall/jni/src/typecoerce.c
new file mode 100644
index 0000000000..f5c9f53a7e
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/jni/src/typecoerce.c
@@ -0,0 +1,72 @@
+/*
+ * 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"
+
+static jmethodID Rf_asIntegerMethodID;
+static jmethodID Rf_asRealMethodID;
+static jmethodID Rf_asCharMethodID;
+
+void init_typecoerce(JNIEnv *env) {
+ 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);
+}
+
+SEXP Rf_asChar(SEXP x){
+ JNIEnv *thisenv = getEnv();
+ return (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, Rf_asCharMethodID, x);
+}
+
+SEXP Rf_coerceVector(SEXP x, SEXPTYPE t){
+ unimplemented("Rf_coerceVector");
+}
+
+SEXP Rf_PairToVectorList(SEXP x){
+ unimplemented("Rf_PairToVectorList");
+}
+
+SEXP Rf_VectorToPairList(SEXP x){
+ unimplemented("Rf_coerceVector");
+}
+
+SEXP Rf_asCharacterFactor(SEXP x){
+ unimplemented("Rf_VectorToPairList");
+}
+
+int Rf_asLogical(SEXP x){
+ unimplemented("Rf_asLogical");
+}
+
+int Rf_asInteger(SEXP x) {
+ JNIEnv *thisenv = getEnv();
+ return (*thisenv)->CallStaticIntMethod(thisenv, CallRFFIHelperClass, Rf_asIntegerMethodID, x);
+}
+
+double Rf_asReal(SEXP x) {
+ JNIEnv *thisenv = getEnv();
+ return (*thisenv)->CallStaticDoubleMethod(thisenv, CallRFFIHelperClass, Rf_asRealMethodID, x);
+}
+
+Rcomplex Rf_asComplex(SEXP x){
+ unimplemented("Rf_asLogical");
+}
diff --git a/com.oracle.truffle.r.native/fficall/jni/src/vectoraccess.c b/com.oracle.truffle.r.native/fficall/jni/src/vectoraccess.c
new file mode 100644
index 0000000000..f975e54f3e
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/jni/src/vectoraccess.c
@@ -0,0 +1,149 @@
+/*
+ * 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"
+#include <stdlib.h>
+#include <string.h>
+
+jmethodID SET_STRING_ELT_MethodID;
+jmethodID RAW_MethodID;
+jmethodID LENGTH_MethodID;
+
+void init_vectoraccess(JNIEnv *env) {
+ SET_STRING_ELT_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "SET_STRING_ELT", "(Ljava/lang/Object;ILjava/lang/Object;)V", 1);
+ RAW_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "RAW", "(Ljava/lang/Object;)[B", 1);
+ LENGTH_MethodID = checkGetMethodID(env, CallRFFIHelperClass, "LENGTH", "(Ljava/lang/Object;)I", 1);
+}
+
+
+int LENGTH(SEXP x) {
+ JNIEnv *thisenv = getEnv();
+ return (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, LENGTH_MethodID, x);
+}
+
+R_len_t Rf_length(SEXP x) {
+ return LENGTH(x);
+}
+
+
+
+int TRUELENGTH(SEXP x){
+ unimplemented("unimplemented");
+}
+
+
+void SETLENGTH(SEXP x, int v){
+ unimplemented("SETLENGTH");
+}
+
+
+void SET_TRUELENGTH(SEXP x, int v){
+ unimplemented("SET_TRUELENGTH");
+}
+
+
+R_xlen_t XLENGTH(SEXP x){
+ unimplemented("XLENGTH");
+}
+
+
+R_xlen_t XTRUELENGTH(SEXP x){
+ unimplemented("XTRUELENGTH");
+}
+
+
+int IS_LONG_VEC(SEXP x){
+ unimplemented("IS_LONG_VEC");
+}
+
+
+int LEVELS(SEXP x){
+ unimplemented("LEVELS");
+}
+
+
+int SETLEVELS(SEXP x, int v){
+ unimplemented("SETLEVELS");
+}
+
+
+
+int *LOGICAL(SEXP x){
+ unimplemented("LOGICAL");
+}
+
+
+int *INTEGER(SEXP x){
+ unimplemented("INTEGER");
+}
+
+
+Rbyte *RAW(SEXP x){
+ JNIEnv *thisenv = getEnv();
+ jbyteArray bytearray = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, RAW_MethodID, x);
+ int len = (*thisenv)->GetArrayLength(thisenv, bytearray);
+ jbyte *data = (*thisenv)->GetByteArrayElements(thisenv, bytearray, NULL);
+ void *result = malloc(len);
+ memcpy(result, data, len);
+ return (Rbyte *) result;
+}
+
+
+double *REAL(SEXP x){
+ unimplemented("REAL");
+}
+
+
+Rcomplex *COMPLEX(SEXP x){
+ unimplemented("COMPLEX");
+}
+
+
+SEXP STRING_ELT(SEXP x, R_xlen_t i){
+ unimplemented("STRING_ELT");
+}
+
+
+SEXP VECTOR_ELT(SEXP x, R_xlen_t i){
+ unimplemented("VECTOR_ELT");
+}
+
+
+void SET_STRING_ELT(SEXP x, R_xlen_t i, SEXP 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){
+ unimplemented("SET_VECTOR_ELT");
+}
+
+
+SEXP *STRING_PTR(SEXP x){
+ unimplemented("STRING_PTR");
+}
+
+
+SEXP *VECTOR_PTR(SEXP x){
+ unimplemented("VECTOR_PTR");
+}
diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/DynLoadFunctions.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/DynLoadFunctions.java
index c78f3c6410..524df93e0a 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/DynLoadFunctions.java
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/DynLoadFunctions.java
@@ -130,7 +130,7 @@ public class DynLoadFunctions {
@TruffleBoundary
protected Object getSymbolInfo(String symbol, RExternalPtr externalPtr, byte withReg) {
controlVisibility();
- DLL.DLLInfo dllInfo = DLL.getDLLInfoForId((int) externalPtr.value);
+ DLL.DLLInfo dllInfo = DLL.getDLLInfoForId((int) externalPtr.getAddr());
if (dllInfo == null) {
throw RError.error(getEncapsulatingSourceSection(), RError.Message.REQUIRES_NAME_DLLINFO);
}
diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/HiddenInternalFunctions.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/HiddenInternalFunctions.java
index 2337d9acc7..47890dbdd7 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/HiddenInternalFunctions.java
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/HiddenInternalFunctions.java
@@ -244,7 +244,7 @@ public class HiddenInternalFunctions {
@TruffleBoundary
protected RList getRegisteredRoutines(RExternalPtr externalPtr) {
Object[] data = new Object[NAMES.getLength()];
- DLL.DLLInfo dllInfo = DLL.getDLLInfoForId((int) externalPtr.value);
+ DLL.DLLInfo dllInfo = DLL.getDLLInfoForId((int) externalPtr.getAddr());
if (dllInfo == null) {
throw RInternalError.shouldNotReachHere();
}
diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/PrettyPrinterNode.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/PrettyPrinterNode.java
index c1b98dc20a..39d3a0bc37 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/PrettyPrinterNode.java
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/PrettyPrinterNode.java
@@ -296,7 +296,7 @@ public abstract class PrettyPrinterNode extends RNode {
@TruffleBoundary
@Specialization
protected String prettyPrintExternalPtr(RExternalPtr operand, Object listElementName, byte quote, byte right) {
- return printValueAndAttributes(String.format("<pointer: %#x>", operand.value), operand, false);
+ return printValueAndAttributes(String.format("<pointer: %#x>", operand.getAddr()), operand, false);
}
@TruffleBoundary
diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/SerializeFunctions.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/SerializeFunctions.java
index 6859fab082..78dcf930c3 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/SerializeFunctions.java
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/SerializeFunctions.java
@@ -111,6 +111,19 @@ public class SerializeFunctions {
protected Object serialize(VirtualFrame frame, Object object, RConnection conn, byte asciiLogical, RNull version, RNull refhook) {
return doSerializeToConn(object, conn, asciiLogical, RRuntime.LOGICAL_NA, version, refhook, RArguments.getDepth(frame));
}
+
+ @SuppressWarnings("unused")
+ @Specialization
+ protected Object serialize(VirtualFrame frame, Object object, RNull conn, byte asciiLogical, RNull version, RNull refhook) {
+ byte[] data = RSerialize.serialize(object, RRuntime.fromLogical(asciiLogical), false, RSerialize.DEFAULT_VERSION, null, RArguments.getDepth(frame));
+ return RDataFactory.createRawVector(data);
+ }
+
+ @SuppressWarnings("unused")
+ @Fallback
+ protected Object serialize(VirtualFrame frame, Object object, Object conn, Object asciiLogical, Object version, Object refhook) {
+ throw RError.error(getEncapsulatingSourceSection(), RError.Message.INVALID_OR_UNIMPLEMENTED_ARGUMENTS);
+ }
}
@RBuiltin(name = "serializeb", kind = INTERNAL, parameterNames = {"object", "conn", "xdr", "version", "refhook"})
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 3292498263..d2728ba7b8 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,7 +22,9 @@
*/
package com.oracle.truffle.r.runtime.ffi.jnr;
+import com.oracle.truffle.r.runtime.*;
import com.oracle.truffle.r.runtime.data.*;
+import com.oracle.truffle.r.runtime.data.model.*;
import com.oracle.truffle.r.runtime.ops.na.*;
/**
@@ -36,46 +38,84 @@ public class CallRFFIHelper {
// Checkstyle: stop method name check
- static RIntVector ScalarInteger(int value) {
+ static RIntVector Rf_ScalarInteger(int value) {
return RDataFactory.createIntVectorFromScalar(value);
}
- static RDoubleVector ScalarDouble(double value) {
+ static RDoubleVector Rf_ScalarDouble(double value) {
return RDataFactory.createDoubleVectorFromScalar(value);
}
- // Checkstyle: resume method name check
-
- /**
- * Helper function that handles {@link Integer} and {@link RIntVector} "vectors".
- *
- * @return value at logical index 0
- */
- static int getIntDataAtZero(Object x) {
+ 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 {
- assert false;
- return 0;
+ throw RInternalError.unimplemented();
}
}
- /**
- * Helper function that handles {@link Integer} and {@link RIntVector} "vectors".
- *
- * @return value at logical index 0
- */
- static double getDoubleDataAtZero(Object x) {
+ 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 {
- assert false;
- return 0;
+ throw RInternalError.unimplemented();
+ }
+ }
+
+ 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();
+ }
+ }
+
+ static int LENGTH(Object x) {
+ if (x instanceof RAbstractContainer) {
+ return ((RAbstractContainer) x).getLength();
+ } else if (x instanceof Integer || x instanceof Double || x instanceof Byte || x instanceof String) {
+ return 1;
+ } else {
+ throw RInternalError.unimplemented();
+ }
+ }
+
+ static void SET_STRING_ELT(Object x, int i, Object v) {
+ // TODO error checks
+ RStringVector xv = (RStringVector) x;
+ xv.setElement(i, v);
+ }
+
+ static byte[] RAW(Object x) {
+ if (x instanceof RRawVector) {
+ return ((RRawVector) x).getDataCopy();
+ } else {
+ throw RInternalError.unimplemented();
}
+
}
+ static int NAMED(Object x) {
+ if (x instanceof RShareable) {
+ return ((RShareable) x).isShared() ? 1 : 0;
+ } else {
+ throw RInternalError.unimplemented();
+ }
+ }
+
+ static Object Rf_duplicate(Object x) {
+ if (x instanceof RAbstractVector) {
+ return ((RAbstractVector) x).copy();
+ } else {
+ throw RInternalError.unimplemented();
+ }
+ }
+ // Checkstyle: resume method name check
+
}
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 dd9a265dcf..a2c8758110 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
@@ -28,6 +28,7 @@ import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary;
import com.oracle.truffle.api.source.*;
import com.oracle.truffle.r.runtime.*;
import com.oracle.truffle.r.runtime.RPlatform.OSInfo;
+import com.oracle.truffle.r.runtime.data.*;
import com.oracle.truffle.r.runtime.ffi.*;
import com.oracle.truffle.r.runtime.ffi.DLL.DLLException;
import com.oracle.truffle.r.runtime.ffi.DLL.SymbolInfo;
@@ -65,7 +66,7 @@ public class CallRFFIWithJNI implements CallRFFI {
throw RError.error((SourceSection) null, ex);
}
System.load(path.toString());
- initialize();
+ initialize(RNull.instance);
}
// @formatter:off
@@ -92,7 +93,7 @@ public class CallRFFIWithJNI implements CallRFFI {
return null;
}
- private static native void initialize();
+ private static native void initialize(RNull instance);
private static native Object call(long address, Object[] args);
private static native Object call0(long address);
private static native Object call1(long address, Object arg1);
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RSerialize.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RSerialize.java
index 8e68a7c8c4..7b4c4a2b9d 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RSerialize.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RSerialize.java
@@ -600,22 +600,10 @@ public class RSerialize {
}
case EXTPTRSXP: {
- Object value = readItem();
- long addr = value == RNull.instance ? 0 : (long) value;
- Object tagObj = readItem();
- String tag;
- if (tagObj == RNull.instance) {
- tag = null;
- } else {
- if (tagObj instanceof RSymbol) {
- tag = ((RSymbol) tagObj).getName();
- } else if (tagObj instanceof String) {
- tag = (String) tagObj;
- } else {
- throw RInternalError.unimplemented();
- }
- }
- result = RDataFactory.createExternalPtr(addr, tag);
+ Object prot = readItem();
+ long addr = 0;
+ Object tag = readItem();
+ result = RDataFactory.createExternalPtr(addr, tag, prot);
addReadRef(result);
break;
}
@@ -1160,7 +1148,8 @@ public class RSerialize {
return SEXPTYPE.BASEENV_SXP;
if (item == REnvironment.globalEnv())
return SEXPTYPE.GLOBALENV_SXP;
-// if (item == R_UnboundValue) return UNBOUNDVALUE_SXP;
+ if (item == RUnboundValue.instance)
+ return SEXPTYPE.UNBOUNDVALUE_SXP;
if (item == RMissing.instance)
return SEXPTYPE.MISSINGARG_SXP;
if (item == REmpty.instance)
@@ -1170,44 +1159,6 @@ public class RSerialize {
return null;
}
- private static SEXPTYPE outputType(SEXPTYPE type, Object obj) {
- switch (type) {
- case FUNSXP: {
- RFunction func = (RFunction) obj;
- if (func.isBuiltin()) {
- return SEXPTYPE.BUILTINSXP;
- } else {
- return SEXPTYPE.CLOSXP;
- }
- }
-
- case LISTSXP: {
- RPairList pl = (RPairList) obj;
- if (pl.getType() != null && pl.getType() == SEXPTYPE.LANGSXP) {
- return SEXPTYPE.LANGSXP;
- } else {
- return type;
- }
- }
-
- case FASTR_INT:
- return SEXPTYPE.INTSXP;
- case FASTR_DOUBLE:
- return SEXPTYPE.REALSXP;
- case FASTR_BYTE:
- return SEXPTYPE.LGLSXP;
- case FASTR_COMPLEX:
- return SEXPTYPE.CPLXSXP;
- case FASTR_DATAFRAME:
- case FASTR_FACTOR:
- return SEXPTYPE.VECSXP;
- case FASTR_CONNECTION:
- return SEXPTYPE.INTSXP;
- default:
- return type;
- }
- }
-
private void writeItem(Object obj) throws IOException {
SEXPTYPE specialType;
if ((specialType = saveSpecialHook(obj)) != null) {
@@ -1215,7 +1166,7 @@ public class RSerialize {
return;
}
SEXPTYPE type = SEXPTYPE.typeForClass(obj.getClass());
- SEXPTYPE outType = outputType(type, obj);
+ SEXPTYPE gnuRType = SEXPTYPE.gnuRType(type, obj);
int refIndex;
if ((refIndex = getRefIndex(obj)) != -1) {
outRefIndex(refIndex);
@@ -1277,8 +1228,8 @@ public class RSerialize {
attributes = null;
}
}
- boolean hasTag = outType == SEXPTYPE.CLOSXP || (type == SEXPTYPE.LISTSXP && !((RPairList) obj).isNullTag());
- int flags = Flags.packFlags(outType, 0, false, attributes != null, hasTag);
+ boolean hasTag = gnuRType == SEXPTYPE.CLOSXP || (type == SEXPTYPE.LISTSXP && !((RPairList) obj).isNullTag());
+ int flags = Flags.packFlags(gnuRType, 0, false, attributes != null, hasTag);
stream.writeInt(flags);
switch (type) {
case STRSXP: {
@@ -1395,8 +1346,8 @@ public class RSerialize {
case EXTPTRSXP: {
addReadRef(obj);
RExternalPtr xptr = (RExternalPtr) obj;
- writeItem(RNull.instance);
- writeItem(RDataFactory.createSymbol(xptr.tag));
+ writeItem(xptr.getProt());
+ writeItem(xptr.getTag());
break;
}
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/conn/ConnectionSupport.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/conn/ConnectionSupport.java
index 14803df39a..36d4ececb7 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/conn/ConnectionSupport.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/conn/ConnectionSupport.java
@@ -413,7 +413,7 @@ public class ConnectionSupport implements RContext.StateFactory {
classes[1] = "connection";
getAttributes().put(RRuntime.CLASS_ATTR_KEY, RDataFactory.createStringVector(classes, RDataFactory.COMPLETE_VECTOR));
// For GnuR compatibility we define the "conn_id" attribute
- getAttributes().put("conn_id", RDataFactory.createExternalPtr(0, "connection"));
+ getAttributes().put("conn_id", RDataFactory.createExternalPtr(0, RDataFactory.createSymbol("connection")));
}
protected void openNonLazyConnection() throws IOException {
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RDataFactory.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RDataFactory.java
index b5ef2c4eef..3bb117de2a 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RDataFactory.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RDataFactory.java
@@ -412,8 +412,12 @@ public final class RDataFactory {
return traceDataCreated(new RS4Object());
}
- public static RExternalPtr createExternalPtr(long value, String tag) {
- return traceDataCreated(new RExternalPtr(value, tag));
+ public static RExternalPtr createExternalPtr(long value, Object tag, Object prot) {
+ return traceDataCreated(new RExternalPtr(value, tag, prot));
+ }
+
+ public static RExternalPtr createExternalPtr(long value, Object tag) {
+ return traceDataCreated(new RExternalPtr(value, tag, RNull.instance));
}
@CompilationFinal private static PerfHandler stats;
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RExternalPtr.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RExternalPtr.java
index 2a74101935..5a72160e27 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RExternalPtr.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RExternalPtr.java
@@ -28,12 +28,38 @@ import com.oracle.truffle.r.runtime.*;
* The rarely seen {@code externalptr} type.
*/
public class RExternalPtr extends RAttributeStorage implements RAttributable, RTypedValue {
- public final long value;
- public final String tag;
+ private long addr;
+ private Object tag;
+ private Object prot;
- RExternalPtr(long value, String tag) {
- this.value = value;
+ RExternalPtr(long addr, Object tag, Object prot) {
+ this.addr = addr;
this.tag = tag;
+ this.prot = prot;
+ }
+
+ public long getAddr() {
+ return addr;
+ }
+
+ public Object getTag() {
+ return tag;
+ }
+
+ public Object getProt() {
+ return prot;
+ }
+
+ public void setAddr(long value) {
+ this.addr = value;
+ }
+
+ public void setTag(Object tag) {
+ this.tag = tag;
+ }
+
+ public void setProt(Object prot) {
+ this.prot = prot;
}
public RType getRType() {
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RFFIAccess.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RFFIAccess.java
new file mode 100644
index 0000000000..c7c9d0046a
--- /dev/null
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RFFIAccess.java
@@ -0,0 +1,36 @@
+/*
+ * 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.
+ */
+package com.oracle.truffle.r.runtime.data;
+
+import com.oracle.truffle.r.runtime.*;
+
+/**
+ * An interface for "unsafe" container access by the FFI interface. FFI code allocates vectors of a
+ * given size, as per GnuR internals, and then populates the elements in separate calls.
+ */
+public interface RFFIAccess {
+ @SuppressWarnings("unused")
+ default void setElement(int i, Object value) {
+ throw RInternalError.unimplemented("setElement");
+ }
+}
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringVector.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringVector.java
index 40a72b3bc6..dc0c5ceb4f 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringVector.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringVector.java
@@ -191,4 +191,10 @@ public final class RStringVector extends RVector implements RAbstractStringVecto
protected RStringVector getImplicitClassHr() {
return getClassHierarchyHelper(implicitClassHeader, implicitClassHeaderArray, implicitClassHeaderMatrix);
}
+
+ @Override
+ public void setElement(int i, Object value) {
+ data[i] = (String) value;
+ }
+
}
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RVector.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RVector.java
index 0403c16a0f..b36381b86f 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RVector.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RVector.java
@@ -45,7 +45,7 @@ import edu.umd.cs.findbugs.annotations.*;
* - non-shared => shared
* </pre>
*/
-public abstract class RVector extends RBounded implements RShareable, RAbstractVector {
+public abstract class RVector extends RBounded implements RShareable, RAbstractVector, RFFIAccess {
protected boolean complete; // "complete" means: does not contain NAs
protected int[] dimensions;
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/DLL.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/DLL.java
index a86154f3e0..64b4e829bb 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/DLL.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/DLL.java
@@ -200,11 +200,12 @@ public class DLL {
}
public static boolean isDLLInfo(RExternalPtr info) {
- return info.tag.equals(DLLInfo.DLL_INFO_REFERENCE);
+ RSymbol tag = (RSymbol) info.getTag();
+ return tag.getName().equals(DLLInfo.DLL_INFO_REFERENCE);
}
public static RExternalPtr createExternalPtr(long value, RStringVector rClass) {
- RExternalPtr result = RDataFactory.createExternalPtr(value, rClass.getDataAt(0));
+ RExternalPtr result = RDataFactory.createExternalPtr(value, RDataFactory.createSymbol(rClass.getDataAt(0)));
result.setClassAttr(rClass, false);
return result;
}
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 5992eea38b..c950d184a7 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
@@ -139,6 +139,56 @@ public enum SEXPTYPE {
throw RInternalError.shouldNotReachHere(fastRClass.getName());
}
+ /**
+ * Accessed from FFI layer.
+ */
+ public static int gnuRCodeForObject(Object obj) {
+ SEXPTYPE type = typeForClass(obj.getClass());
+ return gnuRType(type, obj).code;
+ }
+
+ /**
+ * Convert an {@code SEXPTYPE} that may be a {@code FASTR_XXX} variant into the appropriate GnuR
+ * type.
+ */
+ public static SEXPTYPE gnuRType(SEXPTYPE type, Object obj) {
+ switch (type) {
+ case FUNSXP: {
+ RFunction func = (RFunction) obj;
+ if (func.isBuiltin()) {
+ return SEXPTYPE.BUILTINSXP;
+ } else {
+ return SEXPTYPE.CLOSXP;
+ }
+ }
+
+ case LISTSXP: {
+ RPairList pl = (RPairList) obj;
+ if (pl.getType() != null && pl.getType() == SEXPTYPE.LANGSXP) {
+ return SEXPTYPE.LANGSXP;
+ } else {
+ return type;
+ }
+ }
+
+ case FASTR_INT:
+ return SEXPTYPE.INTSXP;
+ case FASTR_DOUBLE:
+ return SEXPTYPE.REALSXP;
+ case FASTR_BYTE:
+ return SEXPTYPE.LGLSXP;
+ case FASTR_COMPLEX:
+ return SEXPTYPE.CPLXSXP;
+ case FASTR_DATAFRAME:
+ case FASTR_FACTOR:
+ return SEXPTYPE.VECSXP;
+ case FASTR_CONNECTION:
+ return SEXPTYPE.INTSXP;
+ default:
+ return type;
+ }
+ }
+
public static SEXPTYPE convertFastRScalarType(SEXPTYPE type) {
switch (type) {
case FASTR_DOUBLE:
diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/NAMESPACE b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/NAMESPACE
index 6a46a89ac9..465189b97d 100644
--- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/NAMESPACE
+++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/NAMESPACE
@@ -5,3 +5,6 @@ useDynLib(testrffi)
export(add_int)
export(add_double)
export(createIntVector)
+export(createExternalPtr)
+export(getExternalPtrAddr)
+export(test_TYPEOF)
diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/testrffi.R b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/testrffi.R
index 1dfb43aea4..efa57a3383 100644
--- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/testrffi.R
+++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/testrffi.R
@@ -9,3 +9,15 @@ add_double <- function(a, b) {
createIntVector <- function(n) {
.Call("createIntVector", as.integer(n), PACKAGE = "testrffi")
}
+
+createExternalPtr <- function(addr, tag, prot) {
+ .Call("createExternalPtr", as.integer(addr), tag, prot, PACKAGE = "testrffi")
+}
+
+getExternalPtrAddr <- function(eptr) {
+ .Call("getExternalPtrAddr", eptr)
+}
+
+test_TYPEOF <- function(x) {
+ .Call("test_TYPEOF", x, PACKAGE = "testrffi")
+}
diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.c b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.c
index 0ce7071e72..9ef4221195 100644
--- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.c
+++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.c
@@ -43,3 +43,15 @@ SEXP createIntVector(SEXP n) {
SEXP v = allocVector(INTSXP, INTEGER_VALUE(n));
return v;
}
+
+SEXP createExternalPtr(SEXP addr, SEXP tag, SEXP prot) {
+ return R_MakeExternalPtr((void *) (long) INTEGER_VALUE(addr), tag, prot);
+}
+
+SEXP getExternalPtrAddr(SEXP eptr) {
+ return ScalarInteger((int) R_ExternalPtrAddr(eptr));
+}
+
+SEXP test_TYPEOF(SEXP x) {
+ return ScalarInteger(TYPEOF(x));
+}
diff --git a/mx.fastr/copyrights/overrides b/mx.fastr/copyrights/overrides
index 6f36acb3c7..19ac35e9f9 100644
--- a/mx.fastr/copyrights/overrides
+++ b/mx.fastr/copyrights/overrides
@@ -1,5 +1,6 @@
com.oracle.truffle.r.native/builtinlibs/src/rdummy.c,no.copyright
com.oracle.truffle.r.native/fficall/jni/src/rfficall.c,gnu_r.copyright
+com.oracle.truffle.r.native/fficall/jni/src/alloc.c,gnu_r.copyright
com.oracle.truffle.r.native/include/jni/src/R_ext/GraphicsDevice.h,no.copyright
com.oracle.truffle.r.native/include/jni/src/R_ext/GraphicsEngine.h,no.copyright
com.oracle.truffle.r.native/include/jni/src/libintl.h,no.copyright
--
GitLab