Skip to content

Commit

Permalink
Add support for long vectors (> 2^32-1)
Browse files Browse the repository at this point in the history 
R added support for long vectors in version 3.0.0. The xts C code had
not been updated to take advantage of this feature. That meant xts
objects were limited to matrices with less than 2^32-1 elements.

Most of the changes are fall into these categories:

    1. Change index counters from 'int' to 'R_xlen_t'
    2. Use xlength() instead of LENGTH() or length() to get length
    3. Use xlengthgets() instead of lengthgets() to set length

There are a few non-functional changes to move type declaration closer
to where the variable is used.

See #239.
  • Loading branch information
@joshuaulrich
joshuaulrich committed Mar 7, 2023
1 parent 31005d8 commit 5e24deb
Show file tree
Hide file tree
Showing 19 changed files with 138 additions and 131 deletions.
2 changes: 1 addition & 1 deletion inst/include/xts.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -111,7 +111,7 @@ void copy_xtsAttributes(SEXP x, SEXP y); // internal only
void copy_xtsCoreAttributes(SEXP x, SEXP y);// internal only

SEXP isXts(SEXP x); // is.xts analogue
int firstNonNA(SEXP x);
R_xlen_t firstNonNA(SEXP x);
SEXP extract_col (SEXP x, SEXP j, SEXP drop, SEXP first_, SEXP last_);
SEXP do_startofyear(SEXP from, SEXP to, SEXP origin);
int xts_ncols(SEXP x);
Expand Down
4 changes: 2 additions & 2 deletions src/any.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -25,8 +25,8 @@

SEXP any_negative (SEXP i_)
{
int i;
int len = length(i_);
R_xlen_t i;
R_xlen_t len = xlength(i_);

int *int_i=NULL;
double *real_i=NULL;
Expand Down
24 changes: 12 additions & 12 deletions src/binsearch.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -76,7 +76,7 @@ SEXP binsearch(SEXP key, SEXP vec, SEXP start)
error("start must be specified as true or false");
}

if (length(vec) < 1 || length(key) < 1) {
if (xlength(vec) < 1 || length(key) < 1) {
return ScalarInteger(NA_INTEGER);
}

Expand Down Expand Up @@ -105,9 +105,9 @@ SEXP binsearch(SEXP key, SEXP vec, SEXP start)
error("unsupported type");
}

int mid;
int lo = 0;
int hi = length(vec) - 1;
R_xlen_t mid;
R_xlen_t lo = 0;
R_xlen_t hi = xlength(vec) - 1;

