From 13ae8a54dddac85a2df86246cef5bf02855c7c3a Mon Sep 17 00:00:00 2001
From: stepan <stepan.sindelar@oracle.com>
Date: Tue, 13 Mar 2018 17:54:01 +0100
Subject: [PATCH] RFFI implement SET_OBJECT
---
.../ffi/impl/common/JavaUpCallsRFFIImpl.java | 5 ++
.../truffle/r/ffi/impl/nodes/MiscNodes.java | 47 +++++++++++++++
.../r/ffi/impl/upcalls/StdUpCallsRFFI.java | 4 ++
.../fficall/src/common/rffi_upcallsindex.h | 59 ++++++++++---------
.../Rinternals_truffle_common.h | 4 +-
com.oracle.truffle.r.native/version.source | 2 +-
.../packages/testrffi/testrffi/R/api.R | 1 +
.../packages/testrffi/testrffi/src/init_api.h | 1 +
.../testrffi/testrffi/src/rffiwrappers.c | 5 ++
.../testrffi/testrffi/src/rffiwrappers.h | 2 +
.../testrffi/testrffi/tests/simpleTests.R | 24 ++++++++
11 files changed, 123 insertions(+), 31 deletions(-)
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 2eecee257a..071912314d 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
@@ -555,6 +555,11 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI {
}
}
+ @Override
+ public void SET_OBJECT(Object x, int flag) {
+ throw implementedAsNode();
+ }
+
@Override
public void SET_NAMED_FASTR(Object x, int v) {
// Note: In GNUR this is a macro that sets the sxpinfo.named regardless of whether it makes
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 c7259e6558..3349fe9d24 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
@@ -41,12 +41,14 @@ import com.oracle.truffle.r.ffi.impl.nodes.MiscNodesFactory.RHasSlotNodeGen;
import com.oracle.truffle.r.ffi.impl.nodes.MiscNodesFactory.SetFunctionBodyNodeGen;
import com.oracle.truffle.r.ffi.impl.nodes.MiscNodesFactory.SetFunctionEnvironmentNodeGen;
import com.oracle.truffle.r.ffi.impl.nodes.MiscNodesFactory.SetFunctionFormalsNodeGen;
+import com.oracle.truffle.r.ffi.impl.nodes.MiscNodesFactory.SetObjectNodeGen;
import com.oracle.truffle.r.nodes.RASTUtils;
import com.oracle.truffle.r.nodes.access.AccessSlotNode;
import com.oracle.truffle.r.nodes.access.AccessSlotNodeGen;
import com.oracle.truffle.r.nodes.access.HasSlotNode;
import com.oracle.truffle.r.nodes.access.UpdateSlotNode;
import com.oracle.truffle.r.nodes.access.UpdateSlotNodeGen;
+import com.oracle.truffle.r.nodes.attributes.SpecialAttributesFunctions.GetClassAttributeNode;
import com.oracle.truffle.r.nodes.attributes.SpecialAttributesFunctions.SetNamesAttributeNode;
import com.oracle.truffle.r.nodes.attributes.SpecialAttributesFunctionsFactory.SetNamesAttributeNodeGen;
import com.oracle.truffle.r.nodes.builtin.EnvironmentNodes.GetFunctionEnvironmentNode;
@@ -57,13 +59,17 @@ 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.RError.Message;
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;
import com.oracle.truffle.r.runtime.data.RNull;
import com.oracle.truffle.r.runtime.data.RRawVector;
+import com.oracle.truffle.r.runtime.data.RSharingAttributeStorage;
+import com.oracle.truffle.r.runtime.data.RStringVector;
import com.oracle.truffle.r.runtime.data.RSymbol;
+import com.oracle.truffle.r.runtime.data.RTypedValue;
import com.oracle.truffle.r.runtime.data.RTypes;
import com.oracle.truffle.r.runtime.data.model.RAbstractContainer;
import com.oracle.truffle.r.runtime.env.REnvironment;
@@ -369,4 +375,45 @@ public final class MiscNodes {
return RNull.instance;
}
}
+
+ public abstract static class SetObjectNode extends FFIUpCallNode.Arg2 {
+ public static SetObjectNode create() {
+ return SetObjectNodeGen.create();
+ }
+
+ @Child private GetClassAttributeNode getClassAttributeNode;
+
+ @Specialization
+ protected Object doIt(RTypedValue target, int flag) {
+ // Note: "OBJECT" is an internal flag in SEXP that internal dispatching (in FastR
+ // INTERNAL_DISPATCH builtins) is checking first before even checking the attributes
+ // collection for presence of the "class" attribute. FastR always checks attributes and
+ // ignores the OBJECT flag. The only possible difference is hence if someone sets
+ // OBJECT flag to 0 for a SEXP that actually has some class, in which case in GNUR the
+ // internal dispatch builtins like 'as.character' will not dispatch to the S3 method
+ // even thought the object has S3 class and FastR would dispatch.
+ // See simpleTests.R in testrffi package for example.
+ if (flag == 0 && target instanceof RSharingAttributeStorage) {
+ RStringVector clazz = getClass((RSharingAttributeStorage) target);
+ if (clazz != null && clazz.getLength() != 0) {
+ CompilerDirectives.transferToInterpreter();
+ throw RError.error(RError.NO_CALLER, Message.GENERIC, String.format("SET_OBJECT(SEXP, 0) not implemented for SEXP with 'class' attribute"));
+ }
+ }
+ return RNull.instance;
+ }
+
+ @Specialization
+ protected Object doOthers(Object value, Object flag) {
+ throw unsupportedTypes("SET_OBJECT", value, flag);
+ }
+
+ private RStringVector getClass(RSharingAttributeStorage value) {
+ if (getClassAttributeNode == null) {
+ CompilerDirectives.transferToInterpreterAndInvalidate();
+ getClassAttributeNode = insert(GetClassAttributeNode.create());
+ }
+ return getClassAttributeNode.getClassAttr(value);
+ }
+ }
}
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 7f6d381c22..e9bbeb09d1 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
@@ -58,6 +58,7 @@ import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodes.SETCARNode;
import com.oracle.truffle.r.ffi.impl.nodes.MatchNodes;
import com.oracle.truffle.r.ffi.impl.nodes.MiscNodes;
import com.oracle.truffle.r.ffi.impl.nodes.MiscNodes.LENGTHNode;
+import com.oracle.truffle.r.ffi.impl.nodes.MiscNodes.SetObjectNode;
import com.oracle.truffle.r.ffi.impl.nodes.NewCustomConnectionNode;
import com.oracle.truffle.r.ffi.impl.nodes.RMakeExternalPtrNode;
import com.oracle.truffle.r.ffi.impl.nodes.RandFunctionsNodes;
@@ -267,6 +268,9 @@ public interface StdUpCallsRFFI {
int NAMED(Object x);
+ @RFFIUpCallNode(SetObjectNode.class)
+ void SET_OBJECT(Object x, int flag);
+
void SET_NAMED_FASTR(Object x, int v);
Object SET_TYPEOF_FASTR(Object x, int v);
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 52b7c3a493..28b3d41c7b 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
@@ -255,35 +255,36 @@
#define SET_CLOENV_x 249
#define SET_FORMALS_x 250
#define SET_NAMED_FASTR_x 251
-#define SET_RDEBUG_x 252
-#define SET_RSTEP_x 253
-#define SET_S4_OBJECT_x 254
-#define SET_STRING_ELT_x 255
-#define SET_SYMVALUE_x 256
-#define SET_TAG_x 257
-#define SET_TYPEOF_FASTR_x 258
-#define SET_VECTOR_ELT_x 259
-#define STRING_ELT_x 260
-#define SYMVALUE_x 261
-#define TAG_x 262
-#define TYPEOF_x 263
-#define UNSET_S4_OBJECT_x 264
-#define VECTOR_ELT_x 265
-#define forceSymbols_x 266
-#define getCCallable_x 267
-#define getConnectionClassString_x 268
-#define getEmbeddingDLLInfo_x 269
-#define getOpenModeString_x 270
-#define getSummaryDescription_x 271
-#define isSeekable_x 272
-#define octsize_x 273
-#define registerCCallable_x 274
-#define registerRoutines_x 275
-#define restoreHandlerStacks_x 276
-#define setDotSymbolValues_x 277
-#define unif_rand_x 278
-#define useDynamicSymbols_x 279
+#define SET_OBJECT_x 252
+#define SET_RDEBUG_x 253
+#define SET_RSTEP_x 254
+#define SET_S4_OBJECT_x 255
+#define SET_STRING_ELT_x 256
+#define SET_SYMVALUE_x 257
+#define SET_TAG_x 258
+#define SET_TYPEOF_FASTR_x 259
+#define SET_VECTOR_ELT_x 260
+#define STRING_ELT_x 261
+#define SYMVALUE_x 262
+#define TAG_x 263
+#define TYPEOF_x 264
+#define UNSET_S4_OBJECT_x 265
+#define VECTOR_ELT_x 266
+#define forceSymbols_x 267
+#define getCCallable_x 268
+#define getConnectionClassString_x 269
+#define getEmbeddingDLLInfo_x 270
+#define getOpenModeString_x 271
+#define getSummaryDescription_x 272
+#define isSeekable_x 273
+#define octsize_x 274
+#define registerCCallable_x 275
+#define registerRoutines_x 276
+#define restoreHandlerStacks_x 277
+#define setDotSymbolValues_x 278
+#define unif_rand_x 279
+#define useDynamicSymbols_x 280
-#define UPCALLS_TABLE_SIZE 280
+#define UPCALLS_TABLE_SIZE 281
#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 86b8f49235..c1e44d5c68 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
@@ -1218,11 +1218,12 @@ int REFCNT(SEXP x) {
void SET_OBJECT(SEXP x, int v) {
TRACE0();
- unimplemented("SET_OBJECT");
+ ((call_SET_OBJECT) callbacks[SET_OBJECT_x])(x, v);
}
void SET_TYPEOF(SEXP x, int v) {
TRACE0();
+ // TODO: we will be able to implement this for RLanguage <-> RPairList once they are unified in one Java class
unimplemented("SET_TYPEOF");
}
@@ -1253,6 +1254,7 @@ void DUPLICATE_ATTRIB(SEXP to, SEXP from) {
R_len_t R_BadLongVector(SEXP x, const char *y, int z) {
TRACE0();
unimplemented("R_BadLongVector");
+ exit(1);
// "no return" function
}
diff --git a/com.oracle.truffle.r.native/version.source b/com.oracle.truffle.r.native/version.source
index 8c61d23e12..04f9fe4606 100644
--- a/com.oracle.truffle.r.native/version.source
+++ b/com.oracle.truffle.r.native/version.source
@@ -1 +1 @@
-58
+59
diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/api.R b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/api.R
index 9503277930..433e496efc 100644
--- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/api.R
+++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/api.R
@@ -47,6 +47,7 @@ api.SET_ATTRIB <- function(...) .Call(C_api_SET_ATTRIB, ...)
api.STRING_ELT <- function(...) .Call(C_api_STRING_ELT, ...)
api.VECTOR_ELT <- function(...) .Call(C_api_VECTOR_ELT, ...)
api.NAMED <- function(...) .Call(C_api_NAMED, ...)
+api.SET_OBJECT <- function(...) .Call(C_api_SET_OBJECT, ...)
api.SET_NAMED <- function(...) .Call(C_api_SET_NAMED, ...)
api.TYPEOF <- function(...) .Call(C_api_TYPEOF, ...)
api.Rf_any_duplicated <- function(...) .Call(C_api_Rf_any_duplicated, ...)
diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/init_api.h b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/init_api.h
index cdb6fde760..345fc0f7b5 100644
--- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/init_api.h
+++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/init_api.h
@@ -71,6 +71,7 @@ CALLDEF(api_SET_ATTRIB, 2),
CALLDEF(api_STRING_ELT, 2),
CALLDEF(api_VECTOR_ELT, 2),
CALLDEF(api_NAMED, 1),
+CALLDEF(api_SET_OBJECT, 2),
CALLDEF(api_SET_NAMED, 2),
CALLDEF(api_TYPEOF, 1),
CALLDEF(api_Rf_any_duplicated, 2),
diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/rffiwrappers.c b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/rffiwrappers.c
index b15db1b772..c9bf742466 100644
--- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/rffiwrappers.c
+++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/rffiwrappers.c
@@ -228,6 +228,11 @@ SEXP api_NAMED(SEXP x) {
return ScalarInteger(NAMED(x));
}
+SEXP api_SET_OBJECT(SEXP x, SEXP flag) {
+ SET_OBJECT(x, INTEGER_VALUE(flag));
+ return R_NilValue;
+}
+
SEXP api_SET_NAMED(SEXP x, SEXP v) {
SET_NAMED(x, INTEGER_VALUE(v));
return R_NilValue;
diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/rffiwrappers.h b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/rffiwrappers.h
index da4473e42e..f59eb727b1 100644
--- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/rffiwrappers.h
+++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/rffiwrappers.h
@@ -122,6 +122,8 @@ SEXP api_VECTOR_ELT(SEXP x, SEXP i);
SEXP api_NAMED(SEXP x);
+SEXP api_SET_OBJECT(SEXP x, SEXP flag);
+
SEXP api_SET_NAMED(SEXP x, SEXP v);
SEXP api_TYPEOF(SEXP x);
diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/simpleTests.R b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/simpleTests.R
index a620c50095..dfd740c94c 100644
--- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/simpleTests.R
+++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/simpleTests.R
@@ -149,3 +149,27 @@ setAttrTarget
typeof(api.ATTRIB(mtcars))
api.ATTRIB(structure(c(1,2,3), myattr3 = 33))
+
+# SET_OBJECT
+# FastR does not fully support the SET_OBJECT fully,
+# the test is left here in case there is a need to actually implement it.
+x <- structure(3, class='abc')
+# just to make sure tirivial SET_OBJECT examples work
+api.SET_OBJECT(x, 1)
+api.SET_OBJECT(c(1,2,3), 0)
+
+## before SET_OBJECT(x,0), S3 dispatching works as expected:
+# foo <- function(x) UseMethod('foo')
+# foo.default <- function(x) cat("foo.default\n")
+# foo.abc <- function(x) cat("foo.abc\n")
+# as.character.abc <- function(...) "42"
+# paste(x) # "42"
+# foo(x) # "foo.abc"
+
+# api.SET_OBJECT(x, 0) # FastR throws error saying that this is not implemented
+
+## after SET_OBJECT(x,0), S3 dispatching does not work for internals
+# paste(x) # "3" -- as.character.abc not called
+# inherits(x, 'abc') # TRUE
+# foo(x) # "foo.abc"
+
--
GitLab