X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/686765af618887390b43fc86329e5fccabe0ef68..717a0e5b8c12bce584a05a80109231a76eb1b92a:/libguile/init.c

diff --git a/libguile/init.c b/libguile/init.c
index 42fba5226..0e0115385 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002 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
@@ -39,8 +39,6 @@
  * whether to permit this exception to apply to your modifications.
  * If you do not wish that, delete this exception notice.  */
 
-/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
-   gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
 
 
 /* Include the headers for just about everything.
@@ -66,8 +64,10 @@
 #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"
 #include "libguile/eq.h"
 #include "libguile/error.h"
 #include "libguile/eval.h"
@@ -78,13 +78,12 @@
 #include "libguile/fports.h"
 #include "libguile/gc.h"
 #include "libguile/gdbint.h"
+#include "libguile/goops.h"
 #include "libguile/gsubr.h"
 #include "libguile/hash.h"
 #include "libguile/hashtab.h"
 #include "libguile/hooks.h"
-#ifdef GUILE_ISELECT
 #include "libguile/iselect.h"
-#endif
 #include "libguile/ioext.h"
 #include "libguile/keywords.h"
 #include "libguile/lang.h"
@@ -107,9 +106,12 @@
 #include "libguile/print.h"
 #include "libguile/procprop.h"
 #include "libguile/procs.h"
+#include "libguile/properties.h"
 #include "libguile/ramap.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"
@@ -126,15 +128,16 @@
 #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/variable.h"
 #include "libguile/vectors.h"
 #include "libguile/version.h"
 #include "libguile/vports.h"
 #include "libguile/weaks.h"
 #include "libguile/guardians.h"
+#include "libguile/extensions.h"
 
 #include "libguile/init.h"
 
@@ -157,7 +160,6 @@ restart_stack (void *base)
   SCM_DFRAME (scm_rootcont) = scm_last_debug_frame = 0;
 #endif
   SCM_BASE (scm_rootcont) = base;
-  scm_continuation_stack_ptr = SCM_MAKINUM (0);
 }
 
 static void
@@ -171,25 +173,17 @@ start_stack (void *base)
 
   scm_exitval = SCM_BOOL_F;	/* vestigial */
 
-  scm_top_level_lookup_closure_var = SCM_BOOL_F;
-  scm_system_transformer = SCM_BOOL_F;
-
   scm_root->fluids = scm_make_initial_fluids ();
 
   /* Create an object to hold the root continuation.
    */
-  SCM_NEWCELL (scm_rootcont);
-  SCM_SET_CONTREGS (scm_rootcont, scm_must_malloc (sizeof (scm_contregs),
-						   "continuation"));
-  SCM_SET_CELL_TYPE (scm_rootcont, scm_tc7_contin);
-  SCM_SEQ (scm_rootcont) = 0;
-  /* The root continuation if further initialized by restart_stack. */
-
-  /* Create the look-aside stack for variables that are shared between
-   * captured continuations.
-   */
-  scm_continuation_stack = scm_make_vector (SCM_MAKINUM (512), SCM_UNDEFINED);
-  /* The continuation stack is further initialized by restart_stack. */
+  {
+    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 remainder of stack initialization is factored out to another
    * function so that if this stack is ever exitted, it can be
@@ -203,7 +197,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);
@@ -217,7 +211,7 @@ 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)
@@ -267,7 +261,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;
 }
@@ -313,20 +309,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;
 }
 
@@ -355,25 +348,9 @@ scm_load_startup_files ()
       /* Load the init.scm file.  */
       if (SCM_NFALSEP (init_path))
 	scm_primitive_load (init_path);
-  
-      scm_post_boot_init_modules ();
     }
 }
 
-/* Get an integer from an environment variable.  */
-static int
-scm_i_getenv_int (const char *var, int def)
-{
-  char *end, *val = getenv (var);
-  long res;
-  if (!val)
-    return def;
-  res = strtol (val, &end, 10);
-  if (end == val)
-    return def;
-  return res;
-}
-
 
 /* The main init code.  */
 
@@ -394,7 +371,9 @@ struct main_func_closure
 };
 
 
-static void scm_boot_guile_1(SCM_STACKITEM *base, struct main_func_closure *closure);
+static void scm_init_guile_1 (SCM_STACKITEM *base);
+static void scm_boot_guile_1 (SCM_STACKITEM *base,
+			      struct main_func_closure *closure);
 static SCM invoke_main_func(void *body_data);
 
 
@@ -443,147 +422,147 @@ scm_boot_guile (int argc, char ** argv, void (*main_func) (), void *closure)
   scm_boot_guile_1 (&dummy, &c);
 }
 
+void
+scm_init_guile ()
+{
+  scm_init_guile_1 ((SCM_STACKITEM *)scm_get_stack_base ());
+}
 