while (lo < hi) {
mid = lo + (hi - lo) / 2;
Expand All @@ -126,7 +126,7 @@ SEXP binsearch(SEXP key, SEXP vec, SEXP start)
/* cmp_func() := vector[index] >= key when start == true, and we need
* to return the smallest index subject to vector[index] >= key.
*/
if (!cmp_func(data, length(vec)-1)) {
if (!cmp_func(data, xlength(vec)-1)) {
/* entire vector < key */
return ScalarInteger(NA_INTEGER);
}
Expand Down Expand Up @@ -158,19 +158,19 @@ SEXP fill_window_dups_rev(SEXP _x, SEXP _index)
* upper bound of the location of the user index in the xts index.
* This is necessary to handle duplicate dates in the xts index.
*/
int n_x = length(_x);
R_xlen_t n_x = xlength(_x);
int *x = INTEGER(_x);

if (length(_index) < 1) {
if (xlength(_index) < 1) {
return allocVector(INTSXP, 0);
}

PROTECT_INDEX px;
SEXP _out;
PROTECT_WITH_INDEX(_out = allocVector(INTSXP, length(_index)), &px);
PROTECT_WITH_INDEX(_out = allocVector(INTSXP, xlength(_index)), &px);
int *out = INTEGER(_out);

int i, xi, j, k = 0, n_out = length(_out);
R_xlen_t i, xi, j, k = 0, n_out = xlength(_out);
switch (TYPEOF(_index)) {
case REALSXP:
{
Expand All @@ -184,7 +184,7 @@ SEXP fill_window_dups_rev(SEXP _x, SEXP _index)
if (k == n_out) {
REPROTECT(_out = xlengthgets(_out, k+2*(i+1)), px);
out = INTEGER(_out);
n_out = length(_out);
n_out = xlength(_out);
}
out[k++] = j--;
} while (j > 0 && index[xi-1] == index[j-1]);
Expand All @@ -203,7 +203,7 @@ SEXP fill_window_dups_rev(SEXP _x, SEXP _index)
if (k == n_out) {
REPROTECT(_out = xlengthgets(_out, k+2*(i+1)), px);
out = INTEGER(_out);
n_out = length(_out);
n_out = xlength(_out);
}
out[k++] = j--;
} while (j > 0 && index[xi-1] == index[j-1]);
Expand All @@ -214,7 +214,7 @@ SEXP fill_window_dups_rev(SEXP _x, SEXP _index)
error("unsupported index type");
}

/* truncate so length(_out) = k
/* truncate so xlength(_out) = k
* NB: output is in reverse order!
*/
REPROTECT(_out = xlengthgets(_out, k), px);
Expand Down
16 changes: 8 additions & 8 deletions src/coredata.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,21 +33,21 @@ SEXP coredata (SEXP x, SEXP copyAttr)
removing
*/
SEXP result;
int i, j, ncs, nrs;
int P=0;
PROTECT(result = allocVector(TYPEOF(x), length(x))); P++;
R_xlen_t i, j, ncs, nrs;
int P = 0;
PROTECT(result = allocVector(TYPEOF(x), xlength(x))); P++;
switch( TYPEOF(x)) {
case REALSXP:
memcpy(REAL(result), REAL(x), length(result) * sizeof(double));
memcpy(REAL(result), REAL(x), xlength(result) * sizeof(double));
break;
case INTSXP:
memcpy(INTEGER(result), INTEGER(x), length(result) * sizeof(int));
memcpy(INTEGER(result), INTEGER(x), xlength(result) * sizeof(int));
break;
case LGLSXP:
memcpy(LOGICAL(result), LOGICAL(x), length(result) * sizeof(int));
memcpy(LOGICAL(result), LOGICAL(x), xlength(result) * sizeof(int));
break;
case CPLXSXP:
memcpy(COMPLEX(result), COMPLEX(x), length(result) * sizeof(Rcomplex));
memcpy(COMPLEX(result), COMPLEX(x), xlength(result) * sizeof(Rcomplex));
break;
case STRSXP:
ncs = ncols(x); nrs = nrows(x);
Expand All @@ -56,7 +56,7 @@ SEXP coredata (SEXP x, SEXP copyAttr)
SET_STRING_ELT(result, i+j*nrs, STRING_ELT(x, i+j*nrs));
break;
case RAWSXP:
memcpy(RAW(result), RAW(x), length(result) * sizeof(unsigned char));
memcpy(RAW(result), RAW(x), xlength(result) * sizeof(unsigned char));
break;
default:
error("currently unsupported data type");
Expand Down
10 changes: 5 additions & 5 deletions src/diff.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,9 +34,9 @@ SEXP diffXts(SEXP x, SEXP lag, SEXP diff, SEXP arith, SEXP nap, SEXP dots)
SEXP lagXts(SEXP x, SEXP k, SEXP pad)
{
SEXP result;
int nrs, ncs;
int i, j, ij, iijj, K, NApad;
int mode;
R_xlen_t nrs, ncs;
R_xlen_t i, j, ij, iijj, K;
int mode, NApad;
int P=0; /*PROTECT counter*/
int *int_result=NULL, *int_x=NULL;
int *lgl_result=NULL, *lgl_x=NULL;
Expand Down Expand Up @@ -169,8 +169,8 @@ SEXP lagXts(SEXP x, SEXP k, SEXP pad)
setAttrib(result, R_ClassSymbol, getAttrib(x, R_ClassSymbol));
if(!NApad) { /* No NA padding */
SEXP oindex, nindex, dims;
int nRows = (K > 0) ? nrs-K : nrs+K;
int incr = (K > 0) ? K : 0;
R_xlen_t nRows = (K > 0) ? nrs-K : nrs+K;
R_xlen_t incr = (K > 0) ? K : 0;
PROTECT(oindex = getAttrib(x, xts_IndexSymbol));
PROTECT(nindex = allocVector(TYPEOF(oindex), nRows));
switch(TYPEOF(oindex)) {
Expand Down
5 changes: 3 additions & 2 deletions src/endpoints.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -32,9 +32,10 @@ SEXP endpoints (SEXP _x, SEXP _on, SEXP _k, SEXP _addlast /* TRUE */)
c(0,which(diff(_x%/%on%/%k+1) != 0),NROW(_x))
*/
int P = 0;
int *int_index = NULL;
double *real_index = NULL;
int i=1,j=1, nr, P=0;
R_xlen_t i = 1, j = 1, nr;
int int_tmp[2];
int64_t int64_tmp[2];

Expand Down Expand Up @@ -134,7 +135,7 @@ SEXP endpoints (SEXP _x, SEXP _on, SEXP _k, SEXP _addlast /* TRUE */)
ep[j] = nr;
j++;
}
PROTECT(_ep = lengthgets(_ep, j)); P++;
PROTECT(_ep = xlengthgets(_ep, j)); P++;
UNPROTECT(P);
return(_ep);
}
22 changes: 11 additions & 11 deletions src/extract_col.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,7 @@

SEXP extract_col (SEXP x, SEXP j, SEXP drop, SEXP first_, SEXP last_) {
SEXP result, index, new_index;
int nrs, nrsx, i, ii, jj, first, last;
R_xlen_t nrs, nrsx, i, ii, jj, first, last;

nrsx = nrows(x);

Expand All @@ -50,11 +50,11 @@ SEXP extract_col (SEXP x, SEXP j, SEXP drop, SEXP first_, SEXP last_) {
nrs = last - first + 1;


PROTECT(result = allocVector(TYPEOF(x), nrs * length(j)));
PROTECT(result = allocVector(TYPEOF(x), nrs * xlength(j)));

switch(TYPEOF(x)) {
case REALSXP:
for(i=0; i<length(j); i++) {
for(i=0; i<xlength(j); i++) {
/*
Rprintf("j + i*nrs + first=%i\n", (int)(INTEGER(j)[i]-1 + i*nrs + first));
Rprintf("i=%i, j=%i, nrs=%i, first=%i\n", i, INTEGER(j)[i]-1, nrs, first);
Expand All @@ -71,7 +71,7 @@ Rprintf("i=%i, j=%i, nrs=%i, first=%i\n", i, INTEGER(j)[i]-1, nrs, first);
}
break;
case INTSXP:
for(i=0; i<length(j); i++) {
for(i=0; i<xlength(j); i++) {
if(INTEGER(j)[i] == NA_INTEGER) {
for(ii=0; ii < nrs; ii++) {
INTEGER(result)[(i*nrs) + ii] = NA_INTEGER;
Expand All @@ -84,7 +84,7 @@ Rprintf("i=%i, j=%i, nrs=%i, first=%i\n", i, INTEGER(j)[i]-1, nrs, first);
}
break;
case LGLSXP:
for(i=0; i<length(j); i++) {
for(i=0; i<xlength(j); i++) {
if(INTEGER(j)[i] == NA_INTEGER) {
for(ii=0; ii < nrs; ii++) {
LOGICAL(result)[(i*nrs) + ii] = NA_LOGICAL;
Expand All @@ -97,7 +97,7 @@ Rprintf("i=%i, j=%i, nrs=%i, first=%i\n", i, INTEGER(j)[i]-1, nrs, first);
}
break;
case CPLXSXP:
for(i=0; i<length(j); i++) {
for(i=0; i<xlength(j); i++) {
if(INTEGER(j)[i] == NA_INTEGER) {
for(ii=0; ii < nrs; ii++) {
COMPLEX(result)[(i*nrs) + ii].r = NA_REAL;
Expand All @@ -111,7 +111,7 @@ Rprintf("i=%i, j=%i, nrs=%i, first=%i\n", i, INTEGER(j)[i]-1, nrs, first);
}
break;
case RAWSXP:
for(i=0; i<length(j); i++) {
for(i=0; i<xlength(j); i++) {
if(INTEGER(j)[i] == NA_INTEGER) {
for(ii=0; ii < nrs; ii++) {
RAW(result)[(i*nrs) + ii] = 0;
Expand All @@ -124,7 +124,7 @@ Rprintf("i=%i, j=%i, nrs=%i, first=%i\n", i, INTEGER(j)[i]-1, nrs, first);
}
break;
case STRSXP:
for(jj=0; jj<length(j); jj++) {
for(jj=0; jj<xlength(j); jj++) {
if(INTEGER(j)[jj] == NA_INTEGER) {
for(i=0; i< nrs; i++)
SET_STRING_ELT(result, i+jj*nrs, NA_STRING);
Expand Down Expand Up @@ -159,20 +159,20 @@ Rprintf("i=%i, j=%i, nrs=%i, first=%i\n", i, INTEGER(j)[i]-1, nrs, first);
SEXP dim;
PROTECT(dim = allocVector(INTSXP, 2));
INTEGER(dim)[0] = nrs;
INTEGER(dim)[1] = length(j);
INTEGER(dim)[1] = xlength(j);
setAttrib(result, R_DimSymbol, dim);
UNPROTECT(1);

SEXP dimnames, currentnames, newnames;
PROTECT(dimnames = allocVector(VECSXP, 2));
PROTECT(newnames = allocVector(STRSXP, length(j)));
PROTECT(newnames = allocVector(STRSXP, xlength(j)));
currentnames = getAttrib(x, R_DimNamesSymbol);

if(!isNull(currentnames)) {
SET_VECTOR_ELT(dimnames, 0, VECTOR_ELT(currentnames,0));
if(!isNull(VECTOR_ELT(currentnames,1))) {
/* if colnames isn't NULL set */
for(i=0; i<length(j); i++) {
for(i=0; i<xlength(j); i++) {
if(INTEGER(j)[i] == NA_INTEGER) {
SET_STRING_ELT(newnames, i, NA_STRING);
} else {
Expand Down
4 changes: 2 additions & 2 deletions src/isOrdered.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,8 +26,8 @@

SEXP do_is_ordered (SEXP x, SEXP increasing, SEXP strictly)
{
int i;
int nx = LENGTH(x) - 1;
R_xlen_t i;
R_xlen_t nx = xlength(x) - 1;
double *real_x;
int *int_x;

Expand Down
Loading

0 comments on commit 5e24deb

Please sign in to comment.