From d463087d3c4ebad53ec53e78fa65b1b00f46c421 Mon Sep 17 00:00:00 2001
From: Mick Jordan <mick.jordan@oracle.com>
Date: Wed, 3 May 2017 08:51:50 -0700
Subject: [PATCH] [GR-2527] Bring NFI imple in sync with JNI; fix naming issues
---
.../fficall/src/common/Rinternals_common.c | 191 ++++++++++++
.../fficall/src/common/Rinternals_common.h | 26 ++
.../fficall/src/jni/Makefile | 2 +-
.../fficall/src/jni/Rinternals.c | 213 ++------------
.../fficall/src/truffle_nfi/Makefile | 2 +-
.../fficall/src/truffle_nfi/Memory.c | 4 +-
.../fficall/src/truffle_nfi/Rdynload_fastr.c | 4 +-
.../fficall/src/truffle_nfi/Rinternals.c | 271 ++++++------------
.../fficall/src/truffle_nfi/base_rffi.c | 4 +-
.../fficall/src/truffle_nfi/rffi_callbacks.h | 7 +-
.../src/truffle_nfi/rffi_callbacksindex.h | 241 ++++++++--------
.../fficall/src/truffle_nfi/rffiutils.c | 29 ++
.../fficall/src/truffle_nfi/rffiutils.h | 5 +
.../fficall/src/truffle_nfi/variables.c | 15 +-
com.oracle.truffle.r.native/version.source | 2 +-
.../r/nodes/ffi/JavaUpCallsRFFIImpl.java | 18 +-
.../truffle/r/nodes/ffi/RFFIUpCallMethod.java | 19 +-
.../r/nodes/ffi/TracingUpCallsRFFIImpl.java | 30 +-
.../truffle/r/runtime/ffi/StdUpCallsRFFI.java | 16 +-
mx.fastr/mx_fastr_mkgramrd.py | 2 +-
20 files changed, 552 insertions(+), 549 deletions(-)
create mode 100644 com.oracle.truffle.r.native/fficall/src/common/Rinternals_common.c
create mode 100644 com.oracle.truffle.r.native/fficall/src/common/Rinternals_common.h
create mode 100644 com.oracle.truffle.r.native/fficall/src/truffle_nfi/rffiutils.c
diff --git a/com.oracle.truffle.r.native/fficall/src/common/Rinternals_common.c b/com.oracle.truffle.r.native/fficall/src/common/Rinternals_common.c
new file mode 100644
index 0000000000..b4c88dff80
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/src/common/Rinternals_common.c
@@ -0,0 +1,191 @@
+/*
+ * Copyright (c) 2015, 2017, Oracle and/or its affiliates. All rights reserved.
+ * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
+ *
+ * This code is free software; you can redistribute it and/or modify it
+ * 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 <Rinternals.h>
+
+// This file includes all implementations that arise from Rinternals.h that
+// are independent, or largely independent, of the RFFI implementation.
+
+Rboolean Rf_isReal(SEXP x) {
+ return TYPEOF(x) == REALSXP;
+}
+
+Rboolean Rf_isSymbol(SEXP x) {
+ return TYPEOF(x) == SYMSXP;
+}
+
+Rboolean Rf_isComplex(SEXP x) {
+ return TYPEOF(x) == CPLXSXP;
+}
+
+Rboolean Rf_isEnvironment(SEXP x) {
+ return TYPEOF(x) == ENVSXP;
+}
+
+Rboolean Rf_isExpression(SEXP x) {
+ return TYPEOF(x) == EXPRSXP;
+}
+
+Rboolean Rf_isLogical(SEXP x) {
+ return TYPEOF(x) == LGLSXP;
+}
+
+SEXP GetOption(SEXP tag, SEXP rho)
+{
+ return GetOption1(tag); // RFFI impl dependent
+}
+
+int GetOptionCutoff(void)
+{
+ int w;
+ w = asInteger(GetOption1(install("deparse.cutoff")));
+ if (w == NA_INTEGER || w <= 0) {
+ warning("invalid 'deparse.cutoff', used 60");
+ w = 60;
+ }
+ return w;
+}
+
+#define R_MIN_WIDTH_OPT 10
+#define R_MAX_WIDTH_OPT 10000
+#define R_MIN_DIGITS_OPT 0
+#define R_MAX_DIGITS_OPT 22
+
+int GetOptionWidth(void)
+{
+ int w;
+ w = asInteger(GetOption1(install("width")));
+ if (w < R_MIN_WIDTH_OPT || w > R_MAX_WIDTH_OPT) {
+ warning("invalid printing width, used 80");
+ return 80;
+ }
+ return w;
+}
+
+int GetOptionDigits(void)
+{
+ int d;
+ d = asInteger(GetOption1(install("digits")));
+ if (d < R_MIN_DIGITS_OPT || d > R_MAX_DIGITS_OPT) {
+ warning("invalid printing digits, used 7");
+ return 7;
+ }
+ return d;
+}
+
+Rboolean Rf_GetOptionDeviceAsk(void)
+{
+ int ask;
+ ask = asLogical(GetOption1(install("device.ask.default")));
+ if(ask == NA_LOGICAL) {
+ warning("invalid value for \"device.ask.default\", using FALSE");
+ return FALSE;
+ }
+ return ask != 0;
+}
+
+void *DATAPTR(SEXP x) {
+ int type = TYPEOF(x);
+ if (type == INTSXP) {
+ return INTEGER(x);
+ } else if (type == REALSXP) {
+ return REAL(x);
+ } else if (type == LGLSXP) {
+ return LOGICAL(x);
+ } else {
+ printf("DATAPTR %d\n", type);
+ unimplemented("R_DATAPTR");
+ return NULL;
+ }
+}
+
+int R_check_class_and_super(SEXP x, const char **valid, SEXP rho) {
+ int ans;
+ SEXP cl = PROTECT(asChar(getAttrib(x, R_ClassSymbol)));
+ const char *class = CHAR(cl);
+ for (ans = 0; ; ans++) {
+ if (!strlen(valid[ans])) // empty string
+ break;
+ if (!strcmp(class, valid[ans])) {
+ UNPROTECT(1); /* cl */
+ return ans;
+ }
+ }
+ /* if not found directly, now search the non-virtual super classes :*/
+ if(IS_S4_OBJECT(x)) {
+ /* now try the superclasses, i.e., try is(x, "...."); superCl :=
+ .selectSuperClasses(getClass("....")@contains, dropVirtual=TRUE) */
+ SEXP classExts, superCl, _call;
+ // install() results cached anyway so the following variables could be non-static if needed
+ static SEXP s_contains = NULL, s_selectSuperCl = NULL;
+ int i;
+ if(!s_contains) {
+ s_contains = install("contains");
+ s_selectSuperCl = install(".selectSuperClasses");
+ }
+ SEXP classDef = PROTECT(R_getClassDef(class));
+ PROTECT(classExts = R_do_slot(classDef, s_contains));
+ PROTECT(_call = lang3(s_selectSuperCl, classExts,
+ /* dropVirtual = */ ScalarLogical(1)));
+ superCl = eval(_call, rho);
+ UNPROTECT(3); /* _call, classExts, classDef */
+ PROTECT(superCl);
+ for(i=0; i < LENGTH(superCl); i++) {
+ const char *s_class = CHAR(STRING_ELT(superCl, i));
+ for (ans = 0; ; ans++) {
+ if (!strlen(valid[ans]))
+ break;
+ if (!strcmp(s_class, valid[ans])) {
+ UNPROTECT(2); /* superCl, cl */
+ return ans;
+ }
+ }
+ }
+ UNPROTECT(1); /* superCl */
+ }
+ UNPROTECT(1); /* cl */
+ return -1;
+}
+
+int R_check_class_etc_helper (SEXP x, const char **valid, SEXP (*getMethodsNamespace)()) {
+ // install() results cached anyway so the following variables could be non-static if needed
+ static SEXP meth_classEnv = NULL;
+ SEXP cl = getAttrib(x, R_ClassSymbol), rho = R_GlobalEnv, pkg;
+ if (!meth_classEnv)
+ meth_classEnv = install(".classEnv");
+
+ pkg = getAttrib(cl, R_PackageSymbol); /* ==R== packageSlot(class(x)) */
+ if (!isNull(pkg)) { /* find rho := correct class Environment */
+ SEXP clEnvCall;
+ // FIXME: fails if 'methods' is not loaded.
+ PROTECT(clEnvCall = lang2(meth_classEnv, cl));
+ SEXP methodsNamespace = getMethodsNamespace();
+ rho = eval(clEnvCall, methodsNamespace);
+ UNPROTECT(1);
+ if (!isEnvironment(rho))
+ error(_("could not find correct environment; please report!"));
+ }
+ PROTECT(rho);
+ int res = R_check_class_and_super(x, valid, rho);
+ UNPROTECT(1);
+ return res;
+}
diff --git a/com.oracle.truffle.r.native/fficall/src/common/Rinternals_common.h b/com.oracle.truffle.r.native/fficall/src/common/Rinternals_common.h
new file mode 100644
index 0000000000..6d78b52544
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/src/common/Rinternals_common.h
@@ -0,0 +1,26 @@
+/*
+ * Copyright (c) 2014, 2017, Oracle and/or its affiliates. All rights reserved.
+ * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
+ *
+ * This code is free software; you can redistribute it and/or modify it
+ * 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 <Rinternals.h>
+
+// Factors out the RFFI mechanism for getting the methods namespace.
+int R_check_class_etc_helper (SEXP x, const char **valid, SEXP (*getMethodsNamespace)());
diff --git a/com.oracle.truffle.r.native/fficall/src/jni/Makefile b/com.oracle.truffle.r.native/fficall/src/jni/Makefile
index fbbb5f7439..1108df184f 100644
--- a/com.oracle.truffle.r.native/fficall/src/jni/Makefile
+++ b/com.oracle.truffle.r.native/fficall/src/jni/Makefile
@@ -38,7 +38,7 @@ C_OBJECTS := $(patsubst %.c,$(OBJ)/%.o,$(C_SOURCES))
JNI_INCLUDES = -I $(JAVA_HOME)/include -I $(JAVA_HOME)/include/$(JDK_OS_DIR)
FFI_INCLUDES = -I$(TOPDIR)/include -I$(TOPDIR)/include/R_ext
-LOCAL_INCLUDES = -I . -I $(abspath ../include)
+LOCAL_INCLUDES = -I . -I $(abspath ../include) -I $(abspath ../common)
INCLUDES := $(LOCAL_INCLUDES) $(JNI_INCLUDES) $(FFI_INCLUDES)
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 f2e058cf9e..1f63778f8f 100644
--- a/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c
+++ b/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c
@@ -22,6 +22,7 @@
*/
#include <rffiutils.h>
#include <string.h>
+#include <Rinternals_common.h>
// Most everything in RInternals.h
@@ -36,14 +37,14 @@ static jmethodID Rf_ScalarIntegerMethodID;
static jmethodID Rf_ScalarDoubleMethodID;
static jmethodID Rf_ScalarStringMethodID;
static jmethodID Rf_ScalarLogicalMethodID;
-static jmethodID Rf_allocateVectorMethodID;
-static jmethodID Rf_allocateArrayMethodID;
-static jmethodID Rf_allocateMatrixMethodID;
+static jmethodID Rf_allocVectorMethodID;
+static jmethodID Rf_allocArrayMethodID;
+static jmethodID Rf_allocMatrixMethodID;
static jmethodID Rf_duplicateMethodID;
-static jmethodID Rf_anyDuplicatedMethodID;
+static jmethodID Rf_any_duplicatedMethodID;
static jmethodID Rf_consMethodID;
static jmethodID Rf_evalMethodID;
-static jmethodID Rf_findfunMethodID;
+static jmethodID Rf_findFunMethodID;
static jmethodID Rf_defineVarMethodID;
static jmethodID Rf_findVarMethodID;
static jmethodID Rf_findVarInFrameMethodID;
@@ -131,12 +132,12 @@ static jmethodID restoreHandlerStacksMethodID;
static jmethodID R_MakeExternalPtrMethodID;
static jmethodID R_ExternalPtrAddrMethodID;
static jmethodID R_ExternalPtrTagMethodID;
-static jmethodID R_ExternalPtrProtMethodID;
+static jmethodID R_ExternalPtrProtectedMethodID;
static jmethodID R_SetExternalPtrAddrMethodID;
static jmethodID R_SetExternalPtrTagMethodID;
static jmethodID R_SetExternalPtrProtMethodID;
-static jmethodID R_computeIdenticalMethodID;
+static jmethodID R_compute_identicalMethodID;
static jmethodID Rf_copyListMatrixMethodID;
static jmethodID Rf_copyMatrixMethodID;
static jmethodID Rf_nrowsMethodID;
@@ -154,7 +155,7 @@ void init_internals(JNIEnv *env) {
Rf_ScalarLogicalMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_ScalarLogical", "(I)Lcom/oracle/truffle/r/runtime/data/RLogicalVector;", 0);
Rf_consMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_cons", "(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;", 0);
Rf_evalMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_eval", "(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;", 0);
- Rf_findfunMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_findfun", "(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;", 0);
+ Rf_findFunMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_findFun", "(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;", 0);
Rf_defineVarMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_defineVar", "(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)V", 0);
Rf_findVarMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_findVar", "(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;", 0);
Rf_findVarInFrameMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_findVarInFrame", "(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;", 0);
@@ -168,11 +169,11 @@ void init_internals(JNIEnv *env) {
Rf_warningMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_warning", "(Ljava/lang/Object;)V", 0);
Rf_warningcallMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_warningcall", "(Ljava/lang/Object;Ljava/lang/Object;)V", 0);
Rf_errorMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_error", "(Ljava/lang/Object;)V", 0);
- Rf_allocateVectorMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_allocateVector", "(II)Ljava/lang/Object;", 0);
- Rf_allocateMatrixMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_allocateMatrix", "(III)Ljava/lang/Object;", 0);
- Rf_allocateArrayMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_allocateArray", "(ILjava/lang/Object;)Ljava/lang/Object;", 0);
+ Rf_allocVectorMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_allocVector", "(II)Ljava/lang/Object;", 0);
+ Rf_allocMatrixMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_allocMatrix", "(III)Ljava/lang/Object;", 0);
+ Rf_allocArrayMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_allocArray", "(ILjava/lang/Object;)Ljava/lang/Object;", 0);
Rf_duplicateMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_duplicate", "(Ljava/lang/Object;I)Ljava/lang/Object;", 0);
- Rf_anyDuplicatedMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_anyDuplicated", "(Ljava/lang/Object;I)I", 0);
+ Rf_any_duplicatedMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_any_duplicated", "(Ljava/lang/Object;I)I", 0);
R_NewHashedEnvMethodID = checkGetMethodID(env, UpCallsRFFIClass, "R_NewHashedEnv", "(Lcom/oracle/truffle/r/runtime/env/REnvironment;Ljava/lang/Object;)Lcom/oracle/truffle/r/runtime/env/REnvironment;", 0);
Rf_classgetsMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_classgets", "(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;", 0);
RprintfMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rprintf", "(Ljava/lang/Object;)V", 0);
@@ -244,12 +245,12 @@ void init_internals(JNIEnv *env) {
R_MakeExternalPtrMethodID = checkGetMethodID(env, UpCallsRFFIClass, "R_MakeExternalPtr", "(JLjava/lang/Object;Ljava/lang/Object;)Lcom/oracle/truffle/r/runtime/data/RExternalPtr;", 0);
R_ExternalPtrAddrMethodID = checkGetMethodID(env, UpCallsRFFIClass, "R_ExternalPtrAddr", "(Ljava/lang/Object;)J", 0);
R_ExternalPtrTagMethodID = checkGetMethodID(env, UpCallsRFFIClass, "R_ExternalPtrTag", "(Ljava/lang/Object;)Ljava/lang/Object;", 0);
- R_ExternalPtrProtMethodID = checkGetMethodID(env, UpCallsRFFIClass, "R_ExternalPtrProt", "(Ljava/lang/Object;)Ljava/lang/Object;", 0);
+ R_ExternalPtrProtectedMethodID = checkGetMethodID(env, UpCallsRFFIClass, "R_ExternalPtrProtected", "(Ljava/lang/Object;)Ljava/lang/Object;", 0);
R_SetExternalPtrAddrMethodID = checkGetMethodID(env, UpCallsRFFIClass, "R_SetExternalPtrAddr", "(Ljava/lang/Object;J)V", 0);
R_SetExternalPtrTagMethodID = checkGetMethodID(env, UpCallsRFFIClass, "R_SetExternalPtrTag", "(Ljava/lang/Object;Ljava/lang/Object;)V", 0);
- R_SetExternalPtrProtMethodID = checkGetMethodID(env, UpCallsRFFIClass, "R_SetExternalPtrProt", "(Ljava/lang/Object;Ljava/lang/Object;)V", 0);
+ R_SetExternalPtrProtMethodID = checkGetMethodID(env, UpCallsRFFIClass, "R_SetExternalPtrProtected", "(Ljava/lang/Object;Ljava/lang/Object;)V", 0);
- R_computeIdenticalMethodID = checkGetMethodID(env, UpCallsRFFIClass, "R_computeIdentical", "(Ljava/lang/Object;Ljava/lang/Object;I)I", 0);
+ R_compute_identicalMethodID = checkGetMethodID(env, UpCallsRFFIClass, "R_compute_identical", "(Ljava/lang/Object;Ljava/lang/Object;I)I", 0);
Rf_copyListMatrixMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_copyListMatrix", "(Ljava/lang/Object;Ljava/lang/Object;I)V", 0);
Rf_copyMatrixMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_copyMatrix", "(Ljava/lang/Object;Ljava/lang/Object;I)V", 0);
Rf_nrowsMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_nrows", "(Ljava/lang/Object;)I", 0);
@@ -296,14 +297,14 @@ SEXP Rf_allocVector3(SEXPTYPE t, R_xlen_t len, R_allocator_t* allocator) {
}
TRACE(TARGpd, t, len);
JNIEnv *thisenv = getEnv();
- SEXP result = (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, Rf_allocateVectorMethodID, t, len);
+ SEXP result = (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, Rf_allocVectorMethodID, t, len);
return checkRef(thisenv, result);
}
SEXP Rf_allocArray(SEXPTYPE t, SEXP dims) {
TRACE(TARGppd, t, dims);
JNIEnv *thisenv = getEnv();
- SEXP result = (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, Rf_allocateArrayMethodID, t, dims);
+ SEXP result = (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, Rf_allocArrayMethodID, t, dims);
return checkRef(thisenv, result);
}
@@ -314,7 +315,7 @@ SEXP Rf_alloc3DArray(SEXPTYPE t, int x, int y, int z) {
SEXP Rf_allocMatrix(SEXPTYPE mode, int nrow, int ncol) {
TRACE(TARGppd, mode, nrow, ncol);
JNIEnv *thisenv = getEnv();
- SEXP result = (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, Rf_allocateMatrixMethodID, mode, nrow, ncol);
+ SEXP result = (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, Rf_allocMatrixMethodID, mode, nrow, ncol);
return checkRef(thisenv, result);
}
@@ -363,7 +364,7 @@ SEXP Rf_eval(SEXP expr, SEXP env) {
SEXP Rf_findFun(SEXP symbol, SEXP rho) {
TRACE(TARGpp, symbol, rho);
JNIEnv *thisenv = getEnv();
- SEXP result = (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, Rf_findfunMethodID, symbol, rho);
+ SEXP result = (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, Rf_findFunMethodID, symbol, rho);
return checkRef(thisenv, result);
}
@@ -420,7 +421,7 @@ R_xlen_t Rf_any_duplicated(SEXP x, Rboolean from_last) {
TRACE(TARGpd, x, from_last);
if (!isVector(x)) error(_("'duplicated' applies only to vectors"));
JNIEnv *thisenv = getEnv();
- return (*thisenv)->CallIntMethod(thisenv, UpCallsRFFIObject, Rf_anyDuplicatedMethodID, x, from_last);
+ return (*thisenv)->CallIntMethod(thisenv, UpCallsRFFIObject, Rf_any_duplicatedMethodID, x, from_last);
}
SEXP Rf_duplicated(SEXP x, Rboolean y) {
@@ -451,29 +452,6 @@ Rboolean Rf_inherits(SEXP x, const char * klass) {
return (*thisenv)->CallIntMethod(thisenv, UpCallsRFFIObject, Rf_inheritsMethodID, x, klazz);
}
-Rboolean Rf_isReal(SEXP x) {
- return TYPEOF(x) == REALSXP;
-}
-
-Rboolean Rf_isSymbol(SEXP x) {
- return TYPEOF(x) == SYMSXP;
-}
-
-Rboolean Rf_isComplex(SEXP x) {
- return TYPEOF(x) == CPLXSXP;
-}
-
-Rboolean Rf_isEnvironment(SEXP x) {
- return TYPEOF(x) == ENVSXP;
-}
-
-Rboolean Rf_isExpression(SEXP x) {
- return TYPEOF(x) == EXPRSXP;
-}
-
-Rboolean Rf_isLogical(SEXP x) {
- return TYPEOF(x) == LGLSXP;
-}
Rboolean Rf_isObject(SEXP s) {
unimplemented("Rf_isObject");
@@ -756,60 +734,6 @@ SEXP GetOption1(SEXP tag)
return checkRef(thisenv, result);
}
-SEXP GetOption(SEXP tag, SEXP rho)
-{
- return GetOption1(tag);
-}
-
-int GetOptionCutoff(void)
-{
- int w;
- w = asInteger(GetOption1(install("deparse.cutoff")));
- if (w == NA_INTEGER || w <= 0) {
- warning(_("invalid 'deparse.cutoff', used 60"));
- w = 60;
- }
- return w;
-}
-
-#define R_MIN_WIDTH_OPT 10
-#define R_MAX_WIDTH_OPT 10000
-#define R_MIN_DIGITS_OPT 0
-#define R_MAX_DIGITS_OPT 22
-
-int GetOptionWidth(void)
-{
- int w;
- w = asInteger(GetOption1(install("width")));
- if (w < R_MIN_WIDTH_OPT || w > R_MAX_WIDTH_OPT) {
- warning(_("invalid printing width, used 80"));
- return 80;
- }
- return w;
-}
-
-int GetOptionDigits(void)
-{
- int d;
- d = asInteger(GetOption1(install("digits")));
- if (d < R_MIN_DIGITS_OPT || d > R_MAX_DIGITS_OPT) {
- warning(_("invalid printing digits, used 7"));
- return 7;
- }
- return d;
-}
-
-Rboolean Rf_GetOptionDeviceAsk(void)
-{
- int ask;
- ask = asLogical(GetOption1(install("device.ask.default")));
- if(ask == NA_LOGICAL) {
- warning(_("invalid value for \"device.ask.default\", using FALSE"));
- return FALSE;
- }
- return ask != 0;
-}
-
void Rf_gsetVar(SEXP symbol, SEXP value, SEXP rho)
{
JNIEnv *thisenv = getEnv();
@@ -1271,7 +1195,7 @@ double Rf_asReal(SEXP x) {
}
Rcomplex Rf_asComplex(SEXP x){
- unimplemented("Rf_asLogical");
+ unimplemented("Rf_asComplex");
Rcomplex c; return c;
}
@@ -1341,21 +1265,6 @@ const char *R_CHAR(SEXP charsxp) {
return copyChars;
}
-void *DATAPTR(SEXP x) {
- int type = TYPEOF(x);
- if (type == INTSXP) {
- return INTEGER(x);
- } else if (type == REALSXP) {
- return REAL(x);
- } else if (type == LGLSXP) {
- return LOGICAL(x);
- } else {
- printf("DATAPTR %d\n", type);
- unimplemented("R_DATAPTR");
- return NULL;
- }
-}
-
void R_qsort_I (double *v, int *II, int i, int j) {
unimplemented("R_qsort_I");
}
@@ -1454,7 +1363,7 @@ Rboolean R_BindingIsLocked(SEXP sym, SEXP env) {
}
Rboolean R_BindingIsActive(SEXP sym, SEXP env) {
- // TODO: for now, I belive all bindings are false
+ // TODO: for now, I believe all bindings are false
return (Rboolean)0;
}
@@ -1531,7 +1440,7 @@ SEXP R_ExternalPtrTag(SEXP s) {
SEXP R_ExternalPtrProt(SEXP s) {
JNIEnv *thisenv = getEnv();
- SEXP result = (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, R_ExternalPtrProtMethodID, s);
+ SEXP result = (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, R_ExternalPtrProtectedMethodID, s);
return checkRef(thisenv, result);
}
@@ -1628,77 +1537,13 @@ SEXP R_do_new_object(SEXP class_def) {
return checkRef(thisenv, result);
}
-int R_check_class_and_super(SEXP x, const char **valid, SEXP rho) {
- int ans;
- SEXP cl = PROTECT(asChar(getAttrib(x, R_ClassSymbol)));
- const char *class = CHAR(cl);
- for (ans = 0; ; ans++) {
- if (!strlen(valid[ans])) // empty string
- break;
- if (!strcmp(class, valid[ans])) {
- UNPROTECT(1); /* cl */
- return ans;
- }
- }
- /* if not found directly, now search the non-virtual super classes :*/
- if(IS_S4_OBJECT(x)) {
- /* now try the superclasses, i.e., try is(x, "...."); superCl :=
- .selectSuperClasses(getClass("....")@contains, dropVirtual=TRUE) */
- SEXP classExts, superCl, _call;
- // install() results cached anyway so the following variables could be non-static if needed
- static SEXP s_contains = NULL, s_selectSuperCl = NULL;
- int i;
- if(!s_contains) {
- s_contains = install("contains");
- s_selectSuperCl = install(".selectSuperClasses");
- }
- SEXP classDef = PROTECT(R_getClassDef(class));
- PROTECT(classExts = R_do_slot(classDef, s_contains));
- PROTECT(_call = lang3(s_selectSuperCl, classExts,
- /* dropVirtual = */ ScalarLogical(1)));
- superCl = eval(_call, rho);
- UNPROTECT(3); /* _call, classExts, classDef */
- PROTECT(superCl);
- for(i=0; i < LENGTH(superCl); i++) {
- const char *s_class = CHAR(STRING_ELT(superCl, i));
- for (ans = 0; ; ans++) {
- if (!strlen(valid[ans]))
- break;
- if (!strcmp(s_class, valid[ans])) {
- UNPROTECT(2); /* superCl, cl */
- return ans;
- }
- }
- }
- UNPROTECT(1); /* superCl */
- }
- UNPROTECT(1); /* cl */
- return -1;
+static SEXP jniGetMethodsNamespace() {
+ JNIEnv *thisenv = getEnv();
+ return (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, R_MethodsNamespaceMethodID);
}
int R_check_class_etc (SEXP x, const char **valid) {
- // install() results cached anyway so the following variables could be non-static if needed
- static SEXP meth_classEnv = NULL;
- SEXP cl = getAttrib(x, R_ClassSymbol), rho = R_GlobalEnv, pkg;
- if (!meth_classEnv)
- meth_classEnv = install(".classEnv");
-
- pkg = getAttrib(cl, R_PackageSymbol); /* ==R== packageSlot(class(x)) */
- if (!isNull(pkg)) { /* find rho := correct class Environment */
- SEXP clEnvCall;
- // FIXME: fails if 'methods' is not loaded.
- PROTECT(clEnvCall = lang2(meth_classEnv, cl));
- JNIEnv *thisenv = getEnv();
- SEXP methodsNamespace = (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, R_MethodsNamespaceMethodID);
- rho = eval(clEnvCall, methodsNamespace);
- UNPROTECT(1);
- if (!isEnvironment(rho))
- error(_("could not find correct environment; please report!"));
- }
- PROTECT(rho);
- int res = R_check_class_and_super(x, valid, rho);
- UNPROTECT(1);
- return res;
+ return R_check_class_etc_helper(x, valid, jniGetMethodsNamespace);
}
SEXP R_PreserveObject(SEXP x) {
@@ -1717,7 +1562,7 @@ void R_dot_Last(void) {
Rboolean R_compute_identical(SEXP x, SEXP y, int flags) {
JNIEnv *thisenv = getEnv();
- return (*thisenv)->CallIntMethod(thisenv, UpCallsRFFIObject, R_computeIdenticalMethodID, x, y, flags);
+ return (*thisenv)->CallIntMethod(thisenv, UpCallsRFFIObject, R_compute_identicalMethodID, x, y, flags);
}
void Rf_copyListMatrix(SEXP s, SEXP t, Rboolean byrow) {
diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Makefile b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Makefile
index 8c9fb1057c..1d14ab2e86 100644
--- a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Makefile
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Makefile
@@ -38,7 +38,7 @@ C_OBJECTS := $(patsubst %.c,$(OBJ)/%.o,$(C_SOURCES))
FFI_INCLUDES = -I$(TOPDIR)/include -I$(TOPDIR)/include/R_ext
#NFI_INCLUDES is set in environment (by mx)
-LOCAL_INCLUDES = -I . -I $(abspath ../include)
+LOCAL_INCLUDES = -I . -I $(abspath ../include) -I $(abspath ../common)
INCLUDES := $(LOCAL_INCLUDES) $(FFI_INCLUDES) $(NFI_INCLUDES)
diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Memory.c b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Memory.c
index a12d66c3cf..e97023c600 100644
--- a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Memory.c
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Memory.c
@@ -71,7 +71,7 @@ void *R_chk_calloc(size_t nelem, size_t elsize) {
#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)"),
+ error("'Calloc' could not allocate memory (%.0f of %u bytes)",
(double) nelem, elsize);
return (p);
}
@@ -81,7 +81,7 @@ void *R_chk_realloc(void *ptr, size_t size) {
/* Protect against broken realloc */
if(ptr) p = realloc(ptr, size); else p = malloc(size);
if(!p)
- error(_("'Realloc' could not re-allocate memory (%.0f bytes)"),
+ error("'Realloc' could not re-allocate memory (%.0f bytes)",
(double) size);
return(p);
}
diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rdynload_fastr.c b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rdynload_fastr.c
index e9adb555cf..4a0ffaaae6 100644
--- a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rdynload_fastr.c
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rdynload_fastr.c
@@ -79,7 +79,7 @@ Rboolean R_forceSymbols(DllInfo *dllInfo, Rboolean value) {
TruffleObject Rdynload_setSymbol(DllInfo *info, int nstOrd, long routinesAddr, int index) {
- char *name;
+ const char *name;
long fun;
int numArgs;
switch (nstOrd) {
@@ -113,7 +113,7 @@ TruffleObject Rdynload_setSymbol(DllInfo *info, int nstOrd, long routinesAddr, i
}
}
//printf("call_setDotSymbolValues %p, %s, %p, %d\n", info, name, fun, numArgs);
- TruffleObject result = call_setDotSymbolValues(info, name, fun, numArgs);
+ TruffleObject result = call_setDotSymbolValues(info, (char *)name, fun, numArgs);
return result;
}
diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rinternals.c b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rinternals.c
index db41b21bcc..b3005b1448 100644
--- a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rinternals.c
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rinternals.c
@@ -23,6 +23,7 @@
#include <Rinterface.h>
#include <rffiutils.h>
#include <rffi_callbacks.h>
+#include <Rinternals_common.h>
void *callbacks[CALLBACK_TABLE_SIZE];
@@ -31,12 +32,6 @@ void Rinternals_addCallback(int index, void *closure) {
callbacks[index] = closure;
}
-static SEXP unimplemented(char *f) {
- printf("unimplemented %s\n", f);
- exit(1);
- return NULL;
-}
-
static int* return_int;
static double* return_double;
static char* return_byte;
@@ -86,7 +81,7 @@ void return_FREE(void *address) {
// R_GlobalEnv et al are not a variables in FASTR as they are RContext specific
SEXP FASTR_R_GlobalEnv() {
- return unimplemented("FASTR_R_GlobalEnv");
+ return ((call_R_GlobalEnv) callbacks[R_GlobalEnv_x])();
}
SEXP FASTR_R_BaseEnv() {
@@ -94,19 +89,19 @@ SEXP FASTR_R_BaseEnv() {
}
SEXP FASTR_R_BaseNamespace() {
- return unimplemented("FASTR_R_BaseNamespace");
+ return ((call_R_BaseNamespace) callbacks[R_BaseNamespace_x])();
}
SEXP FASTR_R_NamespaceRegistry() {
- return unimplemented("FASTR_R_NamespaceRegistry");
+ return ((call_R_NamespaceRegistry) callbacks[R_NamespaceRegistry_x])();
}
CTXT FASTR_GlobalContext() {
- return unimplemented("FASTR_GlobalContext");
+ return ((call_R_GlobalContext) callbacks[R_GlobalContext_x])();
}
Rboolean FASTR_R_Interactive() {
- return (int) unimplemented("FASTR_R_Interactive");
+ return (int) ((call_R_Interactive) callbacks[R_Interactive_x])();
}
SEXP CAR(SEXP e) {
@@ -134,7 +129,7 @@ double *REAL(SEXP x){
Rbyte *RAW(SEXP x) {
((call_RAW) callbacks[RAW_x])(x);
- return return_byte;
+ return (Rbyte *) return_byte;
}
int LENGTH(SEXP x) {
@@ -178,22 +173,10 @@ SEXP Rf_coerceVector(SEXP x, SEXPTYPE mode) {
return ((call_Rf_coerceVector) callbacks[Rf_coerceVector_x])(x, mode);
}
-SEXP Rf_protect(SEXP x) {
- return x;
-}
-
-void Rf_unprotect(int x) {
- // nothing to do
-}
-
SEXP Rf_cons(SEXP car, SEXP cdr) {
return ((call_Rf_cons) callbacks[Rf_cons_x])(car, cdr);
}
-SEXP R_FindNamespace(SEXP info) {
- return ((call_R_FindNamespace) callbacks[R_FindNamespace_x])(info);
-}
-
SEXP Rf_GetOption1(SEXP tag) {
return ((call_Rf_GetOption1) callbacks[Rf_GetOption1_x])(tag);
}
@@ -227,7 +210,8 @@ void Rf_error(const char *format, ...) {
((call_Rf_error) callbacks[Rf_error_x])(buf);
// just transfer back which will cleanup and exit the entire JNI call
// longjmp(*getErrorJmpBuf(), 1);
-
+ // Should not reach here
+ unimplemented("Rf_error");
}
void Rf_errorcall(SEXP x, const char *format, ...) {
@@ -246,7 +230,7 @@ void Rf_warningcall(SEXP x, const char *format, ...) {
void Rf_warning(const char *format, ...) {
char buf[8192];
va_list(ap);
- va_start(ap,format);
+ va_start(ap, format);
Rvsnprintf(buf, BUFSIZE - 1, format, ap);
va_end(ap);
((call_Rf_warning) callbacks[Rf_warning_x])(buf);
@@ -302,11 +286,11 @@ SEXP Rf_allocVector3(SEXPTYPE t, R_xlen_t len, R_allocator_t* allocator) {
unimplemented("RF_allocVector with custom allocator");
return NULL;
}
- return ((call_Rf_allocateVector) callbacks[Rf_allocateVector_x])(t, len);
+ return ((call_Rf_allocVector) callbacks[Rf_allocVector_x])(t, len);
}
SEXP Rf_allocArray(SEXPTYPE t, SEXP dims) {
- unimplemented("Rf_allocArray");
+ return ((call_Rf_allocArray) callbacks[Rf_allocArray_x])(t, dims);
}
SEXP Rf_alloc3DArray(SEXPTYPE t, int x, int y, int z) {
@@ -314,7 +298,7 @@ SEXP Rf_alloc3DArray(SEXPTYPE t, int x, int y, int z) {
}
SEXP Rf_allocMatrix(SEXPTYPE mode, int nrow, int ncol) {
- unimplemented("Rf_allocMatrix");
+ return ((call_Rf_allocMatrix) callbacks[Rf_allocMatrix_x])(mode, nrow, ncol);
}
SEXP Rf_allocList(int x) {
@@ -343,11 +327,11 @@ SEXP Rf_dimnamesgets(SEXP x, SEXP y) {
}
SEXP Rf_eval(SEXP expr, SEXP env) {
- return unimplemented("Rf_eval");
+ return ((call_Rf_eval) callbacks[Rf_eval_x])(expr, env);
}
SEXP Rf_findFun(SEXP symbol, SEXP rho) {
- return unimplemented("Rf_findFun");
+ return ((call_Rf_findFun) callbacks[Rf_findFun_x])(symbol, rho);
}
SEXP Rf_findVar(SEXP sym, SEXP rho) {
@@ -355,11 +339,11 @@ SEXP Rf_findVar(SEXP sym, SEXP rho) {
}
SEXP Rf_findVarInFrame(SEXP rho, SEXP sym) {
- return unimplemented("Rf_findVarInFrame");
+ return ((call_Rf_findVarInFrame) callbacks[Rf_findVarInFrame_x])(rho, sym);
}
SEXP Rf_findVarInFrame3(SEXP rho, SEXP sym, Rboolean b) {
- return unimplemented("Rf_findVarInFrame");
+ return ((call_Rf_findVarInFrame3) callbacks[Rf_findVarInFrame3_x])(rho, sym, b);
}
SEXP Rf_getAttrib(SEXP vec, SEXP name) {
@@ -373,15 +357,15 @@ SEXP Rf_setAttrib(SEXP vec, SEXP name, SEXP val) {
}
SEXP Rf_duplicate(SEXP x) {
- return unimplemented("Rf_duplicate");
+ return ((call_Rf_duplicate) callbacks[Rf_duplicate_x])(x, 1);
}
SEXP Rf_shallow_duplicate(SEXP x) {
- return unimplemented("Rf_shallow_duplicate");
+ return ((call_Rf_duplicate) callbacks[Rf_duplicate_x])(x, 0);
}
R_xlen_t Rf_any_duplicated(SEXP x, Rboolean from_last) {
- return (R_xlen_t) unimplemented("Rf_any_duplicated");
+ return (R_xlen_t) ((call_Rf_any_duplicated) callbacks[Rf_any_duplicated_x])(x, from_last);
}
SEXP Rf_duplicated(SEXP x, Rboolean y) {
@@ -406,31 +390,7 @@ int Rf_countContexts(int x, int y) {
}
Rboolean Rf_inherits(SEXP x, const char * klass) {
- return (Rboolean) unimplemented("Rf_inherits");
-}
-
-Rboolean Rf_isReal(SEXP x) {
- return TYPEOF(x) == REALSXP;
-}
-
-Rboolean Rf_isSymbol(SEXP x) {
- return TYPEOF(x) == SYMSXP;
-}
-
-Rboolean Rf_isComplex(SEXP x) {
- return TYPEOF(x) == CPLXSXP;
-}
-
-Rboolean Rf_isEnvironment(SEXP x) {
- return TYPEOF(x) == ENVSXP;
-}
-
-Rboolean Rf_isExpression(SEXP x) {
- return TYPEOF(x) == EXPRSXP;
-}
-
-Rboolean Rf_isLogical(SEXP x) {
- return TYPEOF(x) == LGLSXP;
+ return (Rboolean) ((call_Rf_inherits) callbacks[Rf_inherits_x])(x, klass);
}
Rboolean Rf_isObject(SEXP s) {
@@ -443,7 +403,7 @@ void Rf_PrintValue(SEXP x) {
}
SEXP Rf_install(const char *name) {
- ((call_Rf_install) callbacks[Rf_install_x])(name);
+ return ((call_Rf_install) callbacks[Rf_install_x])(name);
}
SEXP Rf_installChar(SEXP charsxp) {
@@ -475,13 +435,20 @@ const char *Rf_reEnc(const char *x, cetype_t ce_in, cetype_t ce_out, int subst)
}
int Rf_ncols(SEXP x) {
- return (int) unimplemented("Rf_ncols");
+ return (int) ((call_Rf_ncols) callbacks[Rf_ncols_x])(x);
}
int Rf_nrows(SEXP x) {
- return (int) unimplemented("Rf_nrows");
+ return (int) ((call_Rf_nrows) callbacks[Rf_nrows_x])(x);
+}
+
+
+SEXP Rf_protect(SEXP x) {
+ return x;
}
+void Rf_unprotect(int x) {
+}
void R_ProtectWithIndex(SEXP x, PROTECT_INDEX *y) {
//
@@ -511,7 +478,7 @@ SEXP R_NewHashedEnv(SEXP parent, SEXP size) {
}
SEXP Rf_classgets(SEXP vec, SEXP klass) {
- return unimplemented("Rf_classgets");
+ return ((call_Rf_classgets) callbacks[Rf_classgets_x])(vec, klass);
}
const char *Rf_translateChar(SEXP x) {
@@ -533,7 +500,7 @@ const char *Rf_translateCharUTF8(SEXP x) {
}
SEXP Rf_lengthgets(SEXP x, R_len_t y) {
- return unimplemented("Rf_lengthgets");
+ return ((call_Rf_lengthgets) callbacks[Rf_lengthgets_x])(x, y);
}
SEXP Rf_xlengthgets(SEXP x, R_xlen_t y) {
@@ -545,68 +512,19 @@ SEXP R_lsInternal(SEXP env, Rboolean all) {
}
SEXP R_lsInternal3(SEXP env, Rboolean all, Rboolean sorted) {
- return unimplemented("R_lsInternal3");
+ return ((call_R_lsInternal3) callbacks[R_lsInternal3_x])(env, all, sorted);
}
SEXP Rf_namesgets(SEXP x, SEXP y) {
return unimplemented("Rf_namesgets");
}
-SEXP GetOption(SEXP tag, SEXP rho) {
- return GetOption1(tag);
-}
-
-int GetOptionCutoff(void) {
- int w;
- w = asInteger(GetOption1(install("deparse.cutoff")));
- if (w == NA_INTEGER || w <= 0) {
- warning(_("invalid 'deparse.cutoff', used 60"));
- w = 60;
- }
- return w;
-}
-
-#define R_MIN_WIDTH_OPT 10
-#define R_MAX_WIDTH_OPT 10000
-#define R_MIN_DIGITS_OPT 0
-#define R_MAX_DIGITS_OPT 22
-
-int GetOptionWidth(void) {
- int w;
- w = asInteger(GetOption1(install("width")));
- if (w < R_MIN_WIDTH_OPT || w > R_MAX_WIDTH_OPT) {
- warning(_("invalid printing width, used 80"));
- return 80;
- }
- return w;
-}
-
-int GetOptionDigits(void) {
- int d;
- d = asInteger(GetOption1(install("digits")));
- if (d < R_MIN_DIGITS_OPT || d > R_MAX_DIGITS_OPT) {
- warning(_("invalid printing digits, used 7"));
- return 7;
- }
- return d;
-}
-
-Rboolean Rf_GetOptionDeviceAsk(void) {
- int ask;
- ask = asLogical(GetOption1(install("device.ask.default")));
- if(ask == NA_LOGICAL) {
- warning(_("invalid value for \"device.ask.default\", using FALSE"));
- return FALSE;
- }
- return ask != 0;
-}
-
SEXP TAG(SEXP e) {
return ((call_TAG) callbacks[TAG_x])(e);
}
SEXP PRINTNAME(SEXP e) {
- return unimplemented("PRINTNAME");
+ return ((call_PRINTNAME) callbacks[PRINTNAME_x])(e);
}
@@ -634,7 +552,7 @@ SEXP CDDDR(SEXP e) {
}
SEXP CADDR(SEXP e) {
- return unimplemented("CADDR");
+ return ((call_CADDR) callbacks[CADDR_x])(e);
}
SEXP CADDDR(SEXP e) {
@@ -669,7 +587,7 @@ SEXP SETCDR(SEXP x, SEXP y) {
}
SEXP SETCADR(SEXP x, SEXP y) {
- return unimplemented("SETCADR");
+ return ((call_SETCADR) callbacks[SETCADR_x])(x, y);
}
SEXP SETCADDR(SEXP x, SEXP y) {
@@ -700,11 +618,11 @@ SEXP CLOENV(SEXP x) {
}
int RDEBUG(SEXP x) {
- unimplemented("RDEBUG");
+ return ((call_RDEBUG) callbacks[RDEBUG_x])(x);
}
int RSTEP(SEXP x) {
- unimplemented("RSTEP");
+ return ((call_RSTEP) callbacks[RSTEP_x])(x);
}
int RTRACE(SEXP x) {
@@ -713,11 +631,11 @@ int RTRACE(SEXP x) {
}
void SET_RDEBUG(SEXP x, int v) {
- unimplemented("SET_RDEBUG");
+ ((call_SET_RDEBUG) callbacks[SET_RDEBUG_x])(x, v);
}
void SET_RSTEP(SEXP x, int v) {
- unimplemented("SET_RSTEP");
+ ((call_SET_RSTEP) callbacks[SET_RSTEP_x])(x, v);
}
void SET_RTRACE(SEXP x, int v) {
@@ -737,7 +655,7 @@ void SET_CLOENV(SEXP x, SEXP v) {
}
SEXP SYMVALUE(SEXP x) {
- return unimplemented("SYMVALUE");
+ return ((call_SYMVALUE) callbacks[SYMVALUE_x])(x);
}
SEXP INTERNAL(SEXP x) {
@@ -754,7 +672,7 @@ void SET_DDVAL(SEXP x, int v) {
}
void SET_SYMVALUE(SEXP x, SEXP v) {
- unimplemented("SET_SYMVALUE");
+ ((call_SET_SYMVALUE) callbacks[SET_SYMVALUE_x])(x, v);
}
void SET_INTERNAL(SEXP x, SEXP v) {
@@ -766,7 +684,7 @@ SEXP FRAME(SEXP x) {
}
SEXP ENCLOS(SEXP x) {
- return unimplemented("ENCLOS");
+ return ((call_ENCLOS) callbacks[ENCLOS_x])(x);
}
SEXP HASHTAB(SEXP x) {
@@ -795,19 +713,19 @@ void SET_HASHTAB(SEXP x, SEXP v) {
}
SEXP PRCODE(SEXP x) {
- return unimplemented("PRCODE");
+ return ((call_PRCODE) callbacks[PRCODE_x])(x);
}
SEXP PRENV(SEXP x) {
- return unimplemented("PRENV");
+ return ((call_PRENV) callbacks[PRENV_x])(x);
}
SEXP PRVALUE(SEXP x) {
- return unimplemented("PRVALUE");
+ return ((call_PRVALUE) callbacks[PRVALUE_x])(x);
}
int PRSEEN(SEXP x) {
- return (int) unimplemented("PRSEEN");
+ return ((call_PRSEEN) callbacks[PRSEEN_x])(x);
}
void SET_PRSEEN(SEXP x, int v) {
@@ -900,9 +818,8 @@ SEXP *STRING_PTR(SEXP x){
}
-SEXP *VECTOR_PTR(SEXP x){
+SEXP * NORET VECTOR_PTR(SEXP x){
unimplemented("VECTOR_PTR");
- return NULL;
}
SEXP Rf_asChar(SEXP x){
@@ -949,7 +866,7 @@ SEXP ATTRIB(SEXP x){
}
int OBJECT(SEXP x){
- return (int) unimplemented("OBJECT");
+ return (int) ((call_OBJECT) callbacks[OBJECT_x])(x);
}
int MARK(SEXP x){
@@ -958,7 +875,7 @@ int MARK(SEXP x){
}
int NAMED(SEXP x){
- return (int) unimplemented("NAMED");
+ return (int) ((call_NAMED) callbacks[NAMED_x])(x);
}
int REFCNT(SEXP x){
@@ -975,6 +892,7 @@ void SET_TYPEOF(SEXP x, int v){
}
SEXP SET_TYPEOF_FASTR(SEXP x, int v){
+ return ((call_SET_TYPEOF_FASTR) callbacks[SET_TYPEOF_FASTR_x])(x, v);
}
void SET_NAMED(SEXP x, int v){
@@ -986,36 +904,7 @@ void SET_ATTRIB(SEXP x, SEXP v){
}
void DUPLICATE_ATTRIB(SEXP to, SEXP from){
- unimplemented("DUPLICATE_ATTRIB");
-}
-
-char *dgettext(const char *domainname, const char *msgid) {
- printf("dgettext: '%s'\n", msgid);
- return (char*) msgid;
-}
-
-char *libintl_dgettext(const char *domainname, const char *msgid) {
- return dgettext(domainname, msgid);
-}
-
-char *dngettext(const char *domainname, const char *msgid, const char * msgid_plural, unsigned long int n) {
- printf("dngettext: singular - '%s' ; plural - '%s'\n", msgid, msgid_plural);
- return (char*) (n == 1 ? msgid : msgid_plural);
-}
-
-void *DATAPTR(SEXP x) {
- int type = TYPEOF(x);
- if (type == INTSXP) {
- return INTEGER(x);
- } else if (type == REALSXP) {
- return REAL(x);
- } else if (type == LGLSXP) {
- return LOGICAL(x);
- } else {
- printf("DATAPTR %d\n", type);
- unimplemented("R_DATAPTR");
- return NULL;
- }
+ ((call_DUPLICATE_ATTRIB) callbacks[DUPLICATE_ATTRIB_x])(to, from);
}
void R_qsort_I (double *v, int *II, int i, int j) {
@@ -1031,14 +920,15 @@ R_len_t R_BadLongVector(SEXP x, const char *y, int z) {
}
int IS_S4_OBJECT(SEXP x) {
- return (int) unimplemented("IS_S4_OBJECT");
+ return (int) ((call_IS_S4_OBJECT) callbacks[IS_S4_OBJECT_x])(x);
}
void SET_S4_OBJECT(SEXP x) {
- unimplemented("SET_S4_OBJECT");
+ ((call_SET_S4_OBJECT) callbacks[SET_S4_OBJECT_x])(x);
}
+
void UNSET_S4_OBJECT(SEXP x) {
- unimplemented("UNSET_S4_OBJECT");
+ ((call_UNSET_S4_OBJECT) callbacks[UNSET_S4_OBJECT_x])(x);
}
Rboolean R_ToplevelExec(void (*fun)(void *), void *data) {
@@ -1071,6 +961,10 @@ Rboolean R_IsNamespaceEnv(SEXP rho) {
return (Rboolean) unimplemented("R_IsNamespaceEnv");
}
+SEXP R_FindNamespace(SEXP info) {
+ return ((call_R_FindNamespace) callbacks[R_FindNamespace_x])(info);
+}
+
SEXP R_NamespaceEnvSpec(SEXP rho) {
return unimplemented("R_NamespaceEnvSpec");
}
@@ -1096,11 +990,11 @@ void R_MakeActiveBinding(SEXP sym, SEXP fun, SEXP env) {
}
Rboolean R_BindingIsLocked(SEXP sym, SEXP env) {
- return (Rboolean) unimplemented("R_BindingIsLocked");
+ return (Rboolean) ((call_R_BindingIsLocked) callbacks[R_BindingIsLocked_x])(sym, env);
}
Rboolean R_BindingIsActive(SEXP sym, SEXP env) {
- // TODO: for now, I belive all bindings are false
+ // TODO: for now, I believe all bindings are false
return (Rboolean)0;
}
@@ -1117,6 +1011,7 @@ SEXP Rf_asS4(SEXP x, Rboolean b, int i) {
}
static SEXP R_tryEvalInternal(SEXP x, SEXP y, int *ErrorOccurred, int silent) {
+ unimplemented("R_tryEvalInternal");
}
SEXP R_tryEval(SEXP x, SEXP y, int *ErrorOccurred) {
@@ -1138,7 +1033,7 @@ double R_strtod(const char *c, char **end) {
}
SEXP R_PromiseExpr(SEXP x) {
- return unimplemented("R_PromiseExpr");
+ return ((call_R_PromiseExpr) callbacks[R_PromiseExpr_x])(x);
}
SEXP R_ClosureExpr(SEXP x) {
@@ -1150,31 +1045,31 @@ SEXP R_forceAndCall(SEXP e, int n, SEXP rho) {
}
SEXP R_MakeExternalPtr(void *p, SEXP tag, SEXP prot) {
- return unimplemented("R_MakeExternalPtr");
+ return ((call_R_MakeExternalPtr) callbacks[R_MakeExternalPtr_x])(p, tag, prot);
}
void *R_ExternalPtrAddr(SEXP s) {
- return unimplemented("R_ExternalPtrAddr");
+ return ((call_R_ExternalPtrAddr) callbacks[R_ExternalPtrAddr_x])(s);
}
SEXP R_ExternalPtrTag(SEXP s) {
- return unimplemented("R_ExternalPtrTag");
+ return ((call_R_ExternalPtrTag) callbacks[R_ExternalPtrTag_x])(s);
}
-SEXP R_ExternalPtrProt(SEXP s) {
- return unimplemented("R_ExternalPtrProt");
+SEXP R_ExternalPtrProtected(SEXP s) {
+ return ((call_R_ExternalPtrProtected) callbacks[R_ExternalPtrProtected_x])(s);
}
void R_SetExternalPtrAddr(SEXP s, void *p) {
- unimplemented("R_SetExternalPtrAddr");
+ ((call_R_SetExternalPtrProtected) callbacks[R_SetExternalPtrProtected_x])(s, p);
}
void R_SetExternalPtrTag(SEXP s, SEXP tag) {
- unimplemented("R_SetExternalPtrTag");
+ ((call_R_SetExternalPtrProtected) callbacks[R_SetExternalPtrProtected_x])(s, tag);
}
void R_SetExternalPtrProtected(SEXP s, SEXP p) {
- unimplemented("R_SetExternalPtrProtected");
+ ((call_R_SetExternalPtrProtected) callbacks[R_SetExternalPtrProtected_x])(s, p);
}
void R_ClearExternalPtr(SEXP s) {
@@ -1222,11 +1117,11 @@ void R_RunWeakRefFinalizer(SEXP w) {
}
SEXP R_do_slot(SEXP obj, SEXP name) {
- return unimplemented("R_do_slot");
+ return ((call_R_do_slot) callbacks[R_do_slot_x])(obj, name);
}
SEXP R_do_slot_assign(SEXP obj, SEXP name, SEXP value) {
- return unimplemented("R_do_slot_assign");
+ return ((call_R_do_slot_assign) callbacks[R_do_slot_assign_x])(obj, name, value);
}
int R_has_slot(SEXP obj, SEXP name) {
@@ -1234,7 +1129,7 @@ int R_has_slot(SEXP obj, SEXP name) {
}
SEXP R_do_MAKE_CLASS(const char *what) {
- return unimplemented("R_do_MAKE_CLASS");
+ return ((call_R_do_MAKE_CLASS) callbacks[R_do_MAKE_CLASS_x])(what);
}
SEXP R_getClassDef (const char *what) {
@@ -1242,15 +1137,15 @@ SEXP R_getClassDef (const char *what) {
}
SEXP R_do_new_object(SEXP class_def) {
- return unimplemented("R_do_new_object");
+ return ((call_R_do_new_object) callbacks[R_do_new_object_x])(class_def);
}
-int R_check_class_and_super(SEXP x, const char **valid, SEXP rho) {
- return (int) unimplemented("R_check_class_and_super");
+static SEXP nfiGetMethodsNamespace() {
+ return ((call_R_MethodsNamespace) callbacks[R_MethodsNamespace_x])();
}
int R_check_class_etc (SEXP x, const char **valid) {
- return (int) unimplemented("R_check_class_etc");
+ return R_check_class_etc_helper(x, valid, nfiGetMethodsNamespace);
}
SEXP R_PreserveObject(SEXP x) {
@@ -1267,14 +1162,14 @@ void R_dot_Last(void) {
Rboolean R_compute_identical(SEXP x, SEXP y, int flags) {
- return (Rboolean) unimplemented("R_compute_identical");
+ return (Rboolean) ((call_R_compute_identical) callbacks[R_compute_identical_x])(x, y, flags);
}
void Rf_copyListMatrix(SEXP s, SEXP t, Rboolean byrow) {
- unimplemented("Rf_copyListMatrix");
+ ((call_Rf_copyListMatrix) callbacks[Rf_copyListMatrix_x])(s, t, byrow);
}
void Rf_copyMatrix(SEXP s, SEXP t, Rboolean byrow) {
- unimplemented("Rf_copyMatrix");
+ ((call_Rf_copyMatrix) callbacks[Rf_copyMatrix_x])(s, t, byrow);
}
diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/base_rffi.c b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/base_rffi.c
index 2073ad00fe..93188c9e9e 100644
--- a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/base_rffi.c
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/base_rffi.c
@@ -51,7 +51,7 @@ void call_glob(char *pattern, void *closure) {
}
}
-void call_readlink(void (*call_setresult)(char *link, int errno), char *path) {
+void call_readlink(void (*call_setresult)(char *link, int cerrno), char *path) {
char *link = NULL;
int cerrno = 0;
char buf[4096];
@@ -65,7 +65,7 @@ void call_readlink(void (*call_setresult)(char *link, int errno), char *path) {
call_setresult(link, cerrno);
}
-void call_strtol(void (*call_setresult)(long result, int errno), char *s, int base) {
+void call_strtol(void (*call_setresult)(long result, int cerrno), char *s, int base) {
long rc = strtol(s, NULL, base);
call_setresult(rc, errno);
}
diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/rffi_callbacks.h b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/rffi_callbacks.h
index a03e58c1c2..94d50549cc 100644
--- a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/rffi_callbacks.h
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/rffi_callbacks.h
@@ -33,7 +33,7 @@ typedef SEXP (*call_Rf_ScalarInteger)(int value);
typedef SEXP (*call_Rf_ScalarReal)(double value);
typedef SEXP (*call_Rf_ScalarString)(SEXP value);
typedef SEXP (*call_Rf_ScalarLogical)(int value);
-typedef SEXP (*call_Rf_allocateVector)(SEXPTYPE t, R_xlen_t len);
+typedef SEXP (*call_Rf_allocVector)(SEXPTYPE t, R_xlen_t len);
typedef SEXP (*call_Rf_allocArray)(SEXPTYPE t, SEXP dims);
typedef SEXP (*call_Rf_alloc3DArray)(SEXPTYPE t, int x, int y, int z);
typedef SEXP (*call_Rf_allocMatrix)(SEXPTYPE mode, int nrow, int ncol);
@@ -52,7 +52,7 @@ typedef SEXP (*call_Rf_findVarInFrame3)(SEXP rho, SEXP sym, Rboolean b);
typedef SEXP (*call_Rf_getAttrib)(SEXP vec, SEXP name);
typedef SEXP (*call_Rf_GetOption1)(SEXP tag);
typedef SEXP (*call_Rf_setAttrib)(SEXP vec, SEXP name, SEXP val);
-typedef SEXP (*call_Rf_duplicate)(SEXP x);
+typedef SEXP (*call_Rf_duplicate)(SEXP x, int v);
typedef SEXP (*call_Rf_shallow_duplicate)(SEXP x);
typedef SEXP (*call_Rf_coerceVector)(SEXP x, SEXPTYPE mode);
typedef R_xlen_t (*call_Rf_any_duplicated)(SEXP x, Rboolean from_last);
@@ -234,7 +234,7 @@ typedef SEXP (*call_R_forceAndCall)(SEXP e, int n, SEXP rho);
typedef SEXP (*call_R_MakeExternalPtr)(void *p, SEXP tag, SEXP prot);
typedef void *(*call_R_ExternalPtrAddr)(SEXP s);
typedef SEXP (*call_R_ExternalPtrTag)(SEXP s);
-typedef SEXP (*call_R_ExternalPtrProt)(SEXP s);
+typedef SEXP (*call_R_ExternalPtrProtected)(SEXP s);
typedef void (*call_R_SetExternalPtrAddr)(SEXP s, void *p);
typedef void (*call_R_SetExternalPtrTag)(SEXP s, SEXP tag);
typedef void (*call_R_SetExternalPtrProtected)(SEXP s, SEXP p);
@@ -267,6 +267,7 @@ typedef void (*call_GetRNGstate)();
typedef void (*call_PutRNGstate)();
typedef SEXP (*call_R_BaseEnv)();
typedef SEXP (*call_R_BaseNamespace)();
+typedef SEXP (*call_R_MethodsNamespace)();
typedef SEXP (*call_R_GlobalEnv)();
typedef SEXP (*call_R_NamespaceRegistry)();
typedef SEXP (*call_R_Interactive)();
diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/rffi_callbacksindex.h b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/rffi_callbacksindex.h
index 3fcb214834..0a457d98f0 100644
--- a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/rffi_callbacksindex.h
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/rffi_callbacksindex.h
@@ -36,125 +36,128 @@
#define GetRNGstate_x 7
#define INTEGER_x 8
#define IS_S4_OBJECT_x 9
-#define LENGTH_x 10
-#define LOGICAL_x 11
-#define NAMED_x 12
-#define OBJECT_x 13
-#define PRCODE_x 14
-#define PRENV_x 15
-#define PRINTNAME_x 16
-#define PRSEEN_x 17
-#define PRVALUE_x 18
-#define PutRNGstate_x 19
-#define RAW_x 20
-#define RDEBUG_x 21
-#define REAL_x 22
-#define RSTEP_x 23
-#define R_BaseEnv_x 24
-#define R_BaseNamespace_x 25
-#define R_BindingIsLocked_x 26
-#define R_CHAR_x 27
-#define R_CleanUp_x 28
-#define R_ExternalPtrAddr_x 29
-#define R_ExternalPtrProt_x 30
-#define R_ExternalPtrTag_x 31
-#define R_FindNamespace_x 32
-#define R_GetConnection_x 33
-#define R_GlobalContext_x 34
-#define R_GlobalEnv_x 35
-#define R_HomeDir_x 36
-#define R_Interactive_x 37
-#define R_MakeExternalPtr_x 38
-#define R_NamespaceRegistry_x 39
-#define R_NewHashedEnv_x 40
-#define R_ParseVector_x 41
-#define R_PromiseExpr_x 42
-#define R_ReadConnection_x 43
-#define R_SetExternalPtrAddr_x 44
-#define R_SetExternalPtrProt_x 45
-#define R_SetExternalPtrTag_x 46
-#define R_ToplevelExec_x 47
-#define R_WriteConnection_x 48
-#define R_computeIdentical_x 49
-#define R_do_MAKE_CLASS_x 50
-#define R_do_new_object_x 51
-#define R_do_slot_x 52
-#define R_do_slot_assign_x 53
-#define R_getContextCall_x 54
-#define R_getContextEnv_x 55
-#define R_getContextFun_x 56
-#define R_getContextSrcRef_x 57
-#define R_getGlobalFunctionContext_x 58
-#define R_getParentFunctionContext_x 59
-#define R_insideBrowser_x 60
-#define R_isEqual_x 61
-#define R_isGlobal_x 62
-#define R_lsInternal3_x 63
-#define R_new_custom_connection_x 64
-#define R_tryEval_x 65
-#define Rf_GetOption1_x 66
-#define Rf_PairToVectorList_x 67
-#define Rf_ScalarDouble_x 68
-#define Rf_ScalarInteger_x 69
-#define Rf_ScalarLogical_x 70
-#define Rf_ScalarString_x 71
-#define Rf_allocateArray_x 72
-#define Rf_allocateMatrix_x 73
-#define Rf_allocateVector_x 74
-#define Rf_anyDuplicated_x 75
-#define Rf_asChar_x 76
-#define Rf_asInteger_x 77
-#define Rf_asLogical_x 78
-#define Rf_asReal_x 79
-#define Rf_classgets_x 80
-#define Rf_coerceVector_x 81
-#define Rf_cons_x 82
-#define Rf_copyListMatrix_x 83
-#define Rf_copyMatrix_x 84
-#define Rf_defineVar_x 85
-#define Rf_duplicate_x 86
-#define Rf_error_x 87
-#define Rf_eval_x 88
-#define Rf_findVar_x 89
-#define Rf_findVarInFrame_x 90
-#define Rf_findVarInFrame3_x 91
-#define Rf_findfun_x 92
-#define Rf_getAttrib_x 93
-#define Rf_gsetVar_x 94
-#define Rf_inherits_x 95
-#define Rf_install_x 96
-#define Rf_installChar_x 97
-#define Rf_isNull_x 98
-#define Rf_isString_x 99
-#define Rf_lengthgets_x 100
-#define Rf_mkCharLenCE_x 101
-#define Rf_ncols_x 102
-#define Rf_nrows_x 103
-#define Rf_setAttrib_x 104
-#define Rf_warning_x 105
-#define Rf_warningcall_x 106
-#define Rprintf_x 107
-#define SETCADR_x 108
-#define SETCAR_x 109
-#define SETCDR_x 110
-#define SET_RDEBUG_x 111
-#define SET_RSTEP_x 112
-#define SET_STRING_ELT_x 113
-#define SET_SYMVALUE_x 114
-#define SET_TAG_x 115
-#define SET_TYPEOF_FASTR_x 116
-#define SET_VECTOR_ELT_x 117
-#define STRING_ELT_x 118
-#define SYMVALUE_x 119
-#define TAG_x 120
-#define TYPEOF_x 121
-#define VECTOR_ELT_x 122
-#define getConnectionClassString_x 123
-#define getOpenModeString_x 124
-#define getSummaryDescription_x 125
-#define isSeekable_x 126
-#define unif_rand_x 127
+#define SET_S4_OBJECT_x 10
+#define UNSET_S4_OBJECT_x 11
+#define LENGTH_x 12
+#define LOGICAL_x 13
+#define NAMED_x 14
+#define OBJECT_x 15
+#define PRCODE_x 16
+#define PRENV_x 17
+#define PRINTNAME_x 18
+#define PRSEEN_x 19
+#define PRVALUE_x 20
+#define PutRNGstate_x 21
+#define RAW_x 22
+#define RDEBUG_x 23
+#define REAL_x 24
+#define RSTEP_x 25
+#define R_BaseEnv_x 26
+#define R_BaseNamespace_x 27
+#define R_BindingIsLocked_x 28
+#define R_CHAR_x 29
+#define R_CleanUp_x 30
+#define R_ExternalPtrAddr_x 31
+#define R_ExternalPtrProtected_x 32
+#define R_ExternalPtrTag_x 33
+#define R_FindNamespace_x 34
+#define R_GetConnection_x 35
+#define R_GlobalContext_x 36
+#define R_GlobalEnv_x 37
+#define R_HomeDir_x 38
+#define R_Interactive_x 39
+#define R_MakeExternalPtr_x 40
+#define R_MethodsNamespace_x 41
+#define R_NamespaceRegistry_x 42
+#define R_NewHashedEnv_x 43
+#define R_ParseVector_x 44
+#define R_PromiseExpr_x 45
+#define R_ReadConnection_x 46
+#define R_SetExternalPtrAddr_x 47
+#define R_SetExternalPtrProtected_x 48
+#define R_SetExternalPtrTag_x 49
+#define R_ToplevelExec_x 50
+#define R_WriteConnection_x 51
+#define R_compute_identical_x 52
+#define R_do_MAKE_CLASS_x 53
+#define R_do_new_object_x 54
+#define R_do_slot_x 55
+#define R_do_slot_assign_x 56
+#define R_getContextCall_x 57
+#define R_getContextEnv_x 58
+#define R_getContextFun_x 59
+#define R_getContextSrcRef_x 60
+#define R_getGlobalFunctionContext_x 61
+#define R_getParentFunctionContext_x 62
+#define R_insideBrowser_x 63
+#define R_isEqual_x 64
+#define R_isGlobal_x 65
+#define R_lsInternal3_x 66
+#define R_new_custom_connection_x 67
+#define R_tryEval_x 68
+#define Rf_GetOption1_x 69
+#define Rf_PairToVectorList_x 70
+#define Rf_ScalarDouble_x 71
+#define Rf_ScalarInteger_x 72
+#define Rf_ScalarLogical_x 73
+#define Rf_ScalarString_x 74
+#define Rf_allocArray_x 75
+#define Rf_allocMatrix_x 76
+#define Rf_allocVector_x 77
+#define Rf_any_duplicated_x 78
+#define Rf_asChar_x 79
+#define Rf_asInteger_x 80
+#define Rf_asLogical_x 81
+#define Rf_asReal_x 82
+#define Rf_classgets_x 83
+#define Rf_coerceVector_x 84
+#define Rf_cons_x 85
+#define Rf_copyListMatrix_x 86
+#define Rf_copyMatrix_x 87
+#define Rf_defineVar_x 88
+#define Rf_duplicate_x 89
+#define Rf_error_x 90
+#define Rf_eval_x 91
+#define Rf_findVar_x 92
+#define Rf_findVarInFrame_x 93
+#define Rf_findVarInFrame3_x 94
+#define Rf_findFun_x 95
+#define Rf_getAttrib_x 96
+#define Rf_gsetVar_x 97
+#define Rf_inherits_x 98
+#define Rf_install_x 99
+#define Rf_installChar_x 100
+#define Rf_isNull_x 101
+#define Rf_isString_x 102
+#define Rf_lengthgets_x 103
+#define Rf_mkCharLenCE_x 104
+#define Rf_ncols_x 105
+#define Rf_nrows_x 106
+#define Rf_setAttrib_x 107
+#define Rf_warning_x 108
+#define Rf_warningcall_x 109
+#define Rprintf_x 110
+#define SETCADR_x 111
+#define SETCAR_x 112
+#define SETCDR_x 113
+#define SET_RDEBUG_x 114
+#define SET_RSTEP_x 115
+#define SET_STRING_ELT_x 116
+#define SET_SYMVALUE_x 117
+#define SET_TAG_x 118
+#define SET_TYPEOF_FASTR_x 119
+#define SET_VECTOR_ELT_x 120
+#define STRING_ELT_x 121
+#define SYMVALUE_x 122
+#define TAG_x 123
+#define TYPEOF_x 124
+#define VECTOR_ELT_x 125
+#define getConnectionClassString_x 126
+#define getOpenModeString_x 127
+#define getSummaryDescription_x 128
+#define isSeekable_x 129
+#define unif_rand_x 130
-#define CALLBACK_TABLE_SIZE 128
+#define CALLBACK_TABLE_SIZE 131
#endif // CALLBACKSINDEX_H
diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/rffiutils.c b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/rffiutils.c
new file mode 100644
index 0000000000..26a0c8bd18
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/rffiutils.c
@@ -0,0 +1,29 @@
+/*
+ * Copyright (c) 2015, 2017, Oracle and/or its affiliates. All rights reserved.
+ * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
+ *
+ * This code is free software; you can redistribute it and/or modify it
+ * 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* unimplemented(char *f) {
+ printf("unimplemented %s\n", f);
+ exit(1);
+}
+
diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/rffiutils.h b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/rffiutils.h
index 4068091952..9a6c701305 100644
--- a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/rffiutils.h
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/rffiutils.h
@@ -32,4 +32,9 @@
extern void init_memory();
+// use for an unimplemented API function
+void *unimplemented(char *msg) __attribute__((noreturn));
+// use for any fatal error
+void fatalError(char *msg) __attribute__((noreturn));
+
#endif
diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/variables.c b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/variables.c
index acd535c135..a16e5c6a92 100644
--- a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/variables.c
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/variables.c
@@ -20,19 +20,24 @@
* or visit www.oracle.com if you need additional information or have any
* questions.
*/
-#include <Rinternals.h>
+#include <string.h>
+#include <Rinterface.h>
#include <trufflenfi.h>
+#include <rffiutils.h>
+// Indices into RFFIVariables enum
+// The commented out entries are not used as they are remapped
+// as functions and the name clashes with the callback index for that
#define R_Home_x 0
#define R_TempDir_x 1
#define R_NilValue_x 2
#define R_UnboundValue_x 3
#define R_MissingArg_x 4
-#define R_GlobalEnv_x 5
+//#define R_GlobalEnv_x 5
#define R_EmptyEnv_x 6
-#define R_BaseEnv_x 7
-#define R_BaseNamespace_x 8
-#define R_NamespaceRegistry_x 9
+//#define R_BaseEnv_x 7
+//#define R_BaseNamespace_x 8
+//#define R_NamespaceRegistry_x 9
#define R_Srcref_x 10
#define R_Bracket2Symbol_x 11
#define R_BracketSymbol_x 12
diff --git a/com.oracle.truffle.r.native/version.source b/com.oracle.truffle.r.native/version.source
index aabe6ec390..2bd5a0a98a 100644
--- a/com.oracle.truffle.r.native/version.source
+++ b/com.oracle.truffle.r.native/version.source
@@ -1 +1 @@
-21
+22
diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/JavaUpCallsRFFIImpl.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/JavaUpCallsRFFIImpl.java
index a980e216b3..a6e270047d 100644
--- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/JavaUpCallsRFFIImpl.java
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/JavaUpCallsRFFIImpl.java
@@ -371,7 +371,7 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI {
}
@Override
- public Object Rf_allocateVector(int mode, int n) {
+ public Object Rf_allocVector(int mode, int n) {
SEXPTYPE type = SEXPTYPE.mapInt(mode);
if (n < 0) {
throw RError.error(RError.SHOW_CALLER2, RError.Message.NEGATIVE_LENGTH_VECTORS_NOT_ALLOWED);
@@ -403,7 +403,7 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI {
}
@Override
- public Object Rf_allocateArray(int mode, Object dimsObj) {
+ public Object Rf_allocArray(int mode, Object dimsObj) {
RIntVector dims = (RIntVector) dimsObj;
int n = 1;
int[] newDims = new int[dims.getLength()];
@@ -412,7 +412,7 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI {
newDims[i] = dims.getDataAt(i);
n *= newDims[i];
}
- RAbstractVector result = (RAbstractVector) Rf_allocateVector(mode, n);
+ RAbstractVector result = (RAbstractVector) Rf_allocVector(mode, n);
setDims(newDims, result);
return result;
@@ -424,7 +424,7 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI {
}
@Override
- public Object Rf_allocateMatrix(int mode, int nrow, int ncol) {
+ public Object Rf_allocMatrix(int mode, int nrow, int ncol) {
SEXPTYPE type = SEXPTYPE.mapInt(mode);
if (nrow < 0 || ncol < 0) {
throw RError.error(RError.SHOW_CALLER2, RError.Message.NEGATIVE_EXTENTS_TO_MATRIX);
@@ -601,7 +601,7 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI {
}
@Override
- public int Rf_anyDuplicated(Object x, int fromLast) {
+ public int Rf_any_duplicated(Object x, int fromLast) {
RAbstractVector vec = (RAbstractVector) x;
if (vec.getLength() == 0) {
return 0;
@@ -747,7 +747,7 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI {
}
@Override
- public Object Rf_findfun(Object symbolObj, Object envObj) {
+ public Object Rf_findFun(Object symbolObj, Object envObj) {
guarantee(envObj instanceof REnvironment);
REnvironment env = (REnvironment) envObj;
guarantee(symbolObj instanceof RSymbol);
@@ -792,7 +792,7 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI {
}
@Override
- public int R_computeIdentical(Object x, Object y, int flags) {
+ public int R_compute_identical(Object x, Object y, int flags) {
RFunction indenticalBuiltin = RContext.lookupBuiltin("identical");
Object res = RContext.getEngine().evalFunction(indenticalBuiltin, null, null, null, x, y, RRuntime.asLogical((!((flags & 1) == 0))),
RRuntime.asLogical((!((flags & 2) == 0))), RRuntime.asLogical((!((flags & 4) == 0))), RRuntime.asLogical((!((flags & 8) == 0))), RRuntime.asLogical((!((flags & 16) == 0))));
@@ -1279,7 +1279,7 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI {
}
@Override
- public Object R_ExternalPtrProt(Object x) {
+ public Object R_ExternalPtrProtected(Object x) {
RExternalPtr p = guaranteeInstanceOf(x, RExternalPtr.class);
return p.getProt();
}
@@ -1297,7 +1297,7 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI {
}
@Override
- public void R_SetExternalPtrProt(Object x, Object prot) {
+ public void R_SetExternalPtrProtected(Object x, Object prot) {
RExternalPtr p = guaranteeInstanceOf(x, RExternalPtr.class);
p.setProt(prot);
}
diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/RFFIUpCallMethod.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/RFFIUpCallMethod.java
index 1b38154133..218f407e58 100644
--- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/RFFIUpCallMethod.java
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/RFFIUpCallMethod.java
@@ -40,6 +40,8 @@ public enum RFFIUpCallMethod {
GetRNGstate("() : void"),
INTEGER("(object) : object"),
IS_S4_OBJECT("(object) : sint32"),
+ SET_S4_OBJECT("(object) : void"),
+ UNSET_S4_OBJECT("(object) : void"),
LENGTH("(object) : sint32"),
LOGICAL("(object) : object"),
NAMED("(object) : sint32"),
@@ -60,7 +62,7 @@ public enum RFFIUpCallMethod {
R_CHAR("(object) : object"),
R_CleanUp("(sint32, sint32, sint32) : void"),
R_ExternalPtrAddr("(object) : object"),
- R_ExternalPtrProt("(object) : object"),
+ R_ExternalPtrProtected("(object) : object"),
R_ExternalPtrTag("(object) : object"),
R_FindNamespace("(object) : object"),
R_GetConnection("(sint32) : object"),
@@ -69,17 +71,18 @@ public enum RFFIUpCallMethod {
R_HomeDir("() : object"),
R_Interactive("() : sint32"),
R_MakeExternalPtr("(object, object, object) : object"),
+ R_MethodsNamespace("() : object"),
R_NamespaceRegistry("() : object"),
R_NewHashedEnv("(object, object) : object"),
R_ParseVector("(object, sint32, object) : object"),
R_PromiseExpr("(object) : object"),
R_ReadConnection("(sint32, object) : sint32"),
R_SetExternalPtrAddr("(object, object) : void"),
- R_SetExternalPtrProt("(object, object) : void"),
+ R_SetExternalPtrProtected("(object, object) : void"),
R_SetExternalPtrTag("(object, object) : void"),
R_ToplevelExec("() : object"),
R_WriteConnection("(sint32, object) : sint32"),
- R_computeIdentical("(object, object, sint32) : sint32"),
+ R_compute_identical("(object, object, sint32) : sint32"),
R_do_MAKE_CLASS("(string) : object"),
R_do_new_object("(object) : object"),
R_do_slot("(object, object) : object"),
@@ -102,10 +105,10 @@ public enum RFFIUpCallMethod {
Rf_ScalarInteger("(sint32) : object"),
Rf_ScalarLogical("(sint32) : object"),
Rf_ScalarString("(object) : object"),
- Rf_allocateArray("(sint32, object) : object"),
- Rf_allocateMatrix("(sint32, sint32, sint32) : object"),
- Rf_allocateVector("(sint32, sint32) : object"),
- Rf_anyDuplicated("(object, sint32) : sint32"),
+ Rf_allocArray("(sint32, object) : object"),
+ Rf_allocMatrix("(sint32, sint32, sint32) : object"),
+ Rf_allocVector("(sint32, sint32) : object"),
+ Rf_any_duplicated("(object, sint32) : sint32"),
Rf_asChar("(object) : object"),
Rf_asInteger("(object) : sint32"),
Rf_asLogical("(object) : sint32"),
@@ -122,7 +125,7 @@ public enum RFFIUpCallMethod {
Rf_findVar("(object, object) : object"),
Rf_findVarInFrame("(object, object) : object"),
Rf_findVarInFrame3("(object, object, sint32) : object"),
- Rf_findfun("(object, object) : object"),
+ Rf_findFun("(object, object) : object"),
Rf_getAttrib("(object, object) : object"),
Rf_gsetVar("(object, object, object) : void"),
Rf_inherits("(string, object) : sint32"),
diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/TracingUpCallsRFFIImpl.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/TracingUpCallsRFFIImpl.java
index 9ad307eea7..2bf8a0d955 100644
--- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/TracingUpCallsRFFIImpl.java
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/ffi/TracingUpCallsRFFIImpl.java
@@ -214,21 +214,21 @@ final class TracingUpCallsRFFIImpl implements UpCallsRFFI {
}
@Override
- public Object Rf_allocateVector(int mode, int n) {
+ public Object Rf_allocVector(int mode, int n) {
RFFIUtils.traceUpCall("Rf_allocateVector", mode, n);
- return delegate.Rf_allocateVector(mode, n);
+ return delegate.Rf_allocVector(mode, n);
}
@Override
- public Object Rf_allocateArray(int mode, Object dimsObj) {
+ public Object Rf_allocArray(int mode, Object dimsObj) {
RFFIUtils.traceUpCall("Rf_allocateArray", mode, dimsObj);
return null;
}
@Override
- public Object Rf_allocateMatrix(int mode, int nrow, int ncol) {
+ public Object Rf_allocMatrix(int mode, int nrow, int ncol) {
RFFIUtils.traceUpCall("Rf_allocateMatrix", mode, ncol, nrow);
- return delegate.Rf_allocateMatrix(mode, nrow, ncol);
+ return delegate.Rf_allocMatrix(mode, nrow, ncol);
}
@Override
@@ -328,9 +328,9 @@ final class TracingUpCallsRFFIImpl implements UpCallsRFFI {
}
@Override
- public int Rf_anyDuplicated(Object x, int fromLast) {
+ public int Rf_any_duplicated(Object x, int fromLast) {
RFFIUtils.traceUpCall("Rf_anyDuplicated", x, fromLast);
- return delegate.Rf_anyDuplicated(x, fromLast);
+ return delegate.Rf_any_duplicated(x, fromLast);
}
@Override
@@ -430,9 +430,9 @@ final class TracingUpCallsRFFIImpl implements UpCallsRFFI {
}
@Override
- public Object Rf_findfun(Object symbolObj, Object envObj) {
+ public Object Rf_findFun(Object symbolObj, Object envObj) {
RFFIUtils.traceUpCall("Rf_findfun", symbolObj, envObj);
- return delegate.Rf_findfun(symbolObj, envObj);
+ return delegate.Rf_findFun(symbolObj, envObj);
}
@Override
@@ -454,9 +454,9 @@ final class TracingUpCallsRFFIImpl implements UpCallsRFFI {
}
@Override
- public int R_computeIdentical(Object x, Object y, int flags) {
+ public int R_compute_identical(Object x, Object y, int flags) {
RFFIUtils.traceUpCall("R_computeIdentical", x, y, flags);
- return delegate.R_computeIdentical(x, y, flags);
+ return delegate.R_compute_identical(x, y, flags);
}
@Override
@@ -700,9 +700,9 @@ final class TracingUpCallsRFFIImpl implements UpCallsRFFI {
}
@Override
- public Object R_ExternalPtrProt(Object x) {
+ public Object R_ExternalPtrProtected(Object x) {
RFFIUtils.traceUpCall("R_ExternalPtrProt", x);
- return delegate.R_ExternalPtrProt(x);
+ return delegate.R_ExternalPtrProtected(x);
}
@Override
@@ -718,9 +718,9 @@ final class TracingUpCallsRFFIImpl implements UpCallsRFFI {
}
@Override
- public void R_SetExternalPtrProt(Object x, Object prot) {
+ public void R_SetExternalPtrProtected(Object x, Object prot) {
RFFIUtils.traceUpCall("R_ExternalPtrProt", x);
- delegate.R_SetExternalPtrProt(x, prot);
+ delegate.R_SetExternalPtrProtected(x, prot);
}
@Override
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/StdUpCallsRFFI.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/StdUpCallsRFFI.java
index 6fe58f99a7..295eaa8c02 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/StdUpCallsRFFI.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/StdUpCallsRFFI.java
@@ -108,11 +108,11 @@ public interface StdUpCallsRFFI {
void Rf_warningcall(Object call, @RFFICstring Object msg);
- Object Rf_allocateVector(int mode, int n);
+ Object Rf_allocVector(int mode, int n);
- Object Rf_allocateArray(int mode, Object dimsObj);
+ Object Rf_allocArray(int mode, Object dimsObj);
- Object Rf_allocateMatrix(int mode, int nrow, int ncol);
+ Object Rf_allocMatrix(int mode, int nrow, int ncol);
int Rf_nrows(Object x);
@@ -146,7 +146,7 @@ public interface StdUpCallsRFFI {
Object Rf_duplicate(Object x, int deep);
- int Rf_anyDuplicated(Object x, int fromLast);
+ int Rf_any_duplicated(Object x, int fromLast);
Object PRINTNAME(Object x);
@@ -180,7 +180,7 @@ public interface StdUpCallsRFFI {
Object Rf_eval(Object expr, Object env);
- Object Rf_findfun(Object symbolObj, Object envObj);
+ Object Rf_findFun(Object symbolObj, Object envObj);
Object Rf_GetOption1(Object tag);
@@ -188,7 +188,7 @@ public interface StdUpCallsRFFI {
void DUPLICATE_ATTRIB(Object to, Object from);
- int R_computeIdentical(Object x, Object y, int flags);
+ int R_compute_identical(Object x, Object y, int flags);
void Rf_copyListMatrix(Object s, Object t, int byrow);
@@ -238,13 +238,13 @@ public interface StdUpCallsRFFI {
Object R_ExternalPtrTag(Object x);
- Object R_ExternalPtrProt(Object x);
+ Object R_ExternalPtrProtected(Object x);
void R_SetExternalPtrAddr(Object x, long addr);
void R_SetExternalPtrTag(Object x, Object tag);
- void R_SetExternalPtrProt(Object x, Object prot);
+ void R_SetExternalPtrProtected(Object x, Object prot);
void R_CleanUp(int sa, int status, int runlast);
diff --git a/mx.fastr/mx_fastr_mkgramrd.py b/mx.fastr/mx_fastr_mkgramrd.py
index a951e04a14..d01b63fc38 100644
--- a/mx.fastr/mx_fastr_mkgramrd.py
+++ b/mx.fastr/mx_fastr_mkgramrd.py
@@ -44,7 +44,7 @@ extern SEXP FASTR_R_EmptyEnv();
extern SEXP R_NewHashedEnv(SEXP a, SEXP b);
char *dgettext(const char *p, const char *msgid) {
-return msgid;
+return (char *)msgid;
}
int imax2(int x, int y)
--
GitLab