mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-14 07:30:32 +02:00
See ChangeLog from 2005-03-02.
This commit is contained in:
Marius Vollmer
parent
cb1cfc42a4
commit
9de87eea47
67 changed files with 3044 additions and 2606 deletions
188
libguile/init.c
188
libguile/init.c
|
|
@ -133,46 +133,6 @@
|
|||
#include <unistd.h>
|
||||
#endif
|
||||
|
||||
/* Setting up the stack. */
|
||||
|
||||
static void
|
||||
restart_stack (void *base)
|
||||
{
|
||||
scm_dynwinds = SCM_EOL;
|
||||
SCM_DYNENV (scm_rootcont) = SCM_EOL;
|
||||
SCM_THROW_VALUE (scm_rootcont) = SCM_EOL;
|
||||
SCM_DFRAME (scm_rootcont) = scm_last_debug_frame = 0;
|
||||
SCM_BASE (scm_rootcont) = base;
|
||||
}
|
||||
|
||||
static void
|
||||
start_stack (void *base)
|
||||
{
|
||||
SCM root;
|
||||
|
||||
root = scm_permanent_object (scm_make_root (SCM_UNDEFINED));
|
||||
scm_set_root (SCM_ROOT_STATE (root));
|
||||
scm_stack_base = base;
|
||||
|
||||
scm_exitval = SCM_BOOL_F; /* vestigial */
|
||||
|
||||
scm_root->fluids = scm_i_make_initial_fluids ();
|
||||
|
||||
/* Create an object to hold the root continuation.
|
||||
*/
|
||||
{
|
||||
scm_t_contregs *contregs = scm_gc_malloc (sizeof (scm_t_contregs),
|
||||
"continuation");
|
||||
contregs->num_stack_items = 0;
|
||||
contregs->seq = 0;
|
||||
SCM_NEWSMOB (scm_rootcont, scm_tc16_continuation, contregs);
|
||||
}
|
||||
|
||||
/* The remainder of stack initialization is factored out to another
|
||||
* function so that if this stack is ever exitted, it can be
|
||||
* re-entered using restart_stack. */
|
||||
restart_stack (base);
|
||||
}
|
||||
|
||||
|
||||
#if 0
|
||||
|
|
@ -283,18 +243,18 @@ scm_init_standard_ports ()
|
|||
buffered input on stdin can reset \ex{(current-input-port)} to
|
||||
block buffering for higher performance. */
|
||||
|
||||
scm_cur_inp
|
||||
= scm_standard_stream_to_port (0,
|
||||
isatty (0) ? "r0" : "r",
|
||||
"standard input");
|
||||
scm_cur_outp = scm_standard_stream_to_port (1,
|
||||
isatty (1) ? "w0" : "w",
|
||||
"standard output");
|
||||
scm_cur_errp = scm_standard_stream_to_port (2,
|
||||
isatty (2) ? "w0" : "w",
|
||||
"standard error");
|
||||
|
||||
scm_cur_loadp = SCM_BOOL_F;
|
||||
scm_set_current_input_port
|
||||
(scm_standard_stream_to_port (0,
|
||||
isatty (0) ? "r0" : "r",
|
||||
"standard input"));
|
||||
scm_set_current_output_port
|
||||
(scm_standard_stream_to_port (1,
|
||||
isatty (1) ? "w0" : "w",
|
||||
"standard output"));
|
||||
scm_set_current_error_port
|
||||
(scm_standard_stream_to_port (2,
|
||||
isatty (2) ? "w0" : "w",
|
||||
"standard error"));
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -345,11 +305,7 @@ struct main_func_closure
|
|||
char **argv; /* the argument list it should receive */
|
||||
};
|
||||
|
||||
|
||||
static void scm_init_guile_1 (SCM_STACKITEM *base);
|
||||
static void scm_boot_guile_1 (SCM_STACKITEM *base,
|
||||
struct main_func_closure *closure);
|
||||
static SCM invoke_main_func(void *body_data);
|
||||
static void *invoke_main_func(void *body_data);
|
||||
|
||||
|
||||
/* Fire up the Guile Scheme interpreter.
|
||||
|
|
@ -383,10 +339,6 @@ static SCM invoke_main_func(void *body_data);
|
|||
void
|
||||
scm_boot_guile (int argc, char ** argv, void (*main_func) (), void *closure)
|
||||
{
|
||||
/* The garbage collector uses the address of this variable as one
|
||||
end of the stack, and the address of one of its own local
|
||||
variables as the other end. */
|
||||
SCM_STACKITEM dummy;
|
||||
struct main_func_closure c;
|
||||
|
||||
c.main_func = main_func;
|
||||
|
|
@ -394,19 +346,55 @@ scm_boot_guile (int argc, char ** argv, void (*main_func) (), void *closure)
|
|||
c.argc = argc;
|
||||
c.argv = argv;
|
||||
|
||||
scm_boot_guile_1 (&dummy, &c);
|
||||
scm_with_guile (invoke_main_func, &c);
|
||||
}
|
||||
|
||||
static void *
|
||||
invoke_main_func (void *body_data)
|
||||
{
|
||||
struct main_func_closure *closure = (struct main_func_closure *) body_data;
|
||||
|
||||
scm_set_program_arguments (closure->argc, closure->argv, 0);
|
||||
(*closure->main_func) (closure->closure, closure->argc, closure->argv);
|
||||
|
||||
scm_restore_signals ();
|
||||
|
||||
/* This tick gives any pending
|
||||
* asyncs a chance to run. This must be done after
|
||||
* the call to scm_restore_signals.
|
||||
*/
|
||||
SCM_ASYNC_TICK;
|
||||
|
||||
/* If the caller doesn't want this, they should exit from main_func
|
||||
themselves.
|
||||
*/
|
||||
exit (0);
|
||||
|
||||
/* never reached */
|
||||
return NULL;
|
||||
}
|
||||
|
||||
scm_i_pthread_mutex_t scm_i_init_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
|
||||
int scm_initialized_p = 0;
|
||||
|
||||
static void *
|
||||
really_cleanup_for_exit (void *unused)
|
||||
{
|
||||
scm_flush_all_ports ();
|
||||
return NULL;
|
||||
}
|
||||
|
||||
static void
|
||||
cleanup_for_exit ()
|
||||
{
|
||||
/* This function might be called in non-guile mode, so we need to
|
||||
enter it temporarily.
|
||||
*/
|
||||
scm_with_guile (really_cleanup_for_exit, NULL);
|
||||
}
|
||||
|
||||
void
|
||||
scm_init_guile ()
|
||||
{
|
||||
scm_init_guile_1 ((SCM_STACKITEM *)scm_get_stack_base ());
|
||||
}
|
||||
|
||||
int scm_initialized_p = 0;
|
||||
|
||||
static void
|
||||
scm_init_guile_1 (SCM_STACKITEM *base)
|
||||
scm_i_init_guile (SCM_STACKITEM *base)
|
||||
{
|
||||
if (scm_initialized_p)
|
||||
return;
|
||||
|
|
@ -427,9 +415,10 @@ scm_init_guile_1 (SCM_STACKITEM *base)
|
|||
scm_block_gc = 1;
|
||||
|
||||
scm_storage_prehistory ();
|
||||
scm_threads_prehistory ();
|
||||
scm_threads_prehistory (base);
|
||||
scm_ports_prehistory ();
|
||||
scm_smob_prehistory ();
|
||||
scm_fluids_prehistory ();
|
||||
scm_hashtab_prehistory (); /* requires storage_prehistory */
|
||||
#ifdef GUILE_DEBUG_MALLOC
|
||||
scm_debug_malloc_prehistory ();
|
||||
|
|
@ -448,13 +437,11 @@ scm_init_guile_1 (SCM_STACKITEM *base)
|
|||
scm_init_variable (); /* all bindings need variables */
|
||||
scm_init_continuations ();
|
||||
scm_init_root (); /* requires continuations */
|
||||
scm_init_threads (base);
|
||||
start_stack (base);
|
||||
scm_init_threads (); /* requires fluids */
|
||||
scm_init_gsubr ();
|
||||
scm_init_thread_procs (); /* requires gsubrs */
|
||||
scm_init_procprop ();
|
||||
scm_init_environments ();
|
||||
scm_init_feature ();
|
||||
scm_init_alist ();
|
||||
scm_init_arbiters ();
|
||||
scm_init_async ();
|
||||
|
|
@ -466,8 +453,9 @@ scm_init_guile_1 (SCM_STACKITEM *base)
|
|||
scm_init_dynwind ();
|
||||
scm_init_eq ();
|
||||
scm_init_error ();
|
||||
scm_init_fluids ();
|
||||
scm_init_futures ();
|
||||
scm_init_fluids ();
|
||||
scm_init_feature (); /* Requires fluids */
|
||||
scm_init_backtrace (); /* Requires fluids */
|
||||
scm_init_fports ();
|
||||
scm_init_strports ();
|
||||
|
|
@ -551,6 +539,8 @@ scm_init_guile_1 (SCM_STACKITEM *base)
|
|||
scm_i_init_deprecated ();
|
||||
#endif
|
||||
|
||||
scm_init_threads_default_dynamic_state ();
|
||||
|
||||
scm_initialized_p = 1;
|
||||
|
||||
scm_block_gc = 0; /* permit the gc to run */
|
||||
|
|
@ -564,54 +554,10 @@ scm_init_guile_1 (SCM_STACKITEM *base)
|
|||
scm_init_rw ();
|
||||
scm_init_extensions ();
|
||||
|
||||
atexit (cleanup_for_exit);
|
||||
scm_load_startup_files ();
|
||||
}
|
||||
|
||||
/* Record here whether SCM_BOOT_GUILE_1 has already been called. This
|
||||
variable is now here and not inside SCM_BOOT_GUILE_1 so that one
|
||||
can tweak it. This is necessary for unexec to work. (Hey, "1-live"
|
||||
is the name of a local radiostation...) */
|
||||
|
||||
int scm_boot_guile_1_live = 0;
|
||||
|
||||
static void
|
||||
scm_boot_guile_1 (SCM_STACKITEM *base, struct main_func_closure *closure)
|
||||
{
|
||||
scm_init_guile_1 (base);
|
||||
|
||||
/* This function is not re-entrant. */
|
||||
if (scm_boot_guile_1_live)
|
||||
abort ();
|
||||
|
||||
scm_boot_guile_1_live = 1;
|
||||
|
||||
scm_set_program_arguments (closure->argc, closure->argv, 0);
|
||||
invoke_main_func (closure);
|
||||
|
||||
scm_restore_signals ();
|
||||
|
||||
/* This tick gives any pending
|
||||
* asyncs a chance to run. This must be done after
|
||||
* the call to scm_restore_signals.
|
||||
*/
|
||||
SCM_ASYNC_TICK;
|
||||
|
||||
/* If the caller doesn't want this, they should return from
|
||||
main_func themselves. */
|
||||
exit (0);
|
||||
}
|
||||
|
||||
static SCM
|
||||
invoke_main_func (void *body_data)
|
||||
{
|
||||
struct main_func_closure *closure = (struct main_func_closure *) body_data;
|
||||
|
||||
(*closure->main_func) (closure->closure, closure->argc, closure->argv);
|
||||
|
||||
/* never reached */
|
||||
return SCM_UNDEFINED;
|
||||
}
|
||||
|
||||
/*
|
||||
Local Variables:
|
||||
c-file-style: "gnu"
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue