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);
}
示例#2
0
SmokeObject::~SmokeObject() {
#ifdef MEM_DEBUG
  qDebug("%p: destructing", this);
#endif
  if (_sexp) {
#ifdef MEM_DEBUG
    qDebug("%p: orphaned sexp %p", this, _sexp);
#endif
    orphanTable(HASHTAB(_sexp));
  }
  if (_internalTable) {
#ifdef MEM_DEBUG
    qDebug("%p: orphaned internal table %p", this, _internalTable);
#endif
    orphanTable(_internalTable);
  }
  if (_fieldEnv)
    R_ReleaseObject(_fieldEnv);
  instances.remove(_ptr);
}
示例#3
0
SmokeObject * SmokeObject::fromSexp(SEXP sexp)
{
  if (!isEnvironment(sexp))
    error("Expected an environment");
  return InstanceObjectTable::instanceFromSexp(HASHTAB(sexp));
}
示例#4
0
/**  Returns the hash table of an environment.
  *
  *  @param sexp An R environment.
  *  @return The hash table of the R environment.
  */
CAMLprim value ocamlr_inspect_envsxp_hashtab (value sexp) {
  return(Val_sexp(HASHTAB(Sexp_val(sexp))));
}