Use _RO accessors for const targets

src/assign.c

@@ -403,7 +403,7 @@ SEXP assign(SEXP dt, SEXP rows, SEXP cols, SEXP newcolnames, SEXP values)
       error(_("i is type '%s'. Must be integer, or numeric is coerced with warning. If i is a logical subset, simply wrap with which(), and take the which() outside the loop if possible for efficiency."), type2char(TYPEOF(rows)));
     targetlen = length(rows);
     numToDo = 0;
-    const int *rowsd = INTEGER(rows);
+    const int *rowsd = INTEGER_RO(rows);
     for (int i=0; i<targetlen; ++i) {
       if ((rowsd[i]<0 && rowsd[i]!=NA_INTEGER) || rowsd[i]>nrow)
         error(_("i[%d] is %d which is out of range [1,nrow=%d]"), i+1, rowsd[i], nrow);  // set() reaches here (test 2005.2); := reaches the same error in subset.c first
@@ -660,7 +660,7 @@ SEXP assign(SEXP dt, SEXP rows, SEXP cols, SEXP newcolnames, SEXP values)
   if (ndelete) {
     // delete any columns assigned NULL (there was a 'continue' earlier in loop above)
     int *tt = (int *)R_alloc(ndelete, sizeof(*tt));
-    const int *colsd=INTEGER(cols), ncols=length(cols), ndt=length(dt);
+    const int *colsd=INTEGER_RO(cols), ncols=length(cols), ndt=length(dt);
     for (int i=0, k=0; i<ncols; ++i) {   // find which ones to delete and put them in tt
       // Aside: a new column being assigned NULL (something odd to do) would have been warned above, added above, and now deleted. Just
       //        easier to code it this way; e.g. so that other columns may be added or removed ok by the same query.
@@ -743,7 +743,7 @@ const char *memrecycle(const SEXP target, const SEXP where, const int start, con
         // allow assigning level numbers to factor columns; test 425, 426, 429 and 1945
         const int nlevel = length(getAttrib(target, R_LevelsSymbol));
         if (isInteger(source)) {
-          const int *sd = INTEGER(source);
+          const int *sd = INTEGER_RO(source);
           for (int i=0; i<slen; ++i) {
             const int val = sd[i+soff];
             if ((val<1 && val!=NA_INTEGER) || val>nlevel) {
@@ -754,7 +754,7 @@ const char *memrecycle(const SEXP target, const SEXP where, const int start, con
             }
           }
         } else {
-          const double *sd = REAL(source);
+          const double *sd = REAL_RO(source);
           for (int i=0; i<slen; ++i) {
             const double val = sd[i+soff];
             // Since nlevel is an int, val < 1 || val > nlevel will deflect UB guarded against in PR #5832
@@ -800,7 +800,7 @@ const char *memrecycle(const SEXP target, const SEXP where, const int start, con
         const int nSource = length(source);
         int *newSourceD = INTEGER(newSource);
         if (sourceIsFactor) {
-          const int *sourceD = INTEGER(source);
+          const int *sourceD = INTEGER_RO(source);
           for (int i=0; i<nSource; ++i) {  // convert source integers to refer to target levels
             const int val = sourceD[i];
             newSourceD[i] = val==NA_INTEGER ? NA_INTEGER : -hash_lookup(marks, sourceLevelsD[val-1], 0); // retains NA factor levels here via TL(NA_STRING); e.g. ordered factor

src/between.c

@@ -74,9 +74,9 @@ SEXP between(SEXP x, SEXP lower, SEXP upper, SEXP incbounds, SEXP NAboundsArg, S
 
   switch (TYPEOF(x)) {
   case INTSXP: {
-    const int *lp = INTEGER(lower);
-    const int *up = INTEGER(upper);
-    const int *xp = INTEGER(x);
+    const int *lp = INTEGER_RO(lower);
+    const int *up = INTEGER_RO(upper);
+    const int *xp = INTEGER_RO(x);
     if (check) for (int i=0; i<longestBound; ++i) {
       const int l=lp[i & lowMask], u=up[i & uppMask];
       if (l!=NA_INTEGER && u!=NA_INTEGER && l>u)
@@ -128,9 +128,9 @@ SEXP between(SEXP x, SEXP lower, SEXP upper, SEXP incbounds, SEXP NAboundsArg, S
       }
       if (verbose) Rprintf(_("between parallel processing of integer64 took %8.3fs\n"), omp_get_wtime()-tic);
     } else {
-      const double *lp = REAL(lower);
-      const double *up = REAL(upper);
-      const double *xp = REAL(x);
+      const double *lp = REAL_RO(lower);
+      const double *up = REAL_RO(upper);
+      const double *xp = REAL_RO(x);
       if (check) for (int i=0; i<longestBound; ++i) {
         const double l=lp[i & lowMask], u=up[i & uppMask];
         if (!isnan(l) && !isnan(u) && l>u)

src/bmerge.c

@@ -356,8 +356,8 @@ void bmerge_r(int xlowIn, int xuppIn, int ilowIn, int iuppIn, int col, int thisg
 
   switch (TYPEOF(xc)) {
   case LGLSXP : case INTSXP : {  // including factors
-    const int *icv = isDataCol ? INTEGER(ic) : NULL;
-    const int *xcv = INTEGER(xc);
+    const int *icv = isDataCol ? INTEGER_RO(ic) : NULL;
+    const int *xcv = INTEGER_RO(xc);
     const int ival = isDataCol ? icv[ir] : thisgrp;
     #define ISNAT(x) ((x)==NA_INTEGER)
     #define WRAP(x) (x)  // wrap not needed for int
@@ -388,8 +388,8 @@ void bmerge_r(int xlowIn, int xuppIn, int ilowIn, int iuppIn, int col, int thisg
       #define WRAP(x) (x)
       DO(const int64_t xval=xcv[XIND(mid)], xval<ival, xval>ival, int64_t, ival-xcv[XIND(xlow)], xcv[XIND(xupp)]-ival, ival)
     } else {
-      const double *icv = REAL(ic);
-      const double *xcv = REAL(xc);
+      const double *icv = REAL_RO(ic);
+      const double *xcv = REAL_RO(xc);
       const double ival = icv[ir];
       const uint64_t ivalt = dtwiddle(ival); // TO: remove dtwiddle by dealing with NA, NaN, -Inf, +Inf up front
       #undef ISNAT

src/dogroups.c

@@ -132,7 +132,7 @@ SEXP dogroups(SEXP dt, SEXP dtcols, SEXP groups, SEXP grpcols, SEXP jiscols, SEX
   iSD = PROTECT(R_getVar(install(".iSD"), env, false)); nprotect++; // 1-row and possibly no cols (if no i variables are used via JIS)
   xSD = PROTECT(R_getVar(install(".xSD"), env, false)); nprotect++;
   R_len_t maxGrpSize = 0;
-  const int *ilens = INTEGER(lens), n=LENGTH(lens);
+  const int *ilens = INTEGER_RO(lens), n=LENGTH(lens);
   for (R_len_t i=0; i<n; ++i) {
     if (ilens[i] > maxGrpSize) maxGrpSize = ilens[i];
   }
@@ -184,8 +184,8 @@ SEXP dogroups(SEXP dt, SEXP dtcols, SEXP groups, SEXP grpcols, SEXP jiscols, SEX
   Rboolean jexpIsSymbolOtherThanSD = (isSymbol(jexp) && strcmp(CHAR(PRINTNAME(jexp)),".SD")!=0);  // test 559
 
   ansloc = 0;
-  const int *istarts = INTEGER(starts);
-  const int *iorder = INTEGER(order);
+  const int *istarts = INTEGER_RO(starts);
+  const int *iorder = INTEGER_RO(order);
 
   // We just want to set anyNA for later. We do it only once for the whole operation
   // because it is a rare edge case for it to be true. See #4892.

src/fcast.c

@@ -37,7 +37,7 @@ SEXP fcast(SEXP lhs, SEXP val, SEXP nrowArg, SEXP ncolArg, SEXP idxArg, SEXP fil
     switch (thistype) {
     case INTSXP:
     case LGLSXP: {
-      const int *ithiscol = INTEGER(thiscol);
+      const int *ithiscol = INTEGER_RO(thiscol);
       const int *ithisfill = NULL;
       if (some_fill) ithisfill = INTEGER(thisfill);
       for (int j=0; j<ncols; ++j) {
@@ -51,7 +51,7 @@ SEXP fcast(SEXP lhs, SEXP val, SEXP nrowArg, SEXP ncolArg, SEXP idxArg, SEXP fil
       }
     } break;
     case REALSXP: {
-      const double *dthiscol = REAL(thiscol);
+      const double *dthiscol = REAL_RO(thiscol);
       const double *dthisfill = NULL;
       if (some_fill) dthisfill = REAL(thisfill);
       for (int j=0; j<ncols; ++j) {
@@ -65,7 +65,7 @@ SEXP fcast(SEXP lhs, SEXP val, SEXP nrowArg, SEXP ncolArg, SEXP idxArg, SEXP fil
       }
     } break;
     case CPLXSXP: {
-      const Rcomplex *zthiscol = COMPLEX(thiscol);
+      const Rcomplex *zthiscol = COMPLEX_RO(thiscol);
       const Rcomplex *zthisfill = NULL;
       if (some_fill) zthisfill = COMPLEX(thisfill);
       for (int j=0; j<ncols; ++j) {

src/fmelt.c

@@ -19,7 +19,7 @@ SEXP set_diff(SEXP x, int n) {
   if (n <= 0) error(_("'n' must be a positive integer"));
   SEXP table = PROTECT(seq_int(n, 1));       // TODO: using match to 1:n seems odd here, why use match at all
   SEXP xmatch = PROTECT(match(x, table, 0)); // Old comment:took a while to realise: matches vec against x - thanks to comment from Matt in assign.c!
-  const int *ixmatch = INTEGER(xmatch);
+  const int *ixmatch = INTEGER_RO(xmatch);
   int *buf = (int *) R_alloc(n, sizeof(*buf));
   int j=0;
   for (int i=0; i<n; ++i) {
@@ -39,7 +39,7 @@ SEXP which(SEXP x, Rboolean val) {
   int j=0, n = length(x);
   SEXP ans;
   if (!isLogical(x)) error(_("Argument to 'which' must be logical"));
-  const int *ix = LOGICAL(x);
+  const int *ix = LOGICAL_RO(x);
   int *buf = (int *) R_alloc(n, sizeof(*buf));
   for (int i=0; i<n; ++i) {
     if (ix[i] == val) {
@@ -70,7 +70,7 @@ static const char *concat(SEXP vec, SEXP idx) {
   int nidx=length(idx), nvec=length(vec);
   ans[0]='\0';
   if (nidx==0) return ans;
-  const int *iidx = INTEGER(idx);
+  const int *iidx = INTEGER_RO(idx);
   for (int i=0; i<nidx; ++i) {
     if (iidx[i]<1 || iidx[i]>nvec)
       internal_error(__func__, "'idx' must take values between 1 and length(vec); 1 <= idx <= %d", nvec); // # nocov
@@ -150,7 +150,7 @@ static SEXP unlist_(SEXP xint) {
   int *ians = INTEGER(ans), k=0;
   for (int i=0; i<n; ++i) {
     SEXP tmp = VECTOR_ELT(xint, i);
-    const int *itmp = INTEGER(tmp), n2=length(tmp);
+    const int *itmp = INTEGER_RO(tmp), n2=length(tmp);
     for (int j=0; j<n2; ++j)
       ians[k++] = itmp[j];
   }
@@ -522,7 +522,7 @@ SEXP getvaluecols(SEXP DT, SEXP dtnames, Rboolean valfactor, Rboolean verbose, s
         int thislen = 0;
         if (data->narm) {
           SEXP thisidx = VECTOR_ELT(data->not_NA_indices, j);
-          ithisidx = INTEGER(thisidx);
+          ithisidx = INTEGER_RO(thisidx);
           thislen = length(thisidx);
         }
         size_t size = RTYPE_SIZEOF(thiscol);
@@ -600,7 +600,7 @@ SEXP getvarcols(SEXP DT, SEXP dtnames, Rboolean varfactor, Rboolean verbose, str
     if (!varfactor) {
       SET_VECTOR_ELT(ansvars, 0, target=allocVector(STRSXP, data->totlen));
       if (!data->measure_is_list) {//one value column to output.
-        const int *thisvaluecols = INTEGER(VECTOR_ELT(data->valuecols, 0));
+        const int *thisvaluecols = INTEGER_RO(VECTOR_ELT(data->valuecols, 0));
         for (int j=0, ansloc=0; j<data->lmax; ++j) {
           const int thislen = data->narm ? length(VECTOR_ELT(data->not_NA_indices, j)) : data->nrow;
           SEXP str = STRING_ELT(dtnames, thisvaluecols[j]-1);
@@ -622,7 +622,7 @@ SEXP getvarcols(SEXP DT, SEXP dtnames, Rboolean varfactor, Rboolean verbose, str
         SEXP thisvaluecols = VECTOR_ELT(data->valuecols, 0);
         int len = length(thisvaluecols);
         levels = PROTECT(allocVector(STRSXP, len)); protecti++;
-        const int *vd = INTEGER(thisvaluecols);
+        const int *vd = INTEGER_RO(thisvaluecols);
         for (int j=0; j<len; ++j) SET_STRING_ELT(levels, j, STRING_ELT(dtnames, vd[j]-1));
         SEXP m = PROTECT(chmatch(levels, levels, 0)); protecti++;  // do we have any dups?
         int numRemove = 0;  // remove dups and any for which narm and all-NA
@@ -706,7 +706,7 @@ SEXP getidcols(SEXP DT, SEXP dtnames, Rboolean verbose, struct processData *data
       if (data->narm) {
         for (int j=0; j<data->lmax; ++j) {
           SEXP thisidx = VECTOR_ELT(data->not_NA_indices, j);
-          const int *ithisidx = INTEGER(thisidx);
+          const int *ithisidx = INTEGER_RO(thisidx);
           const int thislen = length(thisidx);
           for (int k=0; k<thislen; ++k)
             dtarget[counter + k] = dthiscol[ithisidx[k]-1];
@@ -725,7 +725,7 @@ SEXP getidcols(SEXP DT, SEXP dtnames, Rboolean verbose, struct processData *data
       if (data->narm) {
         for (int j=0; j<data->lmax; ++j) {
           SEXP thisidx = VECTOR_ELT(data->not_NA_indices, j);
-          const int *ithisidx = INTEGER(thisidx);
+          const int *ithisidx = INTEGER_RO(thisidx);
           const int thislen = length(thisidx);
           for (int k=0; k<thislen; ++k)
             itarget[counter + k] = ithiscol[ithisidx[k]-1];
@@ -740,7 +740,7 @@ SEXP getidcols(SEXP DT, SEXP dtnames, Rboolean verbose, struct processData *data
       if (data->narm) {
         for (int j=0; j<data->lmax; ++j) {
           SEXP thisidx = VECTOR_ELT(data->not_NA_indices, j);
-          const int *ithisidx = INTEGER(thisidx);
+          const int *ithisidx = INTEGER_RO(thisidx);
           const int thislen = length(thisidx);
           for (int k=0; k<thislen; ++k)
             SET_STRING_ELT(target, counter + k, STRING_ELT(thiscol, ithisidx[k]-1));
@@ -760,7 +760,7 @@ SEXP getidcols(SEXP DT, SEXP dtnames, Rboolean verbose, struct processData *data
       if (data->narm) {
         for (int j=0; j<data->lmax; ++j) {
           SEXP thisidx = VECTOR_ELT(data->not_NA_indices, j);
-          const int *ithisidx = INTEGER(thisidx);
+          const int *ithisidx = INTEGER_RO(thisidx);
           const int thislen = length(thisidx);
           for (int k=0; k<thislen; ++k)
             SET_VECTOR_ELT(target, counter + k, VECTOR_ELT(thiscol, ithisidx[k]-1));

src/forder.c

@@ -587,7 +587,7 @@ SEXP forder(SEXP DT, SEXP by, SEXP retGrpArg, SEXP retStatsArg, SEXP sortGroupsA
       break;
     case CPLXSXP : {
       // treat as if two separate columns of double
-      const Rcomplex *xd = COMPLEX(x);
+      const Rcomplex *xd = COMPLEX_RO(x);
       double *tmp = REAL(CplxPart);
       if (!complexRerun) {
         for (int i=0; i<nrow; ++i) tmp[i] = xd[i].r;  // extract the real part on the first time
@@ -723,7 +723,7 @@ SEXP forder(SEXP DT, SEXP by, SEXP retGrpArg, SEXP retStatsArg, SEXP sortGroupsA
 
     switch(TYPEOF(x)) {
     case INTSXP : case LGLSXP : {
-      int32_t *xd = INTEGER(x);
+      const int32_t *xd = INTEGER_RO(x);
       #pragma omp parallel for num_threads(getDTthreads(nrow, true))
       for (int i=0; i<nrow; i++) {
         uint64_t elem=0;
@@ -738,7 +738,7 @@ SEXP forder(SEXP DT, SEXP by, SEXP retGrpArg, SEXP retStatsArg, SEXP sortGroupsA
       break;
     case REALSXP :
       if (inherits(x, "integer64")) {
-        int64_t *xd = (int64_t *)REAL(x);
+        const int64_t *xd = (const int64_t *)REAL_RO(x);
         #pragma omp parallel for num_threads(getDTthreads(nrow, true))
         for (int i=0; i<nrow; i++) {
           uint64_t elem=0;
@@ -751,7 +751,7 @@ SEXP forder(SEXP DT, SEXP by, SEXP retGrpArg, SEXP retStatsArg, SEXP sortGroupsA
           WRITE_KEY
         }
       } else {
-        double *xd = REAL(x);     // TODO: revisit double compression (skip bytes/mult by 10,100 etc) as currently it's often 6-8 bytes even for 3.14,3.15
+        const double *xd = REAL_RO(x);     // TODO: revisit double compression (skip bytes/mult by 10,100 etc) as currently it's often 6-8 bytes even for 3.14,3.15
         #pragma omp parallel for num_threads(getDTthreads(nrow, true))
         for (int i=0; i<nrow; i++) {
           uint64_t elem=0;
@@ -1416,15 +1416,15 @@ SEXP issorted(SEXP x, SEXP by)
     int i=1;
     switch(TYPEOF(x)) {
     case INTSXP : case LGLSXP : {
-      int *xd = INTEGER(x);
+      const int *xd = INTEGER_RO(x);
       while (i<n && xd[i]>=xd[i-1]) i++;
     } break;
     case REALSXP :
       if (inherits(x,"integer64")) {
-        int64_t *xd = (int64_t *)REAL(x);
+        const int64_t *xd = (int64_t *)REAL_RO(x);
         while (i<n && xd[i]>=xd[i-1]) i++;
       } else {
-        double *xd = REAL(x);
+        const double *xd = REAL_RO(x);
         while (i<n && dtwiddle(xd[i])>=dtwiddle(xd[i-1])) i++;  // TODO: change to loop over any NA or -Inf at the beginning and then proceed without dtwiddle() (but rounding)
       }
       break;
@@ -1527,7 +1527,7 @@ SEXP isOrderedSubset(SEXP x, SEXP nrowArg)
   if (!isInteger(nrowArg) || LENGTH(nrowArg)!=1) error(_("nrow must be integer vector length 1"));
   const int nrow = INTEGER(nrowArg)[0];
   if (nrow<0) error(_("nrow==%d but must be >=0"), nrow);
-  const int *xd = INTEGER(x), xlen=LENGTH(x);
+  const int *xd = INTEGER_RO(x), xlen=LENGTH(x);
   for (int i=0, last=INT_MIN; i<xlen; ++i) {
     int elem = xd[i];
     if (elem==0) continue;
@@ -1565,7 +1565,7 @@ SEXP binary(SEXP x)
 static bool all1(SEXP x) {
   if (!isInteger(x))
     internal_error_with_cleanup(__func__, "all1 got non-integer"); // # nocov
-  int *xp = INTEGER(x);
+  const int *xp = INTEGER_RO(x);
   for (int i=0; i<LENGTH(x); ++i) if (xp[i] != 1) return false;
   return true;
 }
@@ -1583,7 +1583,7 @@ bool colsKeyHead(SEXP x, SEXP cols) {
   }
   SEXP keynames = PROTECT(chmatch(key, getAttrib(x, R_NamesSymbol), 0));
   UNPROTECT(1); // key
-  int *keynamesp = INTEGER(keynames), *colsp = INTEGER(cols);
+  const int *keynamesp = INTEGER_RO(keynames), *colsp = INTEGER_RO(cols);
   for (int i=0; i<LENGTH(cols); ++i) {
     if (colsp[i]!=keynamesp[i]) {
       UNPROTECT(1);

src/frank.c

@@ -28,12 +28,12 @@ SEXP dt_na(SEXP x, SEXP cols)
       error(_("Column %d of input list x is length %d, inconsistent with first column of that item which is length %d."), i+1,length(v),n);
     switch (TYPEOF(v)) {
     case LGLSXP: {
-      const int *iv = LOGICAL(v);
+      const int *iv = LOGICAL_RO(v);
       for (int j=0; j<n; ++j) ians[j] |= (iv[j] == NA_LOGICAL);
     }
       break;
     case INTSXP: {
-      const int *iv = INTEGER(v);
+      const int *iv = INTEGER_RO(v);
       for (int j=0; j<n; ++j) ians[j] |= (iv[j] == NA_INTEGER);
     }
       break;
@@ -47,7 +47,7 @@ SEXP dt_na(SEXP x, SEXP cols)
         const int64_t *dv = (int64_t *)REAL(v);
         for (int j=0; j<n; ++j) ians[j] |= (dv[j] == NA_INTEGER64);
       } else {
-        const double *dv = REAL(v);
+        const double *dv = REAL_RO(v);
         for (int j=0; j<n; ++j) ians[j] |= ISNAN(dv[j]);
       }
     }
@@ -110,7 +110,7 @@ SEXP dt_na(SEXP x, SEXP cols)
 }
 
 SEXP frank(SEXP xorderArg, SEXP xstartArg, SEXP xlenArg, SEXP ties_method) {
-  const int *xstart = INTEGER(xstartArg), *xlen = INTEGER(xlenArg), *xorder = INTEGER(xorderArg);
+  const int *xstart = INTEGER_RO(xstartArg), *xlen = INTEGER_RO(xlenArg), *xorder = INTEGER_RO(xorderArg);
   enum {MEAN, MAX, MIN, DENSE, SEQUENCE, LAST} ties=0; // RUNLENGTH
 
   const char *pties = CHAR(STRING_ELT(ties_method, 0));
@@ -205,11 +205,11 @@ SEXP anyNA(SEXP x, SEXP cols) {
     j=0;
     switch (TYPEOF(v)) {
     case LGLSXP: {
-      const int *iv = LOGICAL(v);
+      const int *iv = LOGICAL_RO(v);
       while(j<n && iv[j]!=NA_LOGICAL) j++;
     } break;
     case INTSXP: {
-      const int *iv = INTEGER(v);
+      const int *iv = INTEGER_RO(v);
       while(j<n && iv[j]!=NA_INTEGER) j++;
     } break;
     case STRSXP: {
@@ -221,7 +221,7 @@ SEXP anyNA(SEXP x, SEXP cols) {
         const int64_t *dv = (int64_t *)REAL(v);
         while (j<n && dv[j]!=NA_INTEGER64) j++;
       } else {
-        const double *dv = REAL(v);
+        const double *dv = REAL_RO(v);
         while (j<n && !ISNAN(dv[j])) j++;
       }
       break;
@@ -230,7 +230,7 @@ SEXP anyNA(SEXP x, SEXP cols) {
       j = n;
       break;
     case CPLXSXP: {
-      const Rcomplex *cv = COMPLEX(v);
+      const Rcomplex *cv = COMPLEX_RO(v);
       // taken from https://github.com/wch/r-source/blob/d75f39d532819ccc8251f93b8ab10d5b83aac89a/src/main/coerce.c
       while (j<n && !ISNAN(cv[j].r) && !ISNAN(cv[j].i)) j++;
     } break;

src/freadR.c

@@ -480,7 +480,7 @@ size_t allocateDT(int8_t *typeArg, int8_t *sizeArg, int ncolArg, int ndrop, size
     if (selectRank) {
       SEXP tt = PROTECT(allocVector(INTSXP, ncol - ndrop));
       int *ttD = INTEGER(tt), rank = 1;
-      const int *rankD = INTEGER(selectRank);
+      const int *rankD = INTEGER_RO(selectRank);
       for (int i = 0; i < ncol; i++) if (type[i] != CT_DROP) ttD[rankD[i] - 1] = rank++;
       SET_VECTOR_ELT(RCHK, 3, selectRank = tt);
       // selectRank now holds the order not the rank (so its name is now misleading). setFinalNRow passes it to setcolorder