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 0000000000000000000000000000000000000000..b1147fa64c28605f1a444964b7ddab5e766d7047 --- /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 3b073fef2479aba79cd53d1cd8488ae2c42ac0b6..f1fd7172b7038e094154ef986cb38c00fba33d2e 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 0000000000000000000000000000000000000000..4323e860a10b7062c47df0715df2ae4f5cb1ef9a --- /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 b779d8c54ec5ac1ad886c7db22786a6a88403076..ad14f4a82702438cd4a68abc49ddce82f45d35b1 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 0000000000000000000000000000000000000000..cd5f09b377bd0ad27893d3cc4b6e8be449cbb8b1 --- /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 cf8b79b9db63759210516d6fc1e8f94cd4c18ae3..1f40f124ddcf7bf9c6be3f6c5140df4250381a1f 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 f36a55442fa22959e8f58c85641bccce57fe00eb..59af7efb20e6dd2ae3990d0e90aa4c04442be195 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 7ca8fbd422201fc3ac965f8f6d78f9ef7684d6e9..7f427019eb26d27068ca1a3fd09c61e6f2871d56 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 4ef12020e481470339dc91cc7a952eb94632f5f2..49c62b47ce81e8fa1de6e555423e369f0b4187b6 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 6462f2ef7a63c45db9311e3f1877155ad4c9b729..3b3f9151830d370f9d55d5bd33e7b9e57373302f 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 f519b18f39d55e401b1a687ef0b1454af342924d..1c98d1a352c6fe1beb2d0e5b43ec23dabd1fe31b 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 0000000000000000000000000000000000000000..77f22ce84c013c4aca2796a53a51e76a67484b03 --- /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 0000000000000000000000000000000000000000..7212138fcedb0eaf6ae960e9e374208cf4727168 --- /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 0000000000000000000000000000000000000000..6f1b3ead662ce4237dd7848bf29a55160fac4dbd --- /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 0000000000000000000000000000000000000000..d31cacbb09c24cd1679d7fa1934a15d69d9e66f1 --- /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 0000000000000000000000000000000000000000..f134aba9ff7d37a93995c163799f2b3bb7ad2556 --- /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 0000000000000000000000000000000000000000..21f8a5190d722fb13d15ea5880dedffc0b2ccc74 --- /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 0000000000000000000000000000000000000000..ed1d46ebcaafe3fcd11b4a5e4cd3f326733eec11 --- /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 0000000000000000000000000000000000000000..eafa6ed4d05a4648422fc0b635d552fd2d93df96 --- /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 0000000000000000000000000000000000000000..d4bc6da189452805cb6d5fe8710a3341214a48da --- /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 0000000000000000000000000000000000000000..52ee4ed3f1de573fd2f43bf798b4c1e4234bd844 --- /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 0000000000000000000000000000000000000000..62ac7845a80a54e58faeea4078649e7314acc585 --- /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 0000000000000000000000000000000000000000..91a932bc150c2d70d8e3abede3a69aeadcf7d6ae --- /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 f35a117c295db7231cd3535107b89242b2db3578..400666d46e0d78f6bd93ec7ee4ccce588f56da67 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 a6ac342d2ef50c8ca65801382a8cac7d23c49e30..c111372360bfe01d73d9a439191bb05afb327e31 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 c9590c3f7f41eb9a40365b7fe9670b19351ab2ac..692d85abf04ec3aca5f71cd3bc0bccf64771ea58 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 ccc435dc740af801b2ea3b1fdf67c62ba211b70b..d1e460a9f2ae75b9a11735307fcc315876f6c7c2 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 d6540d4bde64900352728b9dfcf79c7b99948b98..09325319cdc0d166a72af9ea5742c42b0e1612a9 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 def16936dfb8c0a736d639d4173e6a7d64ae3965..ed5d2e6941064bfd544e33cd7e5d26a6e3afcfd7 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 f04af0d81f250596660328422bc38530d32c896d..bf236d54ecb11df54bbae0c514d70816594e093f 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 9ec5f57cff46bcd2083dd8562d3476ca674fad7e..7570499af7ccb59520e9836cac45644617d23bac 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 542c5f35f7ee1ba7b03a51c949a5eb86a6910709..d081ee47a7b61ab6997236e03e20a3b3e9e63595 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 9c80821300a825fcd4269a95e0e5aea8aa1b0630..84767ed9979d15a3684dd19dbbcac9ab167d7734 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 47ea412fb2099920a2ffac43cc27596a0138ed42..600f8ea846b0bcfd0c959f07e718c53c17056505 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 0000000000000000000000000000000000000000..7d3f1dc3affcb5a671b05db378cc039e14b93d86 --- /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 0000000000000000000000000000000000000000..904cd490ac8a1132c4ebade67b1bb0016d420984 --- /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 0000000000000000000000000000000000000000..8a58ca5b13eca874eb109a04b9dc0c7f72a47d51 --- /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 0000000000000000000000000000000000000000..1dbd60e2288921f9a44e6b16d0f4ca581f8cdca0 --- /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 f908c5e466099af00d907d783b9e2f4aa4e1679c..837a2ad3c8a1e3263ac68aa998550d565a1405ee 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 0333bad16dcc6980403a4b6ef0dc5f4191eb6a56..f8f5833168caf02990e447161f195c845dce7dc7 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 49014be6befa6e4878f9f0681d4e518ca898857d..edb3a9d21ddb2c348ba17dd971987785c9a33699 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 a4623218d73a45941398777933459fb8fa86935f..b7614ecb6d359bcfe478b85748375f9bfa0d0dd7 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 2a61a6187e3da3564207f0a0624bc813e1996a09..ac09cf124f3b7d650c040d45e265d90054c49b43 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 710affdd150797f463f9098c7b5322de2b0715bd..7442f990c2c3da3616a8b77ca4d3b6d439fac8b9 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 0000000000000000000000000000000000000000..b3a9701bffd8fe4c3ccf609f9e2008ba451a8209 --- /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 0000000000000000000000000000000000000000..6f13622b658160c54d1c493cb78bb1c8e15c4004 --- /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 0000000000000000000000000000000000000000..72cd777fbce41e2be9027ef5dbd82e174b6cec16 --- /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 0000000000000000000000000000000000000000..0b20885465dd5f22ce35bd777247b17662c5cb95 --- /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 0c6228ce710c0dd912b4b9b9666a7cd6c528509a..3077166a29809953e1927d64f6e8198da6d4fcb8 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 5898757681b0d2fce70c0ae8b228210c281684a8..19dc2dca73536e16273a0163a318e1c7ceae20da 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 6d04555401fa4b32eb746bb7ac6ebc545d0825ca..8d45b717ff440a384b5b5ae27002749f81be0a19 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 0100364162b471950bbd7958f9e73f71bd0fdcf0..78d7aaddeb3aaf57610a063c3ba8b63421de25e3 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 04fec88d23a262b92a74eed6ae79ec706a87bfdb..d37ff6d11559458bfa9b8397d115107dfb61d79e 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 5307bdc7a4c9f69e76050657eb81a150fa1eae20..170bfeaeeb0ecb4f05934bc5cb23db41cf0f5213 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 ebfce9ea30447a143587285556928f6a5dafb20e..99ead1d2b3fdb76f26b71295679a6b1d44e4430d 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 fdc0facaf054aa7ae39035790d0389936ccbf1a5..5306705e335e4a94b1e9c23bf016f0518a3a20a0 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 7972251ef050a7b0245fbbb9adb929cfe4553d17..5ae5023e69f867c84e68d9d1a47ed165152692b1 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 213970738137f75ae194598f02b786441262ce32..9fae57fc9828333929d2def93eb2a1c343956fbd 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 05e517b2013d5bdf3b8fa38f283eac167cf8381b..b21117fe72e9bea97f1aee0c231049480b48e355 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 28031bee77c13b4db3e3bf5c9e01e0b3e36e662e..8d35f6e2cd65e1a86a51f9de166be2826e2fda31 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 e57776108092a08d4e1720469561b5631de5147f..0a4acc6f2daa2d2c55d2097e64495ff4a538756a 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 92eb70fb0d55c357d5fe97e7a5fc251230b05ee0..a6c7bdc2f870cbf0869e0e2e28795d642697a920 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 983421fd3ae1dde3d2cd91a6cdc7bb731278090e..9311149b78f661ada3e36a033fb248298896b249 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 37031964a37ad06ce86e6ccf85ec0b34b7bb898f..a0e06198112092166d231e27ba70f0ebb5179ec2 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 4ff1f85c486fb6ad11e3bab8226bea1ff666f9b2..40f8018024f5f8b6f0484799ab582c0d038f3093 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 f2693f44823182cd5e1ef316f4840c63abdca467..0b933a804a7ff010bfb3c8db1b2ceefdcfd19756 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 469f313bff34e89ed8dcd75b7610dddb1797d902..59e06668ffdc48b9cafbef3984126d16f85d0ddf 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 304ebb6c129d89c17f19148be8f6f5b21ca5ea94..11cc17e1237b3ca740154544ac593446b41a3b95 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]