diff --git a/com.oracle.truffle.r.native/.project b/com.oracle.truffle.r.native/.project
new file mode 100644
index 0000000000000000000000000000000000000000..ccf79ea7325ff2514fd14773eb30d1ddf5e098fb
--- /dev/null
+++ b/com.oracle.truffle.r.native/.project
@@ -0,0 +1,11 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<projectDescription>
+ <name>com.oracle.truffle.r.native</name>
+ <comment></comment>
+ <projects>
+ </projects>
+ <buildSpec>
+ </buildSpec>
+ <natures>
+ </natures>
+</projectDescription>
diff --git a/com.oracle.truffle.r.native/Makefile b/com.oracle.truffle.r.native/Makefile
new file mode 100644
index 0000000000000000000000000000000000000000..027569e390a6149ceb183b5b97cb6cfb22005c1d
--- /dev/null
+++ b/com.oracle.truffle.r.native/Makefile
@@ -0,0 +1,28 @@
+#
+# Copyright (c) 2014, 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 placeholder to keep mx happy
+# The only native code at this stage is in the form of binary Lapack/Blas libraries copied from GnuR
+
+all:
+
+clean:
diff --git a/com.oracle.truffle.r.native/lib/darwin/libR.dylib b/com.oracle.truffle.r.native/lib/darwin/libR.dylib
new file mode 100755
index 0000000000000000000000000000000000000000..6dea2826530ec11fb3ebd03d113c7fa306b85550
Binary files /dev/null and b/com.oracle.truffle.r.native/lib/darwin/libR.dylib differ
diff --git a/com.oracle.truffle.r.native/lib/darwin/libRblas.dylib b/com.oracle.truffle.r.native/lib/darwin/libRblas.dylib
new file mode 100755
index 0000000000000000000000000000000000000000..e92c74d7adddc7cb2e693139cee8cccedd48d984
Binary files /dev/null and b/com.oracle.truffle.r.native/lib/darwin/libRblas.dylib differ
diff --git a/com.oracle.truffle.r.native/lib/darwin/libRlapack.dylib b/com.oracle.truffle.r.native/lib/darwin/libRlapack.dylib
new file mode 100755
index 0000000000000000000000000000000000000000..04fe8472bfea022feaae66f34e5caa62a63b4056
Binary files /dev/null and b/com.oracle.truffle.r.native/lib/darwin/libRlapack.dylib differ
diff --git a/com.oracle.truffle.r.native/lib/linux/libRblas.so b/com.oracle.truffle.r.native/lib/linux/libRblas.so
new file mode 100755
index 0000000000000000000000000000000000000000..ba1a484fd4be3536e491e5fe1e83972529394e4f
Binary files /dev/null and b/com.oracle.truffle.r.native/lib/linux/libRblas.so differ
diff --git a/com.oracle.truffle.r.native/lib/linux/libRlapack.so b/com.oracle.truffle.r.native/lib/linux/libRlapack.so
new file mode 100755
index 0000000000000000000000000000000000000000..d316bc5f06b4eb3ec8c587b767bd39a0f4a669c9
Binary files /dev/null and b/com.oracle.truffle.r.native/lib/linux/libRlapack.so differ
diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/REngine.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/REngine.java
index 0f524165fbaaa8f82df257eb398dbfc1748aad4d..6c3d720585a756c85e4b8f07f28b79f2cb4838ac 100644
--- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/REngine.java
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/REngine.java
@@ -75,9 +75,21 @@ public final class REngine implements RBuiltinLookupProvider {
REnvironment.initialize(globalFrame, baseFrame);
RBuiltinPackage.initialize();
RRuntime.initialize();
+ evalProfiles(globalFrame);
return globalFrame;
}
+ private static void evalProfiles(VirtualFrame globalFrame) {
+ String siteProfile = RProfile.siteProfile();
+ String userProfile = RProfile.userProfile();
+ if (siteProfile != null) {
+ REngine.parseAndEval(siteProfile, globalFrame, false);
+ }
+ if (userProfile != null) {
+ REngine.parseAndEval(userProfile, globalFrame, false);
+ }
+ }
+
/**
* Create a {@link VirtualFrame} for use in {@link #parseAndEval} for accumulating the results
* from evaluating expressions in an interactive context. Such a value cannot be stored in an
diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Getwd.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Getwd.java
index 9564bcc29d9040b5cc4310cece4d29aebd1ad596..65a5df0d3d3f398cafbf682aed523c66a89f3589 100644
--- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Getwd.java
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Getwd.java
@@ -33,7 +33,7 @@ public abstract class Getwd extends RBuiltinNode {
@Specialization
public Object getwd() {
controlVisibility();
- String result = BaseRFFIFactory.getRFFI().getwd();
+ String result = RFFIFactory.getRFFI().getBaseRFFI().getwd();
return RDataFactory.createStringVector(result);
}
diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/LaFunctions.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/LaFunctions.java
new file mode 100644
index 0000000000000000000000000000000000000000..a926f1140a75c1fdbfa9dcc34f5da431e68e7a46
--- /dev/null
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/LaFunctions.java
@@ -0,0 +1,123 @@
+/*
+ * This material is distributed under the GNU General Public License
+ * Version 2. You may review the terms of this license at
+ * http://www.gnu.org/licenses/gpl-2.0.html
+ *
+ * Copyright (c) 1995-2012, The R Core Team
+ * Copyright (c) 2003, The R Foundation
+ * Copyright (c) 2013, 2014, Oracle and/or its affiliates
+ *
+ * All rights reserved.
+ */
+package com.oracle.truffle.r.nodes.builtin.base;
+
+import com.oracle.truffle.api.CompilerDirectives.SlowPath;
+import com.oracle.truffle.api.dsl.*;
+import com.oracle.truffle.r.nodes.builtin.*;
+import com.oracle.truffle.r.runtime.*;
+import com.oracle.truffle.r.runtime.data.*;
+import com.oracle.truffle.r.runtime.ffi.*;
+
+/*
+ * Logic derived from GNU-R, src/modules/lapack/Lapack.c
+ */
+
+/**
+ * Lapack builtins.
+ */
+public class LaFunctions {
+
+ @RBuiltin(".Internal.La_version")
+ public abstract static class Version extends RBuiltinNode {
+ @Specialization
+ @SlowPath
+ public String doVersion() {
+ int[] version = new int[3];
+ RFFIFactory.getRFFI().getLapackRFFI().ilaver(version);
+ return version[0] + "." + version[1] + "." + version[2];
+ }
+ }
+
+ @RBuiltin(".Internal.La_rg")
+ public abstract static class Rg extends RBuiltinNode {
+
+ private static final String[] NAMES = new String[]{"values", "vectors"};
+
+ @Specialization
+ public Object doRg(RDoubleVector matrix, byte onlyValues) {
+ controlVisibility();
+ if (!matrix.isMatrix()) {
+ throw RError.getGenericError(getEncapsulatingSourceSection(), "'x' must be a square numeric matrix");
+ }
+ int[] dims = matrix.getDimensions();
+ if (onlyValues == RRuntime.LOGICAL_NA) {
+ throw RError.getGenericError(getEncapsulatingSourceSection(), "invalid \"only.values\" argument");
+ }
+ // copy array component of matrix as Lapack destroys it
+ int n = dims[0];
+ double[] a = matrix.getDataCopy();
+ char jobVL = 'N';
+ char jobVR = 'N';
+ boolean vectors = onlyValues == RRuntime.LOGICAL_FALSE;
+ if (vectors) {
+ // TODO fix
+ throw RError.getGenericError(getEncapsulatingSourceSection(), "\"only.values == FALSE\" not implemented");
+ }
+ double[] left = null;
+ double[] right = null;
+ if (vectors) {
+ jobVR = 'V';
+ right = new double[a.length];
+ }
+ double[] wr = new double[n];
+ double[] wi = new double[n];
+ double[] work = new double[1];
+ // ask for optimal size of work array
+ int info = RFFIFactory.getRFFI().getLapackRFFI().dgeev(jobVL, jobVR, n, a, n, wr, wi, left, n, right, n, work, -1);
+ if (info != 0) {
+ dgeevError(info);
+ }
+ // now allocate work array and make the actual call
+ int lwork = (int) work[0];
+ work = new double[lwork];
+ info = RFFIFactory.getRFFI().getLapackRFFI().dgeev(jobVL, jobVR, n, a, n, wr, wi, left, n, right, n, work, lwork);
+ if (info != 0) {
+ dgeevError(info);
+ }
+ // result is a list containing "values" and "vectors" (unless only.values is TRUE)
+ boolean complexValues = false;
+ for (int i = 0; i < n; i++) {
+ if (Math.abs(wi[i]) > 10 * RAccuracyInfo.get().eps * Math.abs(wr[i])) {
+ complexValues = true;
+ }
+ }
+ RVector values = null;
+ Object vectorValues = RNull.instance;
+ if (complexValues) {
+ double[] data = new double[n * 2];
+ for (int i = 0; i < n; i++) {
+ int ix = 2 * i;
+ data[ix] = wr[i];
+ data[ix + 1] = wi[i];
+ }
+ values = RDataFactory.createComplexVector(data, RDataFactory.COMPLETE_VECTOR);
+ if (vectors) {
+ // TODO
+ }
+ } else {
+ values = RDataFactory.createDoubleVector(wr, RDataFactory.COMPLETE_VECTOR);
+ if (vectors) {
+ // TODO
+ }
+ }
+ RStringVector names = RDataFactory.createStringVector(NAMES, RDataFactory.COMPLETE_VECTOR);
+ RList result = RDataFactory.createList(new Object[]{values, vectorValues}, names);
+ return result;
+ }
+
+ private void dgeevError(int info) throws RError {
+ throw RError.getGenericError(getEncapsulatingSourceSection(), "error code " + info + " from Lapack routine 'dgeev'");
+ }
+ }
+
+}
diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Mod.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Mod.java
index 2e726cf5252ae3b0c711ad004d655a77ff946767..a68bf439dfa4032a809103a49eca24f41f245e03 100644
--- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Mod.java
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Mod.java
@@ -27,6 +27,7 @@ import com.oracle.truffle.r.nodes.*;
import com.oracle.truffle.r.nodes.binary.*;
import com.oracle.truffle.r.nodes.builtin.*;
import com.oracle.truffle.r.runtime.data.*;
+import com.oracle.truffle.r.runtime.data.model.*;
import com.oracle.truffle.r.runtime.ops.*;
@RBuiltin("Mod")
@@ -36,10 +37,15 @@ public abstract class Mod extends RBuiltinNode {
@Child protected BinaryArithmeticNode add = BinaryArithmeticNode.create(BinaryArithmetic.ADD);
@Child protected Sqrt sqrt = SqrtFactory.create(new RNode[1], getBuiltin());
- @Specialization
- public double mod(RComplex x) {
+ @Specialization()
+ public RDoubleVector mod(RAbstractComplexVector vec) {
controlVisibility();
- return sqrt.sqrt(add.doDoubleDouble(pow.doDoubleInt(x.getRealPart(), 2), pow.doDoubleInt(x.getImaginaryPart(), 2)));
+ double[] data = new double[vec.getLength()];
+ for (int i = 0; i < vec.getLength(); i++) {
+ RComplex x = vec.getDataAt(i);
+ data[i] = sqrt.sqrt(add.doDoubleDouble(pow.doDoubleInt(x.getRealPart(), 2), pow.doDoubleInt(x.getImaginaryPart(), 2)));
+ }
+ return RDataFactory.createDoubleVector(data, RDataFactory.COMPLETE_VECTOR);
}
}
diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Options.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Options.java
index 9a8c528f1ea26e56042068a669a0c53abe5cc001..f5e299e00acc2c63b64ac5bb68c07d84078302f4 100644
--- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Options.java
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Options.java
@@ -63,4 +63,12 @@ public abstract class Options extends RBuiltinNode {
Object rObject = value == null ? RNull.instance : value;
return RDataFactory.createList(new Object[]{rObject}, RDataFactory.createStringVectorFromScalar(key));
}
+
+ @Specialization
+ public Object options(@SuppressWarnings("unused") double d) {
+ // HACK ALERT - just to allow b25 test, it doesn't do anything,
+ // as that would require the option name
+ controlVisibility();
+ return RNull.instance;
+ }
}
diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/R/LAPACK.R b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/R/LAPACK.R
new file mode 100644
index 0000000000000000000000000000000000000000..aaffc2f89065d46654080bb9241d1159a707dfbd
--- /dev/null
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/R/LAPACK.R
@@ -0,0 +1,60 @@
+# File src/library/base/R/LAPACK.R
+# Part of the R package, http://www.R-project.org
+#
+# Copyright (C) 1995-2013 The R Core Team
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program 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 for more details.
+#
+# A copy of the GNU General Public License is available at
+# http://www.r-project.org/Licenses/
+
+La.svd <- function(x, nu = min(n, p), nv = min(n, p))
+{
+ if(!is.logical(x) && !is.numeric(x) && !is.complex(x))
+ stop("argument to 'La.svd' must be numeric or complex")
+ if (any(!is.finite(x))) stop("infinite or missing values in 'x'")
+ x <- as.matrix(x)
+ n <- nrow(x)
+ p <- ncol(x)
+ if(!n || !p) stop("a dimension is zero")
+ zero <- if(is.complex(x)) 0+0i else 0
+
+ if(nu || nv) {
+ np <- min(n, p)
+ if(nu <= np && nv <= np) {
+ jobu <- "S"
+ u <- matrix(zero, n, np)
+ vt <- matrix(zero, np, p)
+ nu0 <- nv0 <- np
+ } else {
+ jobu <- "A"
+ u <- matrix(zero, n, n)
+ vt <- matrix(zero, p, p)
+ nu0 <- n; nv0 <- p
+ }
+ } else {
+ jobu <- "N"
+ ## these dimensions _are_ checked, but unused
+ u <- matrix(zero, 1L, 1L)
+ vt <- matrix(zero, 1L, 1L)
+ }
+
+ res <- if(is.complex(x))
+ .Internal(La_svd_cmplx(jobu, x, double(min(n,p)), u, vt))
+ else
+ .Internal(La_svd(jobu, x, double(min(n,p)), u, vt))
+ res <- res[c("d", if(nu) "u", if(nv) "vt")]
+ if(nu && nu < nu0) res$u <- res$u[, seq_len(min(n, nu)), drop = FALSE]
+ if(nv && nv < nv0) res$vt <- res$vt[seq_len(min(p, nv)), , drop = FALSE]
+ res
+}
+
+La_version <- function() .Internal(La_version())
diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Setwd.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Setwd.java
index 9a13f24ad2554736d02e2321c19f2d96ef2357f4..022c902bdea3e04d1287607d858183ad7dc80160 100644
--- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Setwd.java
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Setwd.java
@@ -33,11 +33,11 @@ public abstract class Setwd extends RInvisibleBuiltinNode {
@Specialization
public Object setwd(String dir) {
controlVisibility();
- int rc = BaseRFFIFactory.getRFFI().setwd(dir);
+ int rc = RFFIFactory.getRFFI().getBaseRFFI().setwd(dir);
if (rc != 0) {
throw RError.getCannotChangeDirectory(getEncapsulatingSourceSection());
} else {
- return BaseRFFIFactory.getRFFI().getwd();
+ return RFFIFactory.getRFFI().getBaseRFFI().getwd();
}
}
}
diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/SortFunctions.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/SortFunctions.java
new file mode 100644
index 0000000000000000000000000000000000000000..2b33737d6eefaf63c7581430832424b122752d05
--- /dev/null
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/SortFunctions.java
@@ -0,0 +1,56 @@
+/*
+ * Copyright (c) 2013, 2014, 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.nodes.builtin.base;
+
+import java.util.*;
+
+import com.oracle.truffle.api.dsl.*;
+import com.oracle.truffle.r.nodes.builtin.*;
+import com.oracle.truffle.r.runtime.*;
+import com.oracle.truffle.r.runtime.data.*;
+
+/**
+ * Temporary minimal implementation for eigen/b25. Eventually this should be combined with
+ * {@link Order} and made consistent with {@code sort.R}.
+ *
+ */
+public class SortFunctions {
+
+ @RBuiltin("sort.list")
+ public abstract static class SortList extends RBuiltinNode {
+ @Specialization
+ public RDoubleVector sortList(RDoubleVector vec, byte decreasing) {
+ controlVisibility();
+ double[] data = vec.getDataCopy();
+ Arrays.sort(data);
+ if (decreasing == RRuntime.LOGICAL_TRUE) {
+ double[] rdata = new double[data.length];
+ for (int i = 0; i < data.length; i++) {
+ rdata[i] = data[data.length - (i + 1)];
+ }
+ data = rdata;
+ }
+ return RDataFactory.createDoubleVector(data, RDataFactory.COMPLETE_VECTOR);
+ }
+ }
+}
diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/SysGetpid.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/SysGetpid.java
index eafbfd43c82a3641c17f97f247d463e94d4c9af1..6b5a6130691075f7cca288aa350f8f44899d94dc 100644
--- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/SysGetpid.java
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/SysGetpid.java
@@ -33,7 +33,7 @@ public abstract class SysGetpid extends RBuiltinNode {
@Specialization
public Object sysGetPid() {
controlVisibility();
- int pid = BaseRFFIFactory.getRFFI().getpid();
+ int pid = RFFIFactory.getRFFI().getBaseRFFI().getpid();
return RDataFactory.createIntVectorFromScalar(pid);
}
}
diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/SysReadlink.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/SysReadlink.java
index bdbe3dfef0cabfb813b3fb17f238467aa2e82e78..c311a5c8a3bc9a065d0c00cd50cd2bac8d395d1b 100644
--- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/SysReadlink.java
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/SysReadlink.java
@@ -64,7 +64,7 @@ public abstract class SysReadlink extends RBuiltinNode {
private static String doSysReadLink(String path) {
String s;
try {
- s = BaseRFFIFactory.getRFFI().readlink(path);
+ s = RFFIFactory.getRFFI().getBaseRFFI().readlink(path);
if (s == null) {
s = "";
}
diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/unary/UnaryArithmeticReduceNode.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/unary/UnaryArithmeticReduceNode.java
index 5a8964c4dbbd1a79e25117968e5ed70d6f860bb4..91de717c9953ddb9e9662e73e74690bc6aba5db1 100644
--- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/unary/UnaryArithmeticReduceNode.java
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/unary/UnaryArithmeticReduceNode.java
@@ -23,6 +23,7 @@
package com.oracle.truffle.r.nodes.unary;
import com.oracle.truffle.api.dsl.*;
+import com.oracle.truffle.r.runtime.*;
import com.oracle.truffle.r.runtime.data.*;
import com.oracle.truffle.r.runtime.ops.*;
@@ -125,6 +126,16 @@ public abstract class UnaryArithmeticReduceNode extends UnaryNode {
return result;
}
+ @Specialization(order = 12)
+ public RComplex doComplexVector(RComplexVector operand) {
+ RComplex result = RRuntime.double2complex(semantics.getDoubleStart());
+ for (int i = 0; i < operand.getLength(); ++i) {
+ RComplex current = operand.getDataAt(i);
+ result = arithmetic.op(result.getRealPart(), result.getImaginaryPart(), current.getRealPart(), current.getImaginaryPart());
+ }
+ return result;
+ }
+
public static final class ReduceSemantics {
private final int intStart;
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RAccuracyInfo.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RAccuracyInfo.java
new file mode 100644
index 0000000000000000000000000000000000000000..74c539d6dcbc88dbd91b5dc6314f346ceef0b571
--- /dev/null
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RAccuracyInfo.java
@@ -0,0 +1,344 @@
+/*
+ * 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) 2013, 2014, Oracle and/or its affiliates
+ *
+ * All rights reserved.
+ */
+package com.oracle.truffle.r.runtime;
+
+// Transcribed from GnuR src/main/platform.c
+
+public class RAccuracyInfo {
+ public final int ibeta;
+ public final int it;
+ public final int irnd;
+ public final int ngrd;
+ public final int machep;
+ public final int negep;
+ public final int iexp;
+ public final int minexp;
+ public final int maxexp;
+ public final double eps;
+ public final double epsneg;
+ public final double xmin;
+ public final double xmax;
+
+ RAccuracyInfo() {
+ int ibetaTemp;
+ int itTemp;
+ int irndTemp;
+ int ngrdTemp;
+ int machepTemp;
+ int negepTemp;
+ int iexpTemp;
+ int minexpTemp;
+ int maxexpTemp;
+ double epsTemp;
+ double epsnegTemp;
+ double xminTemp;
+ double xmaxTemp;
+
+ double a;
+ double b;
+ double beta;
+ double betain;
+ double betah;
+ double one;
+ double t;
+ double temp;
+ double tempa;
+ double temp1;
+ double two;
+ double y;
+ double z;
+ double zero;
+ int i;
+ int itemp;
+ int iz;
+ int j;
+ int k;
+ int mx;
+ int nxres;
+
+ one = 1;
+ two = one + one;
+ zero = one - one;
+
+ /* determine ibeta, beta ala malcolm. */
+
+ a = one;
+ do {
+ a = a + a;
+ temp = a + one;
+ temp1 = temp - a;
+ } while (temp1 - one == zero);
+
+ b = one;
+ do {
+ b = b + b;
+ temp = a + b;
+ itemp = (int) (temp - a);
+ } while (itemp == 0);
+ ibetaTemp = itemp;
+ beta = ibetaTemp;
+
+ /* determine it, irnd */
+
+ itTemp = 0;
+ b = one;
+ do {
+ itTemp = itTemp + 1;
+ b = b * beta;
+ temp = b + one;
+ temp1 = temp - b;
+ } while (temp1 - one == zero);
+
+ irndTemp = 0;
+ betah = beta / two;
+ temp = a + betah;
+ if (temp - a != zero) {
+ irndTemp = 1;
+ }
+ tempa = a + beta;
+ temp = tempa + betah;
+ if (irndTemp == 0 && temp - tempa != zero) {
+ irndTemp = 2;
+ }
+
+ /* determine negep, epsneg */
+
+ negepTemp = itTemp + 3;
+ betain = one / beta;
+ a = one;
+ for (i = 1; i <= negepTemp; i++) {
+ a = a * betain;
+ }
+ b = a;
+ for (;;) {
+ temp = one - a;
+ if (temp - one != zero) {
+ break;
+ }
+ a = a * beta;
+ negepTemp = negepTemp - 1;
+ }
+ negepTemp = -negepTemp;
+ epsnegTemp = a;
+ if (ibetaTemp != 2 && irndTemp != 0) {
+ a = (a * (one + a)) / two;
+ temp = one - a;
+ if (temp - one != zero) {
+ epsnegTemp = a;
+ }
+ }
+
+ /* determine machep, eps */
+
+ machepTemp = -itTemp - 3;
+ a = b;
+ for (;;) {
+ temp = one + a;
+ if (temp - one != zero) {
+ break;
+ }
+ a = a * beta;
+ machepTemp = machepTemp + 1;
+ }
+ epsTemp = a;
+ temp = tempa + beta * (one + epsTemp);
+ if (ibetaTemp != 2 && irndTemp != 0) {
+ a = (a * (one + a)) / two;
+ temp = one + a;
+ if (temp - one != zero) {
+ epsTemp = a;
+ }
+ }
+
+ /* determine ngrd */
+
+ ngrdTemp = 0;
+ temp = one + epsTemp;
+ if (irndTemp == 0 && temp * one - one != zero) {
+ ngrdTemp = 1;
+ }
+
+ /* determine iexp, minexp, xmin */
+
+ /* loop to determine largest i and k = 2**i such that */
+ /* (1/beta) ** (2**(i)) */
+ /* does not underflow. */
+ /* exit from loop is signaled by an underflow. */
+
+ i = 0;
+ k = 1;
+ z = betain;
+ t = one + epsTemp;
+ nxres = 0;
+ for (;;) {
+ y = z;
+ z = y * y;
+
+ /* check for underflow here */
+
+ a = z * one;
+ temp = z * t;
+ if (a + a == zero || Math.abs(z) >= y) {
+ break;
+ }
+ temp1 = temp * betain;
+ if (temp1 * beta == z) {
+ break;
+ }
+ i = i + 1;
+ k = k + k;
+ }
+ if (ibetaTemp != 10) {
+ iexpTemp = i + 1;
+ mx = k + k;
+ } else {
+ /* this segment is for decimal machines only */
+
+ iexpTemp = 2;
+ iz = ibetaTemp;
+ while (k >= iz) {
+ iz = iz * ibetaTemp;
+ iexpTemp = iexpTemp + 1;
+ }
+ mx = iz + iz - 1;
+ }
+ boolean broke = false;
+ do {
+ /* loop to determine minexp, xmin */
+ /* exit from loop is signaled by an underflow */
+
+ xminTemp = y;
+ y = y * betain;
+
+ /* check for underflow here */
+
+ a = y * one;
+ temp = y * t;
+ if (a + a == zero || Math.abs(y) >= xminTemp) {
+ broke = true;
+ break;
+ }
+ k = k + 1;
+ temp1 = temp * betain;
+ } while (temp1 * beta != y);
+
+ if (!broke) {
+ nxres = 3;
+ xminTemp = y;
+ }
+
+ minexpTemp = -k;
+
+ /* determine maxexp, xmax */
+
+ if (mx <= k + k - 3 && ibetaTemp != 10) {
+ mx = mx + mx;
+ iexpTemp = iexpTemp + 1;
+ }
+ maxexpTemp = mx + minexpTemp;
+
+ /* adjust irnd to reflect partial underflow */
+
+ irndTemp = irndTemp + nxres;
+
+ /* adjust for ieee-style machines */
+
+ if (irndTemp == 2 || irndTemp == 5) {
+ maxexpTemp = maxexpTemp - 2;
+ }
+
+ /* adjust for non-ieee machines with partial underflow */
+
+ if (irndTemp == 3 || irndTemp == 4) {
+ maxexpTemp = maxexpTemp - itTemp;
+ }
+
+ /* adjust for machines with implicit leading bit in binary */
+ /* significand, and machines with radix point at extreme */
+ /* right of significand. */
+
+ i = maxexpTemp + minexpTemp;
+ if (ibetaTemp == 2 && i == 0) {
+ maxexpTemp = maxexpTemp - 1;
+ }
+ if (i > 20) {
+ maxexpTemp = maxexpTemp - 1;
+ }
+ if (a != y) {
+ maxexpTemp = maxexpTemp - 2;
+ }
+ xmaxTemp = one - epsnegTemp;
+ if (xmaxTemp * one != xmaxTemp) {
+ xmaxTemp = one - beta * epsnegTemp;
+ }
+ xmaxTemp = xmaxTemp / (beta * beta * beta * xminTemp);
+ i = maxexpTemp + minexpTemp + 3;
+ if (i > 0) {
+ for (j = 1; j <= i; j++) {
+ if (ibetaTemp == 2) {
+ xmaxTemp = xmaxTemp + xmaxTemp;
+ }
+ if (ibetaTemp != 2) {
+ xmaxTemp = xmaxTemp * beta;
+ }
+ }
+ }
+
+ this.ibeta = ibetaTemp;
+ this.it = itTemp;
+ this.irnd = irndTemp;
+ this.ngrd = ngrdTemp;
+ this.machep = machepTemp;
+ this.negep = negepTemp;
+ this.iexp = iexpTemp;
+ this.minexp = minexpTemp;
+ this.maxexp = maxexpTemp;
+ this.eps = epsTemp;
+ this.epsneg = epsnegTemp;
+ this.xmin = xminTemp;
+ this.xmax = xmaxTemp;
+
+ }
+
+ private static RAccuracyInfo accuracy;
+
+ public static void initialize() {
+ if (accuracy == null) {
+ accuracy = new RAccuracyInfo();
+ }
+ }
+
+ public static RAccuracyInfo get() {
+ return accuracy;
+ }
+
+ public static void main(String[] args) {
+ RAccuracyInfo accuracyInfo = new RAccuracyInfo();
+ // Checkstyle: stop print method check
+ System.out.printf("ibeta %d\n", accuracyInfo.ibeta);
+ System.out.printf("it %d\n", accuracyInfo.it);
+ System.out.printf("irnd %d\n", accuracyInfo.irnd);
+ System.out.printf("ngrd %d\n", accuracyInfo.ngrd);
+ System.out.printf("machep %d\n", accuracyInfo.machep);
+ System.out.printf("negep %d\n", accuracyInfo.negep);
+ System.out.printf("iexp %d\n", accuracyInfo.iexp);
+ System.out.printf("minexp %d\n", accuracyInfo.minexp);
+ System.out.printf("maxexp %d\n", accuracyInfo.maxexp);
+ System.out.printf("negep %d\n", accuracyInfo.negep);
+ System.out.printf("eps %e\n", accuracyInfo.eps);
+ System.out.printf("epsneg %e\n", accuracyInfo.epsneg);
+ System.out.printf("xmin %e\n", accuracyInfo.xmin);
+ System.out.printf("xmax %e\n", accuracyInfo.xmax);
+
+ }
+
+}
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/REnvVars.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/REnvVars.java
index a47bf825de50b6362efa907dcfeabf19e99f0688..25a966ce4a424dcbc99487a53840e32cbca2f30d 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/REnvVars.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/REnvVars.java
@@ -70,7 +70,7 @@ public class REnvVars {
String userFile = envVars.get("R_ENVIRON_USER");
if (userFile == null) {
String dotRenviron = ".Renviron";
- userFile = fileSystem.getPath(BaseRFFIFactory.getRFFI().getwd(), dotRenviron).toString();
+ userFile = fileSystem.getPath(RFFIFactory.getRFFI().getBaseRFFI().getwd(), dotRenviron).toString();
if (!new File(userFile).exists()) {
userFile = fileSystem.getPath(System.getProperty("user.home"), dotRenviron).toString();
}
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RProfile.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RProfile.java
index 31d480fa1ff423bc12d9d83d4fde20e61b0b2f89..118f56aa01275ae90552a87ba61914b817a0fbaa 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RProfile.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RProfile.java
@@ -28,8 +28,9 @@ import java.nio.file.*;
import com.oracle.truffle.r.runtime.ffi.*;
/**
- * Handles the loading of site and user profile code. TODO implement the actual sourceing of the
- * file content.
+ * Handles the loading of site and user profile code. For the time being, owing to issues regarding
+ * environments/frames, this code only reads the files and leaves the evaluation to the caller,
+ * using {@link #siteProfile()} and {@link #userProfile()}.
*/
public class RProfile {
public static void initialize() {
@@ -37,32 +38,59 @@ public class RProfile {
FileSystem fileSystem = FileSystems.getDefault();
if (!RCmdOptions.NO_SITE_FILE.getValue()) {
- String siteProfile = REnvVars.get("R_PROFILE");
- if (siteProfile == null) {
- siteProfile = fileSystem.getPath(rHome, "etc", "Rprofile.site").toString();
+ String siteProfilePath = REnvVars.get("R_PROFILE");
+ if (siteProfilePath == null) {
+ siteProfilePath = fileSystem.getPath(rHome, "etc", "Rprofile.site").toString();
} else {
- siteProfile = Utils.tildeExpand(siteProfile);
+ siteProfilePath = Utils.tildeExpand(siteProfilePath);
}
- if (new File(siteProfile).exists()) {
- // TODO source the content
+ File siteProfileFile = new File(siteProfilePath);
+ if (siteProfileFile.exists()) {
+ siteProfile = source(siteProfileFile);
}
}
if (!RCmdOptions.NO_INIT_FILE.getValue()) {
- String userProfile = REnvVars.get("R_PROFILE_USER");
- if (userProfile == null) {
+ String userProfilePath = REnvVars.get("R_PROFILE_USER");
+ if (userProfilePath == null) {
String dotRenviron = ".Rprofile";
- userProfile = fileSystem.getPath(BaseRFFIFactory.getRFFI().getwd(), dotRenviron).toString();
- if (!new File(userProfile).exists()) {
- userProfile = fileSystem.getPath(System.getProperty("user.home"), dotRenviron).toString();
+ userProfilePath = fileSystem.getPath(RFFIFactory.getRFFI().getBaseRFFI().getwd(), dotRenviron).toString();
+ if (!new File(userProfilePath).exists()) {
+ userProfilePath = fileSystem.getPath(System.getProperty("user.home"), dotRenviron).toString();
}
} else {
- userProfile = Utils.tildeExpand(userProfile);
+ userProfilePath = Utils.tildeExpand(userProfilePath);
}
- if (userProfile != null && new File(userProfile).exists()) {
- // TODO source the content
+ if (userProfilePath != null) {
+ File userProfileFile = new File(userProfilePath);
+ if (userProfileFile.exists()) {
+ userProfile = source(userProfileFile);
+ }
}
}
}
+
+ private static String siteProfile;
+ private static String userProfile;
+
+ public static String siteProfile() {
+ return siteProfile;
+ }
+
+ public static String userProfile() {
+ return userProfile;
+ }
+
+ private static String source(File file) {
+ try (BufferedInputStream is = new BufferedInputStream(new FileInputStream(file))) {
+ byte[] bytes = new byte[(int) file.length()];
+ is.read(bytes);
+ return new String(bytes);
+ } catch (IOException ex) {
+ Utils.fail("unexpected error reading profile file: " + file);
+ return null;
+ }
+
+ }
}
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RRuntime.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RRuntime.java
index d37987d5a725332bca47bbe627b337474b2e9aaa..b5aac273da0c307c794a5700a43466cc1e22ad08 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RRuntime.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RRuntime.java
@@ -145,13 +145,14 @@ public class RRuntime {
public static void initialize() {
startTime = System.nanoTime();
childTimes = new long[]{0, 0};
+ RAccuracyInfo.initialize();
RVersionInfo.initialize();
REnvVars.initialize();
LibPaths.initialize();
ROptions.initialize();
RPackageVariables.initialize();
- RProfile.initialize();
TempDirPath.initialize();
+ RProfile.initialize();
}
/**
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/TempDirPath.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/TempDirPath.java
index 883a6d8118ace9a669a5b574d747bdbfd43c88f6..e537db142edc98e720079d90a3addef9b5f457f0 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/TempDirPath.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/TempDirPath.java
@@ -27,9 +27,9 @@ import java.io.*;
import com.oracle.truffle.r.runtime.ffi.*;
/**
- *
+ *
* As per the GnuR spec, the tempdir() directory is identified on startup.
- *
+ *
*/
public class TempDirPath {
@@ -52,7 +52,7 @@ public class TempDirPath {
if (!startingTempDirPath.endsWith(File.separator)) {
startingTempDirPath += startingTempDirPath;
}
- String t = BaseRFFIFactory.getRFFI().mkdtemp(startingTempDirPath + "Rtmp" + "XXXXXX");
+ String t = RFFIFactory.getRFFI().getBaseRFFI().mkdtemp(startingTempDirPath + "Rtmp" + "XXXXXX");
if (t != null) {
tempDirPath = t;
} else {
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/BaseRFFI.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/BaseRFFI.java
index a1e1b6e151aa44b344124522cd09fb51c870f2b0..f38cbf79d6c6d62688892ae3b5a5c6440c2d2004 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/BaseRFFI.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/BaseRFFI.java
@@ -25,11 +25,11 @@ package com.oracle.truffle.r.runtime.ffi;
import java.io.*;
/**
- * A statically typed interface to exactly those native functions required by the base package,
- * because the functionality is not provided by the JDK. These methods do not necessarily map 1-1 to
- * a native function, they may involve the invocation of several native functions.
+ * A statically typed interface to exactly those native functions required by the R {@code base}
+ * package, because the functionality is not provided by the JDK. These methods do not necessarily
+ * map 1-1 to a native function, they may involve the invocation of several native functions.
*/
-public interface BaseRFFI extends RFFI {
+public interface BaseRFFI {
int getpid();
/**
@@ -39,14 +39,14 @@ public interface BaseRFFI extends RFFI {
/**
* Sets the current working directory to {@code dir}. (cf. Unix {@code chdir}).
- *
+ *
* @return 0 if successful.
*/
int setwd(String dir);
/**
* Try to convert a symbolic link to it's target.
- *
+ *
* @param path the link path
* @return the target if {@code path} is a link else {@code null}
* @throws IOException for any other error except "not a link"
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/BaseRFFIFactory.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/CCallRFFI.java
similarity index 80%
rename from com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/BaseRFFIFactory.java
rename to com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/CCallRFFI.java
index e0d3bf758505354d5461ac4d2f27addcdaea8dd2..15432ed141f7184f2c5dd1617213f1666c327b1f 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/BaseRFFIFactory.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/CCallRFFI.java
@@ -23,14 +23,8 @@
package com.oracle.truffle.r.runtime.ffi;
/**
- * {@link RFFIFactory} known to implement the {@link BaseRFFI} interface.
+ * Placeholder for the C call FFI.
*/
-public abstract class BaseRFFIFactory extends RFFIFactory {
-
- protected static final BaseRFFI baseRFFI = (BaseRFFI) theRFFI;
-
- public static BaseRFFI getRFFI() {
- return baseRFFI;
- }
+public interface CCallRFFI {
}
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/FCallRFFI.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/FCallRFFI.java
new file mode 100644
index 0000000000000000000000000000000000000000..6302d1fe692da535aca5cb320606142940ec3d69
--- /dev/null
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/FCallRFFI.java
@@ -0,0 +1,30 @@
+/*
+ * Copyright (c) 2014, 2014, 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;
+
+/**
+ * Placeholder for the Fortran call FFI.
+ */
+public interface FCallRFFI {
+
+}
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/LapackRFFI.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/LapackRFFI.java
new file mode 100644
index 0000000000000000000000000000000000000000..8de66442d0b33a449d44a2a89f4ff270f7770ccc
--- /dev/null
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/LapackRFFI.java
@@ -0,0 +1,41 @@
+/*
+ * Copyright (c) 2014, 2014, 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;
+
+/**
+ * Collection of statically typed Lapack methods that are used in the {@code base} package.
+ */
+public interface LapackRFFI extends RFFI {
+ /**
+ * Return version info, mjor, minor, patch, in {@code version}.
+ */
+ void ilaver(int[] version);
+
+ /**
+ * See <a href="http://www.netlib.no/netlib/lapack/double/dgeev.f">spec</a>. The {@code info}
+ * arg in the Fortran spec is returned as result.
+ */
+ // @formatter:off
+ int dgeev(char jobVL, char jobVR, int n, double[] a, int lda, double[] wr, double[] wi, double[] vl, int ldvl,
+ double[] vr, int ldvr, double[] work, int lwork);
+}
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFI.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFI.java
index c2b17fac608f3b58b9033b596386f2be86a92c00..27c89a7cccbedb565578dfaec33ba9ea5f9d8915 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFI.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFI.java
@@ -22,20 +22,28 @@
*/
package com.oracle.truffle.r.runtime.ffi;
-import com.oracle.truffle.r.runtime.ffi.RFFIFactory.*;
-
+/**
+ * FastR foreign function interface. There are separate interfaces for the various kinds of foreign
+ * functions that are possible in R:
+ * <ul>
+ * <li>{@link BaseRFFI}: the specific, typed, foreign functions required the built-in {@code base}
+ * package.</li>
+ * <li>{@link LapackRFFI}: the specific, typed, foreign functions required by the built-in
+ * {@code Lapack} functions.</li>
+ * <li>{@link FCallRFFI}: generic Fortran function interface</li>
+ * <li>{@link CCallRFFI}: generic C call interface.
+ * </ul>
+ *
+ * These interfaces may be implemented by one or more providers, specified either when the FastR
+ * system is built or run.
+ */
public interface RFFI {
- /**
- * Strawman, highly generic, function invocation mechanism.
- *
- * @param handle handle to native function, type dependent on implementation
- * @param args arguments
- * @return the result, if any
- */
- Object invoke(Object handle, Object[] args) throws RFFIException;
+ BaseRFFI getBaseRFFI();
+
+ LapackRFFI getLapackRFFI();
+
+ FCallRFFI getFCallRFFI();
+
+ CCallRFFI getCCallRFFI();
- /**
- * Return a handle for invoking function {@code name} in this {@link RFFI}.
- */
- Object getHandle(String name);
}
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFIFactory.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFIFactory.java
index 080d1e618c7af0c1f0da19250dad5390f26dbd2b..85b29014184abdfa95ea2dfb9177866c2e22c552 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFIFactory.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFIFactory.java
@@ -25,18 +25,11 @@ package com.oracle.truffle.r.runtime.ffi;
import com.oracle.truffle.r.runtime.*;
/**
- * Factory class for the different possible implementations of the {@loink RFFI} interface.
+ * Factory class for the different possible implementations of the {@link RFFI} interface.
* Specification is based on system property {@value #FACTORY_CLASS_PROPERTY}. Current default is a
- * (naive) JNR-based implementation.
+ * JNR-based implementation.
*/
public abstract class RFFIFactory {
- public class RFFIException extends Exception {
- private static final long serialVersionUID = -5689472664825730485L;
-
- public RFFIException(String msg, Throwable ex) {
- super(msg, ex);
- }
- }
private static final String FACTORY_CLASS_PROPERTY = "fastr.ffi.factory.class";
private static final String DEFAULT_FACTORY_CLASS = "com.oracle.truffle.r.runtime.ffi.jnr.JNR_RFFIFactory";
@@ -66,4 +59,19 @@ public abstract class RFFIFactory {
*/
protected abstract RFFI createRFFI();
+ public LapackRFFI getLapackRFFI() {
+ Utils.fail("getLapackRFFI not implemented");
+ return null;
+ }
+
+ public FCallRFFI getFCallRFFI() {
+ Utils.fail("getFCallRFFI not implemented");
+ return null;
+ }
+
+ public CCallRFFI getCCallRFFI() {
+ Utils.fail("getCCallRFFI not implemented");
+ return null;
+ }
+
}
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/gnfi/GNFI_RFFIFactory.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/gnfi/GNFI_RFFIFactory.java
index 87d37a9d10d7a92c885664353d2857c6a7ee3968..95c26e89aefd5dfc9a18920d9d27de37e97d5f81 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/gnfi/GNFI_RFFIFactory.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/gnfi/GNFI_RFFIFactory.java
@@ -36,11 +36,11 @@ import com.oracle.truffle.r.runtime.ffi.*;
/**
* BaseRFFI using the Graal Native Function Interface (GNFI). N.B. Pointers, e.g. {@code char*} are
* denoted as {@code long} in argument signatures.
- *
+ *
* N.B. This code is very unsafe!
- *
+ *
*/
-public class GNFI_RFFIFactory extends BaseRFFIFactory implements BaseRFFI {
+public class GNFI_RFFIFactory extends RFFIFactory implements RFFI, BaseRFFI {
private static NativeFunctionInterface nfi;
private static NativeFunctionHandle malloc;
@@ -110,15 +110,6 @@ public class GNFI_RFFIFactory extends BaseRFFIFactory implements BaseRFFI {
}
}
- public Object invoke(Object handle, Object[] args) throws RFFIException {
- Utils.fail("reflective invoke not implemented");
- return null;
- }
-
- public Object getHandle(String name) {
- return name;
- }
-
public int getpid() {
NativeFunctionHandle getpid = nfi.getFunctionHandle("getpid", int.class);
return (int) getpid.call();
@@ -170,4 +161,9 @@ public class GNFI_RFFIFactory extends BaseRFFIFactory implements BaseRFFI {
}
}
+ public BaseRFFI getBaseRFFI() {
+ // TODO Auto-generated method stub
+ return null;
+ }
+
}
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/jnr/JNR_RFFIFactory.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/jnr/JNR_RFFIFactory.java
index 70277b47738706b858db8231a6a2d73bde7509c8..aaa3ad33c8c86a3f1f314a3d3cd4196b118bbce3 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/jnr/JNR_RFFIFactory.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/jnr/JNR_RFFIFactory.java
@@ -24,20 +24,24 @@ package com.oracle.truffle.r.runtime.ffi.jnr;
import java.io.*;
import java.nio.*;
-
import jnr.ffi.*;
import jnr.ffi.annotations.*;
import jnr.posix.*;
import jnr.constants.platform.Errno;
-import com.oracle.truffle.r.runtime.*;
import com.oracle.truffle.r.runtime.ffi.*;
/**
- * A simple JNR-based factory that supports access to POSIX functions only. Access to the base
- * functions is as efficient as it can be with JNR.
+ * JNR-based factory Implements {@link BaseRFFI} and {@link LapackRFFI} directly.
*/
-public class JNR_RFFIFactory extends BaseRFFIFactory implements BaseRFFI {
+public class JNR_RFFIFactory extends RFFIFactory implements RFFI, BaseRFFI, LapackRFFI {
+
+ // Base
+
+ @Override
+ public BaseRFFI getBaseRFFI() {
+ return this;
+ }
/**
* Functions missing from JNR POSIX.
@@ -70,11 +74,6 @@ public class JNR_RFFIFactory extends BaseRFFIFactory implements BaseRFFI {
return this;
}
- public Object invoke(Object handle, Object[] args) throws RFFIException {
- Utils.fail("reflective invoke not implemented");
- return null;
- }
-
protected POSIX posix() {
if (posix == null) {
posix = POSIXFactory.getPOSIX();
@@ -104,10 +103,6 @@ public class JNR_RFFIFactory extends BaseRFFIFactory implements BaseRFFI {
}
}
- public Object getHandle(String name) {
- return name;
- }
-
public String readlink(String path) throws IOException {
String s = posix().readlink(path);
if (s == null) {
@@ -132,4 +127,82 @@ public class JNR_RFFIFactory extends BaseRFFIFactory implements BaseRFFI {
}
}
+ // Lapack
+
+ @Override
+ public LapackRFFI getLapackRFFI() {
+ return this;
+ }
+
+ /**
+ * Fortran does call by reference for everything, which we handle with arrays. Evidently, this
+ * is not as efficient as it could be.
+ */
+ public interface Lapack {
+ // Checkstyle: stop method name
+ void ilaver_(@Out int[] major, @Out int[] minor, @Out int[] patch);
+
+ // @formatter:off
+ // Checkstyle: stop method name
+ void dgeev_(byte[] jobVL, byte[] jobVR, @In int[] n, @In double[] a, @In int[] lda, @Out double[] wr, @Out double[] wi,
+ @Out double[] vl, @In int[] ldvl, @Out double[] vr, @In int[] ldvr,
+ @In @Out double[] work, @In int[] lwork, @Out int[] info);
+ }
+
+ private static class LapackProvider {
+ private static Lapack lapack;
+
+ static Lapack lapack() {
+ if (lapack == null) {
+ lapack = LibraryLoader.create(Lapack.class).load("Rlapack");
+ }
+ return lapack;
+ }
+ }
+
+ private static Lapack lapack() {
+ return LapackProvider.lapack();
+ }
+
+ private static class RefScalars_ilaver {
+ static int[] major = new int[1];
+ static int[] minor = new int[1];
+ static int[] patch = new int[1];
+ }
+ public void ilaver(int[] version) {
+ lapack().ilaver_(RefScalars_ilaver.major, RefScalars_ilaver.minor, RefScalars_ilaver.patch);
+ version[0] = RefScalars_ilaver.major[0];
+ version[1] = RefScalars_ilaver.minor[0];
+ version[2] = RefScalars_ilaver.patch[0];
+ }
+
+ private static class RefScalars_dgeev {
+ static byte[] jobVL = new byte[1];
+ static byte[] jobVR = new byte[1];
+ static int[] n = new int[1];
+ static int[] lda = new int[1];
+ static int[] ldvl = new int[1];
+ static int[] ldvr = new int[1];
+ static int[] lwork = new int[1];
+ static int[] info = new int[1];
+ }
+
+ // @formatter:off
+ public int dgeev(char jobVL, char jobVR, int n, double[] a, int lda, double[] wr, double[] wi,
+ double[] vl, int ldvl, double[] vr, int ldvr, double[] work, int lwork) {
+ // assume single threaded calls here
+ RefScalars_dgeev.jobVL[0] = (byte) jobVL;
+ RefScalars_dgeev.jobVR[0] = (byte) jobVR;
+ RefScalars_dgeev.n[0] = n;
+ RefScalars_dgeev.lda[0] = lda;
+ RefScalars_dgeev.ldvl[0] = ldvl;
+ RefScalars_dgeev.ldvr[0] = ldvr;
+ RefScalars_dgeev.lwork[0] = lwork;
+ // @formatter:off
+ lapack().dgeev_(RefScalars_dgeev.jobVL, RefScalars_dgeev.jobVR, RefScalars_dgeev.n, a, RefScalars_dgeev.lda, wr, wi, vl,
+ RefScalars_dgeev.ldvl, vr, RefScalars_dgeev.ldvr, work,
+ RefScalars_dgeev.lwork, RefScalars_dgeev.info);
+ return RefScalars_dgeev.info[0];
+ }
+
}
diff --git a/mx.fastr/copyrights/overrides b/mx.fastr/copyrights/overrides
index 46e5f99223819405cfd2333f8208c4cf8744fd61..e35beeade4d6d6196000061d10637f225b002f2f 100644
--- a/mx.fastr/copyrights/overrides
+++ b/mx.fastr/copyrights/overrides
@@ -5,6 +5,7 @@ com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Dispatche
com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/GetClass.java,purdue.copyright
com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Inherits.java,purdue.copyright
com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/IsArray.java,purdue.copyright
+com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/LaFunctions.java,gnu_r.copyright
com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/NextMethod.java,purdue.copyright
com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/NextMethodDispatchNode.java,purdue.copyright
com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Rnorm.java,gnu_r.copyright
@@ -79,6 +80,7 @@ com.oracle.truffle.r.parser/src/com/oracle/truffle/r/parser/tools/TreeViewer.jav
com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RError.java,gnu_r.copyright
com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RRandomNumberGenerator.java,hiroshima.copyright
com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RRuntime.java,gnu_r.copyright
+com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RAccuracyInfo.java,gnu_r.copyright
com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ops/BinaryArithmetic.java,gnu_r_purdue.copyright
com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ops/UnaryArithmetic.java,gnu_r_unary.copyright
com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/TestBase.java,purdue.copyright
diff --git a/mx.fastr/mx_fastr.py b/mx.fastr/mx_fastr.py
index 60939bbe5ac3c34384ae87bcaa4cb16551c54675..e62f8db23635f4a3f1a52340c40936a8bbf7da3e 100644
--- a/mx.fastr/mx_fastr.py
+++ b/mx.fastr/mx_fastr.py
@@ -31,6 +31,16 @@ _fastr_suite = None
def _runR(args, className, nonZeroIsFatal=True):
os.environ['R_HOME'] = _fastr_suite.dir
+ # Set up path for Lapack libraries
+ osname = platform.system()
+ lib_base = join(_fastr_suite.dir, 'com.oracle.truffle.r.native', 'lib', osname.lower())
+ lib_value = lib_base
+ if osname == 'Darwin':
+ lib_env = 'DYLD_FALLBACK_LIBRARY_PATH'
+ lib_value = lib_value + os.pathsep + '/usr/lib'
+ else:
+ lib_env = 'LD_LIBRARY_PATH'
+ os.environ[lib_env] = lib_value
return mx_graal.vm(['-ea', '-esa', '-cp', mx.classpath("com.oracle.truffle.r.shell"), className] + args, nonZeroIsFatal=nonZeroIsFatal)
def runRCommand(args, nonZeroIsFatal=True):
@@ -183,6 +193,7 @@ def rbench(args):
parser = ArgumentParser(prog='mx rbench')
parser.add_argument('--path', action='store_true', help='print path to benchmark')
parser.add_argument('--gnur', action='store_true', help='run under GnuR')
+ parser.add_argument('--gnur-path', action='store', metavar='<path>', help='specify path to GnuR', default='R')
parser.add_argument('--fail-fast', action='store_true', help='abort on first failure')
parser.add_argument('--gnur-jit', action='store_true', help='enable GnuR JIT')
parser.add_argument('benchmarks', nargs=REMAINDER, metavar='benchmarkgroup.name', help='list of benchmarks to run')
@@ -212,7 +223,7 @@ def rbench(args):
env = os.environ
if args.gnur_jit:
env['R_ENABLE_JIT'] = '3'
- rc = subprocess.call(['R', '--slave'] + command, env=env)
+ rc = subprocess.call([args.gnur_path, '--slave'] + command, env=env)
else:
rc = runRCommand(command, nonZeroIsFatal=False)
if rc != 0:
diff --git a/mx.fastr/projects b/mx.fastr/projects
index a5f79233e496ce4f4cd58450f64042c8f846b223..63928cd923b5e5b6aa25a07a44d09be8ce49b009 100644
--- a/mx.fastr/projects
+++ b/mx.fastr/projects
@@ -104,3 +104,9 @@ project@com.oracle.truffle.r.runtime@checkstyle=com.oracle.truffle.r.runtime
project@com.oracle.truffle.r.runtime@javaCompliance=1.8
project@com.oracle.truffle.r.runtime@workingSets=Truffle,FastR
+# com.oracle.truffle.r.native
+project@com.oracle.truffle.r.native@sourceDirs=
+project@com.oracle.truffle.r.native@native=true
+project@com.oracle.truffle.r.native@workingSets=FastR
+
+