void
NT_initialize_fov (SCHEME_OBJECT fov)
{
int ctr, in;
SCHEME_OBJECT iv, imv, prim;
static int interrupt_numbers[2] =
{
Global_GC_Level,
Global_1_Level,
};
static long interrupt_masks[2] =
{
0, /* No interrupts allowed */
(INT_Stack_Overflow | INT_Global_GC | INT_GC),
};
iv = (VECTOR_REF (fov, SYSTEM_INTERRUPT_VECTOR));
imv = (VECTOR_REF (fov, FIXOBJ_INTERRUPT_MASK_VECTOR));
prim = (make_primitive ("MICROCODE-POLL-INTERRUPT-HANDLER", 2));
for (ctr = 0; ctr < ((sizeof (interrupt_numbers)) / (sizeof (int))); ctr++)
{
in = interrupt_numbers[ctr];
VECTOR_SET (iv, in, prim);
VECTOR_SET (imv, in, (long_to_integer (interrupt_masks[ctr])));
}
return;
}
static void add_primitive(void *root, Obj **env, char *name, Primitive *fn) {
DEFINE2(sym, prim);
*sym = intern(root, name);
*prim = make_primitive(root, fn);
add_variable(root, env, sym, prim);
}
void add_primitive(Env *env, Obj *root, char *name, Primitive *fn) {
VAR(prim);
*prim = make_primitive(env, root, fn);
add_var(env, root, name, prim);
}
void create_primitives() {
make_primitive(create_symbol("car"), prim_car);
make_primitive(create_symbol("cdr"), prim_cdr);
make_primitive(create_symbol("cons"), prim_cons);
make_primitive(create_symbol("+"), prim_add);
make_primitive(create_symbol("-"), prim_sub);
make_primitive(create_symbol("*"), prim_mul);
make_primitive(create_symbol("fixnum?"), prim_fixnump);
make_primitive(create_symbol("character?"), prim_characterp);
make_primitive(create_symbol("boolean?"), prim_booleanp);
make_primitive(create_symbol("symbol?"), prim_symbolp);
make_primitive(create_symbol("string?"), prim_stringp);
make_primitive(create_symbol("cons?"), prim_consp);
make_primitive(create_symbol("function?"), prim_functionp);
}
static void
start_scheme (void)
{
SCHEME_OBJECT expr;
if (!option_batch_mode && !option_show_version && !option_show_help)
{
outf_console ("MIT/GNU Scheme running under %s\n", OS_Variant);
OS_announcement ();
outf_console ("\n");
outf_flush_console ();
}
initialize_fixed_objects_vector ();
if (option_fasl_file != 0)
{
#ifdef CC_IS_C
/* (SCODE-EVAL (INITIALIZE-C-COMPILED-BLOCK <file>) GLOBAL-ENV) */
SCHEME_OBJECT prim1 = (make_primitive ("INITIALIZE-C-COMPILED-BLOCK", 1));
#else
/* (SCODE-EVAL (BINARY-FASLOAD <file>) GLOBAL-ENV) */
SCHEME_OBJECT prim1 = (make_primitive ("BINARY-FASLOAD", 1));
#endif
SCHEME_OBJECT fn_object = (char_pointer_to_string (option_fasl_file));
SCHEME_OBJECT prim2 = (make_primitive ("SCODE-EVAL", 2));
SCHEME_OBJECT * inner_arg = Free;
(*Free++) = prim1;
(*Free++) = fn_object;
expr = (MAKE_POINTER_OBJECT (TC_PCOMB2, Free));
(*Free++) = prim2;
(*Free++) = (MAKE_POINTER_OBJECT (TC_PCOMB1, inner_arg));
(*Free++) = THE_GLOBAL_ENV;
}
else
{
/* (LOAD-BAND <file>) */
SCHEME_OBJECT prim = (make_primitive ("LOAD-BAND", 1));
SCHEME_OBJECT fn_object = (char_pointer_to_string (option_band_file));
expr = (MAKE_POINTER_OBJECT (TC_PCOMB1, Free));
(*Free++) = prim;
(*Free++) = fn_object;
}
/* Setup registers */
INITIALIZE_INTERRUPTS (0);
SET_ENV (THE_GLOBAL_ENV);
trapping = false;
/* Give the interpreter something to chew on, and ... */
Will_Push (CONTINUATION_SIZE);
SET_RC (RC_END_OF_COMPUTATION);
SET_EXP (SHARP_F);
SAVE_CONT ();
Pushed ();
SET_EXP (expr);
/* Go to it! */
if (! ((SP_OK_P (stack_pointer)) && (Free <= heap_alloc_limit)))
{
outf_fatal ("Configuration won't hold initial data.\n");
termination_init_error ();
}
ENTRY_HOOK ();
Enter_Interpreter ();
}
