SEXP SmokeObject::internalSexp(SEXP env) {
SEXP sexp;
PROTECT(sexp = createSexp(env));
SET_HASHTAB(sexp, internalTable());
UNPROTECT(1);
return sexp;
}
SEXP SmokeObject::sexp() {
if (!_sexp) {
PROTECT(_sexp = createSexp(R_EmptyEnv));
SET_HASHTAB(_sexp, _klass->createObjectTable(this)->sexp());
#ifdef MEM_DEBUG
qDebug("%p: created sexp %p", this, _sexp);
#endif
UNPROTECT(1);
}
return _sexp;
}
SEXP
newRClosureTable(SEXP handlers)
{
R_ObjectTable *tb;
SEXP val, klass, env;
tb = (R_ObjectTable *) malloc(sizeof(R_ObjectTable));
if(!tb)
error("cannot allocate space for an internal R object table");
tb->type = 15;
tb->cachedNames = NULL;
tb->active = TRUE;
R_PreserveObject(handlers);
tb->privateData = handlers;
tb->exists = RClosureTable_exists;
tb->get = RClosureTable_get;
tb->remove = RClosureTable_remove;
tb->assign = RClosureTable_assign;
tb->objects = RClosureTable_objects;
tb->canCache = RClosureTable_canCache;
tb->onAttach = NULL;
tb->onDetach = NULL;
PROTECT(val = R_MakeExternalPtr(tb, Rf_install("UserDefinedDatabase"), R_NilValue));
PROTECT(klass = NEW_CHARACTER(1));
SET_STRING_ELT(klass, 0, COPY_TO_USER_STRING("UserDefinedDatabase"));
SET_CLASS(val, klass);
env = allocSExp(ENVSXP);
SET_HASHTAB(env, val);
SET_ENCLOS(env, R_GlobalEnv);
setAttrib(env, R_ClassSymbol, getAttrib(HASHTAB(env), R_ClassSymbol));
UNPROTECT(2);
return(env);
}