int
main_name (int argc, const char ** argv)
{
init_exit_scheme ();
scheme_program_name = (argv[0]);
initial_C_stack_pointer = ((void *) (&argc));
#ifdef __WIN32__
NT_initialize_win32_system_utilities ();
#endif
#ifdef PREALLOCATE_HEAP_MEMORY
PREALLOCATE_HEAP_MEMORY ();
#endif
#ifdef __OS2__
OS2_initialize_early ();
#endif
obstack_init (&scratch_obstack);
obstack_init (&ffi_obstack);
dstack_initialize ();
transaction_initialize ();
reload_saved_string = 0;
reload_saved_string_length = 0;
read_command_line_options (argc, argv);
setup_memory ((BLOCKS_TO_BYTES (option_heap_size)),
(BLOCKS_TO_BYTES (option_stack_size)),
(BLOCKS_TO_BYTES (option_constant_size)));
initialize_primitives ();
compiler_initialize (option_fasl_file != 0);
OS_initialize ();
start_scheme ();
termination_init_error ();
return (0);
}
static void
defsignal (int signo, const char * name, enum dfl_action action, int flags)
{
if (signo == 0)
return;
if (signal_descriptors_length == signal_descriptors_limit)
{
signal_descriptors_limit += 8;
signal_descriptors =
(UX_realloc (signal_descriptors,
(signal_descriptors_limit *
(sizeof (struct signal_descriptor)))));
if (signal_descriptors == 0)
{
fprintf (stderr, "\nUnable to grow signal definitions table.\n");
fflush (stderr);
termination_init_error ();
}
}
{
struct signal_descriptor * sd =
(signal_descriptors + (signal_descriptors_length++));
(sd -> signo) = signo;
(sd -> name) = name;
(sd -> action) = action;
(sd -> flags) = flags;
}
}
void
OS2_initialize_malloc (void)
{
if (((DosAllocMem ((&malloc_object),
malloc_object_size,
(PAG_EXECUTE | PAG_READ | PAG_WRITE)))
!= NO_ERROR)
|| ((DosSubSetMem (malloc_object,
(DOSSUB_INIT | DOSSUB_SPARSE_OBJ | DOSSUB_SERIALIZE),
malloc_object_size))
!= NO_ERROR))
termination_init_error ();
}
static void
initialize_signal_descriptors (void)
{
signal_descriptors_length = 0;
signal_descriptors_limit = 32;
signal_descriptors =
(UX_malloc (signal_descriptors_limit *
(sizeof (struct signal_descriptor))));
if (signal_descriptors == 0)
{
fprintf (stderr, "\nUnable to allocate signal definitions table.\n");
fflush (stderr);
termination_init_error ();
}
defsignal (SIGHUP, "SIGHUP", dfl_terminate, 0);
defsignal (SIGINT, "SIGINT", dfl_terminate, 0);
defsignal (SIGQUIT, "SIGQUIT", dfl_terminate, CORE_DUMP);
defsignal (SIGILL, "SIGILL", dfl_terminate, CORE_DUMP);
defsignal (SIGTRAP, "SIGTRAP", dfl_terminate, CORE_DUMP);
defsignal (SIGIOT, "SIGIOT", dfl_terminate, CORE_DUMP);
defsignal (SIGEMT, "SIGEMT", dfl_terminate, CORE_DUMP);
#ifdef HAVE_SIGFPE
defsignal (SIGFPE, "SIGFPE", dfl_terminate, CORE_DUMP);
#endif
defsignal (SIGKILL, "SIGKILL", dfl_terminate, (NOIGNORE | NOBLOCK | NOCATCH));
defsignal (SIGBUS, "SIGBUS", dfl_terminate, CORE_DUMP);
defsignal (SIGSEGV, "SIGSEGV", dfl_terminate, CORE_DUMP);
defsignal (SIGSYS, "SIGSYS", dfl_terminate, CORE_DUMP);
defsignal (SIGPIPE, "SIGPIPE", dfl_terminate, 0);
defsignal (SIGALRM, "SIGALRM", dfl_terminate, 0);
defsignal (SIGTERM, "SIGTERM", dfl_terminate, 0);
defsignal (SIGUSR1, "SIGUSR1", dfl_terminate, 0);
defsignal (SIGUSR2, "SIGUSR2", dfl_terminate, 0);
defsignal (SIGABRT, "SIGABRT", dfl_terminate, CORE_DUMP);
defsignal (SIGIO, "SIGIO", dfl_ignore, 0);
defsignal (SIGURG, "SIGURG", dfl_ignore, 0);
defsignal (SIGVTALRM, "SIGVTALRM", dfl_terminate, 0);
defsignal (SIGPROF, "SIGPROF", dfl_terminate, 0);
defsignal (SIGSTOP, "SIGSTOP", dfl_stop, (NOIGNORE | NOBLOCK | NOCATCH));
defsignal (SIGTSTP, "SIGTSTP", dfl_stop, 0);
defsignal (SIGCONT, "SIGCONT", dfl_ignore, (NOIGNORE | NOBLOCK));
defsignal (SIGCHLD, "SIGCHLD", dfl_ignore, 0);
defsignal (SIGTTIN, "SIGTTIN", dfl_stop, 0);
defsignal (SIGTTOU, "SIGTTOU", dfl_stop, 0);
defsignal (SIGLOST, "SIGLOST", dfl_terminate, 0);
defsignal (SIGXCPU, "SIGXCPU", dfl_terminate, 0);
defsignal (SIGXFSZ, "SIGXFSZ", dfl_terminate, 0);
defsignal (SIGPWR, "SIGPWR", dfl_ignore, 0);
defsignal (SIGWINDOW, "SIGWINDOW", dfl_ignore, 0);
defsignal (SIGWINCH, "SIGWINCH", dfl_ignore, 0);
}
void
abort_to_interpreter (int argument)
{
if (interpreter_state == NULL_INTERPRETER_STATE)
{
outf_fatal ("abort_to_interpreter: Interpreter not set up.\n");
termination_init_error ();
}
interpreter_throw_argument = argument;
{
unsigned long old_mask = GET_INT_MASK;
SET_INTERRUPT_MASK (0);
dstack_set_position (interpreter_catch_dstack_position);
SET_INTERRUPT_MASK (old_mask);
}
obstack_free ((&scratch_obstack), 0);
obstack_init (&scratch_obstack);
longjmp (interpreter_catch_env, argument);
}
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 ();
}
