threadsafe port revealed counts
[bpt/guile.git] / libguile / init.c
index 781c181..02dbb99 100644 (file)
@@ -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 <config.h>
 #endif
 
+#include <stdlib.h>
 #include <stdio.h>
 #include <sys/stat.h>
 #include <fcntl.h>
@@ -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
 #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"
 #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/modules.h"
 #include "libguile/net_db.h"
 #include "libguile/numbers.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
@@ -91,8 +97,8 @@
 #include "libguile/print.h"
 #include "libguile/procprop.h"
 #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"
 #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/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"
 #ifdef HAVE_UNISTD_H
 #include <unistd.h>
 #endif
-\f
-
-
-#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
 
 
 \f
@@ -187,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. */
@@ -195,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;
@@ -212,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))
@@ -253,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"));
 }
 
 
@@ -322,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
@@ -364,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 *
@@ -416,88 +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_smob_prehistory ();
-  scm_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 */
-  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 ();
   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_promises ();
-  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 ();
@@ -506,74 +462,61 @@ 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_bootstrap_vm ();
-
-  scm_init_strings ();  /* Requires array-handle */
-  scm_init_struct ();   /* Requires strings */
-  scm_init_frames ();
+  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_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_standard_ports ();  /* Requires fports */
-  scm_init_memoize ();
-  scm_init_eval ();
+  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_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 ();
@@ -581,6 +524,11 @@ scm_i_init_guile (SCM_STACKITEM *base)
 
   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 ();
 }
 
 /*