Reverted changed from 2005/01/24 19:14:54, which was a commit to the
[bpt/guile.git] / libguile / init.c
index 8d3ca5f..ca964af 100644 (file)
@@ -1,54 +1,33 @@
-/* Copyright (C) 1995,1996,1997,1998,1999, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004 Free Software Foundation, Inc.
  * 
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2, or (at your option)
- * any later version.
- * 
- * This program 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 General Public License for more details.
- * 
- * You should have received a copy of the GNU General Public License
- * along with this software; see the file COPYING.  If not, write to
- * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
- * Boston, MA 02111-1307 USA
- *
- * As a special exception, the Free Software Foundation gives permission
- * for additional uses of the text contained in its release of GUILE.
- *
- * The exception is that, if you link the GUILE library with other files
- * to produce an executable, this does not by itself cause the
- * resulting executable to be covered by the GNU General Public License.
- * Your use of that executable is in no way restricted on account of
- * linking the GUILE library code into it.
- *
- * This exception does not however invalidate any other reasons why
- * the executable file might be covered by the GNU General Public License.
+ * 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.
  *
- * This exception applies only to the code released by the
- * Free Software Foundation under the name GUILE.  If you copy
- * code from other Free Software Foundation releases into a copy of
- * GUILE, as the General Public License permits, the exception does
- * not apply to the code that you add in this way.  To avoid misleading
- * anyone as to the status of such modified files, you must delete
- * this exception notice from them.
+ * 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.
  *
- * If you write modifications of your own for GUILE, it is your choice
- * whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice.  */
+ * 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
+ */
 
-/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
-   gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
 
 \f
 /* Include the headers for just about everything.
    We call all their initialization functions.  */
 
+#if HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
 #include <stdio.h>
 #include <sys/stat.h>
 #include <fcntl.h>
+#include <gmp.h>
 
 #include "libguile/_scm.h"
 
 #include "libguile/boolean.h"
 #include "libguile/chars.h"
 #include "libguile/continuations.h"
-#ifdef DEBUG_EXTENSIONS
 #include "libguile/debug.h"
-#endif
 #ifdef GUILE_DEBUG_MALLOC
 #include "libguile/debug-malloc.h"
 #endif
+#include "libguile/deprecation.h"
 #include "libguile/dynl.h"
 #include "libguile/dynwind.h"
 #include "libguile/environments.h"
@@ -77,6 +55,7 @@
 #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/goops.h"
@@ -84,9 +63,8 @@
 #include "libguile/hash.h"
 #include "libguile/hashtab.h"
 #include "libguile/hooks.h"
-#ifdef GUILE_ISELECT
+#include "libguile/i18n.h"
 #include "libguile/iselect.h"
-#endif
 #include "libguile/ioext.h"
 #include "libguile/keywords.h"
 #include "libguile/lang.h"
 #include "libguile/random.h"
 #include "libguile/rdelim.h"
 #include "libguile/read.h"
+#include "libguile/rw.h"
 #include "libguile/scmsigs.h"
 #include "libguile/script.h"
 #include "libguile/simpos.h"
 #include "libguile/stacks.h"
 #include "libguile/stime.h"
 #include "libguile/strings.h"
-#include "libguile/strop.h"
+#include "libguile/srfi-13.h"
+#include "libguile/srfi-14.h"
 #include "libguile/strorder.h"
 #include "libguile/strports.h"
 #include "libguile/struct.h"
 #include "libguile/symbols.h"
-#include "libguile/tag.h"
 #include "libguile/throw.h"
 #include "libguile/unif.h"
 #include "libguile/values.h"
 #include "libguile/vports.h"
 #include "libguile/weaks.h"
 #include "libguile/guardians.h"
+#include "libguile/extensions.h"
+#include "libguile/srfi-4.h"
+#include "libguile/discouraged.h"
+#include "libguile/deprecated.h"
 
 #include "libguile/init.h"
 
