X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/dc3e203e075a2713791a1c5593c67b9296214156..b262d3065c03cbde552cdfbce5819544f2e2dfea:/libguile/init.c diff --git a/libguile/init.c b/libguile/init.c index 6313b6544..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, 2010 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 @@ -87,6 +88,7 @@ #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 @@ -97,7 +99,6 @@ #include "libguile/procs.h" #include "libguile/programs.h" #include "libguile/promises.h" -#include "libguile/properties.h" #include "libguile/array-map.h" #include "libguile/random.h" #include "libguile/rdelim.h" @@ -114,8 +115,11 @@ #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" @@ -129,12 +133,9 @@ #include "libguile/version.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" @@ -146,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 @@ -192,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. */ @@ -200,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; @@ -217,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)) @@ -258,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")); } @@ -327,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 @@ -369,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 * @@ -421,31 +375,18 @@ 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); /* requires storage_prehistory */ - scm_weaks_prehistory (); /* requires storage_prehistory */ + scm_weak_table_prehistory (); /* requires storage_prehistory */ #ifdef GUILE_DEBUG_MALLOC scm_debug_malloc_prehistory (); #endif - scm_symbols_prehistory (); /* requires weaks_prehistory */ + scm_symbols_prehistory (); /* requires weak_table_prehistory */ scm_modules_prehistory (); scm_init_array_handle (); scm_bootstrap_bytevectors (); /* Requires array-handle */ @@ -453,7 +394,11 @@ scm_i_init_guile (SCM_STACKITEM *base) 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 */ @@ -488,9 +433,9 @@ scm_i_init_guile (SCM_STACKITEM *base) scm_init_deprecation (); scm_init_objprop (); scm_init_promises (); /* requires smob_prehistory */ - scm_init_properties (); scm_init_hooks (); /* Requires smob_prehistory */ - scm_init_gc (); /* Requires hooks */ + 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 (); @@ -503,8 +448,8 @@ scm_i_init_guile (SCM_STACKITEM *base) scm_init_numbers (); scm_init_options (); scm_init_pairs (); -#ifdef HAVE_POSIX scm_init_filesys (); /* Requires smob_prehistory */ +#ifdef HAVE_POSIX scm_init_posix (); #endif #ifdef HAVE_REGCOMP @@ -536,14 +481,15 @@ scm_i_init_guile (SCM_STACKITEM *base) scm_init_load (); /* Requires strings */ scm_init_print (); /* Requires strings, struct, smob */ scm_init_read (); - scm_init_stime (); scm_init_strorder (); scm_init_srfi_13 (); scm_init_srfi_14 (); /* Requires smob_prehistory */ scm_init_throw (); /* Requires smob_prehistory */ scm_init_trees (); scm_init_version (); - scm_init_weaks (); + scm_init_weak_set (); + scm_init_weak_table (); + scm_init_weak_vectors (); scm_init_guardians (); /* requires smob_prehistory */ scm_init_vports (); scm_init_standard_ports (); /* Requires fports */ @@ -556,27 +502,21 @@ scm_i_init_guile (SCM_STACKITEM *base) scm_init_debug (); /* Requires macro smobs */ scm_init_random (); /* Requires smob_prehistory */ scm_init_simpos (); +#if HAVE_MODULES scm_init_dynamic_linking (); /* Requires smob_prehistory */ +#endif scm_bootstrap_i18n (); 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 (); @@ -584,7 +524,11 @@ scm_i_init_guile (SCM_STACKITEM *base) atexit (cleanup_for_exit); scm_load_startup_files (); - scm_init_load_should_autocompile (); + 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 (); } /*