[Rcpp-devel] USE_RINTERNALS and Rcpp

[Romain Francois]

Le 23/09/13 18:24, Hadley Wickham a écrit :
> 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

I'm afraid you're right. Defn.h is not part of the distributed files.

Now you might be able to negociate that some of these are promoted to 
public api in a future version, but I would not put my money on it.


And for these:

extern void UNIMPLEMENTED_TYPE(const char *s, SEXP x) ;
extern SEXP csduplicated(SEXP) ;


R makes it difficult for you to use that sort of trick.

I've updated the gist with what happens if you put the code in a 
package: https://gist.github.com/romainfrancois/6672944

You get that note:

* checking compiled code ... NOTE
File ‘/private/tmp/foo.Rcheck/foo/libs/foo.so’:
   Found non-API calls to R: ‘UNIMPLEMENTED_TYPE’, ‘csduplicated’

Romain

> 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