From f5e70eee418d2e51d436e6cb89402a5dc1050f13 Mon Sep 17 00:00:00 2001
From: Mick Jordan <mick.jordan@oracle.com>
Date: Thu, 16 Feb 2017 13:18:55 -0800
Subject: [PATCH] implement RFFI for Truffle NFI
---
ci.hocon | 8 +
.../r/engine/interop/UnsafeAdapter.java | 4 +-
.../interop/ffi/nfi/TruffleNFI_Base.java | 395 +++++
.../interop/ffi/nfi/TruffleNFI_CAccess.java | 75 +
.../interop/ffi/nfi/TruffleNFI_Call.java | 466 ++++++
.../interop/ffi/nfi/TruffleNFI_DLL.java | 119 ++
.../interop/ffi/nfi/TruffleNFI_Lapack.java | 318 ++++
.../ffi/nfi/TruffleNFI_NativeArray.java | 168 +++
.../interop/ffi/nfi/TruffleNFI_PCRE.java | 214 +++
.../interop/ffi/nfi/TruffleNFI_PkgInit.java | 158 ++
.../interop/ffi/nfi/TruffleNFI_RAppl.java | 146 ++
.../ffi/nfi/TruffleNFI_RFFIFactory.java | 168 +++
.../interop/ffi/nfi/TruffleNFI_Stats.java | 108 ++
.../interop/ffi/nfi/TruffleNFI_Tools.java | 99 ++
.../ffi/nfi/TruffleNFI_UpCallsRFFIImpl.java | 100 ++
.../interop/ffi/nfi/TruffleNFI_UserRng.java | 124 ++
.../interop/ffi/nfi/TruffleNFI_Utils.java | 119 ++
.../interop/ffi/nfi/TruffleNFI_Zip.java | 103 ++
com.oracle.truffle.r.native/Makefile | 4 +
com.oracle.truffle.r.native/fficall/Makefile | 60 +-
.../fficall/src/caccess/Makefile | 34 +
.../fficall/src/caccess/caccess.c | 38 +
.../fficall/src/truffle_nfi/Makefile | 63 +
.../fficall/src/truffle_nfi/Memory.c | 123 ++
.../fficall/src/truffle_nfi/Rdynload_fastr.c | 134 ++
.../fficall/src/truffle_nfi/Rembedded.c | 29 +
.../fficall/src/truffle_nfi/Riconv.c | 39 +
.../fficall/src/truffle_nfi/Rinternals.c | 1281 +++++++++++++++++
.../fficall/src/truffle_nfi/Rmath.c | 704 +++++++++
.../fficall/src/truffle_nfi/Utils.c | 44 +
.../fficall/src/truffle_nfi/appl_rffi.c | 40 +
.../fficall/src/truffle_nfi/base_rffi.c | 71 +
.../fficall/src/truffle_nfi/call_rffi.c.not | 26 +
.../fficall/src/truffle_nfi/lapack_rffi.c | 128 ++
.../fficall/src/truffle_nfi/pcre_rffi.c | 65 +
.../fficall/src/truffle_nfi/rffi_callbacks.h | 409 ++++++
.../fficall/src/truffle_nfi/rffiutils.h | 35 +
.../fficall/src/truffle_nfi/variables.c | 390 +++++
.../gnur/Makefile.gnur | 4 +-
com.oracle.truffle.r.native/library/lib.mk | 6 +-
.../library/tools/Makefile | 23 +-
.../library/tools/src/{ => jni}/gramRd_jni.c | 4 +-
.../tools/src/truffle_nfi/gramRd_nfi.c | 33 +
com.oracle.truffle.r.native/version.source | 2 +-
.../r/nodes/builtin/base/LaFunctions.java | 1 +
.../r/runtime/ffi/generic/Generic_Tools.java | 6 +-
.../com/oracle/truffle/r/runtime/ffi/DLL.java | 6 +-
.../truffle/r/runtime/ffi/RFFIFactory.java | 2 +-
com.oracle.truffle.r.test.native/Makefile | 4 +
.../test/tools/RFFIUpCallMethodGenerate.java | 33 +-
documentation/dev/ffi.md | 12 +-
mx.fastr/copyrights/overrides | 3 +
mx.fastr/mx_fastr.py | 2 +-
mx.fastr/mx_fastr_dists.py | 68 -
mx.fastr/suite.py | 40 +-
55 files changed, 6717 insertions(+), 141 deletions(-)
create mode 100644 com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Base.java
create mode 100644 com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_CAccess.java
create mode 100644 com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Call.java
create mode 100644 com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_DLL.java
create mode 100644 com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Lapack.java
create mode 100644 com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_NativeArray.java
create mode 100644 com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_PCRE.java
create mode 100644 com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_PkgInit.java
create mode 100644 com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_RAppl.java
create mode 100644 com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_RFFIFactory.java
create mode 100644 com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Stats.java
create mode 100644 com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Tools.java
create mode 100644 com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_UpCallsRFFIImpl.java
create mode 100644 com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_UserRng.java
create mode 100644 com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Utils.java
create mode 100644 com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Zip.java
create mode 100644 com.oracle.truffle.r.native/fficall/src/caccess/Makefile
create mode 100644 com.oracle.truffle.r.native/fficall/src/caccess/caccess.c
create mode 100644 com.oracle.truffle.r.native/fficall/src/truffle_nfi/Makefile
create mode 100644 com.oracle.truffle.r.native/fficall/src/truffle_nfi/Memory.c
create mode 100644 com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rdynload_fastr.c
create mode 100644 com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rembedded.c
create mode 100644 com.oracle.truffle.r.native/fficall/src/truffle_nfi/Riconv.c
create mode 100644 com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rinternals.c
create mode 100644 com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rmath.c
create mode 100644 com.oracle.truffle.r.native/fficall/src/truffle_nfi/Utils.c
create mode 100644 com.oracle.truffle.r.native/fficall/src/truffle_nfi/appl_rffi.c
create mode 100644 com.oracle.truffle.r.native/fficall/src/truffle_nfi/base_rffi.c
create mode 100644 com.oracle.truffle.r.native/fficall/src/truffle_nfi/call_rffi.c.not
create mode 100644 com.oracle.truffle.r.native/fficall/src/truffle_nfi/lapack_rffi.c
create mode 100644 com.oracle.truffle.r.native/fficall/src/truffle_nfi/pcre_rffi.c
create mode 100644 com.oracle.truffle.r.native/fficall/src/truffle_nfi/rffi_callbacks.h
create mode 100644 com.oracle.truffle.r.native/fficall/src/truffle_nfi/rffiutils.h
create mode 100644 com.oracle.truffle.r.native/fficall/src/truffle_nfi/variables.c
rename com.oracle.truffle.r.native/library/tools/src/{ => jni}/gramRd_jni.c (94%)
create mode 100644 com.oracle.truffle.r.native/library/tools/src/truffle_nfi/gramRd_nfi.c
diff --git a/ci.hocon b/ci.hocon
index 94646dd855..b49df18470 100644
--- a/ci.hocon
+++ b/ci.hocon
@@ -106,6 +106,13 @@ gateTestDarwin : ${gateTestCommon} ${darwinEnvironment} {
}
}
+gateTestLinuxNFI : ${gateTestCommon} {
+ environment : {
+ FASTR_RFFI : "nfi"
+ }
+}
+
+
# This performs a number of "style" checks on the code to ensure it confirms to the project standards.
gateStyle : ${common} {
@@ -146,6 +153,7 @@ internalPkgtest: ${common} {
builds = [
${gateTestLinux} {capabilities : [linux, amd64, fast], targets : [gate, post-merge], name: "gate-test-linux-amd64"}
+# ${gateTestLinuxNFI} {capabilities : [linux, amd64, fast], targets : [gate, post-merge], name: "gate-test-linux-nfi-amd64"}
${gateTestNoSpecialsLinux} {capabilities : [linux, amd64, fast], targets : [gate, post-merge], name: "gate-test-linux-amd64-nospecials"}
${gateTestDarwin} {capabilities : [darwin, amd64], targets : [gate, post-merge], name: "gate-test-darwin-amd64"}
${gateStyle} {capabilities : [linux, amd64], targets : [gate, post-merge], name: "gate-style-linux-amd64"}
diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/UnsafeAdapter.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/UnsafeAdapter.java
index 1306e9bc7c..7ef0df76f7 100644
--- a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/UnsafeAdapter.java
+++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/UnsafeAdapter.java
@@ -26,8 +26,8 @@ import java.lang.reflect.Field;
import sun.misc.Unsafe;
-class UnsafeAdapter {
- static final Unsafe UNSAFE = initUnsafe();
+public class UnsafeAdapter {
+ public static final Unsafe UNSAFE = initUnsafe();
private static Unsafe initUnsafe() {
try {
diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Base.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Base.java
new file mode 100644
index 0000000000..33ab050e3c
--- /dev/null
+++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Base.java
@@ -0,0 +1,395 @@
+/*
+ * 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.
+ */
+package com.oracle.truffle.r.engine.interop.ffi.nfi;
+
+import java.io.IOException;
+import java.util.ArrayList;
+
+import com.oracle.truffle.api.interop.ForeignAccess;
+import com.oracle.truffle.api.interop.InteropException;
+import com.oracle.truffle.api.interop.Message;
+import com.oracle.truffle.api.interop.TruffleObject;
+import com.oracle.truffle.api.interop.java.JavaInterop;
+import com.oracle.truffle.api.nodes.Node;
+import com.oracle.truffle.r.runtime.RInternalError;
+import com.oracle.truffle.r.runtime.ffi.BaseRFFI;
+
+public class TruffleNFI_Base implements BaseRFFI {
+
+ private enum Function {
+ getpid("(): sint32", true),
+ getcwd("([uint8], sint32): sint32", true),
+ chdir("(string): sint32", true),
+ mkdir("(string, sint32): sint32", true),
+ call_readlink("((string, sint32): void, string): void", false),
+ mkdtemp("([uint8]): sint32", true),
+ chmod("(string, sint32): sint32", true),
+ call_strtol("((sint64, sint32): void, string, sint32): void", false),
+ call_uname("((string, string, string, string, string): void): void", false),
+ call_glob("(string, (string): void): void", false);
+
+ private final int argCount;
+ private final String signature;
+ private final boolean useDefaultLibrary;
+ private Node message;
+ private TruffleObject function;
+
+ Function() {
+ this(null, true);
+ }
+
+ Function(String signature, boolean useDefaultLibrary) {
+ this.argCount = TruffleNFI_Utils.getArgCount(signature);
+ this.signature = signature;
+ this.useDefaultLibrary = useDefaultLibrary;
+ }
+
+ private void initialize() {
+ if (message == null) {
+ message = Message.createExecute(argCount).createNode();
+ }
+ if (function == null) {
+ function = TruffleNFI_Utils.lookupAndBind(name(), useDefaultLibrary, signature);
+ }
+ }
+ }
+
+ public static class TruffleNFI_GetpidNode extends GetpidNode {
+ @Override
+ public int execute() {
+ Function.getpid.initialize();
+ try {
+ int result = (int) ForeignAccess.sendExecute(Function.getpid.message, Function.getpid.function);
+ return result;
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+
+ }
+ }
+
+ public static class TruffleNFI_GetwdNode extends GetwdNode {
+ @Override
+ public String execute() {
+ byte[] buf = new byte[4096];
+ Function.getcwd.initialize();
+ try {
+ int result = (int) ForeignAccess.sendExecute(Function.getcwd.message, Function.getcwd.function, JavaInterop.asTruffleObject(buf), buf.length);
+ if (result == 0) {
+ return null;
+ } else {
+ int i = 0;
+ while (buf[i] != 0 && i < buf.length) {
+ i++;
+ }
+ return new String(buf, 0, i);
+ }
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+ }
+
+ public static class TruffleNFI_SetwdNode extends SetwdNode {
+ @Override
+ public int execute(String dir) {
+ Function.chdir.initialize();
+ try {
+ int result = (int) ForeignAccess.sendExecute(Function.chdir.message, Function.chdir.function, dir);
+ return result;
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+ }
+
+ public static class TruffleNFI_MkdirNode extends MkdirNode {
+ @Override
+ public void execute(String dir, int mode) throws IOException {
+ Function.mkdir.initialize();
+ try {
+ int result = (int) ForeignAccess.sendExecute(Function.mkdir.message, Function.mkdir.function, dir, mode);
+ if (result != 0) {
+ throw new IOException("mkdir " + dir + " failed");
+ }
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+ }
+
+ public static class TruffleNFI_ReadlinkNode extends ReadlinkNode {
+ private static final int EINVAL = 22;
+
+ interface SetResult {
+ void setResult(String link, int errno);
+ }
+
+ private static class SetResultImpl implements SetResult {
+ private String link;
+ private int errno;
+
+ @Override
+ public void setResult(String link, int errno) {
+ this.link = link;
+ this.errno = errno;
+ }
+
+ }
+
+ @Override
+ public String execute(String path) throws IOException {
+ Function.call_readlink.initialize();
+ try {
+ SetResultImpl setResultImpl = new SetResultImpl();
+ ForeignAccess.sendExecute(Function.call_readlink.message, Function.call_readlink.function, JavaInterop.asTruffleFunction(SetResult.class, setResultImpl), path);
+ if (setResultImpl.link == null) {
+ if (setResultImpl.errno == EINVAL) {
+ return path;
+ } else {
+ // some other error
+ throw new IOException("readlink failed: " + setResultImpl.errno);
+ }
+ }
+ return setResultImpl.link;
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+ }
+
+ public static class TruffleNFI_MkdtempNode extends MkdtempNode {
+ @Override
+ public String execute(String template) {
+ /*
+ * Not only must the (C) string end in XXXXXX it must also be null-terminated. Since it
+ * is modified by mkdtemp we must make a copy.
+ */
+ byte[] bytes = template.getBytes();
+ byte[] ztbytes = new byte[bytes.length + 1];
+ System.arraycopy(bytes, 0, ztbytes, 0, bytes.length);
+ ztbytes[bytes.length] = 0;
+ Function.mkdtemp.initialize();
+ try {
+ int result = (int) ForeignAccess.sendExecute(Function.mkdtemp.message, Function.mkdtemp.function, JavaInterop.asTruffleObject(ztbytes));
+ if (result == 0) {
+ return null;
+ } else {
+ return new String(ztbytes, 0, bytes.length);
+ }
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+ }
+
+ public static class TruffleNFI_ChmodNode extends ChmodNode {
+ @Override
+ public int execute(String path, int mode) {
+ Function.chmod.initialize();
+ try {
+ int result = (int) ForeignAccess.sendExecute(Function.chmod.message, Function.chmod.function, path, mode);
+ return result;
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+ }
+
+ public static class TruffleNFI_StrolNode extends StrolNode {
+ interface SetResult {
+ void setResult(long result, int errno);
+ }
+
+ private static class SetResultImpl implements SetResult {
+ private long result;
+ private int errno;
+
+ @Override
+ public void setResult(long result, int errno) {
+ this.result = result;
+ this.errno = errno;
+ }
+ }
+
+ @Override
+ public long execute(String s, int base) throws IllegalArgumentException {
+ Function.call_strtol.initialize();
+ try {
+ SetResultImpl setResultImpl = new SetResultImpl();
+ ForeignAccess.sendExecute(Function.call_strtol.message, Function.call_strtol.function, JavaInterop.asTruffleFunction(SetResult.class, setResultImpl), s, base);
+ if (setResultImpl.errno != 0) {
+ throw new IllegalArgumentException("strtol failure");
+ } else {
+ return setResultImpl.result;
+ }
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+ }
+
+ public static class TruffleNFI_UnameNode extends UnameNode {
+ private static UnameUpCallImpl unameUpCallImpl;
+
+ private interface UnameUpCall {
+ void unameUpCall(String sysname, String release, String version, String machine, String nodename);
+ }
+
+ private class UnameUpCallImpl implements UnameUpCall, UtsName {
+ private String sysname;
+ private String release;
+ private String version;
+ private String machine;
+ private String nodename;
+
+ @Override
+ public void unameUpCall(String sysnameA, String releaseA, String versionA, String machineA, String nodenameA) {
+ sysname = sysnameA;
+ release = releaseA;
+ version = versionA;
+ machine = machineA;
+ nodename = nodenameA;
+ }
+
+ @Override
+ public String sysname() {
+ return sysname;
+ }
+
+ @Override
+ public String release() {
+ return release;
+ }
+
+ @Override
+ public String version() {
+ return version;
+ }
+
+ @Override
+ public String machine() {
+ return machine;
+ }
+
+ @Override
+ public String nodename() {
+ return nodename;
+ }
+
+ }
+
+ @Override
+ public UtsName execute() {
+ Function.call_uname.initialize();
+ if (unameUpCallImpl == null) {
+ unameUpCallImpl = new UnameUpCallImpl();
+ try {
+ ForeignAccess.sendExecute(Function.call_uname.message, Function.call_uname.function, JavaInterop.asTruffleFunction(UnameUpCall.class, unameUpCallImpl));
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+ return unameUpCallImpl;
+ }
+ }
+
+ public static class TruffleNFI_GlobNode extends GlobNode {
+ private interface GlobUpCall {
+ void addPath(String path);
+ }
+
+ private static class GlobUpCallImpl implements GlobUpCall {
+ private ArrayList<String> paths = new ArrayList<>();
+
+ @Override
+ public void addPath(String path) {
+ paths.add(path);
+ }
+ }
+
+ @Override
+ public ArrayList<String> glob(String pattern) {
+ Function.call_glob.initialize();
+ GlobUpCallImpl globUpCallImpl = new GlobUpCallImpl();
+ try {
+ ForeignAccess.sendExecute(Function.call_glob.message, Function.call_glob.function, pattern, JavaInterop.asTruffleFunction(GlobUpCall.class, globUpCallImpl));
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ return globUpCallImpl.paths;
+ }
+
+ }
+
+ @Override
+ public GetpidNode createGetpidNode() {
+ return new TruffleNFI_GetpidNode();
+ }
+
+ @Override
+ public GetwdNode createGetwdNode() {
+ return new TruffleNFI_GetwdNode();
+ }
+
+ @Override
+ public SetwdNode createSetwdNode() {
+ return new TruffleNFI_SetwdNode();
+ }
+
+ @Override
+ public MkdirNode createMkdirNode() {
+ return new TruffleNFI_MkdirNode();
+ }
+
+ @Override
+ public ReadlinkNode createReadlinkNode() {
+ return new TruffleNFI_ReadlinkNode();
+ }
+
+ @Override
+ public MkdtempNode createMkdtempNode() {
+ return new TruffleNFI_MkdtempNode();
+ }
+
+ @Override
+ public ChmodNode createChmodNode() {
+ return new TruffleNFI_ChmodNode();
+ }
+
+ @Override
+ public StrolNode createStrolNode() {
+ return new TruffleNFI_StrolNode();
+ }
+
+ @Override
+ public UnameNode createUnameNode() {
+ return new TruffleNFI_UnameNode();
+ }
+
+ @Override
+ public GlobNode createGlobNode() {
+ return new TruffleNFI_GlobNode();
+ }
+
+}
diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_CAccess.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_CAccess.java
new file mode 100644
index 0000000000..a01fd2b14c
--- /dev/null
+++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_CAccess.java
@@ -0,0 +1,75 @@
+/*
+ * Copyright (c) 2017, 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.
+ */
+package com.oracle.truffle.r.engine.interop.ffi.nfi;
+
+import com.oracle.truffle.api.interop.ForeignAccess;
+import com.oracle.truffle.api.interop.InteropException;
+import com.oracle.truffle.api.interop.Message;
+import com.oracle.truffle.api.interop.TruffleObject;
+import com.oracle.truffle.api.nodes.Node;
+import com.oracle.truffle.r.runtime.RInternalError;
+import com.oracle.truffle.r.runtime.ffi.DLL;
+import com.oracle.truffle.r.runtime.ffi.DLLRFFI;
+import com.oracle.truffle.r.runtime.ffi.LibPaths;
+
+public class TruffleNFI_CAccess {
+ private static TruffleNFI_DLL.NFIHandle handle;
+
+ public enum Function {
+ READ_POINTER_INT("(pointer): sint32"),
+ READ_ARRAY_INT("(pointer, sint64): sint32"),
+ READ_POINTER_DOUBLE("(pointer): double"),
+ READ_ARRAY_DOUBLE("(pointer, sint32): double");
+
+ private TruffleObject symbolFunction;
+ private final String signature;
+
+ Function(String signature) {
+ this.signature = signature;
+
+ }
+
+ public TruffleObject getSymbolFunction() {
+ if (handle == null) {
+ handle = (TruffleNFI_DLL.NFIHandle) DLLRFFI.DLOpenRootNode.create().getCallTarget().call(LibPaths.getBuiltinLibPath("caccess"), true, true);
+ }
+ if (symbolFunction == null) {
+ DLL.SymbolHandle symbolHandle = (DLL.SymbolHandle) DLLRFFI.DLSymRootNode.create().getCallTarget().call(handle, cName());
+ assert symbolHandle != null;
+ Node bind = Message.createInvoke(1).createNode();
+ try {
+ symbolFunction = (TruffleObject) ForeignAccess.sendInvoke(bind, symbolHandle.asTruffleObject(), "bind", signature);
+ } catch (InteropException ex) {
+ throw RInternalError.shouldNotReachHere(ex);
+ }
+
+ }
+ return symbolFunction;
+ }
+
+ public String cName() {
+ return "caccess_" + name().toLowerCase();
+ }
+ }
+
+}
diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Call.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Call.java
new file mode 100644
index 0000000000..acefb85638
--- /dev/null
+++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Call.java
@@ -0,0 +1,466 @@
+/*
+ * 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.
+ */
+package com.oracle.truffle.r.engine.interop.ffi.nfi;
+
+import static com.oracle.truffle.r.nodes.ffi.RFFIUtils.traceDownCall;
+import static com.oracle.truffle.r.nodes.ffi.RFFIUtils.traceDownCallReturn;
+import static com.oracle.truffle.r.nodes.ffi.RFFIUtils.traceEnabled;
+
+import com.oracle.truffle.api.dsl.Cached;
+import com.oracle.truffle.api.dsl.Specialization;
+import com.oracle.truffle.api.interop.ForeignAccess;
+import com.oracle.truffle.api.interop.InteropException;
+import com.oracle.truffle.api.interop.Message;
+import com.oracle.truffle.api.interop.TruffleObject;
+import com.oracle.truffle.api.interop.java.JavaInterop;
+import com.oracle.truffle.api.nodes.Node;
+import com.oracle.truffle.r.engine.interop.ffi.nfi.TruffleNFI_CallFactory.TruffleNFI_InvokeCallNodeGen;
+import com.oracle.truffle.r.nodes.ffi.RFFIUpCallMethod;
+import com.oracle.truffle.r.nodes.ffi.RFFIUtils;
+import com.oracle.truffle.r.runtime.RInternalError;
+import com.oracle.truffle.r.runtime.ffi.CallRFFI;
+import com.oracle.truffle.r.runtime.ffi.DLL;
+import com.oracle.truffle.r.runtime.ffi.DLL.SymbolHandle;
+import com.oracle.truffle.r.runtime.ffi.NativeCallInfo;
+import com.oracle.truffle.r.runtime.ffi.RFFIVariables;
+import com.oracle.truffle.r.runtime.ffi.UpCallsRFFI;
+import com.oracle.truffle.r.runtime.gnur.SEXPTYPE;
+
+public class TruffleNFI_Call implements CallRFFI {
+
+ private enum INIT_VAR_FUN {
+ OBJ("(sint32, object) : void"),
+ DOUBLE("(sint32, double): void"),
+ STRING("(sint32, string): void"),
+ INT("(sint32, sint32) : void");
+
+ private final String funName;
+ private TruffleObject initFunction;
+ private final String signature;
+
+ INIT_VAR_FUN(String signature) {
+ this.signature = signature;
+ funName = "Call_initvar_" + name().toLowerCase();
+ }
+ }
+
+ /**
+ * Nesting of native calls is rare but can happen and the cleanup needs to be per call.
+ */
+ private static int callDepth;
+
+ public TruffleNFI_Call() {
+ initialize();
+ TruffleNFI_PkgInit.initialize();
+ }
+
+ private static void initVariables() {
+ Node bind = Message.createInvoke(1).createNode();
+ for (INIT_VAR_FUN initVarFun : INIT_VAR_FUN.values()) {
+ SymbolHandle symbolHandle = DLL.findSymbol(initVarFun.funName, null); // libR
+ try {
+ initVarFun.initFunction = (TruffleObject) ForeignAccess.sendInvoke(bind, symbolHandle.asTruffleObject(), "bind", initVarFun.signature);
+ } catch (Throwable t) {
+ throw RInternalError.shouldNotReachHere(t);
+ }
+ }
+ Node executeNode = Message.createExecute(2).createNode();
+ RFFIVariables[] variables = RFFIVariables.values();
+ for (int i = 0; i < variables.length; i++) {
+ RFFIVariables var = variables[i];
+ Object value = var.getValue();
+ if (value == null) {
+ continue;
+ }
+ try {
+ if (value instanceof Double) {
+ ForeignAccess.sendExecute(executeNode, INIT_VAR_FUN.DOUBLE.initFunction, i, value);
+ } else if (value instanceof Integer) {
+ ForeignAccess.sendExecute(executeNode, INIT_VAR_FUN.INT.initFunction, i, value);
+ } else if (value instanceof String) {
+ ForeignAccess.sendExecute(executeNode, INIT_VAR_FUN.STRING.initFunction, i, value);
+ } else {
+ ForeignAccess.sendExecute(executeNode, INIT_VAR_FUN.OBJ.initFunction, i, value);
+ }
+ } catch (Throwable t) {
+ throw RInternalError.shouldNotReachHere(t);
+ }
+ }
+ }
+
+ private static void initCallbacks(UpCallsRFFI upCallsImpl) {
+ Node bind = Message.createInvoke(1).createNode();
+ Node executeNode = Message.createExecute(1).createNode();
+ SymbolHandle symbolHandle = DLL.findSymbol("Rinternals_addCallback", null);
+ TruffleObject upCallsObject = JavaInterop.asTruffleObject(upCallsImpl);
+ Node readNode = Message.READ.createNode();
+ try {
+ for (RFFIUpCallMethod upCallMethod : RFFIUpCallMethod.values()) {
+ Object upCallMethodObject = ForeignAccess.sendRead(readNode, upCallsObject, upCallMethod.name());
+ String addCallbackSignature = String.format("(sint32, %s): void", upCallMethod.nfiSignature);
+ TruffleObject addCallbackFunction = (TruffleObject) ForeignAccess.sendInvoke(bind, symbolHandle.asTruffleObject(), "bind", addCallbackSignature);
+ ForeignAccess.sendExecute(executeNode, addCallbackFunction, upCallMethod.ordinal(), upCallMethodObject);
+ }
+ } catch (Throwable t) {
+ throw RInternalError.shouldNotReachHere(t);
+ }
+ }
+
+ private enum ReturnArray {
+ INTEGER_CREATE("([sint32], sint32): uint64", 2),
+ DOUBLE_CREATE("([double], sint32): uint64", 2),
+ BYTE_CREATE("([uint8], sint32, sint32): uint64", 3),
+ INTEGER_EXISTING("(uint64): void", 1),
+ DOUBLE_EXISTING("(uint64): void", 1),
+ BYTE_EXISTING("(uint64): void", 1),
+ FREE("(uint64): void", 1);
+
+ private final String signature;
+ private final String funName;
+ private TruffleObject function;
+ private final Node executeNode;
+
+ ReturnArray(String signature, int numArgs) {
+ this.signature = signature;
+ this.funName = "return_" + name();
+ this.executeNode = Message.createExecute(numArgs).createNode();
+ }
+
+ }
+
+ private static void initReturnArray() {
+ Node bind = Message.createInvoke(1).createNode();
+ for (ReturnArray returnArrayFun : ReturnArray.values()) {
+ SymbolHandle symbolHandle = DLL.findSymbol(returnArrayFun.funName, null); // libR
+ try {
+ returnArrayFun.function = (TruffleObject) ForeignAccess.sendInvoke(bind, symbolHandle.asTruffleObject(), "bind", returnArrayFun.signature);
+ } catch (InteropException t) {
+ throw RInternalError.shouldNotReachHere(t);
+ }
+ }
+ }
+
+ // TODO Nodify?
+ static long returnArrayCreate(Object array, boolean isString) {
+ try {
+ if (array instanceof int[]) {
+ return (long) ForeignAccess.sendExecute(ReturnArray.INTEGER_CREATE.executeNode, ReturnArray.INTEGER_CREATE.function, JavaInterop.asTruffleObject(array), ((int[]) array).length);
+ } else if (array instanceof double[]) {
+ return (long) ForeignAccess.sendExecute(ReturnArray.DOUBLE_CREATE.executeNode, ReturnArray.DOUBLE_CREATE.function, JavaInterop.asTruffleObject(array), ((double[]) array).length);
+ } else if (array instanceof byte[]) {
+ return (long) ForeignAccess.sendExecute(ReturnArray.BYTE_CREATE.executeNode, ReturnArray.BYTE_CREATE.function, JavaInterop.asTruffleObject(array), ((byte[]) array).length,
+ isString ? 1 : 0);
+ } else {
+ throw RInternalError.shouldNotReachHere();
+ }
+ } catch (InteropException t) {
+ throw RInternalError.shouldNotReachHere(t);
+ }
+ }
+
+ static void returnArrayExisting(SEXPTYPE type, long address) {
+ try {
+ switch (type) {
+ case INTSXP:
+ case LGLSXP:
+ ForeignAccess.sendExecute(ReturnArray.INTEGER_EXISTING.executeNode, ReturnArray.INTEGER_EXISTING.function, address);
+ break;
+ case REALSXP:
+ ForeignAccess.sendExecute(ReturnArray.DOUBLE_EXISTING.executeNode, ReturnArray.DOUBLE_EXISTING.function, address);
+ break;
+ case CHARSXP:
+ case RAWSXP:
+ ForeignAccess.sendExecute(ReturnArray.BYTE_EXISTING.executeNode, ReturnArray.BYTE_EXISTING.function, address);
+ break;
+ default:
+ throw RInternalError.shouldNotReachHere();
+
+ }
+ } catch (InteropException t) {
+ throw RInternalError.shouldNotReachHere(t);
+ }
+ }
+
+ static void freeArray(long address) {
+ Node executeNode = Message.createExecute(1).createNode();
+ try {
+ ForeignAccess.sendExecute(executeNode, ReturnArray.FREE.function, address);
+ } catch (InteropException t) {
+ throw RInternalError.shouldNotReachHere(t);
+ }
+ }
+
+ private static void initialize() {
+ UpCallsRFFI upCallsImpl = RFFIUtils.initialize(new TruffleNFI_UpCallsRFFIImpl());
+ if (traceEnabled()) {
+ traceDownCall("initialize");
+ }
+ try {
+ initVariables();
+ initCallbacks(upCallsImpl);
+ initReturnArray();
+ } finally {
+ if (traceEnabled()) {
+ traceDownCallReturn("initialize", null);
+ }
+ }
+ }
+
+ public abstract static class TruffleNFI_InvokeCallNode extends InvokeCallNode {
+ @Child Node bindNode = Message.createInvoke(1).createNode();
+
+ @Specialization(guards = "args.length == 0")
+ protected Object invokeCall0(NativeCallInfo nativeCallInfo, @SuppressWarnings("unused") Object[] args,
+ @Cached("createExecute(args.length)") Node executeNode) {
+ synchronized (TruffleNFI_Call.class) {
+ Object result = null;
+ prepareCall(nativeCallInfo.name, args);
+ try {
+ TruffleObject callFunction = (TruffleObject) ForeignAccess.sendInvoke(bindNode,
+ nativeCallInfo.address.asTruffleObject(), "bind", "(): object");
+ return ForeignAccess.sendExecute(executeNode, callFunction);
+ } catch (InteropException ex) {
+ throw RInternalError.shouldNotReachHere(ex);
+ } finally {
+ prepareReturn(nativeCallInfo.name, result);
+ }
+ }
+ }
+
+ @Specialization(guards = "args.length == 1")
+ protected Object invokeCall1(NativeCallInfo nativeCallInfo, Object[] args,
+ @Cached("createExecute(args.length)") Node executeNode) {
+ synchronized (TruffleNFI_Call.class) {
+ Object result = null;
+ prepareCall(nativeCallInfo.name, args);
+ try {
+ TruffleObject callFunction = (TruffleObject) ForeignAccess.sendInvoke(bindNode,
+ nativeCallInfo.address.asTruffleObject(), "bind", "(object): object");
+ return ForeignAccess.sendExecute(executeNode, callFunction, JavaInterop.asTruffleObject(args[0]));
+ } catch (InteropException ex) {
+ throw RInternalError.shouldNotReachHere(ex);
+ } finally {
+ prepareReturn(nativeCallInfo.name, result);
+ }
+ }
+ }
+
+ @Specialization(guards = "args.length == 2")
+ protected Object invokeCall2(NativeCallInfo nativeCallInfo, Object[] args,
+ @Cached("createExecute(args.length)") Node executeNode) {
+ synchronized (TruffleNFI_Call.class) {
+ Object result = null;
+ prepareCall(nativeCallInfo.name, args);
+ try {
+ TruffleObject callFunction = (TruffleObject) ForeignAccess.sendInvoke(bindNode,
+ nativeCallInfo.address.asTruffleObject(), "bind", "(object, object): object");
+ return ForeignAccess.sendExecute(executeNode, callFunction, JavaInterop.asTruffleObject(args[0]), JavaInterop.asTruffleObject(args[1]));
+ } catch (InteropException ex) {
+ throw RInternalError.shouldNotReachHere(ex);
+ } finally {
+ prepareReturn(nativeCallInfo.name, result);
+ }
+ }
+ }
+
+ @Specialization(guards = "args.length == 3")
+ protected Object invokeCall3(NativeCallInfo nativeCallInfo, Object[] args,
+ @Cached("createExecute(args.length)") Node executeNode) {
+ synchronized (TruffleNFI_Call.class) {
+ Object result = null;
+ prepareCall(nativeCallInfo.name, args);
+ try {
+ TruffleObject callFunction = (TruffleObject) ForeignAccess.sendInvoke(bindNode,
+ nativeCallInfo.address.asTruffleObject(), "bind", "(object, object, object): object");
+ return ForeignAccess.sendExecute(executeNode, callFunction, JavaInterop.asTruffleObject(args[0]), JavaInterop.asTruffleObject(args[1]), JavaInterop.asTruffleObject(args[2]));
+ } catch (InteropException ex) {
+ throw RInternalError.shouldNotReachHere(ex);
+ } finally {
+ prepareReturn(nativeCallInfo.name, result);
+ }
+ }
+ }
+
+ @Specialization(guards = "args.length == 4")
+ protected Object invokeCall4(NativeCallInfo nativeCallInfo, Object[] args,
+ @Cached("createExecute(args.length)") Node executeNode) {
+ synchronized (TruffleNFI_Call.class) {
+ Object result = null;
+ prepareCall(nativeCallInfo.name, args);
+ try {
+ TruffleObject callFunction = (TruffleObject) ForeignAccess.sendInvoke(bindNode,
+ nativeCallInfo.address.asTruffleObject(), "bind", "(object, object, object, object): object");
+ return ForeignAccess.sendExecute(executeNode, callFunction, JavaInterop.asTruffleObject(args[0]), JavaInterop.asTruffleObject(args[1]), JavaInterop.asTruffleObject(args[2]),
+ JavaInterop.asTruffleObject(args[3]));
+ } catch (InteropException ex) {
+ throw RInternalError.shouldNotReachHere(ex);
+ } finally {
+ prepareReturn(nativeCallInfo.name, result);
+ }
+ }
+ }
+
+ @Specialization(guards = "args.length == 5")
+ protected Object invokeCall5(NativeCallInfo nativeCallInfo, Object[] args,
+ @Cached("createExecute(args.length)") Node executeNode) {
+ synchronized (TruffleNFI_Call.class) {
+ Object result = null;
+ prepareCall(nativeCallInfo.name, args);
+ try {
+ TruffleObject callFunction = (TruffleObject) ForeignAccess.sendInvoke(bindNode,
+ nativeCallInfo.address.asTruffleObject(), "bind", "(object, object, object, object, object): object");
+ return ForeignAccess.sendExecute(executeNode, callFunction, JavaInterop.asTruffleObject(args[0]), JavaInterop.asTruffleObject(args[1]),
+ JavaInterop.asTruffleObject(args[2]), JavaInterop.asTruffleObject(args[3]), JavaInterop.asTruffleObject(args[4]));
+ } catch (InteropException ex) {
+ throw RInternalError.shouldNotReachHere(ex);
+ } finally {
+ prepareReturn(nativeCallInfo.name, result);
+ }
+ }
+ }
+
+ @Specialization(guards = "args.length == 6")
+ protected Object invokeCall6(NativeCallInfo nativeCallInfo, Object[] args,
+ @Cached("createExecute(args.length)") Node executeNode) {
+ synchronized (TruffleNFI_Call.class) {
+ Object result = null;
+ prepareCall(nativeCallInfo.name, args);
+ try {
+ TruffleObject callFunction = (TruffleObject) ForeignAccess.sendInvoke(bindNode,
+ nativeCallInfo.address.asTruffleObject(), "bind", "(object, object, object, object, object, object): object");
+ return ForeignAccess.sendExecute(executeNode, callFunction, JavaInterop.asTruffleObject(args[0]), JavaInterop.asTruffleObject(args[1]),
+ JavaInterop.asTruffleObject(args[2]), JavaInterop.asTruffleObject(args[3]), JavaInterop.asTruffleObject(args[4]), JavaInterop.asTruffleObject(args[5]));
+ } catch (InteropException ex) {
+ throw RInternalError.shouldNotReachHere(ex);
+ } finally {
+ prepareReturn(nativeCallInfo.name, result);
+ }
+ }
+ }
+
+ @Specialization(guards = "args.length == 7")
+ protected Object invokeCall7(NativeCallInfo nativeCallInfo, Object[] args,
+ @Cached("createExecute(args.length)") Node executeNode) {
+ synchronized (TruffleNFI_Call.class) {
+ Object result = null;
+ prepareCall(nativeCallInfo.name, args);
+ try {
+ TruffleObject callFunction = (TruffleObject) ForeignAccess.sendInvoke(bindNode,
+ nativeCallInfo.address.asTruffleObject(), "bind", "(object, object, object, object, object, object, object): object");
+ return ForeignAccess.sendExecute(executeNode, callFunction, JavaInterop.asTruffleObject(args[0]), JavaInterop.asTruffleObject(args[1]),
+ JavaInterop.asTruffleObject(args[2]), JavaInterop.asTruffleObject(args[3]), JavaInterop.asTruffleObject(args[4]), JavaInterop.asTruffleObject(args[5]),
+ JavaInterop.asTruffleObject(args[6]));
+ } catch (InteropException ex) {
+ throw RInternalError.shouldNotReachHere(ex);
+ } finally {
+ prepareReturn(nativeCallInfo.name, result);
+ }
+ }
+ }
+
+ @Specialization(guards = "args.length == 8")
+ protected Object invokeCall8(NativeCallInfo nativeCallInfo, Object[] args,
+ @Cached("createExecute(args.length)") Node executeNode) {
+ synchronized (TruffleNFI_Call.class) {
+ Object result = null;
+ prepareCall(nativeCallInfo.name, args);
+ try {
+ TruffleObject callFunction = (TruffleObject) ForeignAccess.sendInvoke(bindNode,
+ nativeCallInfo.address.asTruffleObject(), "bind", "(object, object, object, object, object, object, object, object): object");
+ return ForeignAccess.sendExecute(executeNode, callFunction, JavaInterop.asTruffleObject(args[0]), JavaInterop.asTruffleObject(args[1]),
+ JavaInterop.asTruffleObject(args[2]), JavaInterop.asTruffleObject(args[3]), JavaInterop.asTruffleObject(args[4]), JavaInterop.asTruffleObject(args[5]),
+ JavaInterop.asTruffleObject(args[6]), JavaInterop.asTruffleObject(args[7]));
+ } catch (InteropException ex) {
+ throw RInternalError.shouldNotReachHere(ex);
+ } finally {
+ prepareReturn(nativeCallInfo.name, result);
+ }
+ }
+ }
+
+ public static Node createExecute(int n) {
+ return Message.createExecute(n).createNode();
+ }
+
+ }
+
+ public static class TruffleNFI_InvokeVoidCallNode extends InvokeVoidCallNode {
+ private static final String CallVoid1Sig = "(object): void";
+ private static final String CallVoid0Sig = "(): void";
+ @Child Node bindNode = Message.createInvoke(1).createNode();
+ @Child Node execute0Node = Message.createExecute(0).createNode();
+ @Child Node execute1Node = Message.createExecute(1).createNode();
+
+ @Override
+ public void execute(NativeCallInfo nativeCallInfo, Object[] args) {
+ synchronized (TruffleNFI_Call.class) {
+ prepareCall(nativeCallInfo.name, args);
+ try {
+ switch (args.length) {
+ case 0:
+ TruffleObject callVoid0Function = (TruffleObject) ForeignAccess.sendInvoke(bindNode,
+ nativeCallInfo.address.asTruffleObject(), "bind", CallVoid0Sig);
+ ForeignAccess.sendExecute(execute0Node, callVoid0Function);
+ break;
+ case 1:
+ TruffleObject callVoid1Function = (TruffleObject) ForeignAccess.sendInvoke(bindNode,
+ nativeCallInfo.address.asTruffleObject(), "bind", CallVoid1Sig);
+ ForeignAccess.sendExecute(execute1Node, callVoid1Function, args[0]);
+ break;
+ }
+ } catch (InteropException ex) {
+ throw RInternalError.shouldNotReachHere(ex);
+ } finally {
+ prepareReturn(nativeCallInfo.name, null);
+ }
+ }
+ }
+ }
+
+ private static void prepareCall(String name, Object[] args) {
+ if (traceEnabled()) {
+ traceDownCall(name, args);
+ }
+ TruffleNFI_NativeArray.callEnter(callDepth);
+ callDepth++;
+ }
+
+ private static void prepareReturn(String name, Object result) {
+ if (traceEnabled()) {
+ traceDownCallReturn(name, result);
+ }
+ TruffleNFI_NativeArray.callEnter(callDepth);
+ callDepth--;
+ }
+
+ @Override
+ public InvokeCallNode createInvokeCallNode() {
+ return TruffleNFI_InvokeCallNodeGen.create();
+ }
+
+ @Override
+ public InvokeVoidCallNode createInvokeVoidCallNode() {
+ return new TruffleNFI_InvokeVoidCallNode();
+ }
+
+}
diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_DLL.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_DLL.java
new file mode 100644
index 0000000000..21ca2496f3
--- /dev/null
+++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_DLL.java
@@ -0,0 +1,119 @@
+/*
+ * Copyright (c) 2017, 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.
+ */
+package com.oracle.truffle.r.engine.interop.ffi.nfi;
+
+import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary;
+import com.oracle.truffle.api.interop.ForeignAccess;
+import com.oracle.truffle.api.interop.InteropException;
+import com.oracle.truffle.api.interop.Message;
+import com.oracle.truffle.api.interop.TruffleObject;
+import com.oracle.truffle.api.interop.UnknownIdentifierException;
+import com.oracle.truffle.api.nodes.Node;
+import com.oracle.truffle.api.source.Source;
+import com.oracle.truffle.api.vm.PolyglotEngine;
+import com.oracle.truffle.r.runtime.RInternalError;
+import com.oracle.truffle.r.runtime.context.RContext;
+import com.oracle.truffle.r.runtime.ffi.DLL;
+import com.oracle.truffle.r.runtime.ffi.DLL.SymbolHandle;
+import com.oracle.truffle.r.runtime.ffi.DLLRFFI;
+
+public class TruffleNFI_DLL implements DLLRFFI {
+
+ static class NFIHandle {
+ @SuppressWarnings("unused") private final String libName;
+ final TruffleObject libHandle;
+
+ NFIHandle(String libName, TruffleObject libHandle) {
+ this.libName = libName;
+ this.libHandle = libHandle;
+ }
+ }
+
+ private static class TruffleNFI_DLOpenNode extends DLLRFFI.DLOpenNode {
+
+ @Override
+ public Object execute(String path, boolean local, boolean now) {
+ String libName = DLL.libName(path);
+ PolyglotEngine engine = RContext.getInstance().getVM();
+ TruffleObject libHandle = engine.eval(Source.newBuilder(prepareLibraryOpen(path, local, now)).name(path).mimeType("application/x-native").build()).as(TruffleObject.class);
+ return new NFIHandle(libName, libHandle);
+ }
+ }
+
+ @TruffleBoundary
+ private static String prepareLibraryOpen(String path, boolean local, boolean now) {
+ StringBuilder sb = new StringBuilder("load");
+ sb.append("(");
+ sb.append(local ? "RTLD_LOCAL" : "RTLD_GLOBAL");
+ sb.append('|');
+ sb.append(now ? "RTLD_NOW" : "RTLD_LAZY");
+ sb.append(")");
+ sb.append(' ');
+ sb.append(path);
+ return sb.toString();
+ }
+
+ private static class TruffleNFI_DLSymNode extends DLLRFFI.DLSymNode {
+
+ @Override
+ public SymbolHandle execute(Object handle, String symbol) {
+ assert handle instanceof NFIHandle;
+ NFIHandle nfiHandle = (NFIHandle) handle;
+ Node lookupSymbol = Message.READ.createNode();
+ try {
+ TruffleObject result = (TruffleObject) ForeignAccess.sendRead(lookupSymbol, nfiHandle.libHandle, symbol);
+ return new SymbolHandle(result);
+ } catch (UnknownIdentifierException e) {
+ return null;
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere();
+ }
+ }
+ }
+
+ private static class TruffleNFI_DLCloseNode extends DLLRFFI.DLCloseNode {
+
+ @Override
+ public int execute(Object handle) {
+ assert handle instanceof NFIHandle;
+ // TODO
+ return 0;
+ }
+
+ }
+
+ @Override
+ public DLOpenNode createDLOpenNode() {
+ return new TruffleNFI_DLOpenNode();
+ }
+
+ @Override
+ public DLSymNode createDLSymNode() {
+ return new TruffleNFI_DLSymNode();
+ }
+
+ @Override
+ public DLCloseNode createDLCloseNode() {
+ return new TruffleNFI_DLCloseNode();
+ }
+}
diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Lapack.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Lapack.java
new file mode 100644
index 0000000000..66b2d2c0be
--- /dev/null
+++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Lapack.java
@@ -0,0 +1,318 @@
+/*
+ * 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.
+ */
+package com.oracle.truffle.r.engine.interop.ffi.nfi;
+
+import com.oracle.truffle.api.CompilerDirectives.CompilationFinal;
+import com.oracle.truffle.api.interop.ForeignAccess;
+import com.oracle.truffle.api.interop.InteropException;
+import com.oracle.truffle.api.interop.Message;
+import com.oracle.truffle.api.interop.TruffleObject;
+import com.oracle.truffle.api.interop.java.JavaInterop;
+import com.oracle.truffle.api.nodes.Node;
+import com.oracle.truffle.r.runtime.RInternalError;
+import com.oracle.truffle.r.runtime.ffi.LapackRFFI;
+
+public class TruffleNFI_Lapack implements LapackRFFI {
+ enum Function {
+ ilaver("([sint32]): void"),
+ dgeev("(uint8, uint8, sint32, [double], sint32, [double], [double], [double], sint32, [double], sint32, [double], sint32) : sint32"),
+ dgeqp3("(sint32, sint32, [double], sint32, [sint32], [double], [double], sint32) : sint32"),
+ dormq("(uint8, uint8, sint32, sint32, sint32, [double], sint32, [double], [double], sint32, [double], sint32) : sint32"),
+ dtrtrs("(uint8, uint8, uint8, sint32, sint32, [double], sint32, [double], sint32) : sint32"),
+ dgetr("(sint32, sint32, [double], sint32, [sint32]) : sint32"),
+ dpotrf("(uint8, sint32, [double], sint32) : sint32"),
+ dpotri("(uint8, sint32, [double], sint32) : sint32"),
+ dpstrf("uint8, sint32, [double], sint32, [sint32], [sint32], double, [double]) : sint32"),
+ dgesv("(sint32, sint32, [double], sint32, [sint32], [double], sint32) : sint32"),
+ dlange("(uint8, sint32, sint32, [double], sint32, [double]) : double"),
+ dgecon("(uint8, sint32, [double], sint32, double, [double], [double], [sint32]) : sint32"),
+ dsyevr("(uint8, uint8, uint8, sint32, [double], sint32, double, double, sint32, sint32, double, [sint32], [double], [double], sint32, [sint32], [double], sint32, [sint32], sint32) : sint32");
+
+ private final int argCount;
+ private final String signature;
+ @CompilationFinal private Node executeNode;
+ @CompilationFinal private TruffleObject function;
+
+ Function(String signature) {
+ this.argCount = TruffleNFI_Utils.getArgCount(signature);
+ this.signature = signature;
+ }
+
+ private void initialize() {
+ if (executeNode == null) {
+ executeNode = Message.createExecute(argCount).createNode();
+ }
+ if (function == null) {
+ function = TruffleNFI_Utils.lookupAndBind("call_" + name(), false, signature);
+ }
+ }
+ }
+
+ private static class TruffleNFI_IlaverNode extends IlaverNode {
+
+ @Override
+ public void execute(int[] version) {
+ Function.ilaver.initialize();
+ try {
+ ForeignAccess.sendExecute(Function.ilaver.executeNode, Function.ilaver.function, JavaInterop.asTruffleObject(version));
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+
+ }
+ }
+
+ private static class TruffleNFI_DgeevNode extends DgeevNode {
+
+ @Override
+ public int execute(char jobVL, char jobVR, int n, double[] a, int lda, double[] wr, double[] wi, double[] vl, int ldvl, double[] vr, int ldvr, double[] work, int lwork) {
+ Function.dgeev.initialize();
+ try {
+ return (int) ForeignAccess.sendExecute(Function.dgeev.executeNode, Function.dgeev.function, jobVL, jobVR, n, JavaInterop.asTruffleObject(a), lda,
+ JavaInterop.asTruffleObject(wr), JavaInterop.asTruffleObject(wi), JavaInterop.asTruffleObject(vl), ldvl,
+ JavaInterop.asTruffleObject(vr), ldvr, JavaInterop.asTruffleObject(work), lwork);
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+ }
+
+ private static class TruffleNFI_Dgeqp3Node extends Dgeqp3Node {
+
+ @Override
+ public int execute(int m, int n, double[] a, int lda, int[] jpvt, double[] tau, double[] work, int lwork) {
+ Function.dgeqp3.initialize();
+ try {
+ return (int) ForeignAccess.sendExecute(Function.dgeqp3.executeNode, Function.dgeqp3.function, m, n, JavaInterop.asTruffleObject(a), lda, JavaInterop.asTruffleObject(jpvt),
+ JavaInterop.asTruffleObject(tau), JavaInterop.asTruffleObject(work), lwork);
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+ }
+
+ private static class TruffleNFI_DormqrNode extends DormqrNode {
+
+ @Override
+ public int execute(char side, char trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int ldc, double[] work, int lwork) {
+ Function.dormq.initialize();
+ try {
+ return (int) ForeignAccess.sendExecute(Function.dormq.executeNode, Function.dormq.function, side, trans, m, n, k, JavaInterop.asTruffleObject(a), lda,
+ JavaInterop.asTruffleObject(tau), JavaInterop.asTruffleObject(c), ldc, JavaInterop.asTruffleObject(work), lwork);
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+ }
+
+ private static class TruffleNFI_DtrtrsNode extends DtrtrsNode {
+
+ @Override
+ public int execute(char uplo, char trans, char diag, int n, int nrhs, double[] a, int lda, double[] b, int ldb) {
+ Function.dtrtrs.initialize();
+ try {
+ return (int) ForeignAccess.sendExecute(Function.dtrtrs.executeNode, Function.dtrtrs.function, uplo, trans, diag, n, nrhs, JavaInterop.asTruffleObject(a), lda,
+ JavaInterop.asTruffleObject(b), ldb);
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+ }
+
+ private static class TruffleNFI_DgetrfNode extends DgetrfNode {
+
+ @Override
+ public int execute(int m, int n, double[] a, int lda, int[] ipiv) {
+ Function.dgetr.initialize();
+ try {
+ return (int) ForeignAccess.sendExecute(Function.dgetr.executeNode, Function.dgetr.function, m, n, JavaInterop.asTruffleObject(a), lda, JavaInterop.asTruffleObject(ipiv));
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+ }
+
+ private static class TruffleNFI_DpotrfNode extends DpotrfNode {
+
+ @Override
+ public int execute(char uplo, int n, double[] a, int lda) {
+ Function.dpotrf.initialize();
+ try {
+ return (int) ForeignAccess.sendExecute(Function.dpotrf.executeNode, Function.dpotrf.function, uplo, n, JavaInterop.asTruffleObject(a), lda);
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+ }
+
+ private static class TruffleNFI_DpotriNode extends DpotriNode {
+
+ @Override
+ public int execute(char uplo, int n, double[] a, int lda) {
+ Function.dpotri.initialize();
+ try {
+ return (int) ForeignAccess.sendExecute(Function.dpotri.executeNode, Function.dpotrf.function, uplo, n, JavaInterop.asTruffleObject(a), lda);
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+ }
+
+ private static class TruffleNFI_DpstrfNode extends DpstrfNode {
+
+ @Override
+ public int execute(char uplo, int n, double[] a, int lda, int[] piv, int[] rank, double tol, double[] work) {
+ Function.dpstrf.initialize();
+ try {
+ return (int) ForeignAccess.sendExecute(Function.dpstrf.executeNode, Function.dpstrf.function, uplo, n, JavaInterop.asTruffleObject(a), lda,
+ JavaInterop.asTruffleObject(piv), JavaInterop.asTruffleObject(rank), tol, JavaInterop.asTruffleObject(work));
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+ }
+
+ private static class TruffleNFI_DgesvNode extends DgesvNode {
+
+ @Override
+ public int execute(int n, int nrhs, double[] a, int lda, int[] ipiv, double[] b, int ldb) {
+ Function.dgesv.initialize();
+ try {
+ return (int) ForeignAccess.sendExecute(Function.dgesv.executeNode, Function.dgesv.function, n, nrhs, JavaInterop.asTruffleObject(a), lda, JavaInterop.asTruffleObject(ipiv),
+ JavaInterop.asTruffleObject(b), ldb);
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+ }
+
+ private static class TruffleNFI_DlangeNode extends DlangeNode {
+
+ @Override
+ public double execute(char norm, int m, int n, double[] a, int lda, double[] work) {
+ Function.dlange.initialize();
+ try {
+ return (double) ForeignAccess.sendExecute(Function.dlange.executeNode, Function.dlange.function, norm, m, n, JavaInterop.asTruffleObject(a), lda,
+ JavaInterop.asTruffleObject(work));
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+ }
+
+ private static class TruffleNFI_DgeconNode extends DgeconNode {
+
+ @Override
+ public int execute(char norm, int n, double[] a, int lda, double anorm, double[] rcond, double[] work, int[] iwork) {
+ Function.dgecon.initialize();
+ try {
+ return (int) ForeignAccess.sendExecute(Function.dgecon.executeNode, Function.dgecon.function, norm, n, JavaInterop.asTruffleObject(a), lda, anorm, JavaInterop.asTruffleObject(rcond),
+ JavaInterop.asTruffleObject(work), JavaInterop.asTruffleObject(iwork));
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+ }
+
+ private static class TruffleNFI_DsyevrNode extends DsyevrNode {
+
+ @Override
+ public int execute(char jobz, char range, char uplo, int n, double[] a, int lda, double vl, double vu, int il, int iu, double abstol, int[] m, double[] w, double[] z, int ldz, int[] isuppz,
+ double[] work, int lwork, int[] iwork, int liwork) {
+ Function.dsyevr.initialize();
+ try {
+ return (int) ForeignAccess.sendExecute(Function.dsyevr.executeNode, Function.dsyevr.function, jobz, range, uplo, n, JavaInterop.asTruffleObject(a),
+ lda, vl, vu, il, iu, abstol, JavaInterop.asTruffleObject(m), JavaInterop.asTruffleObject(w), JavaInterop.asTruffleObject(z), ldz,
+ JavaInterop.asTruffleObject(isuppz), JavaInterop.asTruffleObject(work), lwork, JavaInterop.asTruffleObject(iwork), liwork);
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+ }
+
+ @Override
+ public IlaverNode createIlaverNode() {
+ return new TruffleNFI_IlaverNode();
+ }
+
+ @Override
+ public DgeevNode createDgeevNode() {
+ return new TruffleNFI_DgeevNode();
+ }
+
+ @Override
+ public Dgeqp3Node createDgeqp3Node() {
+ return new TruffleNFI_Dgeqp3Node();
+ }
+
+ @Override
+ public DormqrNode createDormqrNode() {
+ return new TruffleNFI_DormqrNode();
+ }
+
+ @Override
+ public DtrtrsNode createDtrtrsNode() {
+ return new TruffleNFI_DtrtrsNode();
+ }
+
+ @Override
+ public DgetrfNode createDgetrfNode() {
+ return new TruffleNFI_DgetrfNode();
+ }
+
+ @Override
+ public DpotrfNode createDpotrfNode() {
+ return new TruffleNFI_DpotrfNode();
+ }
+
+ @Override
+ public DpotriNode createDpotriNode() {
+ return new TruffleNFI_DpotriNode();
+ }
+
+ @Override
+ public DpstrfNode createDpstrfNode() {
+ return new TruffleNFI_DpstrfNode();
+ }
+
+ @Override
+ public DgesvNode createDgesvNode() {
+ return new TruffleNFI_DgesvNode();
+ }
+
+ @Override
+ public DlangeNode createDlangeNode() {
+ return new TruffleNFI_DlangeNode();
+ }
+
+ @Override
+ public DgeconNode createDgeconNode() {
+ return new TruffleNFI_DgeconNode();
+ }
+
+ @Override
+ public DsyevrNode createDsyevrNode() {
+ return new TruffleNFI_DsyevrNode();
+ }
+
+}
diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_NativeArray.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_NativeArray.java
new file mode 100644
index 0000000000..39eeb2a3ea
--- /dev/null
+++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_NativeArray.java
@@ -0,0 +1,168 @@
+/*
+ * 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.
+ */
+package com.oracle.truffle.r.engine.interop.ffi.nfi;
+
+import java.util.Arrays;
+
+import com.oracle.truffle.r.runtime.RInternalError;
+import com.oracle.truffle.r.runtime.RRuntime;
+import com.oracle.truffle.r.runtime.data.RIntVector;
+import com.oracle.truffle.r.runtime.data.RLogicalVector;
+import com.oracle.truffle.r.runtime.ffi.UpCallsRFFI;
+import com.oracle.truffle.r.runtime.gnur.SEXPTYPE;
+
+/**
+ * Support for the {@code INTEGER, LOGICAL, ...} functions in the RFFI, which must return the same
+ * array while an FFI call is in progress.
+ */
+public class TruffleNFI_NativeArray {
+ private static int tableHwm;
+ private static int[] hwmStack = new int[16];
+ private static Info[] table = new Info[64];
+
+ static {
+ initTableElements(0);
+ }
+
+ private static class Info {
+ /**
+ * E.g., {@link RIntVector}.
+ */
+ Object x;
+ /**
+ * internal array, e.g. {@code int[]}.
+ */
+ Object array;
+ /**
+ * {@code null} unless {@code x} is an {@link RLogicalVector}, in which case it is the
+ * underlying {@code byte[]}.
+ */
+ byte[] logicalByteArray;
+
+ long arrayAddress;
+ }
+
+ private static void initTableElements(int startIndex) {
+ for (int i = startIndex; i < table.length; i++) {
+ table[i] = new Info();
+ }
+ }
+
+ static void callEnter(int callDepth) {
+ hwmStack[callDepth] = tableHwm;
+ }
+
+ static void callExit(int callDepth) {
+ int oldHwm = hwmStack[callDepth - 1];
+ for (int i = oldHwm; i < tableHwm; i++) {
+ Info info = table[i];
+ if (info.x != null) {
+ if (info.logicalByteArray != null) {
+ boolean seenNA = false;
+ int[] xai = (int[]) info.array;
+ for (int j = 0; j < xai.length; j++) {
+ int xaival = xai[j];
+ byte xal;
+ if (xaival == RRuntime.INT_NA) {
+ seenNA = true;
+ xal = RRuntime.LOGICAL_NA;
+ } else {
+ xal = (byte) xaival;
+ }
+ info.logicalByteArray[j] = xal;
+ }
+ if (seenNA) {
+ RLogicalVector lv = (RLogicalVector) info.x;
+ lv.setComplete(false);
+ }
+ }
+ TruffleNFI_Call.freeArray(info.arrayAddress);
+ }
+ }
+ tableHwm = oldHwm;
+ }
+
+ /**
+ * Searches table for an entry matching {@code x}.
+ *
+ * @return the associated native array address or {@code 0} if not found.
+ */
+ static long findArray(Object x) {
+ for (int i = 0; i < tableHwm; i++) {
+ if (table[i].x == x) {
+ return table[i].arrayAddress;
+ }
+ }
+ return 0;
+ }
+
+ /**
+ * Records that the {@code array} associated with object {@code x} has been requested by the
+ * native code from, e.g., an {@code INTEGER(x)} function.
+ *
+ * @return the native array address
+ */
+ static long recordArray(Object x, Object array, SEXPTYPE type) {
+ Object xa;
+ byte[] logicalByteArray = null;
+ boolean isString = false;
+ switch (type) {
+ case INTSXP:
+ case REALSXP:
+ case RAWSXP:
+ case CHARSXP:
+ isString = type == SEXPTYPE.CHARSXP;
+ xa = array;
+ break;
+
+ case LGLSXP: {
+ byte[] xal = (byte[]) array;
+ // RFFI wants int*
+ int[] xai = new int[xal.length];
+ for (int i = 0; i < xai.length; i++) {
+ byte lval = xal[i];
+ xai[i] = RRuntime.isNA(lval) ? RRuntime.INT_NA : lval;
+ }
+ xa = xai;
+ logicalByteArray = xal;
+ break;
+ }
+
+ default:
+ throw RInternalError.shouldNotReachHere();
+
+ }
+ if (tableHwm == table.length) {
+ table = Arrays.copyOf(table, table.length * 2);
+ initTableElements(tableHwm);
+ }
+ Info t = table[tableHwm];
+ t.x = x;
+ t.array = xa;
+ t.logicalByteArray = logicalByteArray;
+ t.arrayAddress = TruffleNFI_Call.returnArrayCreate(xa, isString);
+ tableHwm++;
+ return t.arrayAddress;
+ }
+
+}
diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_PCRE.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_PCRE.java
new file mode 100644
index 0000000000..a0c1b6d886
--- /dev/null
+++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_PCRE.java
@@ -0,0 +1,214 @@
+/*
+ * 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.
+ */
+package com.oracle.truffle.r.engine.interop.ffi.nfi;
+
+import java.nio.charset.StandardCharsets;
+
+import com.oracle.truffle.api.CompilerDirectives;
+import com.oracle.truffle.api.interop.ForeignAccess;
+import com.oracle.truffle.api.interop.InteropException;
+import com.oracle.truffle.api.interop.Message;
+import com.oracle.truffle.api.interop.TruffleObject;
+import com.oracle.truffle.api.interop.java.JavaInterop;
+import com.oracle.truffle.api.nodes.Node;
+import com.oracle.truffle.r.runtime.RError;
+import com.oracle.truffle.r.runtime.RInternalError;
+import com.oracle.truffle.r.runtime.ffi.PCRERFFI;
+
+public class TruffleNFI_PCRE implements PCRERFFI {
+ private enum Function {
+ maketables("(): sint64", true),
+ compile("((uint64, string, sint32): void, string, sint32, uint64): void", false),
+ getcapturecount("(uint64, uint64): sint32", false),
+ getcapturenames("((sint32, string): void, uint64, uint64)", false),
+ study("(uint64, sint32): void", false),
+ exec("(uint64, uint64, [uint8], sint32, sint32, sint32, [sint32], sint32): sint32", true);
+
+ private final int argCount;
+ private final String signature;
+ private final String callName;
+ private Node executeNode;
+ private TruffleObject function;
+
+ Function(String signature, boolean direct) {
+ this.argCount = TruffleNFI_Utils.getArgCount(signature);
+ this.signature = signature;
+ this.callName = (direct ? "pcre_" : "call_") + name();
+ }
+
+ private void initialize() {
+ if (executeNode == null) {
+ executeNode = Message.createExecute(argCount).createNode();
+ }
+ if (function == null) {
+ function = TruffleNFI_Utils.lookupAndBind(callName, false, signature);
+ }
+ }
+ }
+
+ private static class TruffleNFI_MaketablesNode extends MaketablesNode {
+
+ @Override
+ public long execute() {
+ Function.maketables.initialize();
+ try {
+ long result = (long) ForeignAccess.sendExecute(Function.maketables.executeNode, Function.maketables.function);
+ return result;
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+
+ }
+
+ private static class TruffleNFI_GetCaptureCountNode extends GetCaptureCountNode {
+
+ @Override
+ public int execute(long code, long extra) {
+ Function.getcapturecount.initialize();
+ try {
+ int result = (int) ForeignAccess.sendExecute(Function.getcapturecount.executeNode, Function.getcapturecount.function, code, extra);
+ return result;
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+ }
+
+ private static class TruffleNFI_GetCaptureNamesNode extends GetCaptureNamesNode {
+ interface CaptureNames {
+ void addName(int i, String name);
+ }
+
+ final class CaptureNamesImpl implements CaptureNames {
+ private final String[] captureNames;
+
+ private CaptureNamesImpl(int captureCount) {
+ captureNames = new String[captureCount];
+ }
+
+ @Override
+ public void addName(int i, String name) {
+ captureNames[i] = name;
+ }
+
+ }
+
+ @Override
+ public String[] execute(long code, long extra, int captureCount) {
+ Function.getcapturenames.initialize();
+ try {
+ CaptureNamesImpl captureNamesImpl = new CaptureNamesImpl(captureCount);
+ int result = (int) ForeignAccess.sendExecute(Function.getcapturenames.executeNode, Function.getcapturenames.function,
+ JavaInterop.asTruffleFunction(CaptureNames.class, captureNamesImpl), code, extra);
+ if (result < 0) {
+ CompilerDirectives.transferToInterpreter();
+ throw RError.error(RError.NO_CALLER, RError.Message.WRONG_PCRE_INFO, result);
+ } else {
+ return captureNamesImpl.captureNames;
+ }
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+
+ }
+
+ private static class TruffleNFI_CompileNode extends CompileNode {
+ interface MakeResult {
+ void makeresult(long pcreResult, String errorMessage, int errOffset);
+ }
+
+ private static class MakeResultImpl implements MakeResult {
+ private PCRERFFI.Result result;
+
+ @Override
+ public void makeresult(long pcreResult, String errorMessage, int errOffset) {
+ result = new PCRERFFI.Result(pcreResult, errorMessage, errOffset);
+ }
+ }
+
+ @Override
+ public Result execute(String pattern, int options, long tables) {
+ Function.compile.initialize();
+ try {
+ MakeResultImpl makeResultImpl = new MakeResultImpl();
+ ForeignAccess.sendExecute(Function.compile.executeNode, Function.compile.function, JavaInterop.asTruffleFunction(MakeResult.class, makeResultImpl),
+ pattern, options, tables);
+ return makeResultImpl.result;
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+
+ }
+
+ private static class TruffleNFI_ExecNode extends ExecNode {
+
+ @Override
+ public int execute(long code, long extra, String subject, int offset, int options, int[] ovector) {
+ Function.exec.initialize();
+ try {
+
+ byte[] subjectBytes = subject.getBytes(StandardCharsets.UTF_8);
+ return (int) ForeignAccess.sendExecute(Function.exec.executeNode, Function.exec.function, code, extra,
+ JavaInterop.asTruffleObject(subjectBytes), subjectBytes.length,
+ offset, options, JavaInterop.asTruffleObject(ovector), ovector.length);
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+
+ }
+
+ @Override
+ public MaketablesNode createMaketablesNode() {
+ return new TruffleNFI_MaketablesNode();
+ }
+
+ @Override
+ public CompileNode createCompileNode() {
+ return new TruffleNFI_CompileNode();
+ }
+
+ @Override
+ public GetCaptureCountNode createGetCaptureCountNode() {
+ return new TruffleNFI_GetCaptureCountNode();
+ }
+
+ @Override
+ public GetCaptureNamesNode createGetCaptureNamesNode() {
+ return new TruffleNFI_GetCaptureNamesNode();
+ }
+
+ @Override
+ public StudyNode createStudyNode() {
+ throw RInternalError.unimplemented();
+ }
+
+ @Override
+ public ExecNode createExecNode() {
+ return new TruffleNFI_ExecNode();
+ }
+
+}
diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_PkgInit.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_PkgInit.java
new file mode 100644
index 0000000000..0ec6f4d2ef
--- /dev/null
+++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_PkgInit.java
@@ -0,0 +1,158 @@
+/*
+ * 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.
+ */
+package com.oracle.truffle.r.engine.interop.ffi.nfi;
+
+import com.oracle.truffle.api.interop.ForeignAccess;
+import com.oracle.truffle.api.interop.InteropException;
+import com.oracle.truffle.api.interop.Message;
+import com.oracle.truffle.api.interop.TruffleObject;
+import com.oracle.truffle.api.interop.java.JavaInterop;
+import com.oracle.truffle.api.nodes.Node;
+import com.oracle.truffle.r.runtime.RInternalError;
+import com.oracle.truffle.r.runtime.ffi.DLL;
+import com.oracle.truffle.r.runtime.ffi.DLL.DLLInfo;
+import com.oracle.truffle.r.runtime.ffi.DLL.DotSymbol;
+import com.oracle.truffle.r.runtime.ffi.DLL.SymbolHandle;
+
+public final class TruffleNFI_PkgInit {
+
+ private enum UpCall {
+ registerRoutines("(object, sint32, sint32, uint64): void"),
+ useDynamicSymbols("(object, sint32): sint32"),
+ setDotSymbolValues("(object, string, pointer, sint32): object"),
+ forceSymbols("(object, sint32): sint32");
+ private final String signature;
+
+ UpCall(String signature) {
+ this.signature = signature;
+ }
+ }
+
+ /**
+ * The upcalls from native code that support symbol registration.
+ */
+ interface UpCalls {
+
+ /**
+ * This is the start, called from {@code R_RegisterRoutines}.
+ *
+ * @param dllInfo library the symbols are defined in
+ * @param nstOrd the ordinal value corresponding to
+ * {@link com.oracle.truffle.r.runtime.ffi.DLL.NativeSymbolType}.
+ * @param num the number of functions being registered
+ * @param routines the C address of the function table (not interpreted).
+ */
+ void registerRoutines(DLLInfo dllInfo, int nstOrd, int num, long routines);
+
+ /**
+ * Internal upcall used by {@code Rdynload_setSymbol}. The {@code fun} value must be
+ * converted to a {@link TruffleObject} representing the symbol}.
+ *
+ * @param dllInfo library the symbol is defined in
+ * @param name name of function
+ * @param fun the C address of the function (in the table)
+ * @param numArgs the number of arguments the function takes.
+ */
+ DotSymbol setDotSymbolValues(DLLInfo dllInfo, String name, TruffleObject fun, int numArgs);
+
+ /**
+ * Directly implements {@code R_useDynamicSymbols}.
+ */
+ int useDynamicSymbols(DLLInfo dllInfo, int value);
+
+ /**
+ * Directly implements {@code R_forceSymbols}.
+ */
+ int forceSymbols(DLLInfo dllInfo, int value);
+
+ }
+
+ private static class UpCallsImpl implements UpCalls {
+ /**
+ * First create the array, then downcall to native to get the specific info for each symbol
+ * which is delivered by {@link #setDotSymbolValues}.
+ */
+ @Override
+ public void registerRoutines(DLLInfo dllInfo, int nstOrd, int num, long routines) {
+ DotSymbol[] array = new DotSymbol[num];
+ for (int i = 0; i < num; i++) {
+ array[i] = setSymbol(dllInfo, nstOrd, routines, i);
+ }
+ dllInfo.setNativeSymbols(nstOrd, array);
+ }
+
+ @Override
+ public int useDynamicSymbols(DLLInfo dllInfo, int value) {
+ return DLL.useDynamicSymbols(dllInfo, value);
+ }
+
+ @Override
+ public DotSymbol setDotSymbolValues(DLLInfo dllInfo, String name, TruffleObject fun, int numArgs) {
+ /*
+ * We don't know the NFI signature at this point, so we cannot bind the function here.
+ */
+ DotSymbol result = new DotSymbol(name, new SymbolHandle(fun), numArgs);
+ return result;
+ }
+
+ @Override
+ public int forceSymbols(DLLInfo dllInfo, int value) {
+ return DLL.forceSymbols(dllInfo, value);
+ }
+ }
+
+ private static final String SETSYMBOL_SIGNATURE = "(object, sint32, uint64, sint32): object";
+ private static TruffleObject setSymbolFunction;
+
+ static void initialize() {
+ Node bind = Message.createInvoke(1).createNode();
+ SymbolHandle symbolHandle = DLL.findSymbol("Rdynload_init", null);
+ Node executeNode = Message.createExecute(2).createNode();
+ UpCallsImpl upCalls = new UpCallsImpl();
+ TruffleObject upCallsObject = JavaInterop.asTruffleObject(upCalls);
+ Node readNode = Message.READ.createNode();
+ try {
+ for (UpCall upCall : UpCall.values()) {
+ Object upCallMethodObject = ForeignAccess.sendRead(readNode, upCallsObject, upCall.name());
+ String addCallbackSignature = String.format("(sint32, %s): void", upCall.signature);
+ TruffleObject addCallbackFunction = (TruffleObject) ForeignAccess.sendInvoke(bind, symbolHandle.asTruffleObject(), "bind", addCallbackSignature);
+ ForeignAccess.sendExecute(executeNode, addCallbackFunction, upCall.ordinal(), upCallMethodObject);
+ }
+ symbolHandle = DLL.findSymbol("Rdynload_setSymbol", null);
+ setSymbolFunction = (TruffleObject) ForeignAccess.sendInvoke(bind, symbolHandle.asTruffleObject(), "bind", SETSYMBOL_SIGNATURE);
+ } catch (Throwable t) {
+ throw RInternalError.shouldNotReachHere(t);
+ }
+ }
+
+ private static DotSymbol setSymbol(DLLInfo dllInfo, int nstOrd, long routines, int index) {
+ Node executeNode = Message.createExecute(4).createNode();
+ try {
+ DotSymbol result = (DotSymbol) ForeignAccess.sendExecute(executeNode, setSymbolFunction, dllInfo, nstOrd, routines, index);
+ return result;
+ } catch (Throwable t) {
+ throw RInternalError.shouldNotReachHere(t);
+ }
+
+ }
+}
diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_RAppl.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_RAppl.java
new file mode 100644
index 0000000000..e0289cdacb
--- /dev/null
+++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_RAppl.java
@@ -0,0 +1,146 @@
+/*
+ * 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.
+ */
+package com.oracle.truffle.r.engine.interop.ffi.nfi;
+
+import com.oracle.truffle.api.CompilerDirectives.CompilationFinal;
+import com.oracle.truffle.api.interop.ForeignAccess;
+import com.oracle.truffle.api.interop.InteropException;
+import com.oracle.truffle.api.interop.Message;
+import com.oracle.truffle.api.interop.TruffleObject;
+import com.oracle.truffle.api.interop.java.JavaInterop;
+import com.oracle.truffle.api.nodes.Node;
+import com.oracle.truffle.r.runtime.RInternalError;
+import com.oracle.truffle.r.runtime.ffi.RApplRFFI;
+
+public class TruffleNFI_RAppl implements RApplRFFI {
+ enum Function {
+ dqrdc2("([double], sint32, sint32, sint32, double, [sint32], [double], [sint32], [double]): void"),
+ dqrcf("([double], sint32, sint32, [double], [double], sint32, [double], [sint32]): void"),
+ dqrls("([double], sint32, sint32, [double], sint32, double, [double], [double], [double], [sint32], [sint32], [double], [double]): void");
+
+ private final int argCount;
+ private final String signature;
+ @CompilationFinal private Node executeNode;
+ @CompilationFinal private TruffleObject function;
+
+ Function(String signature) {
+ this.argCount = TruffleNFI_Utils.getArgCount(signature);
+ this.signature = signature;
+ }
+
+ private void initialize() {
+ if (executeNode == null) {
+ executeNode = Message.createExecute(argCount).createNode();
+ }
+ if (function == null) {
+ function = TruffleNFI_Utils.lookupAndBind("call_" + name(), false, signature);
+ }
+ }
+ }
+
+ private static class TruffleNFI_Dqrdc2Node extends Dqrdc2Node {
+
+ @Override
+ public void execute(double[] x, int ldx, int n, int p, double tol, int[] rank, double[] qraux, int[] pivot, double[] work) {
+ Function.dqrdc2.initialize();
+ try {
+ ForeignAccess.sendExecute(Function.dqrdc2.executeNode, Function.dqrdc2.function,
+ JavaInterop.asTruffleObject(x),
+ ldx, n, p, tol,
+ JavaInterop.asTruffleObject(rank),
+ JavaInterop.asTruffleObject(qraux),
+ JavaInterop.asTruffleObject(pivot),
+ JavaInterop.asTruffleObject(work));
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+
+ }
+
+ }
+
+ private static class TruffleNFI_DqrcfNode extends DqrcfNode {
+
+ @Override
+ public void execute(double[] x, int n, int k, double[] qraux, double[] y, int ny, double[] b, int[] info) {
+ Function.dqrcf.initialize();
+ try {
+ ForeignAccess.sendExecute(Function.dqrcf.executeNode, Function.dqrcf.function,
+ JavaInterop.asTruffleObject(x),
+ n, k,
+ JavaInterop.asTruffleObject(qraux),
+ JavaInterop.asTruffleObject(y),
+ ny,
+ JavaInterop.asTruffleObject(b),
+ JavaInterop.asTruffleObject(info));
+
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+
+ }
+
+ private static class TruffleNFI_DqrlsNode extends DqrlsNode {
+
+ @Override
+ public void execute(double[] x, int n, int p, double[] y, int ny, double tol, double[] b, double[] rsd, double[] qty, int[] k, int[] jpvt, double[] qraux, double[] work) {
+ Function.dqrls.initialize();
+ try {
+ ForeignAccess.sendExecute(Function.dqrls.executeNode, Function.dqrls.function,
+ JavaInterop.asTruffleObject(x),
+ n, p,
+ JavaInterop.asTruffleObject(y),
+ ny, tol,
+ JavaInterop.asTruffleObject(b),
+ JavaInterop.asTruffleObject(rsd),
+ JavaInterop.asTruffleObject(qty),
+ JavaInterop.asTruffleObject(k),
+ JavaInterop.asTruffleObject(jpvt),
+ JavaInterop.asTruffleObject(qraux),
+ JavaInterop.asTruffleObject(work));
+
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+
+ }
+
+ }
+
+ @Override
+ public Dqrdc2Node createDqrdc2Node() {
+ return new TruffleNFI_Dqrdc2Node();
+ }
+
+ @Override
+ public DqrcfNode createDqrcfNode() {
+ return new TruffleNFI_DqrcfNode();
+ }
+
+ @Override
+ public DqrlsNode createDqrlsNode() {
+ return new TruffleNFI_DqrlsNode();
+ }
+
+}
diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_RFFIFactory.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_RFFIFactory.java
new file mode 100644
index 0000000000..d884490e87
--- /dev/null
+++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_RFFIFactory.java
@@ -0,0 +1,168 @@
+/*
+ * Copyright (c) 2017, 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.
+ */
+package com.oracle.truffle.r.engine.interop.ffi.nfi;
+
+import com.oracle.truffle.api.CompilerDirectives;
+import com.oracle.truffle.api.CompilerDirectives.CompilationFinal;
+import com.oracle.truffle.r.runtime.context.RContext;
+import com.oracle.truffle.r.runtime.context.RContext.ContextState;
+import com.oracle.truffle.r.runtime.ffi.BaseRFFI;
+import com.oracle.truffle.r.runtime.ffi.CallRFFI;
+import com.oracle.truffle.r.runtime.ffi.DLL;
+import com.oracle.truffle.r.runtime.ffi.DLLRFFI;
+import com.oracle.truffle.r.runtime.ffi.LapackRFFI;
+import com.oracle.truffle.r.runtime.ffi.LibPaths;
+import com.oracle.truffle.r.runtime.ffi.PCRERFFI;
+import com.oracle.truffle.r.runtime.ffi.RApplRFFI;
+import com.oracle.truffle.r.runtime.ffi.RFFI;
+import com.oracle.truffle.r.runtime.ffi.StatsRFFI;
+import com.oracle.truffle.r.runtime.ffi.ToolsRFFI;
+import com.oracle.truffle.r.runtime.ffi.UserRngRFFI;
+import com.oracle.truffle.r.runtime.ffi.ZipRFFI;
+import com.oracle.truffle.r.runtime.ffi.jni.JNI_RFFIFactory;
+
+public class TruffleNFI_RFFIFactory extends JNI_RFFIFactory implements RFFI {
+ private static class ContextStateImpl implements RContext.ContextState {
+ @Override
+ public ContextState initialize(RContext context) {
+ if (context.isInitial()) {
+ String librffiPath = LibPaths.getBuiltinLibPath("R");
+ DLL.loadLibR(librffiPath);
+ }
+ return this;
+ }
+ }
+
+ @Override
+ public ContextState newContextState() {
+ return new ContextStateImpl();
+ }
+
+ @CompilationFinal private CallRFFI callRFFI;
+
+ @CompilationFinal private BaseRFFI baseRFFI;
+
+ @Override
+ public BaseRFFI getBaseRFFI() {
+ if (baseRFFI == null) {
+ CompilerDirectives.transferToInterpreterAndInvalidate();
+ baseRFFI = new TruffleNFI_Base();
+ }
+ return baseRFFI;
+ }
+
+ @Override
+ public CallRFFI getCallRFFI() {
+ if (callRFFI == null) {
+ CompilerDirectives.transferToInterpreterAndInvalidate();
+ callRFFI = new TruffleNFI_Call();
+ }
+ return callRFFI;
+ }
+
+ @CompilationFinal private DLLRFFI dllRFFI;
+
+ @Override
+ public DLLRFFI getDLLRFFI() {
+ if (dllRFFI == null) {
+ dllRFFI = new TruffleNFI_DLL();
+ }
+ return dllRFFI;
+ }
+
+ @CompilationFinal private UserRngRFFI userRngRFFI;
+
+ @Override
+ public UserRngRFFI getUserRngRFFI() {
+ if (userRngRFFI == null) {
+ userRngRFFI = new TruffleNFI_UserRng();
+ }
+ return userRngRFFI;
+ }
+
+ @CompilationFinal private ZipRFFI zipRFFI;
+
+ @Override
+ public ZipRFFI getZipRFFI() {
+ if (zipRFFI == null) {
+ CompilerDirectives.transferToInterpreterAndInvalidate();
+ zipRFFI = new TruffleNFI_Zip();
+ }
+ return zipRFFI;
+ }
+
+ @CompilationFinal private PCRERFFI pcreRFFI;
+
+ @Override
+ public PCRERFFI getPCRERFFI() {
+ if (pcreRFFI == null) {
+ pcreRFFI = new TruffleNFI_PCRE();
+ }
+ return pcreRFFI;
+ }
+
+ @CompilationFinal private LapackRFFI lapackRFFI;
+
+ @Override
+ public LapackRFFI getLapackRFFI() {
+ if (lapackRFFI == null) {
+ CompilerDirectives.transferToInterpreterAndInvalidate();
+ lapackRFFI = new TruffleNFI_Lapack();
+ }
+ return lapackRFFI;
+ }
+
+ @CompilationFinal private RApplRFFI rApplRFFI;
+
+ @Override
+ public RApplRFFI getRApplRFFI() {
+ if (rApplRFFI == null) {
+ CompilerDirectives.transferToInterpreterAndInvalidate();
+ rApplRFFI = new TruffleNFI_RAppl();
+ }
+ return rApplRFFI;
+ }
+
+ @CompilationFinal private StatsRFFI statsRFFI;
+
+ @Override
+ public StatsRFFI getStatsRFFI() {
+ if (statsRFFI == null) {
+ CompilerDirectives.transferToInterpreterAndInvalidate();
+ statsRFFI = new TruffleNFI_Stats();
+ }
+ return statsRFFI;
+ }
+
+ @CompilationFinal private ToolsRFFI toolsRFFI;
+
+ @Override
+ public ToolsRFFI getToolsRFFI() {
+ if (toolsRFFI == null) {
+ CompilerDirectives.transferToInterpreterAndInvalidate();
+ toolsRFFI = new TruffleNFI_Tools();
+ }
+ return toolsRFFI;
+ }
+
+}
diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Stats.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Stats.java
new file mode 100644
index 0000000000..f6c8d87e16
--- /dev/null
+++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Stats.java
@@ -0,0 +1,108 @@
+/*
+ * 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.
+ */
+package com.oracle.truffle.r.engine.interop.ffi.nfi;
+
+import com.oracle.truffle.api.CompilerDirectives.CompilationFinal;
+import com.oracle.truffle.api.interop.ForeignAccess;
+import com.oracle.truffle.api.interop.InteropException;
+import com.oracle.truffle.api.interop.Message;
+import com.oracle.truffle.api.interop.TruffleObject;
+import com.oracle.truffle.api.interop.java.JavaInterop;
+import com.oracle.truffle.api.nodes.Node;
+import com.oracle.truffle.r.runtime.RInternalError;
+import com.oracle.truffle.r.runtime.ffi.DLL;
+import com.oracle.truffle.r.runtime.ffi.DLL.DLLInfo;
+import com.oracle.truffle.r.runtime.ffi.DLL.SymbolHandle;
+import com.oracle.truffle.r.runtime.ffi.DLLRFFI;
+import com.oracle.truffle.r.runtime.ffi.RFFIFactory;
+import com.oracle.truffle.r.runtime.ffi.StatsRFFI;
+
+public class TruffleNFI_Stats implements StatsRFFI {
+
+ private static class TruffleNFI_FactorNode extends FactorNode {
+ private static final String FFT_FACTOR = "fft_factor";
+ private static final String FFT_FACTOR_SIGNATURE = "(sint32, [sint32], [sint32]): void";
+
+ @Child Node factorMessage = Message.createExecute(3).createNode();
+ @Child DLLRFFI.DLSymNode dlsymNode = RFFIFactory.getRFFI().getDLLRFFI().createDLSymNode();
+
+ @CompilationFinal private TruffleObject fftFactorFunction;
+
+ @Override
+ public void execute(int n, int[] pmaxf, int[] pmaxp) {
+ try {
+ if (fftFactorFunction == null) {
+ Node bind = Message.createInvoke(1).createNode();
+ fftFactorFunction = (TruffleObject) ForeignAccess.sendInvoke(bind, findSymbol(FFT_FACTOR, dlsymNode).asTruffleObject(), "bind", FFT_FACTOR_SIGNATURE);
+ }
+ ForeignAccess.sendExecute(factorMessage, fftFactorFunction, n, JavaInterop.asTruffleObject(pmaxf), JavaInterop.asTruffleObject(pmaxp));
+ } catch (InteropException t) {
+ throw RInternalError.shouldNotReachHere();
+ }
+ }
+ }
+
+ private static class TruffleNFI_WorkNode extends WorkNode {
+ private static final String FFT_WORK = "fft_work";
+ private static final String FFT_WORK_SIGNATURE = "([double], sint32, sint32, sint32, sint32, [double], [sint32]): sint32";
+
+ @Child DLLRFFI.DLSymNode dlsymNode = RFFIFactory.getRFFI().getDLLRFFI().createDLSymNode();
+ @Child Node workMessage = Message.createExecute(7).createNode();
+ @CompilationFinal private TruffleObject fftWorkFunction;
+
+ @Override
+ public int execute(double[] a, int nseg, int n, int nspn, int isn, double[] work, int[] iwork) {
+ try {
+ if (fftWorkFunction == null) {
+ Node bind = Message.createInvoke(1).createNode();
+ fftWorkFunction = (TruffleObject) ForeignAccess.sendInvoke(bind, findSymbol(FFT_WORK, dlsymNode).asTruffleObject(), "bind", FFT_WORK_SIGNATURE);
+ }
+ return (int) ForeignAccess.sendExecute(workMessage, fftWorkFunction, JavaInterop.asTruffleObject(a), nseg, n, nspn, isn,
+ JavaInterop.asTruffleObject(work), JavaInterop.asTruffleObject(iwork));
+ } catch (InteropException t) {
+ throw RInternalError.shouldNotReachHere();
+ }
+ }
+
+ }
+
+ private static SymbolHandle findSymbol(String symbol, DLLRFFI.DLSymNode dlsymNode) {
+ SymbolHandle fftAddress;
+ DLLInfo dllInfo = DLL.findLibrary("stats");
+ assert dllInfo != null;
+ fftAddress = dlsymNode.execute(dllInfo.handle, symbol);
+ assert fftAddress != DLL.SYMBOL_NOT_FOUND;
+ return fftAddress;
+ }
+
+ @Override
+ public FactorNode createFactorNode() {
+ return new TruffleNFI_FactorNode();
+ }
+
+ @Override
+ public WorkNode createWorkNode() {
+ return new TruffleNFI_WorkNode();
+ }
+
+}
diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Tools.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Tools.java
new file mode 100644
index 0000000000..305c038b49
--- /dev/null
+++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Tools.java
@@ -0,0 +1,99 @@
+/*
+ * 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.
+ */
+package com.oracle.truffle.r.engine.interop.ffi.nfi;
+
+import java.io.IOException;
+
+import com.oracle.truffle.api.interop.ForeignAccess;
+import com.oracle.truffle.api.interop.InteropException;
+import com.oracle.truffle.api.interop.Message;
+import com.oracle.truffle.api.interop.TruffleObject;
+import com.oracle.truffle.api.interop.java.JavaInterop;
+import com.oracle.truffle.api.nodes.Node;
+import com.oracle.truffle.r.runtime.RInternalError;
+import com.oracle.truffle.r.runtime.conn.RConnection;
+import com.oracle.truffle.r.runtime.data.RLogicalVector;
+import com.oracle.truffle.r.runtime.data.RStringVector;
+import com.oracle.truffle.r.runtime.env.REnvironment;
+import com.oracle.truffle.r.runtime.ffi.DLL;
+import com.oracle.truffle.r.runtime.ffi.ToolsRFFI;
+import com.oracle.truffle.r.runtime.ffi.DLL.DLLInfo;
+import com.oracle.truffle.r.runtime.ffi.DLL.SymbolHandle;
+import com.oracle.truffle.r.runtime.ffi.DLLRFFI;
+import com.oracle.truffle.r.runtime.ffi.generic.Generic_Tools;
+
+public class TruffleNFI_Tools implements ToolsRFFI {
+
+ private static class TruffleNFI_ToolsRFFINode extends Generic_Tools.Generic_ToolsRFFINode {
+ private interface RConnGetC {
+ int getc(RConnection conn);
+ }
+
+ private static class RConnGetCImpl implements RConnGetC {
+ @Override
+ public int getc(RConnection conn) {
+ try {
+ return conn.getc();
+ } catch (IOException ex) {
+ throw RInternalError.shouldNotReachHere(ex);
+ }
+ }
+ }
+
+ private static boolean initialized;
+
+ @Child private DLLRFFI.DLSymNode dysymNode = DLLRFFI.DLSymNode.create();
+
+ @Override
+ public synchronized Object execute(RConnection con, REnvironment srcfile, RLogicalVector verbose, RLogicalVector fragment, RStringVector basename, RLogicalVector warningCalls, Object macros,
+ RLogicalVector warndups) {
+ if (!initialized) {
+ initCallback();
+ initialized = true;
+ }
+ return super.execute(con, srcfile, verbose, fragment, basename, warningCalls, JavaInterop.asTruffleObject(macros), warndups);
+ }
+
+ private void initCallback() {
+ DLLInfo toolsDLLInfo = DLL.findLibrary(TOOLS);
+ assert toolsDLLInfo != null;
+ SymbolHandle symbolHandle = dysymNode.execute(toolsDLLInfo.handle, "gramRd_nfi_init");
+ assert symbolHandle != DLL.SYMBOL_NOT_FOUND;
+ Node bind = Message.createInvoke(1).createNode();
+ Node executeNode = Message.createExecute(1).createNode();
+ try {
+ TruffleObject function = (TruffleObject) ForeignAccess.sendInvoke(bind, symbolHandle.asTruffleObject(), "bind", "((object): sint32): void");
+ ForeignAccess.sendExecute(executeNode, function, JavaInterop.asTruffleFunction(RConnGetC.class, new RConnGetCImpl()));
+ } catch (InteropException t) {
+ throw RInternalError.shouldNotReachHere(t);
+ }
+
+ }
+ }
+
+ @Override
+ public ParseRdNode createParseRdNode() {
+ return new TruffleNFI_ToolsRFFINode();
+ }
+
+}
diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_UpCallsRFFIImpl.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_UpCallsRFFIImpl.java
new file mode 100644
index 0000000000..e302c637ca
--- /dev/null
+++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_UpCallsRFFIImpl.java
@@ -0,0 +1,100 @@
+/*
+ * 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.
+ */
+package com.oracle.truffle.r.engine.interop.ffi.nfi;
+
+import com.oracle.truffle.r.nodes.ffi.JavaUpCallsRFFIImpl;
+import com.oracle.truffle.r.runtime.ffi.CharSXPWrapper;
+import com.oracle.truffle.r.runtime.gnur.SEXPTYPE;
+
+public class TruffleNFI_UpCallsRFFIImpl extends JavaUpCallsRFFIImpl {
+ @Override
+ public Object Rf_mkCharLenCE(Object bytes, int len, int encoding) {
+ // "bytes" is actually a TruffleObject denoting a native pointer
+ // TODO: handle encoding properly
+ return CharSXPWrapper.create(TruffleNFI_Utils.convertCstring(bytes, len));
+ }
+
+ @Override
+ public Object INTEGER(Object x) {
+ long arrayAddress = TruffleNFI_NativeArray.findArray(x);
+ if (arrayAddress == 0) {
+ Object array = super.INTEGER(x);
+ arrayAddress = TruffleNFI_NativeArray.recordArray(x, array, SEXPTYPE.INTSXP);
+ } else {
+ TruffleNFI_Call.returnArrayExisting(SEXPTYPE.INTSXP, arrayAddress);
+ }
+ return x;
+ }
+
+ @Override
+ public Object LOGICAL(Object x) {
+ long arrayAddress = TruffleNFI_NativeArray.findArray(x);
+ if (arrayAddress == 0) {
+ Object array = super.LOGICAL(x);
+ arrayAddress = TruffleNFI_NativeArray.recordArray(x, array, SEXPTYPE.LGLSXP);
+ } else {
+ TruffleNFI_Call.returnArrayExisting(SEXPTYPE.LGLSXP, arrayAddress);
+ }
+ return x;
+
+ }
+
+ @Override
+ public Object REAL(Object x) {
+ long arrayAddress = TruffleNFI_NativeArray.findArray(x);
+ if (arrayAddress == 0) {
+ Object array = super.LOGICAL(x);
+ arrayAddress = TruffleNFI_NativeArray.recordArray(x, array, SEXPTYPE.REALSXP);
+ } else {
+ TruffleNFI_Call.returnArrayExisting(SEXPTYPE.REALSXP, arrayAddress);
+ }
+ return x;
+
+ }
+
+ @Override
+ public Object RAW(Object x) {
+ long arrayAddress = TruffleNFI_NativeArray.findArray(x);
+ if (arrayAddress == 0) {
+ Object array = super.LOGICAL(x);
+ arrayAddress = TruffleNFI_NativeArray.recordArray(x, array, SEXPTYPE.RAWSXP);
+ } else {
+ TruffleNFI_Call.returnArrayExisting(SEXPTYPE.RAWSXP, arrayAddress);
+ }
+ return x;
+ }
+
+ @Override
+ public Object R_CHAR(Object x) {
+ long arrayAddress = TruffleNFI_NativeArray.findArray(x);
+ if (arrayAddress == 0) {
+ CharSXPWrapper charSXP = (CharSXPWrapper) x;
+ Object array = charSXP.getContents().getBytes();
+ arrayAddress = TruffleNFI_NativeArray.recordArray(x, array, SEXPTYPE.CHARSXP);
+ } else {
+ TruffleNFI_Call.returnArrayExisting(SEXPTYPE.CHARSXP, arrayAddress);
+ }
+ return x;
+ }
+
+}
diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_UserRng.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_UserRng.java
new file mode 100644
index 0000000000..e94994edaf
--- /dev/null
+++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_UserRng.java
@@ -0,0 +1,124 @@
+/*
+ * Copyright (c) 2017, 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.
+ */
+package com.oracle.truffle.r.engine.interop.ffi.nfi;
+
+import com.oracle.truffle.api.interop.ForeignAccess;
+import com.oracle.truffle.api.interop.Message;
+import com.oracle.truffle.api.interop.TruffleObject;
+import com.oracle.truffle.api.nodes.Node;
+import com.oracle.truffle.r.runtime.RInternalError;
+import com.oracle.truffle.r.runtime.ffi.UserRngRFFI;
+import com.oracle.truffle.r.runtime.rng.user.UserRNG.Function;
+
+public class TruffleNFI_UserRng implements UserRngRFFI {
+
+ private static class NFIUserRngRFFINode extends UserRngRFFINode {
+ Node initMessage;
+ Node randMessage;
+ Node nSeedMessage;
+ Node seedsMessage;
+ Node readPointerNode = Message.createExecute(1).createNode();
+
+ TruffleObject initFunction;
+ TruffleObject nSeedFunction;
+ TruffleObject randFunction;
+ TruffleObject seedsFunction;
+
+ @Override
+ public void init(int seed) {
+ if (initMessage == null) {
+ initMessage = Message.createExecute(1).createNode();
+ }
+ try {
+ if (initFunction == null) {
+ Node bind = Message.createInvoke(1).createNode();
+ initFunction = (TruffleObject) ForeignAccess.sendInvoke(bind, Function.Init.getSymbolHandle().asTruffleObject(), "bind", "(sint32): void");
+ }
+ ForeignAccess.sendExecute(initMessage, initFunction, seed);
+ } catch (Throwable t) {
+ throw RInternalError.shouldNotReachHere();
+ }
+ }
+
+ @Override
+ public double rand() {
+ if (randMessage == null) {
+ randMessage = Message.createExecute(0).createNode();
+ }
+ try {
+ if (randFunction == null) {
+ Node bind = Message.createInvoke(1).createNode();
+ randFunction = (TruffleObject) ForeignAccess.sendInvoke(bind, Function.Rand.getSymbolHandle().asTruffleObject(), "bind", "(): pointer");
+ }
+ Object address = ForeignAccess.sendExecute(randMessage, randFunction);
+ Object value = ForeignAccess.sendExecute(readPointerNode, TruffleNFI_CAccess.Function.READ_POINTER_DOUBLE.getSymbolFunction(), address);
+ return (double) value;
+ } catch (Throwable t) {
+ throw RInternalError.shouldNotReachHere();
+ }
+ }
+
+ @Override
+ public int nSeed() {
+ if (nSeedMessage == null) {
+ nSeedMessage = Message.createExecute(0).createNode();
+ }
+ try {
+ if (nSeedFunction == null) {
+ Node bind = Message.createInvoke(1).createNode();
+ nSeedFunction = (TruffleObject) ForeignAccess.sendInvoke(bind, Function.NSeed.getSymbolHandle().asTruffleObject(), "bind", "(): pointer");
+ }
+ Object address = ForeignAccess.sendExecute(nSeedMessage, nSeedFunction);
+ Object n = ForeignAccess.sendExecute(readPointerNode, TruffleNFI_CAccess.Function.READ_POINTER_INT.getSymbolFunction(), address);
+ return (int) n;
+ } catch (Throwable t) {
+ throw RInternalError.shouldNotReachHere();
+ }
+ }
+
+ @Override
+ public void seeds(int[] n) {
+ if (seedsMessage == null) {
+ seedsMessage = Message.createExecute(0).createNode();
+ }
+ try {
+ if (seedsFunction == null) {
+ Node bind = Message.createInvoke(1).createNode();
+ seedsFunction = (TruffleObject) ForeignAccess.sendInvoke(bind, Function.Seedloc.getSymbolHandle().asTruffleObject(), "bind", "(): pointer");
+ }
+ Object address = ForeignAccess.sendExecute(seedsMessage, seedsFunction);
+ for (int i = 0; i < n.length; i++) {
+ Object seed = ForeignAccess.sendExecute(readPointerNode, TruffleNFI_CAccess.Function.READ_ARRAY_INT.getSymbolFunction(), address, i);
+ n[i] = (int) seed;
+ }
+ } catch (Throwable t) {
+ throw RInternalError.shouldNotReachHere();
+ }
+ }
+ }
+
+ @Override
+ public UserRngRFFINode createUserRngRFFINode() {
+ return new NFIUserRngRFFINode();
+ }
+}
diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Utils.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Utils.java
new file mode 100644
index 0000000000..df1edddf96
--- /dev/null
+++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Utils.java
@@ -0,0 +1,119 @@
+/*
+ * 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.
+ */
+package com.oracle.truffle.r.engine.interop.ffi.nfi;
+
+import java.nio.charset.StandardCharsets;
+
+import com.oracle.truffle.api.interop.ForeignAccess;
+import com.oracle.truffle.api.interop.InteropException;
+import com.oracle.truffle.api.interop.Message;
+import com.oracle.truffle.api.interop.TruffleObject;
+import com.oracle.truffle.api.interop.UnsupportedMessageException;
+import com.oracle.truffle.api.source.Source;
+import com.oracle.truffle.api.vm.PolyglotEngine;
+import com.oracle.truffle.r.engine.interop.UnsafeAdapter;
+import com.oracle.truffle.r.runtime.RInternalError;
+import com.oracle.truffle.r.runtime.context.RContext;
+import com.oracle.truffle.r.runtime.ffi.DLL;
+
+public class TruffleNFI_Utils {
+
+ private static String getString(long address, int len) {
+ byte[] byteArray = new byte[len];
+ for (int i = 0; i < len; i++) {
+ byteArray[i] = UnsafeAdapter.UNSAFE.getByte(address + i);
+ }
+ return new String(byteArray, StandardCharsets.UTF_8);
+ }
+
+ static String convertCstring(Object cstring, int len) {
+ try {
+ long address = (long) ForeignAccess.sendUnbox(Message.UNBOX.createNode(), (TruffleObject) cstring);
+ return getString(address, len);
+ } catch (UnsupportedMessageException ex) {
+ throw RInternalError.shouldNotReachHere(ex);
+ }
+ }
+
+ private static TruffleObject defaultLibrary;
+
+ private static void initDefaultLibrary() {
+ if (defaultLibrary == null) {
+ PolyglotEngine engine = RContext.getInstance().getVM();
+ defaultLibrary = engine.eval(Source.newBuilder("default").name("(load default)").mimeType("application/x-native").build()).as(TruffleObject.class);
+ }
+
+ }
+
+ /**
+ * Looks up the symbol {@code name} in either the "default" library (e.g. C library symbols) or
+ * in one of the libraries loaded through {@link DLL}, and binds the given NFI signature to the
+ * result, returning the resulting Truffle function object. Failure is fatal.
+ */
+ static TruffleObject lookupAndBind(String name, boolean inDefaultLibrary, String signature) {
+ initDefaultLibrary();
+ try {
+ TruffleObject symbol;
+ if (inDefaultLibrary) {
+ symbol = ((TruffleObject) ForeignAccess.sendRead(Message.READ.createNode(), defaultLibrary, name));
+ } else {
+ symbol = DLL.findSymbol(name, null).asTruffleObject();
+ }
+ return (TruffleObject) ForeignAccess.sendInvoke(Message.createInvoke(1).createNode(), symbol, "bind", signature);
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+
+ /**
+ * Returns the number of arguments in an NFI signature.
+ */
+ static int getArgCount(String signature) {
+ int argCount = 0;
+ int nestCount = -1;
+ boolean type = false;
+ for (int i = 0; i < signature.length(); i++) {
+ char ch = signature.charAt(i);
+ if (ch == '(') {
+ nestCount++;
+ } else if (ch == ')') {
+ if (nestCount > 0) {
+ nestCount--;
+ } else {
+ return type ? argCount + 1 : 0;
+ }
+ } else if (ch == ',') {
+ if (nestCount == 0) {
+ argCount++;
+ }
+ } else {
+ type = true;
+ }
+ }
+ throw RInternalError.shouldNotReachHere();
+ }
+
+ public static void main(String[] args) {
+ System.out.printf("argCount: %s%n", getArgCount(args[0]));
+ }
+}
diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Zip.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Zip.java
new file mode 100644
index 0000000000..957b88ea24
--- /dev/null
+++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/nfi/TruffleNFI_Zip.java
@@ -0,0 +1,103 @@
+/*
+ * 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.
+ */
+package com.oracle.truffle.r.engine.interop.ffi.nfi;
+
+import com.oracle.truffle.api.interop.ForeignAccess;
+import com.oracle.truffle.api.interop.InteropException;
+import com.oracle.truffle.api.interop.Message;
+import com.oracle.truffle.api.interop.TruffleObject;
+import com.oracle.truffle.api.interop.java.JavaInterop;
+import com.oracle.truffle.api.nodes.Node;
+import com.oracle.truffle.r.runtime.RInternalError;
+import com.oracle.truffle.r.runtime.ffi.ZipRFFI;
+
+public class TruffleNFI_Zip implements ZipRFFI {
+
+ private enum Function {
+ compress("([uint8], [uint64], [uint8], uint64): sint32"),
+ uncompress("([uint8], [uint64], [uint8], uint64): sint32");
+
+ private final int argCount;
+ private final String signature;
+ private Node executeNode;
+ private TruffleObject function;
+
+ Function(String signature) {
+ this.argCount = TruffleNFI_Utils.getArgCount(signature);
+ this.signature = signature;
+ }
+
+ private void initialize() {
+ if (executeNode == null) {
+ executeNode = Message.createExecute(argCount).createNode();
+ }
+ if (function == null) {
+ function = TruffleNFI_Utils.lookupAndBind(name(), true, signature);
+ }
+ }
+ }
+
+ private static class TruffleNFI_CompressNode extends ZipRFFI.CompressNode {
+
+ @Override
+ public int execute(byte[] dest, byte[] source) {
+ Function.compress.initialize();
+ long[] destlen = new long[]{dest.length};
+ try {
+ int result = (int) ForeignAccess.sendExecute(Function.compress.executeNode, Function.compress.function,
+ JavaInterop.asTruffleObject(dest), JavaInterop.asTruffleObject(destlen),
+ JavaInterop.asTruffleObject(source), JavaInterop.asTruffleObject(source.length));
+ return result;
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+ }
+
+ private static class TruffleNFI_UncompressNode extends ZipRFFI.UncompressNode {
+ @Override
+ public int execute(byte[] dest, byte[] source) {
+ Function.uncompress.initialize();
+ long[] destlen = new long[]{dest.length};
+ try {
+ int result = (int) ForeignAccess.sendExecute(Function.uncompress.executeNode, Function.uncompress.function,
+ JavaInterop.asTruffleObject(dest), JavaInterop.asTruffleObject(destlen),
+ JavaInterop.asTruffleObject(source), JavaInterop.asTruffleObject(source.length));
+ return result;
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere(e);
+ }
+ }
+ }
+
+ @Override
+ public CompressNode createCompressNode() {
+ return new TruffleNFI_CompressNode();
+ }
+
+ @Override
+ public UncompressNode createUncompressNode() {
+ return new TruffleNFI_UncompressNode();
+ }
+
+}
diff --git a/com.oracle.truffle.r.native/Makefile b/com.oracle.truffle.r.native/Makefile
index 37ea9afada..fae4e67969 100644
--- a/com.oracle.truffle.r.native/Makefile
+++ b/com.oracle.truffle.r.native/Makefile
@@ -30,6 +30,10 @@ export FASTR_NATIVE_DIR = $(TOPDIR)
export R_VERSION = $(subst R-,,$(notdir $(basename $(basename $(wildcard $(FASTR_R_HOME)/libdownloads/R-*.gz)))))
export GNUR_HOME = $(TOPDIR)/gnur/R-$(R_VERSION)
+ifndef FASTR_RFFI
+export FASTR_RFFI = jni
+endif
+
# Completely accurate dependency analysis is very difficult for this project, so use a version number
# to force a clean build, and elsewhere use sentinels to avoid rebuilding when we can't compute the
# dependencies accurately.
diff --git a/com.oracle.truffle.r.native/fficall/Makefile b/com.oracle.truffle.r.native/fficall/Makefile
index 78b1f4b0c3..47d879c4c0 100644
--- a/com.oracle.truffle.r.native/fficall/Makefile
+++ b/com.oracle.truffle.r.native/fficall/Makefile
@@ -39,9 +39,8 @@ R_LIBNAME := libR$(DYLIB_EXT)
R_LIB := $(FASTR_LIB_DIR)/$(R_LIBNAME)
JNIBOOT_LIBNAME := libjniboot$(DYLIB_EXT)
JNIBOOT_LIB := $(FASTR_LIB_DIR)/$(JNIBOOT_LIBNAME)
-
-FASTR_COMPILERS_DIR := $(FASTR_R_HOME)/mx.fastr/compilers
-HAVE_SULONG := $(shell $(FASTR_COMPILERS_DIR)/have_sulong)
+CACCESS_LIBNAME := libcaccess$(DYLIB_EXT)
+CACCESS_LIB := $(FASTR_LIB_DIR)/$(CACCESS_LIBNAME)
ifeq ($(OS_NAME), Darwin)
VERSION_FLAGS := -current_version $(R_VERSION) -compatibility_version $(R_VERSION)
@@ -50,13 +49,13 @@ endif
BLAS_TARGET := $(FASTR_LIB_DIR)/libRblas$(DYLIB_EXT)
LAPACK_TARGET := $(FASTR_LIB_DIR)/libRlapack$(DYLIB_EXT)
-all: $(R_LIB) $(JNIBOOT_LIB)
+all: $(R_LIB)
# use sentinels to avoid (usually unnecessary) rebuilds.
# N.B. if things change in the subdirs, a clean must be invoked
# to remove the sentinels
-$(R_LIB): jni.done
+$(R_LIB): fficall.done
ifeq ($(OS_NAME),Darwin)
$(DYLIB_LD) $(DYLIB_LDFLAGS) -Wl,-rpath,@loader_path/ -o $(R_LIB) $(wildcard lib/*.o) -L$(FASTR_LIB_DIR) -lRblas -lRlapack -lpcre -lz $(VERSION_FLAGS)
install_name_tool -change libRblas.dylib @rpath/libRblas.dylib $(R_LIB)
@@ -68,31 +67,58 @@ else
$(DYLIB_LD) $(DYLIB_LDFLAGS) $(shell echo $(PKG_LDFLAGS_OVERRIDE)) -Wl,-rpath,'$$ORIGIN' -o $(R_LIB) $(wildcard lib/*.o) -L$(FASTR_LIB_DIR) -lRblas -lRlapack -lpcre -lz
endif
-jni.done:
- $(MAKE) -C src/common all
- $(MAKE) -C src/jni all
-ifeq ($(HAVE_SULONG),yes)
+ifeq ($(FASTR_RFFI),nfi)
+fficall.done: common.done
+ $(MAKE) -C src/truffle_nfi all
+ touch fficall.done
+else
+ifeq ($(FASTR_RFFI),llvm)
+fficall.done: common.done
$(MAKE) -C src/truffle_llvm all
-endif
- touch jni.done
+ touch fficall.done
+else
+ifeq ($(FASTR_RFFI),jni)
+fficall.done: common.done $(JNIBOOT_LIB)
+ $(MAKE) -C src/jni all
+
+jniboot.done:
+ $(MAKE) -C src/jniboot all
+ touch jniboot.done
$(JNIBOOT_LIB): jniboot.done
$(DYLIB_LD) $(DYLIB_LDFLAGS) -o $(JNIBOOT_LIB) src/jniboot/jniboot.o $(VERSION_FLAGS)
ifeq ($(OS_NAME),Darwin)
install_name_tool -id @rpath/libjniboot.dylib $(JNIBOOT_LIB)
endif
+else
+ $(error unknown value for FASTR_RFFI)
+endif
+ touch fficall.done
+endif
+endif
-jniboot.done:
- $(MAKE) -C src/jniboot all
- touch jniboot.done
+common.done:
+ $(MAKE) -C src/common all
+
+$(CACCESS_LIB): src/caccess/caccess.o
+ $(DYLIB_LD) $(DYLIB_LDFLAGS) -o $(CACCESS_LIB) src/caccess/caccess.o $(VERSION_FLAGS)
+ifeq ($(OS_NAME),Darwin)
+ install_name_tool -id @rpath/libcaccess.dylib $(CACCESS_LIB)
+endif
clean:
$(MAKE) -C src/common clean
- $(MAKE) -C src/jni clean
-ifeq ($(HAVE_SULONG),yes)
+ifeq ($(FASTR_RFFI),nfi)
+ $(MAKE) -C src/truffle_nfi clean
+else
+ifeq ($(FASTR_RFFI),llvm)
$(MAKE) -C src/truffle_llvm clean
+else
+ $(MAKE) -C src/jni clean
+endif
endif
rm -rf $(R_LIB)
rm -rf $(JNIBOOT_LIB)
- rm -rf jni.done jniboot.done
+ rm -rf $(CACCESS_LIB)
+ rm -rf fficall.done
diff --git a/com.oracle.truffle.r.native/fficall/src/caccess/Makefile b/com.oracle.truffle.r.native/fficall/src/caccess/Makefile
new file mode 100644
index 0000000000..de9823908e
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/src/caccess/Makefile
@@ -0,0 +1,34 @@
+#
+# Copyright (c) 2016, 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.
+#
+
+ifneq ($(MAKECMDGOALS),clean)
+include $(TOPDIR)/platform.mk
+endif
+
+
+.PHONY: all
+
+all: caccess.o
+
+caccess.o: caccess.c
+ $(CC) $(CFLAGS) -c caccess.c -o $@
diff --git a/com.oracle.truffle.r.native/fficall/src/caccess/caccess.c b/com.oracle.truffle.r.native/fficall/src/caccess/caccess.c
new file mode 100644
index 0000000000..6743e91b48
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/src/caccess/caccess.c
@@ -0,0 +1,38 @@
+/*
+ * Copyright (c) 2016, 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.
+ */
+
+int caccess_read_pointer_int(int *address) {
+ return *address;
+}
+
+double caccess_read_pointer_double(double *address) {
+ return *address;
+}
+
+int caccess_read_array_int(int *address, int index) {
+ return address[index];
+}
+
+double caccess_read_array_double(double *address, int index) {
+ return address[index];
+}
diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Makefile b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Makefile
new file mode 100644
index 0000000000..ce8e60537b
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Makefile
@@ -0,0 +1,63 @@
+#
+# 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.
+#
+
+ifneq ($(MAKECMDGOALS),clean)
+include $(TOPDIR)/platform.mk
+endif
+
+.PHONY: all clean
+
+# location of compiled code (.o files)
+OBJ = ../../lib
+
+C_HDRS := $(wildcard *.h)
+
+C_SOURCES = $(wildcard *.c)
+C_OBJECTS := $(patsubst %.c,$(OBJ)/%.o,$(C_SOURCES))
+#$(info C_OBJECTS=$(C_OBJECTS))
+
+FFI_INCLUDES = -I$(TOPDIR)/include -I$(TOPDIR)/include/R_ext
+#NFI_INCLUDES is set in environment (by mx)
+LOCAL_INCLUDES = -I . -I $(abspath ../include)
+
+INCLUDES := $(LOCAL_INCLUDES) $(FFI_INCLUDES) $(NFI_INCLUDES)
+
+# uncomment to see exactly where headers are being read from
+#CFLAGS := $(CFLAGS) -H
+
+all: Makefile $(C_OBJECTS)
+
+$(C_OBJECTS): | $(OBJ)
+
+$(OBJ):
+ mkdir -p $(OBJ)
+
+$(OBJ)/%.o: %.c $(TOPDIR)/include/Rinternals.h $(C_HDRS)
+ $(CC) $(CFLAGS) $(INCLUDES) -I../variable_defs -c $< -o $@
+
+# for debugging, to see what's really being compiled
+$(OBJ)/%.E: %.c $(TOPDIR)/include/Rinternals.h
+ $(CC) -E $(CFLAGS) $(INCLUDES) -c $< > $@
+
+clean:
+ rm -rf $(OBJ)
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
new file mode 100644
index 0000000000..a12d66c3cf
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Memory.c
@@ -0,0 +1,123 @@
+/*
+ * 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, 2017, Oracle and/or its affiliates
+ *
+ * All rights reserved.
+ */
+#include <rffiutils.h>
+#include <stdlib.h>
+#include <string.h>
+
+#define T_MEM_TABLE_INITIAL_SIZE 0
+// The table of transient objects that have been allocated dur the current FFI call
+static void **tMemTable;
+// hwm of tMemTable
+static int tMemTableIndex;
+static int tMemTableLength;
+
+void init_memory() {
+ tMemTable = malloc(sizeof(void*) * T_MEM_TABLE_INITIAL_SIZE);
+ tMemTableLength = T_MEM_TABLE_INITIAL_SIZE;
+ tMemTableIndex = 0;
+}
+
+void *R_chk_calloc(size_t nelem, size_t elsize);
+
+// Memory that is auto-reclaimed across FFI calls
+char *R_alloc(size_t n, int size) {
+ void *p = R_chk_calloc(n, size);
+ if (tMemTableIndex >= tMemTableLength) {
+ int newLength = 2 * tMemTableLength;
+ void *newtMemTable = malloc(sizeof(void*) * newLength);
+ if (newtMemTable == NULL) {
+ fatalError("malloc failure");
+ }
+ memcpy(newtMemTable, tMemTable, tMemTableLength * sizeof(void*));
+ free(tMemTable);
+ tMemTable = newtMemTable;
+ tMemTableLength = newLength;
+ }
+ tMemTable[tMemTableIndex] = p;
+ return (char*) p;
+}
+
+char* S_alloc(long n, int size) {
+ char *p = R_alloc(n, size);
+ memset(p, 0, n);
+ return p;
+}
+
+char* S_realloc(char *p, long a, long b, int size) {
+ return unimplemented("S_realloc");
+}
+
+void allocExit() {
+ int i;
+ for (i = 0; i < tMemTableIndex; i++) {
+ free(tMemTable[i]);
+ }
+}
+
+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 *ptr, size_t size) {
+ void *p;
+ /* 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)"),
+ (double) size);
+ return(p);
+}
+
+void R_chk_free(void *ptr) {
+ if(ptr) {
+ free(ptr);
+ }
+}
+
+int VMAX_MAGIC = 1234;
+
+void* vmaxget(void) {
+// unimplemented("vmaxget");
+ // ignored
+ return &VMAX_MAGIC;
+}
+
+void vmaxset(const void * x) {
+// unimplemented("vmaxget");
+ if (x != &VMAX_MAGIC) {
+ unimplemented("vmaxset with different value");
+ }
+}
+
+void R_gc(void) {
+ unimplemented("R_gc");
+}
+
+int R_gc_running() {
+ unimplemented("R_gc_running");
+ return 0;
+}
+
+SEXP Rf_allocS4Object() {
+ unimplemented("Rf_allocS4Object unimplemented");
+ return NULL;
+}
+
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
new file mode 100644
index 0000000000..e9adb555cf
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rdynload_fastr.c
@@ -0,0 +1,134 @@
+/*
+ * 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-2012, The R Core Team
+ * Copyright (c) 2003, The R Foundation
+ * Copyright (c) 2014, 2017, Oracle and/or its affiliates
+ *
+ * All rights reserved.
+ */
+#include <rffiutils.h>
+#include <Rdynload.h>
+#include <stdio.h>
+
+static void (*call_registerRoutines)(DllInfo *dllInfo, int nstOrd, int num, long routines);
+static int (*call_useDynamicSymbols)(DllInfo *dllInfo, Rboolean value);
+static TruffleObject (*call_setDotSymbolValues)(DllInfo *dllInfo, char *name, long fun, int numArgs);
+static int (*call_forceSymbols)(DllInfo *dllInfo, Rboolean value);
+
+#define registerRoutines_x 0
+#define useDynamicSymbols_x 1
+#define setDotSymbolValues_x 2
+#define forceSymbols_x 3
+
+void Rdynload_init(int index, void* closure) {
+ newClosureRef(closure);
+ switch (index) {
+ case registerRoutines_x: call_registerRoutines = closure; break;
+ case useDynamicSymbols_x: call_useDynamicSymbols = closure; break;
+ case setDotSymbolValues_x: call_setDotSymbolValues = closure; break;
+ case forceSymbols_x: call_forceSymbols = closure; break;
+ }
+}
+
+// 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) {
+ int num;
+ if (croutines) {
+ for(num = 0; croutines[num].name != NULL; num++) {;}
+ //printf("R_registerRoutines %p,%d,%d,%p\n", info, C_NATIVE_TYPE, num, croutines);
+ call_registerRoutines(info, C_NATIVE_TYPE, num, (long) croutines);
+ }
+ if (callRoutines) {
+ for(num = 0; callRoutines[num].name != NULL; num++) {;}
+ //printf("R_registerRoutines %p,%d,%d,%p\n", info, CALL_NATIVE_TYPE, num, callRoutines);
+ call_registerRoutines(info, CALL_NATIVE_TYPE, num, (long) callRoutines);
+ }
+ if (fortranRoutines) {
+ for(num = 0; fortranRoutines[num].name != NULL; num++) {;}
+ //printf("R_registerRoutines %p,%p,%d,%d,%p\n", call_registerRoutines, info, FORTRAN_NATIVE_TYPE, num, fortranRoutines);
+ call_registerRoutines(info, FORTRAN_NATIVE_TYPE, num, (long) fortranRoutines);
+ }
+ if (externalRoutines) {
+ for(num = 0; externalRoutines[num].name != NULL; num++) {;}
+ //printf("R_registerRoutines %p,%d,%d,%p\n", info, EXTERNAL_NATIVE_TYPE, num, externalRoutines);
+ call_registerRoutines(info, EXTERNAL_NATIVE_TYPE, num, (long) externalRoutines);
+ }
+ return 1;
+}
+
+Rboolean R_useDynamicSymbols(DllInfo *dllInfo, Rboolean value) {
+ return call_useDynamicSymbols(dllInfo, value);
+}
+
+Rboolean R_forceSymbols(DllInfo *dllInfo, Rboolean value) {
+ return call_forceSymbols(dllInfo, value);
+}
+
+
+
+TruffleObject Rdynload_setSymbol(DllInfo *info, int nstOrd, long routinesAddr, int index) {
+ 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;
+ }
+ }
+ //printf("call_setDotSymbolValues %p, %s, %p, %d\n", info, name, fun, numArgs);
+ TruffleObject result = call_setDotSymbolValues(info, name, fun, numArgs);
+
+ return result;
+}
+
+extern SEXP unimplemented(char *fun);
+
+void R_RegisterCCallable(const char *package, const char *name, DL_FUNC fptr) {
+ // we ignore this for now
+}
+
+DL_FUNC R_GetCCallable(const char *package, const char *name) {
+ return unimplemented("R_GetCCallable");
+}
+
+DL_FUNC R_FindSymbol(char const *name, char const *pkg,
+ R_RegisteredNativeSymbol *symbol) {
+ return unimplemented("R_FindSymbol");
+}
diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rembedded.c b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rembedded.c
new file mode 100644
index 0000000000..c60dc95c6a
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rembedded.c
@@ -0,0 +1,29 @@
+/*
+ * 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 <Rinterface.h>
+#include <rffiutils.h>
+
+char *R_HomeDir(void) {
+ return ((call_R_HomeDir) callbacks[R_HomeDir_x])();
+}
+
diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Riconv.c b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Riconv.c
new file mode 100644
index 0000000000..455826794f
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Riconv.c
@@ -0,0 +1,39 @@
+/*
+ * 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>
+#include <Riconv.h>
+
+void * Riconv_open (const char* tocode, const char* fromcode) {
+ return unimplemented("Riconv_open");
+}
+
+size_t Riconv (void * cd, const char **inbuf, size_t *inbytesleft,
+ char **outbuf, size_t *outbytesleft) {
+ unimplemented("Riconv");
+ return 0;
+}
+
+int Riconv_close (void * cd) {
+ unimplemented("Riconv_close");
+ return 0;
+}
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
new file mode 100644
index 0000000000..026f9f5ba7
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rinternals.c
@@ -0,0 +1,1281 @@
+/*
+ * 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 <Rinterface.h>
+#include <rffiutils.h>
+#include <rffi_callbacks.h>
+
+void *callbacks[CALLBACK_TABLE_SIZE];
+
+void Rinternals_addCallback(int index, void *closure) {
+ newClosureRef(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;
+
+long return_INTEGER_CREATE(int *value, int len) {
+ int* idata = malloc(len * sizeof(int));
+ memcpy(idata, value, len * sizeof(int));
+ return_int = idata;
+ return (long) idata;
+}
+
+long return_DOUBLE_CREATE(double *value, int len) {
+ double* ddata = malloc(len * sizeof(double));
+ memcpy(ddata, value, len * sizeof(double));
+ return_double = ddata;
+ return (long) ddata;
+}
+
+long return_BYTE_CREATE(char *value, int len, int isString) {
+ if (isString) {
+ len += 1;
+ }
+ char* bdata = malloc(len * sizeof(char));
+ memcpy(bdata, value, len * sizeof(char));
+ if (isString) {
+ bdata[len] = 0;
+ }
+ return_byte = bdata;
+ return (long) bdata;
+}
+
+void return_INTEGER_EXISTING(long address) {
+ return_int = (int*) address;
+}
+
+void return_DOUBLE_EXISTING(long address) {
+ return_double = (double*) address;
+}
+
+void return_BYTE_EXISTING(long address) {
+ return_byte = (char*) address;
+}
+
+void return_FREE(void *address) {
+// free(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");
+}
+
+SEXP FASTR_R_BaseEnv() {
+ return ((call_R_BaseEnv) callbacks[R_BaseEnv_x])();
+}
+
+SEXP FASTR_R_BaseNamespace() {
+ return unimplemented("FASTR_R_BaseNamespace");
+}
+
+SEXP FASTR_R_NamespaceRegistry() {
+ return unimplemented("FASTR_R_NamespaceRegistry");
+}
+
+CTXT FASTR_GlobalContext() {
+ return unimplemented("FASTR_GlobalContext");
+}
+
+Rboolean FASTR_R_Interactive() {
+ return (int) unimplemented("FASTR_R_Interactive");
+}
+
+SEXP CAR(SEXP e) {
+ return ((call_CAR) callbacks[CAR_x])(e);
+}
+
+SEXP CDR(SEXP e) {
+ return ((call_CDR) callbacks[CDR_x])(e);
+}
+
+int *INTEGER(SEXP x) {
+ ((call_INTEGER) callbacks[INTEGER_x])(x);
+ return return_int;
+}
+
+int *LOGICAL(SEXP x){
+ ((call_LOGICAL) callbacks[LOGICAL_x])(x);
+ return return_int;
+}
+
+double *REAL(SEXP x){
+ ((call_REAL) callbacks[REAL_x])(x);
+ return return_double;
+}
+
+Rbyte *RAW(SEXP x) {
+ ((call_RAW) callbacks[RAW_x])(x);
+ return return_byte;
+}
+
+int LENGTH(SEXP x) {
+ return ((call_LENGTH) callbacks[LENGTH_x])(x);
+}
+
+const char * R_CHAR(SEXP x) {
+ ((call_R_CHAR) callbacks[R_CHAR_x])(x);
+ return return_byte;
+}
+
+SEXP Rf_ScalarString(SEXP value) {
+ return ((call_Rf_ScalarString) callbacks[Rf_ScalarString_x])(value);
+}
+
+SEXP Rf_mkChar(const char *x) {
+ return Rf_mkCharLenCE(x, strlen(x), CE_NATIVE);
+}
+
+SEXP Rf_mkCharCE(const char *x, cetype_t y) {
+ return Rf_mkCharLenCE(x, strlen(x), y);
+}
+
+SEXP Rf_mkCharLen(const char *x, int y) {
+ return Rf_mkCharLenCE(x, y, CE_NATIVE);
+}
+
+SEXP Rf_mkCharLenCE(const char *x, int len, cetype_t enc) {
+ return ((call_Rf_mkCharLenCE) callbacks[Rf_mkCharLenCE_x])(x,len, enc);
+}
+
+SEXP Rf_mkString(const char *s) {
+ return ScalarString(Rf_mkChar(s));
+}
+
+void Rf_gsetVar(SEXP symbol, SEXP value, SEXP rho) {
+ ((call_Rf_gsetVar) callbacks[Rf_gsetVar_x])(symbol, value, rho);
+}
+
+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);
+}
+
+#define BUFSIZE 8192
+
+static int Rvsnprintf(char *buf, size_t size, const char *format, va_list ap)
+{
+ int val;
+ val = vsnprintf(buf, size, format, ap);
+ buf[size-1] = '\0';
+ return val;
+}
+
+
+void Rf_error(const char *format, ...) {
+ // TODO fix this
+ // This is a bit tricky. The usual error handling model in Java is "throw RError.error(...)" but
+ // RError.error does quite a lot of stuff including potentially searching for R condition handlers
+ // and, if it finds any, does not return, but throws a different exception than RError.
+ // We definitely need to exit the FFI call and we certainly cannot return to our caller.
+ // So we call RFFIUpCallsObject.Rf_error to throw the RError exception. When the pending
+ // exception (whatever it is) is observed by JNI, the call to Rf_error will return where we do a
+ // non-local transfer of control back to the entry point (which will cleanup).
+ char buf[8192];
+ va_list(ap);
+ va_start(ap,format);
+ Rvsnprintf(buf, BUFSIZE - 1, format, ap);
+ va_end(ap);
+ // This will set a pending exception (in JNI)
+ ((call_Rf_error) callbacks[Rf_error_x])(buf);
+ // just transfer back which will cleanup and exit the entire JNI call
+// longjmp(*getErrorJmpBuf(), 1);
+
+}
+
+void Rf_errorcall(SEXP x, const char *format, ...) {
+ unimplemented("Rf_errorcall");
+}
+
+void Rf_warningcall(SEXP x, const char *format, ...) {
+ char buf[8192];
+ va_list(ap);
+ va_start(ap,format);
+ Rvsnprintf(buf, BUFSIZE - 1, format, ap);
+ va_end(ap);
+ ((call_Rf_warningcall) callbacks[Rf_warningcall_x])(x, buf);
+}
+
+void Rf_warning(const char *format, ...) {
+ char buf[8192];
+ va_list(ap);
+ va_start(ap,format);
+ Rvsnprintf(buf, BUFSIZE - 1, format, ap);
+ va_end(ap);
+ ((call_Rf_warning) callbacks[Rf_warning_x])(buf);
+}
+
+void Rprintf(const char *format, ...) {
+ char buf[8192];
+ va_list(ap);
+ va_start(ap,format);
+ Rvsnprintf(buf, BUFSIZE - 1, format, ap);
+ va_end(ap);
+ ((call_Rprintf) callbacks[Rprintf_x])(buf);
+}
+
+/*
+ REprintf is used by the error handler do not add
+ anything unless you're sure it won't
+ cause problems
+*/
+void REprintf(const char *format, ...)
+{
+ // TODO: determine correct target for this message
+ char buf[8192];
+ va_list(ap);
+ va_start(ap,format);
+ Rvsnprintf(buf, BUFSIZE - 1, format, ap);
+ va_end(ap);
+ // TODO
+}
+
+void Rvprintf(const char *format, va_list args) {
+ unimplemented("Rvprintf");
+}
+void REvprintf(const char *format, va_list args) {
+ unimplemented("REvprintf");
+}
+
+
+SEXP Rf_ScalarInteger(int value) {
+ return ((call_Rf_ScalarInteger) callbacks[Rf_ScalarInteger_x])(value);
+}
+
+SEXP Rf_ScalarReal(double value) {
+ return ((call_Rf_ScalarReal) callbacks[Rf_ScalarDouble_x])(value);
+}
+
+SEXP Rf_ScalarLogical(int value) {
+ return ((call_Rf_ScalarLogical) callbacks[Rf_ScalarLogical_x])(value);
+}
+
+SEXP Rf_allocVector3(SEXPTYPE t, R_xlen_t len, R_allocator_t* allocator) {
+ if (allocator != NULL) {
+ unimplemented("RF_allocVector with custom allocator");
+ return NULL;
+ }
+ return ((call_Rf_allocateVector) callbacks[Rf_allocateVector_x])(t, len);
+}
+
+SEXP Rf_allocArray(SEXPTYPE t, SEXP dims) {
+ unimplemented("Rf_allocArray");
+}
+
+SEXP Rf_alloc3DArray(SEXPTYPE t, int x, int y, int z) {
+ return unimplemented("Rf_alloc3DArray");
+}
+
+SEXP Rf_allocMatrix(SEXPTYPE mode, int nrow, int ncol) {
+ unimplemented("Rf_allocMatrix");
+}
+
+SEXP Rf_allocList(int x) {
+ unimplemented("Rf_allocList)");
+ return NULL;
+}
+
+SEXP Rf_allocSExp(SEXPTYPE t) {
+ return unimplemented("Rf_allocSExp");
+}
+
+void Rf_defineVar(SEXP symbol, SEXP value, SEXP rho) {
+ ((call_Rf_defineVar) callbacks[Rf_defineVar_x])(symbol, value, rho);
+}
+
+void Rf_setVar(SEXP x, SEXP y, SEXP z) {
+ unimplemented("Rf_setVar");
+}
+
+SEXP Rf_dimgets(SEXP x, SEXP y) {
+ return unimplemented("Rf_dimgets");
+}
+
+SEXP Rf_dimnamesgets(SEXP x, SEXP y) {
+ return unimplemented("Rf_dimnamesgets");
+}
+
+SEXP Rf_eval(SEXP expr, SEXP env) {
+ return unimplemented("Rf_eval");
+}
+
+SEXP Rf_findFun(SEXP symbol, SEXP rho) {
+ return unimplemented("Rf_findFun");
+}
+
+SEXP Rf_findVar(SEXP sym, SEXP rho) {
+ return ((call_Rf_findVar) callbacks[Rf_findVar_x])(sym, rho);
+}
+
+SEXP Rf_findVarInFrame(SEXP rho, SEXP sym) {
+ return unimplemented("Rf_findVarInFrame");
+}
+
+SEXP Rf_findVarInFrame3(SEXP rho, SEXP sym, Rboolean b) {
+ return unimplemented("Rf_findVarInFrame");
+}
+
+SEXP Rf_getAttrib(SEXP vec, SEXP name) {
+ SEXP result = ((call_Rf_getAttrib) callbacks[Rf_getAttrib_x])(vec, name);
+// printf("Rf_getAttrib: %p\n", result);
+ return result;
+}
+
+SEXP Rf_setAttrib(SEXP vec, SEXP name, SEXP val) {
+ return ((call_Rf_setAttrib) callbacks[Rf_setAttrib_x])(vec, name, val);
+}
+
+SEXP Rf_duplicate(SEXP x) {
+ return unimplemented("Rf_duplicate");
+}
+
+SEXP Rf_shallow_duplicate(SEXP x) {
+ return unimplemented("Rf_shallow_duplicate");
+}
+
+R_xlen_t Rf_any_duplicated(SEXP x, Rboolean from_last) {
+ return (R_xlen_t) unimplemented("Rf_any_duplicated");
+}
+
+SEXP Rf_duplicated(SEXP x, Rboolean y) {
+ unimplemented("Rf_duplicated");
+ return NULL;
+}
+
+SEXP Rf_applyClosure(SEXP x, SEXP y, SEXP z, SEXP a, SEXP b) {
+ return unimplemented("Rf_applyClosure");
+}
+
+void Rf_copyMostAttrib(SEXP x, SEXP y) {
+ unimplemented("Rf_copyMostAttrib");
+}
+
+void Rf_copyVector(SEXP x, SEXP y) {
+ unimplemented("Rf_copyVector");
+}
+
+int Rf_countContexts(int x, int y) {
+ return (int) unimplemented("Rf_countContexts");
+}
+
+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;
+}
+
+Rboolean Rf_isObject(SEXP s) {
+ unimplemented("Rf_isObject");
+ return FALSE;
+}
+
+void Rf_PrintValue(SEXP x) {
+ unimplemented("Rf_PrintValue");
+}
+
+SEXP Rf_install(const char *name) {
+ ((call_Rf_install) callbacks[Rf_install_x])(name);
+}
+
+SEXP Rf_installChar(SEXP charsxp) {
+ return ((call_Rf_installChar) callbacks[Rf_installChar_x])(charsxp);
+}
+
+Rboolean Rf_isNull(SEXP s) {
+ return (Rboolean) ((call_Rf_isNull) callbacks[Rf_isNull_x])(s);
+}
+
+Rboolean Rf_isString(SEXP s) {
+ return (Rboolean) ((call_Rf_isString) callbacks[Rf_isString_x])(s);
+}
+
+Rboolean R_cycle_detected(SEXP s, SEXP child) {
+ unimplemented("R_cycle_detected");
+ return 0;
+}
+
+cetype_t Rf_getCharCE(SEXP x) {
+ // unimplemented("Rf_getCharCE");
+ // TODO: real implementation
+ return CE_NATIVE;
+}
+
+const char *Rf_reEnc(const char *x, cetype_t ce_in, cetype_t ce_out, int subst) {
+ // TODO proper implementation
+ return x;
+}
+
+int Rf_ncols(SEXP x) {
+ return (int) unimplemented("Rf_ncols");
+}
+
+int Rf_nrows(SEXP x) {
+ return (int) unimplemented("Rf_nrows");
+}
+
+
+void R_ProtectWithIndex(SEXP x, PROTECT_INDEX *y) {
+ //
+}
+
+void R_Reprotect(SEXP x, PROTECT_INDEX y) {
+ //
+}
+
+
+void Rf_unprotect_ptr(SEXP x) {
+ //
+}
+
+
+void R_FlushConsole(void) {
+ // ignored
+}
+
+void R_ProcessEvents(void) {
+ unimplemented("R_ProcessEvents");
+}
+
+// Tools package support, not in public API
+SEXP R_NewHashedEnv(SEXP parent, SEXP size) {
+ return ((call_R_NewHashedEnv) callbacks[R_NewHashedEnv_x])(parent, size);
+}
+
+SEXP Rf_classgets(SEXP vec, SEXP klass) {
+ return unimplemented("Rf_classgets");
+}
+
+const char *Rf_translateChar(SEXP x) {
+ // TODO: proper implementation
+ const char *result = CHAR(x);
+ return result;
+}
+
+const char *Rf_translateChar0(SEXP x) {
+ // TODO: proper implementation
+ const char *result = CHAR(x);
+ return result;
+}
+
+const char *Rf_translateCharUTF8(SEXP x) {
+ // TODO: proper implementation
+ const char *result = CHAR(x);
+ return result;
+}
+
+SEXP Rf_lengthgets(SEXP x, R_len_t y) {
+ return unimplemented("Rf_lengthgets");
+}
+
+SEXP Rf_xlengthgets(SEXP x, R_xlen_t y) {
+ return unimplemented("Rf_xlengthgets");
+}
+
+SEXP R_lsInternal(SEXP env, Rboolean all) {
+ return R_lsInternal3(env, all, TRUE);
+}
+
+SEXP R_lsInternal3(SEXP env, Rboolean all, Rboolean sorted) {
+ return unimplemented("R_lsInternal3");
+}
+
+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");
+}
+
+
+SEXP CAAR(SEXP e) {
+ unimplemented("CAAR");
+ return NULL;
+}
+
+SEXP CDAR(SEXP e) {
+ unimplemented("CDAR");
+ return NULL;
+}
+
+SEXP CADR(SEXP e) {
+ return ((call_CADR) callbacks[CADR_x])(e);
+}
+
+SEXP CDDR(SEXP e) {
+ return ((call_CDDR) callbacks[CDDR_x])(e);
+}
+
+SEXP CDDDR(SEXP e) {
+ unimplemented("CDDDR");
+ return NULL;
+}
+
+SEXP CADDR(SEXP e) {
+ return unimplemented("CADDR");
+}
+
+SEXP CADDDR(SEXP e) {
+ unimplemented("CADDDR");
+ return NULL;
+}
+
+SEXP CAD4R(SEXP e) {
+ unimplemented("CAD4R");
+ return NULL;
+}
+
+int MISSING(SEXP x){
+ unimplemented("MISSING");
+ return 0;
+}
+
+void SET_MISSING(SEXP x, int v) {
+ unimplemented("SET_MISSING");
+}
+
+void SET_TAG(SEXP x, SEXP y) {
+ ((call_SET_TAG) callbacks[SET_TAG_x])(x, y);
+}
+
+SEXP SETCAR(SEXP x, SEXP y) {
+ return ((call_SETCAR) callbacks[SETCAR_x])(x, y);
+}
+
+SEXP SETCDR(SEXP x, SEXP y) {
+ return ((call_SETCDR) callbacks[SETCDR_x])(x, y);
+}
+
+SEXP SETCADR(SEXP x, SEXP y) {
+ return unimplemented("SETCADR");
+}
+
+SEXP SETCADDR(SEXP x, SEXP y) {
+ unimplemented("SETCADDR");
+ return NULL;
+}
+
+SEXP SETCADDDR(SEXP x, SEXP y) {
+ unimplemented("SETCADDDR");
+ return NULL;
+}
+
+SEXP SETCAD4R(SEXP e, SEXP y) {
+ unimplemented("SETCAD4R");
+ return NULL;
+}
+
+SEXP FORMALS(SEXP x) {
+ return unimplemented("FORMALS");
+}
+
+SEXP BODY(SEXP x) {
+ return unimplemented("BODY");
+}
+
+SEXP CLOENV(SEXP x) {
+ return unimplemented("CLOENV");
+}
+
+int RDEBUG(SEXP x) {
+ unimplemented("RDEBUG");
+}
+
+int RSTEP(SEXP x) {
+ unimplemented("RSTEP");
+}
+
+int RTRACE(SEXP x) {
+ unimplemented("RTRACE");
+ return 0;
+}
+
+void SET_RDEBUG(SEXP x, int v) {
+ unimplemented("SET_RDEBUG");
+}
+
+void SET_RSTEP(SEXP x, int v) {
+ unimplemented("SET_RSTEP");
+}
+
+void SET_RTRACE(SEXP x, int v) {
+ unimplemented("SET_RTRACE");
+}
+
+void SET_FORMALS(SEXP x, SEXP v) {
+ unimplemented("SET_FORMALS");
+}
+
+void SET_BODY(SEXP x, SEXP v) {
+ unimplemented("SET_BODY");
+}
+
+void SET_CLOENV(SEXP x, SEXP v) {
+ unimplemented("SET_CLOENV");
+}
+
+SEXP SYMVALUE(SEXP x) {
+ return unimplemented("SYMVALUE");
+}
+
+SEXP INTERNAL(SEXP x) {
+ return unimplemented("INTERNAL");
+}
+
+int DDVAL(SEXP x) {
+ unimplemented("DDVAL");
+ return 0;
+}
+
+void SET_DDVAL(SEXP x, int v) {
+ unimplemented("SET_DDVAL");
+}
+
+void SET_SYMVALUE(SEXP x, SEXP v) {
+ unimplemented("SET_SYMVALUE");
+}
+
+void SET_INTERNAL(SEXP x, SEXP v) {
+ unimplemented("SET_INTERNAL");
+}
+
+SEXP FRAME(SEXP x) {
+ return unimplemented("FRAME");
+}
+
+SEXP ENCLOS(SEXP x) {
+ return unimplemented("ENCLOS");
+}
+
+SEXP HASHTAB(SEXP x) {
+ return unimplemented("HASHTAB");
+}
+
+int ENVFLAGS(SEXP x) {
+ unimplemented("ENVFLAGS");
+ return 0;
+}
+
+void SET_ENVFLAGS(SEXP x, int v) {
+ unimplemented("SET_ENVFLAGS");
+}
+
+void SET_FRAME(SEXP x, SEXP v) {
+ unimplemented("SET_FRAME");
+}
+
+void SET_ENCLOS(SEXP x, SEXP v) {
+ unimplemented("SET_ENCLOS");
+}
+
+void SET_HASHTAB(SEXP x, SEXP v) {
+ unimplemented("SET_HASHTAB");
+}
+
+SEXP PRCODE(SEXP x) {
+ return unimplemented("PRCODE");
+}
+
+SEXP PRENV(SEXP x) {
+ return unimplemented("PRENV");
+}
+
+SEXP PRVALUE(SEXP x) {
+ return unimplemented("PRVALUE");
+}
+
+int PRSEEN(SEXP x) {
+ return (int) unimplemented("PRSEEN");
+}
+
+void SET_PRSEEN(SEXP x, int v) {
+ unimplemented("SET_PRSEEN");
+}
+
+void SET_PRENV(SEXP x, SEXP v) {
+ unimplemented("SET_PRENV");
+}
+
+void SET_PRVALUE(SEXP x, SEXP v) {
+ unimplemented("SET_PRVALUE");
+}
+
+void SET_PRCODE(SEXP x, SEXP v) {
+ unimplemented("SET_PRCODE");
+}
+
+int TRUELENGTH(SEXP x){
+ unimplemented("unimplemented");
+ return 0;
+}
+
+
+void SETLENGTH(SEXP x, int v){
+ unimplemented("SETLENGTH");
+}
+
+
+void SET_TRUELENGTH(SEXP x, int v){
+ unimplemented("SET_TRUELENGTH");
+}
+
+
+R_xlen_t XLENGTH(SEXP x){
+ // xlength seems to be used for long vectors (no such thing in FastR at the moment)
+ return LENGTH(x);
+}
+
+
+R_xlen_t XTRUELENGTH(SEXP x){
+ unimplemented("XTRUELENGTH");
+ return 0;
+}
+
+
+int IS_LONG_VEC(SEXP x){
+ unimplemented("IS_LONG_VEC");
+ return 0;
+}
+
+
+int LEVELS(SEXP x){
+ unimplemented("LEVELS");
+ return 0;
+}
+
+
+int SETLEVELS(SEXP x, int v){
+ unimplemented("SETLEVELS");
+ return 0;
+}
+
+Rcomplex *COMPLEX(SEXP x){
+ unimplemented("COMPLEX");
+ return NULL;
+}
+
+SEXP STRING_ELT(SEXP x, R_xlen_t i) {
+ return ((call_STRING_ELT) callbacks[STRING_ELT_x])(x, i);
+}
+
+
+SEXP VECTOR_ELT(SEXP x, R_xlen_t i){
+ return ((call_VECTOR_ELT) callbacks[VECTOR_ELT_x])(x, i);
+}
+
+void SET_STRING_ELT(SEXP x, R_xlen_t i, SEXP v){
+ ((call_SET_STRING_ELT) callbacks[SET_STRING_ELT_x])(x, i, v);
+}
+
+
+SEXP SET_VECTOR_ELT(SEXP x, R_xlen_t i, SEXP v){
+ return ((call_SET_VECTOR_ELT) callbacks[SET_VECTOR_ELT_x])(x, i, v);
+}
+
+SEXP *STRING_PTR(SEXP x){
+ unimplemented("STRING_PTR");
+ return NULL;
+}
+
+
+SEXP *VECTOR_PTR(SEXP x){
+ unimplemented("VECTOR_PTR");
+ return NULL;
+}
+
+SEXP Rf_asChar(SEXP x){
+ return unimplemented("Rf_asChar");
+}
+
+SEXP Rf_PairToVectorList(SEXP x){
+ return ((call_Rf_PairToVectorList) callbacks[Rf_PairToVectorList_x])(x);
+}
+
+SEXP Rf_VectorToPairList(SEXP x){
+ return unimplemented("Rf_VectorToPairList");
+}
+
+SEXP Rf_asCharacterFactor(SEXP x){
+ unimplemented("Rf_VectorToPairList");
+ return NULL;
+}
+
+int Rf_asLogical(SEXP x){
+ return ((call_Rf_asLogical) callbacks[Rf_asLogical_x])(x);
+}
+
+int Rf_asInteger(SEXP x) {
+ return ((call_Rf_asInteger) callbacks[Rf_asInteger_x])(x);
+}
+
+double Rf_asReal(SEXP x) {
+ unimplemented("Rf_asReal");
+ return 0.0;
+}
+
+Rcomplex Rf_asComplex(SEXP x){
+ unimplemented("Rf_asLogical");
+ Rcomplex c; return c;
+}
+
+int TYPEOF(SEXP x) {
+ return (int) ((call_TYPEOF) callbacks[TYPEOF_x])(x);
+}
+
+SEXP ATTRIB(SEXP x){
+ unimplemented("ATTRIB");
+ return NULL;
+}
+
+int OBJECT(SEXP x){
+ return (int) unimplemented("OBJECT");
+}
+
+int MARK(SEXP x){
+ unimplemented("MARK");
+ return 0;
+}
+
+int NAMED(SEXP x){
+ return (int) unimplemented("NAMED");
+}
+
+int REFCNT(SEXP x){
+ unimplemented("REFCNT");
+ return 0;
+}
+
+void SET_OBJECT(SEXP x, int v){
+ unimplemented("SET_OBJECT");
+}
+
+void SET_TYPEOF(SEXP x, int v){
+ unimplemented("SET_TYPEOF");
+}
+
+SEXP SET_TYPEOF_FASTR(SEXP x, int v){
+}
+
+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");
+}
+
+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;
+ }
+}
+
+void R_qsort_I (double *v, int *II, int i, int j) {
+ unimplemented("R_qsort_I");
+}
+
+void R_qsort_int_I(int *iv, int *II, int i, int j) {
+ unimplemented("R_qsort_int_I");
+}
+
+R_len_t R_BadLongVector(SEXP x, const char *y, int z) {
+ return (R_len_t) unimplemented("R_BadLongVector");
+}
+
+int IS_S4_OBJECT(SEXP x) {
+ return (int) unimplemented("IS_S4_OBJECT");
+}
+
+void SET_S4_OBJECT(SEXP x) {
+ unimplemented("SET_S4_OBJECT");
+}
+void UNSET_S4_OBJECT(SEXP x) {
+ unimplemented("UNSET_S4_OBJECT");
+}
+
+Rboolean R_ToplevelExec(void (*fun)(void *), void *data) {
+ return (Rboolean) unimplemented("R_ToplevelExec");
+}
+
+SEXP R_ExecWithCleanup(SEXP (*fun)(void *), void *data,
+ void (*cleanfun)(void *), void *cleandata) {
+ return unimplemented("R_ExecWithCleanup");
+}
+
+/* Environment and Binding Features */
+void R_RestoreHashCount(SEXP rho) {
+ unimplemented("R_RestoreHashCount");
+}
+
+Rboolean R_IsPackageEnv(SEXP rho) {
+ unimplemented("R_IsPackageEnv");
+}
+
+SEXP R_PackageEnvName(SEXP rho) {
+ return unimplemented("R_PackageEnvName");
+}
+
+SEXP R_FindPackageEnv(SEXP info) {
+ return unimplemented("R_FindPackageEnv");
+}
+
+Rboolean R_IsNamespaceEnv(SEXP rho) {
+ return (Rboolean) unimplemented("R_IsNamespaceEnv");
+}
+
+SEXP R_NamespaceEnvSpec(SEXP rho) {
+ return unimplemented("R_NamespaceEnvSpec");
+}
+
+void R_LockEnvironment(SEXP env, Rboolean bindings) {
+ unimplemented("R_LockEnvironment");
+}
+
+Rboolean R_EnvironmentIsLocked(SEXP env) {
+ unimplemented("");
+}
+
+void R_LockBinding(SEXP sym, SEXP env) {
+ unimplemented("R_LockBinding");
+}
+
+void R_unLockBinding(SEXP sym, SEXP env) {
+ unimplemented("R_unLockBinding");
+}
+
+void R_MakeActiveBinding(SEXP sym, SEXP fun, SEXP env) {
+ unimplemented("R_MakeActiveBinding");
+}
+
+Rboolean R_BindingIsLocked(SEXP sym, SEXP env) {
+ return (Rboolean) unimplemented("R_BindingIsLocked");
+}
+
+Rboolean R_BindingIsActive(SEXP sym, SEXP env) {
+ // TODO: for now, I belive all bindings are false
+ return (Rboolean)0;
+}
+
+Rboolean R_HasFancyBindings(SEXP rho) {
+ return (Rboolean) unimplemented("R_HasFancyBindings");
+}
+
+Rboolean Rf_isS4(SEXP x) {
+ return IS_S4_OBJECT(x);
+}
+
+SEXP Rf_asS4(SEXP x, Rboolean b, int i) {
+ unimplemented("Rf_asS4");
+}
+
+static SEXP R_tryEvalInternal(SEXP x, SEXP y, int *ErrorOccurred, int silent) {
+}
+
+SEXP R_tryEval(SEXP x, SEXP y, int *ErrorOccurred) {
+ return R_tryEvalInternal(x, y, ErrorOccurred, 0);
+}
+
+SEXP R_tryEvalSilent(SEXP x, SEXP y, int *ErrorOccurred) {
+ return R_tryEvalInternal(x, y, ErrorOccurred, 1);
+}
+
+double R_atof(const char *str) {
+ unimplemented("R_atof");
+ return 0;
+}
+
+double R_strtod(const char *c, char **end) {
+ unimplemented("R_strtod");
+ return 0;
+}
+
+SEXP R_PromiseExpr(SEXP x) {
+ return unimplemented("R_PromiseExpr");
+}
+
+SEXP R_ClosureExpr(SEXP x) {
+ return unimplemented("R_ClosureExpr");
+}
+
+SEXP R_forceAndCall(SEXP e, int n, SEXP rho) {
+ return unimplemented("R_forceAndCall");
+}
+
+SEXP R_MakeExternalPtr(void *p, SEXP tag, SEXP prot) {
+ return unimplemented("R_MakeExternalPtr");
+}
+
+void *R_ExternalPtrAddr(SEXP s) {
+ return unimplemented("R_ExternalPtrAddr");
+}
+
+SEXP R_ExternalPtrTag(SEXP s) {
+ return unimplemented("R_ExternalPtrTag");
+}
+
+SEXP R_ExternalPtrProt(SEXP s) {
+ return unimplemented("R_ExternalPtrProt");
+}
+
+void R_SetExternalPtrAddr(SEXP s, void *p) {
+ unimplemented("R_SetExternalPtrAddr");
+}
+
+void R_SetExternalPtrTag(SEXP s, SEXP tag) {
+ unimplemented("R_SetExternalPtrTag");
+}
+
+void R_SetExternalPtrProtected(SEXP s, SEXP p) {
+ unimplemented("R_SetExternalPtrProtected");
+}
+
+void R_ClearExternalPtr(SEXP s) {
+ R_SetExternalPtrAddr(s, NULL);
+}
+
+void R_RegisterFinalizer(SEXP s, SEXP fun) {
+ // TODO implement, but not fail for now
+}
+void R_RegisterCFinalizer(SEXP s, R_CFinalizer_t fun) {
+ // TODO implement, but not fail for now
+}
+
+void R_RegisterFinalizerEx(SEXP s, SEXP fun, Rboolean onexit) {
+ // TODO implement, but not fail for now
+
+}
+
+void R_RegisterCFinalizerEx(SEXP s, R_CFinalizer_t fun, Rboolean onexit) {
+ // TODO implement, but not fail for now
+}
+
+void R_RunPendingFinalizers(void) {
+ // TODO implement, but not fail for now
+}
+
+SEXP R_MakeWeakRef(SEXP key, SEXP val, SEXP fin, Rboolean onexit) {
+ unimplemented("R_MakeWeakRef");
+}
+
+SEXP R_MakeWeakRefC(SEXP key, SEXP val, R_CFinalizer_t fin, Rboolean onexit) {
+ unimplemented("R_MakeWeakRefC");
+}
+
+SEXP R_WeakRefKey(SEXP w) {
+ unimplemented("R_WeakRefKey");
+}
+
+SEXP R_WeakRefValue(SEXP w) {
+ unimplemented("R_WeakRefValue");
+}
+
+void R_RunWeakRefFinalizer(SEXP w) {
+ // TODO implement, but not fail for now
+}
+
+SEXP R_do_slot(SEXP obj, SEXP name) {
+ return unimplemented("R_do_slot");
+}
+
+SEXP R_do_slot_assign(SEXP obj, SEXP name, SEXP value) {
+ return unimplemented("R_do_slot_assign");
+}
+
+int R_has_slot(SEXP obj, SEXP name) {
+ return (int) unimplemented("R_has_slot");
+}
+
+SEXP R_do_MAKE_CLASS(const char *what) {
+ return unimplemented("R_do_MAKE_CLASS");
+}
+
+SEXP R_getClassDef (const char *what) {
+ return unimplemented("R_getClassDef");
+}
+
+SEXP R_do_new_object(SEXP class_def) {
+ return unimplemented("R_do_new_object");
+}
+
+int R_check_class_and_super(SEXP x, const char **valid, SEXP rho) {
+ return (int) unimplemented("R_check_class_and_super");
+}
+
+int R_check_class_etc (SEXP x, const char **valid) {
+ return (int) unimplemented("R_check_class_etc");
+}
+
+SEXP R_PreserveObject(SEXP x) {
+ return newObjectRef(x);
+}
+
+void R_ReleaseObject(SEXP x) {
+ releaseObjectRef(x);
+}
+
+void R_dot_Last(void) {
+ unimplemented("R_dot_Last");
+}
+
+
+Rboolean R_compute_identical(SEXP x, SEXP y, int flags) {
+ return (Rboolean) unimplemented("R_compute_identical");
+}
+
+void Rf_copyListMatrix(SEXP s, SEXP t, Rboolean byrow) {
+ unimplemented("Rf_copyListMatrix");
+}
+
+void Rf_copyMatrix(SEXP s, SEXP t, Rboolean byrow) {
+ unimplemented("Rf_copyMatrix");
+}
+
diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rmath.c b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rmath.c
new file mode 100644
index 0000000000..f9ea65f0db
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rmath.c
@@ -0,0 +1,704 @@
+/*
+ * 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>
+
+double Rf_dnorm(double a, double b, double c, int d) {
+ unimplemented("Rf_dnorm");
+ return 0;
+}
+
+double Rf_dnorm4(double a, double b, double c, int d) {
+ return Rf_dnorm(a, b, c, d);
+}
+
+double Rf_pnorm(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_pnorm");
+ return 0;
+}
+
+double Rf_pnorm5(double a, double b, double c, int d, int e) {
+ return Rf_pnorm(a, b, c, d, e);
+}
+
+double Rf_qnorm(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_qnorm");
+ return 0;
+}
+
+double Rf_qnorm5(double a, double b, double c, int d, int e) {
+ return Rf_qnorm(a, b, c, d, e);
+}
+
+double Rf_rnorm(double a, double b) {
+ unimplemented("Rf_rnorm");
+ return 0;
+}
+
+void Rf_pnorm_both(double a, double * b, double * c, int d, int e) {
+ unimplemented("Rf_pnorm_both");
+}
+
+double Rf_dunif(double a, double b, double c, int d) {
+ unimplemented("Rf_dunif");
+ return 0;
+}
+
+double Rf_punif(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_punif");
+ return 0;
+}
+
+double Rf_qunif(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_qunif");
+ return 0;
+}
+
+double Rf_runif(double a, double b) {
+ unimplemented("Rf_runif");
+ return 0;
+}
+
+double Rf_dgamma(double a, double b, double c, int d) {
+ unimplemented("Rf_dgamma");
+ return 0;
+}
+
+double Rf_pgamma(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_pgamma");
+ return 0;
+}
+
+double Rf_qgamma(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_qgamma");
+ return 0;
+}
+
+double Rf_rgamma(double a, double b) {
+ unimplemented("Rf_rgamma");
+ return 0;
+}
+
+double Rf_log1pmx(double a) {
+ unimplemented("Rf_log1pmx");
+ return 0;
+}
+
+double Rf_log1pexp(double a) {
+ unimplemented("Rf_log1pexp");
+ return 0;
+}
+
+double Rf_lgamma1p(double a) {
+ unimplemented("Rf_lgamma1p");
+ return 0;
+}
+
+double Rf_logspace_add(double a, double b) {
+ unimplemented("Rf_logspace_add");
+ return 0;
+}
+
+double Rf_logspace_sub(double a, double b) {
+ unimplemented("Rf_logspace_sub");
+ return 0;
+}
+
+double Rf_dbeta(double a, double b, double c, int d) {
+ unimplemented("Rf_dbeta");
+ return 0;
+}
+
+double Rf_pbeta(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_pbeta");
+ return 0;
+}
+
+double Rf_qbeta(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_qbeta");
+ return 0;
+}
+
+double Rf_rbeta(double a, double b) {
+ unimplemented("Rf_rbeta");
+ return 0;
+}
+
+double Rf_dlnorm(double a, double b, double c, int d) {
+ unimplemented("Rf_dlnorm");
+ return 0;
+}
+
+double Rf_plnorm(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_plnorm");
+ return 0;
+}
+
+double Rf_qlnorm(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_qlnorm");
+ return 0;
+}
+
+double Rf_rlnorm(double a, double b) {
+ unimplemented("Rf_rlnorm");
+ return 0;
+}
+
+double Rf_dchisq(double a, double b, int c) {
+ unimplemented("Rf_dchisq");
+ return 0;
+}
+
+double Rf_pchisq(double a, double b, int c, int d) {
+ unimplemented("Rf_pchisq");
+ return 0;
+}
+
+double Rf_qchisq(double a, double b, int c, int d) {
+ unimplemented("Rf_qchisq");
+ return 0;
+}
+
+double Rf_rchisq(double a) {
+ unimplemented("Rf_rchisq");
+ return 0;
+}
+
+double Rf_dnchisq(double a, double b, double c, int d) {
+ unimplemented("Rf_dnchisq");
+ return 0;
+}
+
+double Rf_pnchisq(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_pnchisq");
+ return 0;
+}
+
+double Rf_qnchisq(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_qnchisq");
+ return 0;
+}
+
+double Rf_rnchisq(double a, double b) {
+ unimplemented("Rf_rnchisq");
+ return 0;
+}
+
+double Rf_df(double a, double b, double c, int d) {
+ unimplemented("Rf_df");
+ return 0;
+}
+
+double Rf_pf(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_pf");
+ return 0;
+}
+
+double Rf_qf(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_qf");
+ return 0;
+}
+
+double Rf_rf(double a, double b) {
+ unimplemented("Rf_rf");
+ return 0;
+}
+
+double Rf_dt(double a, double b, int c) {
+ unimplemented("Rf_dt");
+ return 0;
+}
+
+double Rf_pt(double a, double b, int c, int d) {
+ unimplemented("Rf_pt");
+ return 0;
+}
+
+double Rf_qt(double a, double b, int c, int d) {
+ unimplemented("Rf_qt");
+ return 0;
+}
+
+double Rf_rt(double a) {
+ unimplemented("Rf_rt");
+ return 0;
+}
+
+double Rf_dbinom(double a, double b, double c, int d) {
+ unimplemented("Rf_dbinom");
+ return 0;
+}
+
+double Rf_pbinom(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_pbinom");
+ return 0;
+}
+
+double Rf_qbinom(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_qbinom");
+ return 0;
+}
+
+double Rf_rbinom(double a, double b) {
+ unimplemented("Rf_rbinom");
+ return 0;
+}
+
+void Rf_rmultinom(int a, double* b, int c, int* d) {
+ unimplemented("Rf_rmultinom");
+}
+
+double Rf_dcauchy(double a, double b, double c, int d) {
+ unimplemented("Rf_dcauchy");
+ return 0;
+}
+
+double Rf_pcauchy(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_pcauchy");
+ return 0;
+}
+
+double Rf_qcauchy(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_qcauchy");
+ return 0;
+}
+
+double Rf_rcauchy(double a, double b) {
+ unimplemented("Rf_rcauchy");
+ return 0;
+}
+
+double Rf_dexp(double a, double b, int c) {
+ unimplemented("Rf_dexp");
+ return 0;
+}
+
+double Rf_pexp(double a, double b, int c, int d) {
+ unimplemented("Rf_pexp");
+ return 0;
+}
+
+double Rf_qexp(double a, double b, int c, int d) {
+ unimplemented("Rf_qexp");
+ return 0;
+}
+
+double Rf_rexp(double a) {
+ unimplemented("Rf_rexp");
+ return 0;
+}
+
+double Rf_dgeom(double a, double b, int c) {
+ unimplemented("Rf_dgeom");
+ return 0;
+}
+
+double Rf_pgeom(double a, double b, int c, int d) {
+ unimplemented("Rf_pgeom");
+ return 0;
+}
+
+double Rf_qgeom(double a, double b, int c, int d) {
+ unimplemented("Rf_qgeom");
+ return 0;
+}
+
+double Rf_rgeom(double a) {
+ unimplemented("Rf_rgeom");
+ return 0;
+}
+
+double Rf_dhyper(double a, double b, double c, double d, int e) {
+ unimplemented("Rf_dhyper");
+ return 0;
+}
+
+double Rf_phyper(double a, double b, double c, double d, int e, int f) {
+ unimplemented("Rf_phyper");
+ return 0;
+}
+
+double Rf_qhyper(double a, double b, double c, double d, int e, int f) {
+ unimplemented("Rf_qhyper");
+ return 0;
+}
+
+double Rf_rhyper(double a, double b, double c) {
+ unimplemented("Rf_rhyper");
+ return 0;
+}
+
+double Rf_dnbinom(double a, double b, double c, int d) {
+ unimplemented("Rf_dnbinom");
+ return 0;
+}
+
+double Rf_pnbinom(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_pnbinom");
+ return 0;
+}
+
+double Rf_qnbinom(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_qnbinom");
+ return 0;
+}
+
+double Rf_rnbinom(double a, double b) {
+ unimplemented("Rf_rnbinom");
+ return 0;
+}
+
+double Rf_dnbinom_mu(double a, double b, double c, int d) {
+ unimplemented("Rf_dnbinom_mu");
+ return 0;
+}
+
+double Rf_pnbinom_mu(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_pnbinom_mu");
+ return 0;
+}
+
+double Rf_qnbinom_mu(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_qnbinom_mu");
+ return 0;
+}
+
+double Rf_rnbinom_mu(double a, double b) {
+ unimplemented("Rf_rnbinom_mu");
+ return 0;
+}
+
+double Rf_dpois(double a, double b, int c) {
+ unimplemented("Rf_dpois");
+ return 0;
+}
+
+double Rf_ppois(double a, double b, int c, int d) {
+ unimplemented("Rf_ppois");
+ return 0;
+}
+
+double Rf_qpois(double a, double b, int c, int d) {
+ unimplemented("Rf_qpois");
+ return 0;
+}
+
+double Rf_rpois(double a) {
+ unimplemented("Rf_rpois");
+ return 0;
+}
+
+double Rf_dweibull(double a, double b, double c, int d) {
+ unimplemented("Rf_dweibull");
+ return 0;
+}
+
+double Rf_pweibull(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_pweibull");
+ return 0;
+}
+
+double Rf_qweibull(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_qweibull");
+ return 0;
+}
+
+double Rf_rweibull(double a, double b) {
+ unimplemented("Rf_rweibull");
+ return 0;
+}
+
+double Rf_dlogis(double a, double b, double c, int d) {
+ unimplemented("Rf_dlogis");
+ return 0;
+}
+
+double Rf_plogis(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_plogis");
+ return 0;
+}
+
+double Rf_qlogis(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_qlogis");
+ return 0;
+}
+
+double Rf_rlogis(double a, double b) {
+ unimplemented("Rf_rlogis");
+ return 0;
+}
+
+double Rf_dnbeta(double a, double b, double c, double d, int e) {
+ unimplemented("Rf_dnbeta");
+ return 0;
+}
+
+double Rf_pnbeta(double a, double b, double c, double d, int e, int f) {
+ unimplemented("Rf_pnbeta");
+ return 0;
+}
+
+double Rf_qnbeta(double a, double b, double c, double d, int e, int f) {
+ unimplemented("Rf_qnbeta");
+ return 0;
+}
+
+double Rf_rnbeta(double a, double b, double c) {
+ unimplemented("Rf_rnbeta");
+ return 0;
+}
+
+double Rf_dnf(double a, double b, double c, double d, int e) {
+ unimplemented("Rf_dnf");
+ return 0;
+}
+
+double Rf_pnf(double a, double b, double c, double d, int e, int f) {
+ unimplemented("Rf_pnf");
+ return 0;
+}
+
+double Rf_qnf(double a, double b, double c, double d, int e, int f) {
+ unimplemented("Rf_qnf");
+ return 0;
+}
+
+double Rf_dnt(double a, double b, double c, int d) {
+ unimplemented("Rf_dnt");
+ return 0;
+}
+
+double Rf_pnt(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_pnt");
+ return 0;
+}
+
+double Rf_qnt(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_qnt");
+ return 0;
+}
+
+double Rf_ptukey(double a, double b, double c, double d, int e, int f) {
+ unimplemented("Rf_ptukey");
+ return 0;
+}
+
+double Rf_qtukey(double a, double b, double c, double d, int e, int f) {
+ unimplemented("Rf_qtukey");
+ return 0;
+}
+
+double Rf_dwilcox(double a, double b, double c, int d) {
+ unimplemented("Rf_dwilcox");
+ return 0;
+}
+
+double Rf_pwilcox(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_pwilcox");
+ return 0;
+}
+
+double Rf_qwilcox(double a, double b, double c, int d, int e) {
+ unimplemented("Rf_qwilcox");
+ return 0;
+}
+
+double Rf_rwilcox(double a, double b) {
+ unimplemented("Rf_rwilcox");
+ return 0;
+}
+
+double Rf_dsignrank(double a, double b, int c) {
+ unimplemented("Rf_dsignrank");
+ return 0;
+}
+
+double Rf_psignrank(double a, double b, int c, int d) {
+ unimplemented("Rf_psignrank");
+ return 0;
+}
+
+double Rf_qsignrank(double a, double b, int c, int d) {
+ unimplemented("Rf_qsignrank");
+ return 0;
+}
+
+double Rf_rsignrank(double a) {
+ unimplemented("Rf_rsignrank");
+ return 0;
+}
+
+double Rf_gammafn(double a) {
+ unimplemented("Rf_gammafn");
+ return 0;
+}
+
+double Rf_lgammafn(double a) {
+ unimplemented("Rf_lgammafn");
+ return 0;
+}
+
+double Rf_lgammafn_sign(double a, int* b) {
+ unimplemented("Rf_lgammafn_sign");
+ return 0;
+}
+
+void Rf_dpsifn(double a, int b, int c, int d, double* e, int* f, int* g) {
+ unimplemented("Rf_dpsifn");
+}
+
+double Rf_psigamma(double a, double b) {
+ unimplemented("Rf_psigamma");
+ return 0;
+}
+
+double Rf_digamma(double a) {
+ unimplemented("Rf_digamma");
+ return 0;
+}
+
+double Rf_trigamma(double a) {
+ unimplemented("Rf_trigamma");
+ return 0;
+}
+
+double Rf_tetragamma(double a) {
+ unimplemented("Rf_tetragamma");
+ return 0;
+}
+
+double Rf_pentagamma(double a) {
+ unimplemented("Rf_pentagamma");
+ return 0;
+}
+
+double Rf_beta(double a, double b) {
+ unimplemented("Rf_beta");
+ return 0;
+}
+
+double Rf_lbeta(double a, double b) {
+ unimplemented("Rf_lbeta");
+ return 0;
+}
+
+double Rf_choose(double a, double b) {
+ unimplemented("Rf_choose");
+ return 0;
+}
+
+double Rf_lchoose(double a, double b) {
+ unimplemented("Rf_lchoose");
+ return 0;
+}
+
+double Rf_bessel_i(double a, double b, double c) {
+ unimplemented("Rf_bessel_i");
+ return 0;
+}
+
+double Rf_bessel_j(double a, double b) {
+ unimplemented("Rf_bessel_j");
+ return 0;
+}
+
+double Rf_bessel_k(double a, double b, double c) {
+ unimplemented("Rf_bessel_k");
+ return 0;
+}
+
+double Rf_bessel_y(double a, double b) {
+ unimplemented("Rf_bessel_y");
+ return 0;
+}
+
+double Rf_bessel_i_ex(double a, double b, double c, double * d) {
+ unimplemented("Rf_bessel_i_ex");
+ return 0;
+}
+
+double Rf_bessel_j_ex(double a, double b, double * c) {
+ unimplemented("Rf_bessel_j_ex");
+ return 0;
+}
+
+double Rf_bessel_k_ex(double a, double b, double c, double * d) {
+ unimplemented("Rf_bessel_k_ex");
+ return 0;
+}
+
+double Rf_bessel_y_ex(double a, double b, double * c) {
+ unimplemented("Rf_bessel_y_ex");
+ return 0;
+}
+
+int Rf_imax2(int x, int y) {
+ return x > y ? x : y;
+}
+
+int Rf_imin2(int x, int y) {
+ return x > y ? y : x;
+}
+
+double Rf_fmax2(double x, double y) {
+ return x > y ? x : y;
+}
+
+double Rf_fmin2(double x, double y) {
+ return x > y ? y : x;
+}
+
+double Rf_sign(double a) {
+ unimplemented("Rf_sign");
+ return 0;
+}
+
+double Rf_fprec(double a, double b) {
+ unimplemented("Rf_fprec");
+ return 0;
+}
+
+double Rf_fsign(double a, double b) {
+ unimplemented("Rf_fsign");
+ return 0;
+}
+
+double Rf_ftrunc(double a) {
+ unimplemented("Rf_ftrunc");
+ return 0;
+}
+
+double Rf_cospi(double a) {
+ unimplemented("Rf_cospi");
+ return 0;
+}
+
+double Rf_sinpi(double a) {
+ unimplemented("Rf_sinpi");
+ return 0;
+}
+
+double Rf_tanpi(double a) {
+ unimplemented("Rf_tanpi");
+ return 0;
+}
+
diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Utils.c b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Utils.c
new file mode 100644
index 0000000000..0c49103831
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Utils.c
@@ -0,0 +1,44 @@
+/*
+ * 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 R_CheckStack(void) {
+ // TODO: check for stack overflow
+ // ignored
+}
+
+void R_CheckStack2(size_t extra) {
+ // TODO: check for stack overflow
+ // ignored
+}
+
+void R_CheckUserInterrupt(void) {
+ // ignored
+}
+
+void Rf_onintr()
+{
+ // TODO: implement interrupt handling, signal errors
+ // ignored
+}
diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/appl_rffi.c b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/appl_rffi.c
new file mode 100644
index 0000000000..5ebdbc607d
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/appl_rffi.c
@@ -0,0 +1,40 @@
+/*
+ * Copyright (c) 2017, 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>
+
+extern void dqrdc2_(double *x, int *ldx, int *n, int *p, double *tol, int *rank, double *qraux, int* pivot, double *work);
+extern void dqrcf_(double *x, int *n, int *k, double *qraux, double *y, int *ny, double *b, int* info);
+extern void dqrls_(double *x, int *n, int *p, double *y, int *ny, double *tol, double *b, double *rsd, double *qty, int *k, int *jpvt, double *qraux, double *work);
+
+void call_dqrdc2(double *x, int ldx, int n, int p, double tol, int *rank, double *qraux, int* pivot, double *work) {
+ dqrdc2_(x, &ldx, &n, &p, &tol, rank, qraux, pivot, work);
+}
+
+void call_dqrcf(double *x, int n, int k, double *qraux, double *y, int ny, double *b, int* info) {
+ dqrcf_(x, &n, &k, qraux, y, &ny, b, info);
+}
+
+void call_dqrls(double *x, int n, int p, double *y, int ny, double tol, double *b, double *rsd, double *qty, int *k, int *jpvt, double *qraux, double *work) {
+ dqrls_(x, &n, &p, y, &ny, &tol, b, rsd, qty, k, jpvt, qraux, work);
+}
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
new file mode 100644
index 0000000000..2073ad00fe
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/base_rffi.c
@@ -0,0 +1,71 @@
+/*
+ * 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 <rffiutils.h>
+
+#include <sys/types.h>
+#include <unistd.h>
+#include <sys/stat.h>
+#include <glob.h>
+#include <sys/utsname.h>
+#include <errno.h>
+
+
+void call_uname(void (*call_uname_setfields)(char *sysname, char *release, char *version, char *machine, char *nodename)) {
+ struct utsname name;
+
+ uname(&name);
+ call_uname_setfields(name.sysname, name.release, name.version, name.machine, name.nodename);
+}
+
+void call_glob(char *pattern, void *closure) {
+ void (*call_addpath)(char *path) = closure;
+
+ glob_t globstruct;
+ int rc = glob(pattern, 0, NULL, &globstruct);
+ if (rc == 0) {
+ int i;
+ for (i = 0; i < globstruct.gl_pathc; i++) {
+ char *path = globstruct.gl_pathv[i];
+ call_addpath(path);
+ }
+ }
+}
+
+void call_readlink(void (*call_setresult)(char *link, int errno), char *path) {
+ char *link = NULL;
+ int cerrno = 0;
+ char buf[4096];
+ int len = readlink(path, buf, 4096);
+ if (len == -1) {
+ cerrno = errno;
+ } else {
+ buf[len] = 0;
+ link = buf;
+ }
+ call_setresult(link, cerrno);
+}
+
+void call_strtol(void (*call_setresult)(long result, int errno), 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/call_rffi.c.not b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/call_rffi.c.not
new file mode 100644
index 0000000000..c52ed611c6
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/call_rffi.c.not
@@ -0,0 +1,26 @@
+#include <rffiutils.h>
+
+typedef void (*callVoid0func)();
+
+Call_callVoid0(long address) {
+// jmp_buf error_jmpbuf;
+// callEnter(env, &error_jmpbuf);
+// if (!setjmp(error_jmpbuf)) {
+ callVoid0func call1 = (callVoid0func) address;
+ (*call1)();
+// }
+// callExit(env);
+}
+
+typedef void (*callVoid1func)(SEXP arg1);
+
+
+Call_callVoid1(long address, TruffleObject *arg1) {
+// jmp_buf error_jmpbuf;
+// callEnter(env, &error_jmpbuf);
+// if (!setjmp(error_jmpbuf)) {
+ callVoid0func call1 = (callVoid0func) address;
+ (*call1)(arg1);
+// }
+// callExit(env);
+}
diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/lapack_rffi.c b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/lapack_rffi.c
new file mode 100644
index 0000000000..cc68ca6f0a
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/lapack_rffi.c
@@ -0,0 +1,128 @@
+/*
+ * Copyright (c) 2016, 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>
+
+extern void ilaver_(int *major, int *minor, int *patch);
+
+void call_ilaver(int* version) {
+ int major;
+ int minor;
+ int patch;
+ ilaver_(&major, &minor, &patch);
+ version[0] = major;
+ version[1] = minor;
+ version[2] = patch;
+}
+
+extern int dgeev_(char *jobVL, char *jobVR, int *n, double *a, int *lda, double *wr, double *wi, double *vl, int *ldvl, double *vr, int *ldvr, double *work, int *lwork, int *info);
+
+int call_dgeev(char jobVL, char jobVR, int n, double *a, int lda, double *wr, double *wi, double *vl, int ldvl, double *vr, int ldvr, double *work, int lwork) {
+ int info;
+ dgeev_(&jobVL, &jobVR, &n, a, &lda, wr, wi, vl, &ldvl, vr, &ldvr, work, &lwork, &info);
+ return info;
+}
+
+extern int dgeqp3_(int *m, int *n, double *a, int *lda, int *jpvt, double *tau, double *work, int *lwork, int *info);
+
+
+int call_dgeqp3(int m, int n, double *a, int lda, int *jpvt, double *tau, double *work, int lwork) {
+ int info;
+ dgeqp3_(&m, &n, a, &lda, jpvt, tau, work, &lwork, &info);
+ return info;
+}
+
+extern int dormqr_(char *side, char *trans, int *m, int *n, int *k, double *a, int *lda, double *tau, double *c, int *ldc, double *work, int *lwork, int *info);
+
+int call_dormqr(char side, char trans, int m, int n, int k, double *a, int lda, double *tau, double *c, int ldc, double *work, int lwork) {
+ int info;
+ dormqr_(&side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work, &lwork, &info);
+ return info;
+}
+
+extern int dtrtrs_(char *uplo, char *trans, char *diag, int *n, int *nrhs, double *a, int *lda, double *b, int *ldb, int *info);
+
+
+int call_dtrtrs(char uplo, char trans, char diag, int n, int nrhs, double *a, int lda, double *b, int ldb) {
+ int info;
+ dtrtrs_(&uplo, &trans, &diag, &n, &nrhs, a, &lda, b, &ldb, &info);
+ return info;
+}
+
+extern int dgetrf_(int *m, int *n, double *a, int *lda, int *ipiv, int *info);
+
+int call_dgetrf(int m, int n, double *a, int lda, int *ipiv) {
+ int info;
+ dgetrf_(&m, &n, a, &lda, ipiv, &info);
+ return info;
+}
+
+extern int dpotrf_(char *uplo, int *n, double *a, int *lda, int *info);
+
+int call_dpotrf(char uplo, int n, double *a, int lda) {
+ int info;
+ dpotrf_(&uplo, &n, a, &lda, &info);
+ return info;
+}
+
+extern int dpstrf_(char *uplo, int *n, double *a, int *lda, int *piv, int *rank, double *tol, double *work, int *info);
+
+int call_dpstrf(char uplo, int n, double *a, int lda, int *piv, int *rank, double tol, double *work) {
+ int info;
+ dpstrf_(&uplo, &n, a, &lda, piv, rank, &tol, work, &info);
+ return info;
+}
+
+extern int dgesv_(int *n, int *nrhs, double *a, int *lda, int *ipiv, double *b, int *ldb, int *info);
+
+int call_dgesv(int n, int nrhs, double *a, int lda, int *ipiv, double *b, int ldb) {
+ int info;
+ dgesv_(&n, &nrhs, a, &lda, ipiv, b, &ldb, &info);
+ return info;
+}
+
+extern double dlange_(char *norm, int *m, int *n, double *a, int *lda, double *work);
+
+double call_dlange(char norm, int m, int n, double *a, int lda, double *work) {
+ double info = dlange_(&norm, &m, &n, a, &lda, work);
+ return info;
+}
+
+extern int dgecon_(char *norm, int *n, double *a, int *lda, double *anorm, double *rcond, double *work, int *iwork, int *info);
+
+int call_dgecon(char norm, int n, double *a, int lda, double anorm, double *rcond, double *work, int *iwork) {
+ int info;
+ dgecon_(&norm, &n, a, &lda, &anorm, rcond, work, iwork, &info);
+ return info;
+}
+
+extern int dsyevr_(char *jobz, char *range, char *uplo, int *n, double* a, int *lda, double *vl, double *vu, int *il, int *iu, double *abstol, int* m, double* w,
+ double* z, int *ldz, int* isuppz, double* work, int *lwork, int* iwork, int *liwork, int* info);
+
+int call_dsyevr(char jobz, char range, char uplo, int n, double *a, int lda, double vl, double vu, int il, int iu, double abstol, int *m, double *w,
+ double *z, int ldz, int *isuppz, double *work, int lwork, int *iwork, int liwork) {
+ int info;
+ dsyevr_(&jobz, &range, &uplo, &n, a, &lda, &vl, &vu, &il, &iu, &abstol, m, w,
+ z, &ldz, isuppz, work, &lwork, iwork, &liwork, &info);
+ return info;
+}
diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/pcre_rffi.c b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/pcre_rffi.c
new file mode 100644
index 0000000000..28be2cb058
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/pcre_rffi.c
@@ -0,0 +1,65 @@
+/*
+ * 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, 1996 Robert Gentleman and Ross Ihaka
+ * Copyright (c) 1997-2015, The R Core Team
+ * Copyright (c) 2017, Oracle and/or its affiliates
+ *
+ * All rights reserved.
+ */
+#include <rffiutils.h>
+
+#define PCRE_INFO_CAPTURECOUNT 2
+#define PCRE_INFO_NAMEENTRYSIZE 7
+#define PCRE_INFO_NAMECOUNT 8
+#define PCRE_INFO_NAMETABLE 9
+
+//char *pcre_maketables();
+void *pcre_compile(char *pattern, int options, char **errorMessage, int *errOffset, char *tables);
+//int pcre_exec(void *code, void *extra, char* subject, int subjectLength, int startOffset, int options, int *ovector, int ovecSize);
+int pcre_fullinfo(void *code, void *extra, int what, void *where);
+//void pcre_free(void *code);
+
+void call_compile(void *closure, char *pattern, int options, long tables) {
+ void (*call_makeresult)(long result, char *errMsg, int errOffset) = closure;
+ char *errorMessage;
+ int errOffset;
+ void *pcre_result = pcre_compile(pattern, options, &errorMessage, &errOffset, (char*) tables);
+ call_makeresult((long) pcre_result, errorMessage, errOffset);
+}
+
+int call_getcapturecount(long code, long extra) {
+ int captureCount;
+ int rc = pcre_fullinfo((void*) code, (void*) extra, PCRE_INFO_CAPTURECOUNT, &captureCount);
+ return rc < 0 ? rc : captureCount;
+}
+
+int call_getcapturenames(void *closure, long code, long extra) {
+ void (*call_setcapturename)(int i, char *name) = closure;
+ int nameCount;
+ int nameEntrySize;
+ char* nameTable;
+ int res;
+ res = pcre_fullinfo((void*) code, (void*) extra, PCRE_INFO_NAMECOUNT, &nameCount);
+ if (res < 0) {
+ return res;
+ }
+ res = pcre_fullinfo((void*) code, (void*) extra, PCRE_INFO_NAMEENTRYSIZE, &nameEntrySize);
+ if (res < 0) {
+ return res;
+ }
+ res = pcre_fullinfo((void*) code, (void*) extra, PCRE_INFO_NAMETABLE, &nameTable);
+ if (res < 0) {
+ return res;
+ }
+ // from GNU R's grep.c
+ for(int i = 0; i < nameCount; i++) {
+ char* entry = nameTable + nameEntrySize * i;
+ int captureNum = (entry[0] << 8) + entry[1] - 1;
+ call_setcapturename(captureNum, entry + 2);
+ }
+ return res;
+
+}
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
new file mode 100644
index 0000000000..d4e0e017db
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/rffi_callbacks.h
@@ -0,0 +1,409 @@
+/*
+ * 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.
+ */
+#ifndef CALLBACKS_H
+#define CALLBACKS_H
+
+#define CADDR_x 0
+#define CADR_x 1
+#define CAR_x 2
+#define CDDR_x 3
+#define CDR_x 4
+#define DUPLICATE_ATTRIB_x 5
+#define ENCLOS_x 6
+#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_getContextCall_x 51
+#define R_getContextEnv_x 52
+#define R_getContextFun_x 53
+#define R_getContextSrcRef_x 54
+#define R_getGlobalFunctionContext_x 55
+#define R_getParentFunctionContext_x 56
+#define R_insideBrowser_x 57
+#define R_isEqual_x 58
+#define R_isGlobal_x 59
+#define R_lsInternal3_x 60
+#define R_new_custom_connection_x 61
+#define R_tryEval_x 62
+#define Rf_GetOption1_x 63
+#define Rf_PairToVectorList_x 64
+#define Rf_ScalarDouble_x 65
+#define Rf_ScalarInteger_x 66
+#define Rf_ScalarLogical_x 67
+#define Rf_ScalarString_x 68
+#define Rf_allocateArray_x 69
+#define Rf_allocateMatrix_x 70
+#define Rf_allocateVector_x 71
+#define Rf_anyDuplicated_x 72
+#define Rf_asChar_x 73
+#define Rf_asInteger_x 74
+#define Rf_asLogical_x 75
+#define Rf_asReal_x 76
+#define Rf_classgets_x 77
+#define Rf_coerceVector_x 78
+#define Rf_cons_x 79
+#define Rf_copyListMatrix_x 80
+#define Rf_copyMatrix_x 81
+#define Rf_defineVar_x 82
+#define Rf_duplicate_x 83
+#define Rf_error_x 84
+#define Rf_eval_x 85
+#define Rf_findVar_x 86
+#define Rf_findVarInFrame_x 87
+#define Rf_findVarInFrame3_x 88
+#define Rf_findfun_x 89
+#define Rf_getAttrib_x 90
+#define Rf_gsetVar_x 91
+#define Rf_inherits_x 92
+#define Rf_install_x 93
+#define Rf_installChar_x 94
+#define Rf_isNull_x 95
+#define Rf_isString_x 96
+#define Rf_lengthgets_x 97
+#define Rf_mkCharLenCE_x 98
+#define Rf_ncols_x 99
+#define Rf_nrows_x 100
+#define Rf_setAttrib_x 101
+#define Rf_warning_x 102
+#define Rf_warningcall_x 103
+#define Rprintf_x 104
+#define SETCADR_x 105
+#define SETCAR_x 106
+#define SETCDR_x 107
+#define SET_RDEBUG_x 108
+#define SET_RSTEP_x 109
+#define SET_STRING_ELT_x 110
+#define SET_SYMVALUE_x 111
+#define SET_TAG_x 112
+#define SET_TYPEOF_FASTR_x 113
+#define SET_VECTOR_ELT_x 114
+#define STRING_ELT_x 115
+#define SYMVALUE_x 116
+#define TAG_x 117
+#define TYPEOF_x 118
+#define VECTOR_ELT_x 119
+#define getConnectionClassString_x 120
+#define getOpenModeString_x 121
+#define getSummaryDescription_x 122
+#define isSeekable_x 123
+#define unif_rand_x 124
+
+#define CALLBACK_TABLE_SIZE 125
+
+extern void* callbacks[];
+
+// TODO Use an array indexed by above
+
+// This is the complete set , including those not yet implemented
+
+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_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);
+typedef SEXP (*call_Rf_allocList)(int x);
+typedef SEXP (*call_Rf_allocSExp)(SEXPTYPE t);
+typedef SEXP (*call_Rf_cons)(SEXP car, SEXP cdr);
+typedef void (*call_Rf_defineVar)(SEXP symbol, SEXP value, SEXP rho);
+typedef void (*call_Rf_setVar)(SEXP x, SEXP y, SEXP z);
+typedef SEXP (*call_Rf_dimgets)(SEXP x, SEXP y);
+typedef SEXP (*call_Rf_dimnamesgets)(SEXP x, SEXP y);
+typedef SEXP (*call_Rf_eval)(SEXP expr, SEXP env);
+typedef SEXP (*call_Rf_findFun)(SEXP symbol, SEXP rho);
+typedef SEXP (*call_Rf_findVar)(SEXP sym, SEXP rho);
+typedef SEXP (*call_Rf_findVarInFrame)(SEXP rho, SEXP sym);
+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_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);
+typedef SEXP (*call_Rf_duplicated)(SEXP x, Rboolean y);
+typedef SEXP (*call_Rf_applyClosure)(SEXP x, SEXP y, SEXP z, SEXP a, SEXP b);
+typedef void (*call_Rf_copyMostAttrib)(SEXP x, SEXP y);
+typedef void (*call_Rf_copyVector)(SEXP x, SEXP y);
+typedef int (*call_Rf_countContexts)(int x, int y);
+typedef Rboolean (*call_Rf_inherits)(SEXP x, const char * klass);
+typedef Rboolean (*call_Rf_isReal)(SEXP x);
+typedef Rboolean (*call_Rf_isSymbol)(SEXP x);
+typedef Rboolean (*call_Rf_isComplex)(SEXP x);
+typedef Rboolean (*call_Rf_isEnvironment)(SEXP x);
+typedef Rboolean (*call_Rf_isExpression)(SEXP x);
+typedef Rboolean (*call_Rf_isLogical)(SEXP x);
+typedef Rboolean (*call_Rf_isObject)(SEXP s);
+typedef void (*call_Rf_PrintValue)(SEXP x);
+typedef SEXP (*call_Rf_install)(const char *name);
+typedef SEXP (*call_Rf_installChar)(SEXP charsxp);
+typedef Rboolean (*call_Rf_isNull)(SEXP s);
+typedef Rboolean (*call_Rf_isString)(SEXP s);
+typedef Rboolean (*call_R_cycle_detected)(SEXP s, SEXP child);
+typedef cetype_t (*call_Rf_getCharCE)(SEXP x);
+typedef SEXP (*call_Rf_mkChar)(const char *x);
+typedef SEXP (*call_Rf_mkCharCE)(const char *x, cetype_t y);
+typedef SEXP (*call_Rf_mkCharLen)(const char *x, int y);
+typedef SEXP (*call_Rf_mkCharLenCE)(const char *x, int len, cetype_t enc);
+typedef const char * (*call_Rf_reEnc)(const char *x, cetype_t ce_in, cetype_t ce_out, int subst);
+typedef SEXP (*call_Rf_mkString)(const char *s);
+typedef int (*call_Rf_ncols)(SEXP x);
+typedef int (*call_Rf_nrows)(SEXP x);
+typedef SEXP (*call_Rf_protect)(SEXP x);
+typedef void (*call_Rf_unprotect)(int x);
+typedef void (*call_R_ProtectWithIndex)(SEXP x, PROTECT_INDEX *y);
+typedef void (*call_R_Reprotect)(SEXP x, PROTECT_INDEX y);
+typedef void (*call_Rf_unprotect_ptr)(SEXP x);
+typedef void (*call_Rf_error)(const char *format, ...);
+typedef void (*call_Rf_errorcall)(SEXP x, const char *format, ...);
+typedef void (*call_Rf_warningcall)(SEXP x, const char *format, ...);
+typedef void (*call_Rf_warning)(const char *format, ...);
+typedef void (*call_Rprintf)(const char *format, ...);
+typedef void (*call_Rvprintf)(const char *format, va_list args);
+typedef void (*call_REvprintf)(const char *format, va_list args);
+typedef void (*call_R_FlushConsole)(void);
+typedef void (*call_R_ProcessEvents)(void);
+typedef SEXP (*call_R_NewHashedEnv)(SEXP parent, SEXP size);
+typedef SEXP (*call_Rf_classgets)(SEXP vec, SEXP klass);
+typedef const char *(*call_Rf_translateChar)(SEXP x);
+typedef const char *(*call_Rf_translateChar0)(SEXP x);
+typedef const char *(*call_Rf_translateCharUTF8)(SEXP x);
+typedef SEXP (*call_Rf_lengthgets)(SEXP x, R_len_t y);
+typedef SEXP (*call_Rf_xlengthgets)(SEXP x, R_xlen_t y);
+typedef SEXP (*call_R_lsInternal)(SEXP env, Rboolean all);
+typedef SEXP (*call_R_lsInternal3)(SEXP env, Rboolean all, Rboolean sorted);
+typedef SEXP (*call_Rf_namesgets)(SEXP x, SEXP y);
+typedef SEXP (*call_TAG)(SEXP e);
+typedef SEXP (*call_PRINTNAME)(SEXP e);
+typedef SEXP (*call_CAR)(SEXP e);
+typedef SEXP (*call_CDR)(SEXP e);
+typedef SEXP (*call_CAAR)(SEXP e);
+typedef SEXP (*call_CDAR)(SEXP e);
+typedef SEXP (*call_CADR)(SEXP e);
+typedef SEXP (*call_CDDR)(SEXP e);
+typedef SEXP (*call_CDDDR)(SEXP e);
+typedef SEXP (*call_CADDR)(SEXP e);
+typedef SEXP (*call_CADDDR)(SEXP e);
+typedef SEXP (*call_CAD4R)(SEXP e);
+typedef int (*call_MISSING)(SEXP x);
+typedef void (*call_SET_MISSING)(SEXP x, int v);
+typedef void (*call_SET_TAG)(SEXP x, SEXP y);
+typedef SEXP (*call_SETCAR)(SEXP x, SEXP y);
+typedef SEXP (*call_SETCDR)(SEXP x, SEXP y);
+typedef SEXP (*call_SETCADR)(SEXP x, SEXP y);
+typedef SEXP (*call_SETCADDR)(SEXP x, SEXP y);
+typedef SEXP (*call_SETCADDDR)(SEXP x, SEXP y);
+typedef SEXP (*call_SETCAD4R)(SEXP e, SEXP y);
+typedef SEXP (*call_FORMALS)(SEXP x);
+typedef SEXP (*call_BODY)(SEXP x);
+typedef SEXP (*call_CLOENV)(SEXP x);
+typedef int (*call_RDEBUG)(SEXP x);
+typedef int (*call_RSTEP)(SEXP x);
+typedef int (*call_RTRACE)(SEXP x);
+typedef void (*call_SET_RDEBUG)(SEXP x, int v);
+typedef void (*call_SET_RSTEP)(SEXP x, int v);
+typedef void (*call_SET_RTRACE)(SEXP x, int v);
+typedef void (*call_SET_FORMALS)(SEXP x, SEXP v);
+typedef void (*call_SET_BODY)(SEXP x, SEXP v);
+typedef void (*call_SET_CLOENV)(SEXP x, SEXP v);
+typedef SEXP (*call_SYMVALUE)(SEXP x);
+typedef SEXP (*call_INTERNAL)(SEXP x);
+typedef int (*call_DDVAL)(SEXP x);
+typedef void (*call_SET_DDVAL)(SEXP x, int v);
+typedef void (*call_SET_SYMVALUE)(SEXP x, SEXP v);
+typedef void (*call_SET_INTERNAL)(SEXP x, SEXP v);
+typedef SEXP (*call_FRAME)(SEXP x);
+typedef SEXP (*call_ENCLOS)(SEXP x);
+typedef SEXP (*call_HASHTAB)(SEXP x);
+typedef int (*call_ENVFLAGS)(SEXP x);
+typedef void (*call_SET_ENVFLAGS)(SEXP x, int v);
+typedef void (*call_SET_FRAME)(SEXP x, SEXP v);
+typedef void (*call_SET_ENCLOS)(SEXP x, SEXP v);
+typedef void (*call_SET_HASHTAB)(SEXP x, SEXP v);
+typedef SEXP (*call_PRCODE)(SEXP x);
+typedef SEXP (*call_PRENV)(SEXP x);
+typedef SEXP (*call_PRVALUE)(SEXP x);
+typedef int (*call_PRSEEN)(SEXP x);
+typedef void (*call_SET_PRSEEN)(SEXP x, int v);
+typedef void (*call_SET_PRENV)(SEXP x, SEXP v);
+typedef void (*call_SET_PRVALUE)(SEXP x, SEXP v);
+typedef void (*call_SET_PRCODE)(SEXP x, SEXP v);
+typedef int (*call_LENGTH)(SEXP x);
+typedef int (*call_TRUELENGTH)(SEXP x);
+typedef void (*call_SETLENGTH)(SEXP x, int v);
+typedef void (*call_SET_TRUELENGTH)(SEXP x, int v);
+typedef R_xlen_t (*call_XLENGTH)(SEXP x);
+typedef R_xlen_t (*call_XTRUELENGTH)(SEXP x);
+typedef int (*call_IS_LONG_VEC)(SEXP x);
+typedef int (*call_LEVELS)(SEXP x);
+typedef int (*call_SETLEVELS)(SEXP x, int v);
+typedef int *(*call_LOGICAL)(SEXP x);
+typedef int *(*call_INTEGER)(SEXP x);
+typedef Rbyte *(*call_RAW)(SEXP x);
+typedef double *(*call_REAL)(SEXP x);
+typedef Rcomplex *(*call_COMPLEX)(SEXP x);
+typedef SEXP (*call_STRING_ELT)(SEXP x, R_xlen_t i);
+typedef SEXP (*call_VECTOR_ELT)(SEXP x, R_xlen_t i);
+typedef void (*call_SET_STRING_ELT)(SEXP x, R_xlen_t i, SEXP v);
+typedef SEXP (*call_SET_VECTOR_ELT)(SEXP x, R_xlen_t i, SEXP v);
+typedef SEXP *(*call_STRING_PTR)(SEXP x);
+typedef SEXP *(*call_VECTOR_PTR)(SEXP x);
+typedef SEXP (*call_Rf_asChar)(SEXP x);
+typedef SEXP (*call_Rf_PairToVectorList)(SEXP x);
+typedef SEXP (*call_Rf_VectorToPairList)(SEXP x);
+typedef SEXP (*call_Rf_asCharacterFactor)(SEXP x);
+typedef int (*call_Rf_asLogical)(SEXP x);
+typedef int (*call_Rf_asInteger)(SEXP x);
+typedef double (*call_Rf_asReal)(SEXP x);
+typedef Rcomplex (*call_Rf_asComplex)(SEXP x);
+typedef int (*call_TYPEOF)(SEXP x);
+typedef SEXP (*call_ATTRIB)(SEXP x);
+typedef int (*call_OBJECT)(SEXP x);
+typedef int (*call_MARK)(SEXP x);
+typedef int (*call_NAMED)(SEXP x);
+typedef int (*call_REFCNT)(SEXP x);
+typedef void (*call_SET_OBJECT)(SEXP x, int v);
+typedef void (*call_SET_TYPEOF)(SEXP x, int v);
+typedef SEXP (*call_SET_TYPEOF_FASTR)(SEXP x, int v);
+typedef void (*call_SET_NAMED)(SEXP x, int v);
+typedef void (*call_SET_ATTRIB)(SEXP x, SEXP v);
+typedef void (*call_DUPLICATE_ATTRIB)(SEXP to, SEXP from);
+typedef int (*call_IS_S4_OBJECT)(SEXP x);
+typedef void (*call_SET_S4_OBJECT)(SEXP x);
+typedef void (*call_UNSET_S4_OBJECT)(SEXP x);
+typedef Rboolean (*call_R_ToplevelExec)(void (*fun)(void *), void *data);
+typedef void (*call_R_RestoreHashCount)(SEXP rho);
+typedef Rboolean (*call_R_IsPackageEnv)(SEXP rho);
+typedef SEXP (*call_R_PackageEnvName)(SEXP rho);
+typedef SEXP (*call_R_FindPackageEnv)(SEXP info);
+typedef Rboolean (*call_R_IsNamespaceEnv)(SEXP rho);
+typedef SEXP (*call_R_NamespaceEnvSpec)(SEXP rho);
+typedef SEXP (*call_R_FindNamespace)(SEXP info);
+typedef void (*call_R_LockEnvironment)(SEXP env, Rboolean bindings);
+typedef Rboolean (*call_R_EnvironmentIsLocked)(SEXP env);
+typedef void (*call_R_LockBinding)(SEXP sym, SEXP env);
+typedef void (*call_R_unLockBinding)(SEXP sym, SEXP env);
+typedef void (*call_R_MakeActiveBinding)(SEXP sym, SEXP fun, SEXP env);
+typedef Rboolean (*call_R_BindingIsLocked)(SEXP sym, SEXP env);
+typedef Rboolean (*call_R_BindingIsActive)(SEXP sym, SEXP env);
+typedef Rboolean (*call_R_HasFancyBindings)(SEXP rho);
+typedef Rboolean (*call_Rf_isS4)(SEXP x);
+typedef SEXP (*call_Rf_asS4)(SEXP x, Rboolean b, int i);
+typedef SEXP (*call_R_tryEval)(SEXP x, SEXP y, int *ErrorOccurred);
+typedef SEXP (*call_R_tryEvalSilent)(SEXP x, SEXP y, int *ErrorOccurred);
+typedef double (*call_R_atof)(const char *str);
+typedef double (*call_R_strtod)(const char *c, char **end);
+typedef SEXP (*call_R_PromiseExpr)(SEXP x);
+typedef SEXP (*call_R_ClosureExpr)(SEXP x);
+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 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);
+typedef void (*call_R_ClearExternalPtr)(SEXP s);
+typedef void (*call_R_RegisterFinalizer)(SEXP s, SEXP fun);
+typedef void (*call_R_RegisterCFinalizer)(SEXP s, R_CFinalizer_t fun);
+typedef void (*call_R_RegisterFinalizerEx)(SEXP s, SEXP fun, Rboolean onexit);
+typedef void (*call_R_RegisterCFinalizerEx)(SEXP s, R_CFinalizer_t fun, Rboolean onexit);
+typedef void (*call_R_RunPendingFinalizers)(void);
+typedef SEXP (*call_R_MakeWeakRef)(SEXP key, SEXP val, SEXP fin, Rboolean onexit);
+typedef SEXP (*call_R_MakeWeakRefC)(SEXP key, SEXP val, R_CFinalizer_t fin, Rboolean onexit);
+typedef SEXP (*call_R_WeakRefKey)(SEXP w);
+typedef SEXP (*call_R_WeakRefValue)(SEXP w);
+typedef void (*call_R_RunWeakRefFinalizer)(SEXP w);
+typedef SEXP (*call_R_do_slot)(SEXP obj, SEXP name);
+typedef SEXP (*call_R_do_slot_assign)(SEXP obj, SEXP name, SEXP value);
+typedef int (*call_R_has_slot)(SEXP obj, SEXP name);
+typedef SEXP (*call_R_do_MAKE_CLASS)(const char *what);
+typedef SEXP (*call_R_getClassDef )(const char *what);
+typedef SEXP (*call_R_do_new_object)(SEXP class_def);
+typedef int (*call_R_check_class_and_super)(SEXP x, const char **valid, SEXP rho);
+typedef int (*call_R_check_class_etc )(SEXP x, const char **valid);
+typedef SEXP (*call_R_PreserveObject)(SEXP x);
+typedef void (*call_R_ReleaseObject)(SEXP x);
+typedef void (*call_R_dot_Last)(void);
+typedef Rboolean (*call_R_compute_identical)(SEXP x, SEXP y, int flags);
+typedef void (*call_Rf_copyListMatrix)(SEXP s, SEXP t, Rboolean byrow);
+typedef void (*call_Rf_copyMatrix)(SEXP s, SEXP t, Rboolean byrow);
+typedef void (*call_GetRNGstate)();
+typedef void (*call_PutRNGstate)();
+typedef SEXP (*call_R_BaseEnv)();
+typedef SEXP (*call_R_BaseNamespace)();
+typedef SEXP (*call_R_GlobalEnv)();
+typedef SEXP (*call_R_NamespaceRegistry)();
+typedef SEXP (*call_R_Interactive)();
+typedef SEXP (*call_R_GlobalContext)();
+typedef SEXP (*call_R_CHAR)(SEXP x);
+typedef char *(*call_R_HomeDir)();
+typedef void (*call_R_CleanUp)(int sa, int status, int runlast);
+typedef void (*call_Rf_gsetVar)(SEXP symbol, SEXP value, SEXP rho);
+typedef double (*call_unif_rand)();
+
+#endif
+
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
new file mode 100644
index 0000000000..4068091952
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/rffiutils.h
@@ -0,0 +1,35 @@
+/*
+ * 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.
+ */
+#ifndef RFFIUTILS_H
+#define RFFIUTILS_H
+
+#include <stdlib.h>
+#include <string.h>
+#include <limits.h>
+#include <Rinternals.h>
+#include <rffi_callbacks.h>
+#include <trufflenfi.h>
+
+extern void init_memory();
+
+#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
new file mode 100644
index 0000000000..acd535c135
--- /dev/null
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/variables.c
@@ -0,0 +1,390 @@
+/*
+ * 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>
+#include <trufflenfi.h>
+
+#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_EmptyEnv_x 6
+#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
+#define R_BraceSymbol_x 13
+#define R_ClassSymbol_x 14
+#define R_DeviceSymbol_x 15
+#define R_DevicesSymbol_x 16
+#define R_DimNamesSymbol_x 17
+#define R_DimSymbol_x 18
+#define R_DollarSymbol_x 19
+#define R_DotsSymbol_x 20
+#define R_DropSymbol_x 21
+#define R_LastvalueSymbol_x 22
+#define R_LevelsSymbol_x 23
+#define R_ModeSymbol_x 24
+#define R_NameSymbol_x 25
+#define R_NamesSymbol_x 26
+#define R_NaRmSymbol_x 27
+#define R_PackageSymbol_x 28
+#define R_QuoteSymbol_x 29
+#define R_RowNamesSymbol_x 30
+#define R_SeedsSymbol_x 31
+#define R_SourceSymbol_x 32
+#define R_TspSymbol_x 33
+#define R_dot_defined_x 34
+#define R_dot_Method_x 35
+#define R_dot_target_x 36
+#define R_SrcrefSymbol_x 37
+#define R_SrcfileSymbol_x 38
+#define R_NaString_x 39
+#define R_NaN_x 40
+#define R_PosInf_x 41
+#define R_NegInf_x 42
+#define R_NaReal_x 43
+#define R_NaInt_x 44
+#define R_BlankString_x 45
+#define R_BlankScalarString_x 46
+#define R_BaseSymbol_x 47
+#define R_NamespaceEnvSymbol_x 48
+#define R_RestartToken_x 49
+
+static const char *R_Home_static;
+static const char *R_TempDir_static;
+static SEXP R_EmptyEnv_static;
+static SEXP R_Srcref_static;
+static SEXP R_NilValue_static;
+static SEXP R_UnboundValue_static;
+static SEXP R_MissingArg_static;
+static SEXP R_BaseSymbol_static;
+static SEXP R_Bracket2Symbol_static; /* "[[" */
+static SEXP R_BracketSymbol_static; /* "[" */
+static SEXP R_BraceSymbol_static; /* "{" */
+static SEXP R_ClassSymbol_static; /* "class" */
+static SEXP R_DeviceSymbol_static; /* ".Device" */
+static SEXP R_DevicesSymbol_static; /* ".Devices" */
+static SEXP R_DimNamesSymbol_static; /* "dimnames" */
+static SEXP R_DimSymbol_static; /* "dim" */
+static SEXP R_DollarSymbol_static; /* "$" */
+static SEXP R_DotsSymbol_static; /* "..." */
+static SEXP R_DropSymbol_static; /* "drop" */
+static SEXP R_LastvalueSymbol_static; /* ".Last.value" */
+static SEXP R_LevelsSymbol_static; /* "levels" */
+static SEXP R_ModeSymbol_static; /* "mode" */
+static SEXP R_NameSymbol_static; /* "name" */
+static SEXP R_NamesSymbol_static; /* "names" */
+static SEXP R_NaRmSymbol_static; /* "na.rm" */
+static SEXP R_PackageSymbol_static; /* "package" */
+static SEXP R_QuoteSymbol_static; /* "quote" */
+static SEXP R_RowNamesSymbol_static; /* "row.names" */
+static SEXP R_SeedsSymbol_static; /* ".Random.seed" */
+static SEXP R_SourceSymbol_static; /* "source" */
+static SEXP R_TspSymbol_static; /* "tsp" */
+static SEXP R_dot_defined_static; /* ".defined" */
+static SEXP R_dot_Method_static; /* ".Method" */
+static SEXP R_dot_target_static; /* ".target" */
+static SEXP R_NaString_static; /* NA_STRING as a CHARSXP */
+static SEXP R_BlankString_static; /* "" as a CHARSXP */
+static SEXP R_BlankScalarString_static; /* "" as a STRSXP */
+static SEXP R_BaseSymbol_static; /* "base" as a SYMSXP */
+static SEXP R_NamespaceEnvSymbol_static; // ".__NAMESPACE__."
+
+// Symbols not part of public API but used in FastR tools implementation
+static SEXP R_SrcrefSymbol_static;
+static SEXP R_SrcfileSymbol_static;
+static SEXP R_RestartToken_static;
+
+// Arith.h
+double R_NaN; /* IEEE NaN */
+double R_PosInf; /* IEEE Inf */
+double R_NegInf; /* IEEE -Inf */
+double R_NaReal; /* NA_REAL: IEEE */
+int R_NaInt; /* NA_INTEGER:= INT_MIN currently */
+
+// various ignored flags and variables nevertheless needed to resolve symbols
+Rboolean R_Visible;
+Rboolean R_interrupts_suspended;
+int R_interrupts_pending;
+Rboolean mbcslocale;
+Rboolean useaqua;
+char* OutDec = ".";
+Rboolean utf8locale = FALSE;
+Rboolean mbcslocale = FALSE;
+Rboolean latin1locale = FALSE;
+int R_dec_min_exponent = -308;
+int max_contour_segments = 25000;
+
+// from sys-std.c
+#include <R_ext/eventloop.h>
+
+static InputHandler BasicInputHandler = {2, -1, NULL};
+InputHandler *R_InputHandlers = &BasicInputHandler;
+
+char *FASTR_R_Home() {
+ return (char *) R_Home_static;
+}
+
+char *FASTR_R_TempDir() {
+ return (char *) R_TempDir_static;
+}
+
+SEXP FASTR_R_EmptyEnv() {
+ return R_EmptyEnv_static;
+}
+
+SEXP FASTR_R_Srcref() {
+ return R_Srcref_static;
+}
+
+SEXP FASTR_R_NilValue() {
+ return R_NilValue_static;
+}
+
+SEXP FASTR_R_UnboundValue() {
+ return R_UnboundValue_static;
+}
+
+SEXP FASTR_R_MissingArg() {
+ return R_MissingArg_static;
+}
+
+SEXP FASTR_R_BaseSymbol() {
+ return R_BaseSymbol_static;
+}
+
+
+SEXP FASTR_R_BraceSymbol() {
+ return R_BraceSymbol_static;
+}
+
+SEXP FASTR_R_Bracket2Symbol() {
+ return R_Bracket2Symbol_static;
+}
+
+SEXP FASTR_R_BracketSymbol() {
+ return R_BracketSymbol_static;
+}
+
+SEXP FASTR_R_ClassSymbol() {
+ return R_ClassSymbol_static;
+}
+
+SEXP FASTR_R_DimNamesSymbol() {
+ return R_DimNamesSymbol_static;
+}
+
+SEXP FASTR_R_DimSymbol() {
+ return R_DimSymbol_static;
+}
+
+
+SEXP FASTR_R_DollarSymbol() {
+ return R_DollarSymbol_static;
+}
+
+SEXP FASTR_R_DotsSymbol() {
+ return R_DotsSymbol_static;
+}
+
+
+SEXP FASTR_R_DropSymbol() {
+ return R_DropSymbol_static;
+}
+
+SEXP FASTR_R_LastvalueSymbol() {
+ return R_LastvalueSymbol_static;
+}
+
+
+SEXP FASTR_R_LevelsSymbol() {
+ return R_LevelsSymbol_static;
+}
+
+SEXP FASTR_R_ModeSymbol() {
+ return R_ModeSymbol_static;
+}
+
+SEXP FASTR_R_NaRmSymbol() {
+ return R_NaRmSymbol_static;
+}
+
+
+SEXP FASTR_R_NameSymbol() {
+ return R_NameSymbol_static;
+}
+
+SEXP FASTR_R_NamesSymbol() {
+ return R_NamesSymbol_static;
+}
+
+
+SEXP FASTR_R_NamespaceEnvSymbol() {
+ return R_NamespaceEnvSymbol_static;
+}
+
+SEXP FASTR_R_PackageSymbol() {
+ return R_PackageSymbol_static;
+}
+
+SEXP FASTR_R_QuoteSymbol() {
+ return R_QuoteSymbol_static;
+}
+
+SEXP FASTR_R_RowNamesSymbol() {
+ return R_RowNamesSymbol_static;
+}
+
+SEXP FASTR_R_SeedsSymbol() {
+ return R_SeedsSymbol_static;
+}
+
+SEXP FASTR_R_SourceSymbol() {
+ return R_SourceSymbol_static;
+}
+
+SEXP FASTR_R_TspSymbol() {
+ return R_TspSymbol_static;
+}
+
+SEXP FASTR_R_dot_defined() {
+ return R_dot_defined_static;
+}
+
+SEXP FASTR_R_dot_Method() {
+ return R_dot_Method_static;
+}
+
+SEXP FASTR_R_dot_target() {
+ return R_dot_target_static;
+}
+
+SEXP FASTR_R_NaString() {
+ return R_NaString_static;
+}
+
+
+SEXP FASTR_R_BlankString() {
+ return R_BlankString_static;
+}
+
+SEXP FASTR_R_BlankScalarString() {
+ return R_BlankScalarString_static;
+}
+
+SEXP FASTR_R_DevicesSymbol() {
+ return R_DevicesSymbol_static;
+}
+
+SEXP FASTR_R_DeviceSymbol() {
+ return R_DeviceSymbol_static;
+}
+
+SEXP FASTR_R_SrcrefSymbol() {
+ return R_SrcrefSymbol_static;
+}
+
+SEXP FASTR_R_SrcfileSymbol() {
+ return R_SrcfileSymbol_static;
+}
+
+void Call_initvar_double(int index, double value) {
+ switch (index) {
+ case R_NaN_x: R_NaN = value; break;
+ }
+}
+
+void Call_initvar_int(int index, int value) {
+ switch (index) {
+ case R_NaInt_x: R_NaInt = value; break;
+ case R_PosInf_x: R_PosInf = value; break;
+ case R_NegInf_x: R_NegInf = value; break;
+ case R_NaReal_x: R_NaReal = value; break;
+ }
+}
+
+char *copystring(char *value) {
+ char *result = malloc(strlen(value) + 1);
+ strcpy(result, value);
+ return result;
+}
+
+// value must be copied
+void Call_initvar_string(int index, char *value) {
+ switch (index) {
+ case R_Home_x: R_Home_static = copystring(value); break;
+ case R_TempDir_x: R_TempDir_static = copystring(value); break;
+ }
+}
+
+void Call_initvar_obj(int index, void* value) {
+ switch (index) {
+ case R_NilValue_x: R_NilValue_static = newObjectRef(value); break;
+ case R_UnboundValue_x: R_UnboundValue_static = newObjectRef(value); break;
+ case R_MissingArg_x: R_MissingArg_static = newObjectRef(value); break;
+// case R_Srcref_x: R_Srcref_static = newObjectRef(value); break;
+ case R_EmptyEnv_x: R_EmptyEnv_static = newObjectRef(value); break;
+ case R_Bracket2Symbol_x: R_Bracket2Symbol_static = newObjectRef(value); break;
+ case R_BracketSymbol_x: R_BracketSymbol_static = newObjectRef(value); break;
+ case R_BraceSymbol_x: R_BraceSymbol_static = newObjectRef(value); break;
+ case R_ClassSymbol_x: R_ClassSymbol_static = newObjectRef(value); break;
+ case R_DeviceSymbol_x: R_DeviceSymbol_static = newObjectRef(value); break;
+ case R_DevicesSymbol_x: R_DevicesSymbol_static = newObjectRef(value); break;
+ case R_DimNamesSymbol_x: R_DimNamesSymbol_static = newObjectRef(value); break;
+ case R_DimSymbol_x: R_DimSymbol_static = newObjectRef(value); break;
+ case R_DollarSymbol_x: R_DollarSymbol_static = newObjectRef(value); break;
+ case R_DotsSymbol_x: R_DotsSymbol_static = newObjectRef(value); break;
+ case R_DropSymbol_x: R_DropSymbol_static = newObjectRef(value); break;
+ case R_LastvalueSymbol_x: R_LastvalueSymbol_static = newObjectRef(value); break;
+ case R_LevelsSymbol_x: R_LevelsSymbol_static = newObjectRef(value); break;
+ case R_ModeSymbol_x: R_ModeSymbol_static = newObjectRef(value); break;
+ case R_NameSymbol_x: R_NameSymbol_static = newObjectRef(value); break;
+ case R_NamesSymbol_x: R_NamesSymbol_static = newObjectRef(value); break;
+ case R_NaRmSymbol_x: R_NaRmSymbol_static = newObjectRef(value); break;
+ case R_PackageSymbol_x: R_PackageSymbol_static = newObjectRef(value); break;
+ case R_QuoteSymbol_x: R_QuoteSymbol_static = newObjectRef(value); break;
+ case R_RowNamesSymbol_x: R_RowNamesSymbol_static = newObjectRef(value); break;
+ case R_SeedsSymbol_x: R_SeedsSymbol_static = newObjectRef(value); break;
+ case R_SourceSymbol_x: R_SourceSymbol_static = newObjectRef(value); break;
+ case R_TspSymbol_x: R_TspSymbol_static = newObjectRef(value); break;
+ case R_dot_defined_x: R_dot_defined_static = newObjectRef(value); break;
+ case R_dot_Method_x: R_dot_Method_static = newObjectRef(value); break;
+ case R_dot_target_x: R_dot_target_static = newObjectRef(value); break;
+ case R_SrcrefSymbol_x: R_SrcrefSymbol_static = newObjectRef(value); break;
+ case R_SrcfileSymbol_x: R_SrcfileSymbol_static = newObjectRef(value); break;
+ case R_NaString_x: R_NaString_static = newObjectRef(value); break;
+ case R_BlankString_x: R_BlankString_static = newObjectRef(value); break;
+ case R_BlankScalarString_x: R_BlankString_static = newObjectRef(value); break;
+ case R_BaseSymbol_x: R_BaseSymbol_static = newObjectRef(value); break;
+ case R_NamespaceEnvSymbol_x: R_NamespaceEnvSymbol_static = newObjectRef(value); break;
+ // case R_RestartToken_x: R_RestartToken_static = newObjectRef(value); break;
+ default:
+ printf("Call_initvar_obj: unimplemented index %d\n", index);
+ exit(1);
+ }
+}
+
diff --git a/com.oracle.truffle.r.native/gnur/Makefile.gnur b/com.oracle.truffle.r.native/gnur/Makefile.gnur
index abc5c59b12..a6819b2a23 100644
--- a/com.oracle.truffle.r.native/gnur/Makefile.gnur
+++ b/com.oracle.truffle.r.native/gnur/Makefile.gnur
@@ -40,12 +40,12 @@
OSNAME := $(shell uname)
-ifdef FASTR_TRUFFLE_RFFI
+ifeq ($(FASTR_RFFI),llvm)
FC_DIR := $(abspath $(TOPDIR)/../mx.fastr/compilers)
FASTR_COMPILERS := CC=$(FC_DIR)/fastr-cc FC=$(FC_DIR)/fastr-fc F77=$(FC_DIR)/fastr-fc CXX=$(FC_DIR)/fastr-c++ CXXCPP=$(FC_DIR)/fastr-cpp OBJC=$(FC_DIR)/fastr-cc
endif
-ifndef FASTR_TRUFFLE_RFFI
+ifneq ($(FASTR_RFFI),llvm)
# LLVM text parser and -g don't get on
OPT_FLAGS := -g -O2
OPT_FLAGS := -O2
diff --git a/com.oracle.truffle.r.native/library/lib.mk b/com.oracle.truffle.r.native/library/lib.mk
index 727f096cb6..4f6a44fcb9 100644
--- a/com.oracle.truffle.r.native/library/lib.mk
+++ b/com.oracle.truffle.r.native/library/lib.mk
@@ -1,5 +1,5 @@
#
-# Copyright (c) 2014, 2016, Oracle and/or its affiliates. All rights reserved.
+# 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
@@ -103,9 +103,9 @@ $(GNUR_F_OBJECTS): | $(OBJ)
$(OBJ):
mkdir -p $(OBJ)
-$(LIB_PKG): $(C_OBJECTS) $(F_OBJECTS) $(GNUR_C_OBJECTS) $(GNUR_F_OBJECTS) $(PKGDIR)
+$(LIB_PKG): $(C_OBJECTS) $(F_OBJECTS) $(GNUR_C_OBJECTS) $(GNUR_F_OBJECTS) $(PKGDIR) $(XTRA_C_OBJECTS)
mkdir -p $(LIBDIR)
- $(DYLIB_LD) $(DYLIB_LDFLAGS) -o $(LIB_PKG) $(C_OBJECTS) $(F_OBJECTS) $(GNUR_C_OBJECTS) $(GNUR_F_OBJECTS) $(PKG_LIBS)
+ $(DYLIB_LD) $(DYLIB_LDFLAGS) -o $(LIB_PKG) $(C_OBJECTS) $(F_OBJECTS) $(GNUR_C_OBJECTS) $(GNUR_F_OBJECTS) $(XTRA_C_OBJECTS) $(PKG_LIBS)
mkdir -p $(FASTR_LIBRARY_DIR)/$(PKG)/libs
cp $(LIB_PKG) $(FASTR_LIBRARY_DIR)/$(PKG)/libs
ifeq ($(OS_NAME),Darwin)
diff --git a/com.oracle.truffle.r.native/library/tools/Makefile b/com.oracle.truffle.r.native/library/tools/Makefile
index 3bf843f957..f044af7d7e 100644
--- a/com.oracle.truffle.r.native/library/tools/Makefile
+++ b/com.oracle.truffle.r.native/library/tools/Makefile
@@ -1,5 +1,5 @@
#
-# Copyright (c) 2014, 2016, Oracle and/or its affiliates. All rights reserved.
+# 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
@@ -33,6 +33,21 @@ LIB_PKG_PRE = $(GRAMRD_OBJ)
CLEAN_PKG = rm_gramRd
+ifeq ($(FASTR_RFFI),nfi)
+XTRA_C_SOURCES += $(SRC)/truffle_nfi/gramRd_nfi.c
+XTRA_C_OBJECTS += $(OBJ)/gramRd_nfi.o
+else
+ifeq ($(FASTR_RFFI),llvm)
+XTRA_C_SOURCES += $(SRC)/truffle_llvm/gramRd_llvm.c
+XTRA_C_OBJECTS += $(OBJ)/gramRd_llvm.o
+else
+ifeq ($(FASTR_RFFI),jni)
+XTRA_C_SOURCES += $(SRC)/jni/gramRd_jni.c
+XTRA_C_OBJECTS += $(OBJ)/gramRd_jni.o
+endif
+endif
+endif
+
include ../lib.mk
# in case already generated
@@ -46,5 +61,11 @@ $(SRC)/gramRd.c: $(GNUR_SRC)/gramRd.c
$(OBJ)/%.o: $(GNUR_SRC)/%.c
$(CC) $(CFLAGS) $(INCLUDES) -c $< -o $@
+$(OBJ)/gramRd_nfi.o: $(SRC)/truffle_nfi/gramRd_nfi.c
+ $(CC) $(CFLAGS) $(FFI_INCLUDES) -c $< -o $@
+
+$(OBJ)/gramRd_jni.o: $(SRC)/jni/gramRd_jni.c
+ $(CC) $(CFLAGS) $(INCLUDES) -c $< -o $@
+
rm_gramRd:
rm -f $(SRC)/gramRd.c
diff --git a/com.oracle.truffle.r.native/library/tools/src/gramRd_jni.c b/com.oracle.truffle.r.native/library/tools/src/jni/gramRd_jni.c
similarity index 94%
rename from com.oracle.truffle.r.native/library/tools/src/gramRd_jni.c
rename to com.oracle.truffle.r.native/library/tools/src/jni/gramRd_jni.c
index c109bff1be..14eb60c2e9 100644
--- a/com.oracle.truffle.r.native/library/tools/src/gramRd_jni.c
+++ b/com.oracle.truffle.r.native/library/tools/src/jni/gramRd_jni.c
@@ -1,5 +1,5 @@
/*
- * Copyright (c) 2016, 2016, Oracle and/or its affiliates. All rights reserved.
+ * Copyright (c) 2016, 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
@@ -20,7 +20,7 @@
* or visit www.oracle.com if you need additional information or have any
* questions.
*/
-#include "gramRd_fastr.h"
+#include "../gramRd_fastr.h"
#include <jni.h>
extern JNIEnv *getEnv();
diff --git a/com.oracle.truffle.r.native/library/tools/src/truffle_nfi/gramRd_nfi.c b/com.oracle.truffle.r.native/library/tools/src/truffle_nfi/gramRd_nfi.c
new file mode 100644
index 0000000000..c5716bb4c3
--- /dev/null
+++ b/com.oracle.truffle.r.native/library/tools/src/truffle_nfi/gramRd_nfi.c
@@ -0,0 +1,33 @@
+/*
+ * Copyright (c) 2016, 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 "../gramRd_fastr.h"
+
+static int (*call_RConnGetC)(void *conn);
+
+void gramRd_nfi_init(void *closure) {
+ call_RConnGetC = closure;
+}
+
+int callGetCMethod(void *conn) {
+ return call_RConnGetC(conn);
+}
diff --git a/com.oracle.truffle.r.native/version.source b/com.oracle.truffle.r.native/version.source
index 98d9bcb75a..3c032078a4 100644
--- a/com.oracle.truffle.r.native/version.source
+++ b/com.oracle.truffle.r.native/version.source
@@ -1 +1 @@
-17
+18
diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/LaFunctions.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/LaFunctions.java
index c379ee6da5..5be9dfbdad 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/LaFunctions.java
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/LaFunctions.java
@@ -379,6 +379,7 @@ public class LaFunctions {
}
@Specialization
+
protected RList doDetGeReal(RAbstractDoubleVector aIn, boolean useLog,
@Cached("create()") GetDimAttributeNode getDimsNode,
@Cached("create()") LapackRFFI.DgetrfNode dgetrfNode) {
diff --git a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/generic/Generic_Tools.java b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/generic/Generic_Tools.java
index 170f820fd2..06d6fa23d7 100644
--- a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/generic/Generic_Tools.java
+++ b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/generic/Generic_Tools.java
@@ -37,12 +37,12 @@ import com.oracle.truffle.r.runtime.ffi.RFFIFactory;
import com.oracle.truffle.r.runtime.ffi.ToolsRFFI;
public class Generic_Tools implements ToolsRFFI {
- private static class Generic_ToolsRFFINode extends ParseRdNode {
+ public static class Generic_ToolsRFFINode extends ParseRdNode {
private static final String C_PARSE_RD = "C_parseRd";
- private static final String TOOLS = "tools";
+ protected static final String TOOLS = "tools";
@Child private CallRFFI.InvokeCallNode callRFFINode = RFFIFactory.getRFFI().getCallRFFI().createInvokeCallNode();
- @Child DLL.RFindSymbolNode findSymbolNode = DLL.RFindSymbolNode.create();
+ @Child private DLL.RFindSymbolNode findSymbolNode = DLL.RFindSymbolNode.create();
@CompilationFinal private NativeCallInfo nativeCallInfo;
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 00825a42b4..c1d2879620 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
@@ -309,12 +309,16 @@ public class DLL {
* Abstracts the way that DLL function symbols are represented, either as a machine address (
* {@link Long}) or a {@link TruffleObject}. At the present time, both forms can exists within a
* single VM, so the class is defined as a "union" for simplicity.
+ *
+ * N.B. It is explicitly allowed to register a {@code null} value as the base package registers
+ * some (Fortran) functions that are implemented in Java but have a bogus (zero) native symbol
+ * definition. Any use of {@code null} is failed
*/
public static final class SymbolHandle {
public final Object value;
public SymbolHandle(Object value) {
- assert value instanceof Long || value instanceof TruffleObject;
+ assert value == null || value instanceof Long || value instanceof TruffleObject;
this.value = value;
}
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFIFactory.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFIFactory.java
index 963d98cc59..b443cb0a7c 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFIFactory.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFIFactory.java
@@ -47,7 +47,7 @@ public abstract class RFFIFactory {
private static final String FACTORY_CLASS_PROPERTY = "fastr.rffi.factory.class";
private static final String FACTORY_CLASS_NAME_PROPERTY = "fastr.rffi.factory";
- private static final String FACTORY_CLASS_ENV = "FASTR_RFFI_FACTORY";
+ private static final String FACTORY_CLASS_ENV = "FASTR_RFFI";
private static final Factory DEFAULT_FACTORY = Factory.JNI;
/**
diff --git a/com.oracle.truffle.r.test.native/Makefile b/com.oracle.truffle.r.test.native/Makefile
index 9c3c1b9ffc..8045621a3c 100644
--- a/com.oracle.truffle.r.test.native/Makefile
+++ b/com.oracle.truffle.r.test.native/Makefile
@@ -35,13 +35,17 @@ all:
$(MAKE) -C urand
$(MAKE) -C packages
ifneq ($(OSNAME), SunOS)
+ifeq ($(FASTR_RFFI),jni)
$(MAKE) -C embedded
endif
+endif
clean:
$(MAKE) -C urand clean
$(MAKE) -C packages clean
ifneq ($(OSNAME), SunOS)
+ifeq ($(FASTR_RFFI),jni)
$(MAKE) -C embedded clean
+endif
endif
rm -f $(REPO_DIR)/*
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/tools/RFFIUpCallMethodGenerate.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/tools/RFFIUpCallMethodGenerate.java
index b538c5c44d..03d88811d9 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/tools/RFFIUpCallMethodGenerate.java
+++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/tools/RFFIUpCallMethodGenerate.java
@@ -24,6 +24,7 @@ package com.oracle.truffle.r.test.tools;
import java.lang.annotation.Annotation;
import java.lang.reflect.Method;
+import java.lang.reflect.Modifier;
import java.util.Arrays;
import java.util.Comparator;
@@ -36,8 +37,23 @@ import com.oracle.truffle.r.runtime.ffi.UpCallsRFFI;
*/
public class RFFIUpCallMethodGenerate {
- public static void main(String[] args) {
- Method[] methods = UpCallsRFFI.class.getMethods();
+ public static void main(String[] args) throws Exception {
+ String klassName = "com.oracle.truffle.r.runtime.ffi.UpCallsRFFI";
+ boolean klassArg = false;
+
+ int i = 0;
+ while (i < args.length) {
+ String arg = args[i];
+ if (arg.equals("--class")) {
+ i++;
+ klassName = args[i];
+ klassArg = true;
+ }
+ i++;
+ }
+
+ Class<?> klass = Class.forName(klassName);
+ Method[] methods = klassArg ? klass.getDeclaredMethods() : klass.getMethods();
Arrays.sort(methods, new Comparator<Method>() {
@@ -47,8 +63,11 @@ public class RFFIUpCallMethodGenerate {
}
});
- for (int i = 0; i < methods.length; i++) {
+ for (i = 0; i < methods.length; i++) {
Method m = methods[i];
+ if (klassArg && (Modifier.isStatic(m.getModifiers()))) {
+ continue;
+ }
String sig = getNFISignature(m);
System.out.printf("%s(\"%s\")%s%n", m.getName(), sig, i == methods.length - 1 ? ";" : ",");
}
@@ -92,12 +111,20 @@ public class RFFIUpCallMethodGenerate {
} else {
return rffiCstring.convert() ? "string" : "pointer";
}
+ case "char":
+ return "uint8";
case "int":
return "sint32";
case "double":
return "double";
case "void":
return "void";
+ case "int[]":
+ return "[sint32]";
+ case "double[]":
+ return "[double]";
+ case "byte[]":
+ return "[uint8]";
default:
return "object";
}
diff --git a/documentation/dev/ffi.md b/documentation/dev/ffi.md
index 1ebb04860b..69fb145d11 100644
--- a/documentation/dev/ffi.md
+++ b/documentation/dev/ffi.md
@@ -1,7 +1,8 @@
# The R FFI Implementation
# Introduction
-FastR interfaces to native C and Fortran code in a number of ways, for example, access to C library APIs not supported by the Java JDK, access to LaPack functions, and the `.Call`, `.Fortran`, `.C` builtins. Each of these are defined by a Java interface,e.g. `CallRFFI` for the `.Call` builtin. To facilitate experimentation and different implementations, the implementation of these interfaces is defined by a factory class, `RFFIFactory`, that is chosen at run time via the `fastr.ffi.factory.class` system property. The factory is responsible for creating an instance of the `RFFI` interface that in turn provides access to implementations of the underlying interfaces such as `CallRFFI`. This structure allows
+FastR interfaces to native C and Fortran code in a number of ways, for example, access to C library APIs not supported by the Java JDK, access to LaPack functions, and the `.Call`, `.Fortran`, `.C` builtins. Each of these are defined by a Java interface,e.g. `CallRFFI` for the `.Call` builtin. To facilitate experimentation and different implementations, the implementation of these interfaces is defined by a factory class, `RFFIFactory`, that is chosen at run time via the `fastr.ffi.factory.class` system property, or the `FASTR_RFFI` environment variable.
+The factory is responsible for creating an instance of the `RFFI` interface that in turn provides access to implementations of the underlying interfaces such as `CallRFFI`. This structure allows
for each of the individual interfaces to be implemented by a different mechanism. Currently the default factory class is `JNI_RFFIFactory` which uses the Java JNI system to implement the transition to native code.
# Native Implementation
@@ -10,10 +11,11 @@ the `com.oracle/truffle.r.native` project`. It's actually a bit more than that a
simple that it is neither necessary nor desirable to implement in Java. As this has evolved a better name for `fficall` would probably be `main`
for compatibility with GNU R.
- There are four sub-directories in `fficall/src`:
+ There are five sub-directories in `fficall/src`:
* `include`
* `common`
* `jni`
+ * `truffle_nfi`
* `truffle_llvm`
## The `fficall/include` directory
@@ -44,7 +46,11 @@ copied/included from GNU R. N.B. Some modified files have a `_fastr` suffix to a
the Makefile rule for compiling directly from the GNU R file.
## The `jni` directory
-`jni` contains the implementation that is based on and has explicit dependencies on Java JNI. It is described in more detail [here](jni_ffi.md)
+`jni` contains the implementation that is based on and has explicit dependencies on Java JNI. It is described in more detail [here](jni_ffi.md). This is the default implementation.
+
+## The `truffle_nfi` directory.
+`truffle_nfi` contains the implementation that is based on the Truffle Native Function Interface. It is enabled by setting `FASTR_RFFIU=nfi` and doing a clean build.
+The implementation is currently incomplete.
## The `truffle_llvm` directory
diff --git a/mx.fastr/copyrights/overrides b/mx.fastr/copyrights/overrides
index a09bd8bac8..c78942645b 100644
--- a/mx.fastr/copyrights/overrides
+++ b/mx.fastr/copyrights/overrides
@@ -115,6 +115,9 @@ com.oracle.truffle.r.native/fficall/src/include/rlocale.h,gnu_r_gentleman_ihaka.
com.oracle.truffle.r.native/fficall/src/jni/Memory.c,gnu_r.copyright
com.oracle.truffle.r.native/fficall/src/jni/pcre_rffi.c,gnu_r_gentleman_ihaka2.copyright
com.oracle.truffle.r.native/fficall/src/jni/Rdynload_fastr.c,gnu_r.copyright
+com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rdynload_fastr.c,gnu_r.copyright
+com.oracle.truffle.r.native/fficall/src/truffle_nfi/Memory.c,gnu_r.copyright
+com.oracle.truffle.r.native/fficall/src/truffle_nfi/pcre_rffi.c,gnu_r_gentleman_ihaka2.copyright
com.oracle.truffle.r.native/fficall/src/truffle_llvm/Rdynload_fastr.c,gnu_r.copyright
com.oracle.truffle.r.native/fficall/src/jni/Rembedded.c,gnu_r.copyright
com.oracle.truffle.r.native/include/src/libintl.h,no.copyright
diff --git a/mx.fastr/mx_fastr.py b/mx.fastr/mx_fastr.py
index 259351b416..0bc160dec4 100644
--- a/mx.fastr/mx_fastr.py
+++ b/mx.fastr/mx_fastr.py
@@ -29,7 +29,7 @@ import mx_fastr_pkgs
import mx_fastr_compile
import mx_fastr_dists
import mx_fastr_junit
-from mx_fastr_dists import FastRNativeProject, FastRTestNativeProject, FastRReleaseProject, FastRNativeRecommendedProject #pylint: disable=unused-import
+from mx_fastr_dists import FastRTestNativeProject, FastRReleaseProject, FastRNativeRecommendedProject #pylint: disable=unused-import
import mx_copylib
import mx_fastr_mkgramrd
import mx_fastr_edinclude
diff --git a/mx.fastr/mx_fastr_dists.py b/mx.fastr/mx_fastr_dists.py
index 68066b43ce..2f81965b06 100644
--- a/mx.fastr/mx_fastr_dists.py
+++ b/mx.fastr/mx_fastr_dists.py
@@ -43,74 +43,6 @@ class FastRProjectAdapter(mx.ArchivableProject):
results.append(join(root, f))
-class FastRNativeProject(FastRProjectAdapter):
- '''
- Custom class for building the com.oracle.truffle.r.native project.
- The customization is to support the creation of an exact FASTR_NATIVE_DEV distribution.
- '''
- def __init__(self, suite, name, deps, workingSets, theLicense, **args):
- FastRProjectAdapter.__init__(self, suite, name, deps, workingSets, theLicense)
-
- def getBuildTask(self, args):
- return mx.NativeBuildTask(args, self)
-
- def _get_gnur_files(self, gnur_dir, files, results):
- for f in files:
- results.append(join(self.dir, gnur_dir, f))
-
- def getResults(self):
- '''
- Capture all the files from the com.oracle.truffle.r.native project that are needed
- in an alternative implementation of the R FFI. This includes some files from GNU R.
- This code has to be kept in sync with the FFI implementation.
- '''
- # plain files
- results = [join(self.dir, "platform.mk")]
- gnur = join('gnur', mx_fastr.r_version())
- gnur_appl = join(gnur, 'src', 'appl')
- self._get_gnur_files(gnur_appl, ['pretty.c', 'interv.c'], results)
- gnur_main = join(gnur, 'src', 'main')
- self._get_gnur_files(gnur_main, ['colors.c', 'devices.c', 'engine.c', 'format.c', 'graphics.c',
- 'plot.c', 'plot3d.c', 'plotmath.c', 'rlocale.c', 'sort.c'], results)
- # these files are not compiled, just "included"
- self._get_gnur_files(gnur_main, ['xspline.c', 'rlocale_data.h'], results)
- # directories
- for d in ["fficall/src/common", "fficall/src/include", "fficall/src/variable_defs"]:
- self._get_files(d, results)
-
- def is_dot_h(f):
- ext = os.path.splitext(f)[1]
- return ext == '.h'
-
- # just the .h files from 'include'
- self._get_files('include', results, is_dot_h)
-
- # tools for alternate impl of gramRd.c
- gnur_tools = join(gnur, 'library', 'tools')
- self._get_files(gnur_tools, results)
- gnur_tools_src = join(gnur, 'src', 'library', 'tools', 'src')
- for f in ['gramRd.c', 'init.c', 'tools.h']:
- results.append(join(self.dir, gnur_tools_src, f))
- for f in ['lib.mk', 'Makefile', 'tools/src/tools_dummy.c', 'tools/src/gramRd_fastr.h', 'tools/Makefile']:
- results.append(join(self.dir, 'library', f))
-
- # selected headers from GNU R source
- with open(join(self.dir, 'fficall/src/include/gnurheaders.mk')) as f:
- lines = f.readlines()
- for line in lines:
- if '$(GNUR_HOME)' in line:
- parts = line.split(' ')
- results.append(join(self.dir, parts[2].rstrip().replace('$(GNUR_HOME)', gnur)))
-
- def is_ddot_o(f):
- ext = os.path.splitext(f)[1]
- return f[0] == 'd' and ext == '.o'
-
- # binary files from GNU R
- self._get_files(gnur_appl, results, is_ddot_o)
-
- return results
-
class FastRTestNativeProject(FastRProjectAdapter):
'''
Custom class for building the com.oracle.truffle.r.native project.
diff --git a/mx.fastr/suite.py b/mx.fastr/suite.py
index ea8973c6b8..39727463a8 100644
--- a/mx.fastr/suite.py
+++ b/mx.fastr/suite.py
@@ -197,6 +197,7 @@ suite = {
"com.oracle.truffle.r.parser",
"truffle:JLINE",
"truffle:TRUFFLE_DEBUG",
+ "truffle:TRUFFLE_NFI",
],
"generatedDependencies" : [
"com.oracle.truffle.r.parser",
@@ -243,11 +244,13 @@ suite = {
"dependencies" : [
"GNUR",
"GNU_ICONV",
+ "truffle:TRUFFLE_NFI_NATIVE",
],
"native" : "true",
- "class" : "FastRNativeProject",
- "output" : "com.oracle.truffle.r.native",
"workingSets" : "FastR",
+ "buildEnv" : {
+ "NFI_INCLUDES" : "-I<path:truffle:TRUFFLE_NFI_NATIVE>/include",
+ },
},
"com.oracle.truffle.r.library" : {
@@ -315,6 +318,8 @@ suite = {
"distDependencies" : [
"truffle:TRUFFLE_API",
"truffle:TRUFFLE_DEBUG",
+ "truffle:TRUFFLE_NFI",
+ "truffle:TRUFFLE_NFI_NATIVE",
"TRUFFLE_R_PARSER_PROCESSOR",
],
},
@@ -336,8 +341,6 @@ suite = {
"FASTR_UNIT_TESTS_NATIVE" : {
"description" : "unit tests support (from test.native project)",
- "dependencies" : ["com.oracle.truffle.r.test.native"],
- "distDependencies" : ["FASTR_NATIVE_DEV"],
"exclude" : ["GNUR", "GNU_ICONV"],
"os_arch" : {
"linux" : {
@@ -361,35 +364,6 @@ suite = {
},
},
- "FASTR_NATIVE_DEV": {
- "description" : "support for overriding the native project implementation in a separate suite",
- "dependencies" : ["com.oracle.truffle.r.native"],
- "exclude" : [
- "GNUR",
- "GNU_ICONV",
- ],
- "os_arch" : {
- "linux" : {
- "amd64" : {
- "path" : "mxbuild/dists/linux/amd64/fastr-native-dev.jar",
- },
- "sparcv9" : {
- "path" : "mxbuild/dists/linux/sparcv9/fastr-native-dev.jar",
- },
- },
- "darwin" : {
- "amd64" : {
- "path" : "mxbuild/dists/darwin/amd64/fastr-native-dev.jar",
- },
- },
- "solaris" : {
- "sparcv9" : {
- "path" : "mxbuild/dists/solaris/sparcv9/fastr-native-dev.jar",
- },
- },
- },
- },
-
"FASTR_RELEASE": {
"description" : "a binary release of FastR",
"dependencies" : ["com.oracle.truffle.r.release"],
--
GitLab