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 index dd2a82945d..64272bf487 100644 --- 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 index 055c2f7587..83b290f0ab 100644 --- 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 index 79c4b2852c..3214f161b0 100644 --- 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 index 8b1a798434..df89c0ae0c 100644 --- 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 #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 index f965a0d137..6107cf5aa9 100644 --- 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 -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,20 +139,23 @@ 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); } @@ -160,6 +163,7 @@ 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 index 83857a80d5..1dfa592626 100644 --- 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 index 697b02905f..c8e4c2658a 100644 --- 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));