Merge commit '29776e85da637ec4d44b2b2822d6934a50c0084b' into boehm-demers-weiser-gc

[bpt/guile.git] / libguile / init.c

diff --git a/libguile/init.c b/libguile/init.c
index 69e1320..d9d7524 100644 (file)
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006 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
@@ -12,7 +12,7 @@
  *
  * 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
  */
 
 
@@ -46,7 +46,9 @@
 #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"
@@ -63,7 +65,7 @@
 #include "libguile/hash.h"
 #include "libguile/hashtab.h"
 #include "libguile/hooks.h"
-#include "libguile/i18n.h"
+#include "libguile/gettext.h"
 #include "libguile/iselect.h"
 #include "libguile/ioext.h"
 #include "libguile/keywords.h"
@@ -125,6 +127,7 @@
 #include "libguile/deprecated.h"
 
 #include "libguile/init.h"
+#include "libguile/private-options.h"
 
 #ifdef HAVE_STRING_H
 #include <string.h>
@@ -339,6 +342,7 @@ static void *invoke_main_func(void *body_data);
 void
 scm_boot_guile (int argc, char ** argv, void (*main_func) (), void *closure)
 {
+  void *res;
   struct main_func_closure c;
 
   c.main_func = main_func;
@@ -346,7 +350,15 @@ scm_boot_guile (int argc, char ** argv, void (*main_func) (), void *closure)
   c.argc = argc;
   c.argv = argv;
 
-  scm_with_guile (invoke_main_func, &c);
+  res = scm_with_guile (invoke_main_func, &c);
+
+  /* If the caller doesn't want this, they should exit from main_func
+     themselves.
+  */
+  if (res == NULL)
+    exit (EXIT_FAILURE);
+  else
+    exit (0);
 }
 
 static void *
@@ -365,13 +377,9 @@ invoke_main_func (void *body_data)
    */
   SCM_ASYNC_TICK;
 
-  /* If the caller doesn't want this, they should exit from main_func
-     themselves.
-  */
-  exit (0);
-
-  /* never reached */
-  return NULL;
+  /* Indicate success by returning non-NULL.
+   */
+  return (void *)1;
 }
 
 scm_i_pthread_mutex_t scm_i_init_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
@@ -387,6 +395,14 @@ really_cleanup_for_exit (void *unused)
 static void
 cleanup_for_exit ()
 {
+  if (scm_i_pthread_mutex_trylock (&scm_i_init_mutex) == 0)
+    scm_i_pthread_mutex_unlock (&scm_i_init_mutex);
+  else
+    {
+      fprintf (stderr, "Cannot exit gracefully when init is in progress; aborting.\n");
+      abort ();
+    }
+
   /* This function might be called in non-guile mode, so we need to
      enter it temporarily. 
   */
@@ -412,14 +428,14 @@ scm_i_init_guile (SCM_STACKITEM *base)
                "but doesn't seem to here.\n");
     }
 
-  scm_block_gc = 1;
-
   scm_storage_prehistory ();
   scm_threads_prehistory (base);
   scm_ports_prehistory ();
   scm_smob_prehistory ();
   scm_fluids_prehistory ();
-  scm_hashtab_prehistory ();   /* requires storage_prehistory */
+  scm_weaks_prehistory ();
+  scm_hashtab_prehistory ();   /* requires storage_prehistory, and
+                                  weaks_prehistory */
 #ifdef GUILE_DEBUG_MALLOC
   scm_debug_malloc_prehistory ();
 #endif
@@ -430,9 +446,10 @@ scm_i_init_guile (SCM_STACKITEM *base)
   
   scm_struct_prehistory ();      /* requires storage */
   scm_symbols_prehistory ();      /* requires storage */
-  scm_weaks_prehistory ();       /* requires storage */
   scm_init_subr_table ();
+#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 ();
@@ -441,7 +458,9 @@ scm_i_init_guile (SCM_STACKITEM *base)
   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 ();
@@ -453,12 +472,17 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_dynwind ();
   scm_init_eq ();
   scm_init_error ();
+#if 0
+  /* See futures.h for a comment why futures are not enabled.
+   */
   scm_init_futures ();
+#endif
   scm_init_fluids ();
   scm_init_feature ();          /* Requires fluids */
   scm_init_backtrace ();       /* Requires fluids */
   scm_init_fports ();
   scm_init_strports ();
+  scm_init_ports ();
   scm_init_gdbint ();           /* Requires strports */
   scm_init_hash ();
   scm_init_hashtab ();
@@ -467,7 +491,7 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_properties ();
   scm_init_hooks ();            /* Requires smob_prehistory */
   scm_init_gc ();              /* Requires hooks, async */
-  scm_init_i18n ();
+  scm_init_gettext ();
   scm_init_ioext ();
   scm_init_keywords ();
   scm_init_list ();
@@ -477,7 +501,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_numbers ();
   scm_init_options ();
   scm_init_pairs ();
-  scm_init_ports ();
 #ifdef HAVE_POSIX
   scm_init_filesys ();
   scm_init_posix ();
@@ -543,9 +566,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
 
   scm_initialized_p = 1;
 
-  scm_block_gc = 0;            /* permit the gc to run */
-  /* ints still disabled */
-
 #ifdef STACK_CHECKING
   scm_stack_checking_enabled_p = SCM_STACK_CHECKING_P;
 #endif