1 /* Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
3 * This program is free software; you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation; either version 2, or (at your option)
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this software; see the file COPYING. If not, write to
15 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
16 * Boston, MA 02111-1307 USA
18 * As a special exception, the Free Software Foundation gives permission
19 * for additional uses of the text contained in its release of GUILE.
21 * The exception is that, if you link the GUILE library with other files
22 * to produce an executable, this does not by itself cause the
23 * resulting executable to be covered by the GNU General Public License.
24 * Your use of that executable is in no way restricted on account of
25 * linking the GUILE library code into it.
27 * This exception does not however invalidate any other reasons why
28 * the executable file might be covered by the GNU General Public License.
30 * This exception applies only to the code released by the
31 * Free Software Foundation under the name GUILE. If you copy
32 * code from other Free Software Foundation releases into a copy of
33 * GUILE, as the General Public License permits, the exception does
34 * not apply to the code that you add in this way. To avoid misleading
35 * anyone as to the status of such modified files, you must delete
36 * this exception notice from them.
38 * If you write modifications of your own for GUILE, it is your choice
39 * whether to permit this exception to apply to your modifications.
40 * If you do not wish that, delete this exception notice. */
42 /* Include the headers for just about everything.
43 We call all their initialization functions. */
48 /* Everybody has an init function. */
52 #include "backtrace.h"
55 #include "continuations.h"
56 #ifdef DEBUG_EXTENSIONS
90 #include "regex-posix.h"
104 #include "stackchk.h"
109 #include "strorder.h"
110 #include "strports.h"
116 #include "variable.h"
131 /* Setting up the stack. */
133 static void start_stack
SCM_P ((void *base
));
134 static void restart_stack
SCM_P ((void * base
));
142 root
= scm_permanent_object (scm_make_root (SCM_UNDEFINED
));
143 scm_set_root (SCM_ROOT_STATE (root
));
144 scm_stack_base
= base
;
146 scm_exitval
= SCM_BOOL_F
; /* vestigial */
148 scm_top_level_lookup_closure_var
= SCM_BOOL_F
;
149 scm_system_transformer
= SCM_BOOL_F
;
151 scm_root
->fluids
= scm_make_initial_fluids ();
153 /* Create an object to hold the root continuation.
155 SCM_NEWCELL (scm_rootcont
);
156 SCM_SETJMPBUF (scm_rootcont
, scm_must_malloc ((long) sizeof (scm_contregs
),
158 SCM_SETCAR (scm_rootcont
, scm_tc7_contin
);
159 SCM_SEQ (scm_rootcont
) = 0;
160 /* The root continuation if further initialized by restart_stack. */
162 /* Create the look-aside stack for variables that are shared between
163 * captured continuations.
165 scm_continuation_stack
= scm_make_vector (SCM_MAKINUM (512), SCM_UNDEFINED
);
166 /* The continuation stack is further initialized by restart_stack. */
168 /* The remainder of stack initialization is factored out to another
169 * function so that if this stack is ever exitted, it can be
170 * re-entered using restart_stack. */
171 restart_stack (base
);
179 scm_dynwinds
= SCM_EOL
;
180 SCM_DYNENV (scm_rootcont
) = SCM_EOL
;
181 SCM_THROW_VALUE (scm_rootcont
) = SCM_EOL
;
182 #ifdef DEBUG_EXTENSIONS
183 SCM_DFRAME (scm_rootcont
) = scm_last_debug_frame
= 0;
185 SCM_BASE (scm_rootcont
) = base
;
186 scm_continuation_stack_ptr
= SCM_MAKINUM (0);
190 static char remsg
[] = "remove\n#define ", addmsg
[] = "add\n#define ";
193 static void fixconfig
SCM_P ((char *s1
, char *s2
, int s
));
196 fixconfig (s1
, s2
, s
)
203 fputs ("\nin ", stderr
);
204 fputs (s
? "setjump" : "scmfig", stderr
);
205 fputs (".h and recompile scm\n", stderr
);
210 static void check_config
SCM_P ((void));
218 if (HEAP_SEG_SIZE
!= j
)
219 fixconfig ("reduce", "size of HEAP_SEG_SIZE", 0);
222 if (sizeof (float) != sizeof (long))
223 fixconfig (remsg
, "SCM_SINGLES", 0);
224 #endif /* def SCM_SINGLES */
228 if (2 * SCM_BITSPERDIG
/ SCM_CHAR_BIT
> sizeof (long))
229 fixconfig (remsg
, "SCM_BIGDIG", 0);
230 #ifndef SCM_DIGSTOOBIG
231 if (SCM_DIGSPERLONG
* sizeof (SCM_BIGDIG
) > sizeof (long))
232 fixconfig (addmsg
, "SCM_DIGSTOOBIG", 0);
236 #ifdef SCM_STACK_GROWS_UP
237 if (((SCM_STACKITEM
*) & j
- stack_start_ptr
) < 0)
238 fixconfig (remsg
, "SCM_STACK_GROWS_UP", 1);
240 if ((stack_start_ptr
- (SCM_STACKITEM
*) & j
) < 0)
241 fixconfig (addmsg
, "SCM_STACK_GROWS_UP", 1);
248 /* initializing standard and current I/O ports */
250 /* Create standard ports from stdio stdin, stdout, and stderr. */
252 scm_init_standard_ports ()
254 /* From the SCSH manual:
256 It can be useful to turn I/O buffering off in some cases, for
257 example when an I/O stream is to be shared by multiple
258 subprocesses. For this reason, scsh allocates an unbuffered port
259 for file descriptor 0 at start-up time.
261 Because shells frequently share stdin with subprocesses, if the
262 shell does buffered reads, it might ``steal'' input intended for
263 a subprocess. For this reason, all shells, including sh, csh,
264 and scsh, read stdin unbuffered. Applications that can tolerate
265 buffered input on stdin can reset \ex{(current-input-port)} to
266 block buffering for higher performance. */
267 scm_def_inp
= scm_stdio_to_port (stdin
,
268 (isatty (fileno (stdin
)) ? "r0" : "r"),
270 scm_def_outp
= scm_stdio_to_port (stdout
, "w", "standard output");
271 scm_def_errp
= scm_stdio_to_port (stderr
, "w", "standard error");
273 scm_cur_inp
= scm_def_inp
;
274 scm_cur_outp
= scm_def_outp
;
275 scm_cur_errp
= scm_def_errp
;
276 scm_cur_loadp
= SCM_BOOL_F
;
281 /* Loading the startup Scheme files. */
283 /* The boot code "ice-9/boot-9" is only loaded by scm_boot_guile when
284 this is false. The unexec code uses this, to keep ice_9 from being
285 loaded into dumped guile executables. */
286 int scm_ice_9_already_loaded
= 0;
289 scm_load_startup_files ()
291 /* We want a path only containing directories from GUILE_LOAD_PATH,
292 SCM_SITE_DIR and SCM_LIBRARY_DIR when searching for the site init
293 file, so we do this before loading Ice-9. */
294 SCM init_path
= scm_sys_search_load_path (scm_makfrom0str ("init.scm"));
297 if (!scm_ice_9_already_loaded
)
298 scm_primitive_load_path (scm_makfrom0str ("ice-9/boot-9.scm"));
300 /* Load the init.scm file. */
301 if (SCM_NFALSEP (init_path
))
302 scm_primitive_load (init_path
);
307 /* The main init code. */
310 typedef int setjmp_type
;
312 typedef long setjmp_type
;
315 /* All the data needed to invoke the main function. */
316 struct main_func_closure
318 /* the function to call */
319 void (*main_func
) SCM_P ((void *closure
, int argc
, char **argv
));
320 void *closure
; /* dummy data to pass it */
322 char **argv
; /* the argument list it should receive */
326 static void scm_boot_guile_1
SCM_P ((SCM_STACKITEM
*base
,
327 struct main_func_closure
*closure
));
328 static SCM invoke_main_func
SCM_P ((void *body_data
));
331 /* Fire up the Guile Scheme interpreter.
333 Call MAIN_FUNC, passing it CLOSURE, ARGC, and ARGV. MAIN_FUNC
334 should do all the work of the program (initializing other packages,
335 reading user input, etc.) before returning. When MAIN_FUNC
336 returns, call exit (0); this function never returns. If you want
337 some other exit value, MAIN_FUNC may call exit itself.
339 scm_boot_guile arranges for program-arguments to return the strings
340 given by ARGC and ARGV. If MAIN_FUNC modifies ARGC/ARGV, should
341 call scm_set_program_arguments with the final list, so Scheme code
342 will know which arguments have been processed.
344 scm_boot_guile establishes a catch-all catch handler which prints
345 an error message and exits the process. This means that Guile
346 exits in a coherent way when system errors occur and the user isn't
347 prepared to handle it. If the user doesn't like this behavior,
348 they can establish their own universal catcher to shadow this one.
350 Why must the caller do all the real work from MAIN_FUNC? The
351 garbage collector assumes that all local variables of type SCM will
352 be above scm_boot_guile's stack frame on the stack. If you try to
353 manipulate SCM values after this function returns, it's the luck of
354 the draw whether the GC will be able to find the objects you
355 allocate. So, scm_boot_guile function exits, rather than
356 returning, to discourage people from making that mistake. */
360 scm_boot_guile (argc
, argv
, main_func
, closure
)
363 void (*main_func
) ();
366 /* The garbage collector uses the address of this variable as one
367 end of the stack, and the address of one of its own local
368 variables as the other end. */
370 struct main_func_closure c
;
372 c
.main_func
= main_func
;
377 scm_boot_guile_1 (&dummy
, &c
);
381 /* Record here whether SCM_BOOT_GUILE_1 has already been called. This
382 variable is now here and not inside SCM_BOOT_GUILE_1 so that one
383 can tweak it. This is necessary for unexec to work. (Hey, "1-live"
384 is the name of a local radiostation...) */
386 int scm_boot_guile_1_live
= 0;
389 scm_boot_guile_1 (base
, closure
)
391 struct main_func_closure
*closure
;
393 static int initialized
= 0;
394 /* static int live = 0; */
395 setjmp_type setjmp_val
;
397 /* This function is not re-entrant. */
398 if (scm_boot_guile_1_live
)
401 scm_boot_guile_1_live
= 1;
403 scm_ints_disabled
= 1;
408 restart_stack (base
);
412 scm_ports_prehistory ();
413 scm_smob_prehistory ();
414 scm_tables_prehistory ();
415 scm_init_storage (0);
418 scm_init_threads (base
);
424 scm_init_arbiters ();
428 scm_init_continuations ();
433 scm_init_backtrace (); /* Requires fluids */
455 scm_init_regex_posix ();
458 scm_init_procprop ();
461 #ifdef DEBUG_EXTENSIONS
464 scm_init_stackchk ();
465 scm_init_struct (); /* Requires struct */
467 scm_init_strports ();
471 scm_init_objects (); /* Requires struct */
472 scm_init_print (); /* Requires struct */
476 scm_init_strorder ();
479 scm_init_variable ();
485 #ifdef DEBUG_EXTENSIONS
486 scm_init_debug (); /* Requires macro smobs */
491 scm_init_load_path ();
492 #if defined (HAVE_RL_GETC_FUNCTION)
493 scm_init_readline ();
495 scm_init_standard_ports ();
496 scm_init_dynamic_linking ();
501 scm_block_gc
= 0; /* permit the gc to run */
502 /* ints still disabled */
504 #ifdef STACK_CHECKING
505 scm_stack_checking_enabled_p
= SCM_STACK_CHECKING_P
;
508 setjmp_val
= setjmp (SCM_JMPBUF (scm_rootcont
));
511 scm_set_program_arguments (closure
->argc
, closure
->argv
, 0);
512 scm_internal_lazy_catch (SCM_BOOL_T
, invoke_main_func
, closure
,
513 scm_handle_by_message
, 0);
516 scm_restore_signals ();
518 /* This tick gives any pending
519 * asyncs a chance to run. This must be done after
520 * the call to scm_restore_signals.
524 /* If the caller doesn't want this, they should return from
525 main_func themselves. */
531 invoke_main_func (body_data
)
534 struct main_func_closure
*closure
= (struct main_func_closure
*) body_data
;
536 scm_load_startup_files ();
538 (*closure
->main_func
) (closure
->closure
, closure
->argc
, closure
->argv
);
541 return SCM_UNDEFINED
;