Refactor grid 4.0.3 to use Global Native API.

ConnectionMaster · Sep 20, 2022 · 67339d2 · 67339d2
1 parent 2e8e655
commit 67339d2
Show file tree

Hide file tree

Showing 7 changed files with 58 additions and 19 deletions.
diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/gpar.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/gpar.c
@@ -357,6 +357,7 @@ void initGPar(pGEDevDesc dd)
     SEXP gpar, gparnames, class;
     SEXP gpfill, gpcol, gpgamma, gplty, gplwd, gpcex, gpfs, gplh, gpfont;
     SEXP gpfontfamily, gpalpha, gplineend, gplinejoin, gplinemitre, gplex;
+    int gridRegisterIndex = *((int *) FASTR_GlobalVarGetPtr(fastr_glob_gridRegisterIndex));
     SEXP gsd = (SEXP) dd->gesd[gridRegisterIndex]->systemSpecific;
     PROTECT(gpar = allocVector(VECSXP, 15));
     PROTECT(gparnames = allocVector(STRSXP, 15));

diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/grid.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/grid.c
@@ -63,14 +63,18 @@ static Rboolean deviceChanged(double devWidthCM, double devHeightCM,
  */
 SEXP L_initGrid(SEXP GridEvalEnv) 
 {
-    R_gridEvalEnv = GridEvalEnv;
-    GEregisterSystem(gridCallback, &gridRegisterIndex);
+    int *gridRegisterIndex = (int *) FASTR_GlobalVarGetPtr(fastr_glob_gridRegisterIndex);
+    SEXP R_gridEvalEnv = GridEvalEnv;
+    FASTR_GlobalVarSetSEXP(fastr_glob_R_gridEvalEnv, R_gridEvalEnv);
+    GEregisterSystem(gridCallback, gridRegisterIndex);
     return R_NilValue;
 }
 
 SEXP L_killGrid() 
 {
-    GEunregisterSystem(gridRegisterIndex);
+    int *gridRegisterIndex = (int *) FASTR_GlobalVarGetPtr(fastr_glob_gridRegisterIndex);
+    GEunregisterSystem(*gridRegisterIndex);
+    *gridRegisterIndex = -1;
     return R_NilValue;
 }
 
@@ -89,6 +93,7 @@ void dirtyGridDevice(pGEDevDesc dd) {
 	SEXP gsd, griddev;
 	/* Record the fact that this device has now received grid output
 	 */
+	int gridRegisterIndex = *((int *) FASTR_GlobalVarGetPtr(fastr_glob_gridRegisterIndex));
 	gsd = (SEXP) dd->gesd[gridRegisterIndex]->systemSpecific;
 	PROTECT(griddev = allocVector(LGLSXP, 1));
 	LOGICAL(griddev)[0] = TRUE;
@@ -319,6 +324,7 @@ SEXP L_setviewport(SEXP invp, SEXP hasParent)
 {
     SEXP vp;
     SEXP pushedvp, fcall;
+    SEXP R_gridEvalEnv = FASTR_GlobalVarGetSEXP(fastr_glob_R_gridEvalEnv);
     /* Get the current device 
      */
     pGEDevDesc dd = getDevice();
@@ -357,6 +363,7 @@ SEXP L_setviewport(SEXP invp, SEXP hasParent)
 static Rboolean noChildren(SEXP children) 
 {
     SEXP result, fcall;
+    SEXP R_gridEvalEnv = FASTR_GlobalVarGetSEXP(fastr_glob_R_gridEvalEnv);
     PROTECT(fcall = lang2(install("no.children"),
 			  children));
     PROTECT(result = eval(fcall, R_gridEvalEnv)); 
@@ -367,6 +374,7 @@ static Rboolean noChildren(SEXP children)
 static Rboolean childExists(SEXP name, SEXP children) 
 {
     SEXP result, fcall;
+    SEXP R_gridEvalEnv = FASTR_GlobalVarGetSEXP(fastr_glob_R_gridEvalEnv);
     PROTECT(fcall = lang3(install("child.exists"),
 			  name, children));
     PROTECT(result = eval(fcall, R_gridEvalEnv)); 
@@ -377,6 +385,7 @@ static Rboolean childExists(SEXP name, SEXP children)
 static SEXP childList(SEXP children) 
 {
     SEXP result, fcall;
+    SEXP R_gridEvalEnv = FASTR_GlobalVarGetSEXP(fastr_glob_R_gridEvalEnv);
     PROTECT(fcall = lang2(install("child.list"),
 			  children));
     PROTECT(result = eval(fcall, R_gridEvalEnv)); 
@@ -532,6 +541,7 @@ SEXP L_downviewport(SEXP name, SEXP strict)
 static Rboolean pathMatch(SEXP path, SEXP pathsofar, SEXP strict) 
 {
     SEXP result, fcall;
+    SEXP R_gridEvalEnv = FASTR_GlobalVarGetSEXP(fastr_glob_R_gridEvalEnv);
     PROTECT(fcall = lang4(install("pathMatch"),
 			  path, pathsofar, strict));
     PROTECT(result = eval(fcall, R_gridEvalEnv)); 
@@ -542,6 +552,7 @@ static Rboolean pathMatch(SEXP path, SEXP pathsofar, SEXP strict)
 static SEXP growPath(SEXP pathsofar, SEXP name) 
 {
     SEXP result, fcall;
+    SEXP R_gridEvalEnv = FASTR_GlobalVarGetSEXP(fastr_glob_R_gridEvalEnv);
     if (isNull(pathsofar))
 	result = name;
     else {
@@ -729,7 +740,8 @@ SEXP L_unsetviewport(SEXP n)
 	SET_TAG(t, install("envir")); 
 	t = CDR(t);
 	SET_TAG(t, install("inherits")); 
-	eval(fcall, R_gridEvalEnv); 
+	SEXP R_gridEvalEnv = FASTR_GlobalVarGetSEXP(fastr_glob_R_gridEvalEnv);
+	eval(fcall, R_gridEvalEnv);
 	UNPROTECT(2); /* false, fcall */
     }
     /* Get the current device size 
@@ -1647,6 +1659,7 @@ static void hullEdge(double *x, double *y, int n,
     SEXP xin, yin, chullFn, R_fcall, hull;    
     int adjust = 0;
     double *xkeep, *ykeep;
+    SEXP R_gridEvalEnv = FASTR_GlobalVarGetSEXP(fastr_glob_R_gridEvalEnv);
     vmax = vmaxget();
     /* Remove any NA's because chull() can't cope with them */
     xkeep = (double *) R_alloc(n, sizeof(double));

diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/grid.h b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/grid.h
@@ -34,6 +34,9 @@
 #define _(String) (String)
 #endif
 
+extern FASTR_GlobalVar_t fastr_glob_gridRegisterIndex;
+extern FASTR_GlobalVar_t fastr_glob_R_gridEvalEnv;
+
 /* All grid type names are prefixed with an "L" 
  * All grid global variable names are prefixed with an "L_" 
  */
@@ -259,13 +262,6 @@ typedef struct {
     double yscalemax;
 } LViewportContext;
 
-/* Evaluation environment */
-#ifndef GRID_MAIN
-extern SEXP R_gridEvalEnv;
-#else
-SEXP R_gridEvalEnv;
-#endif
-
 
 /* Functions called by R code
  * (from all over the place)
@@ -618,9 +614,6 @@ void setGridStateElement(pGEDevDesc dd, int elementIndex, SEXP value);
 
 SEXP gridCallback(GEevent task, pGEDevDesc dd, SEXP data);
 
-extern int gridRegisterIndex;
-
-
 /* From grid.c */
 SEXP doSetViewport(SEXP vp, 
 		   Rboolean topLevelVP,

diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/register.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/register.c
@@ -24,6 +24,9 @@
 #include <R_ext/Rdynload.h>
 #include "grid.h"
 
+FASTR_GlobalVar_t fastr_glob_gridRegisterIndex = NULL;
+FASTR_GlobalVar_t fastr_glob_R_gridEvalEnv = NULL;
+
 #define LCALLDEF(name, n)  {#name, (DL_FUNC) &L_##name, n}
 
 static const R_CallMethodDef callMethods[] = {
@@ -99,9 +102,25 @@ static const R_CallMethodDef callMethods[] = {
     { NULL, NULL, 0 }
 };
 
+static void fastr_free_gridRegisterIndex(void *grid_register_idx)
+{
+    free(grid_register_idx);
+}
+
+
 
 void attribute_visible R_init_grid(DllInfo *dll) 
 {
+    if (fastr_glob_gridRegisterIndex == NULL) {
+	fastr_glob_gridRegisterIndex = FASTR_GlobalVarAlloc();
+	fastr_glob_R_gridEvalEnv = FASTR_GlobalVarAlloc();
+    }
+    FASTR_GlobalVarInitWithDtor(fastr_glob_gridRegisterIndex, fastr_free_gridRegisterIndex);
+    int *gridRegisterIndex = malloc(sizeof(int));
+    *gridRegisterIndex = -1;
+    FASTR_GlobalVarSetPtr(fastr_glob_gridRegisterIndex, gridRegisterIndex);
+    FASTR_GlobalVarInit(fastr_glob_R_gridEvalEnv);
+
     /* No .C, .Fortran, or .External routines => NULL
      */
     R_registerRoutines(dll, NULL, callMethods, NULL, NULL);

diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/state.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/state.c
@@ -21,9 +21,7 @@
 #include "grid.h"
 #include <string.h>
 
-int gridRegisterIndex;
-
-/* The gridSystemState (per device) consists of 
+/* The gridSystemState (per device) consists of
  * GSS_DEVSIZE 0 = current size of device
  * GSS_CURRLOC 1 = current location of grid "pen" 
  * GSS_DL 2 = grid display list
@@ -60,6 +58,7 @@ void initDL(pGEDevDesc dd)
 {
     SEXP dl, dlindex;
     SEXP vp = gridStateElement(dd, GSS_VP);
+    int gridRegisterIndex = *((int *) FASTR_GlobalVarGetPtr(fastr_glob_gridRegisterIndex));
     SEXP gsd = (SEXP) dd->gesd[gridRegisterIndex]->systemSpecific;
     /* The top-level viewport goes at the start of the display list
      */
@@ -83,6 +82,7 @@ void initDL(pGEDevDesc dd)
 void initOtherState(pGEDevDesc dd)
 {
     SEXP currloc, prevloc, recording;
+    int gridRegisterIndex = *((int *) FASTR_GlobalVarGetPtr(fastr_glob_gridRegisterIndex));
     SEXP state = (SEXP) dd->gesd[gridRegisterIndex]->systemSpecific;
     currloc = VECTOR_ELT(state, GSS_CURRLOC);
     REAL(currloc)[0] = NA_REAL;
@@ -139,27 +139,31 @@ void fillGridSystemState(SEXP state, pGEDevDesc dd)
 
 SEXP gridStateElement(pGEDevDesc dd, int elementIndex)
 {
+    int gridRegisterIndex = *((int *) FASTR_GlobalVarGetPtr(fastr_glob_gridRegisterIndex));
     return VECTOR_ELT((SEXP) dd->gesd[gridRegisterIndex]->systemSpecific, 
 		      elementIndex);
 }
 
 void setGridStateElement(pGEDevDesc dd, int elementIndex, SEXP value)
 {
-    SET_VECTOR_ELT((SEXP) dd->gesd[gridRegisterIndex]->systemSpecific, 
+    int gridRegisterIndex = *((int *) FASTR_GlobalVarGetPtr(fastr_glob_gridRegisterIndex));
+    SET_VECTOR_ELT((SEXP) dd->gesd[gridRegisterIndex]->systemSpecific,
 		   elementIndex, value);
 }
 
 static void deglobaliseState(SEXP state)
 {
     int index = INTEGER(VECTOR_ELT(state, GSS_GLOBALINDEX))[0];
-    SET_VECTOR_ELT(findVar(install(".GRID.STATE"), R_gridEvalEnv), 
+    SEXP R_gridEvalEnv = FASTR_GlobalVarGetSEXP(fastr_glob_R_gridEvalEnv);
+    SET_VECTOR_ELT(findVar(install(".GRID.STATE"), R_gridEvalEnv),
 		   index, R_NilValue);
 }
 
 static int findStateSlot()
 {
     int i;
     int result = -1;
+    SEXP R_gridEvalEnv = FASTR_GlobalVarGetSEXP(fastr_glob_R_gridEvalEnv);
     SEXP globalstate = findVar(install(".GRID.STATE"), R_gridEvalEnv);
     for (i = 0; i < length(globalstate); i++)
 	if (VECTOR_ELT(globalstate, i) == R_NilValue) {
@@ -175,6 +179,7 @@ static void globaliseState(SEXP state)
 {
     int index = findStateSlot();
     SEXP globalstate, indexsxp;
+    SEXP R_gridEvalEnv = FASTR_GlobalVarGetSEXP(fastr_glob_R_gridEvalEnv);
     PROTECT(globalstate = findVar(install(".GRID.STATE"), R_gridEvalEnv));
     /* Record the index for deglobalisation
      */
@@ -194,6 +199,7 @@ SEXP gridCallback(GEevent task, pGEDevDesc dd, SEXP data) {
     SEXP gsd;
     SEXP devsize;
     R_GE_gcontext gc;
+    int gridRegisterIndex = *((int *) FASTR_GlobalVarGetPtr(fastr_glob_gridRegisterIndex));
     switch (task) {
     case GE_InitState:
 	/* Create the initial grid state for a device
@@ -286,6 +292,7 @@ SEXP gridCallback(GEevent task, pGEDevDesc dd, SEXP data) {
 		 */
 		SEXP fcall;
 		PROTECT(fcall = lang1(install("draw.all")));
+		SEXP R_gridEvalEnv = FASTR_GlobalVarGetSEXP(fastr_glob_R_gridEvalEnv);
 		eval(fcall, R_gridEvalEnv); 
 		UNPROTECT(1);
 	    }

diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/unit.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/unit.c
@@ -48,6 +48,7 @@ int isNewUnit(SEXP unit) {
     return inherits(unit, "unit_v2");
 }
 SEXP upgradeUnit(SEXP unit) {
+    SEXP R_gridEvalEnv = FASTR_GlobalVarGetSEXP(fastr_glob_R_gridEvalEnv);
     SEXP upgradeFn = PROTECT(findFun(install("upgradeUnit"), R_gridEvalEnv));
     SEXP R_fcall = PROTECT(lang2(upgradeFn, unit));
     SEXP unit2 = PROTECT(eval(R_fcall, R_gridEvalEnv));
@@ -196,6 +197,7 @@ double pureNullUnitValue(SEXP unit, int index)
 
 int pureNullUnit(SEXP unit, int index, pGEDevDesc dd) {
     int i, n, result, u = unitUnit(unit, index);
+    SEXP R_gridEvalEnv = FASTR_GlobalVarGetSEXP(fastr_glob_R_gridEvalEnv);
     if (isArith(u)) {
         SEXP data = unitData(unit, index);
         n = unitLength(data);
@@ -343,6 +345,7 @@ double evaluateGrobUnit(double value, SEXP grob,
     SEXP R_fcall0, R_fcall1, R_fcall2x, R_fcall2y, R_fcall3;
     SEXP savedgpar, savedgrob, updatedgrob;
     SEXP unitx = R_NilValue, unity = R_NilValue;
+    SEXP R_gridEvalEnv = FASTR_GlobalVarGetSEXP(fastr_glob_R_gridEvalEnv);
     double result = 0.0;
     Rboolean protectedGrob = FALSE;
     /*
@@ -1569,6 +1572,7 @@ SEXP validData(SEXP data, SEXP validUnits, int n) {
 	int nUnit = LENGTH(validUnits);
 	int *pValidUnits = INTEGER(validUnits);
 	int dataCopied = 0;
+	SEXP R_gridEvalEnv = FASTR_GlobalVarGetSEXP(fastr_glob_R_gridEvalEnv);
 
 	if (nData != 1 && nData < n) {
 		error(_("data must be either NULL, have length 1, or match the length of the final unit vector"));

diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/viewport.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/viewport.c
@@ -370,6 +370,8 @@ void initVP(pGEDevDesc dd)
     SEXP vpfnname, vpfn, vp;
     SEXP xscale, yscale;
     SEXP currentgp = gridStateElement(dd, GSS_GPAR);
+    int gridRegisterIndex = *((int *) FASTR_GlobalVarGetPtr(fastr_glob_gridRegisterIndex));
+    SEXP R_gridEvalEnv = FASTR_GlobalVarGetSEXP(fastr_glob_R_gridEvalEnv);
     SEXP gsd = (SEXP) dd->gesd[gridRegisterIndex]->systemSpecific;
     PROTECT(vpfnname = findFun(install("grid.top.level.vp"), R_gridEvalEnv));
     PROTECT(vpfn = lang1(vpfnname));