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
<[email protected]> 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
_______________________________________________
Rcpp-devel mailing list
[email protected]
https://lists.r-forge.r-project.org/cgi-bin/mailman/listinfo/rcpp-devel
