X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/731dd0ce191bf4f3ba8fedfe0e08c0e67a966ce4..b262d3065c03cbde552cdfbce5819544f2e2dfea:/libguile/init.c diff --git a/libguile/init.c b/libguile/init.c index 68156ef28..02dbb99ec 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2009 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2009, 2010, 2011 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -25,6 +25,7 @@ # include #endif +#include #include #include #include @@ -41,6 +42,7 @@ #include "libguile/boolean.h" #include "libguile/bytevectors.h" #include "libguile/chars.h" +#include "libguile/control.h" #include "libguile/continuations.h" #include "libguile/debug.h" #ifdef GUILE_DEBUG_MALLOC @@ -49,17 +51,16 @@ #include "libguile/deprecation.h" #include "libguile/dynl.h" #include "libguile/dynwind.h" -#if 0 -#include "libguile/environments.h" -#endif #include "libguile/eq.h" #include "libguile/error.h" #include "libguile/eval.h" #include "libguile/evalext.h" +#include "libguile/expand.h" #include "libguile/feature.h" #include "libguile/filesys.h" #include "libguile/fluids.h" #include "libguile/fports.h" +#include "libguile/frames.h" #include "libguile/gc.h" #include "libguile/gdbint.h" #include "libguile/generalized-arrays.h" @@ -71,21 +72,23 @@ #include "libguile/hooks.h" #include "libguile/gettext.h" #include "libguile/i18n.h" +#include "libguile/instructions.h" #include "libguile/iselect.h" #include "libguile/ioext.h" #include "libguile/keywords.h" -#include "libguile/lang.h" #include "libguile/list.h" #include "libguile/load.h" #include "libguile/macros.h" #include "libguile/mallocs.h" +#include "libguile/memoize.h" #include "libguile/modules.h" #include "libguile/net_db.h" #include "libguile/numbers.h" -#include "libguile/objects.h" +#include "libguile/objcodes.h" #include "libguile/objprop.h" #include "libguile/options.h" #include "libguile/pairs.h" +#include "libguile/poll.h" #include "libguile/ports.h" #include "libguile/posix.h" #ifdef HAVE_REGCOMP @@ -94,7 +97,8 @@ #include "libguile/print.h" #include "libguile/procprop.h" #include "libguile/procs.h" -#include "libguile/properties.h" +#include "libguile/programs.h" +#include "libguile/promises.h" #include "libguile/array-map.h" #include "libguile/random.h" #include "libguile/rdelim.h" @@ -111,26 +115,27 @@ #include "libguile/stacks.h" #include "libguile/stime.h" #include "libguile/strings.h" +#include "libguile/srfi-1.h" +#include "libguile/srfi-4.h" #include "libguile/srfi-13.h" #include "libguile/srfi-14.h" +#include "libguile/srfi-60.h" #include "libguile/strorder.h" #include "libguile/strports.h" #include "libguile/struct.h" #include "libguile/symbols.h" #include "libguile/throw.h" #include "libguile/arrays.h" +#include "libguile/trees.h" #include "libguile/values.h" #include "libguile/variable.h" #include "libguile/vectors.h" #include "libguile/version.h" -#include "libguile/vm-bootstrap.h" +#include "libguile/vm.h" #include "libguile/vports.h" -#include "libguile/weaks.h" #include "libguile/guardians.h" #include "libguile/extensions.h" #include "libguile/uniform.h" -#include "libguile/srfi-4.h" -#include "libguile/discouraged.h" #include "libguile/deprecated.h" #include "libguile/init.h" @@ -142,43 +147,6 @@ #ifdef HAVE_UNISTD_H #include #endif - - - -#if 0 -static char remsg[] = "remove\n#define ", addmsg[] = "add\n#define "; - - -static void -fixconfig (char *s1, char *s2, int s) -{ - fputs (s1, stderr); - fputs (s2, stderr); - fputs ("\nin ", stderr); - fputs (s ? "setjump" : "scmfig", stderr); - fputs (".h and recompile scm\n", stderr); - exit (1); -} - - -static void -check_config (void) -{ - size_t j; - - j = HEAP_SEG_SIZE; - if (HEAP_SEG_SIZE != j) - fixconfig ("reduce", "size of HEAP_SEG_SIZE", 0); - -#if SCM_STACK_GROWS_UP - if (((SCM_STACKITEM *) & j - stack_start_ptr) < 0) - fixconfig (remsg, "SCM_STACK_GROWS_UP", 1); -#else - if ((stack_start_ptr - (SCM_STACKITEM *) & j) < 0) - fixconfig (addmsg, "SCM_STACK_GROWS_UP", 1); -#endif -} -#endif @@ -188,7 +156,6 @@ typedef struct { int fdes; char *mode; - char *name; } stream_body_data; /* proc to be called in scope of exception handler stream_handler. */ @@ -196,8 +163,7 @@ static SCM stream_body (void *data) { stream_body_data *body_data = (stream_body_data *) data; - SCM port = scm_fdes_to_port (body_data->fdes, body_data->mode, - scm_from_locale_string (body_data->name)); + SCM port = scm_fdes_to_port (body_data->fdes, body_data->mode, SCM_BOOL_F); SCM_REVEALED (port) = 1; return port; @@ -213,21 +179,19 @@ stream_handler (void *data SCM_UNUSED, } /* Convert a file descriptor to a port, using scm_fdes_to_port. - - NAME is a C string, not a Guile string - set the revealed count for FILE's file descriptor to 1, so that fdes won't be closed when the port object is GC'd. - catch exceptions: allow Guile to be able to start up even if it has been handed bogus stdin/stdout/stderr. replace the bad ports with void ports. */ static SCM -scm_standard_stream_to_port (int fdes, char *mode, char *name) +scm_standard_stream_to_port (int fdes, char *mode) { SCM port; stream_body_data body_data; body_data.fdes = fdes; body_data.mode = mode; - body_data.name = name; port = scm_internal_catch (SCM_BOOL_T, stream_body, &body_data, stream_handler, NULL); if (scm_is_false (port)) @@ -254,17 +218,11 @@ scm_init_standard_ports () block buffering for higher performance. */ scm_set_current_input_port - (scm_standard_stream_to_port (0, - isatty (0) ? "r0" : "r", - "standard input")); + (scm_standard_stream_to_port (0, isatty (0) ? "r0" : "r")); scm_set_current_output_port - (scm_standard_stream_to_port (1, - isatty (1) ? "w0" : "w", - "standard output")); + (scm_standard_stream_to_port (1, isatty (1) ? "w0" : "w")); scm_set_current_error_port - (scm_standard_stream_to_port (2, - isatty (2) ? "w0" : "w", - "standard error")); + (scm_standard_stream_to_port (2, isatty (2) ? "w0" : "w")); } @@ -323,8 +281,8 @@ static void *invoke_main_func(void *body_data); Call MAIN_FUNC, passing it CLOSURE, ARGC, and ARGV. MAIN_FUNC should do all the work of the program (initializing other packages, reading user input, etc.) before returning. When MAIN_FUNC - returns, call exit (0); this function never returns. If you want - some other exit value, MAIN_FUNC may call exit itself. + returns, call exit (EXIT_FAILURE); this function never returns. + If you want some other exit value, MAIN_FUNC may call exit itself. scm_boot_guile arranges for program-arguments to return the strings given by ARGC and ARGV. If MAIN_FUNC modifies ARGC/ARGV, should @@ -365,7 +323,7 @@ scm_boot_guile (int argc, char ** argv, void (*main_func) (), void *closure) if (res == NULL) exit (EXIT_FAILURE); else - exit (0); + exit (EXIT_SUCCESS); } static void * @@ -417,97 +375,85 @@ cleanup_for_exit () } void -scm_i_init_guile (SCM_STACKITEM *base) +scm_i_init_guile (void *base) { if (scm_initialized_p) return; - if (base == NULL) - { - fprintf (stderr, "cannot determine stack base!\n"); - abort (); - } - - if (sizeof (mpz_t) > (3 * sizeof (scm_t_bits))) - { - fprintf (stderr, - "GMP's mpz_t must fit into a double_cell," - "but doesn't seem to here.\n"); - } - scm_storage_prehistory (); - scm_threads_prehistory (base); - scm_ports_prehistory (); - scm_smob_prehistory (); - scm_fluids_prehistory (); - scm_weaks_prehistory (); - scm_hashtab_prehistory (); /* requires storage_prehistory, and - weaks_prehistory */ + scm_threads_prehistory (base); /* requires storage_prehistory */ + scm_weak_table_prehistory (); /* requires storage_prehistory */ #ifdef GUILE_DEBUG_MALLOC scm_debug_malloc_prehistory (); #endif - if (scm_init_storage ()) /* requires threads_prehistory, - smob_prehistory and - hashtab_prehistory */ - abort (); - - scm_struct_prehistory (); /* requires storage */ - scm_symbols_prehistory (); /* requires storage */ -#if 0 - scm_environments_prehistory (); /* requires storage */ -#endif - scm_modules_prehistory (); /* requires storage and hash tables */ - scm_init_variable (); /* all bindings need variables */ - scm_init_continuations (); + scm_symbols_prehistory (); /* requires weak_table_prehistory */ + scm_modules_prehistory (); + scm_init_array_handle (); + scm_bootstrap_bytevectors (); /* Requires array-handle */ + scm_bootstrap_instructions (); + scm_bootstrap_objcodes (); + scm_bootstrap_programs (); + scm_bootstrap_vm (); + scm_register_r6rs_ports (); + scm_register_foreign (); + scm_register_srfi_1 (); + scm_register_srfi_60 (); + scm_register_poll (); + + scm_init_strings (); /* Requires array-handle */ + scm_init_struct (); /* Requires strings */ + scm_smob_prehistory (); + scm_init_variable (); + scm_init_continuations (); /* requires smob_prehistory */ scm_init_root (); /* requires continuations */ - scm_init_threads (); /* requires fluids */ + scm_init_threads (); /* requires smob_prehistory */ scm_init_gsubr (); scm_init_thread_procs (); /* requires gsubrs */ scm_init_procprop (); -#if 0 - scm_init_environments (); -#endif scm_init_alist (); - scm_init_arbiters (); - scm_init_async (); + scm_init_arbiters (); /* requires smob_prehistory */ + scm_init_async (); /* requires smob_prehistory */ scm_init_boolean (); scm_init_chars (); #ifdef GUILE_DEBUG_MALLOC scm_init_debug_malloc (); #endif - scm_init_dynwind (); + scm_init_dynwind (); /* requires smob_prehistory */ scm_init_eq (); scm_init_error (); scm_init_fluids (); - scm_init_feature (); /* Requires fluids */ - scm_init_backtrace (); /* Requires fluids */ + scm_init_control (); /* requires fluids */ + scm_init_feature (); + scm_init_backtrace (); scm_init_fports (); scm_init_strports (); scm_init_ports (); - scm_init_gdbint (); /* Requires strports */ scm_init_hash (); scm_init_hashtab (); - scm_init_deprecation (); /* Requires hashtabs */ + scm_init_deprecation (); scm_init_objprop (); - scm_init_properties (); + scm_init_promises (); /* requires smob_prehistory */ scm_init_hooks (); /* Requires smob_prehistory */ - scm_init_gc (); /* Requires hooks, async */ + scm_init_stime (); + scm_init_gc (); /* Requires hooks and `get_internal_run_time' */ + scm_init_gc_protect_object (); /* requires threads_prehistory */ + scm_init_gdbint (); /* Requires strports, gc_protect_object */ scm_init_gettext (); scm_init_ioext (); - scm_init_keywords (); + scm_init_keywords (); /* Requires smob_prehistory */ scm_init_list (); - scm_init_macros (); - scm_init_mallocs (); - scm_init_modules (); + scm_init_macros (); /* Requires smob_prehistory */ + scm_init_mallocs (); /* Requires smob_prehistory */ + scm_init_modules (); /* Requires smob_prehistory */ scm_init_numbers (); scm_init_options (); scm_init_pairs (); + scm_init_filesys (); /* Requires smob_prehistory */ #ifdef HAVE_POSIX - scm_init_filesys (); scm_init_posix (); #endif #ifdef HAVE_REGCOMP - scm_init_regex_posix (); + scm_init_regex_posix (); /* Requires smob_prehistory */ #endif scm_init_procs (); scm_init_scmsigs (); @@ -516,78 +462,73 @@ scm_i_init_guile (SCM_STACKITEM *base) scm_init_socket (); #endif scm_init_sort (); - scm_init_srcprop (); + scm_init_srcprop (); /* requires smob_prehistory */ scm_init_stackchk (); - scm_init_array_handle (); scm_init_generalized_arrays (); scm_init_generalized_vectors (); - scm_init_vectors (); + scm_init_vectors (); /* Requires array-handle, */ scm_init_uniform (); - scm_init_bitvectors (); - scm_bootstrap_bytevectors (); - scm_init_srfi_4 (); - scm_init_arrays (); + scm_init_bitvectors (); /* Requires smob_prehistory, array-handle */ + scm_init_srfi_4 (); /* Requires smob_prehistory, array-handle */ + scm_init_arrays (); /* Requires smob_prehistory, array-handle */ scm_init_array_map (); - scm_init_strings (); /* Requires array-handle */ - scm_init_struct (); /* Requires strings */ - scm_init_stacks (); /* Requires strings, struct */ + scm_init_frames (); /* Requires smob_prehistory */ + scm_init_stacks (); /* Requires strings, struct, frames */ scm_init_symbols (); scm_init_values (); /* Requires struct */ scm_init_load (); /* Requires strings */ - scm_init_objects (); /* Requires struct */ - scm_init_print (); /* Requires strings, struct */ + scm_init_print (); /* Requires strings, struct, smob */ scm_init_read (); - scm_init_stime (); scm_init_strorder (); scm_init_srfi_13 (); - scm_init_srfi_14 (); - scm_init_throw (); + scm_init_srfi_14 (); /* Requires smob_prehistory */ + scm_init_throw (); /* Requires smob_prehistory */ + scm_init_trees (); scm_init_version (); - scm_init_weaks (); - scm_init_guardians (); + scm_init_weak_set (); + scm_init_weak_table (); + scm_init_weak_vectors (); + scm_init_guardians (); /* requires smob_prehistory */ scm_init_vports (); - scm_init_eval (); + scm_init_standard_ports (); /* Requires fports */ + scm_init_expand (); /* Requires structs */ + scm_init_memoize (); /* Requires smob_prehistory */ + scm_init_eval (); /* Requires smob_prehistory */ + scm_init_load_path (); + scm_init_eval_in_scheme (); scm_init_evalext (); scm_init_debug (); /* Requires macro smobs */ - scm_init_random (); + scm_init_random (); /* Requires smob_prehistory */ scm_init_simpos (); - scm_init_load_path (); - scm_init_standard_ports (); /* Requires fports */ - scm_init_dynamic_linking (); +#if HAVE_MODULES + scm_init_dynamic_linking (); /* Requires smob_prehistory */ +#endif scm_bootstrap_i18n (); -#if SCM_ENABLE_ELISP - scm_init_lang (); -#endif /* SCM_ENABLE_ELISP */ scm_init_script (); scm_init_goops (); -#if SCM_ENABLE_DISCOURAGED == 1 - scm_i_init_discouraged (); -#endif - #if SCM_ENABLE_DEPRECATED == 1 scm_i_init_deprecated (); #endif - scm_init_threads_default_dynamic_state (); - scm_initialized_p = 1; -#ifdef STACK_CHECKING scm_stack_checking_enabled_p = SCM_STACK_CHECKING_P; -#endif scm_init_rdelim (); scm_init_rw (); scm_init_extensions (); - scm_bootstrap_vm (); - atexit (cleanup_for_exit); scm_load_startup_files (); + scm_init_load_should_auto_compile (); + + /* Capture the dynamic state after loading boot-9, so that new threads end up + in the guile-user module. */ + scm_init_threads_default_dynamic_state (); } /*