diff --git a/com.oracle.truffle.r.native/fficall/src/jni/Rembedded.c b/com.oracle.truffle.r.native/fficall/src/jni/Rembedded.c
index 6737019c8928e4153987352fe6f507f7e0c6efa7..3b1cbfe0ac19ce8b186f0c02724e04fc4b760128 100644
--- a/com.oracle.truffle.r.native/fficall/src/jni/Rembedded.c
+++ b/com.oracle.truffle.r.native/fficall/src/jni/Rembedded.c
@@ -572,3 +572,54 @@ static char **update_environ_with_java_home(void) {
return update_environ(java_home_env);
}
+CTXT R_getGlobalFunctionContext() {
+ JNIEnv *jniEnv = getEnv();
+ jmethodID methodID = checkGetMethodID(jniEnv, CallRFFIHelperClass, "R_getGlobalFunctionContext", "()Ljava/lang/Object;", 1);
+ CTXT result = (*jniEnv)->CallStaticObjectMethod(jniEnv, CallRFFIHelperClass, methodID);
+ result = checkRef(jniEnv, result);
+ return result == R_NilValue ? NULL : result;
+}
+
+CTXT R_getParentFunctionContext(CTXT c) {
+ JNIEnv *jniEnv = getEnv();
+ jmethodID methodID = checkGetMethodID(jniEnv, CallRFFIHelperClass, "R_getParentFunctionContext", "(Ljava/lang/Object;)Ljava/lang/Object;", 1);
+ CTXT result = (*jniEnv)->CallStaticObjectMethod(jniEnv, CallRFFIHelperClass, methodID, c);
+ result = checkRef(jniEnv, result);
+ return result == R_NilValue ? NULL : result;
+}
+
+SEXP R_getContextEnv(CTXT context) {
+ JNIEnv *jniEnv = getEnv();
+ jmethodID methodID = checkGetMethodID(jniEnv, CallRFFIHelperClass, "R_getContextEnv", "(Ljava/lang/Object;)Ljava/lang/Object;", 1);
+ SEXP result = (*jniEnv)->CallStaticObjectMethod(jniEnv, CallRFFIHelperClass, methodID, context);
+ return checkRef(jniEnv, result);
+}
+
+SEXP R_getContextFun(CTXT context) {
+ JNIEnv *jniEnv = getEnv();
+ jmethodID methodID = checkGetMethodID(jniEnv, CallRFFIHelperClass, "R_getContextFun", "(Ljava/lang/Object;)Ljava/lang/Object;", 1);
+ SEXP result = (*jniEnv)->CallStaticObjectMethod(jniEnv, CallRFFIHelperClass, methodID, context);
+ return checkRef(jniEnv, result);
+}
+
+SEXP R_getContextCall(CTXT context) {
+ return R_NilValue;
+ JNIEnv *jniEnv = getEnv();
+ jmethodID methodID = checkGetMethodID(jniEnv, CallRFFIHelperClass, "R_getContextCall", "(Ljava/lang/Object;)Ljava/lang/Object;", 1);
+ SEXP result = (*jniEnv)->CallStaticObjectMethod(jniEnv, CallRFFIHelperClass, methodID, context);
+ return checkRef(jniEnv, result);
+}
+
+SEXP R_getContextSrcRef(CTXT context) {
+ JNIEnv *jniEnv = getEnv();
+ jmethodID methodID = checkGetMethodID(jniEnv, CallRFFIHelperClass, "R_getContextSrcRef", "(Ljava/lang/Object;)Ljava/lang/Object;", 1);
+ SEXP result = (*jniEnv)->CallStaticObjectMethod(jniEnv, CallRFFIHelperClass, methodID, context);
+ result = checkRef(jniEnv, result);
+ return result == R_NilValue ? NULL : result;
+}
+
+int R_insideBrowser() {
+ JNIEnv *jniEnv = getEnv();
+ jmethodID methodID = checkGetMethodID(jniEnv, CallRFFIHelperClass, "R_insideBrowser", "()I", 1);
+ return (*jniEnv)->CallStaticIntMethod(jniEnv, CallRFFIHelperClass, methodID);
+}
diff --git a/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c b/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c
index 65c94ff94dda4d1d518a81bbe8c283ff33587e7b..bdb2015fbbbfd2f1ae29a8409a35f4df3944aa57 100644
--- a/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c
+++ b/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c
@@ -102,6 +102,7 @@ static jmethodID SET_RDEBUGMethodID;
static jmethodID RSTEPMethodID;
static jmethodID SET_RSTEPMethodID;
static jmethodID ENCLOSMethodID;
+static jmethodID PRVALUEMethodID;
static jmethodID R_lsInternal3MethodID;
static jclass rErrorHandlingClass;
@@ -197,6 +198,7 @@ void init_internals(JNIEnv *env) {
RSTEPMethodID = checkGetMethodID(env, CallRFFIHelperClass, "RSTEP", "(Ljava/lang/Object;)I", 1);
SET_RSTEPMethodID = checkGetMethodID(env, CallRFFIHelperClass, "SET_RSTEP", "(Ljava/lang/Object;I)V", 1);
ENCLOSMethodID = checkGetMethodID(env, CallRFFIHelperClass, "ENCLOS", "(Ljava/lang/Object;)Ljava/lang/Object;", 1);
+ PRVALUEMethodID = checkGetMethodID(env, CallRFFIHelperClass, "PRVALUE", "(Ljava/lang/Object;)Ljava/lang/Object;", 1);
R_lsInternal3MethodID = checkGetMethodID(env, CallRFFIHelperClass, "R_lsInternal3", "(Ljava/lang/Object;II)Ljava/lang/Object;", 1);
rErrorHandlingClass = checkFindClass(env, "com/oracle/truffle/r/runtime/RErrorHandling");
@@ -1024,7 +1026,9 @@ SEXP PRENV(SEXP x) {
}
SEXP PRVALUE(SEXP x) {
- return unimplemented("PRVALUE");
+ JNIEnv *thisenv = getEnv();
+ SEXP result = (*thisenv)->CallStaticObjectMethod(thisenv, CallRFFIHelperClass, PRVALUEMethodID, x);
+ return checkRef(thisenv, result);
}
int PRSEEN(SEXP x) {
@@ -1437,7 +1441,7 @@ Rboolean R_HasFancyBindings(SEXP rho) {
}
Rboolean Rf_isS4(SEXP x) {
- return (Rboolean) unimplemented("Rf_isS4");
+ return IS_S4_OBJECT(x);
}
SEXP Rf_asS4(SEXP x, Rboolean b, int i) {
diff --git a/com.oracle.truffle.r.native/include/ed_Rinterface_gcntx b/com.oracle.truffle.r.native/include/ed_Rinterface_gcntx
index 29fd2e768ca5fdd160db4c2edbfee7e3947c2b3b..5f085cd81fa846613522a7038891b4060c9865f7 100644
--- a/com.oracle.truffle.r.native/include/ed_Rinterface_gcntx
+++ b/com.oracle.truffle.r.native/include/ed_Rinterface_gcntx
@@ -1,8 +1,15 @@
/R_GlobalContext/
i
#ifdef FASTR
-extern void* FASTR_GlobalContext();
+extern CTXT FASTR_GlobalContext();
#define R_GlobalContext FASTR_GlobalContext()
+extern CTXT R_getGlobalFunctionContext();
+extern CTXT R_getParentFunctionContext(CTXT);
+extern SEXP R_getContextEnv(CTXT);
+extern SEXP R_getContextFun(CTXT);
+extern SEXP R_getContextCall(CTXT);
+extern SEXP R_getContextSrcRef(CTXT);
+extern int R_insideBrowser();
#else
.
+1
diff --git a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/CallRFFIHelper.java b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/CallRFFIHelper.java
index 38fb92a0f82e0b2d286fb3c975b26b599abe7e23..252696078dafb97459a400835e9e117da69dcfa1 100644
--- a/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/CallRFFIHelper.java
+++ b/com.oracle.truffle.r.runtime.ffi/src/com/oracle/truffle/r/runtime/ffi/jnr/CallRFFIHelper.java
@@ -25,9 +25,13 @@ package com.oracle.truffle.r.runtime.ffi.jnr;
import java.nio.charset.StandardCharsets;
import java.util.HashMap;
import java.util.Map;
+import java.util.function.Function;
import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary;
+import com.oracle.truffle.api.frame.Frame;
+import com.oracle.truffle.api.frame.FrameInstance.FrameAccess;
import com.oracle.truffle.api.source.Source;
+import com.oracle.truffle.api.source.SourceSection;
import com.oracle.truffle.r.runtime.RArguments;
import com.oracle.truffle.r.runtime.RCaller;
import com.oracle.truffle.r.runtime.RCleanUp;
@@ -37,8 +41,9 @@ import com.oracle.truffle.r.runtime.RError;
import com.oracle.truffle.r.runtime.RErrorHandling;
import com.oracle.truffle.r.runtime.RInternalError;
import com.oracle.truffle.r.runtime.RRuntime;
-import com.oracle.truffle.r.runtime.RSerialize;
+import com.oracle.truffle.r.runtime.RSrcref;
import com.oracle.truffle.r.runtime.RType;
+import com.oracle.truffle.r.runtime.Utils;
import com.oracle.truffle.r.runtime.RStartParams.SA_TYPE;
import com.oracle.truffle.r.runtime.context.Engine.ParseException;
import com.oracle.truffle.r.runtime.context.RContext;
@@ -750,9 +755,12 @@ public class CallRFFIHelper {
if (RFFIUtils.traceEnabled()) {
RFFIUtils.traceUpCall("CAR", e);
}
- guaranteeInstanceOf(e, RPairList.class);
- Object car = ((RPairList) e).car();
- return car;
+ guarantee(e != null && (RPairList.class.isInstance(e) || RLanguage.class.isInstance(e)), "CAR only works on pair lists and language objects");
+ if (e instanceof RPairList) {
+ return ((RPairList) e).car();
+ } else {
+ return ((RLanguage) e).getDataAtAsObject(0);
+ }
}
public static Object CDR(Object e) {
@@ -760,17 +768,19 @@ public class CallRFFIHelper {
RFFIUtils.traceUpCall("CDR", e);
}
guaranteeInstanceOf(e, RPairList.class);
- Object cdr = ((RPairList) e).cdr();
- return cdr;
+ return ((RPairList) e).cdr();
}
public static Object CADR(Object e) {
if (RFFIUtils.traceEnabled()) {
RFFIUtils.traceUpCall("CADR", e);
}
- guaranteeInstanceOf(e, RPairList.class);
- Object cadr = ((RPairList) e).cadr();
- return cadr;
+ guarantee(e != null && (RPairList.class.isInstance(e) || RLanguage.class.isInstance(e)), "CADR only works on pair lists and language objects");
+ if (e instanceof RPairList) {
+ return ((RPairList) e).cadr();
+ } else {
+ return ((RLanguage) e).getDataAtAsObject(1);
+ }
}
public static Object SET_TAG(Object x, Object y) {
@@ -1059,6 +1069,14 @@ public class CallRFFIHelper {
return result;
}
+ public static Object PRVALUE(Object x) {
+ if (RFFIUtils.traceEnabled()) {
+ RFFIUtils.traceUpCall("PRVALUE", x);
+ }
+ RPromise p = guaranteeInstanceOf(x, RPromise.class);
+ return p.isEvaluated() ? p.getValue() : RUnboundValue.instance;
+ }
+
private enum ParseStatus {
PARSE_NULL,
PARSE_OK,
@@ -1127,11 +1145,18 @@ public class CallRFFIHelper {
return x;
}
+ private static RCaller topLevel = RCaller.createInvalid(null);
+
public static Object getGlobalContext() {
if (RFFIUtils.traceEnabled()) {
RFFIUtils.traceUpCall("getGlobalContext");
}
- return unimplemented("getGlobalContext");
+ Frame frame = Utils.getActualCurrentFrame();
+ if (frame == null) {
+ return topLevel;
+ }
+ RCaller rCaller = RArguments.getCall(frame);
+ return rCaller == null ? topLevel : rCaller;
}
public static Object getGlobalEnv() {
@@ -1200,4 +1225,161 @@ public class CallRFFIHelper {
}
return RRNG.unifRand();
}
+
+ public static Object R_getGlobalFunctionContext() {
+ if (RFFIUtils.traceEnabled()) {
+ RFFIUtils.traceUpCall("getGlobalFunctionContext");
+ }
+ Frame frame = Utils.getActualCurrentFrame();
+ if (frame == null) {
+ return RNull.instance;
+ }
+ RCaller currentCaller = RArguments.getCall(frame);
+ while (currentCaller != null) {
+ if (!currentCaller.isPromise()) {
+ break;
+ }
+ currentCaller = currentCaller.getParent();
+ }
+ return currentCaller == null ? RNull.instance : currentCaller;
+ }
+
+ public static Object R_getParentFunctionContext(Object c) {
+ if (RFFIUtils.traceEnabled()) {
+ RFFIUtils.traceUpCall("getParentFunctionContext");
+ }
+ RCaller currentCaller = guaranteeInstanceOf(c, RCaller.class);
+ while (true) {
+ currentCaller = currentCaller.getParent();
+ if (currentCaller == null || !currentCaller.isPromise()) {
+ break;
+ }
+ }
+ return currentCaller == null ? RNull.instance : currentCaller;
+ }
+
+ public static Object R_getFunctionContext(int depth) {
+ if (RFFIUtils.traceEnabled()) {
+ RFFIUtils.traceUpCall("getFunctionContext", depth);
+ }
+ Frame frame = Utils.getActualCurrentFrame();
+ RCaller currentCaller = RArguments.getCall(frame);
+ int currentDepth = 0;
+ while (currentCaller != null) {
+ if (!currentCaller.isPromise()) {
+ currentDepth++;
+ if (currentDepth >= depth) {
+ break;
+ }
+ }
+ currentCaller = currentCaller.getParent();
+ }
+ return currentCaller == null ? RNull.instance : currentCaller;
+ }
+
+ public static Object R_getContextEnv(Object c) {
+ if (RFFIUtils.traceEnabled()) {
+ RFFIUtils.traceUpCall("getContextEnv", c);
+ }
+ RCaller rCaller = guaranteeInstanceOf(c, RCaller.class);
+ if (rCaller == topLevel) {
+ return RContext.getInstance().stateREnvironment.getGlobalEnv();
+ }
+ Frame frame = Utils.getActualCurrentFrame();
+ if (RArguments.getCall(frame) == rCaller) {
+ return REnvironment.frameToEnvironment(frame.materialize());
+ } else {
+ Object result = Utils.iterateRFrames(FrameAccess.READ_ONLY, new Function<Frame, Object>() {
+
+ @Override
+ public Object apply(Frame f) {
+ RCaller currentCaller = RArguments.getCall(f);
+ if (currentCaller == rCaller) {
+ return REnvironment.frameToEnvironment(f.materialize());
+ } else {
+ return null;
+ }
+ }
+ });
+ return result;
+ }
+ }
+
+ public static Object R_getContextFun(Object c) {
+ if (RFFIUtils.traceEnabled()) {
+ RFFIUtils.traceUpCall("getContextEnv", c);
+ }
+ RCaller rCaller = guaranteeInstanceOf(c, RCaller.class);
+ if (rCaller == topLevel) {
+ return RNull.instance;
+ }
+ Frame frame = Utils.getActualCurrentFrame();
+ if (RArguments.getCall(frame) == rCaller) {
+ return RArguments.getFunction(frame);
+ } else {
+ Object result = Utils.iterateRFrames(FrameAccess.READ_ONLY, new Function<Frame, Object>() {
+
+ @Override
+ public Object apply(Frame f) {
+ RCaller currentCaller = RArguments.getCall(f);
+ if (currentCaller == rCaller) {
+ return RArguments.getFunction(f);
+ } else {
+ return null;
+ }
+ }
+ });
+ return result;
+ }
+ }
+
+ public static Object R_getContextCall(Object c) {
+ if (RFFIUtils.traceEnabled()) {
+ RFFIUtils.traceUpCall("getContextEnv", c);
+ }
+ RCaller rCaller = guaranteeInstanceOf(c, RCaller.class);
+ if (rCaller == topLevel) {
+ return RNull.instance;
+ }
+ Frame frame = Utils.getActualCurrentFrame();
+ if (RArguments.getCall(frame) == rCaller) {
+ return RContext.getRRuntimeASTAccess().getSyntaxCaller(rCaller);
+ } else {
+ Object result = Utils.iterateRFrames(FrameAccess.READ_ONLY, new Function<Frame, Object>() {
+
+ @Override
+ public Object apply(Frame f) {
+ RCaller currentCaller = RArguments.getCall(f);
+ if (currentCaller == rCaller) {
+ return RContext.getRRuntimeASTAccess().getSyntaxCaller(rCaller);
+ } else {
+ return null;
+ }
+ }
+ });
+ return result;
+ }
+ }
+
+ public static Object R_getContextSrcRef(Object c) {
+ if (RFFIUtils.traceEnabled()) {
+ RFFIUtils.traceUpCall("getContextSrcRef", c);
+ }
+ Object o = R_getContextFun(c);
+ if (!(o instanceof RFunction)) {
+ return RNull.instance;
+ } else {
+ RFunction f = (RFunction) o;
+ SourceSection ss = f.getRootNode().getSourceSection();
+ String path = ss.getSource().getPath();
+ return RSrcref.createLloc(ss, path);
+
+ }
+
+ }
+
+ public static int R_insideBrowser() {
+ return RContext.getInstance().isInBrowser() ? 1 : 0;
+ }
+
}