static void finalizer(SEXP p)
{
SEXP x;
R_len_t n, l, tl;
if(!R_ExternalPtrAddr(p)) error("Internal error: finalizer hasn't received an ExternalPtr");
p = R_ExternalPtrTag(p);
if (!isString(p)) error("Internal error: finalizer's ExternalPtr doesn't see names in tag");
l = LENGTH(p);
tl = TRUELENGTH(p);
if (l<0 || tl<l) error("Internal error: finalizer sees l=%d, tl=%d",l,tl);
n = tl-l;
if (n==0) {
// gc's ReleaseLargeFreeVectors() will have reduced R_LargeVallocSize by the correct amount
// already, so nothing to do (but almost never the case).
return;
}
x = PROTECT(allocVector(VECSXP, 50)); // 50 so it's big enough to be on LargeVector heap. See NodeClassSize in memory.c:allocVector
SETLENGTH(x,50+n*2); // 1*n for the names, 1*n for the VECSXP itself (both are over allocated)
UNPROTECT(1);
return;
}
void attribute_visible R_init_datatable(DllInfo *info)
// relies on pkg/src/Makevars to mv data.table.so to datatable.so
{
R_registerRoutines(info, NULL, callMethods, NULL, externalMethods);
R_useDynamicSymbols(info, FALSE);
setSizes();
const char *msg = "... failed. Please forward this message to maintainer('data.table') or datatable-help.";
if (NA_INTEGER != INT_MIN) error("Checking NA_INTEGER [%d] == INT_MIN [%d] %s", NA_INTEGER, INT_MIN, msg);
if (NA_INTEGER != NA_LOGICAL) error("Checking NA_INTEGER [%d] == NA_LOGICAL [%d] %s", NA_INTEGER, NA_LOGICAL, msg);
if (sizeof(int) != 4) error("Checking sizeof(int) [%d] is 4 %s", sizeof(int), msg);
if (sizeof(double) != 8) error("Checking sizeof(double) [%d] is 8 %s", sizeof(double), msg); // 8 on both 32bit and 64bit.
if (sizeof(long long) != 8) error("Checking sizeof(long long) [%d] is 8 %s", sizeof(long long), msg);
if (sizeof(char *) != 4 && sizeof(char *) != 8) error("Checking sizeof(pointer) [%d] is 4 or 8 %s", sizeof(char *), msg);
if (sizeof(SEXP) != sizeof(char *)) error("Checking sizeof(SEXP) [%d] == sizeof(pointer) [%d] %s", sizeof(SEXP), sizeof(char *), msg);
SEXP tmp = PROTECT(allocVector(INTSXP,2));
if (LENGTH(tmp)!=2) error("Checking LENGTH(allocVector(INTSXP,2)) [%d] is 2 %s", LENGTH(tmp), msg);
if (TRUELENGTH(tmp)!=0) error("Checking TRUELENGTH(allocVector(INTSXP,2)) [%d] is 0 %s", TRUELENGTH(tmp), msg);
UNPROTECT(1);
// According to IEEE (http://en.wikipedia.org/wiki/IEEE_754-1985#Zero) we can rely on 0.0 being all 0 bits.
// But check here anyway just to be sure, just in case this answer is right (http://stackoverflow.com/a/2952680/403310).
int i = 314;
memset(&i, 0, sizeof(int));
if (i != 0) error("Checking memset(&i,0,sizeof(int)); i == (int)0 %s", msg);
unsigned int ui = 314;
memset(&ui, 0, sizeof(unsigned int));
if (ui != 0) error("Checking memset(&ui, 0, sizeof(unsigned int)); ui == (unsigned int)0 %s", msg);
double d = 3.14;
memset(&d, 0, sizeof(double));
if (d != 0.0) error("Checking memset(&d, 0, sizeof(double)); d == (double)0.0 %s", msg);
long double ld = 3.14;
memset(&ld, 0, sizeof(long double));
if (ld != 0.0) error("Checking memset(&ld, 0, sizeof(long double)); ld == (long double)0.0 %s", msg);
setNumericRounding(ScalarInteger(2));
char_integer64 = mkChar("integer64"); // for speed, similar to R_*Symbol.
}
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;
}
