diff --git a/.gitignore b/.gitignore
index fe63b0a59d02279c6c99e502bd60a768794805ef..6b0dd1ea1285e0027b92a1c800821b3879b42efa 100644
--- a/.gitignore
+++ b/.gitignore
@@ -146,4 +146,5 @@ com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/coerceTests.R
com.oracle.truffle.r.native/version.built
documentation/.pydevproject
com.oracle.truffle.r.native/gnur/patch-build
-/com.oracle.truffle.r.native/fficall/common.done
\ No newline at end of file
+com.oracle.truffle.r.test.native/embedded/embedded.actual.output
+com.oracle.truffle.r.test.native/embedded/main.actual.output
diff --git a/ci.hocon b/ci.hocon
index 91c544d5569b556e32fff043d4b188f2f2627619..259a0e142ed2dc363b896a521cd05bed462b7e61 100644
--- a/ci.hocon
+++ b/ci.hocon
@@ -36,6 +36,8 @@ logfiles : [
"libdownloads/R-*/gnur_make.log"
"libdownloads/R-*/Makeconf"
"com.oracle.truffle.r.native/gnur/tests/log/all.diff"
+ "com.oracle.truffle.r.test.native/embedded/*.output"
+ "com.oracle.truffle.r.test.native/embedded/src/*.output"
"*-tests/*.Rout"
]
@@ -93,7 +95,7 @@ gateCmd : ["mx", "--strict-compliance", "rgate", "--strict-mode", "-t"]
gateTestCommon : ${common} {
run : [
- ${gateCmd} ["Versions,JDKReleaseInfo,BuildJavaWithJavac,UnitTests: with specials"]
+ ${gateCmd} ["Versions,JDKReleaseInfo,BuildJavaWithJavac,UnitTests: with specials,Rembedded"]
]
}
diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/REngine.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/REngine.java
index ac33e442961a5780f765c997ff903018c2a2e93e..283b32fc899b0684a18c908a201752c1837ec14d 100644
--- a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/REngine.java
+++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/REngine.java
@@ -106,7 +106,6 @@ import com.oracle.truffle.r.runtime.env.frame.ActiveBinding;
import com.oracle.truffle.r.runtime.env.frame.FrameSlotChangeMonitor;
import com.oracle.truffle.r.runtime.interop.R2Foreign;
import com.oracle.truffle.r.runtime.interop.R2ForeignNodeGen;
-import com.oracle.truffle.r.runtime.nodes.RCodeBuilder;
import com.oracle.truffle.r.runtime.nodes.RNode;
import com.oracle.truffle.r.runtime.nodes.RSyntaxElement;
import com.oracle.truffle.r.runtime.nodes.RSyntaxNode;
@@ -616,7 +615,7 @@ final class REngine implements Engine, Engine.Timings {
if (printResult && result != null) {
assert topLevel;
if (visibility.execute(vf)) {
- printResultImpl(result);
+ printResultImpl(RContext.getInstance(), result);
}
}
if (topLevel) {
@@ -684,19 +683,23 @@ final class REngine implements Engine, Engine.Timings {
}
@Override
- public void printResult(Object originalResult) {
- printResultImpl(originalResult);
+ public void printResult(RContext ctx, Object originalResult) {
+ printResultImpl(ctx, originalResult);
}
@TruffleBoundary
- static void printResultImpl(Object originalResult) {
+ static void printResultImpl(RContext ctx, Object originalResult) {
Object result = evaluatePromise(originalResult);
result = RRuntime.asAbstractVector(result);
+ MaterializedFrame callingFrame = REnvironment.globalEnv(ctx).getFrame();
+ printValue(ctx, callingFrame, result);
+ }
+
+ private static void printValue(RContext ctx, MaterializedFrame callingFrame, Object result) {
if (result instanceof RTypedValue || result instanceof TruffleObject) {
Object resultValue = ShareObjectNode.share(evaluatePromise(result));
- MaterializedFrame callingFrame = REnvironment.globalEnv().getFrame();
if (result instanceof RAttributable && ((RAttributable) result).isS4()) {
- Object printMethod = REnvironment.getRegisteredNamespace("methods").get("show");
+ Object printMethod = REnvironment.getRegisteredNamespace(ctx, "methods").get("show");
RFunction function = (RFunction) evaluatePromise(printMethod);
CallRFunctionNode.executeSlowpath(function, RCaller.createInvalid(callingFrame), callingFrame, new Object[]{resultValue}, null);
} else {
@@ -719,27 +722,6 @@ final class REngine implements Engine, Engine.Timings {
}
}
- /*
- * This abstracts the calling convention, etc. behind the RASTBuilder, but creating large
- * amounts of CallTargets during testing is too much overhead at the moment.
- */
- @SuppressWarnings("unused")
- private void printAlternative(Object result) {
- Object printFunction;
- if (result instanceof RAttributable && ((RAttributable) result).isS4()) {
- printFunction = REnvironment.getRegisteredNamespace("methods").get("show");
- } else {
- printFunction = REnvironment.getRegisteredNamespace("base").get("print");
- }
- RFunction function = (RFunction) evaluatePromise(printFunction);
-
- MaterializedFrame callingFrame = REnvironment.globalEnv().getFrame();
- // create a piece of AST to perform the call
- RCodeBuilder<RSyntaxNode> builder = RContext.getASTBuilder();
- RSyntaxNode call = builder.call(RSyntaxNode.LAZY_DEPARSE, builder.constant(RSyntaxNode.LAZY_DEPARSE, function), builder.constant(RSyntaxNode.LAZY_DEPARSE, result));
- doMakeCallTarget(call.asRNode(), RSource.Internal.EVAL_WRAPPER.string, false, false).call(callingFrame);
- }
-
private static Object evaluatePromise(Object value) {
return value instanceof RPromise ? PromiseHelperNode.evaluateSlowPath((RPromise) value) : value;
}
diff --git a/com.oracle.truffle.r.ffi.codegen/src/com/oracle/truffle/r/ffi/codegen/FFIVariablesCodeGen.java b/com.oracle.truffle.r.ffi.codegen/src/com/oracle/truffle/r/ffi/codegen/FFIVariablesCodeGen.java
index 58e4f7c87abb5043dbf34512b9ddcbcf9f1d58c9..a0ebc7efa90c03ada77861aec09d50072dc1893f 100644
--- a/com.oracle.truffle.r.ffi.codegen/src/com/oracle/truffle/r/ffi/codegen/FFIVariablesCodeGen.java
+++ b/com.oracle.truffle.r.ffi.codegen/src/com/oracle/truffle/r/ffi/codegen/FFIVariablesCodeGen.java
@@ -36,7 +36,7 @@ public class FFIVariablesCodeGen {
*/
public static void main(String[] args) {
System.out.println("// Update com.oracle.truffle.r.native/fficall/src/common/rffi_variablesindex.h with the following: \n");
- System.out.println("// Generated by RFFIVariables.java:\n");
+ System.out.printf("// Generated by %s\n\n", FFIVariablesCodeGen.class.getSimpleName());
for (RFFIVariables var : RFFIVariables.values()) {
System.out.printf("#define %s_x %d\n", var.name(), var.ordinal());
}
@@ -44,7 +44,7 @@ public class FFIVariablesCodeGen {
System.out.println("\n\n// Update com.oracle.truffle.r.native/fficall/src/truffle_nfi/variables.c with the following: \n");
- System.out.println("// Generated by RFFIVariables.java:\n");
+ System.out.printf("// Generated by %s\n\n", FFIVariablesCodeGen.class.getSimpleName());
for (RFFIVariables val : RFFIVariables.values()) {
if (val == RFFIVariables.R_Interactive) {
diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/JavaUpCallsRFFIImpl.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/JavaUpCallsRFFIImpl.java
index ca17d26f435d74daa2f00e0468baf057a3d9dc08..c7984a2e4953a5c1b80e11efebc6db76bc7f5180 100644
--- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/JavaUpCallsRFFIImpl.java
+++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/JavaUpCallsRFFIImpl.java
@@ -740,6 +740,21 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI {
throw implementedAsNode();
}
+ @Override
+ public Object SETCADDR(Object x, Object y) {
+ throw implementedAsNode();
+ }
+
+ @Override
+ public Object SETCADDDR(Object x, Object y) {
+ throw implementedAsNode();
+ }
+
+ @Override
+ public Object SETCAD4R(Object x, Object y) {
+ throw implementedAsNode();
+ }
+
@Override
@TruffleBoundary
public Object SYMVALUE(Object x) {
@@ -1589,6 +1604,11 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI {
return new DotSymbol(name, new SymbolHandle(fun), numArgs);
}
+ @Override
+ public Object getEmbeddingDLLInfo() {
+ return DLL.getEmbeddingDLLInfo();
+ }
+
protected abstract Object setSymbol(DLLInfo dllInfo, int nstOrd, Object routines, int index);
@Override
@@ -1997,6 +2017,11 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI {
return new VectorWrapper(guaranteeVectorOrNull(x, CharSXPWrapper.class));
}
+ @Override
+ public void Rf_PrintValue(Object value) {
+ throw implementedAsNode();
+ }
+
private static TruffleObject guaranteeVectorOrNull(Object obj, Class<? extends TruffleObject> clazz) {
if (obj == RNull.instance) {
return RNull.instance;
diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nfi/HandleNFIUpCallExceptionNode.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nfi/HandleNFIUpCallExceptionNode.java
index 4c3835c1d68b5de9b9fd93ccccaa24471d3f9b1a..a5bfb6562e1749fc6b52805032bb57fef37eb5e6 100644
--- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nfi/HandleNFIUpCallExceptionNode.java
+++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nfi/HandleNFIUpCallExceptionNode.java
@@ -24,16 +24,22 @@ package com.oracle.truffle.r.ffi.impl.nfi;
import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary;
import com.oracle.truffle.api.nodes.Node;
+import com.oracle.truffle.api.profiles.ConditionProfile;
+import com.oracle.truffle.r.runtime.context.RContext;
import com.oracle.truffle.r.runtime.ffi.CallRFFI.HandleUpCallExceptionNode;
import com.oracle.truffle.r.runtime.ffi.DownCallNodeFactory.DownCallNode;
import com.oracle.truffle.r.runtime.ffi.NativeFunction;
public class HandleNFIUpCallExceptionNode extends Node implements HandleUpCallExceptionNode {
@Child private DownCallNode setFlagNode = TruffleNFI_DownCallNodeFactory.INSTANCE.createDownCallNode(NativeFunction.set_exception_flag);
+ private final ConditionProfile isEmbeddedTopLevel = ConditionProfile.createBinaryProfile();
@Override
@TruffleBoundary
public void execute(Throwable originalEx) {
+ if (isEmbeddedTopLevel.profile(RContext.isEmbedded() && isTopLevel())) {
+ return;
+ }
setFlagNode.call();
RuntimeException ex;
if (originalEx instanceof RuntimeException) {
@@ -43,4 +49,8 @@ public class HandleNFIUpCallExceptionNode extends Node implements HandleUpCallEx
}
TruffleNFI_Context.getInstance().setLastUpCallException(ex);
}
+
+ private static boolean isTopLevel() {
+ return ((TruffleNFI_Context) RContext.getInstance().getRFFI()).getCallDepth() == 0;
+ }
}
diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/ListAccessNodes.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/ListAccessNodes.java
index 379adb56840d43fc6fecbed3ea96407bed54f423..41cc4ea43f5faab05c0b2aae65c98427ec8a036f 100644
--- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/ListAccessNodes.java
+++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/ListAccessNodes.java
@@ -172,6 +172,52 @@ public final class ListAccessNodes {
}
}
+ @TypeSystemReference(RTypes.class)
+ public static final class SETCADDRNode extends FFIUpCallNode.Arg2 {
+ @Child CDDRNode cddr = CDDRNode.create();
+ @Child SETCARNode setcarNode = SETCARNode.create();
+
+ @Override
+ public Object executeObject(Object x, Object val) {
+ return setcarNode.executeObject(cddr.executeObject(x), val);
+ }
+
+ public static SETCADDRNode create() {
+ return new SETCADDRNode();
+ }
+ }
+
+ @TypeSystemReference(RTypes.class)
+ public static final class SETCADDDRNode extends FFIUpCallNode.Arg2 {
+ @Child CDDDRNode cdddr = CDDDRNode.create();
+ @Child SETCARNode setcarNode = SETCARNode.create();
+
+ @Override
+ public Object executeObject(Object x, Object val) {
+ return setcarNode.executeObject(cdddr.executeObject(x), val);
+ }
+
+ public static SETCADDDRNode create() {
+ return new SETCADDDRNode();
+ }
+ }
+
+ @TypeSystemReference(RTypes.class)
+ public static final class SETCAD4RNode extends FFIUpCallNode.Arg2 {
+ @Child CDDDRNode cdddr = CDDDRNode.create();
+ @Child CDRNode cdr = CDRNode.create();
+ @Child SETCARNode setcarNode = SETCARNode.create();
+
+ @Override
+ public Object executeObject(Object x, Object val) {
+ return setcarNode.executeObject(cdddr.executeObject(cdr.executeObject(x)), val);
+ }
+
+ public static SETCAD4RNode create() {
+ return new SETCAD4RNode();
+ }
+ }
+
@TypeSystemReference(RTypes.class)
public abstract static class SETCARNode extends FFIUpCallNode.Arg2 {
public static SETCARNode create() {
diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/MiscNodes.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/MiscNodes.java
index 79eecdc8078f5bff3db1aa1d48989e59ae8177eb..1b2b55205c58fd9e3de6a7f9463a2ea1a1d20cd1 100644
--- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/MiscNodes.java
+++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/MiscNodes.java
@@ -52,11 +52,13 @@ import com.oracle.truffle.r.nodes.attributes.SpecialAttributesFunctionsFactory.S
import com.oracle.truffle.r.nodes.builtin.EnvironmentNodes.GetFunctionEnvironmentNode;
import com.oracle.truffle.r.nodes.builtin.casts.fluent.CastNodeBuilder;
import com.oracle.truffle.r.nodes.function.FunctionDefinitionNode;
+import com.oracle.truffle.r.nodes.function.call.RExplicitCallNode;
import com.oracle.truffle.r.nodes.objects.NewObject;
import com.oracle.truffle.r.nodes.objects.NewObjectNodeGen;
import com.oracle.truffle.r.nodes.unary.CastNode;
import com.oracle.truffle.r.nodes.unary.SizeToOctalRawNode;
import com.oracle.truffle.r.runtime.RError;
+import com.oracle.truffle.r.runtime.context.RContext;
import com.oracle.truffle.r.runtime.data.CharSXPWrapper;
import com.oracle.truffle.r.runtime.data.RArgsValuesAndNames;
import com.oracle.truffle.r.runtime.data.RFunction;
@@ -360,4 +362,12 @@ public final class MiscNodes {
return OctSizeNodeGen.create();
}
}
+
+ public static final class RfPrintValueNode extends FFIUpCallNode.Arg1 {
+ @Override
+ public Object executeObject(Object value) {
+ RContext.getEngine().printResult(RContext.getInstance(), value);
+ return RNull.instance;
+ }
+ }
}
diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/RfEvalNode.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/RfEvalNode.java
index 8a12776808ffefc28f31dc13e277846572425e11..4b795471d4427658e9c5ea5a0f73e1015fcdf12d 100644
--- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/RfEvalNode.java
+++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/RfEvalNode.java
@@ -26,12 +26,15 @@ import static com.oracle.truffle.r.runtime.RError.Message.ARGUMENT_NOT_ENVIRONME
import static com.oracle.truffle.r.runtime.RError.Message.ARGUMENT_NOT_FUNCTION;
import static com.oracle.truffle.r.runtime.RError.Message.UNKNOWN_OBJECT;
+import org.graalvm.polyglot.Value;
+
import com.oracle.truffle.api.CompilerDirectives;
import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary;
import com.oracle.truffle.api.dsl.Cached;
import com.oracle.truffle.api.dsl.Fallback;
import com.oracle.truffle.api.dsl.Specialization;
import com.oracle.truffle.api.profiles.ConditionProfile;
+import com.oracle.truffle.api.profiles.ValueProfile;
import com.oracle.truffle.r.nodes.access.variables.ReadVariableNode;
import com.oracle.truffle.r.nodes.function.PromiseHelperNode;
import com.oracle.truffle.r.runtime.ArgumentsSignature;
@@ -51,11 +54,18 @@ import com.oracle.truffle.r.runtime.env.REnvironment;
public abstract class RfEvalNode extends FFIUpCallNode.Arg2 {
@Child private PromiseHelperNode promiseHelper;
+ private final ConditionProfile envIsNullProfile = ConditionProfile.createBinaryProfile();
public static RfEvalNode create() {
return RfEvalNodeGen.create();
}
+ @Specialization
+ @TruffleBoundary
+ Object handlePromise(RPromise expr, @SuppressWarnings("unused") RNull nulLEnv) {
+ return getPromiseHelper().evaluate(null, expr);
+ }
+
@Specialization
@TruffleBoundary
Object handlePromise(RPromise expr, @SuppressWarnings("unused") REnvironment env) {
@@ -64,20 +74,21 @@ public abstract class RfEvalNode extends FFIUpCallNode.Arg2 {
@Specialization
@TruffleBoundary
- Object handleExpression(RExpression expr, REnvironment env) {
- return RContext.getEngine().eval(expr, env, null);
+ Object handleExpression(RExpression expr, Object envArg) {
+ return RContext.getEngine().eval(expr, getEnv(envArg), null);
}
@Specialization
@TruffleBoundary
- Object handleLanguage(RLanguage expr, REnvironment env) {
- return RContext.getEngine().eval(expr, env, null);
+ Object handleLanguage(RLanguage expr, Object envArg) {
+ return RContext.getEngine().eval(expr, getEnv(envArg), null);
}
@Specialization
@TruffleBoundary
- Object handleSymbol(RSymbol expr, REnvironment env) {
- Object result = ReadVariableNode.lookupAny(expr.getName(), env.getFrame(), false);
+ Object handleSymbol(RSymbol expr, Object envArg,
+ @Cached("createClassProfile()") ValueProfile accessProfile) {
+ Object result = ReadVariableNode.lookupAny(expr.getName(), getEnv(envArg).getFrame(accessProfile), false);
if (result == null) {
throw RError.error(RError.NO_CALLER, UNKNOWN_OBJECT, expr.getName());
}
@@ -85,18 +96,23 @@ public abstract class RfEvalNode extends FFIUpCallNode.Arg2 {
}
@Specialization
- Object handlePairList(RPairList l, REnvironment env,
+ Object handlePairList(RPairList l, Object envArg,
@Cached("createBinaryProfile()") ConditionProfile isPromiseProfile,
@Cached("createBinaryProfile()") ConditionProfile noArgsProfile) {
+ REnvironment env = getEnv(envArg);
Object car = l.car();
- RFunction f;
+ RFunction f = null;
if (isPromiseProfile.profile(car instanceof RPromise)) {
car = getPromiseHelper().evaluate(null, (RPromise) car);
}
if (car instanceof RFunction) {
f = (RFunction) car;
- } else {
+ } else if (car instanceof RSymbol) {
+ f = ReadVariableNode.lookupFunction(((RSymbol) car).getName(), env.getFrame());
+ }
+
+ if (f == null) {
throw RError.error(RError.NO_CALLER, ARGUMENT_NOT_FUNCTION);
}
@@ -119,10 +135,21 @@ public abstract class RfEvalNode extends FFIUpCallNode.Arg2 {
if (env instanceof REnvironment) {
return expr;
} else {
+ CompilerDirectives.transferToInterpreter();
throw RError.error(RError.NO_CALLER, ARGUMENT_NOT_ENVIRONMENT);
}
}
+ private REnvironment getEnv(Object envArg) {
+ if (envIsNullProfile.profile(envArg == RNull.instance)) {
+ return REnvironment.globalEnv(RContext.getInstance());
+ } else if (envArg instanceof REnvironment) {
+ return (REnvironment) envArg;
+ }
+ CompilerDirectives.transferToInterpreter();
+ throw RError.error(RError.NO_CALLER, ARGUMENT_NOT_ENVIRONMENT);
+ }
+
private PromiseHelperNode getPromiseHelper() {
if (promiseHelper == null) {
CompilerDirectives.transferToInterpreterAndInvalidate();
diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/TryRfEvalNode.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/TryRfEvalNode.java
index 7048ab7c49dadf6d4f58c299f97fdbf43f0a0c92..7783c59bf988b1f200e47ac52d89c47a7a878689 100644
--- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/TryRfEvalNode.java
+++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/TryRfEvalNode.java
@@ -22,35 +22,67 @@
*/
package com.oracle.truffle.r.ffi.impl.nodes;
+import com.oracle.truffle.api.CompilerDirectives;
import com.oracle.truffle.api.interop.ForeignAccess;
import com.oracle.truffle.api.interop.InteropException;
import com.oracle.truffle.api.interop.Message;
import com.oracle.truffle.api.interop.TruffleObject;
+import com.oracle.truffle.api.interop.UnsupportedMessageException;
import com.oracle.truffle.api.nodes.Node;
+import com.oracle.truffle.r.ffi.impl.interop.UnsafeAdapter;
import com.oracle.truffle.r.runtime.RErrorHandling;
+import com.oracle.truffle.r.runtime.RInternalError;
+import com.oracle.truffle.r.runtime.data.RNull;
public final class TryRfEvalNode extends FFIUpCallNode.Arg4 {
- @Child RfEvalNode rfEvalNode = RfEvalNode.create();
- @Child Node writeErrorFlagNode = Message.WRITE.createNode();
+ @Child private RfEvalNode rfEvalNode = RfEvalNode.create();
+ @Child private Node isNullNode = Message.IS_NULL.createNode();
+ @Child private Node writeErrorFlagNode;
+ @Child private Node isPointerNode;
+ @Child private Node asPointerNode;
@Override
public Object executeObject(Object expr, Object env, Object errorFlag, Object silent) {
Object handlerStack = RErrorHandling.getHandlerStack();
Object restartStack = RErrorHandling.getRestartStack();
+ boolean ok = true;
+ Object result = RNull.instance;
try {
// TODO handle silent
RErrorHandling.resetStacks();
- return rfEvalNode.executeObject(expr, env);
+ result = rfEvalNode.executeObject(expr, env);
} catch (Throwable t) {
- try {
- ForeignAccess.sendWrite(writeErrorFlagNode, (TruffleObject) errorFlag, 0, 1);
- } catch (InteropException e) {
- // Ignore it, when using NFI, e.g., the errorFlag TO does not support the WRITE
- // message
- }
- return null;
+ ok = false;
+ result = RNull.instance;
} finally {
RErrorHandling.restoreStacks(handlerStack, restartStack);
}
+ TruffleObject errorFlagTO = (TruffleObject) errorFlag;
+ if (!ForeignAccess.sendIsNull(isNullNode, errorFlagTO)) {
+ if (isPointerNode == null) {
+ CompilerDirectives.transferToInterpreterAndInvalidate();
+ isPointerNode = insert(Message.IS_POINTER.createNode());
+ }
+ if (ForeignAccess.sendIsPointer(isPointerNode, errorFlagTO)) {
+ if (asPointerNode == null) {
+ CompilerDirectives.transferToInterpreterAndInvalidate();
+ asPointerNode = insert(Message.AS_POINTER.createNode());
+ }
+ long errorFlagPtr;
+ try {
+ errorFlagPtr = ForeignAccess.sendAsPointer(asPointerNode, errorFlagTO);
+ } catch (UnsupportedMessageException e) {
+ throw RInternalError.shouldNotReachHere("IS_POINTER message returned true, AS_POINTER should not fail");
+ }
+ UnsafeAdapter.UNSAFE.putInt(errorFlagPtr, ok ? 0 : 1);
+ } else {
+ try {
+ ForeignAccess.sendWrite(writeErrorFlagNode, errorFlagTO, 0, 1);
+ } catch (InteropException e) {
+ throw RInternalError.shouldNotReachHere("Rf_tryEval errorFlag should be either pointer or support WRITE message");
+ }
+ }
+ }
+ return result;
}
}
diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/DLLUpCallsRFFI.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/DLLUpCallsRFFI.java
index 336062d6f09c01b5b1d83d6506610ab78bcd0eee..3064448d1d7ac885ba5276918b88d1c7f0440699 100644
--- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/DLLUpCallsRFFI.java
+++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/DLLUpCallsRFFI.java
@@ -1,5 +1,5 @@
/*
- * Copyright (c) 2017, 2017, Oracle and/or its affiliates. All rights reserved.
+ * Copyright (c) 2017, 2018, 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
@@ -71,4 +71,11 @@ public interface DLLUpCallsRFFI {
@RFFICpointer
Object getCCallable(@RFFICstring String pkgName, @RFFICstring String functionName);
+ /**
+ * Returns special {@link com.oracle.truffle.r.runtime.ffi.DLL.DLLInfo} instance that is
+ * supposed to be used when registering symbols from within code embedding R, i.e. code that
+ * cannot have its init method called by R runtime and must call {@code R_registerRoutines}
+ * itself.
+ */
+ Object getEmbeddingDLLInfo();
}
diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/FFIUnwrapNode.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/FFIUnwrapNode.java
index 4d5aafa461450125c8692ffabfe9d208b9cf9bc2..40a3f13e3ff2d2b2492106e3b005741412ff937c 100644
--- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/FFIUnwrapNode.java
+++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/FFIUnwrapNode.java
@@ -32,6 +32,7 @@ import com.oracle.truffle.api.nodes.Node;
import com.oracle.truffle.api.profiles.BranchProfile;
import com.oracle.truffle.r.runtime.RInternalError;
import com.oracle.truffle.r.runtime.data.NativeDataAccess;
+import com.oracle.truffle.r.runtime.data.RNull;
import com.oracle.truffle.r.runtime.data.RTruffleObject;
/**
@@ -64,6 +65,11 @@ public final class FFIUnwrapNode extends Node {
}
try {
long address = ForeignAccess.sendAsPointer(asPointer, xTo);
+ if (address == 0) {
+ // Users are expected to use R_NULL, but at least when embedding, GNU R
+ // seems to be tolerant to NULLs.
+ return RNull.instance;
+ }
return NativeDataAccess.lookup(address);
} catch (UnsupportedMessageException e) {
if (isPointerNode == null) {
diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/StdUpCallsRFFI.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/StdUpCallsRFFI.java
index 3bb818f4b30721b643f928494f6f2f5dfa0ef0ce..7151f48559114fb8d46b16b17ced7a418ab8e13e 100644
--- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/StdUpCallsRFFI.java
+++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/StdUpCallsRFFI.java
@@ -45,6 +45,9 @@ import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodes.CDARNode;
import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodes.CDDDRNode;
import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodes.CDDRNode;
import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodes.CDRNode;
+import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodes.SETCAD4RNode;
+import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodes.SETCADDDRNode;
+import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodes.SETCADDRNode;
import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodes.SETCADRNode;
import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodes.SETCARNode;
import com.oracle.truffle.r.ffi.impl.nodes.MatchNodes;
@@ -263,6 +266,15 @@ public interface StdUpCallsRFFI {
@RFFIUpCallNode(SETCADRNode.class)
Object SETCADR(Object x, Object y);
+ @RFFIUpCallNode(SETCADDRNode.class)
+ Object SETCADDR(Object x, Object y);
+
+ @RFFIUpCallNode(SETCADDDRNode.class)
+ Object SETCADDDR(Object x, Object y);
+
+ @RFFIUpCallNode(SETCAD4RNode.class)
+ Object SETCAD4R(Object x, Object y);
+
Object SYMVALUE(Object x);
void SET_SYMVALUE(Object x, Object v);
@@ -455,4 +467,6 @@ public interface StdUpCallsRFFI {
@RFFIUpCallNode(MiscNodes.OctSizeNode.class)
Object octsize(Object size);
+ @RFFIUpCallNode(MiscNodes.RfPrintValueNode.class)
+ void Rf_PrintValue(Object value);
}
diff --git a/com.oracle.truffle.r.native/fficall/src/common/rffi_upcalls.h b/com.oracle.truffle.r.native/fficall/src/common/rffi_upcalls.h
index 673d871727f2ad590e1fc44bb8e17fe7cc4ca23e..307b1d2fcd52091e8055fa8d94262cfc8684ea77 100644
--- a/com.oracle.truffle.r.native/fficall/src/common/rffi_upcalls.h
+++ b/com.oracle.truffle.r.native/fficall/src/common/rffi_upcalls.h
@@ -290,6 +290,7 @@ typedef SEXP (*call_R_ParseVector)(SEXP text, int n, SEXP srcFile);
typedef SEXPTYPE (*call_Rf_str2type)(const char *s);
typedef SEXP (*call_CLOENV)(SEXP closure);
typedef SEXP (*call_octsize)(SEXP size);
+typedef void (*call_Rf_PrintValue)(SEXP x);
// connections
@@ -314,6 +315,7 @@ typedef void * (*call_setDotSymbolValues)(DllInfo *dllInfo, char *name, DL_FUNC
typedef int (*call_forceSymbols)(DllInfo *dllInfo, Rboolean value);
typedef int (*call_registerCCallable)(const char *pkgname, const char *name, void *fun);
typedef void* (*call_getCCallable)(const char *pkgname, const char *name);
+typedef DllInfo* (*call_getEmbeddingDLLInfo)(void);
// memory
diff --git a/com.oracle.truffle.r.native/fficall/src/common/rffi_upcallsindex.h b/com.oracle.truffle.r.native/fficall/src/common/rffi_upcallsindex.h
index be731d8ff016ecebcd73df8124bfd0222f8a4ce6..8c6c12994411ddc5c7c0fa7a6e43e5ce5c922238 100644
--- a/com.oracle.truffle.r.native/fficall/src/common/rffi_upcallsindex.h
+++ b/com.oracle.truffle.r.native/fficall/src/common/rffi_upcallsindex.h
@@ -1,4 +1,4 @@
-// GENERATED; DO NOT EDIT
+// GENERATED by com.oracle.truffle.r.ffi.processor.FFIProcessor class; DO NOT EDIT
#ifndef RFFI_UPCALLSINDEX_H
#define RFFI_UPCALLSINDEX_H
@@ -94,103 +94,108 @@
#define Rf_GetOption1_x 89
#define Rf_NonNullStringMatch_x 90
#define Rf_PairToVectorList_x 91
-#define Rf_ScalarDouble_x 92
-#define Rf_ScalarInteger_x 93
-#define Rf_ScalarLogical_x 94
-#define Rf_ScalarString_x 95
-#define Rf_VectorToPairList_x 96
-#define Rf_allocArray_x 97
-#define Rf_allocMatrix_x 98
-#define Rf_allocVector_x 99
-#define Rf_any_duplicated_x 100
-#define Rf_asChar_x 101
-#define Rf_asCharacterFactor_x 102
-#define Rf_asInteger_x 103
-#define Rf_asLogical_x 104
-#define Rf_asReal_x 105
-#define Rf_classgets_x 106
-#define Rf_coerceVector_x 107
-#define Rf_cons_x 108
-#define Rf_copyListMatrix_x 109
-#define Rf_copyMatrix_x 110
-#define Rf_copyMostAttrib_x 111
-#define Rf_dchisq_x 112
-#define Rf_defineVar_x 113
-#define Rf_dnchisq_x 114
-#define Rf_dunif_x 115
-#define Rf_duplicate_x 116
-#define Rf_error_x 117
-#define Rf_errorcall_x 118
-#define Rf_eval_x 119
-#define Rf_findFun_x 120
-#define Rf_findVar_x 121
-#define Rf_findVarInFrame_x 122
-#define Rf_findVarInFrame3_x 123
-#define Rf_getAttrib_x 124
-#define Rf_gsetVar_x 125
-#define Rf_inherits_x 126
-#define Rf_install_x 127
-#define Rf_installChar_x 128
-#define Rf_isNull_x 129
-#define Rf_isString_x 130
-#define Rf_lengthgets_x 131
-#define Rf_match_x 132
-#define Rf_mkCharLenCE_x 133
-#define Rf_namesgets_x 134
-#define Rf_ncols_x 135
-#define Rf_nrows_x 136
-#define Rf_pchisq_x 137
-#define Rf_pnchisq_x 138
-#define Rf_protect_x 139
-#define Rf_punif_x 140
-#define Rf_qchisq_x 141
-#define Rf_qnchisq_x 142
-#define Rf_qunif_x 143
-#define Rf_rchisq_x 144
-#define Rf_rnchisq_x 145
-#define Rf_runif_x 146
-#define Rf_setAttrib_x 147
-#define Rf_str2type_x 148
-#define Rf_unprotect_x 149
-#define Rf_unprotect_ptr_x 150
-#define Rf_warning_x 151
-#define Rf_warningcall_x 152
-#define Rprintf_x 153
-#define SETCADR_x 154
-#define SETCAR_x 155
-#define SETCDR_x 156
-#define SET_BODY_x 157
-#define SET_CLOENV_x 158
-#define SET_FORMALS_x 159
-#define SET_NAMED_FASTR_x 160
-#define SET_RDEBUG_x 161
-#define SET_RSTEP_x 162
-#define SET_S4_OBJECT_x 163
-#define SET_STRING_ELT_x 164
-#define SET_SYMVALUE_x 165
-#define SET_TAG_x 166
-#define SET_TYPEOF_FASTR_x 167
-#define SET_VECTOR_ELT_x 168
-#define STRING_ELT_x 169
-#define SYMVALUE_x 170
-#define TAG_x 171
-#define TYPEOF_x 172
-#define UNSET_S4_OBJECT_x 173
-#define VECTOR_ELT_x 174
-#define forceSymbols_x 175
-#define getCCallable_x 176
-#define getConnectionClassString_x 177
-#define getOpenModeString_x 178
-#define getSummaryDescription_x 179
-#define isSeekable_x 180
-#define octsize_x 181
-#define registerCCallable_x 182
-#define registerRoutines_x 183
-#define restoreHandlerStacks_x 184
-#define setDotSymbolValues_x 185
-#define unif_rand_x 186
-#define useDynamicSymbols_x 187
+#define Rf_PrintValue_x 92
+#define Rf_ScalarDouble_x 93
+#define Rf_ScalarInteger_x 94
+#define Rf_ScalarLogical_x 95
+#define Rf_ScalarString_x 96
+#define Rf_VectorToPairList_x 97
+#define Rf_allocArray_x 98
+#define Rf_allocMatrix_x 99
+#define Rf_allocVector_x 100
+#define Rf_any_duplicated_x 101
+#define Rf_asChar_x 102
+#define Rf_asCharacterFactor_x 103
+#define Rf_asInteger_x 104
+#define Rf_asLogical_x 105
+#define Rf_asReal_x 106
+#define Rf_classgets_x 107
+#define Rf_coerceVector_x 108
+#define Rf_cons_x 109
+#define Rf_copyListMatrix_x 110
+#define Rf_copyMatrix_x 111
+#define Rf_copyMostAttrib_x 112
+#define Rf_dchisq_x 113
+#define Rf_defineVar_x 114
+#define Rf_dnchisq_x 115
+#define Rf_dunif_x 116
+#define Rf_duplicate_x 117
+#define Rf_error_x 118
+#define Rf_errorcall_x 119
+#define Rf_eval_x 120
+#define Rf_findFun_x 121
+#define Rf_findVar_x 122
+#define Rf_findVarInFrame_x 123
+#define Rf_findVarInFrame3_x 124
+#define Rf_getAttrib_x 125
+#define Rf_gsetVar_x 126
+#define Rf_inherits_x 127
+#define Rf_install_x 128
+#define Rf_installChar_x 129
+#define Rf_isNull_x 130
+#define Rf_isString_x 131
+#define Rf_lengthgets_x 132
+#define Rf_match_x 133
+#define Rf_mkCharLenCE_x 134
+#define Rf_namesgets_x 135
+#define Rf_ncols_x 136
+#define Rf_nrows_x 137
+#define Rf_pchisq_x 138
+#define Rf_pnchisq_x 139
+#define Rf_protect_x 140
+#define Rf_punif_x 141
+#define Rf_qchisq_x 142
+#define Rf_qnchisq_x 143
+#define Rf_qunif_x 144
+#define Rf_rchisq_x 145
+#define Rf_rnchisq_x 146
+#define Rf_runif_x 147
+#define Rf_setAttrib_x 148
+#define Rf_str2type_x 149
+#define Rf_unprotect_x 150
+#define Rf_unprotect_ptr_x 151
+#define Rf_warning_x 152
+#define Rf_warningcall_x 153
+#define Rprintf_x 154
+#define SETCAD4R_x 155
+#define SETCADDDR_x 156
+#define SETCADDR_x 157
+#define SETCADR_x 158
+#define SETCAR_x 159
+#define SETCDR_x 160
+#define SET_BODY_x 161
+#define SET_CLOENV_x 162
+#define SET_FORMALS_x 163
+#define SET_NAMED_FASTR_x 164
+#define SET_RDEBUG_x 165
+#define SET_RSTEP_x 166
+#define SET_S4_OBJECT_x 167
+#define SET_STRING_ELT_x 168
+#define SET_SYMVALUE_x 169
+#define SET_TAG_x 170
+#define SET_TYPEOF_FASTR_x 171
+#define SET_VECTOR_ELT_x 172
+#define STRING_ELT_x 173
+#define SYMVALUE_x 174
+#define TAG_x 175
+#define TYPEOF_x 176
+#define UNSET_S4_OBJECT_x 177
+#define VECTOR_ELT_x 178
+#define forceSymbols_x 179
+#define getCCallable_x 180
+#define getConnectionClassString_x 181
+#define getEmbeddingDLLInfo_x 182
+#define getOpenModeString_x 183
+#define getSummaryDescription_x 184
+#define isSeekable_x 185
+#define octsize_x 186
+#define registerCCallable_x 187
+#define registerRoutines_x 188
+#define restoreHandlerStacks_x 189
+#define setDotSymbolValues_x 190
+#define unif_rand_x 191
+#define useDynamicSymbols_x 192
-#define UPCALLS_TABLE_SIZE 188
+#define UPCALLS_TABLE_SIZE 193
#endif // RFFI_UPCALLSINDEX_H
diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_common/Rinternals_truffle_common.h b/com.oracle.truffle.r.native/fficall/src/truffle_common/Rinternals_truffle_common.h
index aaf82384b184450d1e136097cbfa4b44f8dd95e1..82bf7b8f64b6c1c2a002a7b769f31f757865f43d 100644
--- a/com.oracle.truffle.r.native/fficall/src/truffle_common/Rinternals_truffle_common.h
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_common/Rinternals_truffle_common.h
@@ -490,7 +490,8 @@ Rboolean Rf_isObject(SEXP s) {
void Rf_PrintValue(SEXP x) {
TRACE0();
- unimplemented("Rf_PrintValue");
+ ((call_Rf_PrintValue) callbacks[Rf_PrintValue_x])(x);
+ checkExitCall();
}
SEXP Rf_install(const char *name) {
@@ -770,19 +771,20 @@ SEXP SETCADR(SEXP x, SEXP y) {
SEXP SETCADDR(SEXP x, SEXP y) {
TRACE0();
- unimplemented("SETCADDR");
+ // note: signature is same, we reuse call_SETCADR
+ SEXP result = ((call_SETCADR) callbacks[SETCADDR_x])(x, y);
return NULL;
}
SEXP SETCADDDR(SEXP x, SEXP y) {
TRACE0();
- unimplemented("SETCADDDR");
+ SEXP result = ((call_SETCADR) callbacks[SETCADDDR_x])(x, y);
return NULL;
}
-SEXP SETCAD4R(SEXP e, SEXP y) {
+SEXP SETCAD4R(SEXP x, SEXP y) {
TRACE0();
- unimplemented("SETCAD4R");
+ SEXP result = ((call_SETCADR) callbacks[SETCAD4R_x])(x, y);
return NULL;
}
@@ -1663,6 +1665,13 @@ R_registerRoutines(DllInfo *info, const R_CMethodDef * const croutines,
return 1;
}
+DllInfo *R_getEmbeddingDllInfo() {
+ TRACE0();
+ DllInfo *result = ((call_getEmbeddingDLLInfo) callbacks[getEmbeddingDLLInfo_x])();
+ checkExitCall();
+ return result;
+}
+
Rboolean R_useDynamicSymbols(DllInfo *dllInfo, Rboolean value) {
TRACE0();
Rboolean result = ((call_useDynamicSymbols) callbacks[useDynamicSymbols_x])(dllInfo, value);
diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rembedded.c b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rembedded.c
index 001cdcd36e7696e20fc4fac4b948fb187a68ae95..770deeca724b7c9b8a1a43f6fea0058e6e6bbab6 100644
--- a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rembedded.c
+++ b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rembedded.c
@@ -11,6 +11,7 @@
*/
#include <dlfcn.h>
+#include <unistd.h>
#include <sys/utsname.h>
#include <sys/stat.h>
#define R_INTERFACE_PTRS
@@ -25,6 +26,8 @@
// (in single threaded mode) by FastR.
#undef R_Interactive
+#define PATH_BUF_LEN 255
+
extern char **environ;
static JavaVM *javaVM;
@@ -78,17 +81,17 @@ static int initializeFastR(int argc, char *argv[], int setupRmainloop);
// initializes R, but user is expected (TODO: probably) to invoke the main loop after that
int Rf_initialize_R(int argc, char *argv[]) {
- return initializeFastR(argc, argv, 0);
+ return initializeFastR(argc, argv, 0);
}
// initializes R and the main loop without running it
int Rf_initEmbeddedR(int argc, char *argv[]) {
- return initializeFastR(argc, argv, 1);
+ return initializeFastR(argc, argv, 1);
}
void R_DefParams(Rstart rs) {
// These are the GnuR defaults and correspond to the settings in RStartParams
- // None of the size params make any sense for FastR
+ // None of the size params make any sense for FastR
rs->R_Quiet = FALSE;
rs->R_Slave = FALSE;
rs->R_Interactive = TRUE;
@@ -104,131 +107,139 @@ void R_DefParams(Rstart rs) {
// Allows to set-up some params before the main loop is initialized
// This call has to be made via JNI as we are not in a down-call, i.e. in truffle context, when this gets executed.
void R_SetParams(Rstart rs) {
- JNIEnv *jniEnv = getEnv();
- jmethodID setParamsMethodID = checkGetMethodID(jniEnv, rembeddedClass, "setParams", "(ZZZZZZZIIZ)V", 1);
- (*jniEnv)->CallStaticVoidMethod(jniEnv, rStartParamsClass, setParamsMethodID, rs->R_Quiet, rs->R_Slave, rs->R_Interactive,
- rs->R_Verbose, rs->LoadSiteFile, rs->LoadInitFile, rs->DebugInitFile,
- rs->RestoreAction, rs->SaveAction, rs->NoRenviron);
+ JNIEnv *jniEnv = getEnv();
+ jmethodID setParamsMethodID = checkGetMethodID(jniEnv, rembeddedClass, "setParams", "(ZZZZZZZIIZ)V", 1);
+ (*jniEnv)->CallStaticVoidMethod(jniEnv, rStartParamsClass, setParamsMethodID, rs->R_Quiet, rs->R_Slave, rs->R_Interactive,
+ rs->R_Verbose, rs->LoadSiteFile, rs->LoadInitFile, rs->DebugInitFile,
+ rs->RestoreAction, rs->SaveAction, rs->NoRenviron);
}
// Runs the main REPL loop
void Rf_mainloop(void) {
- JNIEnv *jniEnv = getEnv();
- setupOverrides();
- jmethodID mainloopMethod = checkGetMethodID(jniEnv, rembeddedClass, "runRmainloop", "()V", 1);
- (*jniEnv)->CallStaticVoidMethod(jniEnv, rembeddedClass, mainloopMethod);
+ JNIEnv *jniEnv = getEnv();
+ setupOverrides();
+ jmethodID mainloopMethod = checkGetMethodID(jniEnv, rembeddedClass, "runRmainloop", "()V", 1);
+ (*jniEnv)->CallStaticVoidMethod(jniEnv, rembeddedClass, mainloopMethod);
}
void R_Suicide(const char *s) { ptr_R_Suicide(s); }
void Rf_endEmbeddedR(int fatal) {
// TODO: invoke com.oracle.truffle.r.engine.shell.REmbedded#endRmainloop
- (*javaVM)->DestroyJavaVM(javaVM);
- //TODO fatal
+ (*javaVM)->DestroyJavaVM(javaVM);
+ //TODO fatal
}
static int initializeFastR(int argc, char *argv[], int setupRmainloop) {
- if (initialized) {
- fprintf(stderr, "%s", "R is already initialized\n");
- exit(1);
- }
- // print_environ(environ);
- char *r_home = getenv("R_HOME");
- if (r_home == NULL) {
- fprintf(stderr, "R_HOME must be set\n");
- exit(1);
- }
- struct utsname utsname;
- uname(&utsname);
- char jvmlib_path[256];
- java_home = getenv("JAVA_HOME");
- if (java_home == NULL) {
- if (strcmp(utsname.sysname, "Linux") == 0) {
- char *jvmdir = "/usr/java/latest";
- struct stat statbuf;
- if (stat(jvmdir, &statbuf) == 0) {
- java_home = jvmdir;
- }
- } else if (strcmp(utsname.sysname, "Darwin") == 0) {
- char *jvmdir = "/Library/Java/JavaVirtualMachines/jdk.latest";
- struct stat statbuf;
- if (stat(jvmdir, &statbuf) == 0) {
- java_home = (char*)malloc(strlen(jvmdir) + 32);
- strcpy(java_home, jvmdir);
- strcat(java_home, "/Contents/Home");
- }
- }
- if (java_home == NULL) {
- fprintf(stderr, "Rf_initialize_R: can't find a JAVA_HOME\n");
- exit(1);
- }
- }
- strcpy(jvmlib_path, java_home);
- if (strcmp(utsname.sysname, "Linux") == 0) {
- strcat(jvmlib_path, "/jre/lib/amd64/server/libjvm.so");
- } else if (strcmp(utsname.sysname, "Darwin") == 0) {
- strcat(jvmlib_path, "/jre/lib/server/libjvm.dylib");
+ if (initialized) {
+ fprintf(stderr, "%s", "R is already initialized\n");
+ exit(1);
+ }
+ // print_environ(environ);
+ char *r_home = getenv("R_HOME");
+ if (r_home == NULL) {
+ fprintf(stderr, "R_HOME must be set\n");
+ exit(1);
+ }
+ struct utsname utsname;
+ uname(&utsname);
+ char jvmlib_path[PATH_BUF_LEN];
+ java_home = getenv("JAVA_HOME");
+ if (java_home == NULL) {
+ if (strcmp(utsname.sysname, "Linux") == 0) {
+ char *jvmdir = "/usr/java/latest";
+ struct stat statbuf;
+ if (stat(jvmdir, &statbuf) == 0) {
+ java_home = jvmdir;
+ }
+ } else if (strcmp(utsname.sysname, "Darwin") == 0) {
+ char *jvmdir = "/Library/Java/JavaVirtualMachines/jdk.latest";
+ struct stat statbuf;
+ if (stat(jvmdir, &statbuf) == 0) {
+ java_home = (char*)malloc(strlen(jvmdir) + 32);
+ strcpy(java_home, jvmdir);
+ strcat(java_home, "/Contents/Home");
+ }
+ }
+ if (java_home == NULL) {
+ fprintf(stderr, "Rf_initialize_R: can't find a JAVA_HOME\n");
+ exit(1);
+ }
+ }
+ strncpy(jvmlib_path, java_home, sizeof(jvmlib_path));
+ if (strcmp(utsname.sysname, "Linux") == 0) {
+ char jvmlib_path_copy[PATH_BUF_LEN];
+ strcpy(jvmlib_path_copy, jvmlib_path);
+ strcat(jvmlib_path, "/jre/lib/amd64/server/libjvm.so");
+ if (access(jvmlib_path, F_OK) == -1) {
+ // with Java 9 the location does not contain arch name
+ strcpy(jvmlib_path, jvmlib_path_copy);
+ strcat(jvmlib_path, "/lib/server/libjvm.so");
+ }
+ } else if (strcmp(utsname.sysname, "Darwin") == 0) {
+ strcat(jvmlib_path, "/jre/lib/server/libjvm.dylib");
// Must also load libjli to avoid going through framework
- // and failing to find our JAVA_HOME runtime
- char jlilib_path[256];
- strcpy(jlilib_path, java_home);
- strcat(jlilib_path, "/jre/lib/jli/libjli.dylib");
- dlopen_jvmlib(jlilib_path);
- } else {
- fprintf(stderr, "unsupported OS: %s\n", utsname.sysname);
- exit(1);
- }
- void *vm_handle = dlopen_jvmlib(jvmlib_path);
- JNI_CreateJavaVMFunc createJavaVMFunc = (JNI_CreateJavaVMFunc) dlsym(vm_handle, "JNI_CreateJavaVM");
- if (createJavaVMFunc == NULL) {
- fprintf(stderr, "Rf_initialize_R: cannot find JNI_CreateJavaVM\n");
- exit(1);
- }
-
- char *vm_cp = get_classpath(r_home);
- //printf("cp %s\n", vm_cp);
-
- char **vmargs = malloc(argc * sizeof(char*));
- char **uargs = malloc(argc * sizeof(char*));
- int vmargc = process_vmargs(argc, argv, vmargs, uargs);
- argc -= vmargc;
- argv = uargs;
- JavaVMOption vm_options[1 + vmargc];
-
- vm_options[0].optionString = vm_cp;
- for (int i = 0; i < vmargc; i++) {
- vm_options[i + 1].optionString = vmargs[i];
- }
-
- JavaVMInitArgs vm_args;
- vm_args.version = JNI_VERSION_1_8;
- vm_args.nOptions = 1 + vmargc;
- vm_args.options = vm_options;
- vm_args.ignoreUnrecognized = JNI_TRUE;
-
- jint flag = (*createJavaVMFunc)(&javaVM, (void**)
- &jniEnv, &vm_args);
- if (flag == JNI_ERR) {
- fprintf(stderr, "Rf_initEmbeddedR: error creating Java VM, exiting...\n");
- return 1;
- }
-
- rInterfaceCallbacksClass = checkFindClass(jniEnv, "com/oracle/truffle/r/runtime/RInterfaceCallbacks");
- rembeddedClass = checkFindClass(jniEnv, "com/oracle/truffle/r/engine/shell/REmbedded");
- jclass stringClass = checkFindClass(jniEnv, "java/lang/String");
- jmethodID initializeMethod = checkGetMethodID(jniEnv, rembeddedClass, "initializeR", "([Ljava/lang/String;Z)V", 1);
- jobjectArray argsArray = (*jniEnv)->NewObjectArray(jniEnv, argc, stringClass, NULL);
- for (int i = 0; i < argc; i++) {
- jstring arg = (*jniEnv)->NewStringUTF(jniEnv, argv[i]);
- (*jniEnv)->SetObjectArrayElement(jniEnv, argsArray, i, arg);
- }
- if (setupRmainloop) {
+ // and failing to find our JAVA_HOME runtime
+ char jlilib_path[256];
+ strcpy(jlilib_path, java_home);
+ strcat(jlilib_path, "/jre/lib/jli/libjli.dylib");
+ dlopen_jvmlib(jlilib_path);
+ } else {
+ fprintf(stderr, "unsupported OS: %s\n", utsname.sysname);
+ exit(1);
+ }
+
+ void *vm_handle = dlopen_jvmlib(jvmlib_path);
+ JNI_CreateJavaVMFunc createJavaVMFunc = (JNI_CreateJavaVMFunc) dlsym(vm_handle, "JNI_CreateJavaVM");
+ if (createJavaVMFunc == NULL) {
+ fprintf(stderr, "Rf_initialize_R: cannot find JNI_CreateJavaVM\n");
+ exit(1);
+ }
+
+ char *vm_cp = get_classpath(r_home);
+ //printf("cp %s\n", vm_cp);
+
+ char **vmargs = malloc(argc * sizeof(char*));
+ char **uargs = malloc(argc * sizeof(char*));
+ int vmargc = process_vmargs(argc, argv, vmargs, uargs);
+ argc -= vmargc;
+ argv = uargs;
+ JavaVMOption vm_options[1 + vmargc];
+
+ vm_options[0].optionString = vm_cp;
+ for (int i = 0; i < vmargc; i++) {
+ vm_options[i + 1].optionString = vmargs[i];
+ }
+
+ JavaVMInitArgs vm_args;
+ vm_args.version = JNI_VERSION_1_8;
+ vm_args.nOptions = 1 + vmargc;
+ vm_args.options = vm_options;
+ vm_args.ignoreUnrecognized = JNI_TRUE;
+
+ jint flag = (*createJavaVMFunc)(&javaVM, (void**)
+ &jniEnv, &vm_args);
+ if (flag == JNI_ERR) {
+ fprintf(stderr, "Rf_initEmbeddedR: error creating Java VM, exiting...\n");
+ return 1;
+ }
+
+ rInterfaceCallbacksClass = checkFindClass(jniEnv, "com/oracle/truffle/r/runtime/RInterfaceCallbacks");
+ rembeddedClass = checkFindClass(jniEnv, "com/oracle/truffle/r/engine/shell/REmbedded");
+ jclass stringClass = checkFindClass(jniEnv, "java/lang/String");
+ jmethodID initializeMethod = checkGetMethodID(jniEnv, rembeddedClass, "initializeR", "([Ljava/lang/String;Z)V", 1);
+ jobjectArray argsArray = (*jniEnv)->NewObjectArray(jniEnv, argc, stringClass, NULL);
+ for (int i = 0; i < argc; i++) {
+ jstring arg = (*jniEnv)->NewStringUTF(jniEnv, argv[i]);
+ (*jniEnv)->SetObjectArrayElement(jniEnv, argsArray, i, arg);
+ }
+ if (setupRmainloop) {
setupOverrides();
- }
- // Can't TRACE this upcall as system not initialized
- (*jniEnv)->CallStaticObjectMethod(jniEnv, rembeddedClass, initializeMethod, argsArray, setupRmainloop);
- initialized++;
- return 0;
+ }
+ // Can't TRACE this upcall as system not initialized
+ (*jniEnv)->CallStaticObjectMethod(jniEnv, rembeddedClass, initializeMethod, argsArray, setupRmainloop);
+ initialized++;
+ return 0;
}
// -----------------------------------------------------------------------------------------------
@@ -245,19 +256,19 @@ CTXT R_getGlobalFunctionContext() {
}
CTXT R_getParentFunctionContext(CTXT c) {
- return ((call_R_getParentFunctionContext) callbacks[R_getParentFunctionContext_x])(c);
+ return ((call_R_getParentFunctionContext) callbacks[R_getParentFunctionContext_x])(c);
}
SEXP R_getContextEnv(CTXT c) {
- return ((call_R_getContextEnv) callbacks[R_getContextEnv_x])(c);
+ return ((call_R_getContextEnv) callbacks[R_getContextEnv_x])(c);
}
SEXP R_getContextFun(CTXT c) {
- return ((call_R_getContextFun) callbacks[R_getContextFun_x])(c);
+ return ((call_R_getContextFun) callbacks[R_getContextFun_x])(c);
}
SEXP R_getContextCall(CTXT c) {
- return ((call_R_getContextCall) callbacks[R_getContextCall_x])(c);
+ return ((call_R_getContextCall) callbacks[R_getContextCall_x])(c);
}
SEXP R_getContextSrcRef(CTXT c) {
@@ -273,7 +284,7 @@ int R_isGlobal(CTXT c) {
}
int R_isEqual(void* x, void* y) {
- return ((call_R_isEqual) callbacks[R_isEqual_x])(x, y);
+ return ((call_R_isEqual) callbacks[R_isEqual_x])(x, y);
}
// -----------------------------------------------------------------------------------------------
@@ -316,120 +327,120 @@ char* rembedded_read_console(const char* prompt) {
// Unimplemented API functions (to make the linker happy and as a TODO list)
void R_SaveGlobalEnvToFile(const char *f) {
- unimplemented("R_SaveGlobalEnvToFile");
+ unimplemented("R_SaveGlobalEnvToFile");
}
void uR_ShowMessage(const char *x) {
- unimplemented("R_ShowMessage");
+ unimplemented("R_ShowMessage");
}
int uR_ReadConsole(const char *a, unsigned char *b, int c, int d) {
- unimplemented("R_ReadConsole");
- return 0;
+ unimplemented("R_ReadConsole");
+ return 0;
}
void uR_WriteConsole(const char *x, int y) {
- unimplemented("R_WriteConsole");
+ unimplemented("R_WriteConsole");
}
void uR_WriteConsoleEx(const char *x, int y, int z) {
- unimplemented("R_WriteConsole");
+ unimplemented("R_WriteConsole");
}
void uR_ResetConsole(void) {
- unimplemented("R_ResetConsole");
+ unimplemented("R_ResetConsole");
}
void uR_FlushConsole(void) {
- unimplemented("R_FlushConsole");
+ unimplemented("R_FlushConsole");
}
void uR_ClearerrConsole(void) {
- unimplemented("R_ClearerrConsole");
+ unimplemented("R_ClearerrConsole");
}
void uR_Busy(int x) {
- unimplemented("R_Busy");
+ unimplemented("R_Busy");
}
void R_SizeFromEnv(Rstart rs) {
- unimplemented("R_SizeFromEnv");
+ unimplemented("R_SizeFromEnv");
}
void R_common_command_line(int *a, char **b, Rstart rs) {
- unimplemented("R_common_command_line");
+ unimplemented("R_common_command_line");
}
void R_set_command_line_arguments(int argc, char **argv) {
- unimplemented("R_set_command_line_arguments");
+ unimplemented("R_set_command_line_arguments");
}
int uR_ShowFiles(int a, const char **b, const char **c,
- const char *d, Rboolean e, const char *f) {
- unimplemented("R_ShowFiles");
- return 0;
+ const char *d, Rboolean e, const char *f) {
+ unimplemented("R_ShowFiles");
+ return 0;
}
int uR_ChooseFile(int a, char *b, int c) {
- unimplemented("R_ChooseFile");
- return 0;
+ unimplemented("R_ChooseFile");
+ return 0;
}
int uR_EditFile(const char *a) {
- unimplemented("R_EditFile");
- return 0;
+ unimplemented("R_EditFile");
+ return 0;
}
void uR_loadhistory(SEXP a, SEXP b, SEXP c, SEXP d) {
- unimplemented("uR_loadhistory");
+ unimplemented("uR_loadhistory");
}
void uR_savehistory(SEXP a, SEXP b, SEXP c, SEXP d) {
- unimplemented("R_savehistory");
+ unimplemented("R_savehistory");
}
void uR_addhistory(SEXP a, SEXP b, SEXP c, SEXP d) {
- unimplemented("R_addhistory");
+ unimplemented("R_addhistory");
}
int uR_EditFiles(int a, const char **b, const char **c, const char *d) {
- unimplemented("uR_EditFiles");
- return 0;
+ unimplemented("uR_EditFiles");
+ return 0;
}
SEXP udo_selectlist(SEXP a, SEXP b, SEXP c, SEXP d) {
- return unimplemented("R_EditFiles");
+ return unimplemented("R_EditFiles");
}
SEXP udo_dataentry(SEXP a, SEXP b, SEXP c, SEXP d) {
- return unimplemented("do_dataentry");
+ return unimplemented("do_dataentry");
}
SEXP udo_dataviewer(SEXP a, SEXP b, SEXP c, SEXP d) {
- return unimplemented("do_dataviewer");
+ return unimplemented("do_dataviewer");
}
void uR_ProcessEvents(void) {
- unimplemented("R_ProcessEvents");
+ unimplemented("R_ProcessEvents");
}
void uR_PolledEvents(void) {
- unimplemented("R_PolledEvents");
+ unimplemented("R_PolledEvents");
}
void Rf_jump_to_toplevel() {
- unimplemented("Rf_jump_to_toplevel");
+ unimplemented("Rf_jump_to_toplevel");
}
#include <R_ext/eventloop.h>
fd_set *R_checkActivity(int usec, int ignore_stdin) {
- unimplemented("R_checkActivity");
- return NULL;
+ unimplemented("R_checkActivity");
+ return NULL;
}
void R_runHandlers(InputHandler *handlers, fd_set *mask) {
- unimplemented("R_runHandlers");
+ unimplemented("R_runHandlers");
}
// -----------------------------------------------------------------------------------------------
@@ -450,10 +461,10 @@ void R_runHandlers(InputHandler *handlers, fd_set *mask) {
// user's R_Suicide override to actually really commit the suicide. We invoke this through
// JNI intentionally to avoid any potential problems with NFI being called while destroying the VM.
void uR_Suicide(const char *x) {
- JNIEnv *jniEnv = getEnv();
- jstring msg = (*jniEnv)->NewStringUTF(jniEnv, x);
- jmethodID suicideMethod = checkGetMethodID(jniEnv, rembeddedClass, "R_Suicide", "(Ljava/lang/String;)V", 1);
- (*jniEnv)->CallStaticVoidMethod(jniEnv, rembeddedClass, suicideMethod, msg);
+ JNIEnv *jniEnv = getEnv();
+ jstring msg = (*jniEnv)->NewStringUTF(jniEnv, x);
+ jmethodID suicideMethod = checkGetMethodID(jniEnv, rembeddedClass, "R_Suicide", "(Ljava/lang/String;)V", 1);
+ (*jniEnv)->CallStaticVoidMethod(jniEnv, rembeddedClass, suicideMethod, msg);
}
void uR_CleanUp(SA_TYPE x, int y, int z) {
@@ -471,7 +482,7 @@ void (*ptr_R_ClearerrConsole)(void) = uR_ClearerrConsole;
void (*ptr_R_Busy)(int) = uR_Busy;
void (*ptr_R_CleanUp)(SA_TYPE, int, int) = uR_CleanUp;
int (*ptr_R_ShowFiles)(int, const char **, const char **,
- const char *, Rboolean, const char *) = uR_ShowFiles;
+ const char *, Rboolean, const char *) = uR_ShowFiles;
int (*ptr_R_ChooseFile)(int, char *, int) = uR_ChooseFile;
int (*ptr_R_EditFile)(const char *) = uR_EditFile;
void (*ptr_R_loadhistory)(SEXP, SEXP, SEXP, SEXP) = uR_loadhistory;
@@ -488,25 +499,25 @@ void (* R_PolledEvents)(void) = uR_PolledEvents;
// This call cannot be made via callbacks array because it may be invoked before FastR is fully initialized.
void setupOverrides(void) {
- JNIEnv *jniEnv = getEnv();
- jmethodID ovrMethodID = checkGetMethodID(jniEnv, rInterfaceCallbacksClass, "override", "(Ljava/lang/String;)V", 1);
- jstring name;
- if (ptr_R_Suicide != uR_Suicide) {
- name = (*jniEnv)->NewStringUTF(jniEnv, "R_Suicide");
- (*jniEnv)->CallStaticVoidMethod(jniEnv, rInterfaceCallbacksClass, ovrMethodID, name);
- }
- if (*ptr_R_CleanUp != uR_CleanUp) {
- name = (*jniEnv)->NewStringUTF(jniEnv, "R_CleanUp");
- (*jniEnv)->CallStaticVoidMethod(jniEnv, rInterfaceCallbacksClass, ovrMethodID, name);
- }
- if (*ptr_R_ReadConsole != uR_ReadConsole) {
- name = (*jniEnv)->NewStringUTF(jniEnv, "R_ReadConsole");
- (*jniEnv)->CallStaticVoidMethod(jniEnv, rInterfaceCallbacksClass, ovrMethodID, name);
- }
- if (*ptr_R_WriteConsole != uR_WriteConsole) {
- name = (*jniEnv)->NewStringUTF(jniEnv, "R_WriteConsole");
- (*jniEnv)->CallStaticVoidMethod(jniEnv, rInterfaceCallbacksClass, ovrMethodID, name);
- }
+ JNIEnv *jniEnv = getEnv();
+ jmethodID ovrMethodID = checkGetMethodID(jniEnv, rInterfaceCallbacksClass, "override", "(Ljava/lang/String;)V", 1);
+ jstring name;
+ if (ptr_R_Suicide != uR_Suicide) {
+ name = (*jniEnv)->NewStringUTF(jniEnv, "R_Suicide");
+ (*jniEnv)->CallStaticVoidMethod(jniEnv, rInterfaceCallbacksClass, ovrMethodID, name);
+ }
+ if (*ptr_R_CleanUp != uR_CleanUp) {
+ name = (*jniEnv)->NewStringUTF(jniEnv, "R_CleanUp");
+ (*jniEnv)->CallStaticVoidMethod(jniEnv, rInterfaceCallbacksClass, ovrMethodID, name);
+ }
+ if (*ptr_R_ReadConsole != uR_ReadConsole) {
+ name = (*jniEnv)->NewStringUTF(jniEnv, "R_ReadConsole");
+ (*jniEnv)->CallStaticVoidMethod(jniEnv, rInterfaceCallbacksClass, ovrMethodID, name);
+ }
+ if (*ptr_R_WriteConsole != uR_WriteConsole) {
+ name = (*jniEnv)->NewStringUTF(jniEnv, "R_WriteConsole");
+ (*jniEnv)->CallStaticVoidMethod(jniEnv, rInterfaceCallbacksClass, ovrMethodID, name);
+ }
}
// -----------------------------------------------------------------------------------------------
@@ -515,17 +526,17 @@ void setupOverrides(void) {
// separate vm args from user args
static int process_vmargs(int argc, char *argv[], char *vmargv[], char *uargv[]) {
- int vcount = 0;
- int ucount = 0;
- for (int i = 0; i < argc; i++) {
- char *arg = argv[i];
- if ((arg[0] == '-' && arg[1] == 'X') || (arg[0] == '-' && arg[1] == 'D')) {
- vmargv[vcount++] = arg;
- } else {
- uargv[ucount++] = arg;
- }
- }
- return vcount;
+ int vcount = 0;
+ int ucount = 0;
+ for (int i = 0; i < argc; i++) {
+ char *arg = argv[i];
+ if ((arg[0] == '-' && arg[1] == 'X') || (arg[0] == '-' && arg[1] == 'D')) {
+ vmargv[vcount++] = arg;
+ } else {
+ uargv[ucount++] = arg;
+ }
+ }
+ return vcount;
}
#include <sys/types.h>
@@ -534,17 +545,17 @@ static int process_vmargs(int argc, char *argv[], char *vmargv[], char *uargv[])
#include <errno.h>
static void perror_exit(char *msg) {
- perror(msg);
- exit(1);
+ perror(msg);
+ exit(1);
}
static void *dlopen_jvmlib(char *libpath) {
- void *handle = dlopen(libpath, RTLD_GLOBAL | RTLD_NOW);
- if (handle == NULL) {
- fprintf(stderr, "Rf_initialize_R: cannot dlopen %s: %s\n", libpath, dlerror());
- exit(1);
- }
- return handle;
+ void *handle = dlopen(libpath, RTLD_GLOBAL | RTLD_NOW);
+ if (handle == NULL) {
+ fprintf(stderr, "Rf_initialize_R: cannot dlopen %s: %s\n", libpath, dlerror());
+ exit(1);
+ }
+ return handle;
}
static JNIEnv* getEnv() {
@@ -583,102 +594,102 @@ static jclass checkFindClass(JNIEnv *env, const char *name) {
// We use $R_HOME/bin/execRextras/Rclasspath to do this to emulate what happens
// during normal execution
static char *get_classpath(char *r_home) {
- char **env = update_environ_with_java_home();
- //print_environ(env);
- int pipefd[2];
- if (pipe(pipefd) == -1) {
- perror_exit("pipe");
- }
- pid_t pid = fork();
- if (pid == -1) {
- perror("fork");
- }
- if (pid == 0) {
- // child
- char path[1024];
- strcpy(path, r_home);
- strcat(path, "/bin/execRextras/Rclasspath");
- while ((dup2(pipefd[1], STDOUT_FILENO) == -1) && (errno == EINTR)) {}
- close(pipefd[1]);
- close(pipefd[0]);
- int rc = execle(path, path, (char *)NULL, env);
- if (rc == -1) {
- perror_exit("exec");
- }
- return NULL;
- } else {
- // parent
- const char *cpdef = "-Djava.class.path=";
- char *buf = malloc(4096);
- strcpy(buf, cpdef);
- char *bufptr = buf + strlen(cpdef);
- int max = 4096 - strlen(cpdef);
- close(pipefd[1]);
- while (1) {
- int count = read(pipefd[0], bufptr, max);
- if (count == -1) {
- if (errno == EINTR) {
- continue;
- } else {
- perror_exit("read");
- }
- } else if (count == 0) {
- // scrub any newline
- bufptr--;
- if (*bufptr != '\n') {
- bufptr++;
- }
- *bufptr = 0;
- break;
- } else {
- bufptr += count;
- max -= count;
- }
- }
- close(pipefd[0]);
- wait(NULL);
- return buf;
- }
+ char **env = update_environ_with_java_home();
+ //print_environ(env);
+ int pipefd[2];
+ if (pipe(pipefd) == -1) {
+ perror_exit("pipe");
+ }
+ pid_t pid = fork();
+ if (pid == -1) {
+ perror("fork");
+ }
+ if (pid == 0) {
+ // child
+ char path[1024];
+ strcpy(path, r_home);
+ strcat(path, "/bin/execRextras/Rclasspath");
+ while ((dup2(pipefd[1], STDOUT_FILENO) == -1) && (errno == EINTR)) {}
+ close(pipefd[1]);
+ close(pipefd[0]);
+ int rc = execle(path, path, (char *)NULL, env);
+ if (rc == -1) {
+ perror_exit("exec");
+ }
+ return NULL;
+ } else {
+ // parent
+ const char *cpdef = "-Djava.class.path=";
+ char *buf = malloc(4096);
+ strcpy(buf, cpdef);
+ char *bufptr = buf + strlen(cpdef);
+ int max = 4096 - strlen(cpdef);
+ close(pipefd[1]);
+ while (1) {
+ int count = read(pipefd[0], bufptr, max);
+ if (count == -1) {
+ if (errno == EINTR) {
+ continue;
+ } else {
+ perror_exit("read");
+ }
+ } else if (count == 0) {
+ // scrub any newline
+ bufptr--;
+ if (*bufptr != '\n') {
+ bufptr++;
+ }
+ *bufptr = 0;
+ break;
+ } else {
+ bufptr += count;
+ max -= count;
+ }
+ }
+ close(pipefd[0]);
+ wait(NULL);
+ return buf;
+ }
}
static char **update_environ(char *def) {
- int count = 0;
- char **e = environ;
- while (*e != NULL) {
- e++;
- count++;
- }
- char **new_env = malloc(sizeof(char *) * (count + 2));
- e = environ;
- char **ne = new_env;
- while (*e != NULL) {
- *ne++ = *e++;
- }
- *ne++ = def;
- *ne = (char*) NULL;
- return new_env;
+ int count = 0;
+ char **e = environ;
+ while (*e != NULL) {
+ e++;
+ count++;
+ }
+ char **new_env = malloc(sizeof(char *) * (count + 2));
+ e = environ;
+ char **ne = new_env;
+ while (*e != NULL) {
+ *ne++ = *e++;
+ }
+ *ne++ = def;
+ *ne = (char*) NULL;
+ return new_env;
}
static char **update_environ_with_java_home(void) {
- char **e = environ;
- while (*e != NULL) {
- if (strstr(*e, "JAVA_HOME=")) {
- return environ;
- }
- e++;
- }
- char *java_home_env = malloc(strlen(java_home) + 10);
- strcpy(java_home_env, "JAVA_HOME=");
- strcat(java_home_env, java_home);
- return update_environ(java_home_env);
+ char **e = environ;
+ while (*e != NULL) {
+ if (strstr(*e, "JAVA_HOME=")) {
+ return environ;
+ }
+ e++;
+ }
+ char *java_home_env = malloc(strlen(java_home) + 10);
+ strcpy(java_home_env, "JAVA_HOME=");
+ strcat(java_home_env, java_home);
+ return update_environ(java_home_env);
}
// debugging
static void print_environ(char **env) {
- fprintf(stdout, "## Environment variables at %p\n", env);
- char **e = env;
- while (*e != NULL) {
- fprintf(stdout, "%s\n", *e);
- e++;
- }
+ fprintf(stdout, "## Environment variables at %p\n", env);
+ char **e = env;
+ while (*e != NULL) {
+ fprintf(stdout, "%s\n", *e);
+ e++;
+ }
}
diff --git a/com.oracle.truffle.r.native/version.source b/com.oracle.truffle.r.native/version.source
index e373ee695f6e76d7d3f8f8c4e92d1d60995352e5..fb1e7bc86996a80d4a16529b990adda1d3434c92 100644
--- a/com.oracle.truffle.r.native/version.source
+++ b/com.oracle.truffle.r.native/version.source
@@ -1 +1 @@
-50
+54
diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/printer/AttributesPrinter.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/printer/AttributesPrinter.java
index 34c497312c3d81afee5bd7d0c35da9d39266736d..4df7b6905fc49ccf0a9c85da1bd25854a7a25507 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/printer/AttributesPrinter.java
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/printer/AttributesPrinter.java
@@ -5,7 +5,7 @@
*
* Copyright (c) 1995, 1996 Robert Gentleman and Ross Ihaka
* Copyright (c) 1997-2013, The R Core Team
- * Copyright (c) 2016, 2017, Oracle and/or its affiliates
+ * Copyright (c) 2016, 2018, Oracle and/or its affiliates
*
* All rights reserved.
*/
@@ -94,12 +94,13 @@ final class AttributesPrinter implements ValuePrinter<RAttributable> {
int origLen = buff.length();
buff.append(tag);
- if (RContext.getInstance().isMethodTableDispatchOn() && utils.isS4(a.getValue())) {
+ RContext ctx = RContext.getInstance();
+ if (ctx.isMethodTableDispatchOn() && utils.isS4(a.getValue())) {
S4ObjectPrinter.printS4(printCtx, a.getValue());
// throw new UnsupportedOperationException("TODO");
} else {
if (a.getValue() instanceof RAttributable && ((RAttributable) a.getValue()).isObject()) {
- RContext.getEngine().printResult(a.getValue());
+ RContext.getEngine().printResult(ctx, a.getValue());
} else {
ValuePrinters.INSTANCE.print(a.getValue(), printCtx);
}
diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/printer/ListPrinter.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/printer/ListPrinter.java
index 65694c0578f9cc5c94f3c3b15bddb268ab7e8056..4fa95a508ed285bc4b6c9a80ccd6183c0d5d2677 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/printer/ListPrinter.java
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/printer/ListPrinter.java
@@ -5,7 +5,7 @@
*
* Copyright (c) 1995, 1996 Robert Gentleman and Ross Ihaka
* Copyright (c) 1997-2013, The R Core Team
- * Copyright (c) 2016, 2017, Oracle and/or its affiliates
+ * Copyright (c) 2016, 2018, Oracle and/or its affiliates
*
* All rights reserved.
*/
@@ -203,7 +203,7 @@ final class ListPrinter extends AbstractValuePrinter<RAbstractListVector> {
out.println(tagbuf);
Object si = s.getDataAt(i);
if (si instanceof RAttributable && ((RAttributable) si).isObject()) {
- RContext.getEngine().printResult(si);
+ RContext.getEngine().printResult(RContext.getInstance(), si);
} else {
ValuePrinters.INSTANCE.print(si, printCtx);
ValuePrinters.printNewLine(printCtx);
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/context/Engine.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/context/Engine.java
index a3f5d4b98c8e8c6e2c16d0e21b4d104ae7c6390b..998f2e895d819e4bfaff297aaa4242f2361e9039 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/context/Engine.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/context/Engine.java
@@ -256,7 +256,7 @@ public interface Engine {
* Used by Truffle debugger; invokes the internal "print" support in R for {@code value}.
* Essentially this is equivalent to {@link #evalFunction} using the {@code "print"} function.
*/
- void printResult(Object value);
+ void printResult(RContext ctx, Object value);
/**
* Return the "global" frame for this {@link Engine}, aka {@code globalEnv}.
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/env/REnvironment.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/env/REnvironment.java
index 6f6fc756782041735e9d83cbf01d6e443dbd7286..1253a0a8091e54e81e3e8f2c06ff270a0cab5b43 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/env/REnvironment.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/env/REnvironment.java
@@ -267,7 +267,14 @@ public abstract class REnvironment extends RAttributeStorage {
* Value returned by {@code globalenv()}.
*/
public static REnvironment globalEnv() {
- return RContext.getInstance().stateREnvironment.getGlobalEnv();
+ return globalEnv(RContext.getInstance());
+ }
+
+ /**
+ * Value returned by {@code globalenv()}.
+ */
+ public static REnvironment globalEnv(RContext ctx) {
+ return ctx.stateREnvironment.getGlobalEnv();
}
/**
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/DLL.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/DLL.java
index 07b6aeba98290ab63ad0ee0bd7cb834ca8575171..ce08cd08089df9aadf00819b673c56f4cce2a236 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/DLL.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/DLL.java
@@ -217,6 +217,14 @@ public class DLL {
return result;
}
+ /**
+ * Embedding {@link DLLInfo} is just a placeholder. It does not represent any concrete dll
+ * and thus we e.g. cannot find any symbols in it.
+ */
+ public boolean isEmbeddingDllInfo() {
+ return handle == null;
+ }
+
public void setNativeSymbols(int nstOrd, DotSymbol[] symbols) {
nativeSymbols[nstOrd] = symbols;
}
@@ -758,6 +766,7 @@ public class DLL {
*/
public static SymbolHandle findSymbol(String name, DLLInfo dllInfo) {
if (dllInfo != null) {
+ assert !dllInfo.isEmbeddingDllInfo() : "Dynamic symbols lookup is not supported for the embedding DLLInfo";
return (SymbolHandle) DLLRFFI.DLSymRootNode.create(RContext.getInstance()).call(dllInfo.handle, name);
} else {
return (SymbolHandle) RFindSymbolRootNode.create(RContext.getInstance()).call(name, null, RegisteredNativeSymbol.any());
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFIContext.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFIContext.java
index bc6bf9f3a9bbcbccdcbf17657e064bcfd6713c4b..c5de3d2ae536710aa313255f05c5a950ddef56d7 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFIContext.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFIContext.java
@@ -126,7 +126,7 @@ public abstract class RFFIContext extends RFFI {
cooperativeGc();
}
- public int getCallDepth() {
+ public final int getCallDepth() {
return callDepth;
}
diff --git a/com.oracle.truffle.r.test.native/Makefile b/com.oracle.truffle.r.test.native/Makefile
index e19effc9d83aeaa4e6152ac5a9614d5f4c0c3480..87084580644d9b0d7fd047a4b27c874c02172321 100644
--- a/com.oracle.truffle.r.test.native/Makefile
+++ b/com.oracle.truffle.r.test.native/Makefile
@@ -37,7 +37,10 @@ all:
$(MAKE) -C urand
$(MAKE) -C packages
ifneq ($(OSNAME), SunOS)
-ifeq ($(FASTR_RFFI),jni)
+ifeq ($(FASTR_RFFI),nfi)
+ $(MAKE) -C embedded
+endif
+ifeq ($(FASTR_RFFI),)
$(MAKE) -C embedded
endif
endif
@@ -46,7 +49,10 @@ clean:
$(MAKE) -C urand clean
$(MAKE) -C packages clean
ifneq ($(OSNAME), SunOS)
-ifeq ($(FASTR_RFFI),jni)
+ifeq ($(FASTR_RFFI),nfi)
+ $(MAKE) -C embedded clean
+endif
+ifeq ($(FASTR_RFFI),)
$(MAKE) -C embedded clean
endif
endif
diff --git a/com.oracle.truffle.r.test.native/embedded/Makefile b/com.oracle.truffle.r.test.native/embedded/Makefile
index f8e3d2ad094a917280195a05ea510467c47750ea..7fb216f542cbb2a6c467feb4b6314833927a764e 100644
--- a/com.oracle.truffle.r.test.native/embedded/Makefile
+++ b/com.oracle.truffle.r.test.native/embedded/Makefile
@@ -1,5 +1,5 @@
#
-# Copyright (c) 2016, Oracle and/or its affiliates. All rights reserved.
+# Copyright (c) 2016, 2018, 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
@@ -45,24 +45,28 @@ FASTR_LIB_DIR = $(abspath ../../lib)
.PHONY: all clean
-OBJ = lib
+BIN = bin
SRC = src
C_SOURCES := $(wildcard $(SRC)/*.c)
-C_OBJECTS := $(subst $(SRC),$(OBJ),$(C_SOURCES:.c=.o))
+C_OBJECTS := $(subst $(SRC),$(BIN),$(C_SOURCES:.c=.o))
INCLUDE_DIR := $(NATIVE_PROJECT)/include
-all: $(OBJ)/main Makefile
+all: $(BIN)/main $(BIN)/embedded Makefile
-$(OBJ)/main: | $(OBJ)
+$(BIN)/main: | $(BIN)
+$(BIN)/embedded: | $(BIN)
-$(OBJ):
- mkdir -p $(OBJ)
+$(BIN):
+ mkdir -p $(BIN)
+$(BIN)/main: $(SRC)/main.c
+ $(CC) $(CFLAGS) -I$(INCLUDE_DIR) $< -o $(BIN)/main -L $(FASTR_LIB_DIR) -ldl -lR $(LD_FLAGS) -Wl,-rpath,$(FASTR_LIB_DIR)
-$(OBJ)/main: $(SRC)/main.c
- $(CC) $(CFLAGS) -I$(INCLUDE_DIR) $< -o $(OBJ)/main -L $(FASTR_LIB_DIR) -ldl -lR $(LD_FLAGS) -Wl,-rpath,$(FASTR_LIB_DIR)
+$(BIN)/embedded: $(SRC)/embedded.c
+ $(CC) $(CFLAGS) -I$(INCLUDE_DIR) $< -o $(BIN)/embedded -L $(FASTR_LIB_DIR) -ldl -lR $(LD_FLAGS) -Wl,-rpath,$(FASTR_LIB_DIR)
+ cp $(SRC)/*.R $(BIN)
clean:
- rm -rf $(OBJ)
+ rm -rf $(BIN)
diff --git a/com.oracle.truffle.r.test.native/embedded/src/embedded.c b/com.oracle.truffle.r.test.native/embedded/src/embedded.c
new file mode 100644
index 0000000000000000000000000000000000000000..84d129e2e60419537abee49a0e88030dc519ea12
--- /dev/null
+++ b/com.oracle.truffle.r.test.native/embedded/src/embedded.c
@@ -0,0 +1,207 @@
+/*
+ * Copyright (c) 2018, 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.
+ */
+
+// Simple program testing FastR embedded mode where R is initialized and then evaluation is controlled by the embedder
+// See also main.c for example where R is initialized and then the R's REPL is run.
+
+// Note: some of the examples were taken from GNU R tests/Embedded directory and slightly adapted
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <dlfcn.h>
+#include <sys/utsname.h>
+#include <string.h>
+#define R_INTERFACE_PTRS 1
+#include <Rinterface.h>
+#include <Rembedded.h>
+#include <R_ext/RStartup.h>
+#include <R_ext/Rdynload.h>
+
+#define CALLDEF(name, n) {#name, (DL_FUNC) &name, n}
+
+SEXP twice(SEXP x) {
+ int *xi = INTEGER(x);
+ int len = LENGTH(x);
+ SEXP res;
+ PROTECT(res = allocVector(INTSXP, len));
+ int *resi = INTEGER(res);
+ for (int i = 0; i < len; ++i) {
+ resi[i] = xi[i] * 2;
+ }
+ UNPROTECT(1);
+ return res;
+}
+
+static void checkError(int errorOccurred, const char* context) {
+ if (errorOccurred) {
+ printf("Unexpected error occurred when %s.\n", context);
+ exit(1);
+ }
+}
+
+static void source(const char* file) {
+ FILE *f;
+ if (f = fopen(file, "r")){
+ fclose(f);
+ } else {
+ printf("File '%s' is not accessible. Are you running the program from within a directory that contains this file, e.g. 'obj'?\n", file);
+ exit(1);
+ }
+
+ SEXP e;
+ PROTECT(e = lang2(install("source"), mkString(file)));
+ printf("Sourcing '%s'...\n", file);
+ int errorOccurred;
+ R_tryEval(e, R_GlobalEnv, &errorOccurred);
+ UNPROTECT(1);
+ checkError(errorOccurred, "sourcing a file");
+}
+
+/*
+ Call the function foo() with 3 arguments, 2 of which
+ are named.
+ foo(pch="+", id = 123, c(T,F))
+
+ Note that PrintValue() of the expression seg-faults.
+ We have to set the print name correctly.
+*/
+
+static void bar1() {
+ SEXP fun, pch;
+ SEXP e;
+
+ PROTECT(e = allocVector(LANGSXP, 4));
+ fun = findFun(install("foo"), R_GlobalEnv);
+ if(fun == R_NilValue) {
+ printf("No definition for function foo. Source foo.R and save the session.\n");
+ UNPROTECT(1);
+ exit(1);
+ }
+ SETCAR(e, fun);
+
+ SETCADR(e, mkString("+"));
+ SET_TAG(CDR(e), install("pch"));
+
+ SETCADDR(e, ScalarInteger(123));
+ SET_TAG(CDR(CDR(e)), install("id"));
+
+ pch = allocVector(LGLSXP, 2);
+ LOGICAL(pch)[0] = TRUE;
+ LOGICAL(pch)[1] = FALSE;
+ SETCADDDR(e, pch);
+
+ printf("Printing the expression to be eval'ed...\n");
+ PrintValue(e);
+ printf("Eval'ing the expression...\n");
+ eval(e, R_GlobalEnv);
+
+ SETCAR(e, install("foo"));
+ printf("Printing the expression to be tryEval'ed...\n");
+ PrintValue(e);
+ printf("TryEval'ing the expression...\n");
+ R_tryEval(e, R_GlobalEnv, NULL);
+
+ UNPROTECT(1);
+}
+
+int main(int argc, char **argv) {
+ setbuf(stdout, NULL);
+ char *r_home = getenv("R_HOME");
+ if (r_home == NULL) {
+ printf("R_HOME must be set\n");
+ exit(1);
+ }
+ printf("Initializing R with Rf_initEmbeddedR...\n");
+ Rf_initEmbeddedR(argc, argv);
+
+ // ------------------------------
+ // tests/Embedded/Rerror.c
+
+ /*
+ Evaluates the two expressions:
+ source("error.R")
+ and then calls foo() twice
+ where foo is defined in the file error.R
+ */
+ SEXP e;
+ int errorOccurred;
+ source("error.R");
+
+ PROTECT(e = lang1(install("foo")));
+ printf("Invoking foo() via tryEval...");
+ R_tryEval(e, R_GlobalEnv, &errorOccurred);
+ printf("errorOccurred=%d\n", errorOccurred);
+ printf("Invoking foo() via tryEval once more...");
+ R_tryEval(e, R_GlobalEnv, &errorOccurred);
+ printf("errorOccurred=%d\n", errorOccurred);
+ UNPROTECT(1);
+
+ // ------------------------------
+ // tests/Embedded/tryEval.c
+
+ printf("Trying sqrt with wrong and then correct argument...\n");
+ PROTECT(e = lang2(install("sqrt"), mkString("")));
+ SEXP val = R_tryEval(e, NULL, &errorOccurred);
+ // Note: even the official example is not PROTECTing the val
+ if(errorOccurred) {
+ printf("Caught an error calling sqrt(). Try again with a different argument.\n");
+ }
+ SETCAR(CDR(e), ScalarInteger(9));
+ val = R_tryEval(e, NULL, &errorOccurred);
+ if(errorOccurred) {
+ printf("Caught another error calling sqrt()\n");
+ } else {
+ Rf_PrintValue(val);
+ }
+ UNPROTECT(1);
+
+ // ------------------------------
+ // tests/Embedded/RNamedCall.c
+
+ source("foo.R");
+ printf("Calling foo with named arguments...\n");
+ bar1();
+
+ // ------------------------------
+ // Register custom native symbols and invoke them
+
+ printf("Calling R_getEmbeddingDllInfo...\n");
+ DllInfo *eDllInfo = R_getEmbeddingDllInfo();
+ R_CallMethodDef CallEntries[] = {
+ CALLDEF(twice, 2),
+ {NULL, NULL, 0}
+ };
+ R_registerRoutines(eDllInfo, NULL, CallEntries, NULL, NULL);
+ source("embedding.R");
+ PROTECT(e = lang1(install("runTwice")));
+ SEXP twiceRes = R_tryEval(e, R_GlobalEnv, &errorOccurred);
+ checkError(errorOccurred, "evaluating runTwice");
+ UNPROTECT(1);
+ Rf_PrintValue(twiceRes);
+
+
+ Rf_endEmbeddedR(0);
+ printf("DONE\n");
+ return 0;
+}
+
diff --git a/com.oracle.truffle.r.test.native/embedded/src/embedded.expected.output b/com.oracle.truffle.r.test.native/embedded/src/embedded.expected.output
new file mode 100644
index 0000000000000000000000000000000000000000..4a76493713e8e62a45def473e837b219739b5b95
--- /dev/null
+++ b/com.oracle.truffle.r.test.native/embedded/src/embedded.expected.output
@@ -0,0 +1,75 @@
+Initializing R with Rf_initEmbeddedR...
+Sourcing 'error.R'...
+Invoking foo() via tryEval...Error in foo() : Stopping in function foo
+ [1] 1 2 3 4 5 6 7 8 9 10
+errorOccurred=1
+Invoking foo() via tryEval once more...Error in foo() : Stopping in function foo
+ [1] 1 2 3 4 5 6 7 8 9 10
+errorOccurred=1
+Trying sqrt with wrong and then correct argument...
+Error in sqrt("") : non-numeric argument to mathematical function
+Caught an error calling sqrt(). Try again with a different argument.
+[1] 3
+Sourcing 'foo.R'...
+Calling foo with named arguments...
+Printing the expression to be eval'ed...
+[[1]]
+function(...)
+{
+ args <- list(...)
+ print(args)
+ print(names(args))
+ TRUE
+}
+
+$pch
+[1] "+"
+
+$id
+[1] 123
+
+[[4]]
+[1] TRUE FALSE
+
+Eval'ing the expression...
+$pch
+[1] "+"
+
+$id
+[1] 123
+
+[[3]]
+[1] TRUE FALSE
+
+[1] "pch" "id" ""
+Printing the expression to be tryEval'ed...
+[[1]]
+foo
+
+$pch
+[1] "+"
+
+$id
+[1] 123
+
+[[4]]
+[1] TRUE FALSE
+
+TryEval'ing the expression...
+$pch
+[1] "+"
+
+$id
+[1] 123
+
+[[3]]
+[1] TRUE FALSE
+
+[1] "pch" "id" ""
+Calling R_getEmbeddingDllInfo...
+Sourcing 'embedding.R'...
+getDLLRegisteredRoutines('(embedding)'):
+ .Call .Call.numParameters
+1 twice 2
+[1] 2 4 6 8 10
+DONE
diff --git a/com.oracle.truffle.r.test.native/embedded/src/embedding.R b/com.oracle.truffle.r.test.native/embedded/src/embedding.R
new file mode 100644
index 0000000000000000000000000000000000000000..4170f8be6123e436e341c270c2e1a318a25309fa
--- /dev/null
+++ b/com.oracle.truffle.r.test.native/embedded/src/embedding.R
@@ -0,0 +1,6 @@
+
+runTwice <- function() {
+ cat("getDLLRegisteredRoutines('(embedding)'):\n")
+ print(getDLLRegisteredRoutines("(embedding)"))
+ .Call(getDLLRegisteredRoutines("(embedding)")[[".Call"]][[1]], 1:5);
+}
\ No newline at end of file
diff --git a/com.oracle.truffle.r.test.native/embedded/src/error.R b/com.oracle.truffle.r.test.native/embedded/src/error.R
new file mode 100644
index 0000000000000000000000000000000000000000..3f4a2b61f4d26e38542a67e005755c4362603197
--- /dev/null
+++ b/com.oracle.truffle.r.test.native/embedded/src/error.R
@@ -0,0 +1,6 @@
+foo <-
+function()
+{
+ on.exit(print(1:10))
+ stop("Stopping in function foo")
+}
diff --git a/com.oracle.truffle.r.test.native/embedded/src/foo.R b/com.oracle.truffle.r.test.native/embedded/src/foo.R
new file mode 100644
index 0000000000000000000000000000000000000000..06ef4aa9ee43023ac42d8bd9b28df54aff052cc7
--- /dev/null
+++ b/com.oracle.truffle.r.test.native/embedded/src/foo.R
@@ -0,0 +1,8 @@
+foo <-
+function(...)
+{
+ args <- list(...)
+ print(args)
+ print(names(args))
+ TRUE
+}
diff --git a/com.oracle.truffle.r.test.native/embedded/src/main.c b/com.oracle.truffle.r.test.native/embedded/src/main.c
index 9de0840477855701f938db79008498e274a1e27f..03a6f18fb3718fe4e13bd038b2fbf5e049e12409 100644
--- a/com.oracle.truffle.r.test.native/embedded/src/main.c
+++ b/com.oracle.truffle.r.test.native/embedded/src/main.c
@@ -21,8 +21,8 @@
* questions.
*/
-// A simple test program for FastR embedded mode.
-// compile with "gcc -I include main.c -ldl
+// A simple program testing FastR embedded mode use case where R is initialized and then the R's REPL is run.
+// See embedded.c for example where R is initialized and then evaluation is controlled by the embedder
#include <stdlib.h>
#include <stdio.h>
@@ -40,23 +40,23 @@ void (*ptr_stdR_CleanUp)(SA_TYPE, int, int);
void (*ptr_stdR_Suicide)(const char *);
void testR_CleanUp(SA_TYPE x, int y, int z) {
- printf("test Cleanup\n");
- (ptr_stdR_CleanUp)(x, y, z);
+ printf("test Cleanup\n");
+ (ptr_stdR_CleanUp)(x, y, z);
}
void testR_Suicide(const char *msg) {
- printf("testR_Suicide: %s\n",msg);
- (ptr_stdR_Suicide(msg));
+ printf("testR_Suicide: %s\n",msg);
+ (ptr_stdR_Suicide(msg));
}
int testR_ReadConsole(const char *prompt, unsigned char *buf, int len, int h) {
- fputs(prompt, stdout);
- fflush(stdout); /* make sure prompt is output */
- if (fgets((char *)buf, len, stdin) == NULL) {
- return 0;
- } else {
- return 1;
- }
+ fputs(prompt, stdout);
+ fflush(stdout); /* make sure prompt is output */
+ if (fgets((char *)buf, len, stdin) == NULL) {
+ return 0;
+ } else {
+ return 1;
+ }
}
void testR_WriteConsole(const char *buf, int len) {
@@ -65,31 +65,28 @@ void testR_WriteConsole(const char *buf, int len) {
}
int main(int argc, char **argv) {
- char *r_home = getenv("R_HOME");
- if (r_home == NULL) {
- printf("R_HOME must be set\n");
- exit(1);
- }
- printf("Initializing R with Rf_initialize_R...\n");
- Rf_initialize_R(argc, argv);
- structRstart rp;
- Rstart Rp = &rp;
- R_DefParams(Rp);
- Rp->SaveAction = SA_SAVEASK;
- printf("Initializing R with R_SetParams...\n");
- R_SetParams(Rp);
- ptr_stdR_CleanUp = ptr_R_CleanUp;
- ptr_R_CleanUp = &testR_CleanUp;
- ptr_stdR_Suicide = ptr_R_Suicide;
- ptr_R_Suicide = &testR_Suicide;
- ptr_R_ReadConsole = &testR_ReadConsole;
- ptr_R_WriteConsole = &testR_WriteConsole;
- // TODO:
- // printf("Calling R_getEmbeddingDllInfo...\n");
- // DllInfo *eDllInfo = R_getEmbeddingDllInfo();
- printf("Running R with Rf_mainloop...\n");
- Rf_mainloop();
- printf("Closing R with Rf_endEmbeddedR...\n");
- Rf_endEmbeddedR(0);
- printf("Done");
+ char *r_home = getenv("R_HOME");
+ if (r_home == NULL) {
+ printf("R_HOME must be set\n");
+ exit(1);
+ }
+ printf("Initializing R with Rf_initialize_R...\n");
+ Rf_initialize_R(argc, argv);
+ structRstart rp;
+ Rstart Rp = &rp;
+ R_DefParams(Rp);
+ Rp->SaveAction = SA_SAVEASK;
+ printf("Initializing R with R_SetParams...\n");
+ R_SetParams(Rp);
+ ptr_stdR_CleanUp = ptr_R_CleanUp;
+ ptr_R_CleanUp = &testR_CleanUp;
+ ptr_stdR_Suicide = ptr_R_Suicide;
+ ptr_R_Suicide = &testR_Suicide;
+ ptr_R_ReadConsole = &testR_ReadConsole;
+ ptr_R_WriteConsole = &testR_WriteConsole;
+ printf("Running R with Rf_mainloop...\n");
+ Rf_mainloop();
+ printf("Closing R with Rf_endEmbeddedR...\n");
+ Rf_endEmbeddedR(0);
+ printf("Done");
}
diff --git a/com.oracle.truffle.r.test.native/embedded/src/main.expected.output b/com.oracle.truffle.r.test.native/embedded/src/main.expected.output
new file mode 100644
index 0000000000000000000000000000000000000000..05a230a88c724b4ef17b790c41450e669eb0c0c7
--- /dev/null
+++ b/com.oracle.truffle.r.test.native/embedded/src/main.expected.output
@@ -0,0 +1,8 @@
+Initializing R with Rf_initialize_R...
+Initializing R with R_SetParams...
+Running R with Rf_mainloop...
+TODO prompt> [1] 2 4 6 8 6 8 10 12 10 12
+Warning message:
+In 1:4 + 1:10 :
+ longer object length is not a multiple of shorter object length
+TODO prompt>test Cleanup
diff --git a/com.oracle.truffle.r.test.native/embedded/src/main.input b/com.oracle.truffle.r.test.native/embedded/src/main.input
new file mode 100644
index 0000000000000000000000000000000000000000..38d61667bff343282e28792db2349d30e1f9160e
--- /dev/null
+++ b/com.oracle.truffle.r.test.native/embedded/src/main.input
@@ -0,0 +1,2 @@
+1:4 + 1:10
+q('no')
diff --git a/com.oracle.truffle.r.test.native/embedded/test.sh b/com.oracle.truffle.r.test.native/embedded/test.sh
new file mode 100755
index 0000000000000000000000000000000000000000..38f05584f494acff07adee9bf307abfa9a166f20
--- /dev/null
+++ b/com.oracle.truffle.r.test.native/embedded/test.sh
@@ -0,0 +1,61 @@
+#!/bin/bash
+#
+# Copyright (c) 2018, 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.
+#
+
+set -e
+
+# Resolve the location of this script
+source="${BASH_SOURCE[0]}"
+while [ -h "$source" ] ; do
+ prev_source="$source"
+ source="$(readlink "$source")";
+ if [[ "$source" != /* ]]; then
+ # if the link was relative, it was relative to where it came from
+ dir="$( cd -P "$( dirname "$prev_source" )" && pwd )"
+ source="$dir/$source"
+ fi
+done
+dir="$( cd -P "$( dirname "$source" )" && pwd )"
+
+: ${R_HOME?"R_HOME must point to FastR directory"}
+: ${NFI_LIB?"NFI_LIB must point to libtrufflenfi.so located in mxbuild directory of Truffle"}
+
+echo "Testing 'main' embedding example..."
+(cd $dir/bin; ./main -Dtruffle.nfi.library=$NFI_LIB --vanilla < $dir/src/main.input > $dir/main.actual.output 2>&1)
+if ! diff -q $dir/main.actual.output $dir/src/main.expected.output > /dev/null 2>&1; then
+ echo "'main' embedding test failed"
+ echo "for details see $dir/main.actual.output $dir/src/main.expected.output"
+ echo "to run this test: mx rembedtest"
+ exit 1
+fi
+
+echo "Testing 'embedded' embedding example..."
+(cd $dir/bin; ./embedded -Dtruffle.nfi.library=$NFI_LIB --vanilla > $dir/embedded.actual.output 2>&1)
+if ! diff -q $dir/embedded.actual.output $dir/src/embedded.expected.output > /dev/null 2>&1; then
+ echo "'embedded' embedding test failed"
+ echo "for details see $dir/embedded.actual.output $dir/src/embedded.expected.output"
+ echo "to run this test: mx rembedtest"
+ exit 2
+fi
+
+echo "DONE"
diff --git a/mx.fastr/copyrights/overrides b/mx.fastr/copyrights/overrides
index f3632cb367c8863d7e1b0476ef95b63aa919962c..a0e848c66578e575121b6092beb8c70f51dfdcc5 100644
--- a/mx.fastr/copyrights/overrides
+++ b/mx.fastr/copyrights/overrides
@@ -101,6 +101,7 @@ com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/ts.h,no.copyright
com.oracle.truffle.r.native/gnur/patch/src/library/tools/src/tools_dummy.c,no.copyright
com.oracle.truffle.r.native/gnur/patch/src/library/utils/src/utils_dummy.c,no.copyright
com.oracle.truffle.r.native/run/R.sh,oracle_bash.copyright
+com.oracle.truffle.r.test.native/embedded/test.sh,oracle_bash.copyright
com.oracle.truffle.r.native/run/Rclasspath.sh,oracle_bash.copyright
com.oracle.truffle.r.native/run/Rscript_exec.sh,oracle_bash.copyright
com.oracle.truffle.r.native/run/Rscript.sh,oracle_bash.copyright
diff --git a/mx.fastr/mx_fastr.py b/mx.fastr/mx_fastr.py
index fbf291a74311d8fd357fc407ae12bf294d71a50f..700ba883572d9bf829100793adebb5662751bb9e 100644
--- a/mx.fastr/mx_fastr.py
+++ b/mx.fastr/mx_fastr.py
@@ -245,8 +245,25 @@ def rrepl(args, nonZeroIsFatal=True, extraVmArgs=None):
run_r(args, 'rrepl')
def rembed(args, nonZeroIsFatal=True, extraVmArgs=None):
+ '''
+ Runs pure Java program that simulates the embedding scenario doing the same up-calls as embedded would call.
+ '''
run_r(args, 'rembed')
+def rembedtest(args, nonZeroIsFatal=False, extraVmArgs=None):
+ '''
+ Runs simple R embedding API tests located in com.oracle.truffle.r.test.native/embedded.
+ The tests should be compiled by mx build before they can be run.
+ Each test (native application) is run and its output compared to the expected output
+ file located next to the source file.
+ '''
+ env = os.environ.copy()
+ env['R_HOME'] = _fastr_suite.dir
+ so_suffix = '.dylib' if platform.system().lower() == 'darwin' else '.so'
+ env['NFI_LIB'] = join(mx.suite('truffle').get_output_root(platformDependent=True), 'truffle-nfi-native/bin/libtrufflenfi' + so_suffix)
+ tests_script = join(_fastr_suite.dir, 'com.oracle.truffle.r.test.native/embedded/test.sh')
+ return mx.run([tests_script], env=env, nonZeroIsFatal=nonZeroIsFatal)
+
def _fastr_gate_runner(args, tasks):
'''
The specific additional gates tasks provided by FastR:
@@ -277,6 +294,11 @@ def _fastr_gate_runner(args, tasks):
if t:
mx_unittest.unittest(_apps_unit_tests())
+ with mx_gate.Task('Rembedded', tasks) as t:
+ if t:
+ if rembedtest([]) != 0:
+ t.abort("Rembedded tests failed")
+
mx_gate.add_gate_runner(_fastr_suite, _fastr_gate_runner)
def rgate(args):
@@ -553,6 +575,7 @@ _commands = {
'rbdiag' : [rbdiag, '(builtin)* [-v] [-n] [-m] [--sweep | --sweep=lite | --sweep=total] [--mnonly] [--noSelfTest] [--matchLevel=same | --matchLevel=error] [--maxSweeps=N] [--outMaxLev=N]'],
'rrepl' : [rrepl, '[options]'],
'rembed' : [rembed, '[options]'],
+ 'rembedtest' : [rembedtest, '[options]'],
'r-cp' : [r_classpath, '[options]'],
'pkgtest' : [mx_fastr_pkgs.pkgtest, ['options']],
'pkgtest-cmp' : [mx_fastr_pkgs.pkgtest_cmp, ['gnur_path fastr_path']],
diff --git a/mx.fastr/suite.py b/mx.fastr/suite.py
index c8030673c77775a83b320ea3a8f62fa274307e95..d3b790160193fc0f5e3a94d2849209ec7f9d7f90 100644
--- a/mx.fastr/suite.py
+++ b/mx.fastr/suite.py
@@ -7,7 +7,7 @@ suite = {
{
"name" : "truffle",
"subdir" : True,
- "version" : "3bd8ec58a9318d99953b338967f6579d7a8dc140",
+ "version" : "3e12bec05f7a74f9fbdcd2d2f45f262492fd1306",
"urls" : [
{"url" : "https://github.com/graalvm/graal", "kind" : "git"},
{"url" : "https://curio.ssw.jku.at/nexus/content/repositories/snapshots", "kind" : "binary"},