really boot primitive-eval from scheme.
[bpt/guile.git] / libguile / init.c
index 4d25299..3712a9a 100644 (file)
@@ -1,18 +1,19 @@
-/* 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, 2009 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 as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * 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
  */
 
 
@@ -20,7 +21,7 @@
 /* Include the headers for just about everything.
    We call all their initialization functions.  */
 
-#if HAVE_CONFIG_H
+#ifdef HAVE_CONFIG_H
 #  include <config.h>
 #endif
 
@@ -36,7 +37,9 @@
 #include "libguile/arbiters.h"
 #include "libguile/async.h"
 #include "libguile/backtrace.h"
+#include "libguile/bitvectors.h"
 #include "libguile/boolean.h"
+#include "libguile/bytevectors.h"
 #include "libguile/chars.h"
 #include "libguile/continuations.h"
 #include "libguile/debug.h"
@@ -46,7 +49,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"
 #include "libguile/filesys.h"
 #include "libguile/fluids.h"
 #include "libguile/fports.h"
-#include "libguile/futures.h"
 #include "libguile/gc.h"
 #include "libguile/gdbint.h"
+#include "libguile/generalized-arrays.h"
+#include "libguile/generalized-vectors.h"
 #include "libguile/goops.h"
 #include "libguile/gsubr.h"
 #include "libguile/hash.h"
 #include "libguile/hashtab.h"
 #include "libguile/hooks.h"
+#include "libguile/gettext.h"
 #include "libguile/i18n.h"
 #include "libguile/iselect.h"
 #include "libguile/ioext.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/objprop.h"
 #include "libguile/options.h"
 #include "libguile/pairs.h"
@@ -87,8 +94,9 @@
 #include "libguile/print.h"
 #include "libguile/procprop.h"
 #include "libguile/procs.h"
+#include "libguile/promises.h"
 #include "libguile/properties.h"
-#include "libguile/ramap.h"
+#include "libguile/array-map.h"
 #include "libguile/random.h"
 #include "libguile/rdelim.h"
 #include "libguile/read.h"
 #include "libguile/struct.h"
 #include "libguile/symbols.h"
 #include "libguile/throw.h"
-#include "libguile/unif.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/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"
+#include "libguile/private-options.h"
 
 #ifdef HAVE_STRING_H
 #include <string.h>
@@ -243,18 +255,18 @@ scm_init_standard_ports ()
      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"));
 }
 
 
@@ -278,7 +290,7 @@ scm_load_startup_files ()
   /* Load Ice-9.  */
   if (!scm_ice_9_already_loaded)
     {
-      scm_primitive_load_path (scm_from_locale_string ("ice-9/boot-9.scm"));
+      scm_c_primitive_load_path ("ice-9/boot-9");
 
       /* Load the init.scm file.  */
       if (scm_is_true (init_path))
@@ -305,8 +317,6 @@ struct main_func_closure
   char **argv;                 /* the argument list it should receive */
 };
 
-static void scm_boot_guile_1 (SCM_STACKITEM *base,
-                             struct main_func_closure *closure);
 static void *invoke_main_func(void *body_data);
 
 
@@ -341,6 +351,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;
@@ -348,7 +359,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 *
@@ -367,25 +386,37 @@ invoke_main_func (void *body_data)
    */
   SCM_ASYNC_TICK;
 
-  /* If the caller doesn't want this, they should exit from main_func
-     themselves.
-  */
-  pthread_exit (NULL);
+  /* Indicate success by returning non-NULL.
+   */
+  return (void *)1;
+}
 
-  /* never reached */
+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;
 }
 
-#if 0
-void
-scm_init_guile ()
+static void
+cleanup_for_exit ()
 {
-  scm_i_init_guile ((SCM_STACKITEM *)scm_get_stack_base ());
-}
-#endif
+  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 ();
+    }
 
-pthread_mutex_t scm_i_init_mutex = PTHREAD_MUTEX_INITIALIZER;
-int scm_initialized_p = 0;
+  /* 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)
@@ -406,13 +437,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_hashtab_prehistory ();   /* requires storage_prehistory */
+  scm_fluids_prehistory ();
+  scm_weaks_prehistory ();
+  scm_hashtab_prehistory ();   /* requires storage_prehistory, and
+                                  weaks_prehistory */
 #ifdef GUILE_DEBUG_MALLOC
   scm_debug_malloc_prehistory ();
 #endif
@@ -423,19 +455,20 @@ 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 ();
   scm_init_root ();              /* requires continuations */
-  scm_init_threads ();
+  scm_init_threads ();            /* requires fluids */
   scm_init_gsubr ();
   scm_init_thread_procs ();       /* requires gsubrs */
   scm_init_procprop ();
+#if 0
   scm_init_environments ();
-  scm_init_feature ();
+#endif
   scm_init_alist ();
   scm_init_arbiters ();
   scm_init_async ();
@@ -448,19 +481,21 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_eq ();
   scm_init_error ();
   scm_init_fluids ();
-  scm_init_futures ();
+  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 ();
   scm_init_deprecation ();      /* Requires hashtabs */
   scm_init_objprop ();
+  scm_init_promises ();
   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 ();
@@ -470,7 +505,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 ();
@@ -487,13 +521,24 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_sort ();
   scm_init_srcprop ();
   scm_init_stackchk ();
-  scm_init_strings ();
+
+  scm_init_array_handle ();
+  scm_init_generalized_arrays ();
+  scm_init_generalized_vectors ();
+  scm_init_vectors ();
+  scm_init_uniform ();
+  scm_init_bitvectors ();
+  scm_bootstrap_bytevectors ();
+  scm_init_srfi_4 ();
+  scm_init_arrays ();
+  scm_init_array_map ();
+
+  scm_init_strings ();  /* Requires array-handle */
   scm_init_struct ();   /* Requires strings */
   scm_init_stacks ();   /* Requires strings, struct */
   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_read ();
   scm_init_stime ();
@@ -501,26 +546,27 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_srfi_13 ();
   scm_init_srfi_14 ();
   scm_init_throw ();
-  scm_init_vectors ();
+  scm_init_trees ();
   scm_init_version ();
   scm_init_weaks ();
   scm_init_guardians ();
   scm_init_vports ();
+  scm_init_standard_ports ();  /* Requires fports */
+  scm_bootstrap_vm ();
+  scm_init_memoize ();
   scm_init_eval ();
+  scm_init_load_path ();
+  scm_init_eval_in_scheme ();
   scm_init_evalext ();
   scm_init_debug ();   /* Requires macro smobs */
   scm_init_random ();
-  scm_init_ramap ();
-  scm_init_unif ();
   scm_init_simpos ();
-  scm_init_load_path ();
-  scm_init_standard_ports ();  /* Requires fports */
   scm_init_dynamic_linking ();
+  scm_bootstrap_i18n ();
 #if SCM_ENABLE_ELISP
   scm_init_lang ();
 #endif /* SCM_ENABLE_ELISP */
   scm_init_script ();
-  scm_init_srfi_4 ();
 
   scm_init_goops ();
 
@@ -532,13 +578,10 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_i_init_deprecated ();
 #endif
 
-  scm_init_threads_root_root ();
+  scm_init_threads_default_dynamic_state ();
 
   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
@@ -547,10 +590,10 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_rw ();
   scm_init_extensions ();
 
+  atexit (cleanup_for_exit);
   scm_load_startup_files ();
 }
 
-
 /*
   Local Variables:
   c-file-style: "gnu"