From d333182f09a1250ebaca281964b5c0011d2a06c2 Mon Sep 17 00:00:00 2001
From: Florian Angerer <florian.angerer@oracle.com>
Date: Fri, 20 Oct 2017 11:43:47 +0200
Subject: [PATCH] Implemented simple cache to avoid upcalls in functions
'INTEGER' and 'REAL'.
---
.../Rinternals_truffle_common.h | 18 ++---
.../fficall/src/truffle_llvm/Rinternals.c | 7 ++
.../fficall/src/truffle_nfi/Rinternals.c | 78 ++++++++++++++++++-
com.oracle.truffle.r.native/version.source | 2 +-
4 files changed, 91 insertions(+), 14 deletions(-)
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 9d45df5e3d..c69fd861ca 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
@@ -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;
}
diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_llvm/Rinternals.c b/com.oracle.truffle.r.native/fficall/src/truffle_llvm/Rinternals.c
index 34c7f65e5b..d47eaaf32b 100644
--- a/com.oracle.truffle.r.native/fficall/src/truffle_llvm/Rinternals.c
+++ b/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);
+}
diff --git a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rinternals.c b/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rinternals.c
index 380eaf244e..e2f6f44c8f 100644
--- a/com.oracle.truffle.r.native/fficall/src/truffle_nfi/Rinternals.c
+++ b/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;
+}
diff --git a/com.oracle.truffle.r.native/version.source b/com.oracle.truffle.r.native/version.source
index d81cc0710e..920a139664 100644
--- a/com.oracle.truffle.r.native/version.source
+++ b/com.oracle.truffle.r.native/version.source
@@ -1 +1 @@
-42
+43
--
GitLab