Ejemplo n.º 1
0
static int _selfrefok(SEXP x, Rboolean checkNames, Rboolean verbose) {
    SEXP v, p, tag, prot, names;
    v = getAttrib(x, SelfRefSymbol);
    if (v==R_NilValue || TYPEOF(v)!=EXTPTRSXP) {
        // .internal.selfref missing is expected and normal for i) a pre v1.7.8 data.table loaded
        //  from disk, and ii) every time a new data.table is over-allocated for the first time.
        //  Not being an extptr is for when users contruct a data.table via structure() using dput, post
        //  a question, and find the extptr doesn't parse so put quotes around it (for example).
        //  In both cases the selfref is not ok.
        return 0;
    }
    p = R_ExternalPtrAddr(v);
    if (p==NULL) {
        if (verbose) Rprintf(".internal.selfref ptr is NULL. This is expected and normal for a data.table loaded from disk. If not, please report to datatable-help.\n");
        return -1;
    }
    if (!isNull(p)) error("Internal error: .internal.selfref ptr is not NULL or R_NilValue");
    tag = R_ExternalPtrTag(v);
    if (!(isNull(tag) || isString(tag))) error("Internal error: .internal.selfref tag isn't NULL or a character vector");
    names = getAttrib(x, R_NamesSymbol);
    if (names != tag && isString(names))
        SET_TRUELENGTH(names, LENGTH(names)); 
        // R copied this vector not data.table; it's not actually over-allocated. It looks over-allocated
        // because R copies the original vector's tl over despite allocating length.
    prot = R_ExternalPtrProtected(v);
    if (TYPEOF(prot) != EXTPTRSXP)   // Very rare. Was error(".internal.selfref prot is not itself an extptr").
        return 0;                    // See http://stackoverflow.com/questions/15342227/getting-a-random-internal-selfref-error-in-data-table-for-r
    if (x != R_ExternalPtrAddr(prot))
        SET_TRUELENGTH(x, LENGTH(x));  // R copied this vector not data.table, it's not actually over-allocated
    return checkNames ? names==tag : x==R_ExternalPtrAddr(prot);
}
Ejemplo n.º 2
0
static SEXP shallow(SEXP dt, SEXP cols, R_len_t n)
{
    // NEW: cols argument to specify the columns to shallow copy on. If NULL, all columns.
    // called from alloccol where n is checked carefully, or from shallow() at R level
    // where n is set to truelength (i.e. a shallow copy only with no size change)
    SEXP newdt, names, newnames;
    R_len_t i,l;
    int protecti=0;
    PROTECT(newdt = allocVector(VECSXP, n));   // to do, use growVector here?
    protecti++;
    //copyMostAttrib(dt, newdt);   // including class
    DUPLICATE_ATTRIB(newdt, dt);
    // TO DO: keepattr() would be faster, but can't because shallow isn't merely a shallow copy. It
    //        also increases truelength. Perhaps make that distinction, then, and split out, but marked
    //        so that the next change knows to duplicate.
    //        Does copyMostAttrib duplicate each attrib or does it point? It seems to point, hence DUPLICATE_ATTRIB
    //        for now otherwise example(merge.data.table) fails (since attr(d4,"sorted") gets written by setnames).
    names = getAttrib(dt, R_NamesSymbol); 
    PROTECT(newnames = allocVector(STRSXP, n));
    protecti++;
    if (isNull(cols)) {
        l = LENGTH(dt);
        for (i=0; i<l; i++) SET_VECTOR_ELT(newdt, i, VECTOR_ELT(dt,i));
        if (length(names)) {
            if (length(names) < l) error("Internal error: length(names)>0 but <length(dt)");
            for (i=0; i<l; i++) SET_STRING_ELT(newnames, i, STRING_ELT(names,i));
        } 
        // else an unnamed data.table is valid e.g. unname(DT) done by ggplot2, and .SD may have its names cleared in dogroups, but shallow will always create names for data.table(NULL) which has 100 slots all empty so you can add to an empty data.table by reference ok.
    } else {
        l = length(cols);
        for (i=0; i<l; i++) SET_VECTOR_ELT(newdt, i, VECTOR_ELT(dt,INTEGER(cols)[i]-1));
        if (length(names)) {
            // no need to check length(names) < l here. R-level checks if all value 
            // in 'cols' are valid - in the range of 1:length(names(x))            
            for (i=0; i<l; i++) SET_STRING_ELT( newnames, i, STRING_ELT(names,INTEGER(cols)[i]-1) );
        } 
    }
    setAttrib(newdt, R_NamesSymbol, newnames);
    // setAttrib appears to change length and truelength, so need to do that first _then_ SET next,
    // otherwise (if the SET were were first) the 100 tl is assigned to length.
    SETLENGTH(newnames,l);
    SET_TRUELENGTH(newnames,n);
    SETLENGTH(newdt,l);
    SET_TRUELENGTH(newdt,n);
    setselfref(newdt);
    // SET_NAMED(dt,1);  // for some reason, R seems to set NAMED=2 via setAttrib?  Need NAMED to be 1 for passing to assign via a .C dance before .Call (which sets NAMED to 2), and we can't use .C with DUP=FALSE on lists.
    UNPROTECT(protecti);
    return(newdt);
}
Ejemplo n.º 3
0
size_t allocateDT(int8_t *typeArg, int8_t *sizeArg, int ncolArg, int ndrop, size_t allocNrow) {
  // save inputs for use by pushBuffer
  size = sizeArg;
  type = typeArg;
  int newDT = (ncol == 0);
  if (newDT) {
    ncol = ncolArg;
    dtnrows = allocNrow;
    SET_VECTOR_ELT(RCHK, 0, DT=allocVector(VECSXP,ncol-ndrop));
    if (ndrop==0) {
      setAttrib(DT,R_NamesSymbol,colNamesSxp);  // colNames mkChar'd in userOverride step
    } else {
      SEXP tt = PROTECT(allocVector(STRSXP, ncol-ndrop));
      setAttrib(DT, R_NamesSymbol, tt);
      UNPROTECT(1); // tt; now that it's safely a member of protected object
      for (int i=0,resi=0; i<ncol; i++) if (type[i]!=CT_DROP) {
        SET_STRING_ELT(tt,resi++,STRING_ELT(colNamesSxp,i));
      }
    }
  }
  // TODO: move DT size calculation into a separate function (since the final size is different from the initial size anyways)
  size_t DTbytes = SIZEOF(DT)*(ncol-ndrop)*2; // the VECSXP and its column names (exclude global character cache usage)

  // For each column we could have one of the following cases:
  //   * if the DataTable is "new", then make a new vector
  //   * if the column's type has changed, then replace it with a new vector
  //     (however if column's type[i] is negative, then it means we're skipping
  //     the column in the rerun, and its type hasn't actually changed).
  //   * if dtnrows≠allocNrow and the column's type has not changed, then that
  //     column needs to be re-alloced (using growVector).
  //   * otherwise leave the column as-is.
  for (int i=0, resi=0; i<ncol; i++) {
    if (type[i] == CT_DROP) continue;
    SEXP col = VECTOR_ELT(DT, resi);
    int oldIsInt64 = newDT? 0 : INHERITS(col, char_integer64);
    int newIsInt64 = type[i] == CT_INT64;
    int typeChanged = (type[i] > 0) && (newDT || TYPEOF(col) != typeSxp[type[i]] || oldIsInt64 != newIsInt64);
    int nrowChanged = (allocNrow != dtnrows);
    if (typeChanged || nrowChanged) {
      SEXP thiscol = typeChanged ? allocVector(typeSxp[type[i]], allocNrow)  // no need to PROTECT, passed immediately to SET_VECTOR_ELT, see R-exts 5.9.1
                                 : growVector(col, allocNrow);
      SET_VECTOR_ELT(DT,resi,thiscol);
      if (type[i]==CT_INT64) {
        SEXP tt = PROTECT(ScalarString(char_integer64));
        setAttrib(thiscol, R_ClassSymbol, tt);
        UNPROTECT(1);
      }
      SET_TRUELENGTH(thiscol, allocNrow);
      DTbytes += SIZEOF(thiscol)*allocNrow;
    }
    resi++;
  }
  dtnrows = allocNrow;
  return DTbytes;
}
Ejemplo n.º 4
0
void setFinalNrow(size_t nrow) {
  // TODO realloc
  if (length(DT)) {
    if (nrow == length(VECTOR_ELT(DT, 0)))
      return;
    for (int i=0; i<LENGTH(DT); i++) {
      SETLENGTH(VECTOR_ELT(DT,i), nrow);
      SET_TRUELENGTH(VECTOR_ELT(DT,i), nrow);
    }
  }
}
Ejemplo n.º 5
0
void setFinalNrow(size_t nrow) {
  // TODO realloc
  if (length(DT)) {
    if (nrow == dtnrows)
      return;
    for (int i=0; i<LENGTH(DT); i++) {
      SETLENGTH(VECTOR_ELT(DT,i), nrow);
      SET_TRUELENGTH(VECTOR_ELT(DT,i), nrow);
    }
  }
  R_FlushConsole(); // # 2481. Just a convenient place; nothing per se to do with setFinalNrow()
}
Ejemplo n.º 6
0
SEXP init_Rcpp_cache(){   
    SEXP getNamespaceSym = Rf_install("getNamespace"); // cannot be gc()'ed  once in symbol table
    SEXP RCPP = PROTECT( Rf_eval(Rf_lang2( getNamespaceSym, Rf_mkString("Rcpp") ), R_GlobalEnv) ) ;
    SEXP cache = PROTECT( Rf_allocVector( VECSXP, RCPP_CACHE_SIZE ) );
    
    // the Rcpp namespace
	SET_VECTOR_ELT( cache, 0, RCPP ) ;
	set_error_occured( cache, Rf_ScalarLogical(FALSE) ) ; // error occured
	set_current_error( cache, R_NilValue ) ; // current error
	SET_VECTOR_ELT( cache, 3, R_NilValue ) ; // stack trace
	SET_VECTOR_ELT( cache, RCPP_HASH_CACHE_INDEX, Rf_allocVector(INTSXP, RCPP_HASH_CACHE_INITIAL_SIZE) ) ;
	SEXP stack = PROTECT(Rf_allocVector(VECSXP, RCPP_PROTECT_STACK_INITIAL_SIZE)) ;
	// we use true length to store "top"
	SET_TRUELENGTH(stack, -1 ) ;
	SET_VECTOR_ELT( cache, RCPP_PROTECTION_STACK_INDEX, stack ) ;
	Rf_defineVar( Rf_install(".rcpp_cache"), cache, RCPP );
    
    UNPROTECT(3) ; 
    
    return cache ;
}
Ejemplo n.º 7
0
size_t allocateDT(int8_t *typeArg, int8_t *sizeArg, int ncolArg, int ndrop, size_t allocNrow) {
  // save inputs for use by pushBuffer
  int newDT = (ncol == 0);
  size = sizeArg;
  type = typeArg;
  if (newDT) {
    ncol = ncolArg;
    DT=PROTECT(allocVector(VECSXP,ncol-ndrop));  // safer to leave over allocation to alloc.col on return in fread.R
    protecti++;
    if (ndrop==0) {
      setAttrib(DT,R_NamesSymbol,colNamesSxp);  // colNames mkChar'd in userOverride step
    } else {
      SEXP tt;
      setAttrib(DT, R_NamesSymbol, tt = allocVector(STRSXP, ncol-ndrop));
      for (int i=0,resi=0; i<ncol; i++) if (type[i]!=CT_DROP) {
        SET_STRING_ELT(tt,resi++,STRING_ELT(colNamesSxp,i));
      }
    }
  }
  size_t DTbytes = SIZEOF(DT)*(ncol-ndrop)*2; // the VECSXP and its column names (exclude global character cache usage)
  for (int i=0,resi=0; i<ncol; i++) {
    if (type[i] == CT_DROP) continue;
    int oldSxpType = newDT? -1 : TYPEOF(VECTOR_ELT(DT, resi));
    int oldIsInt64 = newDT? 0 : INHERITS(VECTOR_ELT(DT, resi), char_integer64);
    int newIsInt64 = type[i] == CT_INT64;
    if (type[i] > 0 && (oldSxpType != typeSxp[type[i]] || oldIsInt64 != newIsInt64)) {
      SEXP thiscol = allocVector(typeSxp[type[i]], allocNrow);
      SET_VECTOR_ELT(DT,resi,thiscol);     // no need to PROTECT thiscol, see R-exts 5.9.1
      if (type[i]==CT_INT64) setAttrib(thiscol, R_ClassSymbol, ScalarString(char_integer64));
      SET_TRUELENGTH(thiscol, allocNrow);
      DTbytes += SIZEOF(thiscol)*allocNrow;
    }
    resi++;
  }
  return DTbytes;
}
Ejemplo n.º 8
0
static SEXP duplicate1(SEXP s, Rboolean deep)
{
    SEXP t;
    R_xlen_t i, n;

    switch (TYPEOF(s)) {
    case NILSXP:
    case SYMSXP:
    case ENVSXP:
    case SPECIALSXP:
    case BUILTINSXP:
    case EXTPTRSXP:
    case BCODESXP:
    case WEAKREFSXP:
	return s;
    case CLOSXP:
	PROTECT(s);
	if (R_jit_enabled > 1 && TYPEOF(BODY(s)) != BCODESXP) {
	    int old_enabled = R_jit_enabled;
	    SEXP new_s;
	    R_jit_enabled = 0;
	    new_s = R_cmpfun(s);
	    SET_BODY(s, BODY(new_s));
	    R_jit_enabled = old_enabled;
	}
	PROTECT(t = allocSExp(CLOSXP));
	SET_FORMALS(t, FORMALS(s));
	SET_BODY(t, BODY(s));
	SET_CLOENV(t, CLOENV(s));
	DUPLICATE_ATTRIB(t, s, deep);
	UNPROTECT(2);
	break;
    case LISTSXP:
	PROTECT(s);
	t = duplicate_list(s, deep);
	UNPROTECT(1);
	break;
    case LANGSXP:
	PROTECT(s);
	PROTECT(t = duplicate_list(s, deep));
	SET_TYPEOF(t, LANGSXP);
	DUPLICATE_ATTRIB(t, s, deep);
	UNPROTECT(2);
	break;
    case DOTSXP:
	PROTECT(s);
	PROTECT(t = duplicate_list(s, deep));
	SET_TYPEOF(t, DOTSXP);
	DUPLICATE_ATTRIB(t, s, deep);
	UNPROTECT(2);
	break;
    case CHARSXP:
	return s;
	break;
    case EXPRSXP:
    case VECSXP:
	n = XLENGTH(s);
	PROTECT(s);
	PROTECT(t = allocVector(TYPEOF(s), n));
	for(i = 0 ; i < n ; i++)
	    SET_VECTOR_ELT(t, i, duplicate_child(VECTOR_ELT(s, i), deep));
	DUPLICATE_ATTRIB(t, s, deep);
	SET_TRUELENGTH(t, TRUELENGTH(s));
	UNPROTECT(2);
	break;
    case LGLSXP: DUPLICATE_ATOMIC_VECTOR(int, LOGICAL, t, s, deep); break;
    case INTSXP: DUPLICATE_ATOMIC_VECTOR(int, INTEGER, t, s, deep); break;
    case REALSXP: DUPLICATE_ATOMIC_VECTOR(double, REAL, t, s, deep); break;
    case CPLXSXP: DUPLICATE_ATOMIC_VECTOR(Rcomplex, COMPLEX, t, s, deep); break;
    case RAWSXP: DUPLICATE_ATOMIC_VECTOR(Rbyte, RAW, t, s, deep); break;
    case STRSXP:
	/* direct copying and bypassing the write barrier is OK since
	   t was just allocated and so it cannot be older than any of
	   the elements in s.  LT */
	DUPLICATE_ATOMIC_VECTOR(SEXP, STRING_PTR, t, s, deep);
	break;
    case PROMSXP:
	return s;
	break;
    case S4SXP:
	PROTECT(s);
	PROTECT(t = allocS4Object());
	DUPLICATE_ATTRIB(t, s, deep);
	UNPROTECT(2);
	break;
    default:
	UNIMPLEMENTED_TYPE("duplicate", s);
	t = s;/* for -Wall */
    }
    if(TYPEOF(t) == TYPEOF(s) ) { /* surely it only makes sense in this case*/
	SET_OBJECT(t, OBJECT(s));
	(IS_S4_OBJECT(s) ? SET_S4_OBJECT(t) : UNSET_S4_OBJECT(t));
    }
    return t;
}
Ejemplo n.º 9
0
static SEXP subsetVectorRaw(SEXP x, SEXP idx, int l, int tl)
// Only for use by subsetDT() or subsetVector() below, hence static
// l is the count of non-zero (including NAs) in idx i.e. the length of the result
// tl is the amount to be allocated,  tl>=l
// TO DO: if no 0 or NA detected up front in subsetDT() below, could switch to a faster subsetVectorRawNo0orNA()
{
    int i, this, ansi=0, max=length(x), n=LENGTH(idx), *pidx=INTEGER(idx);
    if (tl<l) error("Internal error: tl<n passed to subsetVectorRaw");
    SEXP ans = PROTECT(allocVector(TYPEOF(x), tl));
    SETLENGTH(ans, l);
    SET_TRUELENGTH(ans, tl);
    // Rprintf("l=%d, tl=%d, LENGTH(idx)=%d\n", l, tl, LENGTH(idx));
#ifdef _OPENMP
    int *ctr = (int *)calloc(omp_get_max_threads()+1, sizeof(int));
#endif

    switch(TYPEOF(x)) {
    case INTSXP :
#ifdef _OPENMP
    #pragma omp parallel
    {
        int tmp=0, ithread = omp_get_thread_num(), nthreads = omp_get_num_threads();    // local
        // computing count indices correctly is tricky when there are 0-indices.
        // 1. count number of non-0 'idx' for each thread
        #pragma omp for
        for (i=0; i<n; i++) tmp += (pidx[i] != 0);  // don't use ctr[ithread+1] here -- false sharing
                            // TODO: use SIMD here?
        ctr[ithread+1] = tmp;                       // ctr[0]=0, rest contains count where iidx!=0,
                            // within each thread's range
        #pragma omp barrier                         // wait for all threads, important
        // 2. using that, set the starting index for each thread appropriately
        #pragma omp single
        for (i=0; i<nthreads; i++)
        ctr[i+1] += ctr[i];                     // for each thread, compute the right starting point, by
                            // taking (non)0-count into account, computed above.
        tmp = ctr[ithread];                         // copy back from shared to thread's local var. All set.
        #pragma omp barrier                         // wait for all threads, important
        // 3. use old code, but with thread's local var with right start index as counter
        #pragma omp for private(this) reduction(+:ansi)
        for (i=0; i<n; i++) {
        this = pidx[i];
        if (this==0) continue;
        // have to use 'tmp' here, and not ctr[ithread++] -- false sharing
        INTEGER(ans)[tmp++] = (this==NA_INTEGER || this>max) ? NA_INTEGER : INTEGER(x)[this-1];
        ansi++;                                 // not required, but just to be sure
        }
    }
#else
    for (i=0; i<n; i++) {
        this = pidx[i];
        if (this==0) continue;
        INTEGER(ans)[ansi++] = (this==NA_INTEGER || this>max) ? NA_INTEGER : INTEGER(x)[this-1];
    }
#endif
    break;
    case REALSXP :
#ifdef _OPENMP
    #pragma omp parallel
    {
        int tmp=0, ithread = omp_get_thread_num(), nthreads = omp_get_num_threads();
        #pragma omp for
        for (i=0; i<n; i++) tmp += (pidx[i] != 0);
        ctr[ithread+1] = tmp;
        #pragma omp barrier
        #pragma omp single
        for (i=0; i<nthreads; i++)
        ctr[i+1] += ctr[i];
        tmp = ctr[ithread];
        #pragma omp barrier
        #pragma omp for private(this) reduction(+:ansi)
        for (i=0; i<n; i++) {
        this = pidx[i];
        if (this==0) continue;
        REAL(ans)[tmp++] = (this==NA_INTEGER || this>max) ? NA_REAL : REAL(x)[this-1];
        ansi++;
        }
    }
#else
    for (i=0; i<n; i++) {
        this = pidx[i];
        if (this==0) continue;
        REAL(ans)[ansi++] = (this==NA_INTEGER || this>max) ? NA_REAL : REAL(x)[this-1];
    }
#endif
    break;
    case LGLSXP :
#ifdef _OPENMP
    #pragma omp parallel
    {
        int tmp=0, ithread = omp_get_thread_num(), nthreads = omp_get_num_threads();
        #pragma omp for
        for (i=0; i<n; i++) tmp += (pidx[i] != 0);
        ctr[ithread+1] = tmp;
        #pragma omp barrier
        #pragma omp single
        for (i=0; i<nthreads; i++)
        ctr[i+1] += ctr[i];
        tmp = ctr[ithread];
        #pragma omp barrier
        #pragma omp for private(this) reduction(+:ansi)
        for (i=0; i<n; i++) {
        this = pidx[i];
        if (this==0) continue;
        LOGICAL(ans)[tmp++] = (this==NA_INTEGER || this>max) ? NA_LOGICAL : LOGICAL(x)[this-1];
        ansi++;
        }
    }
#else
    for (i=0; i<n; i++) {
        this = pidx[i];
        if (this==0) continue;
        LOGICAL(ans)[ansi++] = (this==NA_INTEGER || this>max) ? NA_LOGICAL : LOGICAL(x)[this-1];
    }
#endif
    break;
    case STRSXP :
#ifdef _OPENMP
    #pragma omp parallel
    {
        int tmp=0, ithread = omp_get_thread_num(), nthreads = omp_get_num_threads();
        #pragma omp for
        for (i=0; i<n; i++) tmp += (pidx[i] != 0);
        ctr[ithread+1] = tmp;
        #pragma omp barrier
        #pragma omp single
        for (i=0; i<nthreads; i++)
        ctr[i+1] += ctr[i];
        tmp = ctr[ithread];
        #pragma omp barrier
        #pragma omp for private(this) reduction(+:ansi)
        for (i=0; i<n; i++) {
        this = pidx[i];
        if (this==0) continue;
        SET_STRING_ELT(ans, tmp++, (this==NA_INTEGER || this>max) ? NA_STRING : STRING_ELT(x, this-1));
        ansi++;
        }
    }
#else
    for (i=0; i<n; i++) {
        this = pidx[i];
        if (this==0) continue;
        SET_STRING_ELT(ans, ansi++, (this==NA_INTEGER || this>max) ? NA_STRING : STRING_ELT(x, this-1));
    }
#endif
    break;
    case VECSXP :
#ifdef _OPENMP
    #pragma omp parallel
    {
        int tmp=0, ithread = omp_get_thread_num(), nthreads = omp_get_num_threads();
        #pragma omp for
        for (i=0; i<n; i++) tmp += (pidx[i] != 0);
        ctr[ithread+1] = tmp;
        #pragma omp barrier
        #pragma omp single
        for (i=0; i<nthreads; i++)
        ctr[i+1] += ctr[i];
        tmp = ctr[ithread];
        #pragma omp barrier
        #pragma omp for private(this) reduction(+:ansi)
        for (i=0; i<n; i++) {
        this = pidx[i];
        if (this==0) continue;
        SET_VECTOR_ELT(ans, tmp++, (this==NA_INTEGER || this>max) ? R_NilValue : VECTOR_ELT(x, this-1));
        ansi++;
        }
    }
#else
    for (i=0; i<n; i++) {
        this = pidx[i];
        if (this==0) continue;
        SET_VECTOR_ELT(ans, ansi++, (this==NA_INTEGER || this>max) ? R_NilValue : VECTOR_ELT(x, this-1));
    }
#endif
    break;
    // Fix for #982
    // source: https://github.com/wch/r-source/blob/fbf5cdf29d923395b537a9893f46af1aa75e38f3/src/main/subset.c
    case CPLXSXP :
#ifdef _OPENMP
    #pragma omp parallel
    {
        int tmp=0, ithread = omp_get_thread_num(), nthreads = omp_get_num_threads();
        #pragma omp for
        for (i=0; i<n; i++) tmp += (pidx[i] != 0);
        ctr[ithread+1] = tmp;
        #pragma omp barrier
        #pragma omp single
        for (i=0; i<nthreads; i++)
        ctr[i+1] += ctr[i];
        tmp = ctr[ithread];
        #pragma omp barrier
        #pragma omp for private(this) reduction(+:ansi)
        for (i=0; i<n; i++) {
        this = pidx[i];
        if (this==0) continue;
        if (this == NA_INTEGER || this>max) {
            COMPLEX(ans)[tmp].r = NA_REAL;
            COMPLEX(ans)[tmp++].i = NA_REAL;
        } else COMPLEX(ans)[tmp++] = COMPLEX(x)[this-1];
        ansi++;
        }
    }
#else
    for (i=0; i<n; i++) {
        this = pidx[i];
        if (this == 0) continue;
        if (this == NA_INTEGER || this>max) {
        COMPLEX(ans)[ansi].r = NA_REAL;
        COMPLEX(ans)[ansi].i = NA_REAL;
        } else COMPLEX(ans)[ansi] = COMPLEX(x)[this-1];
        ansi++;
    }
#endif
    break;
    case RAWSXP :
#ifdef _OPENMP
    #pragma omp parallel
    {
        int tmp=0, ithread = omp_get_thread_num(), nthreads = omp_get_num_threads();
        #pragma omp for
        for (i=0; i<n; i++) tmp += (pidx[i] != 0);
        ctr[ithread+1] = tmp;
        #pragma omp barrier
        #pragma omp single
        for (i=0; i<nthreads; i++)
        ctr[i+1] += ctr[i];
        tmp = ctr[ithread];
        #pragma omp barrier
        #pragma omp for private(this) reduction(+:ansi)
        for (i=0; i<n; i++) {
        this = pidx[i];
        if (this==0) continue;
        RAW(ans)[tmp++] = (this == NA_INTEGER || this>max) ? (Rbyte) 0 : RAW(x)[this-1];
        ansi++;
        }
    }
#else
    for (i=0; i<n; i++) {
        this = pidx[i];
        if (this == 0) continue;
        RAW(ans)[ansi++] = (this == NA_INTEGER || this>max) ? (Rbyte) 0 : RAW(x)[this-1];
    }
#endif
    break;
    default :
    error("Unknown column type '%s'", type2char(TYPEOF(x)));
    }
#ifdef _OPENMP
    free(ctr);
#endif
    if (ansi != l) error("Internal error: ansi [%d] != l [%d] at the end of subsetVector", ansi, l);
    copyMostAttrib(x, ans);
    UNPROTECT(1);
    return(ans);
}