From 11764e0c9d209ccd4cb072c8477a9f24a98fc712 Mon Sep 17 00:00:00 2001 From: Mick Jordan <mick.jordan@oracle.com> Date: Wed, 21 Jun 2017 09:25:30 -0700 Subject: [PATCH] LLVM: remove all reflective upcalls, share with NFI --- .../r/ffi/impl/common/Generic_PkgInit.java | 67 + .../ffi/impl/common/JavaUpCallsRFFIImpl.java | 43 +- .../r/ffi/impl/common/PkgInitUpCalls.java | 80 ++ .../impl/common/TracingUpCallsRFFIImpl.java | 12 +- .../r/ffi/impl/common/TruffleUnwrap.java | 70 ++ .../r/ffi/impl/interop/base/GlobResultMR.java | 7 + .../impl/interop/base/ReadlinkResultMR.java | 7 + .../ffi/impl/interop/base/StrtolResultMR.java | 7 + .../ffi/impl/interop/base/UnameResultMR.java | 7 + .../interop/pcre/CaptureNamesResultMR.java | 7 + .../impl/interop/pcre/CompileResultMR.java | 7 + .../interop/pkginit/ForceSymbolsCall.java | 46 + .../interop/pkginit/ForceSymbolsCallMR.java | 46 + .../interop/pkginit/GetCCallableCall.java | 46 + .../interop/pkginit/GetCCallableCallMR.java | 45 + .../pkginit/RegisterCCallableCall.java | 46 + .../pkginit/RegisterCCallableCallMR.java | 45 + .../interop/pkginit/RegisterRoutinesCall.java | 46 + .../pkginit/RegisterRoutinesCallMR.java | 46 + .../pkginit/SetDotSymbolValuesCall.java | 46 + .../pkginit/SetDotSymbolValuesCallMR.java | 46 + .../pkginit/UseDynamicSymbolsCall.java | 46 + .../pkginit/UseDynamicSymbolsCallMR.java | 46 + .../truffle/r/ffi/impl/jni/JNI_PkgInit.java | 13 +- .../r/ffi/impl/llvm/TruffleLLVM_Base.java | 43 - .../r/ffi/impl/llvm/TruffleLLVM_Call.java | 64 +- .../ffi/impl/llvm/TruffleLLVM_NativeDLL.java | 32 +- .../r/ffi/impl/llvm/TruffleLLVM_PCRE.java | 37 +- .../r/ffi/impl/llvm/TruffleLLVM_PkgInit.java | 91 +- .../llvm/TruffleLLVM_RFFIContextState.java | 20 - .../r/ffi/impl/llvm/TruffleLLVM_Stats.java | 11 - .../r/ffi/impl/llvm/TruffleLLVM_Tools.java | 33 +- .../llvm/TruffleLLVM_UpCallsRFFIImpl.java | 85 +- .../r/ffi/impl/llvm/TruffleLLVM_Utils.java | 14 - .../upcalls/BytesToNativeCharArrayCall.java | 47 + .../upcalls/BytesToNativeCharArrayCallMR.java | 47 + .../upcalls/CharSXPToNativeArrayCall.java | 46 + .../upcalls/CharSXPToNativeArrayCallMR.java | 47 + .../r/ffi/impl/nfi/TruffleNFI_Base.java | 2 +- .../r/ffi/impl/nfi/TruffleNFI_Utils.java | 17 - .../r/ffi/impl/upcalls/StdUpCallsRFFI.java | 12 +- .../truffle/r/ffi/processor/FFIProcessor.java | 2 +- .../fficall/src/common/Makefile | 2 +- .../fficall/src/jni/Rinternals.c | 12 +- .../src/truffle_common/Rdynload_fastr.h | 138 ++ .../Rinternals_truffle_common.h | 1107 +++++++++++++++++ .../fficall/src/truffle_common/base_rffi.h | 76 ++ .../fficall/src/truffle_common/pcre_rffi.h | 76 ++ .../fficall/src/truffle_llvm/Makefile | 7 +- .../fficall/src/truffle_llvm/Rdynload_fastr.c | 106 +- .../fficall/src/truffle_llvm/Rinternals.c | 1067 +--------------- .../fficall/src/truffle_llvm/base_rffi.c | 57 +- .../fficall/src/truffle_llvm/call_dlopen.c | 4 +- .../fficall/src/truffle_llvm/pcre_rffi.c | 58 +- .../fficall/src/truffle_llvm/rffiutils.c | 15 +- .../fficall/src/truffle_llvm/rffiutils.h | 5 +- .../fficall/src/truffle_llvm/variables.c | 7 +- .../fficall/src/truffle_nfi/Makefile | 3 +- .../fficall/src/truffle_nfi/Rinternals.c | 1101 +--------------- .../fficall/src/truffle_nfi/base_rffi.c | 42 +- .../fficall/src/truffle_nfi/pcre_rffi.c | 53 +- .../tools/src/truffle_llvm/gramRd_llvm.c | 12 +- .../com/oracle/truffle/r/runtime/RError.java | 1 + .../com/oracle/truffle/r/runtime/ffi/DLL.java | 11 + .../truffle/r/runtime/ffi/RFFIFactory.java | 35 +- .../urand/Makefile | 2 +- documentation/dev/truffle_llvm_ffi.md | 23 +- mx.fastr/mx_fastr_compile.py | 2 +- 68 files changed, 2688 insertions(+), 2861 deletions(-) create mode 100644 com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/Generic_PkgInit.java create mode 100644 com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/PkgInitUpCalls.java create mode 100644 com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/TruffleUnwrap.java create mode 100644 com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/ForceSymbolsCall.java create mode 100644 com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/ForceSymbolsCallMR.java create mode 100644 com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/GetCCallableCall.java create mode 100644 com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/GetCCallableCallMR.java create mode 100644 com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/RegisterCCallableCall.java create mode 100644 com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/RegisterCCallableCallMR.java create mode 100644 com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/RegisterRoutinesCall.java create mode 100644 com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/RegisterRoutinesCallMR.java create mode 100644 com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/SetDotSymbolValuesCall.java create mode 100644 com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/SetDotSymbolValuesCallMR.java create mode 100644 com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/UseDynamicSymbolsCall.java create mode 100644 com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/UseDynamicSymbolsCallMR.java create mode 100644 com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/upcalls/BytesToNativeCharArrayCall.java create mode 100644 com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/upcalls/BytesToNativeCharArrayCallMR.java create mode 100644 com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/upcalls/CharSXPToNativeArrayCall.java create mode 100644 com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/upcalls/CharSXPToNativeArrayCallMR.java create mode 100644 com.oracle.truffle.r.native/fficall/src/truffle_common/Rdynload_fastr.h create mode 100644 com.oracle.truffle.r.native/fficall/src/truffle_common/Rinternals_truffle_common.h create mode 100644 com.oracle.truffle.r.native/fficall/src/truffle_common/base_rffi.h create mode 100644 com.oracle.truffle.r.native/fficall/src/truffle_common/pcre_rffi.h diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/Generic_PkgInit.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/Generic_PkgInit.java new file mode 100644 index 0000000000..b1147fa64c --- /dev/null +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/Generic_PkgInit.java @@ -0,0 +1,67 @@ +/* + * Copyright (c) 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.ffi.impl.common; + +import com.oracle.truffle.r.runtime.ffi.DLL; +import com.oracle.truffle.r.runtime.ffi.DLL.CEntry; +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 abstract class Generic_PkgInit implements PkgInitUpCalls { + @Override + public int registerRoutines(DLLInfo dllInfo, int nstOrd, int num, long routines) { + DotSymbol[] array = new DotSymbol[num]; + for (int i = 0; i < num; i++) { + Object sym = setSymbol(dllInfo, nstOrd, routines, i); + array[i] = (DotSymbol) sym; + } + dllInfo.setNativeSymbols(nstOrd, array); + return 0; + } + + @Override + public int registerCCallable(String pkgName, String functionName, Object address) { + DLLInfo lib = DLL.safeFindLibrary(pkgName); + lib.registerCEntry(new CEntry(functionName, new SymbolHandle(address))); + return 0; + } + + @Override + public int useDynamicSymbols(DLLInfo dllInfo, int value) { + return DLL.useDynamicSymbols(dllInfo, value); + } + + @Override + public int forceSymbols(DLLInfo dllInfo, int value) { + return DLL.forceSymbols(dllInfo, value); + } + + @Override + public DotSymbol setDotSymbolValues(DLLInfo dllInfo, String name, Object fun, int numArgs) { + DotSymbol result = new DotSymbol(name, new SymbolHandle(fun), numArgs); + return result; + } + + protected abstract Object setSymbol(DLLInfo dllInfo, int nstOrd, long routines, int index); +} diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/JavaUpCallsRFFIImpl.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/JavaUpCallsRFFIImpl.java index 3b073fef24..f1fd7172b7 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/JavaUpCallsRFFIImpl.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/JavaUpCallsRFFIImpl.java @@ -390,32 +390,33 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI { } @Override - public Object Rf_allocVector(int mode, int n) { + public Object Rf_allocVector(int mode, long n) { SEXPTYPE type = SEXPTYPE.mapInt(mode); - if (n < 0) { - throw RError.error(RError.SHOW_CALLER2, RError.Message.NEGATIVE_LENGTH_VECTORS_NOT_ALLOWED); + if (n > Integer.MAX_VALUE) { + throw RError.error(RError.SHOW_CALLER2, RError.Message.LONG_VECTORS_NOT_SUPPORTED); // TODO check long vector } + int ni = (int) n; switch (type) { case INTSXP: - return RDataFactory.createIntVector(new int[n], RDataFactory.COMPLETE_VECTOR); + return RDataFactory.createIntVector(new int[ni], RDataFactory.COMPLETE_VECTOR); case REALSXP: - return RDataFactory.createDoubleVector(new double[n], RDataFactory.COMPLETE_VECTOR); + return RDataFactory.createDoubleVector(new double[ni], RDataFactory.COMPLETE_VECTOR); case LGLSXP: - return RDataFactory.createLogicalVector(new byte[n], RDataFactory.COMPLETE_VECTOR); + return RDataFactory.createLogicalVector(new byte[ni], RDataFactory.COMPLETE_VECTOR); case STRSXP: // fill list with empty strings - String[] data = new String[n]; + String[] data = new String[ni]; Arrays.fill(data, ""); return RDataFactory.createStringVector(data, RDataFactory.COMPLETE_VECTOR); case CPLXSXP: - return RDataFactory.createComplexVector(new double[2 * n], RDataFactory.COMPLETE_VECTOR); + return RDataFactory.createComplexVector(new double[2 * ni], RDataFactory.COMPLETE_VECTOR); case RAWSXP: - return RDataFactory.createRawVector(new byte[n]); + return RDataFactory.createRawVector(new byte[ni]); case VECSXP: - return RDataFactory.createList(n); + return RDataFactory.createList(ni); case LANGSXP: - return RDataFactory.createLangPairList(n); + return RDataFactory.createLangPairList(ni); default: throw unimplemented("unexpected SEXPTYPE " + type); } @@ -484,21 +485,21 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI { } @Override - public int SET_STRING_ELT(Object x, int i, Object v) { + public int SET_STRING_ELT(Object x, long i, Object v) { RStringVector vector = guaranteeInstanceOf(x, RStringVector.class); CharSXPWrapper element = guaranteeInstanceOf(v, CharSXPWrapper.class); String value = element.getContents(); if (RRuntime.isNA(value)) { vector.setComplete(false); } - vector.setElement(i, value); + vector.setElement((int) i, value); return 0; } @Override - public int SET_VECTOR_ELT(Object x, int i, Object v) { + public int SET_VECTOR_ELT(Object x, long i, Object v) { RList list = guaranteeInstanceOf(x, RList.class); - list.setElement(i, v); + list.setElement((int) i, v); return 0; } @@ -558,19 +559,19 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI { } @Override - public Object STRING_ELT(Object x, int i) { + public Object STRING_ELT(Object x, long i) { RAbstractStringVector vector = guaranteeInstanceOf(RRuntime.asAbstractVector(x), RAbstractStringVector.class); - return CharSXPWrapper.create(vector.getDataAt(i)); + return CharSXPWrapper.create(vector.getDataAt((int) i)); } @Override - public Object VECTOR_ELT(Object x, int i) { + public Object VECTOR_ELT(Object x, long i) { Object vec = x; if (vec instanceof RExpression) { - return ((RExpression) vec).getDataAt(i); + return ((RExpression) vec).getDataAt((int) i); } RAbstractListVector list = guaranteeInstanceOf(RRuntime.asAbstractVector(vec), RAbstractListVector.class); - return list.getDataAt(i); + return list.getDataAt((int) i); } @Override @@ -636,7 +637,7 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI { } @Override - public int Rf_any_duplicated(Object x, int fromLast) { + public long Rf_any_duplicated(Object x, int fromLast) { RAbstractVector vec = (RAbstractVector) x; if (vec.getLength() == 0) { return 0; diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/PkgInitUpCalls.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/PkgInitUpCalls.java new file mode 100644 index 0000000000..4323e860a1 --- /dev/null +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/PkgInitUpCalls.java @@ -0,0 +1,80 @@ +/* + * Copyright (c) 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.ffi.impl.common; + +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.r.runtime.ffi.DLL.DLLInfo; +import com.oracle.truffle.r.runtime.ffi.DLL.DotSymbol; + +public interface PkgInitUpCalls { + enum Index { + registerRoutines, + setDotSymbolValues, + useDynamicSymbols, + forceSymbols, + registerCCallable, + getCCallable; + } + + /** + * 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). + */ + int 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 a representation of the the C address of the function (in the table) + * @param numArgs the number of arguments the function takes. + */ + DotSymbol setDotSymbolValues(DLLInfo dllInfo, String name, Object 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); + + /** + * Directly implements {@code R_RegisterCCallable}. + */ + int registerCCallable(String pkgName, String functionName, Object fun); + + /** + * Directly implements {@code R_GetCCallable}. + */ + Object getCCallable(String pkgName, String functionName); +} diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/TracingUpCallsRFFIImpl.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/TracingUpCallsRFFIImpl.java index b779d8c54e..ad14f4a827 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/TracingUpCallsRFFIImpl.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/TracingUpCallsRFFIImpl.java @@ -220,7 +220,7 @@ final class TracingUpCallsRFFIImpl implements UpCallsRFFI { } @Override - public Object Rf_allocVector(int mode, int n) { + public Object Rf_allocVector(int mode, long n) { RFFIUtils.traceUpCall("Rf_allocateVector", mode, n); return delegate.Rf_allocVector(mode, n); } @@ -256,13 +256,13 @@ final class TracingUpCallsRFFIImpl implements UpCallsRFFI { } @Override - public int SET_STRING_ELT(Object x, int i, Object v) { + public int SET_STRING_ELT(Object x, long i, Object v) { RFFIUtils.traceUpCall("SET_STRING_ELT", x, i, v); return delegate.SET_STRING_ELT(x, i, v); } @Override - public int SET_VECTOR_ELT(Object x, int i, Object v) { + public int SET_VECTOR_ELT(Object x, long i, Object v) { RFFIUtils.traceUpCall("SET_VECTOR_ELT", i, v); return delegate.SET_VECTOR_ELT(x, i, v); } @@ -292,13 +292,13 @@ final class TracingUpCallsRFFIImpl implements UpCallsRFFI { } @Override - public Object STRING_ELT(Object x, int i) { + public Object STRING_ELT(Object x, long i) { RFFIUtils.traceUpCall("STRING_ELT", x, i); return delegate.STRING_ELT(x, i); } @Override - public Object VECTOR_ELT(Object x, int i) { + public Object VECTOR_ELT(Object x, long i) { RFFIUtils.traceUpCall("VECTOR_ELT", x, i); return delegate.VECTOR_ELT(x, i); } @@ -340,7 +340,7 @@ final class TracingUpCallsRFFIImpl implements UpCallsRFFI { } @Override - public int Rf_any_duplicated(Object x, int fromLast) { + public long Rf_any_duplicated(Object x, int fromLast) { RFFIUtils.traceUpCall("Rf_anyDuplicated", x, fromLast); return delegate.Rf_any_duplicated(x, fromLast); } diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/TruffleUnwrap.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/TruffleUnwrap.java new file mode 100644 index 0000000000..cd5f09b377 --- /dev/null +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/TruffleUnwrap.java @@ -0,0 +1,70 @@ +/* + * Copyright (c) 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.ffi.impl.common; + +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.api.interop.java.JavaInterop; +import com.oracle.truffle.r.ffi.impl.interop.NativePointer; +import com.oracle.truffle.r.runtime.RInternalError; +import com.oracle.truffle.r.runtime.data.RTruffleObject; +import com.oracle.truffle.r.runtime.ffi.RFFIFactory; + +public class TruffleUnwrap { + /** + * There are three possibilities as enumerated below. + * <ul> + * <li>For an {@link RTruffleObject} there is nothing to do, and indeed, calling {@code unbox} + * would be disastrous, as that means, e.g., for a RVector, extract the first element!</li> + * <li>Or we could get a {@code TruffleObject} from another language domain, e.g a + * {@code JavaObject} that wraps, say, an {@code Integer}.S Such a value has to be unboxed. + * Similarly a {@code NativePointer} encoding, say, a C char array. One special case in the LLVM + * implementation is {@code NativePointer} that represents an object stored to memory, which + * requires a lookup (and not an {@code UNBOX}).</li> + * <li>We could also get a plain {@link Integer} or similar type in which case there is nothing + * to do.</li> + * </ul> + */ + public static Object unwrap(Object x) { + if (x instanceof RTruffleObject) { + return x; + } else if (x instanceof TruffleObject) { + Object r = JavaInterop.unbox((TruffleObject) x); + if (r == null) { + // didn't UNBOX + if (RFFIFactory.getType() == RFFIFactory.Type.LLVM) { + TruffleObject xto = (TruffleObject) x; + TruffleObject xtoObject = NativePointer.check(xto); + if (xtoObject != null) { + return xtoObject; + } + } + throw RInternalError.shouldNotReachHere(); + } else { + return r; + } + } else { + return x; + } + } + +} diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/base/GlobResultMR.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/base/GlobResultMR.java index cf8b79b9db..1f40f124dd 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/base/GlobResultMR.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/base/GlobResultMR.java @@ -39,6 +39,13 @@ public class GlobResultMR { } } + @Resolve(message = "IS_EXECUTABLE") + public abstract static class GlobResultIsExecutable extends Node { + protected Object access(@SuppressWarnings("unused") GlobResult receiver) { + return true; + } + } + @Resolve(message = "EXECUTE") public abstract static class BaseGlobResultCallbackExecute extends Node { protected Object access(@SuppressWarnings("unused") VirtualFrame frame, GlobResult receiver, Object[] arguments) { diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/base/ReadlinkResultMR.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/base/ReadlinkResultMR.java index f36a55442f..59af7efb20 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/base/ReadlinkResultMR.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/base/ReadlinkResultMR.java @@ -39,6 +39,13 @@ public class ReadlinkResultMR { } } + @Resolve(message = "IS_EXECUTABLE") + public abstract static class ReadlinkResultIsExecutable extends Node { + protected Object access(@SuppressWarnings("unused") ReadlinkResult receiver) { + return true; + } + } + @Resolve(message = "EXECUTE") public abstract static class BaseReadlinkResultCallbackExecute extends Node { protected Object access(@SuppressWarnings("unused") VirtualFrame frame, ReadlinkResult receiver, Object[] arguments) { diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/base/StrtolResultMR.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/base/StrtolResultMR.java index 7ca8fbd422..7f427019eb 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/base/StrtolResultMR.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/base/StrtolResultMR.java @@ -39,6 +39,13 @@ public class StrtolResultMR { } } + @Resolve(message = "IS_EXECUTABLE") + public abstract static class StrolResultIsExecutable extends Node { + protected Object access(@SuppressWarnings("unused") StrtolResult receiver) { + return true; + } + } + @Resolve(message = "EXECUTE") public abstract static class BaseStrtolResultCallbackExecute extends Node { protected Object access(@SuppressWarnings("unused") VirtualFrame frame, StrtolResult receiver, Object[] arguments) { diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/base/UnameResultMR.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/base/UnameResultMR.java index 4ef12020e4..49c62b47ce 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/base/UnameResultMR.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/base/UnameResultMR.java @@ -39,6 +39,13 @@ public class UnameResultMR { } } + @Resolve(message = "IS_EXECUTABLE") + public abstract static class BaseUnameResultIsExecutable extends Node { + protected Object access(@SuppressWarnings("unused") UnameResult receiver) { + return true; + } + } + @Resolve(message = "EXECUTE") public abstract static class BaseUnameResultCallbackExecute extends Node { protected Object access(@SuppressWarnings("unused") VirtualFrame frame, UnameResult receiver, Object[] arguments) { diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pcre/CaptureNamesResultMR.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pcre/CaptureNamesResultMR.java index 6462f2ef7a..3b3f915183 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pcre/CaptureNamesResultMR.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pcre/CaptureNamesResultMR.java @@ -43,6 +43,13 @@ public class CaptureNamesResultMR { } } + @Resolve(message = "IS_EXECUTABLE") + public abstract static class CaptureNamesResultIsExecutable extends Node { + protected Object access(@SuppressWarnings("unused") CaptureNamesResult receiver) { + return true; + } + } + @Resolve(message = "EXECUTE") public abstract static class CaptureNamesCallbackExecute extends Node { protected Object access(@SuppressWarnings("unused") VirtualFrame frame, CaptureNamesResult receiver, Object[] arguments) { diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pcre/CompileResultMR.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pcre/CompileResultMR.java index f519b18f39..1c98d1a352 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pcre/CompileResultMR.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pcre/CompileResultMR.java @@ -43,6 +43,13 @@ public class CompileResultMR { } } + @Resolve(message = "IS_EXECUTABLE") + public abstract static class CompileResultIsExecutable extends Node { + protected Object access(@SuppressWarnings("unused") CompileResult receiver) { + return true; + } + } + @Resolve(message = "EXECUTE") public abstract static class ResultCallbackExecute extends Node { protected Object access(@SuppressWarnings("unused") VirtualFrame frame, CompileResult receiver, Object[] arguments) { diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/ForceSymbolsCall.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/ForceSymbolsCall.java new file mode 100644 index 0000000000..77f22ce84c --- /dev/null +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/ForceSymbolsCall.java @@ -0,0 +1,46 @@ +/* + * Copyright (c) 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.ffi.impl.interop.pkginit; + +import com.oracle.truffle.api.interop.ForeignAccess; +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.r.ffi.impl.common.PkgInitUpCalls; +import com.oracle.truffle.r.runtime.data.RTruffleObject; + +public class ForceSymbolsCall implements RTruffleObject { + public final PkgInitUpCalls pkgInitUpCalls; + + public ForceSymbolsCall(PkgInitUpCalls pkgInitUpCalls) { + this.pkgInitUpCalls = pkgInitUpCalls; + } + + public static boolean isInstance(TruffleObject value) { + return value instanceof ForceSymbolsCall; + } + + @Override + public ForeignAccess getForeignAccess() { + return ForceSymbolsCallMRForeign.ACCESS; + } + +} diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/ForceSymbolsCallMR.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/ForceSymbolsCallMR.java new file mode 100644 index 0000000000..7212138fce --- /dev/null +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/ForceSymbolsCallMR.java @@ -0,0 +1,46 @@ +/* + * Copyright (c) 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.ffi.impl.interop.pkginit; + +import com.oracle.truffle.api.interop.MessageResolution; +import com.oracle.truffle.api.interop.Resolve; +import com.oracle.truffle.api.nodes.Node; +import com.oracle.truffle.r.runtime.ffi.DLL.DLLInfo; + +@MessageResolution(receiverType = ForceSymbolsCall.class) +public class ForceSymbolsCallMR { + @Resolve(message = "EXECUTE") + public abstract static class ForceSymbolsCallExecute extends Node { + protected java.lang.Object access(ForceSymbolsCall receiver, Object[] arguments) { + return receiver.pkgInitUpCalls.forceSymbols((DLLInfo) arguments[0], (int) arguments[1]); + } + } + + @Resolve(message = "IS_EXECUTABLE") + public abstract static class ForceSymbolsCallIsExecutable extends Node { + protected Object access(@SuppressWarnings("unused") ForceSymbolsCall receiver) { + return true; + } + } + +} diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/GetCCallableCall.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/GetCCallableCall.java new file mode 100644 index 0000000000..6f1b3ead66 --- /dev/null +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/GetCCallableCall.java @@ -0,0 +1,46 @@ +/* + * Copyright (c) 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.ffi.impl.interop.pkginit; + +import com.oracle.truffle.api.interop.ForeignAccess; +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.r.ffi.impl.common.PkgInitUpCalls; +import com.oracle.truffle.r.runtime.data.RTruffleObject; + +public class GetCCallableCall implements RTruffleObject { + public final PkgInitUpCalls pkgInitUpCalls; + + public GetCCallableCall(PkgInitUpCalls pkgInitUpCalls) { + this.pkgInitUpCalls = pkgInitUpCalls; + } + + public static boolean isInstance(TruffleObject value) { + return value instanceof GetCCallableCall; + } + + @Override + public ForeignAccess getForeignAccess() { + return GetCCallableCallMRForeign.ACCESS; + } + +} diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/GetCCallableCallMR.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/GetCCallableCallMR.java new file mode 100644 index 0000000000..d31cacbb09 --- /dev/null +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/GetCCallableCallMR.java @@ -0,0 +1,45 @@ +/* + * Copyright (c) 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.ffi.impl.interop.pkginit; + +import com.oracle.truffle.api.interop.MessageResolution; +import com.oracle.truffle.api.interop.Resolve; +import com.oracle.truffle.api.nodes.Node; + +@MessageResolution(receiverType = GetCCallableCall.class) +public class GetCCallableCallMR { + @Resolve(message = "EXECUTE") + public abstract static class GetCCallableCallExecute extends Node { + protected java.lang.Object access(GetCCallableCall receiver, Object[] arguments) { + return receiver.pkgInitUpCalls.getCCallable((String) arguments[0], (String) arguments[1]); + } + } + + @Resolve(message = "IS_EXECUTABLE") + public abstract static class GetCCallableCallIsExecutable extends Node { + protected Object access(@SuppressWarnings("unused") GetCCallableCall receiver) { + return true; + } + } + +} diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/RegisterCCallableCall.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/RegisterCCallableCall.java new file mode 100644 index 0000000000..f134aba9ff --- /dev/null +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/RegisterCCallableCall.java @@ -0,0 +1,46 @@ +/* + * Copyright (c) 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.ffi.impl.interop.pkginit; + +import com.oracle.truffle.api.interop.ForeignAccess; +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.r.ffi.impl.common.PkgInitUpCalls; +import com.oracle.truffle.r.runtime.data.RTruffleObject; + +public class RegisterCCallableCall implements RTruffleObject { + public final PkgInitUpCalls pkgInitUpCalls; + + public RegisterCCallableCall(PkgInitUpCalls pkgInitUpCalls) { + this.pkgInitUpCalls = pkgInitUpCalls; + } + + public static boolean isInstance(TruffleObject value) { + return value instanceof RegisterCCallableCall; + } + + @Override + public ForeignAccess getForeignAccess() { + return RegisterCCallableCallMRForeign.ACCESS; + } + +} diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/RegisterCCallableCallMR.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/RegisterCCallableCallMR.java new file mode 100644 index 0000000000..21f8a5190d --- /dev/null +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/RegisterCCallableCallMR.java @@ -0,0 +1,45 @@ +/* + * Copyright (c) 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.ffi.impl.interop.pkginit; + +import com.oracle.truffle.api.interop.MessageResolution; +import com.oracle.truffle.api.interop.Resolve; +import com.oracle.truffle.api.nodes.Node; + +@MessageResolution(receiverType = RegisterCCallableCall.class) +public class RegisterCCallableCallMR { + @Resolve(message = "EXECUTE") + public abstract static class RegisterCCallableCallExecute extends Node { + protected java.lang.Object access(RegisterCCallableCall receiver, Object[] arguments) { + return receiver.pkgInitUpCalls.registerCCallable((String) arguments[0], (String) arguments[1], arguments[2]); + } + } + + @Resolve(message = "IS_EXECUTABLE") + public abstract static class RegisterCCallableCallIsExecutable extends Node { + protected Object access(@SuppressWarnings("unused") RegisterCCallableCall receiver) { + return true; + } + } + +} diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/RegisterRoutinesCall.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/RegisterRoutinesCall.java new file mode 100644 index 0000000000..ed1d46ebca --- /dev/null +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/RegisterRoutinesCall.java @@ -0,0 +1,46 @@ +/* + * Copyright (c) 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.ffi.impl.interop.pkginit; + +import com.oracle.truffle.api.interop.ForeignAccess; +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.r.ffi.impl.common.PkgInitUpCalls; +import com.oracle.truffle.r.runtime.data.RTruffleObject; + +public class RegisterRoutinesCall implements RTruffleObject { + public final PkgInitUpCalls pkgInitUpCalls; + + public RegisterRoutinesCall(PkgInitUpCalls pkgInitUpCalls) { + this.pkgInitUpCalls = pkgInitUpCalls; + } + + public static boolean isInstance(TruffleObject value) { + return value instanceof RegisterRoutinesCall; + } + + @Override + public ForeignAccess getForeignAccess() { + return RegisterRoutinesCallMRForeign.ACCESS; + } + +} diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/RegisterRoutinesCallMR.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/RegisterRoutinesCallMR.java new file mode 100644 index 0000000000..eafa6ed4d0 --- /dev/null +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/RegisterRoutinesCallMR.java @@ -0,0 +1,46 @@ +/* + * Copyright (c) 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.ffi.impl.interop.pkginit; + +import com.oracle.truffle.api.interop.MessageResolution; +import com.oracle.truffle.api.interop.Resolve; +import com.oracle.truffle.api.nodes.Node; +import com.oracle.truffle.r.runtime.ffi.DLL.DLLInfo; + +@MessageResolution(receiverType = RegisterRoutinesCall.class) +public class RegisterRoutinesCallMR { + @Resolve(message = "EXECUTE") + public abstract static class RegisterRoutinesCallExecute extends Node { + protected java.lang.Object access(RegisterRoutinesCall receiver, Object[] arguments) { + return receiver.pkgInitUpCalls.registerRoutines((DLLInfo) arguments[0], (int) arguments[1], (int) arguments[2], (long) arguments[3]); + } + } + + @Resolve(message = "IS_EXECUTABLE") + public abstract static class RegisterRoutinesCallIsExecutable extends Node { + protected Object access(@SuppressWarnings("unused") RegisterRoutinesCall receiver) { + return true; + } + } + +} diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/SetDotSymbolValuesCall.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/SetDotSymbolValuesCall.java new file mode 100644 index 0000000000..d4bc6da189 --- /dev/null +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/SetDotSymbolValuesCall.java @@ -0,0 +1,46 @@ +/* + * Copyright (c) 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.ffi.impl.interop.pkginit; + +import com.oracle.truffle.api.interop.ForeignAccess; +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.r.ffi.impl.common.PkgInitUpCalls; +import com.oracle.truffle.r.runtime.data.RTruffleObject; + +public class SetDotSymbolValuesCall implements RTruffleObject { + public final PkgInitUpCalls pkgInitUpCalls; + + public SetDotSymbolValuesCall(PkgInitUpCalls pkgInitUpCalls) { + this.pkgInitUpCalls = pkgInitUpCalls; + } + + public static boolean isInstance(TruffleObject value) { + return value instanceof SetDotSymbolValuesCall; + } + + @Override + public ForeignAccess getForeignAccess() { + return SetDotSymbolValuesCallMRForeign.ACCESS; + } + +} diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/SetDotSymbolValuesCallMR.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/SetDotSymbolValuesCallMR.java new file mode 100644 index 0000000000..52ee4ed3f1 --- /dev/null +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/SetDotSymbolValuesCallMR.java @@ -0,0 +1,46 @@ +/* + * Copyright (c) 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.ffi.impl.interop.pkginit; + +import com.oracle.truffle.api.interop.MessageResolution; +import com.oracle.truffle.api.interop.Resolve; +import com.oracle.truffle.api.nodes.Node; +import com.oracle.truffle.r.runtime.ffi.DLL.DLLInfo; + +@MessageResolution(receiverType = SetDotSymbolValuesCall.class) +public class SetDotSymbolValuesCallMR { + @Resolve(message = "EXECUTE") + public abstract static class SetDotSymbolValuesCallExecute extends Node { + protected java.lang.Object access(SetDotSymbolValuesCall receiver, Object[] arguments) { + return receiver.pkgInitUpCalls.setDotSymbolValues((DLLInfo) arguments[0], (String) arguments[1], arguments[2], (int) arguments[3]); + } + } + + @Resolve(message = "IS_EXECUTABLE") + public abstract static class SetDotSymbolValuesCallIsExecutable extends Node { + protected Object access(@SuppressWarnings("unused") SetDotSymbolValuesCall receiver) { + return true; + } + } + +} diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/UseDynamicSymbolsCall.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/UseDynamicSymbolsCall.java new file mode 100644 index 0000000000..62ac7845a8 --- /dev/null +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/UseDynamicSymbolsCall.java @@ -0,0 +1,46 @@ +/* + * Copyright (c) 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.ffi.impl.interop.pkginit; + +import com.oracle.truffle.api.interop.ForeignAccess; +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.r.ffi.impl.common.PkgInitUpCalls; +import com.oracle.truffle.r.runtime.data.RTruffleObject; + +public class UseDynamicSymbolsCall implements RTruffleObject { + public final PkgInitUpCalls pkgInitUpCalls; + + public UseDynamicSymbolsCall(PkgInitUpCalls pkgInitUpCalls) { + this.pkgInitUpCalls = pkgInitUpCalls; + } + + public static boolean isInstance(TruffleObject value) { + return value instanceof UseDynamicSymbolsCall; + } + + @Override + public ForeignAccess getForeignAccess() { + return UseDynamicSymbolsCallMRForeign.ACCESS; + } + +} diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/UseDynamicSymbolsCallMR.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/UseDynamicSymbolsCallMR.java new file mode 100644 index 0000000000..91a932bc15 --- /dev/null +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/pkginit/UseDynamicSymbolsCallMR.java @@ -0,0 +1,46 @@ +/* + * Copyright (c) 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.ffi.impl.interop.pkginit; + +import com.oracle.truffle.api.interop.MessageResolution; +import com.oracle.truffle.api.interop.Resolve; +import com.oracle.truffle.api.nodes.Node; +import com.oracle.truffle.r.runtime.ffi.DLL.DLLInfo; + +@MessageResolution(receiverType = UseDynamicSymbolsCall.class) +public class UseDynamicSymbolsCallMR { + @Resolve(message = "EXECUTE") + public abstract static class UseDynamicSymbolsCallExecute extends Node { + protected java.lang.Object access(UseDynamicSymbolsCall receiver, Object[] arguments) { + return receiver.pkgInitUpCalls.useDynamicSymbols((DLLInfo) arguments[0], (int) arguments[1]); + } + } + + @Resolve(message = "IS_EXECUTABLE") + public abstract static class UseDynamicSymbolsCallIsExecutable extends Node { + protected Object access(@SuppressWarnings("unused") UseDynamicSymbolsCall receiver) { + return true; + } + } + +} diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/jni/JNI_PkgInit.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/jni/JNI_PkgInit.java index f35a117c29..400666d46e 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/jni/JNI_PkgInit.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/jni/JNI_PkgInit.java @@ -45,12 +45,12 @@ final class JNI_PkgInit { } private static void registerCCallable(String pkgName, String functionName, long address) { - DLLInfo lib = safeFindLibrary(pkgName); + DLLInfo lib = DLL.safeFindLibrary(pkgName); lib.registerCEntry(new CEntry(functionName, new SymbolHandle(address))); } public static long getCCallable(String pkgName, String functionName) { - DLLInfo lib = safeFindLibrary(pkgName); + DLLInfo lib = DLL.safeFindLibrary(pkgName); CEntry result = lib.lookupCEntry(functionName); if (result == null) { throw RError.error(RError.NO_CALLER, Message.UNKNOWN_OBJECT, functionName); @@ -84,13 +84,4 @@ final class JNI_PkgInit { throw RInternalError.unimplemented(); } - private static DLLInfo safeFindLibrary(String pkgName) { - DLLInfo lib = DLL.findLibrary(pkgName); - if (lib == null) { - // It seems GNU R would create an C entry even for non-existing package, we are more - // defensive - throw RError.error(RError.NO_CALLER, Message.DLL_NOT_LOADED, pkgName); - } - return lib; - } } diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_Base.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_Base.java index a6ac342d2e..c111372360 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_Base.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_Base.java @@ -29,8 +29,6 @@ import com.oracle.truffle.api.CompilerDirectives; 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.TruffleObject; -import com.oracle.truffle.api.interop.java.JavaInterop; import com.oracle.truffle.api.nodes.Node; import com.oracle.truffle.r.ffi.impl.interop.NativeCharArray; import com.oracle.truffle.r.ffi.impl.interop.base.GlobResult; @@ -38,30 +36,11 @@ import com.oracle.truffle.r.ffi.impl.interop.base.ReadlinkResult; import com.oracle.truffle.r.ffi.impl.interop.base.StrtolResult; import com.oracle.truffle.r.ffi.impl.interop.base.UnameResult; import com.oracle.truffle.r.runtime.RInternalError; -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.DLL; import com.oracle.truffle.r.runtime.ffi.DLL.SymbolHandle; -import com.oracle.truffle.r.runtime.ffi.RFFIFactory; public class TruffleLLVM_Base implements BaseRFFI { - private static TruffleObject truffleBaseTruffleObject; - - TruffleLLVM_Base() { - truffleBaseTruffleObject = JavaInterop.asTruffleObject(this); - } - - static class ContextStateImpl implements RContext.ContextState { - @Override - public ContextState initialize(RContext context) { - RFFIFactory.getRFFI().getBaseRFFI(); - context.getEnv().exportSymbol("_fastr_rffi_base", truffleBaseTruffleObject); - return this; - } - - } - public static class TruffleLLVM_GetpidNode extends GetpidNode { @Child private Node message = LLVMFunction.getpid.createMessage(); @CompilationFinal private SymbolHandle symbolHandle; @@ -153,14 +132,6 @@ public class TruffleLLVM_Base implements BaseRFFI { } } - public void setReadlinkResult(ReadlinkResult baseReadlinkResultCallback, NativeCharArray nativePath, int errno) { - String path = null; - if (nativePath != null) { - path = new String(nativePath.getValue()); - } - baseReadlinkResultCallback.setResult(path, errno); - } - public static class TruffleLLVM_ReadlinkNode extends ReadlinkNode { private static final int EINVAL = 22; @Child private Node message = LLVMFunction.readlink.createMessage(); @@ -246,10 +217,6 @@ public class TruffleLLVM_Base implements BaseRFFI { } } - public void setStrtolResult(StrtolResult callback, long value, int errno) { - callback.setResult(value, errno); - } - public static class TruffleLLVM_StrolNode extends StrolNode { @Child private Node message = LLVMFunction.strtol.createMessage(); @CompilationFinal private SymbolHandle symbolHandle; @@ -275,12 +242,6 @@ public class TruffleLLVM_Base implements BaseRFFI { } } - public void setUnameResult(UnameResult baseUnameResultCallback, NativeCharArray sysname, NativeCharArray release, - NativeCharArray version, NativeCharArray machine, NativeCharArray nodename) { - baseUnameResultCallback.setResult(new String(sysname.getValue()), new String(release.getValue()), new String(version.getValue()), - new String(machine.getValue()), new String(nodename.getValue())); - } - public static class TruffleLLVM_UnameNode extends UnameNode { @Child private Node message = LLVMFunction.uname.createMessage(); @CompilationFinal private SymbolHandle symbolHandle; @@ -301,10 +262,6 @@ public class TruffleLLVM_Base implements BaseRFFI { } } - public void setGlobResult(GlobResult baseGlobResultCallback, NativeCharArray path) { - baseGlobResultCallback.addPath(new String(path.getValue())); - } - public static class TruffleLLVM_GlobNode extends GlobNode { @Child private Node message = LLVMFunction.glob.createMessage(); @CompilationFinal private SymbolHandle symbolHandle; diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_Call.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_Call.java index c9590c3f7f..692d85abf0 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_Call.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_Call.java @@ -29,10 +29,12 @@ 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.ffi.impl.common.RFFIUtils; +import com.oracle.truffle.r.ffi.impl.common.TruffleUnwrap; import com.oracle.truffle.r.ffi.impl.llvm.TruffleLLVM_CallFactory.TruffleLLVM_InvokeCallNodeGen; +import com.oracle.truffle.r.ffi.impl.llvm.upcalls.BytesToNativeCharArrayCall; +import com.oracle.truffle.r.ffi.impl.llvm.upcalls.CharSXPToNativeArrayCall; import com.oracle.truffle.r.ffi.impl.upcalls.Callbacks; import com.oracle.truffle.r.ffi.impl.upcalls.UpCallsRFFI; import com.oracle.truffle.r.runtime.RInternalError; @@ -45,19 +47,12 @@ import com.oracle.truffle.r.runtime.ffi.RFFIFactory; import com.oracle.truffle.r.runtime.ffi.RFFIVariables; final class TruffleLLVM_Call implements CallRFFI { - private static TruffleLLVM_Call truffleCall; - private static TruffleObject truffleCallTruffleObject; - private static TruffleObject truffleCallHelper; - private static TruffleObject truffleCallHelperImpl; private static UpCallsRFFI upCallsRFFI; + private static TruffleLLVM_UpCallsRFFIImpl upCallsRFFIImpl; TruffleLLVM_Call() { - truffleCall = this; - truffleCallTruffleObject = JavaInterop.asTruffleObject(truffleCall); - TruffleLLVM_UpCallsRFFIImpl upCallsRFFIImpl = new TruffleLLVM_UpCallsRFFIImpl(); - truffleCallHelperImpl = JavaInterop.asTruffleObject(upCallsRFFIImpl); + upCallsRFFIImpl = new TruffleLLVM_UpCallsRFFIImpl(); upCallsRFFI = RFFIUtils.initialize(upCallsRFFIImpl); - truffleCallHelper = JavaInterop.asTruffleObject(upCallsRFFIImpl); } static class ContextStateImpl implements RContext.ContextState { @@ -68,9 +63,6 @@ final class TruffleLLVM_Call implements CallRFFI { public ContextState initialize(RContext contextA) { this.context = contextA; RFFIFactory.getRFFI().getCallRFFI(); - context.getEnv().exportSymbol("_fastr_rffi_call", truffleCallTruffleObject); - context.getEnv().exportSymbol("_fastr_rffi_callhelper", truffleCallHelper); - context.getEnv().exportSymbol("_fastr_rffi_callhelper_impl", truffleCallHelperImpl); if (!initDone) { initVariables(context); initCallbacks(context, upCallsRFFI); @@ -127,38 +119,52 @@ final class TruffleLLVM_Call implements CallRFFI { } private static void initCallbacks(RContext context, UpCallsRFFI upCallsImpl) { - Node executeNode = Message.createExecute(1).createNode(); + Node executeNode = Message.createExecute(2).createNode(); SymbolHandle symbolHandle = new SymbolHandle(context.getEnv().importSymbol("@" + "Rinternals_addCallback")); try { + // standard callbacks + Callbacks[] callbacks = Callbacks.values(); Callbacks.createCalls(upCallsImpl); - for (Callbacks callback : Callbacks.values()) { + for (Callbacks callback : callbacks) { ForeignAccess.sendExecute(executeNode, symbolHandle.asTruffleObject(), callback.ordinal(), callback.call); } + // llvm specific callbacks + ForeignAccess.sendExecute(executeNode, symbolHandle.asTruffleObject(), callbacks.length, new BytesToNativeCharArrayCall(upCallsRFFIImpl)); + ForeignAccess.sendExecute(executeNode, symbolHandle.asTruffleObject(), callbacks.length + 1, new CharSXPToNativeArrayCall(upCallsRFFIImpl)); } catch (Throwable t) { throw RInternalError.shouldNotReachHere(t); } } - @ImportStatic({Message.class, RContext.class}) + @ImportStatic({Message.class}) public abstract static class TruffleLLVM_InvokeCallNode extends InvokeCallNode { - @Child private Node messageNode = Message.createExecute(0).createNode(); + private final boolean isVoid; + + protected TruffleLLVM_InvokeCallNode(boolean isVoid) { + this.isVoid = isVoid; + } - @Specialization(guards = {"cachedNativeCallInfo.name.equals(nativeCallInfo.name)"}) + @Specialization(guards = {"cachedNativeCallInfo.name.equals(nativeCallInfo.name)", "args.length == cachedArgCount"}) protected Object invokeCallCached(NativeCallInfo nativeCallInfo, Object[] args, - @SuppressWarnings("unused") @Cached("nativeCallInfo") NativeCallInfo cachedNativeCallInfo) { - return doInvoke(messageNode, nativeCallInfo, args); + @SuppressWarnings("unused") @Cached("nativeCallInfo") NativeCallInfo cachedNativeCallInfo, + @SuppressWarnings("unused") @Cached("argCount(args)") int cachedArgCount, + @Cached("createMessageNode(args)") Node cachedMessageNode) { + return doInvoke(cachedMessageNode, nativeCallInfo, args); } @Specialization(replaces = "invokeCallCached") protected Object invokeCallNormal(NativeCallInfo nativeCallInfo, Object[] args) { - return doInvoke(Message.createExecute(0).createNode(), nativeCallInfo, args); + return doInvoke(Message.createExecute(args.length).createNode(), nativeCallInfo, args); } - private static Object doInvoke(Node messageNode, NativeCallInfo nativeCallInfo, Object[] args) { + private Object doInvoke(Node messageNode, NativeCallInfo nativeCallInfo, Object[] args) { boolean isNullSetting = RContext.getRForeignAccessFactory().setIsNull(false); try { - Object result = TruffleLLVM_Utils.checkNativeAddress(ForeignAccess.sendExecute(messageNode, nativeCallInfo.address.asTruffleObject(), args)); + Object result = ForeignAccess.sendExecute(messageNode, nativeCallInfo.address.asTruffleObject(), args); + if (!isVoid) { + result = TruffleUnwrap.unwrap(result); + } return result; } catch (InteropException t) { throw RInternalError.shouldNotReachHere(t); @@ -167,10 +173,18 @@ final class TruffleLLVM_Call implements CallRFFI { } } + public int argCount(Object[] args) { + return args.length; + } + + public Node createMessageNode(Object[] args) { + return Message.createExecute(args.length).createNode(); + } + } private static class TruffleLLVM_InvokeVoidCallNode extends InvokeVoidCallNode { - @Child private TruffleLLVM_InvokeCallNode invokeCallNode = TruffleLLVM_InvokeCallNodeGen.create(); + @Child private TruffleLLVM_InvokeCallNode invokeCallNode = TruffleLLVM_InvokeCallNodeGen.create(true); @Override public synchronized void execute(NativeCallInfo nativeCallInfo, Object[] args) { @@ -191,7 +205,7 @@ final class TruffleLLVM_Call implements CallRFFI { @Override public InvokeCallNode createInvokeCallNode() { - return TruffleLLVM_InvokeCallNodeGen.create(); + return TruffleLLVM_InvokeCallNodeGen.create(false); } @Override diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_NativeDLL.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_NativeDLL.java index ccc435dc74..d1e460a9f2 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_NativeDLL.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_NativeDLL.java @@ -32,12 +32,10 @@ import com.oracle.truffle.api.interop.Message; import com.oracle.truffle.api.interop.MessageResolution; import com.oracle.truffle.api.interop.Resolve; 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.ffi.impl.interop.NativeCharArray; import com.oracle.truffle.r.runtime.RInternalError; -import com.oracle.truffle.r.runtime.context.RContext; -import com.oracle.truffle.r.runtime.context.RContext.ContextState; +import com.oracle.truffle.r.runtime.data.RTruffleObject; import com.oracle.truffle.r.runtime.ffi.DLL; import com.oracle.truffle.r.runtime.ffi.DLL.SymbolHandle; import com.oracle.truffle.r.runtime.ffi.RFFIRootNode; @@ -59,27 +57,12 @@ class TruffleLLVM_NativeDLL { } } - private static TruffleLLVM_NativeDLL truffleNativeDLL; - private static TruffleObject truffleNativeDLLTruffleObject; - - static class ContextStateImpl implements RContext.ContextState { - @Override - public ContextState initialize(RContext context) { - if (truffleNativeDLL == null) { - truffleNativeDLL = new TruffleLLVM_NativeDLL(); - truffleNativeDLLTruffleObject = JavaInterop.asTruffleObject(truffleNativeDLL); - context.getEnv().exportSymbol("_fastr_dllnative_helper", truffleNativeDLLTruffleObject); - } - return this; - } - } - public interface ErrorCallback { void setResult(String errorMessage); } - private static class ErrorCallbackImpl implements ErrorCallback, TruffleObject { + private static class ErrorCallbackImpl implements ErrorCallback, RTruffleObject { private String errorMessage; @Override @@ -103,6 +86,13 @@ class TruffleLLVM_NativeDLL { } } + @Resolve(message = "IS_EXECUTABLE") + public abstract static class ErrorCallbackIsExecutableNode extends Node { + protected Object access(@SuppressWarnings("unused") ErrorCallback receiver) { + return true; + } + } + @Resolve(message = "EXECUTE") public abstract static class ErrorCallbackExecuteNode extends Node { protected Object access(@SuppressWarnings("unused") VirtualFrame frame, ErrorCallback receiver, Object[] arguments) { @@ -112,10 +102,6 @@ class TruffleLLVM_NativeDLL { } } - public void setDlopenResult(ErrorCallback errorCallback, NativeCharArray errorMessage) { - errorCallback.setResult(new String(errorMessage.getValue())); - } - static class TruffleLLVM_NativeDLOpen extends Node { @CompilationFinal private SymbolHandle symbolHandle; diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_PCRE.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_PCRE.java index d6540d4bde..09325319cd 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_PCRE.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_PCRE.java @@ -27,7 +27,6 @@ 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.TruffleObject; -import com.oracle.truffle.api.interop.java.JavaInterop; import com.oracle.truffle.api.nodes.Node; import com.oracle.truffle.r.ffi.impl.common.LibPaths; import com.oracle.truffle.r.ffi.impl.interop.NativeCharArray; @@ -36,47 +35,18 @@ import com.oracle.truffle.r.ffi.impl.interop.pcre.CaptureNamesResult; import com.oracle.truffle.r.ffi.impl.interop.pcre.CompileResult; import com.oracle.truffle.r.runtime.RError; import com.oracle.truffle.r.runtime.RInternalError; -import com.oracle.truffle.r.runtime.context.RContext; -import com.oracle.truffle.r.runtime.context.RContext.ContextState; import com.oracle.truffle.r.runtime.ffi.DLL; import com.oracle.truffle.r.runtime.ffi.DLL.SymbolHandle; import com.oracle.truffle.r.runtime.ffi.PCRERFFI; -import com.oracle.truffle.r.runtime.ffi.RFFIFactory; public class TruffleLLVM_PCRE implements PCRERFFI { - private static TruffleObject trufflePCRETruffleObject; TruffleLLVM_PCRE() { - trufflePCRETruffleObject = JavaInterop.asTruffleObject(this); // Need to ensure that the native pcre library is loaded String pcrePath = LibPaths.getBuiltinLibPath("pcre"); System.load(pcrePath); } - static class ContextStateImpl implements RContext.ContextState { - @Override - public ContextState initialize(RContext context) { - RFFIFactory.getRFFI().getPCRERFFI(); - context.getEnv().exportSymbol("_fastr_rffi_pcre", trufflePCRETruffleObject); - return this; - } - } - - public CompileResult makeResult(TruffleObject pcreResultObj, NativeCharArray nativeErrorMessage, int errOffset) { - long pcreResult = TruffleLLVM_Utils.getNativeAddress(pcreResultObj); - String errorMessage = null; - if (nativeErrorMessage != null) { - errorMessage = new String(nativeErrorMessage.getValue()); - } - CompileResult result = new CompileResult(); - result.set(pcreResult, errorMessage, errOffset); - return result; - } - - public void addCaptureName(int i, Object nameObj, CaptureNamesResult captureNamesCallback) { - captureNamesCallback.addName(i, new String(((NativeCharArray) nameObj).getValue())); - } - private static class TruffleLLVM_MaketablesNode extends MaketablesNode { @Child private Node message = LLVMFunction.maketables.createMessage(); @CompilationFinal private SymbolHandle symbolHandle; @@ -154,10 +124,9 @@ public class TruffleLLVM_PCRE implements PCRERFFI { symbolHandle = DLL.findSymbol(LLVMFunction.compile.callName, null); } NativeCharArray pattenChars = new NativeCharArray(pattern.getBytes()); - Object callResult = ForeignAccess.sendExecute(message, symbolHandle.asTruffleObject(), - pattenChars, options, tables); - CompileResult result = (CompileResult) callResult; - return result.getResult(); + CompileResult data = new CompileResult(); + ForeignAccess.sendExecute(message, symbolHandle.asTruffleObject(), data, pattenChars, options, tables); + return data.getResult(); } catch (InteropException ex) { throw RInternalError.shouldNotReachHere(ex); } diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_PkgInit.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_PkgInit.java index def16936df..ed5d2e6941 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_PkgInit.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_PkgInit.java @@ -25,87 +25,76 @@ package com.oracle.truffle.r.ffi.impl.llvm; 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.interop.java.JavaInterop; import com.oracle.truffle.api.nodes.Node; +import com.oracle.truffle.r.ffi.impl.common.PkgInitUpCalls; +import com.oracle.truffle.r.ffi.impl.interop.pkginit.ForceSymbolsCall; +import com.oracle.truffle.r.ffi.impl.interop.pkginit.GetCCallableCall; +import com.oracle.truffle.r.ffi.impl.interop.pkginit.RegisterCCallableCall; +import com.oracle.truffle.r.ffi.impl.interop.pkginit.RegisterRoutinesCall; +import com.oracle.truffle.r.ffi.impl.interop.pkginit.SetDotSymbolValuesCall; +import com.oracle.truffle.r.ffi.impl.interop.pkginit.UseDynamicSymbolsCall; +import com.oracle.truffle.r.runtime.RError; import com.oracle.truffle.r.runtime.RInternalError; import com.oracle.truffle.r.runtime.context.RContext; import com.oracle.truffle.r.runtime.context.RContext.ContextState; import com.oracle.truffle.r.runtime.ffi.DLL; +import com.oracle.truffle.r.runtime.ffi.DLL.CEntry; 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; +import com.oracle.truffle.r.ffi.impl.common.Generic_PkgInit; -class TruffleLLVM_PkgInit { +final class TruffleLLVM_PkgInit extends Generic_PkgInit { private static TruffleLLVM_PkgInit trufflePkgInit; - private static TruffleObject trufflePkgInitTruffleObject; + private static TruffleObject setSymbolHandle; static class ContextStateImpl implements RContext.ContextState { @Override public ContextState initialize(RContext context) { - TruffleLLVM_PkgInit.initialize(); - context.getEnv().exportSymbol("_fastr_rffi_pkginit", trufflePkgInitTruffleObject); + if (context.isInitial()) { + TruffleLLVM_PkgInit.initialize(context); + } return this; } - @Override - public void beforeDestroy(RContext context) { - } } - private static TruffleLLVM_PkgInit initialize() { - if (trufflePkgInit == null) { - trufflePkgInit = new TruffleLLVM_PkgInit(); - trufflePkgInitTruffleObject = JavaInterop.asTruffleObject(trufflePkgInit); + private static void initialize(RContext context) { + trufflePkgInit = new TruffleLLVM_PkgInit(); + setSymbolHandle = new SymbolHandle(context.getEnv().importSymbol("@" + "Rdynload_setSymbol")).asTruffleObject(); + Node executeNode = Message.createExecute(2).createNode(); + TruffleObject callbackSymbol = new SymbolHandle(context.getEnv().importSymbol("@" + "Rdynload_addCallback")).asTruffleObject(); + try { + ForeignAccess.sendExecute(executeNode, callbackSymbol, PkgInitUpCalls.Index.registerRoutines.ordinal(), new RegisterRoutinesCall(trufflePkgInit)); + ForeignAccess.sendExecute(executeNode, callbackSymbol, PkgInitUpCalls.Index.setDotSymbolValues.ordinal(), new SetDotSymbolValuesCall(trufflePkgInit)); + ForeignAccess.sendExecute(executeNode, callbackSymbol, PkgInitUpCalls.Index.useDynamicSymbols.ordinal(), new UseDynamicSymbolsCall(trufflePkgInit)); + ForeignAccess.sendExecute(executeNode, callbackSymbol, PkgInitUpCalls.Index.forceSymbols.ordinal(), new ForceSymbolsCall(trufflePkgInit)); + ForeignAccess.sendExecute(executeNode, callbackSymbol, PkgInitUpCalls.Index.registerCCallable.ordinal(), new RegisterCCallableCall(trufflePkgInit)); + ForeignAccess.sendExecute(executeNode, callbackSymbol, PkgInitUpCalls.Index.getCCallable.ordinal(), new GetCCallableCall(trufflePkgInit)); + } catch (Throwable t) { + throw RInternalError.shouldNotReachHere(t); } - return trufflePkgInit; } - public void registerRoutines(DLLInfo dllInfo, int nstOrd, int num, long routines) { - DotSymbol[] array = new DotSymbol[num]; - SymbolHandle setSymbolHandle = new SymbolHandle(RContext.getInstance().getEnv().importSymbol("@" + "PkgInit_setSymbol")); - for (int i = 0; i < num; i++) { - Object sym = setSymbol(nstOrd, routines, i, setSymbolHandle); - array[i] = (DotSymbol) sym; + @Override + public Object getCCallable(String pkgName, String functionName) { + DLLInfo lib = DLL.safeFindLibrary(pkgName); + CEntry result = lib.lookupCEntry(functionName); + if (result == null) { + throw RError.error(RError.NO_CALLER, RError.Message.UNKNOWN_OBJECT, functionName); } - dllInfo.setNativeSymbols(nstOrd, array); + return result.address.asTruffleObject(); } - private static Object setSymbol(int nstOrd, long routines, int index, SymbolHandle symbolHandle) { - Node executeNode = Message.createExecute(3).createNode(); + @Override + protected Object setSymbol(DLLInfo dllInfo, int nstOrd, long routines, int index) { + Node executeNode = Message.createExecute(4).createNode(); try { - Object result = ForeignAccess.sendExecute(executeNode, symbolHandle.asTruffleObject(), nstOrd, routines, index); + Object result = ForeignAccess.sendExecute(executeNode, setSymbolHandle, dllInfo, nstOrd, routines, index); return result; } catch (Throwable t) { throw RInternalError.shouldNotReachHere(); } } - @SuppressWarnings("unused") - public void registerCCallable(String pkgName, String functionName, long address) { - // TBD - System.console(); - } - - @SuppressWarnings({"unused", "static-method"}) - private long getCCallable(String pkgName, String functionName) { - // TBD - throw RInternalError.unimplemented(); - } - - /** - * Upcall from native to create a {@link DotSymbol} value. - */ - public DotSymbol createDotSymbol(String name, Object fundesc, int numArgs) { - DotSymbol result = new DotSymbol(name, new SymbolHandle(fundesc), numArgs); - return result; - } - - public int useDynamicSymbols(DLLInfo dllInfo, int value) { - return DLL.useDynamicSymbols(dllInfo, value); - } - - public int forceSymbols(DLLInfo dllInfo, int value) { - return DLL.forceSymbols(dllInfo, value); - } } diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_RFFIContextState.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_RFFIContextState.java index f04af0d81f..bf236d54ec 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_RFFIContextState.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_RFFIContextState.java @@ -35,21 +35,11 @@ class TruffleLLVM_RFFIContextState implements ContextState { TruffleLLVM_DLL.ContextStateImpl dllState; TruffleLLVM_PkgInit.ContextStateImpl pkgInitState; TruffleLLVM_Call.ContextStateImpl callState; - TruffleLLVM_Stats.ContextStateImpl statsState; - TruffleLLVM_Tools.ContextStateImpl toolsState; - TruffleLLVM_PCRE.ContextStateImpl pcreState; - TruffleLLVM_Base.ContextStateImpl baseState; - TruffleLLVM_NativeDLL.ContextStateImpl nativeDllState; TruffleLLVM_RFFIContextState() { dllState = new TruffleLLVM_DLL.ContextStateImpl(); pkgInitState = new TruffleLLVM_PkgInit.ContextStateImpl(); callState = new TruffleLLVM_Call.ContextStateImpl(); - statsState = new TruffleLLVM_Stats.ContextStateImpl(); - toolsState = new TruffleLLVM_Tools.ContextStateImpl(); - pcreState = new TruffleLLVM_PCRE.ContextStateImpl(); - baseState = new TruffleLLVM_Base.ContextStateImpl(); - nativeDllState = new TruffleLLVM_NativeDLL.ContextStateImpl(); } static TruffleLLVM_RFFIContextState getContextState() { @@ -69,11 +59,6 @@ class TruffleLLVM_RFFIContextState implements ContextState { dllState.initialize(context); pkgInitState.initialize(context); callState.initialize(context); - statsState.initialize(context); - toolsState.initialize(context); - pcreState.initialize(context); - baseState.initialize(context); - nativeDllState.initialize(context); return this; } @@ -82,10 +67,5 @@ class TruffleLLVM_RFFIContextState implements ContextState { dllState.beforeDestroy(context); pkgInitState.beforeDestroy(context); callState.beforeDestroy(context); - statsState.beforeDestroy(context); - toolsState.beforeDestroy(context); - pcreState.beforeDestroy(context); - baseState.beforeDestroy(context); - nativeDllState.beforeDestroy(context); } } diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_Stats.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_Stats.java index 9ec5f57cff..7570499af7 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_Stats.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_Stats.java @@ -34,7 +34,6 @@ import com.oracle.truffle.r.ffi.impl.llvm.TruffleLLVM_StatsFactory.ExecuteFactor import com.oracle.truffle.r.ffi.impl.llvm.TruffleLLVM_StatsFactory.ExecuteWorkNodeGen; import com.oracle.truffle.r.runtime.RInternalError; import com.oracle.truffle.r.runtime.context.RContext; -import com.oracle.truffle.r.runtime.context.RContext.ContextState; import com.oracle.truffle.r.runtime.ffi.DLL; import com.oracle.truffle.r.runtime.ffi.RFFIFactory; import com.oracle.truffle.r.runtime.ffi.DLL.DLLInfo; @@ -49,14 +48,6 @@ public class TruffleLLVM_Stats implements StatsRFFI { fft_factor; } - static class ContextStateImpl implements RContext.ContextState { - @Override - public ContextState initialize(RContext context) { - return this; - } - - } - public abstract static class LookupAdapter extends Node { @Child private DLLRFFI.DLSymNode dllSymNode = RFFIFactory.getRFFI().getDLLRFFI().createDLSymNode(); @@ -66,8 +57,6 @@ public class TruffleLLVM_Stats implements StatsRFFI { // and these symbols are not registered (only fft) SymbolHandle result = dllSymNode.execute(dllInfo.handle, name); if (result == DLL.SYMBOL_NOT_FOUND) { - @SuppressWarnings("unused") - TruffleLLVM_RFFIContextState cs = TruffleLLVM_RFFIContextState.getContextState(); throw RInternalError.shouldNotReachHere(); } return result; diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_Tools.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_Tools.java index 542c5f35f7..d081ee47a7 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_Tools.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_Tools.java @@ -24,34 +24,37 @@ package com.oracle.truffle.r.ffi.impl.llvm; import java.io.IOException; +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.interop.java.JavaInterop; +import com.oracle.truffle.api.nodes.Node; import com.oracle.truffle.r.ffi.impl.common.Generic_Tools; +import com.oracle.truffle.r.ffi.impl.interop.tools.RConnGetCCall; import com.oracle.truffle.r.runtime.RInternalError; import com.oracle.truffle.r.runtime.conn.RConnection; import com.oracle.truffle.r.runtime.context.RContext; -import com.oracle.truffle.r.runtime.context.RContext.ContextState; 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.RFFIFactory; import com.oracle.truffle.r.runtime.ffi.ToolsRFFI; +import com.oracle.truffle.r.runtime.ffi.DLL.SymbolHandle; public class TruffleLLVM_Tools implements ToolsRFFI { - private static TruffleObject truffleToolsTruffleObject; + private static boolean addCallbackDone; - TruffleLLVM_Tools() { - truffleToolsTruffleObject = JavaInterop.asTruffleObject(this); - } - - static class ContextStateImpl implements RContext.ContextState { - @Override - public ContextState initialize(RContext context) { - RFFIFactory.getRFFI().getToolsRFFI(); - context.getEnv().exportSymbol("_fastr_rffi_tools", truffleToolsTruffleObject); - return this; + private static void addCallback() { + if (!addCallbackDone) { + Node executeNode = Message.createExecute(2).createNode(); + TruffleObject callbackSymbol = new SymbolHandle(RContext.getInstance().getEnv().importSymbol("@" + "gramRd_addCallback")).asTruffleObject(); + try { + ForeignAccess.sendExecute(executeNode, callbackSymbol, new RConnGetCCall()); + addCallbackDone = true; + } catch (Throwable t) { + throw RInternalError.shouldNotReachHere(t); + } } + } private static class TruffleLLVM_ToolsRFFINode extends Generic_Tools.Generic_ToolsRFFINode { @@ -61,9 +64,11 @@ public class TruffleLLVM_Tools implements ToolsRFFI { @Override public synchronized Object execute(RConnection con, REnvironment srcfile, RLogicalVector verbose, RLogicalVector fragment, RStringVector basename, RLogicalVector warningCalls, Object macros, RLogicalVector warndups) { + addCallback(); Object result = super.execute(con, srcfile, verbose, fragment, basename, warningCalls, macros, warndups); return result; } + } public static int getC(RConnection conn) { diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_UpCallsRFFIImpl.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_UpCallsRFFIImpl.java index 9c80821300..84767ed997 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_UpCallsRFFIImpl.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_UpCallsRFFIImpl.java @@ -22,11 +22,6 @@ */ package com.oracle.truffle.r.ffi.impl.llvm; -import static com.oracle.truffle.r.ffi.impl.llvm.TruffleLLVM_Utils.checkNativeAddress; - -import java.nio.charset.StandardCharsets; - -import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; import com.oracle.truffle.r.ffi.impl.common.JavaUpCallsRFFIImpl; import com.oracle.truffle.r.ffi.impl.common.RFFIUtils; import com.oracle.truffle.r.ffi.impl.interop.NativeCharArray; @@ -37,7 +32,6 @@ import com.oracle.truffle.r.ffi.impl.interop.NativeRawArray; import com.oracle.truffle.r.ffi.impl.upcalls.Callbacks; import com.oracle.truffle.r.runtime.REnvVars; import com.oracle.truffle.r.runtime.RInternalError; -import com.oracle.truffle.r.runtime.data.RDataFactory; import com.oracle.truffle.r.runtime.data.RDouble; import com.oracle.truffle.r.runtime.data.RInteger; import com.oracle.truffle.r.runtime.data.RLogical; @@ -56,6 +50,11 @@ public class TruffleLLVM_UpCallsRFFIImpl extends JavaUpCallsRFFIImpl { return new NativeCharArray(chars.getContents().getBytes()); } + public Object bytesToNativeCharArray(byte[] bytes) { + Object result = new NativeCharArray(bytes); + return result; + } + // Checkstyle: stop method name check @Override @@ -68,26 +67,6 @@ public class TruffleLLVM_UpCallsRFFIImpl extends JavaUpCallsRFFIImpl { } } - @Override - public int Rf_error(Object msg) { - if (msg instanceof NativeCharArray) { - String smsg = new String(((NativeCharArray) msg).getValue(), StandardCharsets.UTF_8); - super.Rf_error(smsg); - } else { - throw RInternalError.unimplemented(); - } - return 0; - } - - @Override - public Object Rf_install(Object name) { - if (name instanceof NativeCharArray) { - return RDataFactory.createSymbolInterned(new String(((NativeCharArray) name).getValue(), StandardCharsets.UTF_8)); - } else { - throw RInternalError.unimplemented(); - } - } - @Override public Object RAW(Object x) { byte[] value = (byte[]) super.RAW(x); @@ -102,7 +81,7 @@ public class TruffleLLVM_UpCallsRFFIImpl extends JavaUpCallsRFFIImpl { @Override public Object INTEGER(Object x) { - int[] value = (int[]) super.INTEGER(checkNativeAddress(x)); + int[] value = (int[]) super.INTEGER(x); return new NativeIntegerArray(x, value); } @@ -121,7 +100,7 @@ public class TruffleLLVM_UpCallsRFFIImpl extends JavaUpCallsRFFIImpl { @Override public Object Rf_findVar(Object symbolArg, Object envArg) { - Object v = super.Rf_findVar(symbolArg, checkNativeAddress(envArg)); + Object v = super.Rf_findVar(symbolArg, envArg); if (v instanceof RTypedValue) { return v; } else { @@ -129,56 +108,6 @@ public class TruffleLLVM_UpCallsRFFIImpl extends JavaUpCallsRFFIImpl { } } - @Override - public int Rf_defineVar(Object symbolArg, Object value, Object envArg) { - super.Rf_defineVar(symbolArg, value, checkNativeAddress(envArg)); - return 0; - } - - @Override - @TruffleBoundary - public int Rf_setAttrib(Object obj, Object name, Object val) { - super.Rf_setAttrib(checkNativeAddress(obj), name, checkNativeAddress(val)); - return 0; - } - - @Override - public Object Rf_getAttrib(Object obj, Object name) { - Object checkedObj = checkNativeAddress(obj); - return super.Rf_getAttrib(checkedObj, name); - } - - @Override - public Object Rf_cons(Object car, Object cdr) { - return super.Rf_cons(checkNativeAddress(car), checkNativeAddress(cdr)); - } - - @Override - public Object CAR(Object e) { - return super.CAR(checkNativeAddress(e)); - } - - @Override - public Object CDR(Object e) { - return super.CDR(checkNativeAddress(e)); - } - - @Override - public Object CADR(Object e) { - Object ne = checkNativeAddress(e); - return super.CADR(ne); - } - - @Override - public Object SETCAR(Object x, Object y) { - return super.SETCAR(checkNativeAddress(x), y); - } - - public Object bytesToNativeCharArray(byte[] bytes) { - Object result = new NativeCharArray(bytes); - return result; - } - private static RScalar wrapPrimitive(Object x) { if (x instanceof Double) { return RDouble.valueOf((double) x); diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_Utils.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_Utils.java index 47ea412fb2..600f8ea846 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_Utils.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/TruffleLLVM_Utils.java @@ -28,9 +28,7 @@ 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.ffi.impl.interop.NativePointer; import com.oracle.truffle.r.runtime.RInternalError; -import com.oracle.truffle.r.runtime.data.RTruffleObject; import com.oracle.truffle.r.runtime.ffi.RFFIRootNode; public class TruffleLLVM_Utils { @@ -42,18 +40,6 @@ public class TruffleLLVM_Utils { return result; } - static Object checkNativeAddress(Object object) { - if (object instanceof RTruffleObject) { - return object; - } - TruffleObject useObj = (TruffleObject) object; - TruffleObject foo = NativePointer.check(useObj); - if (foo != null) { - useObj = foo; - } - return useObj; - } - static final class AsPointerRootNode extends RFFIRootNode<AsPointerNode> { private AsPointerRootNode() { super(new AsPointerNode()); diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/upcalls/BytesToNativeCharArrayCall.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/upcalls/BytesToNativeCharArrayCall.java new file mode 100644 index 0000000000..7d3f1dc3af --- /dev/null +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/upcalls/BytesToNativeCharArrayCall.java @@ -0,0 +1,47 @@ +/* + * Copyright (c) 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.ffi.impl.llvm.upcalls; + +import com.oracle.truffle.api.interop.ForeignAccess; +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.r.ffi.impl.llvm.TruffleLLVM_UpCallsRFFIImpl; +import com.oracle.truffle.r.runtime.data.RTruffleObject; + +public class BytesToNativeCharArrayCall implements RTruffleObject { + + public final TruffleLLVM_UpCallsRFFIImpl upCallsImpl; + + public BytesToNativeCharArrayCall(TruffleLLVM_UpCallsRFFIImpl upCallsImpl) { + this.upCallsImpl = upCallsImpl; + } + + public static boolean isInstance(TruffleObject value) { + return value instanceof BytesToNativeCharArrayCall; + } + + @Override + public ForeignAccess getForeignAccess() { + return BytesToNativeCharArrayCallMRForeign.ACCESS; + } + +} diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/upcalls/BytesToNativeCharArrayCallMR.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/upcalls/BytesToNativeCharArrayCallMR.java new file mode 100644 index 0000000000..904cd490ac --- /dev/null +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/upcalls/BytesToNativeCharArrayCallMR.java @@ -0,0 +1,47 @@ +/* + * Copyright (c) 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.ffi.impl.llvm.upcalls; + +import com.oracle.truffle.api.interop.MessageResolution; +import com.oracle.truffle.api.interop.Resolve; +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.api.interop.java.JavaInterop; +import com.oracle.truffle.api.nodes.Node; + +@MessageResolution(receiverType = BytesToNativeCharArrayCall.class) +public class BytesToNativeCharArrayCallMR { + @Resolve(message = "EXECUTE") + public abstract static class BytesToNativeCharArrayCallExecute extends Node { + protected java.lang.Object access(BytesToNativeCharArrayCall receiver, Object[] arguments) { + return receiver.upCallsImpl.bytesToNativeCharArray(JavaInterop.asJavaObject(byte[].class, (TruffleObject) arguments[0])); + } + } + + @Resolve(message = "IS_EXECUTABLE") + public abstract static class BytesToNativeCharArrayCallIsExecutable extends Node { + protected Object access(@SuppressWarnings("unused") BytesToNativeCharArrayCall receiver) { + return true; + } + } + +} diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/upcalls/CharSXPToNativeArrayCall.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/upcalls/CharSXPToNativeArrayCall.java new file mode 100644 index 0000000000..8a58ca5b13 --- /dev/null +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/upcalls/CharSXPToNativeArrayCall.java @@ -0,0 +1,46 @@ +/* + * Copyright (c) 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.ffi.impl.llvm.upcalls; + +import com.oracle.truffle.api.interop.ForeignAccess; +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.r.ffi.impl.llvm.TruffleLLVM_UpCallsRFFIImpl; +import com.oracle.truffle.r.runtime.data.RTruffleObject; + +public class CharSXPToNativeArrayCall implements RTruffleObject { + public final TruffleLLVM_UpCallsRFFIImpl upCallsImpl; + + public CharSXPToNativeArrayCall(TruffleLLVM_UpCallsRFFIImpl upCallsImpl) { + this.upCallsImpl = upCallsImpl; + } + + public static boolean isInstance(TruffleObject value) { + return value instanceof CharSXPToNativeArrayCall; + } + + @Override + public ForeignAccess getForeignAccess() { + return CharSXPToNativeArrayCallMRForeign.ACCESS; + } + +} diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/upcalls/CharSXPToNativeArrayCallMR.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/upcalls/CharSXPToNativeArrayCallMR.java new file mode 100644 index 0000000000..1dbd60e228 --- /dev/null +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/llvm/upcalls/CharSXPToNativeArrayCallMR.java @@ -0,0 +1,47 @@ +/* + * Copyright (c) 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.ffi.impl.llvm.upcalls; + +import com.oracle.truffle.api.interop.MessageResolution; +import com.oracle.truffle.api.interop.Resolve; +import com.oracle.truffle.api.nodes.Node; +import com.oracle.truffle.r.runtime.data.RTruffleObject; + +@MessageResolution(receiverType = CharSXPToNativeArrayCall.class) +public class CharSXPToNativeArrayCallMR implements RTruffleObject { + + @Resolve(message = "EXECUTE") + public abstract static class CharSXPToNativeArrayCallExecute extends Node { + protected java.lang.Object access(CharSXPToNativeArrayCall receiver, Object[] arguments) { + return receiver.upCallsImpl.charSXPToNativeCharArray(arguments[0]); + } + } + + @Resolve(message = "IS_EXECUTABLE") + public abstract static class CharSXPToNativeArrayCallIsExecutable extends Node { + protected Object access(@SuppressWarnings("unused") CharSXPToNativeArrayCall receiver) { + return true; + } + } + +} diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nfi/TruffleNFI_Base.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nfi/TruffleNFI_Base.java index f908c5e466..837a2ad3c8 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nfi/TruffleNFI_Base.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nfi/TruffleNFI_Base.java @@ -215,7 +215,7 @@ public class TruffleNFI_Base implements BaseRFFI { public ArrayList<String> glob(String pattern) { GlobResult data = new GlobResult(); try { - ForeignAccess.sendExecute(message, NFIFunction.glob.getFunction(), pattern, data); + ForeignAccess.sendExecute(message, NFIFunction.glob.getFunction(), data, pattern); } catch (InteropException e) { throw RInternalError.shouldNotReachHere(e); } diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nfi/TruffleNFI_Utils.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nfi/TruffleNFI_Utils.java index 0333bad16d..f8f5833168 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nfi/TruffleNFI_Utils.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nfi/TruffleNFI_Utils.java @@ -110,23 +110,6 @@ public class TruffleNFI_Utils { throw RInternalError.shouldNotReachHere(); } - /** - * There are three possibilities as enumerated below. For an {@link RTruffleObject} there is - * nothing to do, and indeed, calling {@code unbox} would be disastrous, as that means, e.g., - * for a RVector, extract the first element! We could get a plain {@link Integer}, but we could - * also get a {@code JavaObject} (aka a {@code TruffleObject} that wraps such a value. That does - * have to be unboxed. Ditto a {@code NativePointer} encoding, say, a C char array. - */ - public static Object unwrap(Object x) { - if (x instanceof RTruffleObject) { - return x; - } else if (x instanceof TruffleObject) { - return JavaInterop.unbox((TruffleObject) x); - } else { - return x; - } - } - public static void main(String[] args) { System.out.printf("argCount: %s%n", getArgCount(args[0])); } diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/StdUpCallsRFFI.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/StdUpCallsRFFI.java index 49014be6be..edb3a9d21d 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/StdUpCallsRFFI.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/StdUpCallsRFFI.java @@ -116,7 +116,7 @@ public interface StdUpCallsRFFI { int /* void */ Rf_warningcall(Object call, @RFFICstring Object msg); - Object Rf_allocVector(int mode, int n); + Object Rf_allocVector(int mode, long n); Object Rf_allocArray(int mode, Object dimsObj); @@ -128,9 +128,9 @@ public interface StdUpCallsRFFI { int LENGTH(Object x); - int /* void */ SET_STRING_ELT(Object x, int i, Object v); + int /* void */ SET_STRING_ELT(Object x, long i, Object v); - int /* void */ SET_VECTOR_ELT(Object x, int i, Object v); + int /* void */ SET_VECTOR_ELT(Object x, long i, Object v); Object RAW(Object x); @@ -140,9 +140,9 @@ public interface StdUpCallsRFFI { Object REAL(Object x); - Object STRING_ELT(Object x, int i); + Object STRING_ELT(Object x, long i); - Object VECTOR_ELT(Object x, int i); + Object VECTOR_ELT(Object x, long i); int NAMED(Object x); @@ -156,7 +156,7 @@ public interface StdUpCallsRFFI { Object Rf_duplicate(Object x, int deep); - int Rf_any_duplicated(Object x, int fromLast); + long Rf_any_duplicated(Object x, int fromLast); Object PRINTNAME(Object x); diff --git a/com.oracle.truffle.r.ffi.processor/src/com/oracle/truffle/r/ffi/processor/FFIProcessor.java b/com.oracle.truffle.r.ffi.processor/src/com/oracle/truffle/r/ffi/processor/FFIProcessor.java index a4623218d7..b7614ecb6d 100644 --- a/com.oracle.truffle.r.ffi.processor/src/com/oracle/truffle/r/ffi/processor/FFIProcessor.java +++ b/com.oracle.truffle.r.ffi.processor/src/com/oracle/truffle/r/ffi/processor/FFIProcessor.java @@ -230,7 +230,7 @@ public final class FFIProcessor extends AbstractProcessor { w.append("// GENERATED; DO NOT EDIT\n"); w.append("package ").append("com.oracle.truffle.r.ffi.impl.upcalls").append(";\n\n"); if (usesUnwrap) { - w.append("import static com.oracle.truffle.r.ffi.impl.nfi.TruffleNFI_Utils.unwrap;\n"); + w.append("import static com.oracle.truffle.r.ffi.impl.common.TruffleUnwrap.unwrap;\n"); } w.append("import com.oracle.truffle.api.interop.MessageResolution;\n"); w.append("import com.oracle.truffle.api.interop.Resolve;\n"); diff --git a/com.oracle.truffle.r.native/fficall/src/common/Makefile b/com.oracle.truffle.r.native/fficall/src/common/Makefile index 2a61a6187e..ac09cf124f 100644 --- a/com.oracle.truffle.r.native/fficall/src/common/Makefile +++ b/com.oracle.truffle.r.native/fficall/src/common/Makefile @@ -1,5 +1,5 @@ # -# Copyright (c) 2015, 2016, Oracle and/or its affiliates. All rights reserved. +# 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 diff --git a/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c b/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c index 710affdd15..7442f990c2 100644 --- a/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c +++ b/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c @@ -173,11 +173,11 @@ void init_internals(JNIEnv *env) { Rf_warningMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_warning", "(Ljava/lang/Object;)I", 0); Rf_warningcallMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_warningcall", "(Ljava/lang/Object;Ljava/lang/Object;)I", 0); Rf_errorMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_error", "(Ljava/lang/Object;)I", 0); - Rf_allocVectorMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_allocVector", "(II)Ljava/lang/Object;", 0); + Rf_allocVectorMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_allocVector", "(IJ)Ljava/lang/Object;", 0); Rf_allocMatrixMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_allocMatrix", "(III)Ljava/lang/Object;", 0); Rf_allocArrayMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_allocArray", "(ILjava/lang/Object;)Ljava/lang/Object;", 0); Rf_duplicateMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_duplicate", "(Ljava/lang/Object;I)Ljava/lang/Object;", 0); - Rf_any_duplicatedMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_any_duplicated", "(Ljava/lang/Object;I)I", 0); + Rf_any_duplicatedMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_any_duplicated", "(Ljava/lang/Object;I)J", 0); R_NewHashedEnvMethodID = checkGetMethodID(env, UpCallsRFFIClass, "R_NewHashedEnv", "(Lcom/oracle/truffle/r/runtime/env/REnvironment;Ljava/lang/Object;)Lcom/oracle/truffle/r/runtime/env/REnvironment;", 0); Rf_classgetsMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rf_classgets", "(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;", 0); RprintfMethodID = checkGetMethodID(env, UpCallsRFFIClass, "Rprintf", "(Ljava/lang/Object;)I", 0); @@ -204,14 +204,14 @@ void init_internals(JNIEnv *env) { SETCADR_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "SETCADR", "(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;", 0); SYMVALUE_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "SYMVALUE", "(Ljava/lang/Object;)Ljava/lang/Object;", 0); SET_SYMVALUE_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "SET_SYMVALUE", "(Ljava/lang/Object;Ljava/lang/Object;)I", 0); - SET_STRING_ELT_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "SET_STRING_ELT", "(Ljava/lang/Object;ILjava/lang/Object;)I", 0); - SET_VECTOR_ELT_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "SET_VECTOR_ELT", "(Ljava/lang/Object;ILjava/lang/Object;)I", 0); + SET_STRING_ELT_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "SET_STRING_ELT", "(Ljava/lang/Object;JLjava/lang/Object;)I", 0); + SET_VECTOR_ELT_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "SET_VECTOR_ELT", "(Ljava/lang/Object;JLjava/lang/Object;)I", 0); RAW_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "RAW", "(Ljava/lang/Object;)Ljava/lang/Object;", 0); REAL_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "REAL", "(Ljava/lang/Object;)Ljava/lang/Object;", 0); LOGICAL_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "LOGICAL", "(Ljava/lang/Object;)Ljava/lang/Object;", 0); INTEGER_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "INTEGER", "(Ljava/lang/Object;)Ljava/lang/Object;", 0); - STRING_ELT_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "STRING_ELT", "(Ljava/lang/Object;I)Ljava/lang/Object;", 0); - VECTOR_ELT_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "VECTOR_ELT", "(Ljava/lang/Object;I)Ljava/lang/Object;", 0); + STRING_ELT_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "STRING_ELT", "(Ljava/lang/Object;J)Ljava/lang/Object;", 0); + VECTOR_ELT_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "VECTOR_ELT", "(Ljava/lang/Object;J)Ljava/lang/Object;", 0); LENGTH_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "LENGTH", "(Ljava/lang/Object;)I", 0); R_do_slot_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "R_do_slot", "(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;", 0); R_do_slot_assign_MethodID = checkGetMethodID(env, UpCallsRFFIClass, "R_do_slot_assign", "(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;", 0); diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_common/Rdynload_fastr.h b/com.oracle.truffle.r.native/fficall/src/truffle_common/Rdynload_fastr.h new file mode 100644 index 0000000000..b3a9701bff --- /dev/null +++ b/com.oracle.truffle.r.native/fficall/src/truffle_common/Rdynload_fastr.h @@ -0,0 +1,138 @@ +/* + * Copyright (c) 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 <Rdynload.h> + +// The implementation must implement: +// void *ensure_function(void *fun) + +typedef void (*call_registerRoutines)(DllInfo *dllInfo, int nstOrd, int num, long routines); +typedef int (*call_useDynamicSymbols)(DllInfo *dllInfo, Rboolean value); +typedef void * (*call_setDotSymbolValues)(DllInfo *dllInfo, char *name, void *fun, int numArgs); +typedef int (*call_forceSymbols)(DllInfo *dllInfo, Rboolean value); +typedef int (*call_registerCCallable)(const char *pkgname, const char *name, void *fun); +typedef void* (*call_getCCallable)(const char *pkgname, const char *name); + +#define registerRoutines_x 0 +#define setDotSymbolValues_x 1 +#define useDynamicSymbols_x 2 +#define forceSymbols_x 3 +#define registerCCallable_x 4 +#define getCCallable_x 5 +#define CALLBACK_TABLE_SIZE 6 + +// 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) dynload_callbacks[registerRoutines_x])(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) dynload_callbacks[registerRoutines_x])(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) dynload_callbacks[registerRoutines_x])(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) dynload_callbacks[registerRoutines_x])(info, EXTERNAL_NATIVE_TYPE, num, (long) externalRoutines); + } + return 1; +} + +Rboolean R_useDynamicSymbols(DllInfo *dllInfo, Rboolean value) { + return ((call_useDynamicSymbols) dynload_callbacks[useDynamicSymbols_x])(dllInfo, value); +} + +Rboolean R_forceSymbols(DllInfo *dllInfo, Rboolean value) { + return ((call_forceSymbols) dynload_callbacks[forceSymbols_x])(dllInfo, value); +} + + +void *Rdynload_setSymbol(DllInfo *info, int nstOrd, long routinesAddr, int index) { + const char *name; + void * fun; + int numArgs; + switch (nstOrd) { + case C_NATIVE_TYPE: { + R_CMethodDef *croutines = (R_CMethodDef *) routinesAddr; + name = croutines[index].name; + fun = croutines[index].fun; + numArgs = croutines[index].numArgs; + break; + } + case CALL_NATIVE_TYPE: { + R_CallMethodDef *callRoutines = (R_CallMethodDef *) routinesAddr; + name = callRoutines[index].name; + fun = callRoutines[index].fun; + numArgs = callRoutines[index].numArgs; + break; + } + case FORTRAN_NATIVE_TYPE: { + R_FortranMethodDef * fortranRoutines = (R_FortranMethodDef *) routinesAddr; + name = fortranRoutines[index].name; + fun = fortranRoutines[index].fun; + numArgs = fortranRoutines[index].numArgs; + break; + } + case EXTERNAL_NATIVE_TYPE: { + R_ExternalMethodDef * externalRoutines = (R_ExternalMethodDef *) routinesAddr; + name = externalRoutines[index].name; + fun = externalRoutines[index].fun; + numArgs = externalRoutines[index].numArgs; + break; + } + } + //printf("call_setDotSymbolValues %p, %s, %p, %d\n", info, name, fun, numArgs); + void *result = ((call_setDotSymbolValues) dynload_callbacks[setDotSymbolValues_x])(info, ensure_string(name), ensure_fun(fun), numArgs); + return result; +} + +void R_RegisterCCallable(const char *package, const char *name, DL_FUNC fptr) { + ((call_registerCCallable) dynload_callbacks[registerCCallable_x])(ensure_string(package), ensure_string(name), (void *)fptr); +} + +DL_FUNC R_GetCCallable(const char *package, const char *name) { + return ((call_getCCallable) dynload_callbacks[getCCallable_x])(ensure_string(package), ensure_string(name)); +} + +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_common/Rinternals_truffle_common.h b/com.oracle.truffle.r.native/fficall/src/truffle_common/Rinternals_truffle_common.h new file mode 100644 index 0000000000..6f13622b65 --- /dev/null +++ b/com.oracle.truffle.r.native/fficall/src/truffle_common/Rinternals_truffle_common.h @@ -0,0 +1,1107 @@ +/* + * 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. + */ + +/* This file is "included" by the corresponding Rinternals.c in the + truffle_nfi and truffle_llvm directories. + The implementation must define the following five functions: + + SEXP checkRef(SEXP x) + Checks for 'x' being "handle" and returns the canionical handle. + + SEXP newObjectHandle(SEXP x) + + void releaseObjectHandle(SEXP x) + + char *ensure_truffle_chararray_n(const char *x, int n) + Ensures that the sequence of 'n' bytes starting at 'x' is in the + appropriate representation for the implementation. + + void *ensure_string(const char *x) + Ensures that (on the Java side of the upcall) x, which must be null-terminated, + appears as a java.lang.String + + Any of these functions could be the identity function. +*/ + +// R_GlobalEnv et al are not a variables in FASTR as they are RContext specific +SEXP FASTR_R_GlobalEnv() { + return ((call_R_GlobalEnv) callbacks[R_GlobalEnv_x])(); +} + +SEXP FASTR_R_BaseEnv() { + return ((call_R_BaseEnv) callbacks[R_BaseEnv_x])(); +} + +SEXP FASTR_R_BaseNamespace() { + return ((call_R_BaseNamespace) callbacks[R_BaseNamespace_x])(); +} + +SEXP FASTR_R_NamespaceRegistry() { + return ((call_R_NamespaceRegistry) callbacks[R_NamespaceRegistry_x])(); +} + +CTXT FASTR_GlobalContext() { + return ((call_R_GlobalContext) callbacks[R_GlobalContext_x])(); +} + +Rboolean FASTR_R_Interactive() { + return (int) ((call_R_Interactive) callbacks[R_Interactive_x])(); +} + +SEXP CAR(SEXP e) { + return checkRef(((call_CAR) callbacks[CAR_x])(e)); +} + +SEXP CDR(SEXP e) { + return checkRef(((call_CDR) callbacks[CDR_x])(e)); +} + +int LENGTH(SEXP x) { + return ((call_LENGTH) callbacks[LENGTH_x])(x); +} + +SEXP Rf_ScalarString(SEXP value) { + return checkRef(((call_Rf_ScalarString) callbacks[Rf_ScalarString_x])(value)); +} + +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 checkRef(((call_Rf_coerceVector) callbacks[Rf_coerceVector_x])(x, mode)); +} + +SEXP Rf_cons(SEXP car, SEXP cdr) { + return checkRef(((call_Rf_cons) callbacks[Rf_cons_x])(car, cdr)); +} + +SEXP Rf_GetOption1(SEXP tag) { + return checkRef(((call_Rf_GetOption1) callbacks[Rf_GetOption1_x])(tag)); +} + +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 checkRef(((call_Rf_mkCharLenCE) callbacks[Rf_mkCharLenCE_x])(ensure_truffle_chararray_n(x, len), len, enc)); +} + +#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_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, ensure_string(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])(ensure_string(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])(ensure_string(buf)); +} + +void Rf_error(const char *format, ...) { + // 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. + char buf[8192]; + va_list(ap); + va_start(ap,format); + Rvsnprintf(buf, BUFSIZE - 1, format, ap); + va_end(ap); + ((call_Rf_error) callbacks[Rf_error_x])(ensure_string(buf)); + // Should not reach here + unimplemented("Rf_error"); +} + + +/* + 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 checkRef(((call_Rf_ScalarInteger) callbacks[Rf_ScalarInteger_x])(value)); +} + +SEXP Rf_ScalarReal(double value) { + return checkRef(((call_Rf_ScalarReal) callbacks[Rf_ScalarDouble_x])(value)); +} + +SEXP Rf_ScalarLogical(int value) { + return checkRef(((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 checkRef(((call_Rf_allocVector) callbacks[Rf_allocVector_x])(t, len)); +} + +SEXP Rf_allocArray(SEXPTYPE t, SEXP dims) { + return checkRef(((call_Rf_allocArray) callbacks[Rf_allocArray_x])(t, dims)); +} + +SEXP Rf_alloc3DArray(SEXPTYPE t, int x, int y, int z) { + return unimplemented("Rf_alloc3DArray"); +} + +SEXP Rf_allocMatrix(SEXPTYPE mode, int nrow, int ncol) { + return checkRef(((call_Rf_allocMatrix) callbacks[Rf_allocMatrix_x])(mode, nrow, ncol)); +} + +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 checkRef(((call_Rf_eval) callbacks[Rf_eval_x])(expr, env)); +} + +SEXP Rf_findFun(SEXP symbol, SEXP rho) { + return checkRef(((call_Rf_findFun) callbacks[Rf_findFun_x])(symbol, rho)); +} + +SEXP Rf_findVar(SEXP sym, SEXP rho) { + return checkRef(((call_Rf_findVar) callbacks[Rf_findVar_x])(sym, rho)); +} + +SEXP Rf_findVarInFrame(SEXP rho, SEXP sym) { + return checkRef(((call_Rf_findVarInFrame) callbacks[Rf_findVarInFrame_x])(rho, sym)); +} + +SEXP Rf_findVarInFrame3(SEXP rho, SEXP sym, Rboolean b) { + return checkRef(((call_Rf_findVarInFrame3) callbacks[Rf_findVarInFrame3_x])(rho, sym, b)); +} + +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 checkRef(((call_Rf_setAttrib) callbacks[Rf_setAttrib_x])(vec, name, val)); +} + +SEXP Rf_duplicate(SEXP x) { + return checkRef(((call_Rf_duplicate) callbacks[Rf_duplicate_x])(x, 1)); +} + +SEXP Rf_shallow_duplicate(SEXP x) { + return checkRef(((call_Rf_duplicate) callbacks[Rf_duplicate_x])(x, 0)); +} + +R_xlen_t Rf_any_duplicated(SEXP x, Rboolean from_last) { + return (R_xlen_t) ((call_Rf_any_duplicated) callbacks[Rf_any_duplicated_x])(x, from_last); +} + +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) ((call_Rf_inherits) callbacks[Rf_inherits_x])(x, ensure_string(klass)); +} + +Rboolean Rf_isObject(SEXP s) { + unimplemented("Rf_isObject"); + return FALSE; +} + +void Rf_PrintValue(SEXP x) { + unimplemented("Rf_PrintValue"); +} + +SEXP Rf_install(const char *name) { + return checkRef(((call_Rf_install) callbacks[Rf_install_x])(ensure_string(name))); +} + +SEXP Rf_installChar(SEXP charsxp) { + return checkRef(((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) ((call_Rf_ncols) callbacks[Rf_ncols_x])(x); +} + +int Rf_nrows(SEXP x) { + return (int) ((call_Rf_nrows) callbacks[Rf_nrows_x])(x); +} + + +SEXP Rf_protect(SEXP x) { + return x; +} + +void Rf_unprotect(int x) { +} + +void R_ProtectWithIndex(SEXP x, PROTECT_INDEX *y) { + // +} + +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 checkRef(((call_R_NewHashedEnv) callbacks[R_NewHashedEnv_x])(parent, size)); +} + +SEXP Rf_classgets(SEXP vec, SEXP klass) { + return checkRef(((call_Rf_classgets) callbacks[Rf_classgets_x])(vec, klass)); +} + +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 checkRef(((call_Rf_lengthgets) callbacks[Rf_lengthgets_x])(x, y)); +} + +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 checkRef(((call_R_lsInternal3) callbacks[R_lsInternal3_x])(env, all, sorted)); +} + +SEXP Rf_namesgets(SEXP x, SEXP y) { + return unimplemented("Rf_namesgets"); +} + +SEXP TAG(SEXP e) { + return checkRef(((call_TAG) callbacks[TAG_x])(e)); +} + +SEXP PRINTNAME(SEXP e) { + return checkRef(((call_PRINTNAME) callbacks[PRINTNAME_x])(e)); +} + + +SEXP CAAR(SEXP e) { + unimplemented("CAAR"); + return NULL; +} + +SEXP CDAR(SEXP e) { + unimplemented("CDAR"); + return NULL; +} + +SEXP CADR(SEXP e) { + return checkRef(((call_CADR) callbacks[CADR_x])(e)); +} + +SEXP CDDR(SEXP e) { + return checkRef(((call_CDDR) callbacks[CDDR_x])(e)); +} + +SEXP CDDDR(SEXP e) { + unimplemented("CDDDR"); + return NULL; +} + +SEXP CADDR(SEXP e) { + return checkRef(((call_CADDR) callbacks[CADDR_x])(e)); +} + +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 checkRef(((call_SETCAR) callbacks[SETCAR_x])(x, y)); +} + +SEXP SETCDR(SEXP x, SEXP y) { + return checkRef(((call_SETCDR) callbacks[SETCDR_x])(x, y)); +} + +SEXP SETCADR(SEXP x, SEXP y) { + return checkRef(((call_SETCADR) callbacks[SETCADR_x])(x, y)); +} + +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) { + return ((call_RDEBUG) callbacks[RDEBUG_x])(x); +} + +int RSTEP(SEXP x) { + return ((call_RSTEP) callbacks[RSTEP_x])(x); +} + +int RTRACE(SEXP x) { + unimplemented("RTRACE"); + return 0; +} + +void SET_RDEBUG(SEXP x, int v) { + ((call_SET_RDEBUG) callbacks[SET_RDEBUG_x])(x, v); +} + +void SET_RSTEP(SEXP x, int v) { + ((call_SET_RSTEP) callbacks[SET_RSTEP_x])(x, v); +} + +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 checkRef(((call_SYMVALUE) callbacks[SYMVALUE_x])(x)); +} + +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) { + ((call_SET_SYMVALUE) callbacks[SET_SYMVALUE_x])(x, v); +} + +void SET_INTERNAL(SEXP x, SEXP v) { + unimplemented("SET_INTERNAL"); +} + +SEXP FRAME(SEXP x) { + return unimplemented("FRAME"); +} + +SEXP ENCLOS(SEXP x) { + return checkRef(((call_ENCLOS) callbacks[ENCLOS_x])(x)); +} + +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 checkRef(((call_PRCODE) callbacks[PRCODE_x])(x)); +} + +SEXP PRENV(SEXP x) { + return checkRef(((call_PRENV) callbacks[PRENV_x])(x)); +} + +SEXP PRVALUE(SEXP x) { + return checkRef(((call_PRVALUE) callbacks[PRVALUE_x])(x)); +} + +int PRSEEN(SEXP x) { + return ((call_PRSEEN) callbacks[PRSEEN_x])(x); +} + +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){ + return (Rcomplex*) unimplemented("COMPLEX"); +} + +SEXP STRING_ELT(SEXP x, R_xlen_t i) { + return checkRef(((call_STRING_ELT) callbacks[STRING_ELT_x])(x, i)); +} + + +SEXP VECTOR_ELT(SEXP x, R_xlen_t i){ + return checkRef(((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 checkRef(((call_SET_VECTOR_ELT) callbacks[SET_VECTOR_ELT_x])(x, i, v)); +} + +SEXP *STRING_PTR(SEXP x){ + unimplemented("STRING_PTR"); + return NULL; +} + + +SEXP * NORET VECTOR_PTR(SEXP x){ + unimplemented("VECTOR_PTR"); +} + +SEXP Rf_asChar(SEXP x){ + return checkRef(((call_Rf_asChar) callbacks[Rf_asChar_x])(x)); +} + +SEXP Rf_PairToVectorList(SEXP x){ + return checkRef(((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) { + return ((call_Rf_asReal) callbacks[Rf_asReal_x])(x); +} + +Rcomplex Rf_asComplex(SEXP x){ + unimplemented("Rf_asComplex"); + 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) ((call_OBJECT) callbacks[OBJECT_x])(x); +} + +int MARK(SEXP x){ + unimplemented("MARK"); + return 0; +} + +int NAMED(SEXP x){ + return (int) ((call_NAMED) callbacks[NAMED_x])(x); +} + +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){ + return checkRef(((call_SET_TYPEOF_FASTR) callbacks[SET_TYPEOF_FASTR_x])(x, 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){ + ((call_DUPLICATE_ATTRIB) callbacks[DUPLICATE_ATTRIB_x])(to, from); +} + +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) ((call_IS_S4_OBJECT) callbacks[IS_S4_OBJECT_x])(x); +} + +void SET_S4_OBJECT(SEXP x) { + ((call_SET_S4_OBJECT) callbacks[SET_S4_OBJECT_x])(x); +} + +void UNSET_S4_OBJECT(SEXP x) { + ((call_UNSET_S4_OBJECT) callbacks[UNSET_S4_OBJECT_x])(x); +} + +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_FindNamespace(SEXP info) { + return checkRef(((call_R_FindNamespace) callbacks[R_FindNamespace_x])(info)); +} + +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) ((call_R_BindingIsLocked) callbacks[R_BindingIsLocked_x])(sym, env); +} + +Rboolean R_BindingIsActive(SEXP sym, SEXP env) { + // TODO: for now, I believe 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) { + unimplemented("R_tryEvalInternal"); +} + +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 checkRef(((call_R_PromiseExpr) callbacks[R_PromiseExpr_x])(x)); +} + +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 checkRef(((call_R_MakeExternalPtr) callbacks[R_MakeExternalPtr_x])(p, tag, prot)); +} + +void *R_ExternalPtrAddr(SEXP s) { + return ((call_R_ExternalPtrAddr) callbacks[R_ExternalPtrAddr_x])(s); +} + +SEXP R_ExternalPtrTag(SEXP s) { + return checkRef(((call_R_ExternalPtrTag) callbacks[R_ExternalPtrTag_x])(s)); +} + +SEXP R_ExternalPtrProtected(SEXP s) { + return checkRef(((call_R_ExternalPtrProtected) callbacks[R_ExternalPtrProtected_x])(s)); +} + +void R_SetExternalPtrAddr(SEXP s, void *p) { + ((call_R_SetExternalPtrProtected) callbacks[R_SetExternalPtrProtected_x])(s, p); +} + +void R_SetExternalPtrTag(SEXP s, SEXP tag) { + ((call_R_SetExternalPtrProtected) callbacks[R_SetExternalPtrProtected_x])(s, tag); +} + +void R_SetExternalPtrProtected(SEXP s, SEXP p) { + ((call_R_SetExternalPtrProtected) callbacks[R_SetExternalPtrProtected_x])(s, p); +} + +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 checkRef(((call_R_do_slot) callbacks[R_do_slot_x])(obj, name)); +} + +SEXP R_do_slot_assign(SEXP obj, SEXP name, SEXP value) { + return checkRef(((call_R_do_slot_assign) callbacks[R_do_slot_assign_x])(obj, name, value)); +} + +int R_has_slot(SEXP obj, SEXP name) { + return (int) unimplemented("R_has_slot"); +} + +SEXP R_do_MAKE_CLASS(const char *what) { + return checkRef(((call_R_do_MAKE_CLASS) callbacks[R_do_MAKE_CLASS_x])(what)); +} + +SEXP R_getClassDef (const char *what) { + return unimplemented("R_getClassDef"); +} + +SEXP R_do_new_object(SEXP class_def) { + return checkRef(((call_R_do_new_object) callbacks[R_do_new_object_x])(class_def)); +} + +static SEXP nfiGetMethodsNamespace() { + return checkRef(((call_R_MethodsNamespace) callbacks[R_MethodsNamespace_x])()); +} + +int R_check_class_etc (SEXP x, const char **valid) { + return R_check_class_etc_helper(x, valid, nfiGetMethodsNamespace); +} + +SEXP R_PreserveObject(SEXP x) { + return newObjectHandle(x); +} + +void R_ReleaseObject(SEXP x) { + releaseObjectHandle(x); +} + +void R_dot_Last(void) { + unimplemented("R_dot_Last"); +} + + +Rboolean R_compute_identical(SEXP x, SEXP y, int flags) { + return (Rboolean) ((call_R_compute_identical) callbacks[R_compute_identical_x])(x, y, flags); +} + +void Rf_copyListMatrix(SEXP s, SEXP t, Rboolean byrow) { + ((call_Rf_copyListMatrix) callbacks[Rf_copyListMatrix_x])(s, t, byrow); +} + +void Rf_copyMatrix(SEXP s, SEXP t, Rboolean byrow) { + ((call_Rf_copyMatrix) callbacks[Rf_copyMatrix_x])(s, t, byrow); +} + diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_common/base_rffi.h b/com.oracle.truffle.r.native/fficall/src/truffle_common/base_rffi.h new file mode 100644 index 0000000000..72cd777fbc --- /dev/null +++ b/com.oracle.truffle.r.native/fficall/src/truffle_common/base_rffi.h @@ -0,0 +1,76 @@ +/* + * 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_base_uname(void (*call_uname_setfields)(char *sysname, char *release, char *version, char *machine, char *nodename)) { + struct utsname name; + + uname(&name); + call_uname_setfields(ensure_string(name.sysname), ensure_string(name.release), ensure_string(name.version), + ensure_string(name.machine), ensure_string(name.nodename)); +} + +int errfunc(const char* path, int error) { + return 0; +} + +void call_base_glob(void *closure, char *pattern) { + void (*call_addpath)(void *path) = closure; + + glob_t globstruct; + int rc = glob(pattern, 0, errfunc, &globstruct); + if (rc == 0) { + int i; + for (i = 0; i < globstruct.gl_pathc; i++) { + char *path = globstruct.gl_pathv[i]; + call_addpath(ensure_string(path)); + } + } +} + +void call_base_readlink(void (*call_setresult)(void *link, int cerrno), 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(ensure_string(link), cerrno); +} + +void call_base_strtol(void (*call_setresult)(long result, int cerrno), char *s, int base) { + long rc = strtol(s, NULL, base); + call_setresult(rc, errno); +} diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_common/pcre_rffi.h b/com.oracle.truffle.r.native/fficall/src/truffle_common/pcre_rffi.h new file mode 100644 index 0000000000..0b20885465 --- /dev/null +++ b/com.oracle.truffle.r.native/fficall/src/truffle_common/pcre_rffi.h @@ -0,0 +1,76 @@ +/* + * Copyright (c) 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> + +#define PCRE_INFO_CAPTURECOUNT 2 +#define PCRE_INFO_NAMEENTRYSIZE 7 +#define PCRE_INFO_NAMECOUNT 8 +#define PCRE_INFO_NAMETABLE 9 + +extern char *pcre_maketables(); +extern void *pcre_compile(char *pattern, int options, char **errorMessage, int *errOffset, char *tables); +extern 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); +extern void pcre_free(void *code); + +void call_pcre_compile(void (*makeresult)(long result, char *errMsg, int errOffset), char *pattern, int options, long tables) { + char *errorMessage; + int errOffset; + void *pcre_result = pcre_compile(pattern, options, &errorMessage, &errOffset, (char*) tables); + void *msg = NULL; + if (pcre_result == NULL) { + msg = ensure_string(errorMessage); + } makeresult((long) pcre_result, msg, errOffset); +} + +int call_pcre_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_pcre_getcapturenames(void (*setcapturename)(int i, char *name), long code, long extra) { + 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; + setcapturename(captureNum, ensure_string(entry + 2)); + } + return res; +} diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_llvm/Makefile b/com.oracle.truffle.r.native/fficall/src/truffle_llvm/Makefile index 0c6228ce71..3077166a29 100644 --- a/com.oracle.truffle.r.native/fficall/src/truffle_llvm/Makefile +++ b/com.oracle.truffle.r.native/fficall/src/truffle_llvm/Makefile @@ -52,6 +52,7 @@ C_HDRS := $(wildcard *.h) LOCAL_C_SOURCES := $(wildcard *.c) COMMON_C_SOURCES := $(wildcard ../common/*.c) TRUFFLE_COMMON_C_SOURCES := $(wildcard ../truffle_common/*.c) +TRUFFLE_COMMON_H_SOURCES := $(wildcard ../truffle_common/*.h) C_SOURCES := $(LOCAL_C_SOURCES) $(COMMON_C_SOURCES) $(TRUFFLE_COMMON_C_SOURCES) #$(info C_SOURCES=$(C_SOURCES)) LOCAL_C_OBJECTS := $(addprefix $(OBJ)/, $(LOCAL_C_SOURCES:.c=.o)) @@ -63,8 +64,8 @@ C_OBJECTS := $(LOCAL_C_OBJECTS) $(COMMON_C_OBJECTS) $(TRUFFLE_COMMON_C_OBJECTS) SULONG_DIR = $(abspath $(FASTR_R_HOME)/../sulong) SULONG_INCLUDES = -I$(SULONG_DIR)/include -FFI_INCLUDES = -I$(TOPDIR)/include -LOCAL_INCLUDES = -I . -I $(abspath ../include) +FFI_INCLUDES = -I$(TOPDIR)/include -I$(TOPDIR)/include/R_ext +LOCAL_INCLUDES = -I . -I $(abspath ../include) -I $(abspath ../common) INCLUDES := $(LOCAL_INCLUDES) $(FFI_INCLUDES) $(SULONG_INCLUDES) @@ -90,7 +91,7 @@ $(OBJ)/%.o: $(GNUR_APPL_SRC)/%.c $(OBJ)/%.o: $(GNUR_MAIN_SRC)/%.c $(CC) $(CFLAGS) $(INCLUDES) $(GNUR_HEADER_DEFS) $(SUPPRESS_WARNINGS) -c $< -o $@ -$(OBJ)/%.o: %.c $(FASTR_NATIVE_DIR)/include/Rinternals.h rffiutils.h +$(OBJ)/%.o: %.c $(FASTR_NATIVE_DIR)/include/Rinternals.h rffiutils.h $(TRUFFLE_COMMON_H_SOURCES) ../common/rffi_upcallsindex.h $(CC) $(CFLAGS) $(INCLUDES) $(GNUR_HEADER_DEFS) $(SUPPRESS_WARNINGS) -c $< -o $@ $(OBJ)/%.o: ../common/%.c $(FASTR_NATIVE_DIR)/include/Rinternals.h diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_llvm/Rdynload_fastr.c b/com.oracle.truffle.r.native/fficall/src/truffle_llvm/Rdynload_fastr.c index 5898757681..19dc2dca73 100644 --- a/com.oracle.truffle.r.native/fficall/src/truffle_llvm/Rdynload_fastr.c +++ b/com.oracle.truffle.r.native/fficall/src/truffle_llvm/Rdynload_fastr.c @@ -12,111 +12,23 @@ // Registering routines from loaded shared libraries - LLVM variant -#include <R_ext/Rdynload.h> #include <truffle.h> #include <rffiutils.h> -// 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 +static void **dynload_callbacks = NULL; -#define IMPORT_PKG_INIT() void *obj = truffle_import_cached("_fastr_rffi_pkginit") - -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) { - IMPORT_PKG_INIT(); - int num; - if (croutines) { - for(num = 0; croutines[num].name != NULL; num++) {;} - truffle_invoke(obj, "registerRoutines", info, C_NATIVE_TYPE, num, (long) croutines); - } - if (callRoutines) { - for(num = 0; callRoutines[num].name != NULL; num++) {;} - truffle_invoke(obj, "registerRoutines", info, CALL_NATIVE_TYPE, num, (long) callRoutines); - } - if (fortranRoutines) { - for(num = 0; fortranRoutines[num].name != NULL; num++) {;} - truffle_invoke(obj, "registerRoutines", info, FORTRAN_NATIVE_TYPE, num, (long) fortranRoutines); - } - if (externalRoutines) { - for(num = 0; externalRoutines[num].name != NULL; num++) {;} - truffle_invoke(obj, "registerRoutines", info, EXTERNAL_NATIVE_TYPE, num, (long) externalRoutines); - } - return 1; +void *ensure_fun(void *fun) { + void *r = truffle_address_to_function(fun); + return r; } -void *PkgInit_setSymbol(int nstOrd, long routinesAddr, int index) { - const char *name; - void *fun; - int numArgs; +#include "../truffle_common/Rdynload_fastr.h" - switch (nstOrd) { - case C_NATIVE_TYPE: { - R_CMethodDef *croutines = (R_CMethodDef *) routinesAddr; - name = croutines[index].name; - fun = croutines[index].fun; - numArgs = croutines[index].numArgs; - break; - } - case CALL_NATIVE_TYPE: { - R_CallMethodDef *callRoutines = (R_CallMethodDef *) routinesAddr; - name = callRoutines[index].name; - fun = callRoutines[index].fun; - numArgs = callRoutines[index].numArgs; - break; - } - case FORTRAN_NATIVE_TYPE: { - R_FortranMethodDef * fortranRoutines = (R_FortranMethodDef *) routinesAddr; - name = fortranRoutines[index].name; - fun = fortranRoutines[index].fun; - numArgs = fortranRoutines[index].numArgs; - break; - } - case EXTERNAL_NATIVE_TYPE: { - R_ExternalMethodDef * externalRoutines = (R_ExternalMethodDef *) routinesAddr; - name = externalRoutines[index].name; - fun = externalRoutines[index].fun; - numArgs = externalRoutines[index].numArgs; - break; - } +void Rdynload_addCallback(int index, void* callback) { + if (dynload_callbacks == NULL) { + dynload_callbacks = truffle_managed_malloc(CALLBACK_TABLE_SIZE * sizeof(void*)); } - void *nameString = truffle_read_string(name); - void *fundesc = truffle_address_to_function(fun); - IMPORT_PKG_INIT(); - void *result = truffle_invoke(obj, "createDotSymbol", nameString, fundesc, numArgs); - return result; + dynload_callbacks[index] = callback; } -void R_RegisterCCallable(const char *package, const char *name, DL_FUNC fptr) { - void *packageString = truffle_read_string(package); - void *nameString = truffle_read_string(name); - IMPORT_PKG_INIT(); - truffle_invoke(obj, "registerCCallable", packageString, nameString, (long) fptr); -} - -Rboolean R_useDynamicSymbols(DllInfo *dllInfo, Rboolean value) { - IMPORT_PKG_INIT(); - return truffle_invoke_i(obj, "useDynamicSymbols", dllInfo, value); -} - -Rboolean R_forceSymbols(DllInfo *dllInfo, Rboolean value) { - IMPORT_PKG_INIT(); - return truffle_invoke_i(obj, "forceSymbols", dllInfo, value); -} - -DL_FUNC R_GetCCallable(const char *package, const char *name) { - unimplemented("R_GetCCallable"); - return NULL; -} - -DL_FUNC R_FindSymbol(char const *name, char const *pkg, - R_RegisteredNativeSymbol *symbol) { - unimplemented("R_FindSymbol"); - return NULL; -} diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_llvm/Rinternals.c b/com.oracle.truffle.r.native/fficall/src/truffle_llvm/Rinternals.c index 6d04555401..8d45b717ff 100644 --- a/com.oracle.truffle.r.native/fficall/src/truffle_llvm/Rinternals.c +++ b/com.oracle.truffle.r.native/fficall/src/truffle_llvm/Rinternals.c @@ -21,1089 +21,92 @@ * questions. */ +#include <Rinterface.h> #include <rffiutils.h> +#include <Rinternals_common.h> #include <truffle.h> #include "../common/rffi_upcalls.h" // Most everything in RInternals.h +#define INTERNAL_UPCALLS_TABLE_SIZE UPCALLS_TABLE_SIZE + 2 +#define bytesToNativeCharArray_x UPCALLS_TABLE_SIZE +#define charSXPToNativeCharArray_x UPCALLS_TABLE_SIZE + 1 + +typedef char* (*call_bytesToNativeCharArray)(SEXP e); +typedef char* (*call_charSXPToNativeCharArray)(SEXP e); +typedef char* (*call_R_Home)(); + void **callbacks = NULL; void Rinternals_addCallback(int index, void *callback) { if (callbacks == NULL) { - callbacks = truffle_managed_malloc(UPCALLS_TABLE_SIZE * sizeof(void*)); + callbacks = truffle_managed_malloc(INTERNAL_UPCALLS_TABLE_SIZE * sizeof(void*)); } +// printf("setting callback %d\n", index); callbacks[index] = callback; } -static char *ensure_truffle_chararray_n(const char *x, int n); - -// R_GlobalEnv et al are not a variables in FASTR as they are RContext specific -SEXP FASTR_R_GlobalEnv() { - IMPORT_CALLHELPER_IMPL(); - return truffle_invoke(obj, "R_GlobalEnv"); -} - -SEXP FASTR_R_BaseEnv() { - IMPORT_CALLHELPER_IMPL(); - return truffle_invoke(obj, "R_BaseEnv"); -} - -SEXP FASTR_R_BaseNamespace() { - IMPORT_CALLHELPER_IMPL(); - return truffle_invoke(obj, "R_BaseNamespace"); -} - -SEXP FASTR_R_NamespaceRegistry() { - IMPORT_CALLHELPER_IMPL(); - return truffle_invoke(obj, "R_NamespaceRegistry"); -} - -Rboolean FASTR_R_Interactive() { - IMPORT_CALLHELPER_IMPL(); - return (Rboolean) truffle_invoke_i(obj, "R_Interactive"); -} - -SEXP Rf_ScalarInteger(int value) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "Rf_ScalarInteger", value); -} - -SEXP Rf_ScalarReal(double value) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "Rf_ScalarDouble", value); -} - -SEXP Rf_ScalarString(SEXP value) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "Rf_ScalarString", value); -} - -SEXP Rf_ScalarLogical(int value) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "Rf_ScalarLogical", value); -} - -SEXP Rf_allocVector3(SEXPTYPE t, R_xlen_t len, R_allocator_t* allocator) { - if (allocator != NULL) { - return unimplemented("RF_allocVector with custom allocator"); - } - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "Rf_allocVector", t, len); -} - -SEXP Rf_allocArray(SEXPTYPE t, SEXP dims) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "Rf_allocArray", t, dims); -} - -SEXP Rf_alloc3DArray(SEXPTYPE t, int x, int y, int z) { - return unimplemented("Rf_alloc3DArray"); -} - -SEXP Rf_allocMatrix(SEXPTYPE mode, int nrow, int ncol) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "Rf_allocMatrix", mode, nrow, ncol); -} - -SEXP Rf_allocList(int x) { - return unimplemented("Rf_allocList)"); -} - -SEXP Rf_allocSExp(SEXPTYPE t) { - return unimplemented("Rf_allocSExp"); -} - -SEXP Rf_cons(SEXP car, SEXP cdr) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "Rf_cons", car, cdr); -} - -void Rf_defineVar(SEXP symbol, SEXP value, SEXP rho) { - IMPORT_CALLHELPER(); - truffle_invoke(obj, "Rf_defineVar", 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 symbol, SEXP rho) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "Rf_findVar", symbol, rho); -} - -SEXP Rf_findVarInFrame(SEXP symbol, SEXP rho) { - return unimplemented("Rf_findVarInFrame"); -} - -SEXP Rf_getAttrib(SEXP vec, SEXP name) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "Rf_getAttrib", vec, name); -} - -SEXP Rf_setAttrib(SEXP vec, SEXP name, SEXP val) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "Rf_setAttrib", vec, name, val); -} - -SEXP Rf_duplicate(SEXP x) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "Rf_duplicate", x, 1); -} - -SEXP Rf_shallow_duplicate(SEXP x) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "Rf_duplicate", x, 0); -} - -R_xlen_t Rf_any_duplicated(SEXP x, Rboolean from_last) { - IMPORT_CALLHELPER(); - return (R_xlen_t) truffle_invoke(obj, "Rf_any_duplicated", x, from_last); -} - -SEXP Rf_duplicated(SEXP x, Rboolean y) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "Rf_duplicated", x, y); -} - -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"); -} - -Rboolean Rf_inherits(SEXP x, const char * klass) { - IMPORT_CALLHELPER(); - return (Rboolean) truffle_invoke(obj, "Rf_inherits", x, klass); -} - -Rboolean Rf_isObject(SEXP s) { - unimplemented("Rf_isObject"); - return FALSE; -} - -void Rf_PrintValue(SEXP x) { - unimplemented("Rf_PrintValue"); -} - -SEXP Rf_install(const char *name) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "Rf_install", ensure_truffle_chararray(name)); -} - -SEXP Rf_installChar(SEXP charsxp) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "Rf_installChar", charsxp); -} - -Rboolean Rf_isNull(SEXP s) { - IMPORT_CALLHELPER(); - return (Rboolean) truffle_invoke_i(obj, "Rf_isNull", s); -} - -Rboolean Rf_isString(SEXP s) { - IMPORT_CALLHELPER(); - return (Rboolean) truffle_invoke_i(obj, "Rf_isString", s); -} - -Rboolean R_cycle_detected(SEXP s, SEXP child) { - return (Rboolean) unimplemented("R_cycle_detected"); -} - -cetype_t Rf_getCharCE(SEXP x) { - // unimplemented("Rf_getCharCE"); - // TODO: real implementation - return CE_NATIVE; +SEXP checkRef(SEXP x) { + return x; } -char *ensure_truffle_chararray_n(const char *x, int n) { +static char *ensure_truffle_chararray_n(const char *x, int n) { if (truffle_is_truffle_object(x)) { return x; } else { - IMPORT_CALLHELPER_IMPL(); - return truffle_invoke(obj, "bytesToNativeCharArray", truffle_read_n_bytes(x, n)); + return ((call_bytesToNativeCharArray) callbacks[bytesToNativeCharArray_x])(truffle_read_n_bytes(x, n)); } } -SEXP Rf_mkCharLenCE_truffle(const char *x, cetype_t enc) { - // Assumes x is a NativeCharArray - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "Rf_mkCharLenCE", x, 0, enc); -} - -SEXP Rf_mkChar(const char *x) { - return Rf_mkCharLenCE_truffle(ensure_truffle_chararray(x), CE_NATIVE); -} - -SEXP Rf_mkCharCE(const char *x, cetype_t y) { - return Rf_mkCharLenCE_truffle(ensure_truffle_chararray(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 Rf_mkCharLenCE_truffle(ensure_truffle_chararray_n(x, len), enc); -} - -const char *Rf_reEnc(const char *x, cetype_t ce_in, cetype_t ce_out, int subst) { - // TODO proper implementation - return x; -} - -SEXP Rf_mkString(const char *s) { - return ScalarString(Rf_mkChar(s)); -} - -int Rf_ncols(SEXP x) { - IMPORT_CALLHELPER(); - return (int) truffle_invoke(obj, "Rf_ncols", x); +char *ensure_truffle_chararray(const char *x) { + if (truffle_is_truffle_object(x)) { + return (char *)x; + } else { + return ((call_bytesToNativeCharArray) callbacks[bytesToNativeCharArray_x])(truffle_read_n_bytes(x, strlen(x))); + } } -int Rf_nrows(SEXP x) { - IMPORT_CALLHELPER(); - return (int) truffle_invoke(obj, "Rf_nrows", x); +void *ensure_string(const char *x) { + return truffle_read_string(x); } - -SEXP Rf_protect(SEXP x) { +static SEXP newObjectHandle(SEXP x) { return x; } -void Rf_unprotect(int x) { - // TODO perhaps we can use this -} - -void R_ProtectWithIndex(SEXP x, PROTECT_INDEX *y) { - +static void releaseObjectHandle(SEXP x) { } -void R_Reprotect(SEXP x, PROTECT_INDEX y) { - +char *FASTR_R_Home() { + return ((call_R_Home) callbacks[R_Home_x])(); } -void Rf_unprotect_ptr(SEXP x) { - // TODO perhaps we can use this -} - -#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, ...) { - // 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. - char buf[8192]; - va_list(ap); - va_start(ap,format); - Rvsnprintf(buf, BUFSIZE - 1, format, ap); - va_end(ap); - IMPORT_CALLHELPER(); - truffle_invoke(obj, "Rf_error", ensure_truffle_chararray(buf)); -} - -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); - unimplemented("Rf_warningcall"); - -} - -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); - unimplemented("Rf_warning"); - -} - -void Rprintf(const char *format, ...) { - char buf[8192]; - va_list(ap); - va_start(ap,format); - Rvsnprintf(buf, BUFSIZE - 1, format, ap); - va_end(ap); - void *str = truffle_read_string(buf); - IMPORT_CALLHELPER(); - truffle_invoke(obj, "printf", str); -} - -/* - 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); - unimplemented("REprintf"); - -} - -void Rvprintf(const char *format, va_list args) { - unimplemented("Rvprintf"); -} -void REvprintf(const char *format, va_list args) { - unimplemented("REvprintf"); -} - -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) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "R_NewHashedEnv", parent, size); -} - -SEXP Rf_classgets(SEXP x, SEXP y) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "Rf_classgets", x, y); -} - -const char *Rf_translateChar(SEXP x) { -// unimplemented("Rf_translateChar"); - // TODO: proper implementation - const char *result = CHAR(x); -// printf("translateChar: '%s'\n", result); - return result; -} - -const char *Rf_translateChar0(SEXP x) { - unimplemented("Rf_translateChar0"); - return NULL; -} - -const char *Rf_translateCharUTF8(SEXP x) { - unimplemented("Rf_translateCharUTF8"); - return NULL; -} - -SEXP R_FindNamespace(SEXP info) { - return unimplemented("R_FindNamespace"); -} - -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 Rf_namesgets(SEXP x, SEXP y) { - return unimplemented("Rf_namesgets"); -} - -SEXP GetOption1(SEXP tag){ - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "GetOption1", tag); -} - -void Rf_gsetVar(SEXP symbol, SEXP value, SEXP rho) { - IMPORT_CALLHELPER(); - truffle_invoke(obj, "Rf_gsetVar", symbol, value, rho); -} - -SEXP TAG(SEXP e) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "TAG", e); -} - -SEXP PRINTNAME(SEXP e) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "PRINTNAME", e); -} - -SEXP CAR(SEXP e) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "CAR", e); -} - -SEXP CDR(SEXP e) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "CDR", e); -} - -SEXP CAAR(SEXP e) { - unimplemented("CAAR"); - return NULL; -} - -SEXP CDAR(SEXP e) { - unimplemented("CDAR"); - return NULL; -} - -SEXP CADR(SEXP e) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "CADR", e); -} - -SEXP CDDR(SEXP e) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "CDDR", e); -} - -SEXP CDDDR(SEXP e) { - unimplemented("CDDDR"); - return NULL; -} - -SEXP CADDR(SEXP e) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "CADDR", e); -} - -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) { - IMPORT_CALLHELPER(); - truffle_invoke(obj, "SET_TAG", x, y); -} - -SEXP SETCAR(SEXP x, SEXP y) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "SETCAR", x, y); -} - -SEXP SETCDR(SEXP x, SEXP y) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "SETCDR", x, y); -} - -SEXP SETCADR(SEXP x, SEXP y) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "SETCADR", x, y); -} - -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) { - IMPORT_CALLHELPER(); - return (int) truffle_invoke(obj, "RDEBUG", x); -} - -int RSTEP(SEXP x) { - IMPORT_CALLHELPER(); - return (int) truffle_invoke(obj, "RSTEP", x); -} - -int RTRACE(SEXP x) { - unimplemented("RTRACE"); - return 0; -} - -void SET_RDEBUG(SEXP x, int v) { - IMPORT_CALLHELPER(); - truffle_invoke(obj, "SET_RDEBUG", x, v); -} - -void SET_RSTEP(SEXP x, int v) { - IMPORT_CALLHELPER(); - truffle_invoke(obj, "SET_RSTEP", x, v); -} - -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) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "SYMVALUE", x); -} - -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) { - IMPORT_CALLHELPER(); - truffle_invoke(obj, "SET_SYMVALUE", x, v); -} - -void SET_INTERNAL(SEXP x, SEXP v) { - unimplemented("SET_INTERNAL"); -} - - -SEXP FRAME(SEXP x) { - return unimplemented("FRAME"); -} - -SEXP ENCLOS(SEXP x) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "ENCLOS", x); -} - -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) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "PRCODE", x); -} - -SEXP PRENV(SEXP x) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "PRENV", x); -} - -SEXP PRVALUE(SEXP x) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "PRVALUE", x); -} - -int PRSEEN(SEXP x) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "PRSEEN", x); -} - -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 LENGTH(SEXP x) { - IMPORT_CALLHELPER(); - return truffle_invoke_i(obj, "LENGTH", x); -} - -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; -} +#include <string.h> +#include "../truffle_common/Rinternals_truffle_common.h" int *LOGICAL(SEXP x){ - IMPORT_CALLHELPER(); - return (int*) truffle_invoke(obj, "LOGICAL", x); + return (int*) ((call_INTEGER) callbacks[LOGICAL_x])(x); } int *INTEGER(SEXP x){ - IMPORT_CALLHELPER(); - return (int*) truffle_invoke(obj, "INTEGER", x); + return (int*) ((call_INTEGER) callbacks[INTEGER_x])(x); } Rbyte *RAW(SEXP x){ - IMPORT_CALLHELPER(); - return (int*) truffle_invoke(obj, "RAW", x); + return (Rbyte *) ((call_INTEGER) callbacks[REAL_x])(x); } double *REAL(SEXP x){ - IMPORT_CALLHELPER(); - return (double*) truffle_invoke(obj, "REAL", x); -} - - -Rcomplex *COMPLEX(SEXP x){ - return (Rcomplex*) unimplemented("COMPLEX"); -} - - -SEXP STRING_ELT(SEXP x, R_xlen_t i){ - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "STRING_ELT", x, i); -} - - -SEXP VECTOR_ELT(SEXP x, R_xlen_t i){ - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "VECTOR_ELT", x, i); -} - -void SET_STRING_ELT(SEXP x, R_xlen_t i, SEXP v){ - IMPORT_CALLHELPER(); - truffle_invoke(obj, "SET_STRING_ELT", x, i, v); -} - - -SEXP SET_VECTOR_ELT(SEXP x, R_xlen_t i, SEXP v){ - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "SET_VECTOR_ELT", x, i, v); -} - - -SEXP *STRING_PTR(SEXP x){ - return unimplemented("STRING_PTR"); -} - - -SEXP *VECTOR_PTR(SEXP x){ - return unimplemented("VECTOR_PTR"); -} - -SEXP Rf_asChar(SEXP x){ - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "Rf_asChar", x); -} - -SEXP Rf_PairToVectorList(SEXP x){ - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "Rf_PairToVectorList", x); -} - -SEXP Rf_VectorToPairList(SEXP x){ - return unimplemented("Rf_VectorToPairList"); -} - -SEXP Rf_asCharacterFactor(SEXP x){ - return unimplemented("Rf_VectorToPairList"); -} - -int Rf_asLogical(SEXP x){ - IMPORT_CALLHELPER(); - return truffle_invoke_i(obj, "Rf_asLogical", x); + return (double*) ((call_INTEGER) callbacks[INTEGER_x])(x); } -int Rf_asInteger(SEXP x) { - IMPORT_CALLHELPER(); - return truffle_invoke_i(obj, "Rf_asInteger", x); -} - -double Rf_asReal(SEXP x) { - IMPORT_CALLHELPER(); - return (double) truffle_invoke_d(obj, "Rf_asReal", x); -} - -Rcomplex Rf_asComplex(SEXP x){ - unimplemented("Rf_asLogical"); - Rcomplex c; return c; -} - -int TYPEOF(SEXP x) { - IMPORT_CALLHELPER(); - return truffle_invoke_i(obj, "TYPEOF", x); -} - -SEXP ATTRIB(SEXP x){ - unimplemented("ATTRIB"); - return NULL; -} - -int OBJECT(SEXP x){ - return (int) unimplemented("OBJECT"); -} - -int MARK(SEXP x){ - IMPORT_CALLHELPER(); - return (int) truffle_invoke(obj, "MARK", x); -} - -int NAMED(SEXP x){ - IMPORT_CALLHELPER(); - return truffle_invoke_i(obj, "NAMED", x); -} - -int REFCNT(SEXP x){ - return (int) unimplemented("REFCNT"); -} - -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){ - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "SET_TYPEOF_FASTR", x, 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){ - IMPORT_CALLHELPER(); - truffle_invoke(obj, "DUPLICATE_ATTRIB", to, from); -} const char *R_CHAR(SEXP charsxp) { - IMPORT_CALLHELPER_IMPL(); - return (char *)truffle_invoke(obj, "charSXPToNativeCharArray", charsxp); -} - -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"); + return ((call_charSXPToNativeCharArray) callbacks[charSXPToNativeCharArray_x])(charsxp); } -int IS_S4_OBJECT(SEXP x) { - return (int) unimplemented("IS_S4_OBJECT"); -} - -void SET_S4_OBJECT(SEXP x) { - IMPORT_CALLHELPER(); - truffle_invoke(obj, "SET_S4_OBJECT", x); -} - -void UNSET_S4_OBJECT(SEXP x) { - IMPORT_CALLHELPER(); - truffle_invoke(obj, "UNSET_S4_OBJECT", x); -} - -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"); -} - -SEXP R_tryEval(SEXP x, SEXP y, int *z) { - return unimplemented("R_tryEval"); -} - -SEXP R_tryEvalSilent(SEXP x, SEXP y, int *z) { - return unimplemented("R_tryEvalSilent"); -} - -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) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "R_PromiseExpr", x); -} - -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) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "R_MakeExternalPtr", (long) p, tag, prot); -} - -void *R_ExternalPtrAddr(SEXP s) { - IMPORT_CALLHELPER(); - return (void*) truffle_invoke_l(obj, "R_ExternalPtrAddr", s); -} - -SEXP R_ExternalPtrTag(SEXP s) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "R_ExternalPtrTag", s); -} - -SEXP R_ExternalPtrProt(SEXP s) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "R_ExternalPtrProt", s); -} - -void R_SetExternalPtrAddr(SEXP s, void *p) { - IMPORT_CALLHELPER(); - truffle_invoke(obj, "R_SetExternalPtrAddr", s, p); -} - -void R_SetExternalPtrTag(SEXP s, SEXP tag) { - IMPORT_CALLHELPER(); - truffle_invoke(obj, "R_SetExternalPtrTag", s, tag); -} - -void R_SetExternalPtrProt(SEXP s, SEXP p) { - IMPORT_CALLHELPER(); - truffle_invoke(obj, "R_SetExternalPtrProt", s, p); -} - -void R_ClearExternalPtr(SEXP s) { - IMPORT_CALLHELPER(); - truffle_invoke(obj, "R_ClearExternalPtr", s); -} - -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_do_slot(SEXP objx, SEXP name) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "R_do_slot", objx, name); -} - -SEXP R_do_slot_assign(SEXP objx, SEXP name, SEXP value) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "R_do_slot_assign", objx, name, value); -} - -int R_has_slot(SEXP obj, SEXP name) { - return (int) unimplemented("R_has_slot"); -} - -SEXP R_do_MAKE_CLASS(const char *what) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "R_do_MAKE_CLASS", what); -} - -SEXP R_getClassDef (const char *what) { - return unimplemented("R_getClassDef"); -} - -SEXP R_do_new_object(SEXP class_def) { - IMPORT_CALLHELPER(); - return truffle_invoke(obj, "R_do_new_object", class_def); -} - -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_FASTR(SEXP x) { - return unimplemented("R_PreserveObject"); -} - -void R_ReleaseObject(SEXP x) { - unimplemented("R_ReleaseObject"); -} - -Rboolean R_compute_identical(SEXP x, SEXP y, int flags) { - IMPORT_CALLHELPER(); - return (Rboolean) truffle_invoke(obj, "R_compute_identical", x, y, flags); -} - -void Rf_copyListMatrix(SEXP s, SEXP t, Rboolean byrow) { - IMPORT_CALLHELPER(); - truffle_invoke(obj, "Rf_copyListMatrix", s, t, byrow); -} - -void Rf_copyMatrix(SEXP s, SEXP t, Rboolean byrow) { - IMPORT_CALLHELPER(); - truffle_invoke(obj, "Rf_copyMatrix", s, t, byrow); -} diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_llvm/base_rffi.c b/com.oracle.truffle.r.native/fficall/src/truffle_llvm/base_rffi.c index 0100364162..78d7aaddeb 100644 --- a/com.oracle.truffle.r.native/fficall/src/truffle_llvm/base_rffi.c +++ b/com.oracle.truffle.r.native/fficall/src/truffle_llvm/base_rffi.c @@ -28,8 +28,9 @@ #include <glob.h> #include <sys/utsname.h> #include <errno.h> +#include <rffiutils.h> -#define IMPORT_BASE_HELPER() void *base = truffle_import_cached("_fastr_rffi_base") +#include "../truffle_common/base_rffi.h" int call_base_getpid() { return getpid(); @@ -61,62 +62,8 @@ int call_base_mkdtemp(char *template) { } } -void call_base_readlink(void *callback, char* path) { - char *link = NULL; - char buf[4096]; - int cerrno = 0; - int len = readlink(path, buf, 4096); - IMPORT_BASE_HELPER(); - if (len == -1) { - cerrno = errno; - } else { - buf[len] = 0; - link = ensure_truffle_chararray(buf); - } - truffle_invoke(base,"setReadlinkResult", callback, link, cerrno); -} - -void call_base_strtol(void *callback, char *s, int nbase) { - long rc = strtol(s, NULL, nbase); - IMPORT_BASE_HELPER(); - truffle_invoke(base, "setStrtolResult", callback, rc, errno); -} - -void call_base_uname(void *callback) { - struct utsname name; - - uname(&name); - IMPORT_BASE_HELPER(); - truffle_invoke(base, "setUnameResult", - callback, - ensure_truffle_chararray(name.sysname), - ensure_truffle_chararray(name.release), - ensure_truffle_chararray(name.version), - ensure_truffle_chararray(name.machine), - ensure_truffle_chararray(name.nodename)); -} int call_base_chmod(char *path, int mode) { int rc = chmod(path, mode); return rc; } - -int errfunc(const char* path, int error) { - return 0; -} - -void call_base_glob(void *callback, char *pattern) { - glob_t globstruct; - - int rc = glob(pattern, 0, errfunc, &globstruct); - if (rc == 0) { - IMPORT_BASE_HELPER(); - - int i; - for (i = 0; i < globstruct.gl_pathc; i++) { - char *path = globstruct.gl_pathv[i]; - truffle_invoke(base, "setGlobResult", callback, ensure_truffle_chararray(path)); - } - } - -} diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_llvm/call_dlopen.c b/com.oracle.truffle.r.native/fficall/src/truffle_llvm/call_dlopen.c index 04fec88d23..d37ff6d115 100644 --- a/com.oracle.truffle.r.native/fficall/src/truffle_llvm/call_dlopen.c +++ b/com.oracle.truffle.r.native/fficall/src/truffle_llvm/call_dlopen.c @@ -36,13 +36,13 @@ #include <dlfcn.h> #include <errno.h> -long call_dlopen(void *callback, char *path, int local, int now) { +long call_dlopen(void *callback(char *result), char *path, int local, int now) { int flags = (local ? RTLD_LOCAL : RTLD_GLOBAL) | (now ? RTLD_NOW : RTLD_LAZY); void *handle = dlopen(path, flags); if (handle == NULL) { int cerrno = errno; char *error = dlerror(); - truffle_invoke(truffle_import_cached("_fastr_dllnative_helper"), "setDlopenResult", callback, error); + callback(error); } return (long) handle; } diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_llvm/pcre_rffi.c b/com.oracle.truffle.r.native/fficall/src/truffle_llvm/pcre_rffi.c index 5307bdc7a4..170bfeaeeb 100644 --- a/com.oracle.truffle.r.native/fficall/src/truffle_llvm/pcre_rffi.c +++ b/com.oracle.truffle.r.native/fficall/src/truffle_llvm/pcre_rffi.c @@ -11,68 +11,12 @@ */ #include <rffiutils.h> -#define PCRE_INFO_CAPTURECOUNT 2 -#define PCRE_INFO_NAMEENTRYSIZE 7 -#define PCRE_INFO_NAMECOUNT 8 -#define PCRE_INFO_NAMETABLE 9 - -extern char *pcre_maketables(); -extern void *pcre_compile(char *pattern, int options, char **errorMessage, int *errOffset, char *tables); -extern 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); -extern void pcre_free(void *code); - -#define IMPORT_PCRE_HELPER() void *pcre = truffle_import_cached("_fastr_rffi_pcre") +#include "../truffle_common/pcre_rffi.h" char *call_pcre_maketables() { return pcre_maketables(); } -void *call_pcre_compile(char *pattern, int options, long tables) { - char *errorMessage; - int errOffset; - void *pcre_result = pcre_compile(pattern, options, &errorMessage, &errOffset, (char*) tables); - void *msg = NULL; - if (pcre_result == NULL) { - msg = ensure_truffle_chararray(errorMessage); - } - IMPORT_PCRE_HELPER(); - return truffle_invoke(pcre, "makeResult", pcre_result, msg, errOffset); -} - -int call_pcre_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_pcre_getcapturenames(long code, long extra, void *captureNamesCallback) { - 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; - } - IMPORT_PCRE_HELPER(); - // 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; - truffle_invoke(pcre, "addCaptureName", captureNum, ensure_truffle_chararray(entry + 2), captureNamesCallback); - } - return res; -} - int call_pcre_exec(long code, long extra, char *subject, int subjectLength, int startOffset, int options, int *ovectorElems, int ovectorLen) { int rc = pcre_exec((void *) code, (void *) extra, (char *) subject, subjectLength, startOffset, options, ovectorElems, ovectorLen); diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_llvm/rffiutils.c b/com.oracle.truffle.r.native/fficall/src/truffle_llvm/rffiutils.c index ebfce9ea30..99ead1d2b3 100644 --- a/com.oracle.truffle.r.native/fficall/src/truffle_llvm/rffiutils.c +++ b/com.oracle.truffle.r.native/fficall/src/truffle_llvm/rffiutils.c @@ -24,17 +24,10 @@ SEXP unimplemented(char *name) { printf("unimplemented %s\n", name); - void *nameString = truffle_read_string(name); - void *obj = truffle_import_cached("_fastr_rffi_call"); - void *result = truffle_invoke(obj, "unimplemented", nameString); - return result; + exit(1); } -char *ensure_truffle_chararray(const char *x) { - if (truffle_is_truffle_object(x)) { - return (char *)x; - } else { - IMPORT_CALLHELPER_IMPL(); - return truffle_invoke(obj, "bytesToNativeCharArray", truffle_read_n_bytes(x, strlen(x))); - } +void fatalError(char *msg) { + printf("faatal error %s\n", msg); + exit(1); } diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_llvm/rffiutils.h b/com.oracle.truffle.r.native/fficall/src/truffle_llvm/rffiutils.h index fdc0facaf0..5306705e33 100644 --- a/com.oracle.truffle.r.native/fficall/src/truffle_llvm/rffiutils.h +++ b/com.oracle.truffle.r.native/fficall/src/truffle_llvm/rffiutils.h @@ -29,10 +29,9 @@ #include <Rinternals.h> #include <truffle.h> -#define IMPORT_CALLHELPER() void *obj = truffle_import_cached("_fastr_rffi_callhelper") -#define IMPORT_CALLHELPER_IMPL() void *obj = truffle_import_cached("_fastr_rffi_callhelper_impl") - char *ensure_truffle_chararray(const char *x); +void *ensure_string(const char *x); +void *ensure_fun(void *fun); SEXP unimplemented(char *name); #endif /* RFFIUTILS_H */ diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_llvm/variables.c b/com.oracle.truffle.r.native/fficall/src/truffle_llvm/variables.c index 7972251ef0..5ae5023e69 100644 --- a/com.oracle.truffle.r.native/fficall/src/truffle_llvm/variables.c +++ b/com.oracle.truffle.r.native/fficall/src/truffle_llvm/variables.c @@ -30,12 +30,7 @@ double R_NegInf; /* IEEE -Inf */ double R_NaReal; /* NA_REAL: IEEE */ int R_NaInt; /* NA_INTEGER:= INT_MIN currently */ -void **variables = NULL; - -char *FASTR_R_Home() { - IMPORT_CALLHELPER_IMPL(); - return (char *) truffle_invoke(obj, "R_Home"); -} +static void **variables = NULL; SEXP FASTR_R_NilValue() { return (SEXP) variables[R_NilValue_x]; diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Makefile b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Makefile index 2139707381..9fae57fc98 100644 --- a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Makefile +++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Makefile @@ -34,6 +34,7 @@ C_HDRS := $(wildcard *.h) LOCAL_C_SOURCES = $(wildcard *.c) TRUFFLE_COMMON_C_SOURCES := $(wildcard ../truffle_common/*.c) +TRUFFLE_COMMON_H_SOURCES := $(wildcard ../truffle_common/*.h) C_SOURCES := $(LOCAL_C_SOURCES) $(TRUFFLE_COMMON_C_SOURCES) #$(info C_SOURCES=$(C_SOURCES)) TRUFFLE_COMMON_C_OBJECTS := $(addprefix $(OBJ)/, $(notdir $(TRUFFLE_COMMON_C_SOURCES:.c=.o))) @@ -60,7 +61,7 @@ $(OBJ): $(OBJ)/%.o: %.c $(TOPDIR)/include/Rinternals.h ../common/rffi_upcallsindex.h $(C_HDRS) $(CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ -$(OBJ)/%.o: ../truffle_common/%.c $(TOPDIR)/include/Rinternals.h ../common/rffi_upcallsindex.h $(C_HDRS) +$(OBJ)/%.o: ../truffle_common/%.c $(TOPDIR)/include/Rinternals.h $(TRUFFLE_COMMON_H_SOURCES) ../common/rffi_upcallsindex.h $(C_HDRS) $(CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ # for debugging, to see what's really being compiled diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rinternals.c b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rinternals.c index 05e517b201..b21117fe72 100644 --- a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rinternals.c +++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rinternals.c @@ -44,6 +44,24 @@ static int* return_int; static double* return_double; static char* return_byte; +char *ensure_truffle_chararray_n(const char *x, int n) { + return (char *) x; +} + +void *ensure_string(const char * x) { + return (void *) x; +} + +SEXP newObjectHandle(SEXP x) { + return newObjectRef(x); +} + +void releaseObjectHandle(SEXP x) { + releaseObjectRef(x); +} + +#include "../truffle_common/Rinternals_truffle_common.h" + long return_INTEGER_CREATE(int *value, int len) { int* idata = malloc(len * sizeof(int)); memcpy(idata, value, len * sizeof(int)); @@ -87,39 +105,6 @@ 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 ((call_R_GlobalEnv) callbacks[R_GlobalEnv_x])(); -} - -SEXP FASTR_R_BaseEnv() { - return ((call_R_BaseEnv) callbacks[R_BaseEnv_x])(); -} - -SEXP FASTR_R_BaseNamespace() { - return ((call_R_BaseNamespace) callbacks[R_BaseNamespace_x])(); -} - -SEXP FASTR_R_NamespaceRegistry() { - return ((call_R_NamespaceRegistry) callbacks[R_NamespaceRegistry_x])(); -} - -CTXT FASTR_GlobalContext() { - return ((call_R_GlobalContext) callbacks[R_GlobalContext_x])(); -} - -Rboolean FASTR_R_Interactive() { - return ((call_R_Interactive) callbacks[R_Interactive_x])(); -} - -SEXP CAR(SEXP e) { - return checkRef(((call_CAR) callbacks[CAR_x])(e)); -} - -SEXP CDR(SEXP e) { - return checkRef(((call_CDR) callbacks[CDR_x])(e)); -} - int *INTEGER(SEXP x) { ((call_INTEGER) callbacks[INTEGER_x])(x); return return_int; @@ -140,1058 +125,8 @@ Rbyte *RAW(SEXP x) { return (Rbyte *) 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 checkRef(((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 checkRef(((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 checkRef(((call_Rf_coerceVector) callbacks[Rf_coerceVector_x])(x, mode)); -} - -SEXP Rf_cons(SEXP car, SEXP cdr) { - return checkRef(((call_Rf_cons) callbacks[Rf_cons_x])(car, cdr)); -} - -SEXP Rf_GetOption1(SEXP tag) { - return checkRef(((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); - // Should not reach here - unimplemented("Rf_error"); -} - -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 checkRef(((call_Rf_ScalarInteger) callbacks[Rf_ScalarInteger_x])(value)); -} - -SEXP Rf_ScalarReal(double value) { - return checkRef(((call_Rf_ScalarReal) callbacks[Rf_ScalarDouble_x])(value)); -} - -SEXP Rf_ScalarLogical(int value) { - return checkRef(((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 checkRef(((call_Rf_allocVector) callbacks[Rf_allocVector_x])(t, len)); -} - -SEXP Rf_allocArray(SEXPTYPE t, SEXP dims) { - return checkRef(((call_Rf_allocArray) callbacks[Rf_allocArray_x])(t, dims)); -} - -SEXP Rf_alloc3DArray(SEXPTYPE t, int x, int y, int z) { - return unimplemented("Rf_alloc3DArray"); -} - -SEXP Rf_allocMatrix(SEXPTYPE mode, int nrow, int ncol) { - return checkRef(((call_Rf_allocMatrix) callbacks[Rf_allocMatrix_x])(mode, nrow, ncol)); -} - -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 checkRef(((call_Rf_eval) callbacks[Rf_eval_x])(expr, env)); -} - -SEXP Rf_findFun(SEXP symbol, SEXP rho) { - return checkRef(((call_Rf_findFun) callbacks[Rf_findFun_x])(symbol, rho)); -} - -SEXP Rf_findVar(SEXP sym, SEXP rho) { - return checkRef(((call_Rf_findVar) callbacks[Rf_findVar_x])(sym, rho)); -} - -SEXP Rf_findVarInFrame(SEXP rho, SEXP sym) { - return checkRef(((call_Rf_findVarInFrame) callbacks[Rf_findVarInFrame_x])(rho, sym)); -} - -SEXP Rf_findVarInFrame3(SEXP rho, SEXP sym, Rboolean b) { - return checkRef(((call_Rf_findVarInFrame3) callbacks[Rf_findVarInFrame3_x])(rho, sym, b)); -} - -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 checkRef(((call_Rf_setAttrib) callbacks[Rf_setAttrib_x])(vec, name, val)); -} - -SEXP Rf_duplicate(SEXP x) { - return checkRef(((call_Rf_duplicate) callbacks[Rf_duplicate_x])(x, 1)); -} - -SEXP Rf_shallow_duplicate(SEXP x) { - return checkRef(((call_Rf_duplicate) callbacks[Rf_duplicate_x])(x, 0)); -} - -R_xlen_t Rf_any_duplicated(SEXP x, Rboolean from_last) { - return ((call_Rf_any_duplicated) callbacks[Rf_any_duplicated_x])(x, from_last); -} - -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) { - unimplemented("Rf_countContexts"); - return 0; -} - -Rboolean Rf_inherits(SEXP x, const char * klass) { - return ((call_Rf_inherits) callbacks[Rf_inherits_x])(x, klass); -} - -Rboolean Rf_isObject(SEXP s) { - unimplemented("Rf_isObject"); - return FALSE; -} - -void Rf_PrintValue(SEXP x) { - unimplemented("Rf_PrintValue"); -} - -SEXP Rf_install(const char *name) { - return checkRef(((call_Rf_install) callbacks[Rf_install_x])(name)); -} - -SEXP Rf_installChar(SEXP charsxp) { - return checkRef(((call_Rf_installChar) callbacks[Rf_installChar_x])(charsxp)); -} - -Rboolean Rf_isNull(SEXP s) { - return ((call_Rf_isNull) callbacks[Rf_isNull_x])(s); -} - -Rboolean Rf_isString(SEXP s) { - return ((call_Rf_isString) callbacks[Rf_isString_x])(s); -} - -Rboolean R_cycle_detected(SEXP s, SEXP child) { - unimplemented("R_cycle_detected"); - return FALSE; -} - -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 ((call_Rf_ncols) callbacks[Rf_ncols_x])(x); -} - -int Rf_nrows(SEXP x) { - return ((call_Rf_nrows) callbacks[Rf_nrows_x])(x); -} - - -SEXP Rf_protect(SEXP x) { - return x; -} - -void Rf_unprotect(int x) { -} - -void R_ProtectWithIndex(SEXP x, PROTECT_INDEX *y) { - // -} - -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 checkRef(((call_R_NewHashedEnv) callbacks[R_NewHashedEnv_x])(parent, size)); -} - -SEXP Rf_classgets(SEXP vec, SEXP klass) { - return checkRef(((call_Rf_classgets) callbacks[Rf_classgets_x])(vec, klass)); -} - -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 checkRef(((call_Rf_lengthgets) callbacks[Rf_lengthgets_x])(x, y)); -} - -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 checkRef(((call_R_lsInternal3) callbacks[R_lsInternal3_x])(env, all, sorted)); -} - -SEXP Rf_namesgets(SEXP x, SEXP y) { - return unimplemented("Rf_namesgets"); -} - -SEXP TAG(SEXP e) { - return checkRef(((call_TAG) callbacks[TAG_x])(e)); -} - -SEXP PRINTNAME(SEXP e) { - return checkRef(((call_PRINTNAME) callbacks[PRINTNAME_x])(e)); -} - - -SEXP CAAR(SEXP e) { - unimplemented("CAAR"); - return NULL; -} - -SEXP CDAR(SEXP e) { - unimplemented("CDAR"); - return NULL; -} - -SEXP CADR(SEXP e) { - return checkRef(((call_CADR) callbacks[CADR_x])(e)); -} - -SEXP CDDR(SEXP e) { - return checkRef(((call_CDDR) callbacks[CDDR_x])(e)); -} - -SEXP CDDDR(SEXP e) { - unimplemented("CDDDR"); - return NULL; -} - -SEXP CADDR(SEXP e) { - return checkRef(((call_CADDR) callbacks[CADDR_x])(e)); -} - -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 checkRef(((call_SETCAR) callbacks[SETCAR_x])(x, y)); -} - -SEXP SETCDR(SEXP x, SEXP y) { - return checkRef(((call_SETCDR) callbacks[SETCDR_x])(x, y)); -} - -SEXP SETCADR(SEXP x, SEXP y) { - return checkRef(((call_SETCADR) callbacks[SETCADR_x])(x, y)); -} - -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) { - return ((call_RDEBUG) callbacks[RDEBUG_x])(x); -} - -int RSTEP(SEXP x) { - return ((call_RSTEP) callbacks[RSTEP_x])(x); -} - -int RTRACE(SEXP x) { - unimplemented("RTRACE"); - return 0; -} - -void SET_RDEBUG(SEXP x, int v) { - ((call_SET_RDEBUG) callbacks[SET_RDEBUG_x])(x, v); -} - -void SET_RSTEP(SEXP x, int v) { - ((call_SET_RSTEP) callbacks[SET_RSTEP_x])(x, v); -} - -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 checkRef(((call_SYMVALUE) callbacks[SYMVALUE_x])(x)); -} - -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) { - ((call_SET_SYMVALUE) callbacks[SET_SYMVALUE_x])(x, v); -} - -void SET_INTERNAL(SEXP x, SEXP v) { - unimplemented("SET_INTERNAL"); -} - -SEXP FRAME(SEXP x) { - return unimplemented("FRAME"); -} - -SEXP ENCLOS(SEXP x) { - return checkRef(((call_ENCLOS) callbacks[ENCLOS_x])(x)); -} - -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 checkRef(((call_PRCODE) callbacks[PRCODE_x])(x)); -} - -SEXP PRENV(SEXP x) { - return checkRef(((call_PRENV) callbacks[PRENV_x])(x)); -} - -SEXP PRVALUE(SEXP x) { - return checkRef(((call_PRVALUE) callbacks[PRVALUE_x])(x)); -} - -int PRSEEN(SEXP x) { - return ((call_PRSEEN) callbacks[PRSEEN_x])(x); -} - -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 checkRef(((call_STRING_ELT) callbacks[STRING_ELT_x])(x, i)); -} - - -SEXP VECTOR_ELT(SEXP x, R_xlen_t i){ - return checkRef(((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 checkRef(((call_SET_VECTOR_ELT) callbacks[SET_VECTOR_ELT_x])(x, i, v)); -} - -SEXP *STRING_PTR(SEXP x){ - unimplemented("STRING_PTR"); - return NULL; -} - - -SEXP * NORET VECTOR_PTR(SEXP x){ - unimplemented("VECTOR_PTR"); -} - -SEXP Rf_asChar(SEXP x){ - return checkRef(((call_Rf_asChar) callbacks[Rf_asChar_x])(x)); -} - -SEXP Rf_PairToVectorList(SEXP x){ - return checkRef(((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) { - return ((call_Rf_asReal) callbacks[Rf_asReal_x])(x); -} - -Rcomplex Rf_asComplex(SEXP x){ - unimplemented("Rf_asComplex"); - Rcomplex c; - return c; -} - -int TYPEOF(SEXP x) { - return ((call_TYPEOF) callbacks[TYPEOF_x])(x); -} - -SEXP ATTRIB(SEXP x){ - unimplemented("ATTRIB"); - return NULL; -} - -int OBJECT(SEXP x){ - return ((call_OBJECT) callbacks[OBJECT_x])(x); -} - -int MARK(SEXP x){ - unimplemented("MARK"); - return 0; -} - -int NAMED(SEXP x){ - return ((call_NAMED) callbacks[NAMED_x])(x); -} - -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){ - return checkRef(((call_SET_TYPEOF_FASTR) callbacks[SET_TYPEOF_FASTR_x])(x, 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){ - ((call_DUPLICATE_ATTRIB) callbacks[DUPLICATE_ATTRIB_x])(to, from); -} - -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) { - unimplemented("R_BadLongVector"); - return 0; -} - -int IS_S4_OBJECT(SEXP x) { - return ((call_IS_S4_OBJECT) callbacks[IS_S4_OBJECT_x])(x); -} - -void SET_S4_OBJECT(SEXP x) { - ((call_SET_S4_OBJECT) callbacks[SET_S4_OBJECT_x])(x); -} - -void UNSET_S4_OBJECT(SEXP x) { - ((call_UNSET_S4_OBJECT) callbacks[UNSET_S4_OBJECT_x])(x); -} - -Rboolean R_ToplevelExec(void (*fun)(void *), void *data) { - unimplemented("R_ToplevelExec"); - return FALSE; -} - -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) { - unimplemented("R_IsNamespaceEnv"); - return FALSE; -} - -SEXP R_FindNamespace(SEXP info) { - return checkRef(((call_R_FindNamespace) callbacks[R_FindNamespace_x])(info)); -} - -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 ((call_R_BindingIsLocked) callbacks[R_BindingIsLocked_x])(sym, env); -} - -Rboolean R_BindingIsActive(SEXP sym, SEXP env) { - // TODO: for now, I believe all bindings are false - return FALSE; -} - -Rboolean R_HasFancyBindings(SEXP rho) { - unimplemented("R_HasFancyBindings"); - return FALSE; -} - -Rboolean Rf_isS4(SEXP x) { - return IS_S4_OBJECT(x); -} - -SEXP Rf_asS4(SEXP x, Rboolean b, int i) { - unimplemented("Rf_asS4"); - return NULL; -} - -static SEXP R_tryEvalInternal(SEXP x, SEXP y, int *ErrorOccurred, int silent) { - unimplemented("R_tryEvalInternal"); - return NULL; -} - -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 checkRef(((call_R_PromiseExpr) callbacks[R_PromiseExpr_x])(x)); -} - -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 checkRef(((call_R_MakeExternalPtr) callbacks[R_MakeExternalPtr_x])(p, tag, prot)); -} - -void *R_ExternalPtrAddr(SEXP s) { - return ((call_R_ExternalPtrAddr) callbacks[R_ExternalPtrAddr_x])(s); -} - -SEXP R_ExternalPtrTag(SEXP s) { - return checkRef(((call_R_ExternalPtrTag) callbacks[R_ExternalPtrTag_x])(s)); -} - -SEXP R_ExternalPtrProtected(SEXP s) { - return checkRef(((call_R_ExternalPtrProtected) callbacks[R_ExternalPtrProtected_x])(s)); -} - -void R_SetExternalPtrAddr(SEXP s, void *p) { - ((call_R_SetExternalPtrProtected) callbacks[R_SetExternalPtrProtected_x])(s, p); -} - -void R_SetExternalPtrTag(SEXP s, SEXP tag) { - ((call_R_SetExternalPtrProtected) callbacks[R_SetExternalPtrProtected_x])(s, tag); -} - -void R_SetExternalPtrProtected(SEXP s, SEXP p) { - ((call_R_SetExternalPtrProtected) callbacks[R_SetExternalPtrProtected_x])(s, p); -} - -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"); - return NULL; -} - -SEXP R_MakeWeakRefC(SEXP key, SEXP val, R_CFinalizer_t fin, Rboolean onexit) { - unimplemented("R_MakeWeakRefC"); - return NULL; -} - -SEXP R_WeakRefKey(SEXP w) { - unimplemented("R_WeakRefKey"); - return NULL; -} - -SEXP R_WeakRefValue(SEXP w) { - unimplemented("R_WeakRefValue"); - return NULL; -} - -void R_RunWeakRefFinalizer(SEXP w) { - // TODO implement, but not fail for now -} - -SEXP R_do_slot(SEXP obj, SEXP name) { - return checkRef(((call_R_do_slot) callbacks[R_do_slot_x])(obj, name)); -} - -SEXP R_do_slot_assign(SEXP obj, SEXP name, SEXP value) { - return checkRef(((call_R_do_slot_assign) callbacks[R_do_slot_assign_x])(obj, name, value)); -} - -int R_has_slot(SEXP obj, SEXP name) { - unimplemented("R_has_slot"); - return 0; -} - -SEXP R_do_MAKE_CLASS(const char *what) { - return checkRef(((call_R_do_MAKE_CLASS) callbacks[R_do_MAKE_CLASS_x])(what)); -} - -SEXP R_getClassDef (const char *what) { - return unimplemented("R_getClassDef"); -} - -SEXP R_do_new_object(SEXP class_def) { - return checkRef(((call_R_do_new_object) callbacks[R_do_new_object_x])(class_def)); -} - -static SEXP nfiGetMethodsNamespace() { - return checkRef(((call_R_MethodsNamespace) callbacks[R_MethodsNamespace_x])()); -} - -int R_check_class_etc (SEXP x, const char **valid) { - return R_check_class_etc_helper(x, valid, nfiGetMethodsNamespace); -} - -SEXP R_PreserveObject_FASTR(SEXP x) { - TruffleEnv* env = (*truffleContext)->getTruffleEnv(truffleContext); - return (*env)->newObjectRef(env, x); -} - -void R_ReleaseObject(SEXP x) { - TruffleEnv* env = (*truffleContext)->getTruffleEnv(truffleContext); - (*env)->releaseObjectRef(env, x); -} - -void R_dot_Last(void) { - unimplemented("R_dot_Last"); -} - - -Rboolean R_compute_identical(SEXP x, SEXP y, int flags) { - return ((call_R_compute_identical) callbacks[R_compute_identical_x])(x, y, flags); -} - -void Rf_copyListMatrix(SEXP s, SEXP t, Rboolean byrow) { - ((call_Rf_copyListMatrix) callbacks[Rf_copyListMatrix_x])(s, t, byrow); -} - -void Rf_copyMatrix(SEXP s, SEXP t, Rboolean byrow) { - ((call_Rf_copyMatrix) callbacks[Rf_copyMatrix_x])(s, t, byrow); -} - diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/base_rffi.c b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/base_rffi.c index 28031bee77..8d35f6e2cd 100644 --- a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/base_rffi.c +++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/base_rffi.c @@ -28,44 +28,6 @@ #include <glob.h> #include <sys/utsname.h> #include <errno.h> +#include <rffiutils.h> - -void call_base_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_base_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_base_readlink(void (*call_setresult)(char *link, int cerrno), 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_base_strtol(void (*call_setresult)(long result, int cerrno), char *s, int base) { - long rc = strtol(s, NULL, base); - call_setresult(rc, errno); -} +#include "../truffle_common/base_rffi.h" 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 index e577761080..0a4acc6f2d 100644 --- 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 @@ -9,56 +9,5 @@ * * 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_pcre_compile(void *closure, char *pattern, int options, long tables) { - void (*makeresult)(long result, char *errMsg, int errOffset) = closure; - char *errorMessage; - int errOffset; - void *pcre_result = pcre_compile(pattern, options, &errorMessage, &errOffset, (char*) tables); - makeresult((long) pcre_result, errorMessage, errOffset); -} - -int call_pcre_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_pcre_getcapturenames(void *closure, long code, long extra) { - void (*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; - setcapturename(captureNum, entry + 2); - } - return res; -} +#include "../truffle_common/pcre_rffi.h" diff --git a/com.oracle.truffle.r.native/library/tools/src/truffle_llvm/gramRd_llvm.c b/com.oracle.truffle.r.native/library/tools/src/truffle_llvm/gramRd_llvm.c index 92eb70fb0d..a6c7bdc2f8 100644 --- a/com.oracle.truffle.r.native/library/tools/src/truffle_llvm/gramRd_llvm.c +++ b/com.oracle.truffle.r.native/library/tools/src/truffle_llvm/gramRd_llvm.c @@ -23,9 +23,15 @@ #include "../gramRd_fastr.h" #include <truffle.h> -#define IMPORT_TOOLS() void *obj = truffle_import_cached("_fastr_rffi_tools") +typedef int (*call_getc)(void *conn); + +static void **gramRd_callbacks = NULL; + +void gramRd_addCallback(void *callback) { + gramRd_callbacks = truffle_managed_malloc(1 * sizeof(void*)); + gramRd_callbacks[0] = callback; +} int callGetCMethod(void *conn) { - IMPORT_TOOLS(); - return (int) truffle_invoke(obj, "getC", conn); + return ((call_getc) gramRd_callbacks[0])(conn); } diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RError.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RError.java index 983421fd3a..9311149b78 100644 --- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RError.java +++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RError.java @@ -445,6 +445,7 @@ public final class RError extends RuntimeException implements TruffleException { LIST_NAMES_SAME_LENGTH("names(x) must be a character vector of the same length as x"), DIMS_CONTAIN_NEGATIVE_VALUES("the dims contain negative values"), NEGATIVE_LENGTH_VECTORS_NOT_ALLOWED("negative length vectors are not allowed"), + LONG_VECTORS_NOT_SUPPORTED("long length vectors are not suppoted"), FIRST_ARG_MUST_BE_ARRAY("invalid first argument, must be an array"), IMAGINARY_PARTS_DISCARDED_IN_COERCION("imaginary parts discarded in coercion"), DIMS_CONTAIN_NA("the dims contain missing values"), 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 37031964a3..a0e0619811 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 @@ -25,6 +25,7 @@ import com.oracle.truffle.api.nodes.Node; import com.oracle.truffle.api.nodes.RootNode; import com.oracle.truffle.api.source.SourceSection; import com.oracle.truffle.r.runtime.RError; +import com.oracle.truffle.r.runtime.RError.Message; import com.oracle.truffle.r.runtime.RError.RErrorException; import com.oracle.truffle.r.runtime.RInternalError; import com.oracle.truffle.r.runtime.RRuntime; @@ -751,4 +752,14 @@ public class DLL { return result; } + public static DLLInfo safeFindLibrary(String pkgName) { + DLLInfo lib = DLL.findLibrary(pkgName); + if (lib == null) { + // It seems GNU R would create an C entry even for non-existing package, we are more + // defensive + throw RError.error(RError.NO_CALLER, Message.DLL_NOT_LOADED, pkgName); + } + return lib; + } + } 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 4ff1f85c48..40f8018024 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 @@ -38,7 +38,7 @@ import com.oracle.truffle.r.runtime.context.RContext.ContextState; * point. */ public abstract class RFFIFactory { - private enum Factory { + public enum Type { JNI("com.oracle.truffle.r.ffi.impl.jni.JNI_RFFIFactory"), LLVM("com.oracle.truffle.r.ffi.impl.llvm.TruffleLLVM_RFFIFactory"), MANAGED("com.oracle.truffle.r.ffi.impl.managed.Managed_RFFIFactory"), @@ -46,15 +46,14 @@ public abstract class RFFIFactory { private final String klassName; - Factory(String klassName) { + Type(String klassName) { this.klassName = klassName; } } - 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_TYPE_PROPERTY = "fastr.rffi.factory.type"; private static final String FACTORY_CLASS_ENV = "FASTR_RFFI"; - private static final Factory DEFAULT_FACTORY = Factory.JNI; + private static final Type DEFAULT_FACTORY = Type.JNI; /** * Singleton instance of the factory. @@ -62,10 +61,12 @@ public abstract class RFFIFactory { private static RFFIFactory instance; @CompilationFinal protected static RFFI theRFFI; + @CompilationFinal private static Type type; static { if (instance == null) { - String klassName = getFactoryClassName(); + type = getFactoryType(); + String klassName = type.klassName; try { instance = (RFFIFactory) Class.forName(klassName).newInstance(); theRFFI = instance.createRFFI(); @@ -75,12 +76,8 @@ public abstract class RFFIFactory { } } - private static String getFactoryClassName() { - String prop = System.getProperty(FACTORY_CLASS_PROPERTY); - if (prop != null) { - return prop; - } - prop = System.getProperty(FACTORY_CLASS_NAME_PROPERTY); + private static Type getFactoryType() { + String prop = System.getProperty(FACTORY_TYPE_PROPERTY); if (prop != null) { return checkFactoryName(prop); } @@ -89,15 +86,15 @@ public abstract class RFFIFactory { return checkFactoryName(prop); } if (FastRConfig.ManagedMode) { - return Factory.MANAGED.klassName; + return Type.MANAGED; } - return DEFAULT_FACTORY.klassName; + return DEFAULT_FACTORY; } - private static String checkFactoryName(String prop) { + private static Type checkFactoryName(String prop) { try { - Factory factory = Factory.valueOf(prop.toUpperCase()); - return factory.klassName; + Type factory = Type.valueOf(prop.toUpperCase()); + return factory; } catch (IllegalArgumentException ex) { throw Utils.rSuicide("No RFFI factory: " + prop); } @@ -114,6 +111,10 @@ public abstract class RFFIFactory { return theRFFI; } + public static Type getType() { + return type; + } + /** * Subclass implements this method to actually create the concrete {@link RFFI} instance. */ diff --git a/com.oracle.truffle.r.test.native/urand/Makefile b/com.oracle.truffle.r.test.native/urand/Makefile index f2693f4482..0b933a804a 100644 --- a/com.oracle.truffle.r.test.native/urand/Makefile +++ b/com.oracle.truffle.r.test.native/urand/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 diff --git a/documentation/dev/truffle_llvm_ffi.md b/documentation/dev/truffle_llvm_ffi.md index 469f313bff..59e06668ff 100644 --- a/documentation/dev/truffle_llvm_ffi.md +++ b/documentation/dev/truffle_llvm_ffi.md @@ -20,13 +20,6 @@ The above definitions assume a MacPorts installation. On Linux, the installation is system dependent, but once installed, set the same environment variables. -Both GNU R and FastR native code must be compiled to generate LLVM code. This is handled by special "wrapper" compiler scripts that encapsulate the required steps. -To ensure that the wrapper compiler scripts are used in the GNU R build set: - - export FASTR_RFFI=llvm - -If you have an existing build, you must unset any definition of `GNUR_NOCLEAN` then run `mx build -c`. The wrapper scripts add quite a bit of overhead to the build process, particularly the GNU R configure step, but fortunately this only has to be done once. - ## Building Sulong The `sulong` repository must be cloned to a sibling directory of `fastr` and built: @@ -35,7 +28,12 @@ The `sulong` repository must be cloned to a sibling directory of `fastr` and bui cd sulong mx su-pulldragonegg -The `mx su-pulldragonegg` step is required to be able to compile Fortran code to LLVM, which is required by FastR.. As well as downloading DragonEgg this will also download and clang 3.2, which is needed to build DragonEgg. On Linux, it is necessary to use clang 3.2 in preference to any installed clang, e.g., 3.8, as some of the LLVM code generated by DragonEgg is syntax-incompatible with 3.8. The downloaded version is saved in `cache/tools/llvm/bin` and this (absolute) path should be added to `PATH`. +The `mx su-pulldragonegg` step is required to be able to compile Fortran code to LLVM, which is required by FastR.. As well as downloading DragonEgg this will also download and clang 3.2, which is needed to build DragonEgg. On Linux, it is necessary to use clang 3.2 in preference to any installed clang, e.g., 3.8, as some of the LLVM code generated by DragonEgg is syntax-incompatible with 3.8. The downloaded version is saved in `cache/tools/llvm/bin`. + +Sulong must be built with a more recent version of `clang` than 3.2, which means that `sulong` and `fastr` cannot be built in one step. +First make sure that you have a supported version of `clang` and related tools installed, e.g., 3.8 and that they are on your `PATH`. Also if you are on MacOS and are using MacPorts, you must make symbolic links to the explicitly versioned tool names, i.e. `clang` -> `clang-mp-3.8`. This also applies to the `opt` and `llvm-link` tools. You can set these links directly in `/opt/local/bin` using `sudo` or create a local `bin` directory and place the links there, making sure that this directory is on your `PATH`. + + and this (absolute) path should be added to `PATH`. Now the remainder of sulong can be built. @@ -45,8 +43,7 @@ The `mx build` step will clone the `graal` repository, if necessary, and build t ## Building FastR -Both GNU R and FastR native code must be compiled to generate LLVM code. This is handled by special "wrapper" compiler scripts that encapsulate the required steps. -To ensure that the `llvm` variant of the native build is generated, set: +To ensure that an LLVM build variant is chosen, set: export FASTR_RFFI=llvm @@ -58,6 +55,8 @@ On Mac OS (with MacPorts) set: export PKG_LDFLAGS_OVERRIDE="-L/opt/local/lib -L/opt/local/lib/libgcc" +Now, ensure that `clang-3.2` is first on your `PATH` by adding the absolute path of `sulong/cache/tools/llvm/bin`. + Then run `mx build`. ## Running @@ -72,11 +71,7 @@ Note that if the `LLVM_PARSE_TIME` environment variable is set to any value, the The compiler wrapper scripts are simple shell scripts that first test for the existence of the `sulong` sibling directory and, if it exists and the environment variable `FASTR_SULONG_IGNORE` is not set, invoke associated `mx` commands to perform the compilation. Otherwise, the standard compiler is used. The scripts are stored in the `compilers` sub-directory of `mx.fastr` and are named: `fastr-cc`, `fastr-fc`, `fastr-c++` and `fastr-cpp`. The associated `mx` commands are in `mx.fastr/mx_fastr_compilers.py`. -In order to support both LLVM and non-LLVM execution (no longer actually necessary), each native source file is compiled twice, once to generate native machine code and once to generate LLVM IR. The LLVM IR is actually stored in the object file and extracted at runtime. This avoids having to disrupt the normal R package build process by allowing it to be completely unaware of the existence of LLVM. - Currently, for convenience, the Python wrappers invoke code in the Sulong `sulong/mx.sulong` directory. Eventually, they will modified to be independent of Sulong. ## Limitations At the time of writing all the `RFFI` interfaces are implemented for LLVM. However, owing to a bug in DragonEgg, the actual Fortran code for the Lapack library is not executed under LLVM, only the wrapper. - -Also, not all callbacks are implemented at this time, just those necessary to run a basic system. diff --git a/mx.fastr/mx_fastr_compile.py b/mx.fastr/mx_fastr_compile.py index 304ebb6c12..11cc17e123 100644 --- a/mx.fastr/mx_fastr_compile.py +++ b/mx.fastr/mx_fastr_compile.py @@ -215,7 +215,7 @@ def _create_bc_lib(args): bcfiles = [] while i < len(args): arg = args[i] - if arg == '-o' : + if arg == '-o': # library file i = i + 1 lib = args[i] -- GitLab