[Rcpp-devel] USE_RINTERNALS and Rcpp

[Romain Francois]

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