Introduced new native functions and fixed implementation of some others.

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);
+}

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) {

com.oracle.truffle.r.native/include/ed_Rinterface_gcntx

 /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

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;
+    }
+
 }