-/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998 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
*
* 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+ * 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.
*
* 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.
- */
+ * If you do not wish that, delete this exception notice. */
\f
+/* Include the headers for just about everything.
+ We call all their initialization functions. */
#include <stdio.h>
#include "_scm.h"
/* Everybody has an init function. */
#include "alist.h"
-#include "append.h"
#include "arbiters.h"
#include "async.h"
#include "backtrace.h"
#ifdef DEBUG_EXTENSIONS
#include "debug.h"
#endif
+#include "dynl.h"
#include "dynwind.h"
#include "eq.h"
#include "error.h"
#include "eval.h"
-#include "fdsocket.h"
+#include "evalext.h"
#include "feature.h"
#include "filesys.h"
+#include "fluids.h"
#include "fports.h"
#include "gc.h"
#include "gdbint.h"
#include "gsubr.h"
#include "hash.h"
#include "hashtab.h"
+#ifdef GUILE_ISELECT
+#include "iselect.h"
+#endif
#include "ioext.h"
-#include "kw.h"
+#include "keywords.h"
#include "list.h"
#include "load.h"
+#include "macros.h"
#include "mallocs.h"
-#include "mbstrings.h"
+#include "modules.h"
+#include "net_db.h"
#include "numbers.h"
+#include "objects.h"
#include "objprop.h"
#include "options.h"
#include "pairs.h"
#include "ports.h"
#include "posix.h"
+#ifdef HAVE_REGCOMP
+#include "regex-posix.h"
+#endif
#include "print.h"
#include "procprop.h"
#include "procs.h"
#include "ramap.h"
+#include "random.h"
#include "read.h"
#include "scmsigs.h"
-#include "sequences.h"
+#include "script.h"
#include "simpos.h"
#include "smob.h"
#include "socket.h"
+#include "sort.h"
#include "srcprop.h"
#include "stackchk.h"
#include "stacks.h"
#include "version.h"
#include "vports.h"
#include "weaks.h"
+#include "guardians.h"
#include "init.h"
#include <unistd.h>
#endif
\f
+/* Setting up the stack. */
-static void scm_start_stack SCM_P ((void *base));
-static void scm_restart_stack SCM_P ((void * base));
+static void start_stack SCM_P ((void *base));
+static void restart_stack SCM_P ((void * base));
static void
-scm_start_stack (base)
+start_stack (base)
void * base;
{
SCM root;
scm_exitval = SCM_BOOL_F; /* vestigial */
- scm_top_level_lookup_thunk_var = SCM_BOOL_F;
+ 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);
"continuation"));
SCM_SETCAR (scm_rootcont, scm_tc7_contin);
SCM_SEQ (scm_rootcont) = 0;
- /* The root continuation if further initialized by scm_restart_stack. */
+ /* 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, SCM_UNDEFINED);
- /* The continuation stack is further initialized by scm_restart_stack. */
+ scm_continuation_stack = scm_make_vector (SCM_MAKINUM (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
- * re-entered using scm_restart_stack. */
- scm_restart_stack (base);
+ * re-entered using restart_stack. */
+ restart_stack (base);
}
static void
-scm_restart_stack (base)
+restart_stack (base)
void * base;
{
scm_dynwinds = SCM_EOL;
static void
scm_init_standard_ports ()
{
- /* I'm not sure why this should be unbuffered when coming from a
- tty; isn't line buffering more common? */
- scm_def_inp = scm_stdio_to_port (stdin,
+ /* From the SCSH manual:
+
+ It can be useful to turn I/O buffering off in some cases, for
+ example when an I/O stream is to be shared by multiple
+ subprocesses. For this reason, scsh allocates an unbuffered port
+ for file descriptor 0 at start-up time.
+
+ Because shells frequently share stdin with subprocesses, if the
+ shell does buffered reads, it might ``steal'' input intended for
+ a subprocess. For this reason, all shells, including sh, csh,
+ and scsh, read stdin unbuffered. Applications that can tolerate
+ buffered input on stdin can reset \ex{(current-input-port)} to
+ block buffering for higher performance. */
+ scm_def_inp
+ = scm_standard_stream_to_port (stdin,
(isatty (fileno (stdin)) ? "r0" : "r"),
"standard input");
- scm_def_outp = scm_stdio_to_port (stdout, "w", "standard output");
- scm_def_errp = scm_stdio_to_port (stderr, "w", "standard error");
+ scm_def_outp = scm_standard_stream_to_port (stdout, "w", "standard output");
+ scm_def_errp = scm_standard_stream_to_port (stderr, "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;
}
\f
+/* Loading the startup Scheme files. */
+
+/* The boot code "ice-9/boot-9" is only loaded by scm_boot_guile when
+ this is false. The unexec code uses this, to keep ice_9 from being
+ loaded into dumped guile executables. */
+int scm_ice_9_already_loaded = 0;
+
+void
+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"));
+
+ /* Load Ice-9. */
+ if (!scm_ice_9_already_loaded)
+ scm_primitive_load_path (scm_makfrom0str ("ice-9/boot-9.scm"));
+
+ /* Load the init.scm file. */
+ if (SCM_NFALSEP (init_path))
+ scm_primitive_load (init_path);
+}
+
+
+\f
+/* The main init code. */
+
#ifdef _UNICOS
typedef int setjmp_type;
#else
typedef long setjmp_type;
#endif
-static void scm_boot_guile_1 SCM_P ((SCM_STACKITEM *base,
- int argc, char **argv,
- void (*main_func) (void *closure,
- int argc,
- char **argv),
- void *closure));
+/* All the data needed to invoke the main function. */
+struct main_func_closure
+{
+ /* the function to call */
+ void (*main_func) SCM_P ((void *closure, int argc, char **argv));
+ void *closure; /* dummy data to pass it */
+ int argc;
+ char **argv; /* the argument list it should receive */
+};
+
+
+static void scm_boot_guile_1 SCM_P ((SCM_STACKITEM *base,
+ struct main_func_closure *closure));
+static SCM invoke_main_func SCM_P ((void *body_data));
/* Fire up the Guile Scheme interpreter.
call scm_set_program_arguments with the final list, so Scheme code
will know which arguments have been processed.
+ scm_boot_guile establishes a catch-all catch handler which prints
+ an error message and exits the process. This means that Guile
+ exits in a coherent way when system errors occur and the user isn't
+ prepared to handle it. If the user doesn't like this behavior,
+ they can establish their own universal catcher to shadow this one.
+
Why must the caller do all the real work from MAIN_FUNC? The
garbage collector assumes that all local variables of type SCM will
be above scm_boot_guile's stack frame on the stack. If you try to
end of the stack, and the address of one of its own local
variables as the other end. */
SCM_STACKITEM dummy;
+ struct main_func_closure c;
+
+ c.main_func = main_func;
+ c.closure = closure;
+ c.argc = argc;
+ c.argv = argv;
- return scm_boot_guile_1 (&dummy, argc, argv, main_func, closure);
+ scm_boot_guile_1 (&dummy, &c);
}
+/* 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 (base, argc, argv, main_func, closure)
+scm_boot_guile_1 (base, closure)
SCM_STACKITEM *base;
- int argc;
- char **argv;
- void (*main_func) ();
- void *closure;
+ struct main_func_closure *closure;
{
static int initialized = 0;
- static int live = 0;
+ /* static int live = 0; */
setjmp_type setjmp_val;
/* This function is not re-entrant. */
- if (live)
+ if (scm_boot_guile_1_live)
abort ();
- live = 1;
+ scm_boot_guile_1_live = 1;
scm_ints_disabled = 1;
scm_block_gc = 1;
if (initialized)
{
- scm_restart_stack (base);
+ restart_stack (base);
}
else
{
#ifdef USE_THREADS
scm_init_threads (base);
#endif
- scm_start_stack (base);
+ start_stack (base);
scm_init_gsubr ();
scm_init_feature ();
scm_init_alist ();
- scm_init_append ();
scm_init_arbiters ();
scm_init_async ();
- scm_init_backtrace ();
scm_init_boolean ();
scm_init_chars ();
scm_init_continuations ();
scm_init_dynwind ();
scm_init_eq ();
scm_init_error ();
- scm_init_fdsocket ();
+ scm_init_fluids ();
+ scm_init_backtrace (); /* Requires fluids */
scm_init_fports ();
scm_init_filesys ();
scm_init_gc ();
scm_init_gdbint ();
scm_init_hash ();
scm_init_hashtab ();
+#ifdef GUILE_ISELECT
+ scm_init_iselect ();
+#endif
scm_init_ioext ();
- scm_init_kw ();
+ scm_init_keywords ();
scm_init_list ();
+ scm_init_macros ();
scm_init_mallocs ();
+ scm_init_modules ();
+ scm_init_net_db ();
scm_init_numbers ();
scm_init_objprop ();
-#if DEBUG_EXTENSIONS
- /* Excluding this until it's really needed makes the binary
- * smaller after linking. */
scm_init_options ();
-#endif
scm_init_pairs ();
scm_init_ports ();
scm_init_posix ();
+#ifdef HAVE_REGCOMP
+ scm_init_regex_posix ();
+#endif
scm_init_procs ();
scm_init_procprop ();
scm_init_scmsigs ();
scm_init_socket ();
+ scm_init_sort ();
#ifdef DEBUG_EXTENSIONS
scm_init_srcprop ();
#endif
scm_init_symbols ();
scm_init_tag ();
scm_init_load ();
+ scm_init_objects (); /* Requires struct */
scm_init_print (); /* Requires struct */
scm_init_read ();
- scm_init_sequences ();
scm_init_stime ();
scm_init_strings ();
scm_init_strorder ();
- scm_init_mbstrings ();
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 ();
#ifdef DEBUG_EXTENSIONS
scm_init_debug (); /* Requires macro smobs */
#endif
scm_init_ramap ();
+ scm_init_random ();
scm_init_unif ();
scm_init_simpos ();
scm_init_load_path ();
scm_init_standard_ports ();
+ scm_init_dynamic_linking ();
+ scm_init_script ();
initialized = 1;
}
setjmp_val = setjmp (SCM_JMPBUF (scm_rootcont));
if (!setjmp_val)
{
- scm_init_signals ();
-
- scm_set_program_arguments (argc, argv);
- (*main_func) (closure, argc, argv);
+ 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_restore_signals ();
main_func themselves. */
exit (0);
}
+
+
+static SCM
+invoke_main_func (body_data)
+ void *body_data;
+{
+ struct main_func_closure *closure = (struct main_func_closure *) body_data;
+
+ scm_load_startup_files ();
+
+ scm_post_boot_init_modules ();
+
+ (*closure->main_func) (closure->closure, closure->argc, closure->argv);
+
+ /* never reached */
+ return SCM_UNDEFINED;
+}
HCoop / bpt / guile.git / blobdiff