USE_RINTERNALS and Rcpp

README.md

$ 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

checkResults.txt

$ R CMD check foo
* using log directory ‘/private/tmp/foo.Rcheck’
* using R version 3.0.1 (2013-05-16)
* using platform: x86_64-apple-darwin10.8.0 (64-bit)
* using session charset: UTF-8
* checking for file ‘foo/DESCRIPTION’ ... OK
* checking extension type ... Package
* this is package ‘foo’ version ‘1.0’
* checking package namespace information ... OK
* checking package dependencies ... OK
* checking if this is a source package ... OK
* checking if there is a namespace ... OK
* checking for executable files ... OK
* checking for hidden files and directories ... OK
* checking for portable file names ... OK
* checking for sufficient/correct file permissions ... OK
* checking whether package ‘foo’ can be installed ... OK
* checking installed package size ... OK
* checking package directory ... OK
* checking DESCRIPTION meta-information ... WARNING
Non-standard license specification:
  What license is it under?
Standardizable: FALSE
* checking top-level files ... OK
* checking for left-over files ... OK
* checking index information ... OK
* checking package subdirectories ... OK
* checking R files for non-ASCII characters ... OK
* checking R files for syntax errors ... OK
* checking whether the package can be loaded ... OK
* checking whether the package can be loaded with stated dependencies ... OK
* checking whether the package can be unloaded cleanly ... OK
* checking whether the namespace can be loaded with stated dependencies ... OK
* checking whether the namespace can be unloaded cleanly ... OK
* checking for unstated dependencies in R code ... OK
* checking S3 generic/method consistency ... OK
* checking replacement functions ... OK
* checking foreign function calls ... OK
* checking R code for possible problems ... OK
* checking Rd files ... OK
* checking Rd metadata ... OK
* checking Rd cross-references ... OK
* checking for missing documentation entries ... OK
* checking for code/documentation mismatches ... OK
* checking Rd \usage sections ... OK
* checking Rd contents ... OK
* checking for unstated dependencies in examples ... OK
* checking line endings in C/C++/Fortran sources/headers ... OK
* checking line endings in Makefiles ... OK
* checking for portable use of $(BLAS_LIBS) and $(LAPACK_LIBS) ... OK
* checking compiled code ... NOTE
File ‘/private/tmp/foo.Rcheck/foo/libs/foo.so’:
  Found non-API calls to R: ‘UNIMPLEMENTED_TYPE’, ‘csduplicated’

Compiled code should not call non-API entry points in R.

See ‘Writing portable packages’ in the ‘Writing R Extensions’ manual.
* checking examples ... NONE
* checking PDF version of manual ... OK

WARNING: There was 1 warning.
NOTE: There was 1 note.
See
  ‘/private/tmp/foo.Rcheck/00check.log’
for details.

size.c

#define USE_RINTERNALS
#include <Rinternals.h>
#include <R.h>

typedef size_t R_size_t;

typedef struct {
  union {
		SEXP		backpointer;
		double		align;
	} u;
} VECREC, *VECP;

#define BYTE2VEC(n)	(((n)>0)?(((n)-1)/sizeof(VECREC)+1):0)
#define INT2VEC(n)	(((n)>0)?(((n)*sizeof(int)-1)/sizeof(VECREC)+1):0)
#define FLOAT2VEC(n)	(((n)>0)?(((n)*sizeof(double)-1)/sizeof(VECREC)+1):0)
#define COMPLEX2VEC(n)	(((n)>0)?(((n)*sizeof(Rcomplex)-1)/sizeof(VECREC)+1):0)
#define PTR2VEC(n)	(((n)>0)?(((n)*sizeof(SEXP)-1)/sizeof(VECREC)+1):0)

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

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

SEXP siz( SEXP x){
    return Rf_ScalarReal( objectsize(x) ) ;   
}