*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#include "libguile/hash.h"
#include "libguile/hashtab.h"
#include "libguile/hooks.h"
+#include "libguile/i18n.h"
#include "libguile/iselect.h"
#include "libguile/ioext.h"
#include "libguile/keywords.h"
#include "libguile/weaks.h"
#include "libguile/guardians.h"
#include "libguile/extensions.h"
+#include "libguile/srfi-4.h"
#include "libguile/discouraged.h"
#include "libguile/deprecated.h"
#include <unistd.h>
#endif
\f
-/* 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
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"));
}
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.
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;
c.argc = argc;
c.argv = argv;
- scm_boot_guile_1 (&dummy, &c);
+ scm_with_guile (invoke_main_func, &c);
}
-void
-scm_init_guile ()
+static void *
+invoke_main_func (void *body_data)
{
- scm_init_guile_1 ((SCM_STACKITEM *)scm_get_stack_base ());
+ 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
-scm_init_guile_1 (SCM_STACKITEM *base)
+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_i_init_guile (SCM_STACKITEM *base)
{
if (scm_initialized_p)
return;
"but doesn't seem to here.\n");
}
- 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 ();
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 ();
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 ();
scm_init_properties ();
scm_init_hooks (); /* Requires smob_prehistory */
scm_init_gc (); /* Requires hooks, async */
+ scm_init_i18n ();
scm_init_ioext ();
scm_init_keywords ();
scm_init_list ();
scm_init_evalext ();
scm_init_debug (); /* Requires macro smobs */
scm_init_random ();
-#if SCM_HAVE_ARRAYS
scm_init_ramap ();
scm_init_unif ();
-#endif
scm_init_simpos ();
scm_init_load_path ();
scm_init_standard_ports (); /* Requires fports */
scm_init_lang ();
#endif /* SCM_ENABLE_ELISP */
scm_init_script ();
+ scm_init_srfi_4 ();
scm_init_goops ();
scm_i_init_deprecated ();
#endif
- scm_initialized_p = 1;
+ scm_init_threads_default_dynamic_state ();
- scm_block_gc = 0; /* permit the gc to run */
- /* ints still disabled */
+ scm_initialized_p = 1;
#ifdef STACK_CHECKING
scm_stack_checking_enabled_p = SCM_STACK_CHECKING_P;
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"
HCoop / bpt / guile.git / blobdiff