Implemented simple cache to avoid upcalls in functions 'INTEGER' and 'REAL'.

com.oracle.truffle.r.native/fficall/src/truffle_common/Rinternals_truffle_common.h

@@ -1011,37 +1011,37 @@ int SETLEVELS(SEXP x, int v) {
     return 0;
 }
 
-int *INTEGER(SEXP x) {
-    TRACE0();
-    SEXP result = ((call_INTEGER) callbacks[INTEGER_x])(x);
+int *FASTR_INTEGER(SEXP x) {
+    TRACE(TARGp, x);
+    int *result = ((call_INTEGER) callbacks[INTEGER_x])(x);
     checkExitCall();
     return result;
 }
 
 int *LOGICAL(SEXP x){
     TRACE0();
-    SEXP result = ((call_LOGICAL) callbacks[LOGICAL_x])(x);
+    int *result = ((call_LOGICAL) callbacks[LOGICAL_x])(x);
     checkExitCall();
     return result;
 }
 
-double *REAL(SEXP x){
-    TRACE0();
-    SEXP result = ((call_REAL) callbacks[REAL_x])(x);
+double *FASTR_REAL(SEXP x){
+    TRACE(TARGp, x);
+    double *result = ((call_REAL) callbacks[REAL_x])(x);
     checkExitCall();
     return result;
 }
 
 Rbyte *RAW(SEXP x) {
     TRACE0();
-    SEXP result = ((call_RAW) callbacks[RAW_x])(x);
+    Rbyte *result = ((call_RAW) callbacks[RAW_x])(x);
     checkExitCall();
     return result;
 }
 
 Rcomplex *COMPLEX(SEXP x) {
     TRACE0();
-    SEXP result = ((call_COMPLEX) callbacks[COMPLEX_x])(x);
+    Rcomplex *result = ((call_COMPLEX) callbacks[COMPLEX_x])(x);
     checkExitCall();
     return result;
 }

com.oracle.truffle.r.native/fficall/src/truffle_llvm/Rinternals.c

@@ -98,4 +98,11 @@ const char *R_CHAR(SEXP charsxp) {
 	return ((call_charSXPToNativeCharArray) callbacks[charSXPToNativeCharArray_x])(charsxp);
 }
 
+int *INTEGER(SEXP x) {
+    return FASTR_INTEGER(x);
+}
+
+double *REAL(SEXP x){
+    return FASTR_REAL(x);
+}
 

com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rinternals.c

@@ -36,10 +36,6 @@ void*** Rinternals_getCallbacksAddress() {
         return &callbacks;
 }
 
-static int* return_int;
-static double* return_double;
-static char* return_byte;
-
 char *ensure_truffle_chararray_n(const char *x, int n) {
 	return (char *) x;
 }
@@ -49,3 +45,77 @@ void *ensure_string(const char * x) {
 }
 
 #include "../truffle_common/Rinternals_truffle_common.h"
+
+#define ARRAY_CACHE_SIZE 5
+
+typedef struct array_cache_entry {
+	SEXP key;
+	void *data;
+	unsigned int hits;
+} ArrayCacheEntry;
+
+static __thread ArrayCacheEntry int_cache[ARRAY_CACHE_SIZE];
+static __thread ArrayCacheEntry real_cache[ARRAY_CACHE_SIZE];
+
+static inline int array_cache_lookup(ArrayCacheEntry *cache, SEXP key) {
+#if ARRAY_CACHE_SIZE > 0
+  for(int i=0; i < ARRAY_CACHE_SIZE; i++) {
+    	if(cache[i].key == key) {
+    		(cache[i].hits)++;
+    		return i;
+    	}
+    }
+#endif
+  return -1;
+}
+
+static inline void array_cache_insert(ArrayCacheEntry *cache, SEXP key,
+		void *data) {
+
+#if ARRAY_CACHE_SIZE > 0
+	// replace least frequent
+	unsigned hits = cache[0].hits;
+	int idx = 0;
+
+	for (int i = 1; i < ARRAY_CACHE_SIZE && hits != 0; i++) {
+		if (cache[i].hits < hits) {
+			hits = cache[i].hits;
+			idx = i;
+		}
+	}
+
+	cache[idx].key = key;
+	cache[idx].data = data;
+	cache[idx].hits = 0;
+#endif
+}
+
+int *INTEGER(SEXP x) {
+    TRACE(TARGp, x);
+
+    // lookup in cache
+    int idx = array_cache_lookup(int_cache, x);
+    if(idx >= 0) {
+    	return (int *)int_cache[idx].data;
+    }
+
+    int *result = FASTR_INTEGER(x);
+
+    array_cache_insert(int_cache, x, result);
+    return result;
+}
+
+double *REAL(SEXP x){
+    TRACE(TARGp, x);
+
+    // lookup in cache
+    int idx = array_cache_lookup(real_cache, x);
+    if(idx >= 0) {
+    	return (double *)real_cache[idx].data;
+    }
+
+    double *result = FASTR_REAL(x);
+
+    array_cache_insert(real_cache, x, result);
+    return result;
+}

com.oracle.truffle.r.native/version.source

-42
+43