diff --git a/src/assign.c b/src/assign.c index 5901d5a15..05a55cb5a 100644 --- a/src/assign.c +++ b/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; inrow) 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; inlevel) { @@ -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 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; iu) @@ -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; iu) diff --git a/src/bmerge.c b/src/bmerge.c index 737e27f98..c22250175 100644 --- a/src/bmerge.c +++ b/src/bmerge.c @@ -56,8 +56,8 @@ SEXP bmerge(SEXP idt, SEXP xdt, SEXP icolsArg, SEXP xcolsArg, SEXP xoArg, SEXP r if ((LENGTH(icolsArg)==0 || LENGTH(xcolsArg)==0) && LENGTH(idt)>0) // We let through LENGTH(i) == 0 for tests 2126.* internal_error(__func__, "icols and xcols must be non-empty integer vectors"); if (LENGTH(icolsArg) > LENGTH(xcolsArg)) internal_error(__func__, "length(icols) [%d] > length(xcols) [%d]", LENGTH(icolsArg), LENGTH(xcolsArg)); // # nocov - icols = INTEGER(icolsArg); - xcols = INTEGER(xcolsArg); + icols = INTEGER_RO(icolsArg); + xcols = INTEGER_RO(xcolsArg); xN = LENGTH(xdt) ? LENGTH(VECTOR_ELT(xdt,0)) : 0; iN = ilen = anslen = LENGTH(idt) ? LENGTH(VECTOR_ELT(idt,0)) : 0; ncol = LENGTH(icolsArg); // there may be more sorted columns in x than involved in the join @@ -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)], xvalival, 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 diff --git a/src/cj.c b/src/cj.c index 2d59d0511..0125141a8 100644 --- a/src/cj.c +++ b/src/cj.c @@ -25,7 +25,7 @@ SEXP cj(SEXP base_list) switch(TYPEOF(source)) { case LGLSXP: case INTSXP: { - const int *restrict sourceP = INTEGER(source); + const int *restrict sourceP = INTEGER_RO(source); int *restrict targetP = INTEGER(target); #pragma omp parallel for num_threads(getDTthreads(thislen*eachrep, true)) // default static schedule so two threads won't write to same cache line in last column @@ -41,7 +41,7 @@ SEXP cj(SEXP base_list) } } break; case REALSXP: { - const double *restrict sourceP = REAL(source); + const double *restrict sourceP = REAL_RO(source); double *restrict targetP = REAL(target); #pragma omp parallel for num_threads(getDTthreads(thislen*eachrep, true)) for (int i = 0; i < thislen; i++) { @@ -55,7 +55,7 @@ SEXP cj(SEXP base_list) } } break; case CPLXSXP: { - const Rcomplex *restrict sourceP = COMPLEX(source); + const Rcomplex *restrict sourceP = COMPLEX_RO(source); Rcomplex *restrict targetP = COMPLEX(target); #pragma omp parallel for num_threads(getDTthreads(thislen*eachrep, true)) for (int i = 0; i < thislen; i++) { diff --git a/src/dogroups.c b/src/dogroups.c index 7fd1b956e..e60c4c916 100644 --- a/src/dogroups.c +++ b/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 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. diff --git a/src/fcast.c b/src/fcast.c index 0207e5dcb..8b846d840 100644 --- a/src/fcast.c +++ b/src/fcast.c @@ -37,9 +37,9 @@ 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); + if (some_fill) ithisfill = INTEGER_RO(thisfill); for (int j=0; j1 ? INT64_MAX : 0; const int64_t nmask = len3>1 ? INT64_MAX : 0; - const int *restrict pl = LOGICAL(l); + const int *restrict pl = LOGICAL_RO(l); SEXP ans = PROTECT(allocVector(tans, len0)); nprotect++; if (!na_a) copyMostAttrib(a, ans); @@ -237,7 +237,7 @@ SEXP fcaseR(SEXP rho, SEXP args) { if (!isLogical(whens)) { error(_("Argument #%d must be logical but was of type %s."), 2*i+1, type2char(TYPEOF(whens))); } - const int *restrict pwhens = LOGICAL(whens); + const int *restrict pwhens = LOGICAL_RO(whens); l = 0; if (i == 0) { n_ans = xlength(whens); @@ -306,7 +306,7 @@ SEXP fcaseR(SEXP rho, SEXP args) { switch(TYPEOF(ans)) { case LGLSXP: { const int *restrict pthens; - if (!naout) pthens = LOGICAL(thens); // the content is not useful if out is NA_LOGICAL scalar + if (!naout) pthens = LOGICAL_RO(thens); // the content is not useful if out is NA_LOGICAL scalar int *restrict pans = LOGICAL(ans); const int pna = NA_LOGICAL; for (int64_t j=0; jnvec) 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; inarm) { 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; jlmax; ++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; jnarm) { for (int j=0; jlmax; ++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; knarm) { for (int j=0; jlmax; ++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; knarm) { for (int j=0; jlmax; ++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; knarm) { for (int j=0; jlmax; ++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=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=xd[i-1]) i++; } else { - double *xd = REAL(x); + const double *xd = REAL_RO(x); while (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>bitshift) + 1; @@ -224,7 +224,7 @@ void *gather(SEXP x, bool *anyNA) const bool verbose = GetVerbose(); switch (TYPEOF(x)) { case LGLSXP: case INTSXP: { - const int *restrict thisx = INTEGER(x); + const int *restrict thisx = INTEGER_RO(x); #pragma omp parallel for num_threads(getDTthreads(nBatch, false)) for (int b=0; b= 1 && ixi <= nlevels) ? STRING_ELT(levels, ix[i]-1) : NA_STRING); } newx = PROTECT(chmatch(xchar, ulevels, NA_INTEGER)); - int *inewx = INTEGER(newx); + const int *inewx = INTEGER_RO(newx); for (int i=0; i