@@ -158,11 +141,8 @@ restart_stack (void *base)
   scm_dynwinds = SCM_EOL;
   SCM_DYNENV (scm_rootcont) = SCM_EOL;
   SCM_THROW_VALUE (scm_rootcont) = SCM_EOL;
-#ifdef DEBUG_EXTENSIONS
   SCM_DFRAME (scm_rootcont) = scm_last_debug_frame = 0;
-#endif
   SCM_BASE (scm_rootcont) = base;
-  scm_continuation_stack_ptr = SCM_MAKINUM (0);
 }
 
 static void
@@ -176,29 +156,17 @@ start_stack (void *base)
 
   scm_exitval = SCM_BOOL_F;    /* vestigial */
 
-#if SCM_DEBUG_DEPRECATED == 0
-  scm_top_level_lookup_closure_var = SCM_BOOL_F;
-#endif
-  scm_system_transformer = SCM_BOOL_F;
-
-  scm_root->fluids = scm_make_initial_fluids ();
+  scm_root->fluids = scm_i_make_initial_fluids ();
 
   /* Create an object to hold the root continuation.
    */
   {
-    scm_contregs *contregs = scm_must_malloc (sizeof (scm_contregs),
+    scm_t_contregs *contregs = scm_gc_malloc (sizeof (scm_t_contregs),
                                              "continuation");
     contregs->num_stack_items = 0;
     contregs->seq = 0;
     SCM_NEWSMOB (scm_rootcont, scm_tc16_continuation, contregs);
   }
-  /* The root continuation is further initialized by restart_stack. */
-
-  /* Create the look-aside stack for variables that are shared between
-   * captured continuations.
-   */
-  scm_continuation_stack = scm_c_make_vector (512, SCM_UNDEFINED);
-  /* The continuation stack is further initialized by restart_stack. */
 
   /* The remainder of stack initialization is factored out to another
    * function so that if this stack is ever exitted, it can be
@@ -212,7 +180,7 @@ static char remsg[] = "remove\n#define ", addmsg[] = "add\n#define ";
 
 
 static void 
-fixconfig (char *s1,char *s2,int s)
+fixconfig (char *s1, char *s2, int s)
 {
   fputs (s1, stderr);
   fputs (s2, stderr);
@@ -226,22 +194,13 @@ fixconfig (char *s1,char *s2,int s)
 static void
 check_config (void)
 {
-  scm_sizet j;
+  size_t j;
 
   j = HEAP_SEG_SIZE;
   if (HEAP_SEG_SIZE != j)
     fixconfig ("reduce", "size of HEAP_SEG_SIZE", 0);
 
-#ifdef SCM_BIGDIG
-  if (2 * SCM_BITSPERDIG / SCM_CHAR_BIT > sizeof (long))
-      fixconfig (remsg, "SCM_BIGDIG", 0);
-#ifndef SCM_DIGSTOOBIG
-  if (SCM_DIGSPERLONG * sizeof (SCM_BIGDIG) > sizeof (long))
-      fixconfig (addmsg, "SCM_DIGSTOOBIG", 0);
-#endif
-#endif
-
-#ifdef SCM_STACK_GROWS_UP
+#if SCM_STACK_GROWS_UP
   if (((SCM_STACKITEM *) & j - stack_start_ptr) < 0)
     fixconfig (remsg, "SCM_STACK_GROWS_UP", 1);
 #else
@@ -268,7 +227,7 @@ 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_makfrom0str (body_data->name));
+                              scm_from_locale_string (body_data->name));
 
   SCM_REVEALED (port) = 1;
   return port;
@@ -276,7 +235,9 @@ stream_body (void *data)
 
 /* exception handler for stream_body.  */
 static SCM
-stream_handler (void *data, SCM tag, SCM throw_args)
+stream_handler (void *data SCM_UNUSED,
+               SCM tag SCM_UNUSED,
+               SCM throw_args SCM_UNUSED)
 {
   return SCM_BOOL_F;
 }
@@ -299,7 +260,7 @@ scm_standard_stream_to_port (int fdes, char *mode, char *name)
   body_data.name = name;
   port = scm_internal_catch (SCM_BOOL_T, stream_body, &body_data, 
                             stream_handler, NULL);
-  if (SCM_FALSEP (port))
+  if (scm_is_false (port))
     port = scm_void_port (mode);
   return port;
 }
