diff --git a/.gitignore b/.gitignore index 431b9e0bcedb9a1c51376555882b0f4da06fb54d..dd8ad6fc9f8427efea3cd9df3720d9a10af35050 100644 --- a/.gitignore +++ b/.gitignore @@ -127,5 +127,8 @@ test_gnur test_fastr lib.install.cran* package.blacklist +*.ll +*.su +*.bc com.oracle.truffle.r.test.native/embedded/lib bench-results.json diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeCharArray.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeCharArray.java new file mode 100644 index 0000000000000000000000000000000000000000..582860ac3d948d2448f6aa8427f61f3027b9467d --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeCharArray.java @@ -0,0 +1,37 @@ +/* + * Copyright (c) 2014, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop; + +import com.oracle.truffle.api.interop.TruffleObject; + +/** + * A {@link TruffleObject} that represents an array of {@code unsigned char} values, that is + * {@code NULL} terminated in the C domain. + */ +public class NativeCharArray extends NativeUInt8Array { + + public NativeCharArray(byte[] bytes) { + super(bytes, true); + } + +} diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeCharArrayMR.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeCharArrayMR.java new file mode 100644 index 0000000000000000000000000000000000000000..5e8e040221f1f747c101648f8d2ea91dc2143e50 --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeCharArrayMR.java @@ -0,0 +1,78 @@ +/* + * Copyright (c) 2014, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop; + +import com.oracle.truffle.api.interop.CanResolve; +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.nodes.Node; +import com.oracle.truffle.r.engine.TruffleRLanguage; + +@MessageResolution(receiverType = NativeCharArray.class, language = TruffleRLanguage.class) +public class NativeCharArrayMR { + @Resolve(message = "READ") + public abstract static class NCAReadNode extends Node { + protected byte access(NativeCharArray receiver, int index) { + return receiver.read(index); + } + } + + @Resolve(message = "WRITE") + public abstract static class NCAWriteNode extends Node { + protected Object access(NativeCharArray receiver, int index, byte value) { + receiver.write(index, value); + return value; + } + } + + @Resolve(message = "HAS_SIZE") + public abstract static class NCAHasSizeNode extends Node { + protected boolean access(@SuppressWarnings("unused") NativeCharArray receiver) { + return true; + } + } + + @Resolve(message = "GET_SIZE") + public abstract static class NCAGetSizeNode extends Node { + protected int access(NativeCharArray receiver) { + return receiver.getSize(); + } + } + + @Resolve(message = "UNBOX") + public abstract static class NCAUnboxNode extends Node { + protected long access(NativeCharArray receiver) { + return receiver.convertToNative(); + } + } + + @CanResolve + public abstract static class NCACheck extends Node { + + protected static boolean test(TruffleObject receiver) { + return receiver instanceof NativeCharArray; + } + } + +} diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeDoubleArray.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeDoubleArray.java new file mode 100644 index 0000000000000000000000000000000000000000..471fe62d1a061b11ee3879509c8ffa8fd7598b59 --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeDoubleArray.java @@ -0,0 +1,39 @@ +/* + * Copyright (c) 2016, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop; + +import com.oracle.truffle.r.runtime.data.RTruffleObject; + +public class NativeDoubleArray extends NativeNACheck implements RTruffleObject { + public final double[] value; + + public NativeDoubleArray(Object obj, double[] value) { + super(obj); + this.value = value; + } + + public NativeDoubleArray(double[] value) { + this(null, value); + } + +} diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeDoubleArrayMR.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeDoubleArrayMR.java new file mode 100644 index 0000000000000000000000000000000000000000..573bdb61008a581c770c3396df82334d5e87acbc --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeDoubleArrayMR.java @@ -0,0 +1,61 @@ +/* + * Copyright (c) 2016, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop; + +import com.oracle.truffle.api.interop.CanResolve; +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.nodes.Node; +import com.oracle.truffle.r.engine.TruffleRLanguage; +import com.oracle.truffle.r.runtime.RRuntime; + +@MessageResolution(receiverType = NativeDoubleArray.class, language = TruffleRLanguage.class) +public class NativeDoubleArrayMR { + + @Resolve(message = "READ") + public abstract static class NDAReadNode extends Node { + protected double access(NativeDoubleArray receiver, int index) { + return receiver.value[index]; + } + } + + @Resolve(message = "WRITE") + public abstract static class NDAWriteNode extends Node { + protected double access(NativeDoubleArray receiver, int index, double value) { + if (value == RRuntime.DOUBLE_NA) { + receiver.setIncomplete(); + } + receiver.value[index] = value; + return value; + } + } + + @CanResolve + public abstract static class NDACheck extends Node { + + protected static boolean test(TruffleObject receiver) { + return receiver instanceof NativeDoubleArray; + } + } +} diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeIntegerArray.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeIntegerArray.java new file mode 100644 index 0000000000000000000000000000000000000000..ee20f7db3ef49404a4408daef761af4e795fac82 --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeIntegerArray.java @@ -0,0 +1,39 @@ +/* + * Copyright (c) 2016, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop; + +import com.oracle.truffle.r.runtime.data.RTruffleObject; + +public class NativeIntegerArray extends NativeNACheck implements RTruffleObject { + public final int[] value; + + public NativeIntegerArray(Object obj, int[] value) { + super(obj); + this.value = value; + } + + public NativeIntegerArray(int[] value) { + this(null, value); + } + +} diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeIntegerArrayMR.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeIntegerArrayMR.java new file mode 100644 index 0000000000000000000000000000000000000000..70115e5f2dca80144eeb71fdee370b8ab1a8d545 --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeIntegerArrayMR.java @@ -0,0 +1,62 @@ +/* + * Copyright (c) 2016, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop; + +import com.oracle.truffle.api.interop.CanResolve; +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.nodes.Node; +import com.oracle.truffle.r.engine.TruffleRLanguage; +import com.oracle.truffle.r.runtime.RRuntime; + +@MessageResolution(receiverType = NativeIntegerArray.class, language = TruffleRLanguage.class) +public class NativeIntegerArrayMR { + + @Resolve(message = "READ") + public abstract static class NIAReadNode extends Node { + protected int access(NativeIntegerArray receiver, int index) { + return receiver.value[index]; + } + } + + @Resolve(message = "WRITE") + public abstract static class NIAWriteNode extends Node { + protected int access(NativeIntegerArray receiver, int index, int value) { + if (value == RRuntime.INT_NA) { + receiver.setIncomplete(); + } + receiver.value[index] = value; + return value; + } + } + + @CanResolve + public abstract static class NIACheck extends Node { + + protected static boolean test(TruffleObject receiver) { + return receiver instanceof NativeIntegerArray; + } + } + +} diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeLogicalArray.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeLogicalArray.java new file mode 100644 index 0000000000000000000000000000000000000000..bc1e41f398dbfcab2819e660432117dd6286b330 --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeLogicalArray.java @@ -0,0 +1,56 @@ +/* + * Copyright (c) 2014, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop; + +import com.oracle.truffle.api.CompilerDirectives.CompilationFinal; +import com.oracle.truffle.r.runtime.RRuntime; +import com.oracle.truffle.r.runtime.data.RTruffleObject; + +/** + * Handles the requirement that the R FFI sees "logical" arrays as {@code int[]} but the actual + * array in FastR is represented as {@code byte[]}. + */ +public class NativeLogicalArray extends NativeNACheck implements RTruffleObject { + @CompilationFinal public final byte[] data; + + public NativeLogicalArray(Object obj, byte[] value) { + super(obj); + this.data = value; + } + + int read(int index) { + return data[index] & 0xFF; + } + + void write(int index, int value) { + byte newVal; + if (value == RRuntime.INT_NA) { + newVal = RRuntime.LOGICAL_NA; + setIncomplete(); + } else { + newVal = (byte) (value & 0xFF); + } + data[index] = newVal; + } + +} diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeLogicalArrayMR.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeLogicalArrayMR.java new file mode 100644 index 0000000000000000000000000000000000000000..eb9d9bdae5988b38c75cd26dfba03e86c8d929ea --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeLogicalArrayMR.java @@ -0,0 +1,64 @@ +/* + * Copyright (c) 2014, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop; + +import com.oracle.truffle.api.interop.CanResolve; +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.nodes.Node; +import com.oracle.truffle.r.engine.TruffleRLanguage; + +@MessageResolution(receiverType = NativeLogicalArray.class, language = TruffleRLanguage.class) +public class NativeLogicalArrayMR { + @Resolve(message = "READ") + public abstract static class NLAReadNode extends Node { + protected int access(NativeLogicalArray receiver, int index) { + return receiver.read(index); + } + } + + @Resolve(message = "WRITE") + public abstract static class NLAWriteNode extends Node { + protected Object access(NativeLogicalArray receiver, int index, int value) { + receiver.write(index, value); + return value; + } + } + + @Resolve(message = "GET_SIZE") + public abstract static class NLAGetSizeNode extends Node { + protected int access(NativeLogicalArray receiver) { + return receiver.data.length; + } + } + + @CanResolve + public abstract static class NLACheck extends Node { + + protected static boolean test(TruffleObject receiver) { + return receiver instanceof NativeLogicalArray; + } + } + +} diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeNACheck.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeNACheck.java new file mode 100644 index 0000000000000000000000000000000000000000..2eaad54125ea328ba342e4635f02634daacb892d --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeNACheck.java @@ -0,0 +1,50 @@ +/* + * Copyright (c) 2014, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop; + +import com.oracle.truffle.r.runtime.data.RVector; + +/** + * Handles the {@code complete} flag in an {@link RVector} when an {@code NA} value is assigned in + * native code. + * + */ +public class NativeNACheck { + private final RVector<?> vec; + + protected NativeNACheck(Object x) { + if (x instanceof RVector<?>) { + vec = (RVector<?>) x; + } else { + // scalar (length 1) vector or no associated R object + vec = null; + } + } + + public void setIncomplete() { + if (vec != null) { + vec.setComplete(false); + } + } + +} diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeRawArray.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeRawArray.java new file mode 100644 index 0000000000000000000000000000000000000000..8e452be22a8d57901913b6eaf659381bacbcdc05 --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeRawArray.java @@ -0,0 +1,31 @@ +/* + * Copyright (c) 2016, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop; + +public class NativeRawArray extends NativeUInt8Array { + + public NativeRawArray(byte[] bytes) { + super(bytes, false); + } + +} diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeRawArrayMR.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeRawArrayMR.java new file mode 100644 index 0000000000000000000000000000000000000000..4aac34a0afab0c8aeaaba389b4cd3129992afaac --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeRawArrayMR.java @@ -0,0 +1,71 @@ +/* + * Copyright (c) 2016, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop; + +import com.oracle.truffle.api.interop.CanResolve; +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.nodes.Node; +import com.oracle.truffle.r.engine.TruffleRLanguage; + +@MessageResolution(receiverType = NativeRawArray.class, language = TruffleRLanguage.class) +public class NativeRawArrayMR { + @Resolve(message = "READ") + public abstract static class NRAReadNode extends Node { + protected byte access(NativeRawArray receiver, int index) { + return receiver.bytes[index]; + } + } + + @Resolve(message = "WRITE") + public abstract static class NRAWriteNode extends Node { + protected Object access(NativeRawArray receiver, int index, byte value) { + receiver.bytes[index] = value; + return value; + } + } + + @Resolve(message = "GET_SIZE") + public abstract static class NRAGetSizeNode extends Node { + protected int access(NativeRawArray receiver) { + return receiver.bytes.length; + } + } + + @Resolve(message = "UNBOX") + public abstract static class NRAUnboxNode extends Node { + protected long access(NativeRawArray receiver) { + return receiver.convertToNative(); + } + } + + @CanResolve + public abstract static class NRACheck extends Node { + + protected static boolean test(TruffleObject receiver) { + return receiver instanceof NativeRawArray; + } + } + +} diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeUInt8Array.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeUInt8Array.java new file mode 100644 index 0000000000000000000000000000000000000000..2c8eddabdc7e5a8212846d2759478af031e96b8a --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/NativeUInt8Array.java @@ -0,0 +1,118 @@ +/* + * Copyright (c) 2016, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop; + +import static com.oracle.truffle.r.engine.interop.UnsafeAdapter.UNSAFE; + +import com.oracle.truffle.api.CompilerDirectives; +import com.oracle.truffle.api.CompilerDirectives.CompilationFinal; +import com.oracle.truffle.r.runtime.data.RTruffleObject; + +import sun.misc.Unsafe; + +/** + * Parent class of {@link NativeRawArray} and {@link NativeCharArray}, that holds the common logic + * for a C type {@code uint8*}, that may or may not be {@code NULL} terminated (in the C domain), + * and may escape into the native domain via an UNBOX message. + * + * N.B. Java never stores a {@code NULL} value in a String or the byte array from + * {@link String#getBytes}. + * + * If {@link #fakeNull()} is {@code true}, then {@link #read} returns 0, else it is an error; + * similar for {@link #write}. + */ +public abstract class NativeUInt8Array implements RTruffleObject { + public final byte[] bytes; + + /** + * If the array escapes the Truffle world via {@link #convertToNative()}, this value will be + * non-zero and is used exclusively thereafter. + */ + @CompilationFinal protected long nativeAddress; + private final int effectiveLength; + + protected NativeUInt8Array(byte[] bytes, boolean nullTerminate) { + this.bytes = bytes; + this.effectiveLength = bytes.length + (nullTerminate ? 1 : 0); + } + + private boolean fakeNull() { + return bytes.length != effectiveLength; + } + + private void checkNativeIndex(int index) { + if (index < 0 || index >= effectiveLength) { + throw new ArrayIndexOutOfBoundsException(index); + } + } + + void write(int index, byte value) { + if (nativeAddress != 0) { + checkNativeIndex(index); + UNSAFE.putByte(nativeAddress + index, value); + } else { + if (index == bytes.length && fakeNull()) { + // ignore + } else { + bytes[index] = value; + } + } + } + + byte read(int index) { + if (nativeAddress != 0) { + checkNativeIndex(index); + return UNSAFE.getByte(nativeAddress + index); + } else { + if (index == bytes.length && fakeNull()) { + return (byte) 0; + } + return bytes[index]; + } + } + + int getSize() { + return bytes.length; + } + + long convertToNative() { + if (nativeAddress == 0) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + nativeAddress = UNSAFE.allocateMemory(effectiveLength); + UNSAFE.copyMemory(bytes, Unsafe.ARRAY_BYTE_BASE_OFFSET, null, nativeAddress, bytes.length); + if (fakeNull()) { + UNSAFE.putByte(nativeAddress + bytes.length, (byte) 0); + } + } + return nativeAddress; + } + + public byte[] getBytes() { + if (nativeAddress != 0) { + // copy back + UNSAFE.copyMemory(null, nativeAddress, bytes, Unsafe.ARRAY_BYTE_BASE_OFFSET, bytes.length); + } + return bytes; + } + +} diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/RDoubleMR.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/RDoubleMR.java new file mode 100644 index 0000000000000000000000000000000000000000..2cacef289c49c07e09543f6894cc1fdf69a4b125 --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/RDoubleMR.java @@ -0,0 +1,71 @@ +/* + * Copyright (c) 2016, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop; + +import com.oracle.truffle.api.interop.CanResolve; +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.nodes.Node; +import com.oracle.truffle.r.engine.TruffleRLanguage; +import com.oracle.truffle.r.runtime.data.RDouble; + +@MessageResolution(receiverType = RDouble.class, language = TruffleRLanguage.class) +public class RDoubleMR { + @Resolve(message = "IS_BOXED") + public abstract static class RDoubleIsBoxedNode extends Node { + protected Object access(@SuppressWarnings("unused") RDouble receiver) { + return true; + } + } + + @Resolve(message = "HAS_SIZE") + public abstract static class RDoubleHasSizeNode extends Node { + protected Object access(@SuppressWarnings("unused") RDouble receiver) { + return false; + } + } + + @Resolve(message = "IS_NULL") + public abstract static class RDoubleIsNullNode extends Node { + protected Object access(@SuppressWarnings("unused") RDouble receiver) { + return false; + } + } + + @Resolve(message = "UNBOX") + public abstract static class RDoubleUnboxNode extends Node { + protected double access(RDouble receiver) { + return receiver.getValue(); + } + } + + @CanResolve + public abstract static class RDoubleCheck extends Node { + + protected static boolean test(TruffleObject receiver) { + return receiver instanceof RDouble; + } + } + +} diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/RForeignAccessFactoryImpl.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/RForeignAccessFactoryImpl.java index 4e2a81101dde3a94799a5219af80a090d17c33e3..d2ada23dadab7250f52af9b9799169c49efb32f7 100644 --- a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/RForeignAccessFactoryImpl.java +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/RForeignAccessFactoryImpl.java @@ -38,12 +38,14 @@ import com.oracle.truffle.r.runtime.context.RContext; import com.oracle.truffle.r.runtime.context.RForeignAccessFactory; import com.oracle.truffle.r.runtime.data.RComplex; import com.oracle.truffle.r.runtime.data.RComplexVector; +import com.oracle.truffle.r.runtime.data.RDouble; import com.oracle.truffle.r.runtime.data.RDoubleSequence; import com.oracle.truffle.r.runtime.data.RDoubleVector; import com.oracle.truffle.r.runtime.data.RExternalPtr; import com.oracle.truffle.r.runtime.data.RFunction; import com.oracle.truffle.r.runtime.data.RIntSequence; import com.oracle.truffle.r.runtime.data.RIntVector; +import com.oracle.truffle.r.runtime.data.RInteger; import com.oracle.truffle.r.runtime.data.RList; import com.oracle.truffle.r.runtime.data.RLogicalVector; import com.oracle.truffle.r.runtime.data.RNull; @@ -99,7 +101,10 @@ public final class RForeignAccessFactoryImpl implements RForeignAccessFactory { RFunction.class, RNull.class, REnvironment.class, RList.class, RSymbol.class, RPairList.class, RExternalPtr.class, RUnboundValue.class, - DLLInfo.class, DotSymbol.class}; + DLLInfo.class, DotSymbol.class, + NativeRawArray.class, NativeCharArray.class, NativeIntegerArray.class, + NativeDoubleArray.class, NativeLogicalArray.class, + RDouble.class, RInteger.class}; private static final class ForeignAccessState { @@ -211,6 +216,20 @@ public final class RForeignAccessFactoryImpl implements RForeignAccessFactory { foreignAccess = RExternalPtrMRForeign.createAccess(); } else if (RUnboundValue.class.isAssignableFrom(clazz)) { foreignAccess = RUnboundValueMRForeign.createAccess(); + } else if (NativeRawArray.class.isAssignableFrom(clazz)) { + foreignAccess = NativeRawArrayMRForeign.createAccess(); + } else if (NativeLogicalArray.class.isAssignableFrom(clazz)) { + foreignAccess = NativeLogicalArrayMRForeign.createAccess(); + } else if (NativeCharArray.class.isAssignableFrom(clazz)) { + foreignAccess = NativeCharArrayMRForeign.createAccess(); + } else if (NativeDoubleArray.class.isAssignableFrom(clazz)) { + foreignAccess = NativeDoubleArrayMRForeign.createAccess(); + } else if (NativeIntegerArray.class.isAssignableFrom(clazz)) { + foreignAccess = NativeIntegerArrayMRForeign.createAccess(); + } else if (RInteger.class.isAssignableFrom(clazz)) { + foreignAccess = RIntegerMRForeign.createAccess(); + } else if (RDouble.class.isAssignableFrom(clazz)) { + foreignAccess = RDoubleMRForeign.createAccess(); } else { if (RAbstractVector.class.isAssignableFrom(clazz)) { foreignAccess = ForeignAccess.create(RAbstractVector.class, new RAbstractVectorAccessFactory()); diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/RIntegerMR.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/RIntegerMR.java new file mode 100644 index 0000000000000000000000000000000000000000..94d2c602606c42318d4474d8efa00f8d14594c2e --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/RIntegerMR.java @@ -0,0 +1,71 @@ +/* + * Copyright (c) 2016, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop; + +import com.oracle.truffle.api.interop.CanResolve; +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.nodes.Node; +import com.oracle.truffle.r.engine.TruffleRLanguage; +import com.oracle.truffle.r.runtime.data.RInteger; + +@MessageResolution(receiverType = RInteger.class, language = TruffleRLanguage.class) +public class RIntegerMR { + @Resolve(message = "IS_BOXED") + public abstract static class RIntegerIsBoxedNode extends Node { + protected Object access(@SuppressWarnings("unused") RInteger receiver) { + return true; + } + } + + @Resolve(message = "HAS_SIZE") + public abstract static class RIntegerHasSizeNode extends Node { + protected Object access(@SuppressWarnings("unused") RInteger receiver) { + return false; + } + } + + @Resolve(message = "IS_NULL") + public abstract static class RIntegerIsNullNode extends Node { + protected Object access(@SuppressWarnings("unused") RInteger receiver) { + return false; + } + } + + @Resolve(message = "UNBOX") + public abstract static class RIntegerUnboxNode extends Node { + protected double access(RInteger receiver) { + return receiver.getValue(); + } + } + + @CanResolve + public abstract static class RIntegerCheck extends Node { + + protected static boolean test(TruffleObject receiver) { + return receiver instanceof RInteger; + } + } + +} diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/UnsafeAdapter.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/UnsafeAdapter.java new file mode 100644 index 0000000000000000000000000000000000000000..e80c125a9fe68c1cb1d8bc11f799d19549d85021 --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/UnsafeAdapter.java @@ -0,0 +1,46 @@ +/* + * Copyright (c) 2014, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop; + +import java.lang.reflect.Field; + +import sun.misc.Unsafe; + +class UnsafeAdapter { + static final Unsafe UNSAFE = initUnsafe(); + + private static Unsafe initUnsafe() { + try { + return Unsafe.getUnsafe(); + } catch (SecurityException se) { + try { + Field theUnsafe = Unsafe.class.getDeclaredField("theUnsafe"); + theUnsafe.setAccessible(true); + return (Unsafe) theUnsafe.get(Unsafe.class); + } catch (Exception e) { + throw new RuntimeException("exception while trying to get Unsafe", e); + } + } + } + +} diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TruffleC.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TruffleC.java new file mode 100644 index 0000000000000000000000000000000000000000..c37ecfff0f865de02e865b69f8ab8fddfe39b2d1 --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TruffleC.java @@ -0,0 +1,83 @@ +/* + * Copyright (c) 2014, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop.ffi; + +import com.oracle.truffle.api.frame.VirtualFrame; +import com.oracle.truffle.api.interop.ForeignAccess; +import com.oracle.truffle.api.interop.Message; +import com.oracle.truffle.api.nodes.Node; +import com.oracle.truffle.r.engine.interop.NativeRawArray; +import com.oracle.truffle.r.engine.interop.NativeDoubleArray; +import com.oracle.truffle.r.engine.interop.NativeIntegerArray; +import com.oracle.truffle.r.runtime.RInternalError; +import com.oracle.truffle.r.runtime.ffi.CRFFI; +import com.oracle.truffle.r.runtime.ffi.NativeCallInfo; +import com.oracle.truffle.r.runtime.ffi.jni.JNI_C; +import com.oracle.truffle.r.runtime.ffi.truffle.TruffleRFFIFrameHelper; + +class TruffleC implements CRFFI { + private static class TruffleCRFFINode extends JNI_C.JNI_CRFFINode { + + @Override + public synchronized void invoke(NativeCallInfo nativeCallInfo, Object[] args) { + if (nativeCallInfo.address.value instanceof Long) { + super.invoke(nativeCallInfo, args); + } else { + VirtualFrame frame = TruffleRFFIFrameHelper.create(); + TruffleDLL.ensureParsed(nativeCallInfo); + Object[] wargs = wrap(args); + try { + Node messageNode = Message.createExecute(0).createNode(); + ForeignAccess.sendExecute(messageNode, frame, nativeCallInfo.address.asTruffleObject(), wargs); + } catch (Throwable t) { + throw RInternalError.shouldNotReachHere(t); + } + } + } + + Object[] wrap(Object[] args) { + Object[] nargs = new Object[args.length]; + for (int i = 0; i < args.length; i++) { + Object arg = args[i]; + Object narg; + if (arg instanceof int[]) { + narg = new NativeIntegerArray((int[]) arg); + } else if (arg instanceof double[]) { + narg = new NativeDoubleArray((double[]) arg); + } else if (arg instanceof byte[]) { + narg = new NativeRawArray((byte[]) arg); + } else { + throw RInternalError.unimplemented(".C type: " + arg.getClass().getSimpleName()); + } + nargs[i] = narg; + } + return nargs; + } + } + + @Override + public CRFFINode createCRFFINode() { + return new TruffleCRFFINode(); + } + +} diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TruffleCAccess.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TruffleCAccess.java new file mode 100644 index 0000000000000000000000000000000000000000..a835741a541a4c3f326358a4fff502f2d54ab9e4 --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TruffleCAccess.java @@ -0,0 +1,54 @@ +/* + * Copyright (c) 2016, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop.ffi; + +import com.oracle.truffle.r.runtime.ffi.DLL; +import com.oracle.truffle.r.runtime.ffi.RFFIFactory; + +/** + * Access to primitive C operations. + */ +public class TruffleCAccess { + private static final TruffleDLL.TruffleHandle handle = new TruffleDLL.TruffleHandle("libR"); + + public enum Function { + READ_POINTER_INT, + READ_ARRAY_INT, + READ_POINTER_DOUBLE, + READ_ARRAY_DOUBLE; + + private DLL.SymbolHandle symbolHandle; + + public DLL.SymbolHandle getSymbolHandle() { + if (symbolHandle == null) { + symbolHandle = RFFIFactory.getRFFI().getDLLRFFI().dlsym(handle, cName()); + } + return symbolHandle; + } + + public String cName() { + return "caccess_" + name().toLowerCase(); + } + } + +} diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TruffleCall.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TruffleCall.java new file mode 100644 index 0000000000000000000000000000000000000000..bd2cf5c8099cffd999117f67b117025f6f845bb6 --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TruffleCall.java @@ -0,0 +1,265 @@ +/* + * Copyright (c) 2014, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop.ffi; + +import com.oracle.truffle.api.dsl.Cached; +import com.oracle.truffle.api.dsl.ImportStatic; +import com.oracle.truffle.api.dsl.Specialization; +import com.oracle.truffle.api.frame.VirtualFrame; +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.engine.interop.ffi.TruffleCallFactory.InvokeTruffleNodeGen; +import com.oracle.truffle.r.engine.interop.ffi.TruffleCallFactory.SplitTruffleCallRFFINodeGen; +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.RNull; +import com.oracle.truffle.r.runtime.ffi.CallRFFI; +import com.oracle.truffle.r.runtime.ffi.NativeCallInfo; +import com.oracle.truffle.r.runtime.ffi.RFFIVariables; +import com.oracle.truffle.r.runtime.ffi.DLL.SymbolHandle; +import com.oracle.truffle.r.runtime.ffi.jni.JNI_Call; +import com.oracle.truffle.r.runtime.ffi.jni.JNI_Call.JNI_CallRFFINode; +import com.oracle.truffle.r.runtime.ffi.truffle.TruffleRFFIFrameHelper; + +class TruffleCall implements CallRFFI { + private static TruffleCall truffleCall; + private static TruffleObject truffleCallTruffleObject; + private static TruffleObject truffleCallHelper; + + @SuppressWarnings("unused") + TruffleCall() { + new JNI_Call(); + truffleCall = this; + truffleCallTruffleObject = JavaInterop.asTruffleObject(truffleCall); + TrufflePkgInit.initialize(); + truffleCallHelper = TruffleCallHelper.initialize(); + } + + static class ContextStateImpl implements RContext.ContextState { + private RContext context; + private boolean initVariablesDone; + + @Override + public ContextState initialize(RContext contextA) { + this.context = contextA; + context.addExportedSymbol("_fastr_rffi_call", truffleCallTruffleObject); + context.addExportedSymbol("_fastr_rffi_callhelper", truffleCallHelper); + return this; + } + + @Override + public void beforeDestroy(RContext contextA) { + } + + } + + static ContextStateImpl newContextState() { + return new ContextStateImpl(); + } + + private enum INIT_VAR_FUN { + OBJ, + DOUBLE, + INT; + + private final String funName; + private SymbolHandle symbolHandle; + + INIT_VAR_FUN() { + funName = "Call_initvar_" + name().toLowerCase(); + } + } + + private static void initVariables(RContext context) { + // must have parsed the variables module in libR + for (INIT_VAR_FUN initVarFun : INIT_VAR_FUN.values()) { + TruffleDLL.ensureParsed("libR", initVarFun.funName, true); + initVarFun.symbolHandle = new SymbolHandle(context.getEnv().importSymbol("@" + initVarFun.funName)); + } + VirtualFrame frame = TruffleRFFIFrameHelper.create(); + Node executeNode = Message.createExecute(2).createNode(); + RFFIVariables[] variables = RFFIVariables.values(); + for (int i = 0; i < variables.length; i++) { + RFFIVariables var = variables[i]; + Object value = var.getValue(); + if (value == null) { + continue; + } + try { + if (value instanceof Double) { + ForeignAccess.sendExecute(executeNode, frame, INIT_VAR_FUN.DOUBLE.symbolHandle.asTruffleObject(), i, value); + } else if (value instanceof Integer) { + ForeignAccess.sendExecute(executeNode, frame, INIT_VAR_FUN.INT.symbolHandle.asTruffleObject(), i, value); + } else { + // TODO + // ForeignAccess.sendExecute(executeNode, frame, + // INIT_VAR_FUN.OBJ.symbolHandle.asTruffleObject(), i, value); + } + } catch (Throwable t) { + throw RInternalError.shouldNotReachHere(t); + } + } + } + + public static class InvokeJNI extends Node { + @Child JNI_CallRFFINode jniCall = new JNI_CallRFFINode(); + + public Object invokeCall(NativeCallInfo nativeCallInfo, Object[] args) { + return jniCall.invokeCall(nativeCallInfo, args); + } + + public Object invokeVoidCall(NativeCallInfo nativeCallInfo, Object[] args) { + jniCall.invokeVoidCall(nativeCallInfo, args); + return RNull.instance; + } + + } + + /** + * Experimentally the node created for the message send contains cached information regarding + * the target, which is {@link RContext} specific, leading to invalid data being accessed in + * SHARED_PARENT_RW contexts (specifically the cached exported symbols used for package + * initialization). So we guard the node with a check that the context has not changed. + * + */ + @ImportStatic({Message.class, RContext.class}) + public abstract static class InvokeTruffle extends Node { + public abstract Object execute(NativeCallInfo nativeCallInfo, Object[] args, RContext context); + + @Specialization(guards = {"context == cachedContext"}) + protected Object invokeCallCached(NativeCallInfo nativeCallInfo, Object[] args, @SuppressWarnings("unused") RContext context, // + @SuppressWarnings("unused") @Cached("getInstance()") RContext cachedContext, + @Cached("createExecute(0).createNode()") Node messageNode, + @SuppressWarnings("unused") @Cached("ensureReady(nativeCallInfo)") boolean ready) { + return doInvoke(messageNode, nativeCallInfo, args); + } + + @Specialization(contains = "invokeCallCached") + protected Object invokeCallNormal(NativeCallInfo nativeCallInfo, Object[] args, @SuppressWarnings("unused") RContext context) { + return doInvoke(Message.createExecute(0).createNode(), nativeCallInfo, args); + } + + private static Object doInvoke(Node messageNode, NativeCallInfo nativeCallInfo, Object[] args) { + VirtualFrame frame = TruffleRFFIFrameHelper.create(); + try { + return ForeignAccess.sendExecute(messageNode, frame, nativeCallInfo.address.asTruffleObject(), args); + } catch (Throwable t) { + throw RInternalError.shouldNotReachHere(t); + } + } + + public static boolean ensureReady(NativeCallInfo nativeCallInfo) { + TruffleDLL.ensureParsed(nativeCallInfo); + ContextStateImpl contextState = TruffleRFFIContextState.getContextState().callState; + if (!contextState.initVariablesDone) { + initVariables(contextState.context); + contextState.initVariablesDone = true; + } + return true; + } + + public static InvokeTruffle create() { + return InvokeTruffleNodeGen.create(); + } + + } + + /** + * This class exists to separate out the delegated JNI calls from the Truffle calls. + */ + public abstract static class SplitTruffleCallRFFINode extends Node { + public abstract Object execute(NativeCallInfo nativeCallInfo, Object[] args, boolean voidCall); + + @Specialization(guards = {"isJNICall(nativeCallInfo)", "!voidCall"}) + protected Object invokeCall(NativeCallInfo nativeCallInfo, Object[] args, @SuppressWarnings("unused") boolean voidCall, // + @Cached("new()") InvokeJNI invokeJNI) { + return invokeJNI.invokeCall(nativeCallInfo, args); + + } + + @Specialization(guards = {"isJNICall(nativeCallInfo)", "voidCall"}) + protected Object invokeVoidCall(NativeCallInfo nativeCallInfo, Object[] args, @SuppressWarnings("unused") boolean voidCall, // + @Cached("new()") InvokeJNI invokeJNI) { + return invokeJNI.invokeVoidCall(nativeCallInfo, args); + + } + + @Specialization(guards = "!isJNICall(nativeCallInfo)") + protected Object invokeCall(NativeCallInfo nativeCallInfo, Object[] args, @SuppressWarnings("unused") boolean voidCall, // + @Cached("create()") InvokeTruffle invokeTruffle) { + return invokeTruffle.execute(nativeCallInfo, args, RContext.getInstance()); + } + + public static boolean isJNICall(NativeCallInfo nativeCallInfo) { + return nativeCallInfo.address.value instanceof Long; + } + + } + + private static class TruffleCallRFFINode extends CallRFFINode { + @Child SplitTruffleCallRFFINode splitTruffleCallRFFINode = SplitTruffleCallRFFINodeGen.create(); + + @Override + public synchronized Object invokeCall(NativeCallInfo nativeCallInfo, Object[] args) { + return splitTruffleCallRFFINode.execute(nativeCallInfo, args, false); + + } + + @Override + public synchronized void invokeVoidCall(NativeCallInfo nativeCallInfo, Object[] args) { + splitTruffleCallRFFINode.execute(nativeCallInfo, args, true); + } + + @Override + public void setTempDir(String tempDir) { + // TODO Truffleize + new JNI_CallRFFINode().setTempDir(tempDir); + } + + @Override + public void setInteractive(boolean interactive) { + // TODO Truffleize + new JNI_CallRFFINode().setInteractive(interactive); + } + + } + + /** + * Upcalled from Rinternal et al. + * + * @param function + */ + public void unimplemented(String function) { + throw RInternalError.unimplemented("RFFI function: '" + function + "' not implemented"); + } + + @Override + public CallRFFINode createCallRFFINode() { + return new TruffleCallRFFINode(); + } + +} diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TruffleCallHelper.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TruffleCallHelper.java new file mode 100644 index 0000000000000000000000000000000000000000..4347e0e1d93e8037e661457abe394ac6e3e48b1d --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TruffleCallHelper.java @@ -0,0 +1,153 @@ +/* + * Copyright (c) 2016, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop.ffi; + +import java.nio.charset.StandardCharsets; + +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.api.interop.java.JavaInterop; +import com.oracle.truffle.r.engine.interop.NativeRawArray; +import com.oracle.truffle.r.engine.interop.NativeCharArray; +import com.oracle.truffle.r.engine.interop.NativeDoubleArray; +import com.oracle.truffle.r.engine.interop.NativeIntegerArray; +import com.oracle.truffle.r.engine.interop.NativeLogicalArray; +import com.oracle.truffle.r.runtime.REnvVars; +import com.oracle.truffle.r.runtime.RInternalError; +import com.oracle.truffle.r.runtime.context.RContext; +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; +import com.oracle.truffle.r.runtime.data.RNull; +import com.oracle.truffle.r.runtime.data.RScalar; +import com.oracle.truffle.r.runtime.data.RTypedValue; +import com.oracle.truffle.r.runtime.data.RUnboundValue; +import com.oracle.truffle.r.runtime.ffi.CharSXPWrapper; +import com.oracle.truffle.r.runtime.ffi.JavaUpCallsRFFI; + +/** + * A wrapper class that can be instantiated and export for method lookup. For now just delegates to + * {@link JavaUpCallsRFFI}. + * + */ +public class TruffleCallHelper extends JavaUpCallsRFFI { + private static TruffleCallHelper singleton; + private static TruffleObject singletonTruffleObject; + + public static TruffleObject initialize() { + if (singleton == null) { + singleton = new TruffleCallHelper(); + singletonTruffleObject = JavaInterop.asTruffleObject(singleton); + } + return singletonTruffleObject; + } + + public Object charSXPToNativeCharArray(Object x) { + CharSXPWrapper chars = guaranteeInstanceOf(x, CharSXPWrapper.class); + return new NativeCharArray(chars.getContents().getBytes()); + } + + // Checkstyle: stop method name check + + public Object Rf_mkCharLenCE(Object bytes, int encoding) { + if (bytes instanceof NativeCharArray) { + return super.Rf_mkCharLenCE(((NativeCharArray) bytes).getBytes(), encoding); + } else { + throw RInternalError.unimplemented(); + } + } + + public Object Rf_install(Object name) { + if (name instanceof NativeCharArray) { + return RDataFactory.createSymbolInterned(new String(((NativeCharArray) name).getBytes(), StandardCharsets.UTF_8)); + } else { + throw RInternalError.unimplemented(); + } + } + + @Override + public Object RAW(Object x) { + byte[] value = (byte[]) super.RAW(x); + return new NativeRawArray(value); + } + + @Override + public Object LOGICAL(Object x) { + byte[] value = (byte[]) super.LOGICAL(x); + return new NativeLogicalArray(x, value); + } + + @Override + public Object INTEGER(Object x) { + int[] value = (int[]) super.INTEGER(x); + return new NativeIntegerArray(x, value); + } + + @Override + public Object REAL(Object x) { + // Special handling in Truffle variant + double[] value = (double[]) super.REAL(x); + return new NativeDoubleArray(x, value); + } + + public Object R_Home() { + byte[] sbytes = REnvVars.rHome().getBytes(); + return new NativeCharArray(sbytes); + } + + @Override + public Object Rf_findVar(Object symbolArg, Object envArg) { + Object v = super.Rf_findVar(symbolArg, envArg); + if (v instanceof RTypedValue) { + return v; + } else { + return wrapPrimitive(v); + } + } + + public Object R_NilValue() { + return RNull.instance; + } + + public Object R_UnboundValue() { + return RUnboundValue.instance; + } + + public Object bytesToNativeCharArray(byte[] bytes) { + return new NativeCharArray(bytes); + } + + private static RScalar wrapPrimitive(Object x) { + if (x instanceof Double) { + return RDouble.valueOf((double) x); + } else if (x instanceof Integer) { + return RInteger.valueOf((int) x); + } else if (x instanceof Byte) { + return RLogical.valueOf((byte) x); + } else { + throw RInternalError.shouldNotReachHere(); + } + + } + +} diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TruffleDLL.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TruffleDLL.java new file mode 100644 index 0000000000000000000000000000000000000000..68255337206f51fe889be8627716ac9502c0bd4c --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TruffleDLL.java @@ -0,0 +1,350 @@ +/* + * Copyright (c) 2016, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop.ffi; + +import java.nio.file.FileSystems; +import java.util.HashMap; +import java.util.Map; + +import com.oracle.truffle.api.CallTarget; +import com.oracle.truffle.api.CompilerAsserts; +import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; +import com.oracle.truffle.api.source.Source; +import com.oracle.truffle.r.runtime.RInternalError; +import com.oracle.truffle.r.runtime.Utils; +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.jni.JNI_DLL; +import com.oracle.truffle.r.runtime.ffi.truffle.LLVM_IR; +import com.oracle.truffle.r.runtime.ffi.DLLRFFI; +import com.oracle.truffle.r.runtime.ffi.NativeCallInfo; + +/** + * The Truffle version of {@link DLLRFFI}. {@link TruffleDLL#dlopen} expects to find the LLVM IR + * embedded in the shared library. If it exists it is used, unless the library is blacklisted. + * Otherwise we fall back to the standard JNI implementation. + * + * The LLVM bitcode is stored (opaquely) in the shared library file, and access through the + * {@link LLVM_IR} class. The {@link LLVM_IR#getLLVMIR(String)} method will return an array of + * {@link LLVM_IR} instances for all the modules in the library. These have to be parsed by the + * Truffle LLVM system (into ASTs) before they can be interpreted/compiled. Note that there is no + * support in Truffle LLVM itself for resolving references to functions in other LLVM modules. If + * the function as an LLVM AST cannot be found it is assumed to be a native function. The upshot of + * this is that, naively, every module in a library has to be parsed before any modules can be + * executed, and inter-library dependencies also have to be handled explicitly. Most of the + * inter-library references are to "libR", which is handled specially. If parsing was fast eager + * parsing of all modules would not be an issue but, currently, is it not fast and some modules + * exhibit pathologies that can take as long as a minute to parse, so some effort to support lazy + * parsing has been implemented. Unfortunately this requires additional metadata. Note also that + * only functions that are invoked explicitly through on of the RFFI interfaces can be handled + * lazily; any internal calls must already be resolved (this would change if LLVM had the callback + * facility alluded to above). + * + * This code can operate with lazy or eager parsing, but additional metadata has to be provided on + * the defined/undefined symbols in a module. + * + * There is one major difference between native and LLVM libraries. There is a single global + * instance of a native library and the symbols are, therefore, accessible from any {@link RContext} + * instance . However, the (Truffle) function descriptors for an LLVM library are specific to the + * {@link RContext} they are created (parsed) in. This has two important consequences: + * <ol> + * <li>It is theoretically possible to have different versions of libraries in different contexts. + * </li> + * <li>The {@code libR} library function descriptors must be made available in every context. At the + * present time this can only be done by re-parsing the library contents.</li> + * </ol> + * + * Note also that {@code libR} is the only library that is opened in native and LLVM mode, as the + * native code is used by non-LLVM packages (libraries) and the LLVM code is used by the LLVM + * packages (libraries). + */ +class TruffleDLL extends JNI_DLL implements DLLRFFI { + /** + * Supports lazy parsing of LLVM modules. + */ + static class ParseStatus { + /** + * Name of associated library. + */ + final String libName; + /** + * The LLVM IR (bitcode). + */ + final LLVM_IR ir; + /** + * {@code true} iff the bitcode has been parsed into a Truffle AST. + */ + boolean parsed; + + ParseStatus(String libName, LLVM_IR ir, boolean parsed) { + this.libName = libName; + this.ir = ir; + this.parsed = parsed; + } + + @Override + public String toString() { + CompilerAsserts.neverPartOfCompilation(); + return String.format("lib %s, module %s, parsed %b%n", libName, ir.name, parsed); + } + } + + class ContextStateImpl implements RContext.ContextState { + /** + * A map from function name to its {@link ParseStatus}, allowing fast determination whether + * parsing is required in a call, see {@link #ensureParsed}. N.B. parsing happens at the + * module level, so all exported functions in one module share the same {@link ParseStatus} + * instance. + */ + Map<String, ParseStatus> parseStatusMap = new HashMap<>(); + + /** + * When a new {@link RContext} is created we have to re-parse the libR modules, + * unfortunately, as there is no way to propagate the LLVM state created in the initial + * context. TODO when do we really need to do this? This is certainly too early for contexts + * that will not invoke LLVM code (e.g. most unit tests) + */ + @Override + public ContextState initialize(RContext context) { + for (LLVM_IR ir : libRModules) { + addExportsToMap(this, "libR", ir, (name) -> name.endsWith("_llvm")); + } + return this; + } + + @Override + public void beforeDestroy(RContext context) { + if (!context.isInitial()) { + parseStatusMap = null; + } + } + + } + + private static TruffleDLL truffleDLL; + + TruffleDLL() { + assert truffleDLL == null; + truffleDLL = this; + } + + static TruffleDLL getInstance() { + assert truffleDLL != null; + return truffleDLL; + } + + static ContextStateImpl newContextState() { + return truffleDLL.new ContextStateImpl(); + } + + static boolean isBlacklisted(String libName) { + String libs = System.getenv("FASTR_TRUFFLE_LIBS"); + if (libs == null) { + Utils.warn(String.format("TruffleDLL: %s, FASTR_TRUFFLE_LIBS is unset, defaulting to JNI", libName)); + return true; + } + String[] libsElems = libs.split(","); + for (String libsElem : libsElems) { + if (libName.equals(libsElem)) { + return false; + } + } + return true; + } + + static class TruffleHandle { + private final String libName; + + TruffleHandle(String libName) { + this.libName = libName; + } + } + + @FunctionalInterface + interface ModuleNameMatch { + boolean match(String name); + } + + /** + * If a library is enabled for LLVM,the IR for all the modules is retrieved and analyzed. Every + * exported symbol in the module added to the parseStatus map for the current {@link RContext}. + * This allows {@link #dlsym} to definitively locate any symbol, even if the IR has not been + * parsed yet. + */ + @Override + public Object dlopen(String path, boolean local, boolean now) { + try { + LLVM_IR[] irs = LLVM_IR.getLLVMIR(path); + String libName = getLibName(path); + // even if libR is not all LLVM executed, some parts have to be + // but they can't be parsed now + if (libName.equals("libR")) { + libRModules = irs; + } + if (irs == null || isBlacklisted(libName)) { + return super.dlopen(path, local, now); + } else { + ContextStateImpl contextState = getContextState(); + for (int i = 0; i < irs.length; i++) { + LLVM_IR ir = irs[i]; + addExportsToMap(contextState, libName, ir, (name) -> true); + } + return new TruffleHandle(libName); + } + } catch (Exception ex) { + return null; + } + } + + private static void addExportsToMap(ContextStateImpl contextState, String libName, LLVM_IR ir, ModuleNameMatch moduleNameMatch) { + ParseStatus parseStatus = new ParseStatus(libName, ir, false); + for (String export : ir.exports) { + if (moduleNameMatch.match(ir.name)) { + assert contextState.parseStatusMap.get(export) == null; + contextState.parseStatusMap.put(export, parseStatus); + } + } + } + + private static String getLibName(String path) { + String fileName = FileSystems.getDefault().getPath(path).getFileName().toString(); + int ix = fileName.lastIndexOf("."); + return fileName.substring(0, ix); + } + + /** + * Record of the libR modules for subsequent parsing. + */ + private LLVM_IR[] libRModules; + + private static ContextStateImpl getContextState() { + return TruffleRFFIContextState.getContextState().dllState; + } + + /** + * About to invoke the (external) function denoted by {@code nativeCallInfo}. Therefore, it must + * have been parsed (in {@link #dlsym(Object, String)}) AND all dependent modules, recursively, + * must also be parsed. Evidently since the dependencies are expressed at a module level, this + * may parse more than strictly necessary. + * + * @param nativeCallInfo + */ + static void ensureParsed(NativeCallInfo nativeCallInfo) { + ensureParsed(nativeCallInfo.dllInfo.name, nativeCallInfo.name, true); + } + + /** + * Similar to {@link #ensureParsed(NativeCallInfo)} but with a function specified as a string + * (for internal use) and an optional check whether the function must exist. + * + * @param libName TODO + */ + @TruffleBoundary + static void ensureParsed(String libName, String name, boolean fatalIfMissing) { + ContextStateImpl contextState = getContextState(); + Map<String, ParseStatus> parseStatusMap = contextState.parseStatusMap; + ParseStatus parseStatus = parseStatusMap.get(name); + assert parseStatus != null || !fatalIfMissing; + if (parseStatus != null && !parseStatus.parsed) { + parseLLVM(parseStatus.ir); + parseStatus.parsed = true; + boolean isPackageInit = isPackageInit(libName, name); + for (String importee : parseStatus.ir.imports) { + /* + * If we are resolving a package init call, we do not want to resolve all the + * imports if functions in the same library as this will cause everything in the + * library to be parsed eagerly! + */ + ParseStatus importeeParseStatus = parseStatusMap.get(importee); + boolean internal = isPackageInit && importeeParseStatus.libName.equals(libName); + if (importeeParseStatus != null && !internal) { + ensureParsed(libName, importee, false); + } + } + } + } + + private static boolean isPackageInit(@SuppressWarnings("unused") String libName, String name) { + if (name.startsWith(DLL.R_INIT_PREFIX)) { + return true; + } else { + return false; + } + } + + private static void parseLLVM(LLVM_IR ir) { + if (ir instanceof LLVM_IR.Binary) { + LLVM_IR.Binary bir = (LLVM_IR.Binary) ir; + parseBinary(bir); + } else { + throw RInternalError.unimplemented("LLVM text IR"); + } + } + + private static CallTarget parseBinary(LLVM_IR.Binary ir) { + long start = System.nanoTime(); + RContext context = RContext.getInstance(); + long nanos = 1000 * 1000 * 1000; + Source source = Source.newBuilder(ir.base64).name(ir.name).mimeType("application/x-llvm-ir-bitcode-base64").build(); + CallTarget result = context.getEnv().parse(source); + if (System.getenv("LLVM_PARSE_TIME") != null) { + long end = System.nanoTime(); + System.out.printf("parsed %s in %f secs%n", ir.name, ((double) (end - start)) / (double) nanos); + } + return result; + } + + @Override + public SymbolHandle dlsym(Object handle, String symbol) { + if (handle instanceof TruffleHandle) { + // If the symbol exists it will be in the map + ParseStatus parseStatus = getContextState().parseStatusMap.get(symbol); + if (parseStatus != null && parseStatus.libName.equals(((TruffleHandle) handle).libName)) { + // force a parse so we have a "value" + if (!parseStatus.parsed) { + ensureParsed(parseStatus.libName, symbol, true); + } + Object symValue = RContext.getInstance().getEnv().importSymbol("@" + symbol); + assert symValue != null; + return new SymbolHandle(symValue); + } else { + // symbol not found (or not in requested library) + return null; + } + } else { + return super.dlsym(handle, symbol); + } + } + + @Override + public int dlclose(Object handle) { + if (handle instanceof TruffleHandle) { + return 0; + } else { + return super.dlclose(handle); + } + } + +} diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TrufflePkgInit.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TrufflePkgInit.java new file mode 100644 index 0000000000000000000000000000000000000000..c73897234ac24c90c3f35384dd688bd6a88d50ac --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TrufflePkgInit.java @@ -0,0 +1,119 @@ +/* + * Copyright (c) 2014, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop.ffi; + +import com.oracle.truffle.api.frame.VirtualFrame; +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.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.DLLInfo; +import com.oracle.truffle.r.runtime.ffi.DLL.DotSymbol; +import com.oracle.truffle.r.runtime.ffi.DLL.SymbolHandle; +import com.oracle.truffle.r.runtime.ffi.truffle.TruffleRFFIFrameHelper; + +class TrufflePkgInit { + + private static TrufflePkgInit trufflePkgInit; + private static TruffleObject trufflePkgInitTruffleObject; + + static class ContextStateImpl implements RContext.ContextState { + @Override + public ContextState initialize(RContext context) { + context.addExportedSymbol("_fastr_rffi_pkginit", trufflePkgInitTruffleObject); + return this; + } + + @Override + public void beforeDestroy(RContext context) { + } + } + + static ContextStateImpl newContextState() { + return new ContextStateImpl(); + } + + static TrufflePkgInit initialize() { + if (trufflePkgInit == null) { + trufflePkgInit = new TrufflePkgInit(); + trufflePkgInitTruffleObject = JavaInterop.asTruffleObject(trufflePkgInit); + } + 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; + } + dllInfo.setNativeSymbols(nstOrd, array); + } + + private static Object setSymbol(int nstOrd, long routines, int index, SymbolHandle symbolHandle) { + VirtualFrame frame = TruffleRFFIFrameHelper.create(); + Node executeNode = Message.createExecute(3).createNode(); + try { + + Object result = ForeignAccess.sendExecute(executeNode, frame, symbolHandle.asTruffleObject(), 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) { + return new DotSymbol(name, new SymbolHandle(fundesc), numArgs); + } + + 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.engine/src/com/oracle/truffle/r/engine/interop/ffi/TruffleRFFIContextState.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TruffleRFFIContextState.java new file mode 100644 index 0000000000000000000000000000000000000000..bd937ee2872fc4ece8f61621267aa7d1a754dc6f --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TruffleRFFIContextState.java @@ -0,0 +1,70 @@ +/* + * Copyright (c) 2014, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop.ffi; + +import com.oracle.truffle.r.runtime.context.RContext; +import com.oracle.truffle.r.runtime.context.RContext.ContextState; + +/** + * A facade for the context state for the Truffle LLVM factory. Delegates to the various + * module-specific pieces of state. This may get merged into a single instance eventually. + */ +class TruffleRFFIContextState implements ContextState { + TruffleDLL.ContextStateImpl dllState; + TrufflePkgInit.ContextStateImpl pkgInitState; + TruffleCall.ContextStateImpl callState; + TruffleStats.ContextStateImpl statsState; + + TruffleRFFIContextState() { + dllState = TruffleDLL.newContextState(); + pkgInitState = TrufflePkgInit.newContextState(); + callState = TruffleCall.newContextState(); + statsState = TruffleStats.newContextState(); + } + + static TruffleRFFIContextState getContextState() { + return (TruffleRFFIContextState) RContext.getInstance().getStateRFFI(); + } + + static TruffleRFFIContextState getContextState(RContext context) { + return (TruffleRFFIContextState) context.getStateRFFI(); + } + + @Override + public ContextState initialize(RContext context) { + dllState.initialize(context); + pkgInitState.initialize(context); + callState.initialize(context); + statsState.initialize(context); + return this; + } + + @Override + public void beforeDestroy(RContext context) { + dllState.beforeDestroy(context); + pkgInitState.beforeDestroy(context); + callState.beforeDestroy(context); + statsState.beforeDestroy(context); + } + +} diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TruffleStats.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TruffleStats.java new file mode 100644 index 0000000000000000000000000000000000000000..61e65d2a56178c322cf64254da17893eeb073e72 --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TruffleStats.java @@ -0,0 +1,208 @@ +/* + * Copyright (c) 2014, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop.ffi; + +import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; +import com.oracle.truffle.api.dsl.Cached; +import com.oracle.truffle.api.dsl.ImportStatic; +import com.oracle.truffle.api.dsl.Specialization; +import com.oracle.truffle.api.frame.VirtualFrame; +import com.oracle.truffle.api.interop.ForeignAccess; +import com.oracle.truffle.api.interop.Message; +import com.oracle.truffle.api.nodes.Node; +import com.oracle.truffle.r.engine.interop.NativeDoubleArray; +import com.oracle.truffle.r.engine.interop.NativeIntegerArray; +import com.oracle.truffle.r.engine.interop.ffi.TruffleStatsFactory.ExecuteFactorNodeGen; +import com.oracle.truffle.r.engine.interop.ffi.TruffleStatsFactory.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.StatsRFFI; +import com.oracle.truffle.r.runtime.ffi.DLL.DLLInfo; +import com.oracle.truffle.r.runtime.ffi.DLL.SymbolHandle; +import com.oracle.truffle.r.runtime.ffi.truffle.TruffleRFFIFrameHelper; + +public class TruffleStats implements StatsRFFI { + + public enum FFT_FUN { + fft_work, + fft_factor; + } + + static class ContextStateImpl implements RContext.ContextState { + @Override + public ContextState initialize(RContext context) { + /* + * In the case of a SHARE_PARENT_RW context, there is no dlopen call for stats, so the + * fft_work/fft_factor functions will not be added into the context symbol map, so we do + * it here. + */ + if (context.getKind() == RContext.ContextKind.SHARE_PARENT_RW) { + TruffleDLL.ContextStateImpl contextState = TruffleRFFIContextState.getContextState().dllState; + TruffleDLL.ContextStateImpl parentDLLContextState = TruffleRFFIContextState.getContextState(context.getParent()).dllState; + TruffleDLL.ParseStatus parseStatus = null; + for (FFT_FUN f : FFT_FUN.values()) { + String funName = f.name(); + TruffleDLL.ParseStatus parentParseStatus = parentDLLContextState.parseStatusMap.get(funName); + if (parentParseStatus != null) { + if (parseStatus == null) { + parseStatus = new TruffleDLL.ParseStatus("stats", parentParseStatus.ir, false); + } + contextState.parseStatusMap.put(f.name(), parseStatus); + } + } + } + return this; + } + + @Override + public void beforeDestroy(RContext context) { + } + } + + static ContextStateImpl newContextState() { + return new ContextStateImpl(); + } + + public abstract static class LookupAdapter extends Node { + public SymbolHandle lookup(String name) { + DLLInfo dllInfo = DLL.findLibrary("stats"); + // cannot go through DLL because stats does not allow dynamic lookup + // and these symbols are not registered (only fft) + SymbolHandle result = TruffleDLL.getInstance().dlsym(dllInfo.handle, name); + if (result == DLL.SYMBOL_NOT_FOUND) { + @SuppressWarnings("unused") + TruffleRFFIContextState cs = TruffleRFFIContextState.getContextState(); + throw RInternalError.shouldNotReachHere(); + } + return result; + } + } + + @ImportStatic({RContext.class}) + public abstract static class ExecuteWork extends LookupAdapter { + public abstract int execute(double[] a, int nseg, int n, int nspn, int isn, double[] work, int[] iwork, RContext context); + + @Specialization(guards = "context == cachedContext") + protected int executeWorkCached(double[] a, int nseg, int n, int nspn, int isn, double[] work, int[] iwork, @SuppressWarnings("unused") RContext context, // + @SuppressWarnings("unused") @Cached("getInstance()") RContext cachedContext, + @Cached("createMessageNode()") Node messageNode, + @Cached("lookupWork()") SymbolHandle fftWork) { + return doWork(a, nseg, n, nspn, isn, work, iwork, messageNode, fftWork); + } + + @Specialization(contains = "executeWorkCached") + protected int executeWorkNormal(double[] a, int nseg, int n, int nspn, int isn, double[] work, int[] iwork, @SuppressWarnings("unused") RContext context) { + return doWork(a, nseg, n, nspn, isn, work, iwork, createMessageNode(), lookup("fft_work")); + } + + private static int doWork(double[] a, int nseg, int n, int nspn, int isn, double[] work, int[] iwork, Node messageNode, SymbolHandle fftWork) { + NativeDoubleArray na = new NativeDoubleArray(a); + NativeDoubleArray nwork = new NativeDoubleArray(work); + NativeIntegerArray niwork = new NativeIntegerArray(iwork); + VirtualFrame frame = TruffleRFFIFrameHelper.create(); + try { + return (int) ForeignAccess.sendExecute(messageNode, frame, fftWork.asTruffleObject(), na, nseg, n, nspn, isn, nwork, niwork); + } catch (Throwable t) { + throw RInternalError.shouldNotReachHere(t); + } + } + + public static Node createMessageNode() { + return Message.createExecute(7).createNode(); + } + + public static ExecuteWork create() { + return ExecuteWorkNodeGen.create(); + } + + public SymbolHandle lookupWork() { + return lookup("fft_work"); + } + } + + @ImportStatic({RContext.class}) + public abstract static class ExecuteFactor extends LookupAdapter { + protected abstract void execute(int n, int[] pmaxf, int[] pmaxp, RContext context); + + @Specialization(guards = "context == cachedContext") + protected void executeFactorCached(int n, int[] pmaxf, int[] pmaxp, @SuppressWarnings("unused") RContext context, // + @SuppressWarnings("unused") @Cached("getInstance()") RContext cachedContext, + @Cached("createMessageNode()") Node messageNode, + @Cached("lookupFactor()") SymbolHandle fftFactor) { + doFactor(n, pmaxf, pmaxp, messageNode, fftFactor); + } + + @Specialization(contains = "executeFactorCached") + protected void executeFactorNormal(int n, int[] pmaxf, int[] pmaxp, @SuppressWarnings("unused") RContext context) { + doFactor(n, pmaxf, pmaxp, createMessageNode(), lookup("fft_factor")); + } + + private static void doFactor(int n, int[] pmaxf, int[] pmaxp, Node messageNode, SymbolHandle fftFactor) { + NativeIntegerArray npmaxf = new NativeIntegerArray(pmaxf); + NativeIntegerArray npmaxp = new NativeIntegerArray(pmaxp); + VirtualFrame frame = TruffleRFFIFrameHelper.create(); + + try { + ForeignAccess.sendExecute(messageNode, frame, fftFactor.asTruffleObject(), n, npmaxf, npmaxp); + } catch (Throwable t) { + throw RInternalError.shouldNotReachHere(t); + } + } + + public static Node createMessageNode() { + return Message.createExecute(3).createNode(); + } + + public static ExecuteFactor create() { + return ExecuteFactorNodeGen.create(); + } + + public SymbolHandle lookupFactor() { + return lookup("fft_factor"); + } + } + + public static class Truffle_FFTNode extends FFTNode { + @Child ExecuteWork executeWork = ExecuteWork.create(); + @Child ExecuteFactor executeFactor = ExecuteFactor.create(); + + @Override + public int executeWork(double[] a, int nseg, int n, int nspn, int isn, double[] work, int[] iwork) { + return executeWork.execute(a, nseg, n, nspn, isn, work, iwork, RContext.getInstance()); + } + + @Override + public void executeFactor(int n, int[] pmaxf, int[] pmaxp) { + executeFactor.execute(n, pmaxf, pmaxp, RContext.getInstance()); + } + + } + + @Override + public FFTNode createFFTNode() { + return new Truffle_FFTNode(); + } + +} diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TruffleUserRng.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TruffleUserRng.java new file mode 100644 index 0000000000000000000000000000000000000000..2f1ccf7b942503f909037a3a246731d56875a772 --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/TruffleUserRng.java @@ -0,0 +1,108 @@ +/* + * Copyright (c) 2016, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop.ffi; + +import static com.oracle.truffle.r.runtime.rng.user.UserRNG.Function; +import com.oracle.truffle.api.frame.VirtualFrame; +import com.oracle.truffle.api.interop.ForeignAccess; +import com.oracle.truffle.api.interop.Message; +import com.oracle.truffle.api.nodes.Node; +import com.oracle.truffle.r.runtime.RInternalError; +import com.oracle.truffle.r.runtime.ffi.UserRngRFFI; +import com.oracle.truffle.r.runtime.ffi.truffle.TruffleRFFIFrameHelper; + +public class TruffleUserRng implements UserRngRFFI { + private static class TruffleUserRngRFFINode extends UserRngRFFINode { + Node initMessage; + Node randMessage; + Node nSeedMessage; + Node seedsMessage; + Node readPointerNode = Message.createExecute(1).createNode(); + + @Override + public void init(int seed) { + VirtualFrame frame = TruffleRFFIFrameHelper.create(); + if (initMessage == null) { + initMessage = Message.createExecute(1).createNode(); + } + try { + ForeignAccess.sendExecute(initMessage, frame, Function.Init.getSymbolHandle().asTruffleObject(), seed); + } catch (Throwable t) { + throw RInternalError.shouldNotReachHere(); + } + } + + @Override + public double rand() { + VirtualFrame frame = TruffleRFFIFrameHelper.create(); + if (randMessage == null) { + randMessage = Message.createExecute(0).createNode(); + } + try { + Object address = ForeignAccess.sendExecute(randMessage, frame, Function.Rand.getSymbolHandle().asTruffleObject()); + Object value = ForeignAccess.sendExecute(readPointerNode, frame, TruffleCAccess.Function.READ_POINTER_DOUBLE.getSymbolHandle().asTruffleObject(), address); + return (double) value; + } catch (Throwable t) { + throw RInternalError.shouldNotReachHere(); + } + } + + @Override + public int nSeed() { + VirtualFrame frame = TruffleRFFIFrameHelper.create(); + if (nSeedMessage == null) { + nSeedMessage = Message.createExecute(0).createNode(); + } + try { + Object address = ForeignAccess.sendExecute(nSeedMessage, frame, Function.NSeed.getSymbolHandle().asTruffleObject()); + Object n = ForeignAccess.sendExecute(readPointerNode, frame, TruffleCAccess.Function.READ_POINTER_INT.getSymbolHandle().asTruffleObject(), address); + return (int) n; + } catch (Throwable t) { + throw RInternalError.shouldNotReachHere(); + } + } + + @Override + public void seeds(int[] n) { + VirtualFrame frame = TruffleRFFIFrameHelper.create(); + if (seedsMessage == null) { + seedsMessage = Message.createExecute(0).createNode(); + } + try { + Object address = ForeignAccess.sendExecute(seedsMessage, frame, Function.Seedloc.getSymbolHandle().asTruffleObject()); + for (int i = 0; i < n.length; i++) { + Object seed = ForeignAccess.sendExecute(readPointerNode, frame, TruffleCAccess.Function.READ_ARRAY_INT.getSymbolHandle().asTruffleObject(), address, i); + n[i] = (int) seed; + } + } catch (Throwable t) { + throw RInternalError.shouldNotReachHere(); + } + } + } + + @Override + public UserRngRFFINode createUserRngRFFINode() { + return new TruffleUserRngRFFINode(); + } + +} diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/Truffle_RFFIFactory.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/Truffle_RFFIFactory.java new file mode 100644 index 0000000000000000000000000000000000000000..2bf1a5c7f7a0d0fc6dd10a434d9ab320e07e4db7 --- /dev/null +++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/interop/ffi/Truffle_RFFIFactory.java @@ -0,0 +1,103 @@ +/* + * Copyright (c) 2014, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.engine.interop.ffi; + +import com.oracle.truffle.r.runtime.context.RContext.ContextState; +import com.oracle.truffle.r.runtime.ffi.CRFFI; +import com.oracle.truffle.r.runtime.ffi.CallRFFI; +import com.oracle.truffle.r.runtime.ffi.DLLRFFI; +import com.oracle.truffle.r.runtime.ffi.RFFI; +import com.oracle.truffle.r.runtime.ffi.StatsRFFI; +import com.oracle.truffle.r.runtime.ffi.UserRngRFFI; +import com.oracle.truffle.r.runtime.ffi.jni.JNI_RFFIFactory; + +/** + * Incremental approach to using Truffle, defaults to the JNI factory. + * + */ +public class Truffle_RFFIFactory extends JNI_RFFIFactory implements RFFI { + + @Override + protected void initialize(boolean runtime) { + super.initialize(runtime); + } + + @Override + public ContextState newContextState() { + return new TruffleRFFIContextState(); + } + + private CRFFI cRFFI; + + @Override + public CRFFI getCRFFI() { + if (cRFFI == null) { + cRFFI = new TruffleC(); + } + return cRFFI; + } + + private DLLRFFI dllRFFI; + + @Override + public DLLRFFI getDLLRFFI() { + if (dllRFFI == null) { + dllRFFI = new TruffleDLL(); + } + return dllRFFI; + } + + private UserRngRFFI truffleUserRngRFFI; + + @Override + public UserRngRFFI getUserRngRFFI() { + if (truffleUserRngRFFI == null) { + truffleUserRngRFFI = new TruffleUserRng(); + } + return truffleUserRngRFFI; + } + + private CallRFFI truffleCallRFFI; + + @Override + public CallRFFI getCallRFFI() { + if (truffleCallRFFI == null) { + truffleCallRFFI = new TruffleCall(); + } + return truffleCallRFFI; + } + + private StatsRFFI truffleStatsRFFI; + + @Override + public StatsRFFI getStatsRFFI() { + if (TruffleDLL.isBlacklisted("stats")) { + return super.getStatsRFFI(); + } + if (truffleStatsRFFI == null) { + truffleStatsRFFI = new TruffleStats(); + } + return truffleStatsRFFI; + } + +} diff --git a/com.oracle.truffle.r.native/fficall/Makefile b/com.oracle.truffle.r.native/fficall/Makefile index 46b4f1d95fcb7c981511ee1fff0baad3fcaf325b..ee3411055022a526dbc34b3f9475bcbdcdb84cb4 100644 --- a/com.oracle.truffle.r.native/fficall/Makefile +++ b/com.oracle.truffle.r.native/fficall/Makefile @@ -33,11 +33,16 @@ endif .PHONY: all clean +C_LIBNAME := libR$(DYLIB_EXT) +C_LIB := $(FASTR_LIB_DIR)/$(C_LIBNAME) R_LIBNAME := libR$(DYLIB_EXT) R_LIB := $(FASTR_LIB_DIR)/$(R_LIBNAME) JNIBOOT_LIBNAME := libjniboot$(DYLIB_EXT) JNIBOOT_LIB := $(FASTR_LIB_DIR)/$(JNIBOOT_LIBNAME) +FASTR_COMPILERS_DIR := $(FASTR_R_HOME)/mx.fastr/compilers +HAVE_SULONG := $(shell $(FASTR_COMPILERS_DIR)/have_sulong) + ifeq ($(OS_NAME), Darwin) VERSION_FLAGS := -current_version $(R_VERSION) -compatibility_version $(R_VERSION) endif @@ -66,6 +71,9 @@ endif jni.done: $(MAKE) -C src/common all $(MAKE) -C src/jni all +ifeq ($(HAVE_SULONG),yes) + $(MAKE) -C src/truffle all +endif touch jni.done $(JNIBOOT_LIB): jniboot.done @@ -81,7 +89,10 @@ jniboot.done: clean: $(MAKE) -C src/common clean $(MAKE) -C src/jni clean +ifeq ($(HAVE_SULONG),yes) + $(MAKE) -C src/truffle clean +endif rm -rf $(R_LIB) rm -rf $(JNIBOOT_LIB) rm -rf jni.done jniboot.done - + diff --git a/com.oracle.truffle.r.native/fficall/src/common/Makefile b/com.oracle.truffle.r.native/fficall/src/common/Makefile index c4a7426922c9afb82094e16c6c74cce3c127b4b3..da61c6bf96907dd3197e0c9b1756110d79660779 100644 --- a/com.oracle.truffle.r.native/fficall/src/common/Makefile +++ b/com.oracle.truffle.r.native/fficall/src/common/Makefile @@ -35,7 +35,7 @@ OBJ = ../../lib GNUR_APPL_C_FILES = pretty.c interv.c GNUR_APPL_SRC = $(GNUR_HOME)/src/appl # the Fortran sources are not recompiled, just copied -GNUR_APPL_F_OBJECTS := $(wildcard $(GNUR_APPL_SRC)/d*.o) +GNUR_APPL_F_OBJECTS := $(wildcard $(GNUR_APPL_SRC)/d*.o $(GNUR_APPL_SRC)/d*.ll) GNUR_MAIN_C_FILES = colors.c devices.c engine.c format.c graphics.c plot.c plot3d.c plotmath.c rlocale.c sort.c GNUR_MAIN_SRC = $(GNUR_HOME)/src/main diff --git a/com.oracle.truffle.r.native/fficall/src/jni/variables.c b/com.oracle.truffle.r.native/fficall/src/jni/variables.c index aaf00d68fee482eaa1fbae06c1421eb1593b189e..10fb96f8e8134669890a83683a9fe6677e5b8c38 100644 --- a/com.oracle.truffle.r.native/fficall/src/jni/variables.c +++ b/com.oracle.truffle.r.native/fficall/src/jni/variables.c @@ -65,6 +65,23 @@ CTXT FASTR_GlobalContext() { return addGlobalRef(env, res, 0); } +static const char *R_Home_local; +static void *R_NilValue_local; +static void *R_UnboundValue_local; + +char *FASTR_R_Home() { + return (char *)R_Home_local; +} + +SEXP FASTR_R_NilValue() { + return R_NilValue_local; +} + +SEXP FASTR_R_UnboundValue() { + return R_UnboundValue_local; +} + + void init_variables(JNIEnv *env, jobjectArray initialValues) { // initialValues is an array of enums jclass enumClass = (*env)->GetObjectClass(env, (*env)->GetObjectArrayElement(env, initialValues, 0)); @@ -93,7 +110,7 @@ void init_variables(JNIEnv *env, jobjectArray initialValues) { jobject value = (*env)->CallObjectMethod(env, variable, getValueMethodID); if (value != NULL) { if (strcmp(nameChars, "R_Home") == 0) { - R_Home = (*env)->GetStringUTFChars(env, value, NULL); + R_Home_local = (*env)->GetStringUTFChars(env, value, NULL); } else if (strcmp(nameChars, "R_NaN") == 0) { R_NaN = (*env)->CallDoubleMethod(env, value, doubleValueMethodID); } else if (strcmp(nameChars, "R_PosInf") == 0) { @@ -109,9 +126,9 @@ void init_variables(JNIEnv *env, jobjectArray initialValues) { if (strcmp(nameChars, "R_EmptyEnv") == 0) { R_EmptyEnv = ref; } else if (strcmp(nameChars, "R_NilValue") == 0) { - R_NilValue = ref; + R_NilValue_local = ref; } else if (strcmp(nameChars, "R_UnboundValue") == 0) { - R_UnboundValue = ref; + R_UnboundValue_local = ref; } else if (strcmp(nameChars, "R_MissingArg") == 0) { R_MissingArg = ref; } else if (strcmp(nameChars, "R_Bracket2Symbol") == 0) { diff --git a/com.oracle.truffle.r.native/fficall/src/truffle/Makefile b/com.oracle.truffle.r.native/fficall/src/truffle/Makefile new file mode 100644 index 0000000000000000000000000000000000000000..f493f5f594d809918fe148e508e6384ae39e9fcb --- /dev/null +++ b/com.oracle.truffle.r.native/fficall/src/truffle/Makefile @@ -0,0 +1,114 @@ +# +# Copyright (c) 2014, 2016, 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 compiles everything in this directory, plus all the code in ../common, +# including the code referenced in common from GnuR, with the -DFASTR_LLVM flag. +# This creates an object file with no compiled C/Fortan code, just the equivalent LLVM IR +# Since, at present, the resulting shared library (libR) must include both the real and the dummy +# object files, we have to avoid a name clash on the object file,which we achieve by appending +# "_llvm" to the name of the object file. The wrapper compilers use this name to create the +# symbol that is looked up to find the LLVM IR at runtime. + +# N.B. -g -O2 (which is the FFLAGS default from platform.mk) is currently suppressed +# due to sulong limitations + +ifneq ($(MAKECMDGOALS),clean) +include $(TOPDIR)/platform.mk +endif + +.PHONY: all clean + +include ../include/gnurheaders.mk + +# location of compiled code (.o files) +OBJ = ../../lib + +GNUR_APPL_C_FILES = pretty.c interv.c +GNUR_APPL_SRC = $(GNUR_HOME)/src/appl +GNUR_APPL_F_FILES := $(wildcard $(GNUR_APPL_SRC)/d*.f) + +GNUR_MAIN_C_FILES = colors.c devices.c engine.c format.c graphics.c plot.c plot3d.c plotmath.c rlocale.c sort.c +GNUR_MAIN_SRC = $(GNUR_HOME)/src/main + +GNUR_C_OBJECTS := $(addprefix $(OBJ)/, $(GNUR_APPL_C_FILES:.c=.o) $(GNUR_MAIN_C_FILES:.c=.o)) +LLVM_GNUR_C_OBJECTS := $(GNUR_C_OBJECTS:.o=_llvm.o) +#$(info LLVM_GNUR_C_OBJECTS: $(LLVM_GNUR_C_OBJECTS)) + +GNUR_F_OBJECTS := $(addprefix $(OBJ)/, $(notdir $(GNUR_APPL_F_FILES:.f=.o))) +LLVM_GNUR_F_OBJECTS := $(GNUR_F_OBJECTS:.o=_llvm.o) +#$(info LLVM_GNUR_F_OBJECTS: $(LLVM_GNUR_F_OBJECTS)) + +C_HDRS := $(wildcard *.h) + +LOCAL_C_SOURCES := $(wildcard *.c) +COMMON_C_SOURCES := $(wildcard ../common/*.c) +C_SOURCES := $(LOCAL_C_SOURCES) $(COMMON_C_SOURCES) +LOCAL_C_OBJECTS := $(addprefix $(OBJ)/, $(LOCAL_C_SOURCES:.c=.o)) +COMMON_C_OBJECTS := $(addprefix $(OBJ)/, $(notdir $(COMMON_C_SOURCES:.c=.o))) +C_OBJECTS := $(LOCAL_C_OBJECTS) $(COMMON_C_OBJECTS) +LLVM_C_OBJECTS := $(C_OBJECTS:.o=_llvm.o) +#$(info LLVM_C_OBJECTS=$(LLVM_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) + +INCLUDES := $(LOCAL_INCLUDES) $(FFI_INCLUDES) $(SULONG_INCLUDES) + +CFLAGS := $(CFLAGS) -DFASTR_LLVM +#FFLAGS := $(FFLAGS) -DFASTR_LLVM +FFLAGS := -DFASTR_LLVM + +# uncomment to see exactly where headers are being read from +#CFLAGS := $(CFLAGS) -H + +all: Makefile $(LLVM_C_OBJECTS) $(LLVM_GNUR_COBJECTS) $(LLVM_GNUR_F_OBJECTS) + +$(C_OBJECTS): | $(OBJ) + +$(GNUR_C_OBJECTS): | $(OBJ) + +$(GNUR_F_OBJECTS): | $(OBJ) + +$(OBJ): + mkdir -p $(OBJ) + +$(OBJ)/%_llvm.o: $(GNUR_APPL_SRC)/%.c + $(CC) $(CFLAGS) $(INCLUDES) $(GNUR_HEADER_DEFS) $(SUPPRESS_WARNINGS) -c $< -o $@ + +$(OBJ)/%_llvm.o: $(GNUR_MAIN_SRC)/%.c + $(CC) $(CFLAGS) $(INCLUDES) $(GNUR_HEADER_DEFS) $(SUPPRESS_WARNINGS) -c $< -o $@ + +$(OBJ)/%_llvm.o: %.c $(FASTR_NATIVE_DIR)/include/Rinternals.h rffiutils.h + $(CC) $(CFLAGS) $(INCLUDES) $(GNUR_HEADER_DEFS) -I../variable_defs $(SUPPRESS_WARNINGS) -c $< -o $@ + +$(OBJ)/%_llvm.o: ../common/%.c $(FASTR_NATIVE_DIR)/include/Rinternals.h + $(CC) $(CFLAGS) $(INCLUDES) $(GNUR_HEADER_DEFS) $(SUPPRESS_WARNINGS) -c $< -o $@ + +$(OBJ)/%_llvm.o: $(GNUR_APPL_SRC)/%.f + $(F77) $(FFLAGS) $(FPICFLAGS) -c $< -o $@ + +clean: + rm -rf $(OBJ) diff --git a/com.oracle.truffle.r.native/fficall/src/truffle/README.md b/com.oracle.truffle.r.native/fficall/src/truffle/README.md new file mode 100644 index 0000000000000000000000000000000000000000..8ed7f6488940a668caaa87bc059f8e7c9f9fc579 --- /dev/null +++ b/com.oracle.truffle.r.native/fficall/src/truffle/README.md @@ -0,0 +1,2 @@ +The C code in this directory is never compiled by the standard C compiler to create compiled object code. +It is compiled solely to create LLVM IR which is interpreted at runtime. This is controlled by the -DFASTR_LLVM "compiler" flag. diff --git a/com.oracle.truffle.r.native/fficall/src/truffle/Rdynload_fastr.c b/com.oracle.truffle.r.native/fficall/src/truffle/Rdynload_fastr.c new file mode 100644 index 0000000000000000000000000000000000000000..45eef643d9a124db2d32f59496e422faaf3387a7 --- /dev/null +++ b/com.oracle.truffle.r.native/fficall/src/truffle/Rdynload_fastr.c @@ -0,0 +1,122 @@ +/* + * This material is distributed under the GNU General Public License + * Version 2. You may review the terms of this license at + * http://www.gnu.org/licenses/gpl-2.0.html + * + * Copyright (c) 1995-2012, The R Core Team + * Copyright (c) 2003, The R Foundation + * Copyright (c) 2014, 2016, Oracle and/or its affiliates + * + * All rights reserved. + */ + +// 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 + +#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 *PkgInit_setSymbol(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; + } + } + 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; +} + +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/Rinternals.c b/com.oracle.truffle.r.native/fficall/src/truffle/Rinternals.c new file mode 100644 index 0000000000000000000000000000000000000000..d91c866eb705a11d63e948c03a24cfe4d61949f6 --- /dev/null +++ b/com.oracle.truffle.r.native/fficall/src/truffle/Rinternals.c @@ -0,0 +1,1124 @@ +/* + * Copyright (c) 2015, 2016, 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 <truffle.h> + +// Most everything in RInternals.h + +static char *ensure_truffle_chararray(const char *x); +static char *ensure_truffle_chararray_n(const char *x, int n); + +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_allocateVector", t, len); +} + +SEXP Rf_allocArray(SEXPTYPE t, SEXP dims) { + return unimplemented("Rf_allocArray"); +} + +SEXP Rf_alloc3DArray(SEXPTYPE t, int x, int y, int z) { + return unimplemented("Rf_alloc3DArray"); +} + +SEXP Rf_allocMatrix(SEXPTYPE mode, int nrow, int ncol) { + return unimplemented("Rf_allocMatrix"); +} + +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) { + return unimplemented("Rf_cons"); +} + +void Rf_defineVar(SEXP symbol, SEXP value, SEXP rho) { + unimplemented("Rf_defineVar"); +} + +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) { + return unimplemented("Rf_getAttrib"); +} + +SEXP Rf_setAttrib(SEXP vec, SEXP name, SEXP val) { + return unimplemented("Rf_setAttrib"); +} + +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) { + return (R_xlen_t) unimplemented("Rf_any_duplicated"); +} + +SEXP Rf_duplicated(SEXP x, Rboolean y) { + return unimplemented("Rf_duplicated"); +} + +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) { + unimplemented("Rf_inherits"); + return FALSE; +} + +Rboolean Rf_isReal(SEXP x) { + return TYPEOF(x) == REALSXP; +} + +Rboolean Rf_isSymbol(SEXP x) { + return TYPEOF(x) == SYMSXP; +} + +Rboolean Rf_isComplex(SEXP x) { + return TYPEOF(x) == CPLXSXP; +} + +Rboolean Rf_isEnvironment(SEXP x) { + return TYPEOF(x) == ENVSXP; +} + +Rboolean Rf_isExpression(SEXP x) { + return TYPEOF(x) == EXPRSXP; +} + +Rboolean Rf_isLogical(SEXP x) { + return TYPEOF(x) == LGLSXP; +} + +Rboolean Rf_isObject(SEXP s) { + unimplemented("Rf_isObject"); + return FALSE; +} + +void Rf_PrintValue(SEXP x) { + unimplemented("Rf_PrintValue"); +} + +SEXP Rf_install(const char *name) { + IMPORT_CALLHELPER(); + return truffle_invoke(obj, "Rf_install", ensure_truffle_chararray(name)); +} + +SEXP Rf_installChar(SEXP charsxp) { + return unimplemented("Rf_installChar"); +} + +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; +} + +static char *ensure_truffle_chararray(const char *x) { + if (truffle_is_truffle_object(x)) { + return x; + } else { + IMPORT_CALLHELPER(); + return truffle_invoke(obj, "bytesToNativeCharArray", truffle_read_bytes(x)); + } +} + +char *ensure_truffle_chararray_n(const char *x, int n) { + if (truffle_is_truffle_object(x)) { + return x; + } else { + IMPORT_CALLHELPER(); + return truffle_invoke(obj, "bytesToNativeCharArray", 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, 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) { + unimplemented("Rf_ncols"); + return 0; +} + +int Rf_nrows(SEXP x) { + unimplemented("Rf_nrows"); + return 0; +} + + +SEXP Rf_protect(SEXP x) { + return x; +} + +void Rf_unprotect(int x) { + // TODO perhaps we can use this +} + +void R_ProtectWithIndex(SEXP x, PROTECT_INDEX *y) { + +} + +void R_Reprotect(SEXP x, PROTECT_INDEX y) { + +} + + +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. + // So we call CallRFFIHelper.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); + 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); + 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) { + return unimplemented("R_NewHashedEnv"); +} + +SEXP Rf_classgets(SEXP x, SEXP y) { + return unimplemented("Rf_classgets"); +} + +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){ + return unimplemented("GetOption1"); +} + +SEXP GetOption(SEXP tag, SEXP rho) { + return GetOption1(tag); +} + +int GetOptionCutoff(void) +{ + int w; + w = asInteger(GetOption1(install("deparse.cutoff"))); + if (w == NA_INTEGER || w <= 0) { + warning(_("invalid 'deparse.cutoff', used 60")); + w = 60; + } + return w; +} + +#define R_MIN_WIDTH_OPT 10 +#define R_MAX_WIDTH_OPT 10000 +#define R_MIN_DIGITS_OPT 0 +#define R_MAX_DIGITS_OPT 22 + +int GetOptionWidth(void) +{ + int w; + w = asInteger(GetOption1(install("width"))); + if (w < R_MIN_WIDTH_OPT || w > R_MAX_WIDTH_OPT) { + warning(_("invalid printing width, used 80")); + return 80; + } + return w; +} + +int GetOptionDigits(void) +{ + int d; + d = asInteger(GetOption1(install("digits"))); + if (d < R_MIN_DIGITS_OPT || d > R_MAX_DIGITS_OPT) { + warning(_("invalid printing digits, used 7")); + return 7; + } + return d; +} + +Rboolean Rf_GetOptionDeviceAsk(void) +{ + int ask; + ask = asLogical(GetOption1(install("device.ask.default"))); + if(ask == NA_LOGICAL) { + warning(_("invalid value for \"device.ask.default\", using FALSE")); + return FALSE; + } + return ask != 0; +} + +void Rf_gsetVar(SEXP symbol, SEXP value, SEXP rho) { + unimplemented("Rf_gsetVar"); +} + +SEXP TAG(SEXP e) { + IMPORT_CALLHELPER(); + return truffle_invoke(obj, "TAG", e); +} + +SEXP PRINTNAME(SEXP e) { + return unimplemented("PRINTNAME"); +} + +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) { + return unimplemented("CDDR"); +} + +SEXP CDDDR(SEXP e) { + unimplemented("CDDDR"); + return NULL; +} + +SEXP CADDR(SEXP e) { + unimplemented("CADDR"); + return NULL; +} + +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) { + unimplemented("SET_TAG"); +} + +SEXP SETCAR(SEXP x, SEXP y) { + return unimplemented("SETCAR"); +} + +SEXP SETCDR(SEXP x, SEXP y) { + return unimplemented("SETCDR"); +} + +SEXP SETCADR(SEXP x, SEXP y) { + unimplemented("SETCADR"); + return NULL; +} + +SEXP SETCADDR(SEXP x, SEXP y) { + unimplemented("SETCADDR"); + return NULL; +} + +SEXP SETCADDDR(SEXP x, SEXP y) { + unimplemented("SETCADDDR"); + return NULL; +} + +SEXP SETCAD4R(SEXP e, SEXP y) { + unimplemented("SETCAD4R"); + return NULL; +} + +SEXP FORMALS(SEXP x) { + return unimplemented("FORMALS"); +} + +SEXP BODY(SEXP x) { + return unimplemented("BODY"); +} + +SEXP CLOENV(SEXP x) { + return unimplemented("CLOENV"); +} + +int RDEBUG(SEXP x) { + unimplemented("RDEBUG"); + return 0; +} + +int RSTEP(SEXP x) { + unimplemented("RSTEP"); + return 0; +} + +int RTRACE(SEXP x) { + unimplemented("RTRACE"); + return 0; +} + +void SET_RDEBUG(SEXP x, int v) { + unimplemented("SET_RDEBUG"); +} + +void SET_RSTEP(SEXP x, int v) { + unimplemented("SET_RSTEP"); +} + +void SET_RTRACE(SEXP x, int v) { + unimplemented("SET_RTRACE"); +} + +void SET_FORMALS(SEXP x, SEXP v) { + unimplemented("SET_FORMALS"); +} + +void SET_BODY(SEXP x, SEXP v) { + unimplemented("SET_BODY"); +} + +void SET_CLOENV(SEXP x, SEXP v) { + unimplemented("SET_CLOENV"); +} + +SEXP SYMVALUE(SEXP x) { + return unimplemented("SYMVALUE"); +} + +SEXP INTERNAL(SEXP x) { + return unimplemented("INTERNAL"); +} + +int DDVAL(SEXP x) { + unimplemented("DDVAL"); + return 0; +} + +void SET_DDVAL(SEXP x, int v) { + unimplemented("SET_DDVAL"); +} + +void SET_SYMVALUE(SEXP x, SEXP v) { + unimplemented("SET_SYMVALUE"); +} + +void SET_INTERNAL(SEXP x, SEXP v) { + unimplemented("SET_INTERNAL"); +} + + +SEXP FRAME(SEXP x) { + return unimplemented("FRAME"); +} + +SEXP ENCLOS(SEXP x) { + return unimplemented("ENCLOS"); +} + +SEXP HASHTAB(SEXP x) { + return unimplemented("HASHTAB"); +} + +int ENVFLAGS(SEXP x) { + unimplemented("ENVFLAGS"); + return 0; +} + +void SET_ENVFLAGS(SEXP x, int v) { + unimplemented("SET_ENVFLAGS"); +} + +void SET_FRAME(SEXP x, SEXP v) { + unimplemented("SET_FRAME"); +} + +void SET_ENCLOS(SEXP x, SEXP v) { + unimplemented("SET_ENCLOS"); +} + +void SET_HASHTAB(SEXP x, SEXP v) { + unimplemented("SET_HASHTAB"); +} + + +SEXP PRCODE(SEXP x) { + return unimplemented("PRCODE"); +} + +SEXP PRENV(SEXP x) { + unimplemented("PRSEEN"); + return 0; +} + +SEXP PRVALUE(SEXP x) { + return unimplemented("PRVALUE"); +} + +int PRSEEN(SEXP x) { + return (int) unimplemented("PRSEEN"); +} + +void SET_PRSEEN(SEXP x, int v) { + unimplemented("SET_PRSEEN"); +} + +void SET_PRENV(SEXP x, SEXP v) { + unimplemented("SET_PRENV"); +} + +void SET_PRVALUE(SEXP x, SEXP v) { + unimplemented("SET_PRVALUE"); +} + +void SET_PRCODE(SEXP x, SEXP v) { + unimplemented("SET_PRCODE"); +} + +int 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; +} + +int *LOGICAL(SEXP x){ + IMPORT_CALLHELPER(); + return (int*) truffle_invoke(obj, "LOGICAL", x); +} + +int *INTEGER(SEXP x){ + IMPORT_CALLHELPER(); + return (int*) truffle_invoke(obj, "INTEGER", x); +} + + +Rbyte *RAW(SEXP x){ + IMPORT_CALLHELPER(); + return (int*) truffle_invoke(obj, "RAW", 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){ + return unimplemented("Rf_PairToVectorList"); +} + +SEXP Rf_VectorToPairList(SEXP x){ + return unimplemented("Rf_VectorToPairList"); +} + +SEXP Rf_asCharacterFactor(SEXP x){ + return unimplemented("Rf_VectorToPairList"); +} + +int Rf_asLogical(SEXP x){ + return (int) unimplemented("Rf_asLogical"); +} + +int Rf_asInteger(SEXP x) { + IMPORT_CALLHELPER(); + return truffle_invoke_i(obj, "Rf_asInteger", 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){ + return (int) unimplemented("MARK"); +} + +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){ + return unimplemented("SET_TYPEOF_FASTR"); +} + +void SET_NAMED(SEXP x, int v){ + unimplemented("SET_NAMED"); +} + +void SET_ATTRIB(SEXP x, SEXP v){ + unimplemented("SET_ATTRIB"); +} + +void DUPLICATE_ATTRIB(SEXP to, SEXP from){ + unimplemented("DUPLICATE_ATTRIB"); +} + +char *dgettext(const char *domainname, const char *msgid) { + printf("dgettext: '%s'\n", msgid); + return (char*) msgid; +} + +char *dngettext(const char *domainname, const char *msgid, const char * msgid_plural, unsigned long int n) { + printf("dngettext: singular - '%s' ; plural - '%s'\n", msgid, msgid_plural); + return (char*) (n == 1 ? msgid : msgid_plural); +} + +const char *R_CHAR(SEXP charsxp) { + IMPORT_CALLHELPER(); + return (char *)truffle_invoke(obj, "charSXPToNativeCharArray", charsxp); +} + +void *(R_DATAPTR)(SEXP x) { + unimplemented("R_DATAPTR"); + return NULL; +} + +void R_qsort_I (double *v, int *II, int i, int j) { + unimplemented("R_qsort_I"); +} + +void R_qsort_int_I(int *iv, int *II, int i, int j) { + unimplemented("R_qsort_int_I"); +} + +R_len_t R_BadLongVector(SEXP x, const char *y, int z) { + return (R_len_t) unimplemented("R_BadLongVector"); +} + +int IS_S4_OBJECT(SEXP x) { + return (int) unimplemented("IS_S4_OBJECT"); +} + +void SET_S4_OBJECT(SEXP x) { + unimplemented("SET_S4_OBJECT"); +} +void UNSET_S4_OBJECT(SEXP x) { + unimplemented("UNSET_S4_OBJECT"); +} + +Rboolean R_ToplevelExec(void (*fun)(void *), void *data) { + return (Rboolean) unimplemented("R_ToplevelExec"); +} + +SEXP R_ExecWithCleanup(SEXP (*fun)(void *), void *data, + void (*cleanfun)(void *), void *cleandata) { + return unimplemented("R_ExecWithCleanup"); +} + +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) { + return unimplemented("R_PromiseExpr"); +} + +SEXP R_ClosureExpr(SEXP x) { + return unimplemented("R_ClosureExpr"); +} + +SEXP R_forceAndCall(SEXP e, int n, SEXP rho) { + return unimplemented("R_forceAndCall"); +} + +SEXP R_MakeExternalPtr(void *p, SEXP tag, SEXP prot) { + 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) { + return unimplemented("R_ExternalPtrTag"); +} + +SEXP R_ExternalPtrProt(SEXP s) { + return unimplemented("R_ExternalPtrProt"); +} + +void R_SetExternalPtrAddr(SEXP s, void *p) { + unimplemented("R_SetExternalPtrAddr"); +} + +void R_SetExternalPtrTag(SEXP s, SEXP tag) { + unimplemented("R_SetExternalPtrTag"); +} + +void R_SetExternalPtrProt(SEXP s, SEXP p) { + unimplemented("R_SetExternalPtrProt"); +} + +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_do_slot(SEXP obj, SEXP name) { + return unimplemented("R_do_slot"); +} + +SEXP R_do_slot_assign(SEXP obj, SEXP name, SEXP value) { + return unimplemented("R_do_slot_assign"); +} + +int R_has_slot(SEXP obj, SEXP name) { + return (int) unimplemented("R_has_slot"); +} + +SEXP R_do_MAKE_CLASS(const char *what) { + return unimplemented("R_do_MAKE_CLASS"); +} + +SEXP R_getClassDef (const char *what) { + return unimplemented("R_getClassDef"); +} + +SEXP R_do_new_object(SEXP class_def) { + return unimplemented("R_do_new_object"); +} + +int R_check_class_and_super(SEXP x, const char **valid, SEXP rho) { + return (int) unimplemented("R_check_class_and_super"); +} + +int R_check_class_etc (SEXP x, const char **valid) { + return (int) unimplemented("R_check_class_etc"); +} + +SEXP R_PreserveObject(SEXP x) { + return unimplemented("R_PreserveObject"); +} + +void R_ReleaseObject(SEXP x) { + unimplemented("R_ReleaseObject"); +} + +Rboolean R_compute_identical(SEXP x, SEXP y, int flags) { + return (Rboolean) unimplemented("R_compute_identical"); +} + +void Rf_copyListMatrix(SEXP s, SEXP t, Rboolean byrow) { + unimplemented("Rf_copyListMatrix"); +} + +void Rf_copyMatrix(SEXP s, SEXP t, Rboolean byrow) { + unimplemented("Rf_copyMatrix"); +} diff --git a/com.oracle.truffle.r.native/fficall/src/truffle/caccess.c b/com.oracle.truffle.r.native/fficall/src/truffle/caccess.c new file mode 100644 index 0000000000000000000000000000000000000000..d07c61c716cf948d2b91d97027a2aa67c0e4b9cc --- /dev/null +++ b/com.oracle.truffle.r.native/fficall/src/truffle/caccess.c @@ -0,0 +1,38 @@ +/* + * Copyright (c) 2016, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ + +int caccess_read_pointer_int(int *address) { + return *address; +} + +double caccess_read_pointer_double(double *address) { + return *address; +} + +int caccess_read_array_int(int *address, int index) { + return address[index]; +} + +double caccess_read_array_double(double *address, int index) { + return address[index]; +} diff --git a/com.oracle.truffle.r.native/fficall/src/truffle/llvm_dummy.c b/com.oracle.truffle.r.native/fficall/src/truffle/llvm_dummy.c new file mode 100644 index 0000000000000000000000000000000000000000..f786ab945c7932692e6fbecf8c98b9e0b58bac95 --- /dev/null +++ b/com.oracle.truffle.r.native/fficall/src/truffle/llvm_dummy.c @@ -0,0 +1,24 @@ +/* + * Copyright (c) 2014, 2016, 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. + */ +// A dummy file that is compiled (by fastr-cc) in place of any actual .c file in this directory. +// This allows the IR for the actual .c file to be merged with the empty .o for llvm_dummy. diff --git a/com.oracle.truffle.r.native/fficall/src/truffle/llvm_dummy.f b/com.oracle.truffle.r.native/fficall/src/truffle/llvm_dummy.f new file mode 100644 index 0000000000000000000000000000000000000000..6c4e6cee29e0ca31cc15e3c1429d33061508786a --- /dev/null +++ b/com.oracle.truffle.r.native/fficall/src/truffle/llvm_dummy.f @@ -0,0 +1,24 @@ +/* + * Copyright (c) 2014, 2016, 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. + */ +// A dummy file that is compiled (by fastr-fc) in place of any actual .f file in this directory. +// This allows the IR for the actual .f file to be merged with the empty .o for llvm_dummy. diff --git a/com.oracle.truffle.r.native/fficall/src/truffle/rffiutils.c b/com.oracle.truffle.r.native/fficall/src/truffle/rffiutils.c new file mode 100644 index 0000000000000000000000000000000000000000..82a74a54059453e7fc5731fc9c429b7a8f3949c4 --- /dev/null +++ b/com.oracle.truffle.r.native/fficall/src/truffle/rffiutils.c @@ -0,0 +1,32 @@ +/* + * Copyright (c) 2016, 2016, 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> + +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; +} + diff --git a/com.oracle.truffle.r.native/fficall/src/truffle/rffiutils.h b/com.oracle.truffle.r.native/fficall/src/truffle/rffiutils.h new file mode 100644 index 0000000000000000000000000000000000000000..d4a21793b398c4e34ea2c64f83deac513ec88ba4 --- /dev/null +++ b/com.oracle.truffle.r.native/fficall/src/truffle/rffiutils.h @@ -0,0 +1,36 @@ +/* + * Copyright (c) 2015, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +#ifndef RFFIUTILS_H +#define RFFIUTILS_H + +#include <stdlib.h> +#include <string.h> +#include <limits.h> +#include <Rinternals.h> +#include <truffle.h> + +#define IMPORT_CALLHELPER() void *obj = truffle_import_cached("_fastr_rffi_callhelper") + +SEXP unimplemented(char *name); + +#endif /* RFFIUTILS_H */ diff --git a/com.oracle.truffle.r.native/fficall/src/truffle/variables.c b/com.oracle.truffle.r.native/fficall/src/truffle/variables.c new file mode 100644 index 0000000000000000000000000000000000000000..a9944e5183845b3407a18815dc52638b53caa09f --- /dev/null +++ b/com.oracle.truffle.r.native/fficall/src/truffle/variables.c @@ -0,0 +1,130 @@ +/* + * Copyright (c) 2016, 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 <variable_defs.h> + +// R_GlobalEnv et al are not a variables in FASTR as they are RContext specific +SEXP FASTR_GlobalEnv() { + IMPORT_CALLHELPER(); + return truffle_invoke(obj, "R_GlobalEnv"); +} + +SEXP FASTR_BaseEnv() { + IMPORT_CALLHELPER(); + return truffle_invoke(obj, "R_BaseEnv"); +} + +SEXP FASTR_BaseNamespace() { + IMPORT_CALLHELPER(); + return truffle_invoke(obj, "R_BaseNamespace"); +} + +SEXP FASTR_NamespaceRegistry() { + IMPORT_CALLHELPER(); + return truffle_invoke(obj, "R_NamespaceRegistry"); +} + +Rboolean FASTR_IsInteractive() { + IMPORT_CALLHELPER(); + return (Rboolean) truffle_invoke_i(obj, "isInteractive"); +} + +char *FASTR_R_Home() { + IMPORT_CALLHELPER(); + return (char *) truffle_invoke(obj, "R_Home"); +} + +SEXP FASTR_R_NilValue() { + IMPORT_CALLHELPER(); + return truffle_invoke(obj, "R_NilValue"); + +} + +SEXP FASTR_R_UnboundValue() { + IMPORT_CALLHELPER(); + return truffle_invoke(obj, "R_UnboundValue"); +} + +void Call_initvar_obj(int index, void* value) { + /* + switch (index) { + case R_Home_x: R_Home = (char *) value; break; + case R_TempDir_x: R_TempDir = value; break; + case R_NilValue_x: R_NilValue = value; break; + case R_UnboundValue_x: R_UnboundValue = value; break; + case R_MissingArg_x: R_MissingArg = value; break; + case R_Srcref_x: R_Srcref = value; break; + case R_Bracket2Symbol_x: R_Bracket2Symbol = value; break; + case R_BracketSymbol_x: R_BracketSymbol = value; break; + case R_BraceSymbol_x: R_BraceSymbol = value; break; + case R_ClassSymbol_x: R_ClassSymbol = value; break; + case R_DeviceSymbol_x: R_DeviceSymbol = value; break; + case R_DevicesSymbol_x: R_DevicesSymbol = value; break; + case R_DimNamesSymbol_x: R_DimNamesSymbol = value; break; + case R_DimSymbol_x: R_DimSymbol = value; break; + case R_DollarSymbol_x: R_DollarSymbol = value; break; + case R_DotsSymbol_x: R_DotsSymbol = value; break; + case R_DropSymbol_x: R_DropSymbol = value; break; + case R_LastvalueSymbol_x: R_LastvalueSymbol = value; break; + case R_LevelsSymbol_x: R_LevelsSymbol = value; break; + case R_ModeSymbol_x: R_ModeSymbol = value; break; + case R_NameSymbol_x: R_NameSymbol = value; break; + case R_NamesSymbol_x: R_NamesSymbol = value; break; + case R_NaRmSymbol_x: R_NaRmSymbol = value; break; + case R_PackageSymbol_x: R_PackageSymbol = value; break; + case R_QuoteSymbol_x: R_QuoteSymbol = value; break; + case R_RowNamesSymbol_x: R_RowNamesSymbol = value; break; + case R_SeedsSymbol_x: R_SeedsSymbol = value; break; + case R_SourceSymbol_x: R_SourceSymbol = value; break; + case R_TspSymbol_x: R_TspSymbol = value; break; + case R_dot_defined_x: R_dot_defined = value; break; + case R_dot_Method_x: R_dot_Method = value; break; + case R_dot_target_x: R_dot_target = value; break; + case R_SrcrefSymbol_x: R_SrcrefSymbol = value; break; + case R_SrcfileSymbol_x: R_SrcfileSymbol = value; break; + case R_NaString_x: R_NaString = value; break; + case R_NaInt_x: R_NaInt = (int) value; break; + case R_BlankString_x: R_BlankString = value; break; + case R_TrueValue_x: R_TrueValue = value; break; + case R_FalseValue_x: R_FalseValue = value; break; + case R_LogicalNAValue_x: R_LogicalNAValue = value; break; + } + */ +} + +void Call_initvar_double(int index, double value) { + switch (index) { + case R_NaN_x: R_NaN = value; break; + } +} + +void Call_initvar_int(int index, int value) { + switch (index) { + case R_NaInt_x: R_NaInt = value; break; + case R_PosInf_x: R_PosInf = value; break; + case R_NegInf_x: R_NegInf = value; break; + case R_NaReal_x: R_NaReal = value; break; + } +} + + diff --git a/com.oracle.truffle.r.native/fficall/src/variable_defs/variable_defs.h b/com.oracle.truffle.r.native/fficall/src/variable_defs/variable_defs.h index 01f2643b7dd05d124e0cfd40815233163a5ee0d1..b3c3831a5acd1392c93c3e207ebdd30ea9d16238 100644 --- a/com.oracle.truffle.r.native/fficall/src/variable_defs/variable_defs.h +++ b/com.oracle.truffle.r.native/fficall/src/variable_defs/variable_defs.h @@ -101,3 +101,54 @@ int max_contour_segments = 25000; static InputHandler BasicInputHandler = {2, -1, NULL}; InputHandler *R_InputHandlers = &BasicInputHandler; + +// ordinal numbers of the RVariables enum +#define R_Home_x 0 +#define R_TempDir_x 1 +#define R_NilValue_x 2 +#define R_UnboundValue_x 3 +#define R_MissingArg_x 4 +#define R_GlobalEnv_x 5 +#define R_EmptyEnv_x 6 +#define R_BaseEnv_x 7 +#define R_BaseNamespace_x 8 +#define R_NamespaceRegistry_x 9 +#define R_Srcref_x 10 +#define R_Bracket2Symbol_x 11 +#define R_BracketSymbol_x 12 +#define R_BraceSymbol_x 13 +#define R_ClassSymbol_x 14 +#define R_DeviceSymbol_x 15 +#define R_DevicesSymbol_x 16 +#define R_DimNamesSymbol_x 17 +#define R_DimSymbol_x 18 +#define R_DollarSymbol_x 19 +#define R_DotsSymbol_x 20 +#define R_DropSymbol_x 21 +#define R_LastvalueSymbol_x 22 +#define R_LevelsSymbol_x 23 +#define R_ModeSymbol_x 24 +#define R_NameSymbol_x 25 +#define R_NamesSymbol_x 26 +#define R_NaRmSymbol_x 27 +#define R_PackageSymbol_x 28 +#define R_QuoteSymbol_x 29 +#define R_RowNamesSymbol_x 30 +#define R_SeedsSymbol_x 31 +#define R_SourceSymbol_x 32 +#define R_TspSymbol_x 33 +#define R_dot_defined_x 34 +#define R_dot_Method_x 35 +#define R_dot_target_x 36 +#define R_SrcrefSymbol_x 37 +#define R_SrcfileSymbol_x 38 +#define R_NaString_x 39 +#define R_NaN_x 40 +#define R_PosInf_x 41 +#define R_NegInf_x 42 +#define R_NaReal_x 43 +#define R_NaInt_x 44 +#define R_BlankString_x 45 +#define R_TrueValue_x 46 +#define R_FalseValue_x 47 +#define R_LogicalNAValue_x 48 diff --git a/com.oracle.truffle.r.native/gnur/Makefile.gnur b/com.oracle.truffle.r.native/gnur/Makefile.gnur index 29c57579c3e0d2c0f96e5eca81d56583072cf3ab..4b9f8580e4a38070be7ed61503dd8c306926ca90 100644 --- a/com.oracle.truffle.r.native/gnur/Makefile.gnur +++ b/com.oracle.truffle.r.native/gnur/Makefile.gnur @@ -40,11 +40,20 @@ OSNAME := $(shell uname) +ifdef FASTR_TRUFFLE_RFFI +FC_DIR := $(abspath $(TOPDIR)/../mx.fastr/compilers) +FASTR_COMPILERS := CC=$(FC_DIR)/fastr-cc FC=$(FC_DIR)/fastr-fc F77=$(FC_DIR)/fastr-fc CXX=$(FC_DIR)/fastr-c++ CXXCPP=$(FC_DIR)/fastr-cpp OBJC=$(FC_DIR)/fastr-cc +endif + +ifndef FASTR_TRUFFLE_RFFI +# LLVM text parser and -g don't get on OPT_FLAGS := -g -O2 +OPT_FLAGS := -O2 CFLAGS := $(OPT_FLAGS) CPPFLAGS := $(OPT_FLAGS) CXXFLAGS := $(OPT_FLAGS) +endif ifeq ($(OSNAME), Linux) FORCE_PIC := true @@ -60,6 +69,7 @@ all: Makefile $(GNUR_HOME) iconv config build $(GNUR_HOME): tar xf $(TOPDIR)/../libdownloads/R-$(R_VERSION).tar.gz + # After this platform check, GNUR_CONFIG_FLAGS must be set ifeq ($(OSNAME), SunOS) # @@ -119,6 +129,9 @@ ifneq ($(PKG_LDFLAGS_OVERRIDE),) GNUR_CONFIG_FLAGS := $(GNUR_CONFIG_FLAGS) LDFLAGS=$(PKG_LDFLAGS_OVERRIDE) endif +# setup for LLVM (if enabled) +GNUR_CONFIG_FLAGS := $(GNUR_CONFIG_FLAGS) FFLAGS=-O2 $(FASTR_COMPILERS) + endif # End of platform check @@ -140,7 +153,7 @@ RECPKGS := "--without-recommended-packages" endif $(GNUR_HOME)/Makefile: - (cd $(GNUR_HOME); ./configure --with-x=no $(RECPKGS) --enable-memory-profiling $(GNUR_CONFIG_FLAGS) > gnur_configure.log 2>&1) + (cd $(GNUR_HOME); ./configure --with-x=no --with-aqua=no $(RECPKGS) --enable-memory-profiling $(GNUR_CONFIG_FLAGS) > gnur_configure.log 2>&1) build: $(GNUR_HOME)/bin/R diff --git a/com.oracle.truffle.r.native/include/ed_Rinterface_interactive b/com.oracle.truffle.r.native/include/ed_Rinterface_interactive index 48066ad11ff1bb4db62720f691a37c8be9983563..d226ba210788f9c015c03c6a495fd8c49b120d97 100644 --- a/com.oracle.truffle.r.native/include/ed_Rinterface_interactive +++ b/com.oracle.truffle.r.native/include/ed_Rinterface_interactive @@ -9,4 +9,15 @@ LibExtern Rboolean FASTR_Interactive(); a #endif . +/R_Home;/ +i +#ifdef FASTR +LibExtern char* FASTR_R_Home(); +#define R_Home FASTR_R_Home() +#else +. ++1 +a +#endif +. w Rinterface.h diff --git a/com.oracle.truffle.r.native/include/ed_Rinternals b/com.oracle.truffle.r.native/include/ed_Rinternals index c4022028d1c73d0e38c35c555af449a8030827ee..11d0c1e55752a00ed78095033e28a3e1c6f7943a 100644 --- a/com.oracle.truffle.r.native/include/ed_Rinternals +++ b/com.oracle.truffle.r.native/include/ed_Rinternals @@ -68,6 +68,28 @@ LibExtern SEXP FASTR_NamespaceRegistry(); a #endif . +/R_NilValue;/ +i +#ifdef FASTR +LibExtern SEXP FASTR_R_NilValue(); +#define R_NilValue FASTR_R_NilValue() +#else +. ++1 +a +#endif +. +/R_UnboundValue;/ +i +#ifdef FASTR +LibExtern SEXP FASTR_R_UnboundValue(); +#define R_UnboundValue FASTR_R_UnboundValue() +#else +. ++1 +a +#endif +. /R_PreserveObject/ i #ifdef FASTR diff --git a/com.oracle.truffle.r.native/library/grDevices/Makefile b/com.oracle.truffle.r.native/library/grDevices/Makefile index 9c94eef469463a28855f2c0c929dc9263f1e70a3..50e82ab7afb18c63038688fb52cea9c863fade96 100644 --- a/com.oracle.truffle.r.native/library/grDevices/Makefile +++ b/com.oracle.truffle.r.native/library/grDevices/Makefile @@ -1,5 +1,5 @@ # -# Copyright (c) 2014, 2015, Oracle and/or its affiliates. All rights reserved. +# Copyright (c) 2014, 2016, 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 @@ -41,7 +41,9 @@ GNUR_C_SOURCES := axis_scales.c chull.c colors.c devCairo.c devPS.c devPicTeX.c devices.c init.c stubs.c ifeq ($(OS_NAME), Darwin) -GNUR_C_SOURCES := $(GNUR_C_SOURCES) qdBitmap.c qdPDF.c +ifneq ($(shell grep HAVE_AQUA $(GNUR_HOME)/config.log),) + GNUR_C_SOURCES := $(GNUR_C_SOURCES) qdBitmap.c qdPDF.c +endif endif GNUR_C_OBJECTS := $(addprefix $(OBJ)/, $(GNUR_C_SOURCES:.c=.o)) diff --git a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/JavaUpCallsRFFI.java b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/JavaUpCallsRFFI.java index d51986b5013153204a5c9b511534bd21d37f4de5..77b7024330594169c34bfebe20c65f3ceaddf35f 100644 --- a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/JavaUpCallsRFFI.java +++ b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/JavaUpCallsRFFI.java @@ -135,7 +135,7 @@ public class JavaUpCallsRFFI implements UpCallsRFFI { } } - private static <T> T guaranteeInstanceOf(Object x, Class<T> clazz) { + public static <T> T guaranteeInstanceOf(Object x, Class<T> clazz) { if (x == null) { guarantee(false, "unexpected type: null instead of " + clazz.getSimpleName()); } else if (!clazz.isInstance(x)) { @@ -388,7 +388,7 @@ public class JavaUpCallsRFFI implements UpCallsRFFI { } } - private static RStringVector getClassHr(Object v) { + public static RStringVector getClassHr(Object v) { RStringVector result; if (v instanceof RAttributable) { result = ((RAttributable) v).getClassHierarchy(); diff --git a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/Load_RFFIFactory.java b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/Load_RFFIFactory.java index 003cfc0e03d5cd67a3e6fde4468a32f33eed1fb3..5450aec0a2854787bd2fcd81ca70db4366e1c6fd 100644 --- a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/Load_RFFIFactory.java +++ b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/Load_RFFIFactory.java @@ -26,18 +26,11 @@ import com.oracle.truffle.r.runtime.Utils; /** * Selects a particular subclass of {@link RFFIFactory}. Specification is based on system property - * {@value #FACTORY_CLASS_PROPERTY}. Current default is a JNR-based implementation. + * {@value #FACTORY_CLASS_PROPERTY}. Current default is a JNI-based implementation. */ public class Load_RFFIFactory { private static final String FACTORY_CLASS_PROPERTY = "fastr.ffi.factory.class"; - private static final String PACKAGE_PREFIX = "com.oracle.truffle.r.runtime.ffi."; - private static final String SUFFIX = "_RFFIFactory"; - private static final String DEFAULT_FACTORY = "jni"; - private static final String DEFAULT_FACTORY_CLASS = mapSimpleName(DEFAULT_FACTORY); - - private static String mapSimpleName(String simpleName) { - return PACKAGE_PREFIX + simpleName + "." + simpleName.toUpperCase() + SUFFIX; - } + private static final String DEFAULT_FACTORY_CLASS = "com.oracle.truffle.r.runtime.ffi.jni.JNI_RFFIFactory"; /** * Singleton instance of the factory. Typically initialized at runtime but may be initialized @@ -49,12 +42,7 @@ public class Load_RFFIFactory { if (instance == null) { String prop = System.getProperty(FACTORY_CLASS_PROPERTY); try { - if (prop != null) { - if (!prop.contains(".")) { - // simple name - prop = mapSimpleName(prop); - } - } else { + if (prop == null) { prop = DEFAULT_FACTORY_CLASS; } instance = (RFFIFactory) Class.forName(prop).newInstance(); diff --git a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jni/JNI_C.java b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jni/JNI_C.java index 2e7a4c3d7aef66bdb52e71eaafcc12f347d7858e..8ea8d72d97fd793667d4d0ea8831cb275a74c804 100644 --- a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jni/JNI_C.java +++ b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jni/JNI_C.java @@ -30,7 +30,7 @@ import com.oracle.truffle.r.runtime.ffi.CRFFI; import com.oracle.truffle.r.runtime.ffi.NativeCallInfo; public class JNI_C implements CRFFI { - private static class JNI_CRFFINode extends CRFFINode { + public static class JNI_CRFFINode extends CRFFINode { /** * This is rather similar to {@link JNI_Call}, except the objects are guaranteed to be * native array types, no upcalls are possible, and no result is returned. However, the diff --git a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/truffle/LLVM_IR.java b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/truffle/LLVM_IR.java new file mode 100644 index 0000000000000000000000000000000000000000..804ccd512c35c5bd479666a18a381b25a47a94fb --- /dev/null +++ b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/truffle/LLVM_IR.java @@ -0,0 +1,97 @@ +/* + * Copyright (c) 2016, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.runtime.ffi.truffle; + +import java.io.IOException; +import java.util.Base64; + +import com.oracle.truffle.r.runtime.RInternalError; + +public abstract class LLVM_IR { + public static final int TEXT_CODE = 1; + public static final int BINARY_CODE = 2; + + /** + * The name of the "module", aka object file, that the IR pertains to. + */ + public final String name; + /** + * List of exported symbols. + */ + public final String[] exports; + /** + * List of imported symbols. + */ + public final String[] imports; + + protected LLVM_IR(String name, String[] exports, String[] imports) { + this.name = name; + this.exports = exports; + this.imports = imports; + } + + @Override + public String toString() { + return name; + } + + /** + * Denotes textual LLVM IR. + */ + public static final class Text extends LLVM_IR { + public final String text; + + public Text(String name, String text, String[] exports, String[] imports) { + super(name, exports, imports); + this.text = text; + } + } + + /** + * Denotes binary LLVM IR. + */ + public static final class Binary extends LLVM_IR { + public final byte[] binary; + public final String base64; + + public Binary(String name, byte[] binary, String[] exports, String[] imports) { + super(name, exports, imports); + this.binary = binary; + base64 = Base64.getEncoder().encodeToString(binary); + } + } + + /** + * Return an array of {@link LLVM_IR} instances contained in the library denoted by {@code path} + * . + */ + public static LLVM_IR[] getLLVMIR(String path) throws IOException { + String os = System.getProperty("os.name"); + if (os.contains("Mac OS")) { + return MachOAccess.getLLVMIR(path); + } else { + throw RInternalError.unimplemented("LLVM_IR_Access for Linux"); + } + } + +} diff --git a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/truffle/MachOAccess.java b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/truffle/MachOAccess.java new file mode 100644 index 0000000000000000000000000000000000000000..af939db7b3115319e7cd3be01c965092692e24e4 --- /dev/null +++ b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/truffle/MachOAccess.java @@ -0,0 +1,455 @@ +/* + * Copyright (c) 2016, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.runtime.ffi.truffle; + +import java.io.*; +import java.nio.*; +import java.nio.file.FileSystems; +import java.nio.file.Files; +import java.util.ArrayList; + +import com.oracle.truffle.r.runtime.RInternalError; + +/** + * (Limited) Access to Mach_O 64-bit format files. See /usr/include/mach-o/*.h for source. Note that + * a file may (unusually) contain multiple binaries for different architectures, see + * /usr/include/mach-o/fat.h. Such a file is called a universal binary file, (cf an archive file). + * + */ +@SuppressWarnings("unused") +final class MachOAccess implements AutoCloseable { + private final RandomAccessFile raf; + private final Header header; + private final LoadCommand[] loadCommands; + + private MachOAccess(RandomAccessFile raf) throws IOException { + this.raf = raf; + this.header = new Header(); + this.loadCommands = getLoadCommands(); + } + + static LLVM_IR[] getLLVMIR(String path) throws IOException { + try (MachOAccess ma = new MachOAccess(new RandomAccessFile(path, "r"))) { + return ma.getLLVMIR(); + } + } + + /** + * Return an array of {@link LLVM_IR} instances corresponding to the "modules" in the library, + * or {@code null} of there none. + */ + private LLVM_IR[] getLLVMIR() throws IOException { + SymTabLoadCommand symtab = null; + for (LoadCommand lc : loadCommands) { + if (lc.cmd == LC_TYPE.LC_SYMTAB) { + symtab = (SymTabLoadCommand) lc; + break; + } + } + assert symtab != null; + ArrayList<LLVM_IR> list = new ArrayList<>(); + NList64[] syms = symtab.getSymbolTable(); + for (NList64 sym : syms) { + String name = symtab.getSymbolName(sym); + if (name.startsWith("__llvm_")) { + String module = name.substring(7); + getSection(loadCommands, sym.sect); + raf.seek(sym.value); + int type = raf.read(); + int len = readInt(); + byte[] buf = new byte[len]; + // exported symbols + String[] exports = readXXPorts(); + // imported symbols + String[] imports = readXXPorts(); + raf.read(buf); + LLVM_IR ir; + if (type == LLVM_IR.TEXT_CODE) { + ir = new LLVM_IR.Text(module, new String(buf), exports, imports); + } else if (type == LLVM_IR.BINARY_CODE) { + ir = new LLVM_IR.Binary(module, buf, exports, imports); + } else { + throw RInternalError.shouldNotReachHere(); + } + list.add(ir); + } + } + if (list.size() == 0) { + return null; + } else { + LLVM_IR[] result = new LLVM_IR[list.size()]; + list.toArray(result); + return result; + } + } + + String[] readXXPorts() throws IOException { + int numxxports = readInt(); + String[] xxports = new String[numxxports]; + for (int i = 0; i < numxxports; i++) { + int xxportLen = raf.read(); + byte[] xxportBuf = new byte[xxportLen]; + for (int j = 0; j < xxportLen; j++) { + xxportBuf[j] = (byte) raf.read(); + } + xxports[i] = new String(xxportBuf); + } + return xxports; + } + + @Override + public void close() throws IOException { + raf.close(); + } + + private final class Header implements Cloneable { + private static final int FAT_MAGIC = 0xcafebabe; + private final int magic; + private final int cputype; + private final int cpusubtype; + private final int filetype; + private final int ncmds; + private final int sizeofcmds; + private final int flags; + private final int reserved; + + private Header() throws IOException { + this.magic = raf.readInt(); + assert magic != FAT_MAGIC; + cputype = readInt(); + cpusubtype = readInt(); + filetype = readInt(); + ncmds = readInt(); + sizeofcmds = readInt(); + flags = readInt(); + reserved = readInt(); + } + + } + + private enum LC_TYPE { + LC_SYMTAB(0x2), + LC_THREAD(0x4), + LC_DYSYMTAB(0xb), + LC_LOAD_DYLIB(0xc), + LC_ID_DYLIB(0xd), + LC_SUB_FRAMEWORK(0x12), + LC_SEGMENT_64(0x19), + LC_UUID(0x1b), + LC_RPATH(0x1C), + LC_DYLD_INFO(0x22), + LC_VERSION_MIN_MACOSX(0x24), + LC_FUNCTION_STARTS(0x26), + LC_DATA_IN_CODE(0x29), + LC_SOURCE_VERSION(0x2A), + LC_USER(0x32); + + private int code; + + LC_TYPE(int code) { + this.code = code; + } + + static int getCode(int codeIn) { + return codeIn & ~LoadCommand.LC_REQ_DYLD; + } + + static LC_TYPE getType(int code) { + for (LC_TYPE lct : LC_TYPE.values()) { + if (code == lct.code) { + return lct; + } + } + assert false : "unknown load cmd: " + code; + return null; + } + } + + /** + * Common base class for all Mach-O load command types. + */ + private class LoadCommand { + private static final int LC_REQ_DYLD = 0x80000000; + + private long cmdFileOffset; + private final int code; + private final LC_TYPE cmd; + private final int cmdsize; + + protected LoadCommand(int index) throws IOException { + cmdFileOffset = raf.getFilePointer(); + this.code = readInt(); + this.cmd = LC_TYPE.getType(LC_TYPE.getCode(this.code)); + this.cmdsize = readInt(); + } + + protected LoadCommand(int index, LC_TYPE cmd, int cmdsize) { + this.cmd = cmd; + this.code = cmd.code; + this.cmdsize = cmdsize; + } + + private String typeName() { + return cmd.name(); + } + } + + /** + * Reads a load command structure starting at the current file position, invoking the + * appropriate subclass {@code read} command, based on the {@code cmd} field. Leaves the file + * pointer at the next load command (if any). + * + * @return instance of the appropriate subclass for discovered command type + * @throws IOException + */ + private LoadCommand readNextLoadCommand(int index) throws IOException { + LoadCommand result = null; + final long ptr = raf.getFilePointer(); + final LC_TYPE cmd = LC_TYPE.getType(LC_TYPE.getCode(readInt())); + final int cmdsize = readInt(); + /* The LoadCommand class reads the two prior fields again. */ + raf.seek(ptr); + switch (cmd) { + case LC_SEGMENT_64: + result = new Segment64LoadCommand(index); + break; + case LC_SYMTAB: + result = new SymTabLoadCommand(index); + break; + default: + result = new LoadCommand(index); + break; + } + // skip over entire command + raf.seek(ptr + cmdsize); + return result; + } + + private LoadCommand[] getLoadCommands() throws IOException { + LoadCommand[] result = new LoadCommand[header.ncmds]; + for (int i = 0; i < header.ncmds; i++) { + result[i] = readNextLoadCommand(i); + } + return result; + } + + private final class Segment64LoadCommand extends LoadCommand { + private final String segName; + private final long vmaddr; + private final long vmsize; + private final long fileoff; + private final long filesize; + private final int maxprot; + private final int initprot; + private final int nsects; + private final int flags; + private final Section64[] sections; + + private Segment64LoadCommand(int index) throws IOException { + super(index); + final byte[] segname = new byte[16]; + for (int i = 0; i < 16; i++) { + segname[i] = raf.readByte(); + } + segName = new String(segname); + vmaddr = readLong(); + vmsize = readLong(); + fileoff = readLong(); + filesize = readLong(); + maxprot = readInt(); + initprot = readInt(); + nsects = readInt(); + flags = readInt(); + sections = new Section64[nsects]; + for (int i = 0; i < nsects; i++) { + sections[i] = new Section64(this); + } + } + + } + + private final class Section64 { + private final String sectname; + private final String segname; + private final long addr; + private final long size; + private final int offset; + private final int align; + private final int reloff; + private final int nreloc; + private final int flags; + private final int reserved1; + private final int reserved2; + private final int reserved3; + + private Section64(Segment64LoadCommand segment64) throws IOException { + sectname = readName(); + segname = readName(); + addr = readLong(); + size = readLong(); + offset = readInt(); + align = readInt(); + reloff = readInt(); + nreloc = readInt(); + flags = readInt(); + reserved1 = readInt(); + reserved2 = readInt(); + reserved3 = readInt(); + } + + private String readName() throws IOException { + byte[] nameBytes = new byte[16]; + int length = 0; + for (int i = 0; i < nameBytes.length; i++) { + nameBytes[i] = raf.readByte(); + if (nameBytes[i] != 0) { + length++; + } + } + return new String(nameBytes, 0, length); + } + + private boolean isText() { + return segname.equals("__TEXT"); + } + } + + private class SymTabLoadCommand extends LoadCommand { + private final int symoff; + private final int nsyms; + private final int stroff; + private final int strsize; + /** + * Lazily created string table. + */ + private byte[] stringTable; + /** + * Lazily created symbol table. + */ + private NList64[] symbolTable; + + SymTabLoadCommand(int index) throws IOException { + super(index); + symoff = readInt(); + nsyms = readInt(); + stroff = readInt(); + strsize = readInt(); + } + + private NList64[] getSymbolTable() throws IOException { + if (symbolTable != null) { + return symbolTable; + } + stringTable = new byte[strsize]; + raf.seek(stroff); + for (int i = 0; i < strsize; i++) { + stringTable[i] = raf.readByte(); + } + symbolTable = new NList64[nsyms]; + raf.seek(symoff); + for (int i = 0; i < nsyms; i++) { + symbolTable[i] = new NList64(); + } + return symbolTable; + } + + private String getSymbolName(NList64 nlist64) { + String symbol = ""; + if (nlist64.strx != 0) { + byte sb = stringTable[nlist64.strx]; + int sl = 0; + while (sb != 0) { + sb = stringTable[nlist64.strx + sl]; + sl++; + } + if (sl > 0) { + symbol = new String(stringTable, nlist64.strx, sl - 1); + } + } + return symbol; + } + + } + + private class NList64 { + private final int strx; + private final byte type; + private final byte sect; + private final short desc; + private final long value; + + NList64() throws IOException { + strx = readInt(); + type = raf.readByte(); + sect = raf.readByte(); + desc = readShort(); + value = readLong(); + } + + void print() { + + } + } + + /** + * Locates a given section within a given array of load commands. Sections are numbered from 1 + * as they occur within SEGMENT_64 commands. + * + * @param loadCommands + * @param sectToFind + */ + private static Section64 getSection(LoadCommand[] loadCommands, int sectToFind) { + int sect = 1; + for (int i = 0; i < loadCommands.length; i++) { + if (loadCommands[i].cmd == LC_TYPE.LC_SEGMENT_64) { + Segment64LoadCommand slc = (Segment64LoadCommand) loadCommands[i]; + if (sectToFind < sect + slc.nsects) { + return slc.sections[sectToFind - sect]; + } + sect += slc.nsects; + } + } + return null; + } + + private short readShort() throws IOException { + final int b1 = raf.read(); + final int b2 = raf.read(); + return (short) (((b2 << 8) | b1) & 0xFFFF); + } + + private int readInt() throws IOException { + final int b1 = raf.read(); + final int b2 = raf.read(); + final int b3 = raf.read(); + final int b4 = raf.read(); + return (b4 << 24) | (b3 << 16) | (b2 << 8) | b1; + } + + private long readLong() throws IOException { + final long lw = readInt(); + final long hw = readInt(); + return hw << 32 | (lw & 0xFFFFFFFFL); + } + +} diff --git a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/truffle/TruffleRFFIFrameHelper.java b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/truffle/TruffleRFFIFrameHelper.java new file mode 100644 index 0000000000000000000000000000000000000000..6b892a78508eb4b640a63e20b5836ba5136b4718 --- /dev/null +++ b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/truffle/TruffleRFFIFrameHelper.java @@ -0,0 +1,33 @@ +/* + * Copyright (c) 2014, 2016, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 2 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 2 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 2 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.runtime.ffi.truffle; + +import com.oracle.truffle.api.frame.VirtualFrame; +import com.oracle.truffle.r.runtime.SubstituteVirtualFrame; +import com.oracle.truffle.r.runtime.Utils; + +public class TruffleRFFIFrameHelper { + public static VirtualFrame create() { + return SubstituteVirtualFrame.create(Utils.getActualCurrentFrame().materialize()); + } +} diff --git a/com.oracle.truffle.r.test.native/urand/Makefile b/com.oracle.truffle.r.test.native/urand/Makefile index 4883c2383ea1d865cf9602546081a0ac6d4751b9..1dc8f430e262e9e052f97a98fbc7c35263b9e711 100644 --- a/com.oracle.truffle.r.test.native/urand/Makefile +++ b/com.oracle.truffle.r.test.native/urand/Makefile @@ -38,7 +38,7 @@ SRC = src C_SOURCES := $(wildcard $(SRC)/*.c) # Since this library is loaded explicitly we keep a consistent # extension so that the test script is portable for TestExpectedOutput -C_LIBNAME := lib$(subst $(SRC)/,,$(C_SOURCES:.c=.so)) +C_LIBNAME := liburand.so C_OBJECTS := $(subst $(SRC),$(OBJ),$(C_SOURCES:.c=.o)) C_LIB := $(OBJ)/$(C_LIBNAME) diff --git a/com.oracle.truffle.r.test.native/urand/src/nrand.c b/com.oracle.truffle.r.test.native/urand/src/nrand.c new file mode 100644 index 0000000000000000000000000000000000000000..9fe8ab10dbbf8a68d8db13a9258f5a8a56662d43 --- /dev/null +++ b/com.oracle.truffle.r.test.native/urand/src/nrand.c @@ -0,0 +1,29 @@ +/* + * This material is distributed under the GNU General Public License + * Version 2. You may review the terms of this license at + * http://www.gnu.org/licenses/gpl-2.0.html + * + * Copyright (c) 1995-2012, The R Core Team + * Copyright (c) 2003, The R Foundation + * Copyright (c) 2016, Oracle and/or its affiliates + * + * All rights reserved. + */ +#include <R_ext/Random.h> + +/* ratio-of-uniforms for normal */ +#include <math.h> +static double x; + +double * user_norm_rand() +{ + double u, v, z; + do { + u = unif_rand(); + v = 0.857764 * (2. * unif_rand() - 1); + x = v/u; z = 0.25 * x * x; + if (z < 1. - u) break; + if (z > 0.259/u + 0.35) continue; + } while (z > -log(u)); + return &x; +} diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/tools/ShowLLVMIR.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/tools/ShowLLVMIR.java new file mode 100644 index 0000000000000000000000000000000000000000..bc21326e8681db7c6d2f512e8a1d739b6c6238d7 --- /dev/null +++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/tools/ShowLLVMIR.java @@ -0,0 +1,132 @@ +/* + * Copyright (c) 2014, 2016, 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.test.tools; + +import java.io.IOException; +import java.io.InputStream; +import java.io.OutputStream; +import com.oracle.truffle.r.runtime.ProcessOutputManager; +import com.oracle.truffle.r.runtime.ffi.truffle.LLVM_IR; + +public class ShowLLVMIR { + public static void main(String[] args) { + String objPath = null; + String llpart = null; + boolean list = false; + boolean xxports = false; + boolean dis = false; + int i = 0; + while (i < args.length) { + String arg = args[i]; + switch (arg) { + case "-o": + i++; + objPath = args[i]; + break; + case "-ll": + case "--module": + i++; + llpart = args[i]; + break; + case "--names": + case "--list": + list = true; + break; + case "--xxports": + xxports = true; + break; + case "--dis": + dis = true; + break; + + } + i++; + } + if (objPath == null) { + usage(); + } + try { + LLVM_IR[] irs = LLVM_IR.getLLVMIR(objPath); + if (irs == null) { + System.out.printf("no llvm ir in %s\n", objPath); + System.exit(1); + } + for (LLVM_IR ir : irs) { + if (list) { + System.out.println(ir.name); + } else { + if (llpart == null || ir.name.equals(llpart)) { + System.out.printf("Module: %s%n", ir.name); + if (xxports) { + System.out.println("Exports"); + System.out.println("======="); + for (String export : ir.exports) { + System.out.println(export); + } + System.out.println("Imports"); + System.out.println("======="); + for (String importx : ir.imports) { + System.out.println(importx); + } + } + if (dis) { + String text = null; + if (ir instanceof LLVM_IR.Binary) { + LLVM_IR.Binary irb = (LLVM_IR.Binary) ir; + try { + ProcessBuilder pb = new ProcessBuilder("llvm-dis"); + Process p = pb.start(); + InputStream os = p.getInputStream(); + OutputStream is = p.getOutputStream(); + ProcessOutputManager.OutputThreadVariable readThread = new ProcessOutputManager.OutputThreadVariable("llvm-dis", os); + readThread.start(); + is.write(irb.binary); + is.close(); + @SuppressWarnings("unused") + int rc = p.waitFor(); + text = new String(readThread.getData(), 0, readThread.getTotalRead()); + } catch (IOException ex) { + System.err.println(ex); + System.exit(2); + } + } else { + LLVM_IR.Text tir = (LLVM_IR.Text) ir; + text = tir.text; + } + System.out.println(text); + } + } + } + } + } catch (Exception e) { + System.err.println(e); + } + + } + + private static void usage() { + System.err.print("usage: -o objfile"); + System.exit(1); + } + +} diff --git a/documentation/dev/ffi.md b/documentation/dev/ffi.md index 1bfb317291076eaee2c1f084bdacce01ddc24c5e..0be78c5bacccd8fc4563b4da07e17bf5c9c1c6a3 100644 --- a/documentation/dev/ffi.md +++ b/documentation/dev/ffi.md @@ -2,7 +2,7 @@ # Introduction The implementation of the [R FFI](https://cran.r-project.org/doc/manuals/r-release/R-exts.html) is contained in the `fficall` directory of -the `com.oracle/truffle.r.native` project`. It`s actually a bit more than that as it also contains code copied from GNU R, for example that supports graphics or is sufficiently +the `com.oracle/truffle.r.native` project`. It's actually a bit more than that as it also contains code copied from GNU R, for example that supports graphics or is sufficiently simple that it is neither necessary nor desirable to implement in Java. As this has evolved a better name for `fficall` would probably be `main` for compatibility with GNU R. @@ -11,6 +11,7 @@ for compatibility with GNU R. * `common` * `variable_defs` * `jni` + * `truffle` ## The `fficall/include` directory @@ -48,4 +49,6 @@ dependent. In order to support a JNI and a non-JNI implementation, the file is s ## The `jni` directory `jni` contains the implementation that is based on and has explicit dependencies on Java JNI. It is described in more detail [here](jni_ffi.md) +## The `truffle` directory +`truffle` contains the native side of the variant that is based on the Truffle LLVM implementation. It is described in more detail [here](truffle_ffi.md) \ No newline at end of file diff --git a/documentation/dev/truffle_ffi.md b/documentation/dev/truffle_ffi.md new file mode 100644 index 0000000000000000000000000000000000000000..8eb7fd13ca344734107b2a70c0e9a4a9ce37aae1 --- /dev/null +++ b/documentation/dev/truffle_ffi.md @@ -0,0 +1,63 @@ +# Introduction + +The Truffle implementation of the R FFI is based on the Truffle implementation of LLVM intermediate code, named [Sulong](https://github.com/graalvm/sulong). + + +# Building +Special setup is required to build FastR to use the Truffle R FFI implementation. + +## Building Sulong +The `sulong` repository must be cloned to a sibling directory of `fastr` and built: + + cd $FASTR_HOME + git clone https://github.com/graalvm/sulong.git + cd sulong + mx build + mx su-pulldragonegg + +The `mx build` step will clone the `graal-core` repository, if necessary, and build that also. The `mx su-pulldragonegg` step is required to be able to compile Fortran code to LLVM, which is required by FastR. + +## Additional Pre-Requisites + +The DragonEgg plugin requires that `gcc 4.6` and `gfortran 4.6` be available. On Mac OS, these can be installed with MacPorts (recommended) or Brew. Having installed these, set the following environment variables: + + export SULONG_GPP=/opt/local/bin/g++-mp-4.6 + export SULONG_GFORTRAN=/opt/local/bin/gfortran-mp-4.6 + export SULONG_GCC=/opt/local/bin/gcc-mp-4.6 + +The above definitions assume a MacPorts installation. + +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_TRUFFLE_RFFI=true + +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. + +## Running + +There is no compile-time dependency between FastR and Sulong; all communication is via the Truffle Interop API. Therefore Sulong must be dynamically imported using either `mx --dynamicimport sulong` or by setting the environment variable `DEFAULT_DYNAMIC_IMPORTS=sulong`, with latter being most convenient. With this in effect, a normal `mx R` will make SuLong available. In particular, the factory class that controls which FFI implementation is in used is chosen based on whether Sulong is available. + +Even then, by default, the Truffle FFI implementation is not enabled and the system defaults to the normal JNI RFFI implementation, in order to support an +incremental approach to enabling native code for LLVM implementation. To enable one or more packages (strictly their associated dynamic libraries) for LLVM implementation, set the environment variable `FASTR_TRUFFLE_LIBS` to a comma-separated list of library names, e.g. `stats,testrffi`. If this variable is unset,and the Truffle RFFI factory class is enabled, a warning is given on every library open that the load is defaulting to the JNI implementation. + +At the time of writing, only the following libraries have been tested in LLVM mode: + +* `liburand`: this is not actually a package library, but a test for the user-defined random number generator feature of R. It lives in the +`com.oracle.truffle.r.test.native/urand` directory and must be loaded explicitly using `dyn.load`. See the `TestUserRNG` class for an example of how to test it. +* `testrffi`: This is the (evolving) RFFI test package that lives in `com.oracle.truffle.r.test.native/packages/testrffi`. It must first be installed by e.g, `bin/R CMD INSTALL com.oracle.truffle.r.test.native/packages/testrffi/lib/testrffi.tar`. As always this will install to the location specified by the `R_LIBS_USER` or `R_LIBS` environment variables or, if unset, the FastR `library` directory. An example test would then be to execute `library(testrffi); rffi.addDouble(2,3)` after running `mx R`. +* `stats`: Most of the native code in the GNU R `stats` package has either been rewritten in Java or temporarily disabled. However, the Fast Fourier Transform code is written in C and called through the FFI. E.g. `fft(1:4)` is a simple test. +* `digest`: This is a CRAN package that contains a significant amount of native code, relating to MD5 and SHA digest generation. The simple way to install and test this is to execute: `mx pkgtest '^digest$'`. This assumes an internet connection is available to access CRAN. + +Note that if the `LLVM_PARSE_TIME` environment variable is set to any value, the time taken to parse each LLVM module is logged to the console, which is also an indication that the LLVM implementation variant is being used. + +# Implementation Details + +## Compiler Wrapper Scripts + +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, 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. + diff --git a/mx.fastr/compilers/fastr-c++ b/mx.fastr/compilers/fastr-c++ new file mode 100755 index 0000000000000000000000000000000000000000..2d8cc481f9b9a50c0d6225a4e6b66c52525e7707 --- /dev/null +++ b/mx.fastr/compilers/fastr-c++ @@ -0,0 +1,47 @@ +# +# Copyright (c) 2016, 2016, 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. +# +#!/bin/bash + +SOURCE="${BASH_SOURCE[0]}" +while [ -h "$SOURCE" ]; do + DIR="$( cd -P "$( dirname "$SOURCE" )" && pwd )" + SOURCE="$(readlink "$SOURCE")" + [[ $SOURCE != /* ]] && SOURCE="$DIR/$SOURCE" +done +DIR="$( cd -P "$( dirname "$SOURCE" )" && pwd )" + +with_sulong=0 +while [ $DIR != "/" ] ; do + if [ -d $DIR/sulong ] && [ -d $DIR/sulong/mx.sulong ] ; then + with_sulong=1 + break + fi + DIR=`dirname $DIR` +done + +if [ $with_sulong = 1 ] && [ "$FASTR_SULONG_IGNORE" = "" ] ; then + mx --dynamicimport sulong fastr-c++ $@ +else + g++ $@ +fi + diff --git a/mx.fastr/compilers/fastr-cc b/mx.fastr/compilers/fastr-cc new file mode 100755 index 0000000000000000000000000000000000000000..ff05a0f750e2aea46665b44880480462d2d443c0 --- /dev/null +++ b/mx.fastr/compilers/fastr-cc @@ -0,0 +1,47 @@ +# +# Copyright (c) 2016, 2016, 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. +# +#!/bin/bash + +SOURCE="${BASH_SOURCE[0]}" +while [ -h "$SOURCE" ]; do + DIR="$( cd -P "$( dirname "$SOURCE" )" && pwd )" + SOURCE="$(readlink "$SOURCE")" + [[ $SOURCE != /* ]] && SOURCE="$DIR/$SOURCE" +done +DIR="$( cd -P "$( dirname "$SOURCE" )" && pwd )" + +with_sulong=0 +while [ $DIR != "/" ] ; do + if [ -d $DIR/sulong ] && [ -d $DIR/sulong/mx.sulong ] ; then + with_sulong=1 + break + fi + DIR=`dirname $DIR` +done + +if [ $with_sulong = 1 ] && [ "$FASTR_SULONG_IGNORE" = "" ] ; then + mx --dynamicimport sulong fastr-cc $@ +else + gcc $@ +fi + diff --git a/mx.fastr/compilers/fastr-cpp b/mx.fastr/compilers/fastr-cpp new file mode 100755 index 0000000000000000000000000000000000000000..5e5a24e6cc91d91f5ca7c67efcfb65904417366e --- /dev/null +++ b/mx.fastr/compilers/fastr-cpp @@ -0,0 +1,46 @@ +# +# Copyright (c) 2016, 2016, 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. +# +#!/bin/bash + +SOURCE="${BASH_SOURCE[0]}" +while [ -h "$SOURCE" ]; do + DIR="$( cd -P "$( dirname "$SOURCE" )" && pwd )" + SOURCE="$(readlink "$SOURCE")" + [[ $SOURCE != /* ]] && SOURCE="$DIR/$SOURCE" +done +DIR="$( cd -P "$( dirname "$SOURCE" )" && pwd )" + +with_sulong=0 +while [ $DIR != "/" ] ; do + if [ -d $DIR/sulong ] && [ -d $DIR/sulong/mx.sulong ] ; then + with_sulong=1 + break + fi + DIR=`dirname $DIR` +done + +if [ $with_sulong = 1 ] && [ "$FASTR_SULONG_IGNORE" = "" ] ; then + mx --dynamicimport sulong fastr-cpp $@ +else + cpp $@ +fi diff --git a/mx.fastr/compilers/fastr-fc b/mx.fastr/compilers/fastr-fc new file mode 100755 index 0000000000000000000000000000000000000000..e5f506854e54513bd3dacbe95f94690dfd99fce3 --- /dev/null +++ b/mx.fastr/compilers/fastr-fc @@ -0,0 +1,47 @@ +# +# Copyright (c) 2016, 2016, 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. +# +#!/bin/bash + +SOURCE="${BASH_SOURCE[0]}" +while [ -h "$SOURCE" ]; do + DIR="$( cd -P "$( dirname "$SOURCE" )" && pwd )" + SOURCE="$(readlink "$SOURCE")" + [[ $SOURCE != /* ]] && SOURCE="$DIR/$SOURCE" +done +DIR="$( cd -P "$( dirname "$SOURCE" )" && pwd )" + +with_sulong=0 +while [ $DIR != "/" ] ; do + if [ -d $DIR/sulong ] && [ -d $DIR/sulong/mx.sulong ] ; then + with_sulong=1 + break + fi + DIR=`dirname $DIR` +done + +if [ $with_sulong = 1 ] && [ "$FASTR_SULONG_IGNORE" = "" ] ; then + mx --dynamicimport sulong fastr-fc $@ +else + gfortran $@ +fi + diff --git a/mx.fastr/compilers/have_sulong b/mx.fastr/compilers/have_sulong new file mode 100755 index 0000000000000000000000000000000000000000..a650e87c518dd7362aaf94bb3ae25ab69aad2bd0 --- /dev/null +++ b/mx.fastr/compilers/have_sulong @@ -0,0 +1,46 @@ +# +# Copyright (c) 2016, 2016, 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. +# +#!/bin/bash + +SOURCE="${BASH_SOURCE[0]}" +while [ -h "$SOURCE" ]; do # resolve $SOURCE until the file is no longer a symlink + DIR="$( cd -P "$( dirname "$SOURCE" )" && pwd )" + SOURCE="$(readlink "$SOURCE")" + [[ $SOURCE != /* ]] && SOURCE="$DIR/$SOURCE" # if $SOURCE was a relative symlink, we need to resolve it relative to the path where the symlink file was located +done +DIR="$( cd -P "$( dirname "$SOURCE" )" && pwd )" + +with_sulong=0 +while [ $DIR != "/" ] ; do + if [ -d $DIR/sulong ] && [ -d $DIR/sulong/mx.sulong ] ; then + with_sulong=1 + break + fi + DIR=`dirname $DIR` +done + +if [ $with_sulong = 1 ] && [ "$FASTR_SULONG_IGNORE" = "" ] ; then + echo "yes" +else + echo "no" +fi diff --git a/mx.fastr/copyrights/overrides b/mx.fastr/copyrights/overrides index 0467373d319614885a7468b7ad3c4ddd3c190853..04187d4474c73ddfd6f471ebf8fb96da44252695 100644 --- a/mx.fastr/copyrights/overrides +++ b/mx.fastr/copyrights/overrides @@ -110,6 +110,7 @@ com.oracle.truffle.r.native/fficall/src/variable_defs/variable_defs.h,gnu_r.copy com.oracle.truffle.r.native/fficall/src/jni/Memory.c,gnu_r.copyright com.oracle.truffle.r.native/fficall/src/jni/pcre_rffi.c,gnu_r_gentleman_ihaka2.copyright com.oracle.truffle.r.native/fficall/src/jni/Rdynload_fastr.c,gnu_r.copyright +com.oracle.truffle.r.native/fficall/src/truffle/Rdynload_fastr.c,gnu_r.copyright com.oracle.truffle.r.native/fficall/src/jni/Rembedded.c,gnu_r.copyright com.oracle.truffle.r.native/include/src/libintl.h,no.copyright com.oracle.truffle.r.native/library/base/src/registration.c,no.copyright @@ -242,6 +243,7 @@ com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RRuntime.java,gnu_ com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RSerialize.java,gnu_r.copyright com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RType.java,gnu_r.copyright com.oracle.truffle.r.test.native/urand/src/urand.c,gnu_r.copyright +com.oracle.truffle.r.test.native/urand/src/nrand.c,gnu_r.copyright com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_abbreviate.java,purdue.copyright com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_abs.java,purdue.copyright com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_acos.java,purdue.copyright diff --git a/mx.fastr/mx_fastr.py b/mx.fastr/mx_fastr.py index 6815ab54d6de730e1afd12291a18fd8c4ddde57f..ceb60cfc4e9cc5d0762a9ce96540781d77bad0aa 100644 --- a/mx.fastr/mx_fastr.py +++ b/mx.fastr/mx_fastr.py @@ -26,6 +26,7 @@ from argparse import ArgumentParser import mx import mx_gate import mx_fastr_pkgs +import mx_fastr_compile import mx_fastr_dists import mx_fastr_junit from mx_fastr_dists import FastRNativeProject, FastRTestNativeProject, FastRReleaseProject, FastRNativeRecommendedProject #pylint: disable=unused-import @@ -47,6 +48,7 @@ _fastr_suite = mx.suite('fastr') If this is None, then we run under the standard VM in interpreted mode only. ''' _mx_graal = mx.suite("graal-core", fatalIfMissing=False) +_mx_sulong = mx.suite("sulong", fatalIfMissing=False) _r_command_package = 'com.oracle.truffle.r.engine' _repl_command = 'com.oracle.truffle.tools.debug.shell.client.SimpleREPLClient' @@ -91,9 +93,14 @@ def do_run_r(args, command, extraVmArgs=None, jdk=None, **kwargs): if not jdk: jdk = get_default_jdk() - vmArgs = mx.get_runtime_jvm_args('FASTR', jdk=jdk) + dists = ['FASTR'] + if _mx_sulong: + dists.append('SULONG') + + vmArgs = mx.get_runtime_jvm_args(dists, jdk=jdk) vmArgs += set_graal_options() + vmArgs += _sulong_options() if extraVmArgs is None or not '-da' in extraVmArgs: # unless explicitly disabled we enable assertion checking @@ -142,6 +149,13 @@ def set_graal_options(): else: return [] +def _sulong_options(): + if _mx_sulong: + return ['-Dfastr.ffi.factory.class=com.oracle.truffle.r.engine.interop.ffi.Truffle_RFFIFactory', + '-XX:-UseJVMCIClassLoader'] + else: + return [] + def _get_ldpaths(env, lib_env_name): ldpaths = os.path.join(env['R_HOME'], 'etc', 'ldpaths') command = ['bash', '-c', 'source ' + ldpaths + ' && env'] @@ -347,6 +361,7 @@ def _junit_r_harness(args, vmArgs, jdk, junitArgs): vmArgs += ['-Xss12m'] # no point in printing errors to file when running tests (that contain errors on purpose) vmArgs += ['-DR:-PrintErrorStacktracesToFile'] + vmArgs += _sulong_options() setREnvironment() @@ -586,4 +601,5 @@ _commands = { 'nativebuild' : [nativebuild, '[]'], } +_commands.update(mx_fastr_compile._commands) mx.update_commands(_fastr_suite, _commands) diff --git a/mx.fastr/mx_fastr_compile.py b/mx.fastr/mx_fastr_compile.py new file mode 100644 index 0000000000000000000000000000000000000000..701f3c2a5f7689543111444151572e3865128520 --- /dev/null +++ b/mx.fastr/mx_fastr_compile.py @@ -0,0 +1,343 @@ +# +# Copyright (c) 2016, 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. +# +""" +A wrapper for the C/C++/Fortran compilers that optionally handles the generation of LLVM bitcode. +When not running with sulong is simply forwards to the default compiler for the platform. +When running under sulong, it uses sulong to do two compilations; first to generate object code +and second to generate LLVM bitcode. +""" +import os, sys +import mx +import mx_fastr + +def _sulong(): + sulong = mx.suite('sulong', fatalIfMissing=False) + if sulong: + return sulong.extensions + else: + return None + +def _is_linux(): + return sys.platform.startswith('linux') + +def _is_darwin(): + return sys.platform.startswith('darwin') + +def _log(cmd, args): + if os.environ.has_key('FASTR_COMPILE_LOGFILE'): + with open(os.environ['FASTR_COMPILE_LOGFILE'], 'a') as f: + f.write(cmd) + f.write('(') + f.write(os.getcwd()) + f.write(')') + f.write(' ') + f.write(' '.join(args)) + f.write('\n') + +class AnalyzedArgs: + ''' + is_link: True iff the command is a shared library link + llvm_ir_file: the target file for the ir derived from the .o file (only set if is_link=False) + compile_args: possibly modified args for C compilation + emit_llvm_args: the args to generate the llvm ir + ''' + def __init__(self, llvm_ir_file, is_link, compile_args, emit_llvm_args): + self.llvm_ir_file = llvm_ir_file + self.is_link = is_link + self.compile_args = compile_args + self.emit_llvm_args = emit_llvm_args + + +def _c_dummy_file(): + return os.path.join(mx_fastr._fastr_suite.dir, 'com.oracle.truffle.r.native', 'fficall', 'src', 'truffle', 'llvm_dummy.c') + +def _analyze_args(args, dragonEgg=False): + ''' + Analyzes the original arguments to the compiler and returns an adjusted + list that will run the compiler (via sulong) to extract the llvm ir. + Result is an instance of AnalyzedArgs: + ''' + compile_args = [] + emit_llvm_args = [] + llvm_ir_file_ext = '.bc' + if not dragonEgg: + emit_llvm_args.append('-emit-llvm') + else: + # dragonEgg plugin doesn't seem able to make bitcode directly + emit_llvm_args.append('-S') + llvm_ir_file_ext = '.ll' + + is_link = False + llvm_ir_file = None + c_dummy = False + i = 0 + while i < len(args): + arg = args[i] + if arg == '-DFASTR_LLVM': + c_dummy = True + i = i + 1 + continue + + emit_llvm_args.append(arg) + compile_args.append(arg) + if arg == '-c': + cfile = args[i + 1] + if c_dummy: + cfile = _c_dummy_file() + compile_args.append(cfile) + emit_llvm_args.append(args[i + 1]) + i = i + 1 + + if arg == '-o': + ext = os.path.splitext(args[i + 1])[1] + is_link = ext == '.so' or ext == '.dylib' + compile_args.append(args[i + 1]) + if ext == '.o': + llvm_ir_file = os.path.splitext(args[i + 1])[0] + llvm_ir_file_ext + emit_llvm_args.append(llvm_ir_file) + i = i + 1 + + i = i + 1 + _log('adjusted-compile-args', compile_args) + _log('emit-llvm-args', emit_llvm_args) + return AnalyzedArgs(llvm_ir_file, is_link, compile_args, emit_llvm_args) + +def cc(args): + _log('fastr:cc', args) + compiler = None + sulong = _sulong() + if sulong: + analyzed_args = _analyze_args(args) + if _is_linux(): + rc = sulong.compileWithGCC(analyzed_args.compile_args) + if rc == 0 and analyzed_args.llvm_ir_file: + if not analyzed_args.is_link: + rc = sulong.compileWithGCC(analyzed_args.emit_llvm_args) + elif _is_darwin(): + rc = sulong.compileWithClang(analyzed_args.compile_args) + if rc == 0 and analyzed_args.llvm_ir_file: + if not analyzed_args.is_link: + rc = sulong.compileWithClang(analyzed_args.emit_llvm_args) + else: + mx.abort('unsupported platform') + if rc == 0 and not analyzed_args.is_link and analyzed_args.llvm_ir_file: + rc = _mem2reg_opt(analyzed_args.llvm_ir_file) + if rc == 0: + rc = _embed_ir(analyzed_args.llvm_ir_file) + else: + if _is_linux(): + compiler = 'gcc' + elif _is_darwin(): + compiler = 'clang' + else: + mx.abort('unsupported platform') + + rc = mx.run([compiler] + args, nonZeroIsFatal=False) + + return rc + +def fc(args): + _log('fastr:fc', args) + compiler = None + sulong = _sulong() + if sulong: + analyzed_args = _analyze_args(args, dragonEgg=True) + rc = mx.run([sulong.getGFortran()] + analyzed_args.compile_args, nonZeroIsFatal=False) + if rc == 0: + rc = sulong.dragonEggGFortran(analyzed_args.emit_llvm_args) + if rc == 0 and analyzed_args.llvm_ir_file: + # create bitcode from textual IR + llvm_as = sulong.findLLVMProgram('llvm-as') + llvm_bc_file = os.path.splitext(analyzed_args.llvm_ir_file)[0] + '.bc' + rc = mx.run([llvm_as, analyzed_args.llvm_ir_file, '-o', llvm_bc_file]) + rc = _embed_ir(llvm_bc_file) + else: + compiler = 'gfortran' + rc = mx.run([compiler] + args, nonZeroIsFatal=False) + + return rc + +def cpp(args): + _log('fastr:c++', args) + compiler = None + sulong = _sulong() + if sulong: + analyzed_args = _analyze_args(args) + if _is_linux(): + rc = sulong.dragonEggGPP(analyzed_args.compile_args) + elif _is_darwin(): + rc = sulong.compileWithClangPP(analyzed_args.compile_args) + if rc == 0: + if analyzed_args.llvm_ir_file: + rc = sulong.compileWithClangPP(analyzed_args.emit_llvm_args) + else: + mx.abort('unsupported platform') + if rc == 0 and not analyzed_args.is_link: + rc = _embed_ir(analyzed_args.llvm_ir_file) + else: + compiler = 'g++' + rc = mx.run([compiler] + args, nonZeroIsFatal=False) + + return rc + +def cppcpp(args): + '''C++ pre-preprocessor''' + _log('fastr:cpp', args) + rc = mx.run(['cpp'] + args) + return rc + +def _mem2reg_opt(llvm_ir_file): + filename = os.path.splitext(llvm_ir_file)[0] + ext = os.path.splitext(llvm_ir_file)[1] + opt_filename = filename + '.opt' + ext + rc = _sulong().opt(['-mem2reg', llvm_ir_file, '-o', opt_filename]) + if rc == 0: + os.rename(opt_filename, llvm_ir_file) + return rc + +def _embed_ir(llvm_ir_file): + ''' + Given an llvm_ir_file, generates an assembler file containing the content as a sequence + of .byte directives, then uses ld to merge that with the original .o file, replacing + the original .o file. + ''' + + def write_hexbyte(f, b): + f.write("0x%0.2X" % b) + + def write_int(f, n): + write_hexbyte(f, n & 255) + f.write(',') + write_hexbyte(f, (n >> 8) & 255) + f.write(',') + write_hexbyte(f, (n >> 16) & 255) + f.write(',') + write_hexbyte(f, (n >> 24) & 255) + + def write_symbol(f, sym): + write_dot_byte(f) + write_hexbyte(f, len(sym)) + f.write(', ') + first = True + for ch in sym: + if first: + first = False + else: + f.write(', ') + write_hexbyte(f, ord(ch)) + f.write('\n') + + def write_dot_byte(f): + f.write(' .byte ') + + def checkchars(s): + return s.replace("-", "_") + + # find the exported symbols + llvm_nm = _sulong().findLLVMProgram("llvm-nm") + + class NMOutputCapture: + def __init__(self): + self.exports = [] + self.imports = [] + + def __call__(self, data): + # T name + s = data.strip() + if s[0] == 'T': + self.exports.append(s[2:]) + elif s[0] == 'U': + self.imports.append(s[2:]) + + llvm_nm_out = NMOutputCapture() + mx.run([llvm_nm, llvm_ir_file], out=llvm_nm_out) + + with open(llvm_ir_file) as f: + content = bytearray(f.read()) + filename = os.path.splitext(llvm_ir_file)[0] + ext = os.path.splitext(llvm_ir_file)[1] + as_file = llvm_ir_file + '.s' + gsym = "__llvm_" + checkchars(os.path.basename(filename)) + with open(as_file, 'w') as f: + f.write(' .const\n') + f.write(' .globl ' + gsym + '\n') + f.write(gsym + ':\n') + count = 0 + lenc = len(content) + write_dot_byte(f) + # 1 for text, 2 for binary, followed by length + write_hexbyte(f, 1 if ext == '.ll' else 2) + f.write(',') + write_int(f, lenc) + f.write('\n') + # now the exported symbols + write_dot_byte(f) + write_int(f, len(llvm_nm_out.exports)) + f.write('\n') + for sym in llvm_nm_out.exports: + write_symbol(f, sym) + # now the imported symbols + write_dot_byte(f) + write_int(f, len(llvm_nm_out.imports)) + f.write('\n') + for sym in llvm_nm_out.imports: + write_symbol(f, sym) + # now the content + write_dot_byte(f) + first = True + for b in content: + if first: + first = False + else: + f.write(',') + write_hexbyte(f, b) + count = count + 1 + if count % 20 == 0 and count < lenc: + f.write('\n') + write_dot_byte(f) + first = True + f.write('\n') + + ll_o_file = llvm_ir_file + '.o' + rc = mx.run(['gcc', '-c', as_file, '-o', ll_o_file], nonZeroIsFatal=False) + if rc == 0: + # combine + o_file = filename + '.o' + dot_o_file = o_file + '.o' + os.rename(o_file, dot_o_file) + rc = mx.run(['ld', '-r', dot_o_file, ll_o_file, '-o', o_file], nonZeroIsFatal=False) + os.remove(dot_o_file) + os.remove(as_file) + os.remove(ll_o_file) + return rc + +def mem2reg(args): + _mem2reg_opt(args[0]) + +_commands = { + 'fastr-cc' : [cc, '[options]'], + 'fastr-fc' : [fc, '[options]'], + 'fastr-c++' : [cpp, '[options]'], + 'fastr-cpp' : [cppcpp, '[options]'], + 'mem2reg' : [mem2reg, '[options]'], +}