static SEXP get_package_CEntry_table(const char *package)
{
SEXP penv, pname;
if (CEntryTable == NULL) {
CEntryTable = R_NewHashedEnv(R_NilValue, ScalarInteger(0));
R_PreserveObject(CEntryTable);
}
pname = install(package);
penv = findVarInFrame(CEntryTable, pname);
if (penv == R_UnboundValue) {
penv = R_NewHashedEnv(R_NilValue, ScalarInteger(0));
defineVar(pname, penv, CEntryTable);
}
return penv;
}
/** do_newenv() : .Internal(new.env(hash, parent, size))
*
* @return a newly created environment()
*/
SEXP attribute_hidden do_newenv(SEXP call, SEXP op, SEXP args, SEXP rho)
{
SEXP enclos, size, ans;
int hash;
checkArity(op, args);
hash = asInteger(CAR(args));
args = CDR(args);
enclos = CAR(args);
if (isNull(enclos)) {
error(_("use of NULL environment is defunct"));
enclos = R_BaseEnv;
} else
if( !isEnvironment(enclos) &&
!isEnvironment((enclos = simple_as_environment(enclos))))
error(_("'enclos' must be an environment"));
if( hash ) {
args = CDR(args);
PROTECT(size = coerceVector(CAR(args), INTSXP));
if (INTEGER(size)[0] == NA_INTEGER)
INTEGER(size)[0] = 0; /* so it will use the internal default */
ans = R_NewHashedEnv(enclos, size);
UNPROTECT(1);
} else
ans = NewEnvironment(R_NilValue, R_NilValue, enclos);
return ans;
}
else
klass = asChar(klass);
PROTECT(klass);
value = ScalarString(klass);
UNPROTECT(1);
return value;
}
static SEXP s_dot_S3Class = 0;
static SEXP R_S4_extends_table = 0;
static SEXP cache_class(const char *class, SEXP klass) {
if(!R_S4_extends_table) {
R_S4_extends_table = R_NewHashedEnv(R_NilValue, ScalarInteger(0));
R_PreserveObject(R_S4_extends_table);
}
if(isNull(klass)) { /* retrieve cached value */
SEXP val;
val = findVarInFrame(R_S4_extends_table, install(class));
return (val == R_UnboundValue) ? klass : val;
}
defineVar(install(class), klass, R_S4_extends_table);
return klass;
}
static SEXP S4_extends(SEXP klass) {
static SEXP s_extends = 0, s_extendsForS3;
SEXP e, val; const char *class;
if(!s_extends) {
