Hi,
I would not do that kind of internal things with Rcpp. Instead put code
from this gist https://gist.github.com/romainfrancois/6672944 on a .c
file and go old school about it:
$ R CMD SHLIB size.c
$ Rscript -e "dyn.load('size.so'); siz <- function(.) .Call( 'siz', .) ;
siz(1:10); siz(siz); siz(letters) "
[1] 88
[1] 600
[1] 1496
Romain
Le 23/09/13 17:45, Hadley Wickham a écrit :
Hi all,
Is it possible to access the R internals api through Rcpp? For
example, I want to right my own version of object.size() that's aimed
at detecting memory leaks, so it needs to recursively include the size
of environments. The objectsize C function needs to access R internals
to get the size of various vectors (BYTE2VEC, INT2VEC etc) - is there
a way to accomplish the same thing through Rcpp? (Source code for
objectsize included below)
Thanks!
Hadley
static R_size_t objectsize(SEXP s)
{
R_size_t cnt = 0, vcnt = 0;
SEXP tmp, dup;
Rboolean isVec = FALSE;
switch (TYPEOF(s)) {
case NILSXP:
return(0);
break;
case SYMSXP:
break;
case LISTSXP:
case LANGSXP:
case BCODESXP:
cnt += objectsize(TAG(s));
cnt += objectsize(CAR(s));
cnt += objectsize(CDR(s));
break;
case CLOSXP:
cnt += objectsize(FORMALS(s));
cnt += objectsize(BODY(s));
/* no charge for the environment */
break;
case ENVSXP:
case PROMSXP:
case SPECIALSXP:
case BUILTINSXP:
break;
case CHARSXP:
vcnt = BYTE2VEC(length(s)+1);
isVec = TRUE;
break;
case LGLSXP:
case INTSXP:
vcnt = INT2VEC(xlength(s));
isVec = TRUE;
break;
case REALSXP:
vcnt = FLOAT2VEC(xlength(s));
isVec = TRUE;
break;
case CPLXSXP:
vcnt = COMPLEX2VEC(xlength(s));
isVec = TRUE;
break;
case STRSXP:
vcnt = PTR2VEC(xlength(s));
dup = csduplicated(s);
for (R_xlen_t i = 0; i < xlength(s); i++) {
tmp = STRING_ELT(s, i);
if(tmp != NA_STRING && !LOGICAL(dup)[i])
cnt += objectsize(tmp);
}
isVec = TRUE;
break;
case DOTSXP:
case ANYSXP:
/* we don't know about these */
break;
case VECSXP:
case EXPRSXP:
case WEAKREFSXP:
/* Generic Vector Objects */
vcnt = PTR2VEC(xlength(s));
for (R_xlen_t i = 0; i < xlength(s); i++)
cnt += objectsize(VECTOR_ELT(s, i));
isVec = TRUE;
break;
case EXTPTRSXP:
cnt += sizeof(void *); /* the actual pointer */
cnt += objectsize(EXTPTR_PROT(s));
cnt += objectsize(EXTPTR_TAG(s));
break;
case RAWSXP:
vcnt = BYTE2VEC(xlength(s));
isVec = TRUE;
break;
case S4SXP:
/* Has TAG and ATRIB but no CAR nor CDR */
cnt += objectsize(TAG(s));
break;
default:
UNIMPLEMENTED_TYPE("object.size", s);
}
/* add in node space:
we need to take into account the rounding up that goes on
in the node classes. */
if(isVec) {
cnt += sizeof(SEXPREC_ALIGN);
if (vcnt > 16) cnt += 8*vcnt;
else if (vcnt > 8) cnt += 128;
else if (vcnt > 6) cnt += 64;
else if (vcnt > 4) cnt += 48;
else if (vcnt > 2) cnt += 32;
else if (vcnt > 1) cnt += 16;
else if (vcnt > 0) cnt += 8;
} else cnt += sizeof(SEXPREC);
/* add in attributes: these are fake for CHARSXPs */
if(TYPEOF(s) != CHARSXP) cnt += objectsize(ATTRIB(s));
return(cnt);
}
--
Romain Francois
Professional R Enthusiast
+33(0) 6 28 91 30 30
_______________________________________________
Rcpp-devel mailing list
[email protected]
https://lists.r-forge.r-project.org/cgi-bin/mailman/listinfo/rcpp-devel