@@ -322,20 +283,17 @@ scm_init_standard_ports ()
      buffered input on stdin can reset \ex{(current-input-port)} to
      block buffering for higher performance.  */
 
-  scm_def_inp
+  scm_cur_inp
     = scm_standard_stream_to_port (0, 
                                   isatty (0) ? "r0" : "r",
                                   "standard input");
-  scm_def_outp = scm_standard_stream_to_port (1,
+  scm_cur_outp = scm_standard_stream_to_port (1,
                                              isatty (1) ? "w0" : "w",
                                              "standard output");
-  scm_def_errp = scm_standard_stream_to_port (2,
+  scm_cur_errp = scm_standard_stream_to_port (2,
                                              isatty (2) ? "w0" : "w",
                                              "standard error");
 
-  scm_cur_inp = scm_def_inp;
-  scm_cur_outp = scm_def_outp;
-  scm_cur_errp = scm_def_errp;
   scm_cur_loadp = SCM_BOOL_F;
 }
 
@@ -354,18 +312,17 @@ scm_load_startup_files ()
   /* We want a path only containing directories from GUILE_LOAD_PATH,
      SCM_SITE_DIR and SCM_LIBRARY_DIR when searching for the site init
      file, so we do this before loading Ice-9.  */
-  SCM init_path = scm_sys_search_load_path (scm_makfrom0str ("init.scm"));
+  SCM init_path =
+    scm_sys_search_load_path (scm_from_locale_string ("init.scm"));
 
   /* Load Ice-9.  */
   if (!scm_ice_9_already_loaded)
     {
-      scm_primitive_load_path (scm_makfrom0str ("ice-9/boot-9.scm"));
+      scm_primitive_load_path (scm_from_locale_string ("ice-9/boot-9.scm"));
 
       /* Load the init.scm file.  */
-      if (SCM_NFALSEP (init_path))
+      if (scm_is_true (init_path))
        scm_primitive_load (init_path);
-  
-      scm_post_boot_init_modules ();
     }
 }
 
@@ -460,28 +417,41 @@ scm_init_guile_1 (SCM_STACKITEM *base)
       abort ();
     }
 
-  scm_ints_disabled = 1;
+  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_block_gc = 1;
-  
+
+  scm_storage_prehistory ();
+  scm_threads_prehistory ();
   scm_ports_prehistory ();
   scm_smob_prehistory ();
-  scm_tables_prehistory ();
+  scm_hashtab_prehistory ();   /* requires storage_prehistory */
 #ifdef GUILE_DEBUG_MALLOC
   scm_debug_malloc_prehistory ();
 #endif
-  scm_init_storage ();
+  if (scm_init_storage ())        /* requires threads_prehistory,
+                                    smob_prehistory and
+                                    hashtab_prehistory */
+    abort ();
+  
   scm_struct_prehistory ();      /* requires storage */
   scm_symbols_prehistory ();      /* requires storage */
   scm_weaks_prehistory ();       /* requires storage */
   scm_init_subr_table ();
   scm_environments_prehistory (); /* requires storage */
+  scm_modules_prehistory ();      /* requires storage and hash tables */
+  scm_init_variable ();           /* all bindings need variables */
   scm_init_continuations ();
   scm_init_root ();              /* requires continuations */
-#ifdef USE_THREADS
   scm_init_threads (base);
-#endif
   start_stack (base);
   scm_init_gsubr ();
+  scm_init_thread_procs ();       /* requires gsubrs */
   scm_init_procprop ();
   scm_init_environments ();
   scm_init_feature ();
@@ -497,19 +467,19 @@ scm_init_guile_1 (SCM_STACKITEM *base)
   scm_init_eq ();
   scm_init_error ();
   scm_init_fluids ();
