HIDE void deserializeSEXP(SEXP o) {
_dbg(rjprintf("attempt to deserialize %p (clCL=%p, oCL=%p)\n", o, clClassLoader, oClassLoader));
SEXP s = EXTPTR_PROT(o);
if (TYPEOF(s) == RAWSXP && EXTPTR_PTR(o) == NULL) {
JNIEnv *env = getJNIEnv();
if (env && clClassLoader && oClassLoader) {
jbyteArray ser = newByteArray(env, RAW(s), LENGTH(s));
if (ser) {
jmethodID mid = (*env)->GetMethodID(env, clClassLoader, "toObject", "([B)Ljava/lang/Object;");
if (mid) {
jobject res = (*env)->CallObjectMethod(env, oClassLoader, mid, ser);
if (res) {
jobject go = makeGlobal(env, res);
_mp(MEM_PROF_OUT("R %08x RNEW %08x\n", (int) go, (int) res))
if (go) {
_dbg(rjprintf(" - succeeded: %p\n", go));
/* set the deserialized object */
EXTPTR_PTR(o) = (SEXP) go;
/* Note: currently we don't remove the serialized content, because it was created explicitly using .jcache to allow repeated saving. Once this is handled by a hook, we shall remove it. However, to assure compatibility TAG is always NULL for now, so we do clear the cache if TAG is non-null for future use. */
if (EXTPTR_TAG(o) != R_NilValue) {
/* remove the serialized raw vector */
SETCDR(o, R_NilValue); /* Note: this is abuse of the API since it uses the fact that PROT is stored in CDR */
}
}
}
}
releaseObject(env, ser);
}
}
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:
case DOTSXP:
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:
R_CheckStack(); /* in case attributes might lead to a cycle */
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));
PROTECT(dup = Rf_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;
UNPROTECT(1);
break;
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);
}
