/* Cleanup */
void cleanup_main(void *data)
{
ScmVM *vm = Scm_VM();
if (profiling_mode) {
Scm_ProfilerStop();
Scm_EvalCString("(profiler-show)",
SCM_OBJ(Scm_GaucheModule()),
NULL); /* ignore errors */
}
/* EXPERIMENTAL */
if (stats_mode) {
fprintf(stderr, "\n;; Statistics (*: main thread only):\n");
fprintf(stderr,
";; GC: %zubytes heap, %zubytes allocated\n",
GC_get_heap_size(), GC_get_total_bytes());
fprintf(stderr,
";; stack overflow*: %ldtimes, %.2fms total/%.2fms avg\n",
vm->stat.sovCount,
vm->stat.sovTime/1000.0,
(vm->stat.sovCount > 0?
(double)(vm->stat.sovTime/vm->stat.sovCount)/1000.0 :
0.0));
}
/* EXPERIMENTAL */
if (SCM_VM_RUNTIME_FLAG_IS_SET(vm, SCM_COLLECT_LOAD_STATS)) {
Scm_Eval(SCM_LIST2(SCM_INTERN("profiler-show-load-stats"),
SCM_LIST2(SCM_INTERN("quote"),
vm->stat.loadStat)),
SCM_OBJ(Scm_GaucheModule()),
NULL); /* ignore errors */
}
}
ScmObj Scm_ComparatorHashFunction(ScmComparator *cmpr)
{
if (SCM_FALSEP(cmpr->hashFn)) {
static ScmObj p = SCM_UNDEFINED;
SCM_BIND_PROC(p, "comparator-hash-function",
Scm_GaucheModule());
return Scm_ApplyRec1(p, SCM_OBJ(cmpr)); /* this fills hashFn */
} else {
return cmpr->hashFn;
}
}
ScmObj Scm_ComparatorOrderingPredicate(ScmComparator *cmpr)
{
if (SCM_FALSEP(cmpr->orderFn)) {
static ScmObj p = SCM_UNDEFINED;
SCM_BIND_PROC(p, "comparator-ordering-predicate",
Scm_GaucheModule());
return Scm_ApplyRec1(p, SCM_OBJ(cmpr)); /* this fills orderFn */
} else {
return cmpr->orderFn;
}
}
/* C-level accessors, that take care of on-demand filling of slots. */
ScmObj Scm_ComparatorComparisonProcedure(ScmComparator *cmpr)
{
if (SCM_FALSEP(cmpr->compareFn)) {
static ScmObj p = SCM_UNDEFINED;
SCM_BIND_PROC(p, "comparator-comparison-procedure",
Scm_GaucheModule());
return Scm_ApplyRec1(p, SCM_OBJ(cmpr)); /* this fills compareFn */
} else {
return cmpr->compareFn;
}
}
/*
* Initialization
*/
void Scm__InitCollection(void)
{
ScmModule *mod = Scm_GaucheModule();
Scm_InitStaticClass(&Scm_CollectionClass, "<collection>",
mod, NULL, 0);
Scm_InitStaticClass(&Scm_SequenceClass, "<sequence>",
mod, NULL, 0);
Scm_InitStaticClass(&Scm_DictionaryClass, "<dictionary>",
mod, NULL, 0);
Scm_InitStaticClass(&Scm_OrderedDictionaryClass, "<ordered-dictionary>",
mod, NULL, 0);
}
/*
* Entry point of initlalizing Gauche runtime
*/
void Scm_Init(const char *signature)
{
/* make sure the main program links the same version of libgauche */
if (strcmp(signature, GAUCHE_SIGNATURE) != 0) {
Scm_Panic("libgauche ABI version mismatch: libgauche %s, expected %s",
GAUCHE_SIGNATURE, signature);
}
/* Some platforms require this. It is harmless if GC is
already initialized, so we call it here just in case. */
GC_init();
/* Set up GC parameters. We need to call finalizers at the safe
point of VM loop, so we disable auto finalizer invocation, and
ask GC to call us back when finalizers are queued. */
GC_oom_fn = oom_handler;
GC_finalize_on_demand = TRUE;
GC_finalizer_notifier = finalizable;
(void)SCM_INTERNAL_MUTEX_INIT(cond_features.mutex);
/* Initialize components. The order is important, for some components
rely on the other components to be initialized. */
Scm__InitParameter();
Scm__InitVM();
Scm__InitSymbol();
Scm__InitModule();
Scm__InitNumber();
Scm__InitChar();
Scm__InitClass();
Scm__InitModulePost();
Scm__InitCollection();
Scm__InitExceptions();
Scm__InitProc();
Scm__InitPort();
Scm__InitWrite();
Scm__InitCode();
Scm__InitMacro();
Scm__InitLoad();
Scm__InitRegexp();
Scm__InitRead();
Scm__InitSignal();
Scm__InitSystem();
Scm_Init_libalpha();
Scm_Init_libbool();
Scm_Init_libchar();
Scm_Init_libcode();
Scm_Init_libdict();
Scm_Init_libeval();
Scm_Init_libexc();
Scm_Init_libfmt();
Scm_Init_libio();
Scm_Init_liblazy();
Scm_Init_liblist();
Scm_Init_libmisc();
Scm_Init_libmod();
Scm_Init_libnum();
Scm_Init_libobj();
Scm_Init_libproc();
Scm_Init_librx();
Scm_Init_libstr();
Scm_Init_libsym();
Scm_Init_libsys();
Scm_Init_libvec();
Scm_Init_compile();
Scm_Init_libomega();
Scm__InitCompaux();
Scm_SelectModule(Scm_GaucheModule());
Scm__InitAutoloads();
Scm_SelectModule(Scm_UserModule());
/* Final setup of cond-features alist. */
init_cond_features();
#ifdef GAUCHE_USE_PTHREADS
/* a trick to make sure the gc thread object is linked */
ptr_pthread_create = (int (*)(void))GC_pthread_create;
#endif
}