+  scm_init_futures ();
   scm_init_backtrace ();       /* Requires fluids */
   scm_init_fports ();
   scm_init_strports ();
   scm_init_gdbint ();           /* Requires strports */
   scm_init_hash ();
   scm_init_hashtab ();
+  scm_init_deprecation ();      /* Requires hashtabs */
   scm_init_objprop ();
   scm_init_properties ();
-  scm_init_hooks ();        /* Requires objprop until hook names are removed */
+  scm_init_hooks ();            /* Requires smob_prehistory */
   scm_init_gc ();              /* Requires hooks, async */
-#ifdef GUILE_ISELECT
-  scm_init_iselect ();
-#endif
+  scm_init_i18n ();
   scm_init_ioext ();
   scm_init_keywords ();
   scm_init_list ();
@@ -534,25 +504,22 @@ scm_init_guile_1 (SCM_STACKITEM *base)
   scm_init_socket ();
 #endif
   scm_init_sort ();
-#ifdef DEBUG_EXTENSIONS
   scm_init_srcprop ();
-#endif
   scm_init_stackchk ();
-  scm_init_struct ();
-  scm_init_stacks ();   /* Requires struct */
+  scm_init_strings ();
+  scm_init_struct ();   /* Requires strings */
+  scm_init_stacks ();   /* Requires strings, struct */
   scm_init_symbols ();
-  scm_init_tag ();
   scm_init_values ();   /* Requires struct */
-  scm_init_load ();
+  scm_init_load ();     /* Requires strings */
   scm_init_objects (); /* Requires struct */
-  scm_init_print ();   /* Requires struct */
+  scm_init_print ();   /* Requires strings, struct */
   scm_init_read ();
   scm_init_stime ();
-  scm_init_strings ();
   scm_init_strorder ();
-  scm_init_strop ();
+  scm_init_srfi_13 ();
+  scm_init_srfi_14 ();
   scm_init_throw ();
-  scm_init_variable ();
   scm_init_vectors ();
   scm_init_version ();
   scm_init_weaks ();
@@ -560,23 +527,30 @@ scm_init_guile_1 (SCM_STACKITEM *base)
   scm_init_vports ();
   scm_init_eval ();
   scm_init_evalext ();
-#ifdef DEBUG_EXTENSIONS
   scm_init_debug ();   /* Requires macro smobs */
-#endif
   scm_init_random ();
-#ifdef HAVE_ARRAYS
   scm_init_ramap ();
   scm_init_unif ();
-#endif
   scm_init_simpos ();
   scm_init_load_path ();
   scm_init_standard_ports ();  /* Requires fports */
   scm_init_dynamic_linking ();
+#if SCM_ENABLE_ELISP
   scm_init_lang ();
+#endif /* SCM_ENABLE_ELISP */
   scm_init_script ();
-  
-  scm_init_oop_goops_goopscore_module ();
-  
+  scm_init_srfi_4 ();
+
+  scm_init_goops ();
+
+#if SCM_ENABLE_DISCOURAGED == 1
+  scm_i_init_discouraged ();
+#endif
+
+#if SCM_ENABLE_DEPRECATED == 1
+  scm_i_init_deprecated ();
+#endif
+
   scm_initialized_p = 1;
 
   scm_block_gc = 0;            /* permit the gc to run */
@@ -586,12 +560,11 @@ scm_init_guile_1 (SCM_STACKITEM *base)
   scm_stack_checking_enabled_p = SCM_STACK_CHECKING_P;
 #endif
 
-  scm_load_startup_files ();
-
-  /* this is located here, not from a deep understanding of the
-     module system, but as a way of avoiding segv and other
-     undesirable side effects that arise from various alternatives.  */
   scm_init_rdelim ();
+  scm_init_rw ();
+  scm_init_extensions ();
+
+  scm_load_startup_files ();
 }
 
 /* Record here whether SCM_BOOT_GUILE_1 has already been called.  This