[Rcpp-devel] USE_RINTERNALS and Rcpp

[Hadley Wickham]

Thanks!

There's no way to make this less fragile (i.e. by using Defn.h),
right? (Because Defn.h isn't "exported" by R)

Hadley

On Mon, Sep 23, 2013 at 11:17 AM, Romain Francois
<romain at r-enthusiasts.com> wrote:
> 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
>



-- 
Chief Scientist, RStudio
http://had.co.nz/