[Rcpp-devel] USE_RINTERNALS and Rcpp

[Hadley Wickham]

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);
}






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