-/* Record here whether SCM_BOOT_GUILE_1 has already been called.  This
-   variable is now here and not inside SCM_BOOT_GUILE_1 so that one
-   can tweak it. This is necessary for unexec to work. (Hey, "1-live"
-   is the name of a local radiostation...) */
-
-int scm_boot_guile_1_live = 0;
+int scm_initialized_p = 0;
 
 static void
-scm_boot_guile_1 (SCM_STACKITEM *base, struct main_func_closure *closure)
+scm_init_guile_1 (SCM_STACKITEM *base)
 {
-  static int initialized = 0;
-  /* static int live = 0; */
-  setjmp_type setjmp_val;
-
-  /* This function is not re-entrant. */
-  if (scm_boot_guile_1_live)
-    abort ();
+  if (scm_initialized_p)
+    return;
 
-  scm_boot_guile_1_live = 1;
+  if (base == NULL)
+    {
+      fprintf (stderr, "cannot determine stack base!\n");
+      abort ();
+    }
 
   scm_ints_disabled = 1;
   scm_block_gc = 1;
   
-  if (initialized)
-    {
-      restart_stack (base);
-    }
-  else
-    {
-      scm_ports_prehistory ();
-      scm_smob_prehistory ();
-      scm_tables_prehistory ();
+  scm_ports_prehistory ();
+  scm_smob_prehistory ();
+  scm_tables_prehistory ();
 #ifdef GUILE_DEBUG_MALLOC
-      scm_debug_malloc_prehistory ();
-#endif
-      scm_init_storage (scm_i_getenv_int ("GUILE_INIT_SEGMENT_SIZE_1", 0),
-			scm_i_getenv_int ("GUILE_MIN_YIELD_1", 0),
-			scm_i_getenv_int ("GUILE_INIT_SEGMENT_SIZE_2", 0),
-			scm_i_getenv_int ("GUILE_MIN_YIELD_2", 0),
-			scm_i_getenv_int ("GUILE_MAX_SEGMENT_SIZE", 0));
-      scm_weaks_prehistory ();	/* Must come after scm_init_storage */
-      scm_init_subr_table ();
-      scm_init_root ();
-#ifdef USE_THREADS
-      scm_init_threads (base);
+  scm_debug_malloc_prehistory ();
 #endif
-      start_stack (base);
-      scm_init_gsubr ();
-      scm_init_feature ();
-      scm_init_alist ();
-      scm_init_arbiters ();
-      scm_init_async ();
-      scm_init_boolean ();
-      scm_init_chars ();
-      scm_init_continuations ();
+  if (scm_init_storage ())	          /* requires smob_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 */
+  scm_init_variable ();           /* all bindings need variables */
+  scm_init_continuations ();
+  scm_init_root ();		  /* requires continuations */
+  scm_init_threads (base);
+  start_stack (base);
+  scm_init_gsubr ();
+  scm_init_thread_procs ();       /* requires gsubrs */
+  scm_init_procprop ();
+  scm_init_environments ();
+  scm_init_feature ();
+  scm_init_alist ();
+  scm_init_arbiters ();
+  scm_init_async ();
+  scm_init_boolean ();
+  scm_init_chars ();
 #ifdef GUILE_DEBUG_MALLOC
-      scm_init_debug_malloc ();
-#endif
-      scm_init_dynwind ();
-      scm_init_eq ();
-      scm_init_error ();
-      scm_init_fluids ();
-      scm_init_backtrace ();	/* Requires fluids */
-      scm_init_fports ();
-      scm_init_gdbint ();
-      scm_init_hash ();
-      scm_init_hashtab ();
-      scm_init_hooks ();
-      scm_init_gc ();		/* Requires hooks */
-#ifdef GUILE_ISELECT
-      scm_init_iselect ();
+  scm_init_debug_malloc ();
 #endif
-      scm_init_ioext ();
-      scm_init_keywords ();
-      scm_init_list ();
-      scm_init_macros ();
-      scm_init_mallocs ();
-      scm_init_modules ();
-      scm_init_numbers ();
-      scm_init_objprop ();
-      scm_init_options ();
-      scm_init_pairs ();
-      scm_init_ports ();
+  scm_init_dynwind ();
+  scm_init_eq ();
+  scm_init_error ();
+  scm_init_fluids ();
+  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 smob_prehistory */
+  scm_init_gc ();		/* Requires hooks, async */
+  scm_init_ioext ();
+  scm_init_keywords ();
+  scm_init_list ();
+  scm_init_macros ();
+  scm_init_mallocs ();
+  scm_init_modules ();
+  scm_init_numbers ();
+  scm_init_options ();
+  scm_init_pairs ();
+  scm_init_ports ();
 #ifdef HAVE_POSIX
-      scm_init_filesys ();
-      scm_init_posix ();
+  scm_init_filesys ();
+  scm_init_posix ();
 #endif
 #ifdef HAVE_REGCOMP
-      scm_init_regex_posix ();
+  scm_init_regex_posix ();
 #endif
-      scm_init_procs ();
-      scm_init_procprop ();
-      scm_init_scmsigs ();
+  scm_init_procs ();
+  scm_init_scmsigs ();
 #ifdef HAVE_NETWORKING
-      scm_init_net_db ();
-      scm_init_socket ();
+  scm_init_net_db ();
+  scm_init_socket ();
 #endif
-      scm_init_sort ();
+  scm_init_sort ();
 #ifdef DEBUG_EXTENSIONS
-      scm_init_srcprop ();
+  scm_init_srcprop ();
 #endif
-      scm_init_stackchk ();
-      scm_init_struct ();	/* Requires struct */
-      scm_init_stacks ();
-      scm_init_strports ();
-      scm_init_symbols ();
-      scm_init_tag ();
-      scm_init_load ();
-      scm_init_objects ();	/* Requires struct */
-      scm_init_print ();	/* Requires struct */
-      scm_init_read ();
-      scm_init_stime ();
-      scm_init_strings ();
-      scm_init_strorder ();
-      scm_init_strop ();
-      scm_init_throw ();
-      scm_init_variable ();
-      scm_init_vectors ();
-      scm_init_version ();
-      scm_init_weaks ();
-      scm_init_guardian ();
-      scm_init_vports ();
-      scm_init_eval ();
-      scm_init_evalext ();
+  scm_init_stackchk ();
+  scm_init_strings ();
+  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 ();
+  scm_init_strorder ();
+  scm_init_strop ();
+  scm_init_throw ();
+  scm_init_vectors ();
+  scm_init_version ();
+  scm_init_weaks ();
+  scm_init_guardians ();
+  scm_init_vports ();
+  scm_init_eval ();
+  scm_init_evalext ();
 #ifdef DEBUG_EXTENSIONS
-      scm_init_debug ();	/* Requires macro smobs */
+  scm_init_debug ();	/* Requires macro smobs */
 #endif
-      scm_init_random ();
+  scm_init_random ();
 #ifdef HAVE_ARRAYS
-      scm_init_ramap ();
-      scm_init_unif ();
+  scm_init_ramap ();
+  scm_init_unif ();
 #endif
-      scm_init_simpos ();
-      scm_init_load_path ();
-      scm_init_standard_ports ();
-      scm_init_dynamic_linking ();
-      scm_init_lang ();
-      scm_init_script ();
-      initialized = 1;
-    }
+  scm_init_simpos ();
+  scm_init_load_path ();
+  scm_init_standard_ports ();  /* Requires fports */
+#ifdef DYNAMIC_LINKING
+  scm_init_dynamic_linking ();
+#endif
+#ifdef SCM_ENABLE_ELISP
+  scm_init_lang ();
+#endif /* SCM_ENABLE_ELISP */
+  scm_init_script ();
+
+  scm_init_goops ();
+  
+  scm_initialized_p = 1;
 
   scm_block_gc = 0;		/* permit the gc to run */
   /* ints still disabled */
@@ -592,13 +571,33 @@ scm_boot_guile_1 (SCM_STACKITEM *base, struct main_func_closure *closure)
   scm_stack_checking_enabled_p = SCM_STACK_CHECKING_P;
 #endif
 
-  setjmp_val = setjmp (SCM_JMPBUF (scm_rootcont));
-  if (!setjmp_val)
-    {
-      scm_set_program_arguments (closure->argc, closure->argv, 0);
-      scm_internal_lazy_catch (SCM_BOOL_T, invoke_main_func, closure,
-			       scm_handle_by_message, 0);
-    }
+  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
+   variable is now here and not inside SCM_BOOT_GUILE_1 so that one
+   can tweak it. This is necessary for unexec to work. (Hey, "1-live"
+   is the name of a local radiostation...) */
+
+int scm_boot_guile_1_live = 0;
+
+static void
+scm_boot_guile_1 (SCM_STACKITEM *base, struct main_func_closure *closure)
+{
+  scm_init_guile_1 (base);
+
+  /* This function is not re-entrant. */
+  if (scm_boot_guile_1_live)
+    abort ();
+
+  scm_boot_guile_1_live = 1;
+
+  scm_set_program_arguments (closure->argc, closure->argv, 0);
+  invoke_main_func (closure);
 
   scm_restore_signals ();
 
@@ -613,14 +612,11 @@ scm_boot_guile_1 (SCM_STACKITEM *base, struct main_func_closure *closure)
   exit (0);
 }
 
-
 static SCM
 invoke_main_func (void *body_data)
 {
   struct main_func_closure *closure = (struct main_func_closure *) body_data;
 
-  scm_load_startup_files ();
-
   (*closure->main_func) (closure->closure, closure->argc, closure->argv);
 
   /* never reached */