diff options
author | Jim Blandy <jimb@red-bean.com> | 1996-10-23 02:14:39 +0000 |
---|---|---|
committer | Jim Blandy <jimb@red-bean.com> | 1996-10-23 02:14:39 +0000 |
commit | 1cdaaafb7320e922ff2510c2f7bba8b49a220818 (patch) | |
tree | d0e037d8d5dc1e5a1550d286b6fc67d18512d773 | |
parent | a089567e228351fb8729f49082e3a397adbcd25b (diff) | |
download | guile-1cdaaafb7320e922ff2510c2f7bba8b49a220818.tar.gz |
* init.c (scm_start_stack): Don't initialize scm_progargs here.
(scm_boot_guile): Call scm_set_program_arguments here, later than
the old initialization.
* init.c: (scm_boot_guile, scm_boot_guile_1): New, simplified
initialization procedure.
- Delete in, out, err arguments; there are other perfectly good
ways to override these when desired.
- Delete result argument; this function shouldn't ever return.
- Rename init_func argument to main_func, for less confusion.
- Delete boot_cmd argument; main_func is more general.
-Add 'closure' argument, to help people pass data to main_func
without resorting to global variables.
- Abort if reentered; don't bother returning an error code.
- Call scm_init_standard_ports to set up the default/current
standard ports; no need to pass them to scm_start_stack.
- Remove code to evaluate the boot_cmd, and start the repl; let
the user do something like that in main_func if they want.
- Remove code to package up a return value; main_func can do any
of that as needed.
- Call exit (0), instead of returning.
(scm_start_stack): Don't initialize the I/O ports here; that's
weird. Delete in, out, err arguments. Move guts to
scm_init_standard_ports, scm_stdio_to_port.
(scm_init_standard_ports): New function, to set up current and
default standard ports.
(scm_start_stack, scm_restart_stack): Make these static.
* init.h (scm_boot_guile): Adjust declaration.
(scm_start_stack, scm_restart_stack): Remove externally
visible declarations for these.
(enum scm_boot_status): Removed; now scm_boot_guile never returns.
-rw-r--r-- | libguile/init.c | 326 |
1 files changed, 101 insertions, 225 deletions
diff --git a/libguile/init.c b/libguile/init.c index 0566c102a..1b1c390f2 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -119,77 +119,19 @@ #endif -void -scm_start_stack (base, in, out, err) +static void scm_start_stack SCM_P ((void *base)); +static void scm_restart_stack SCM_P ((void * base)); + +static void +scm_start_stack (base) void * base; - FILE * in; - FILE * out; - FILE * err; { SCM root; - struct scm_port_table * pt; root = scm_permanent_object (scm_make_root (SCM_UNDEFINED)); scm_set_root (SCM_ROOT_STATE (root)); - scm_stack_base = base; - /* Create standard ports from stdio files, if requested to do so. - */ - - if (!in) - { - scm_def_inp = SCM_BOOL_F; - } - else - { - SCM_NEWCELL (scm_def_inp); - pt = scm_add_to_port_table (scm_def_inp); - SCM_SETCAR (scm_def_inp, (scm_tc16_fport | SCM_OPN | SCM_RDNG)); - SCM_SETPTAB_ENTRY (scm_def_inp, pt); - SCM_SETSTREAM (scm_def_inp, (SCM)in); - if (isatty (fileno (in))) - { - scm_setbuf0 (scm_def_inp); /* turn off stdin buffering */ - SCM_SETOR_CAR (scm_def_inp, SCM_BUF0); - } - scm_set_port_revealed_x (scm_def_inp, SCM_MAKINUM (1)); - } - - if (!out) - { - scm_def_outp = SCM_BOOL_F; - } - else - { - SCM_NEWCELL (scm_def_outp); - pt = scm_add_to_port_table (scm_def_outp); - SCM_SETCAR (scm_def_outp, (scm_tc16_fport | SCM_OPN | SCM_WRTNG)); - SCM_SETPTAB_ENTRY (scm_def_outp, pt); - SCM_SETSTREAM (scm_def_outp, (SCM)out); - scm_set_port_revealed_x (scm_def_outp, SCM_MAKINUM (1)); - } - - if (!err) - { - scm_def_errp = SCM_BOOL_F; - } - else - { - SCM_NEWCELL (scm_def_errp); - pt = scm_add_to_port_table (scm_def_errp); - SCM_SETCAR (scm_def_errp, (scm_tc16_fport | SCM_OPN | SCM_WRTNG)); - SCM_SETPTAB_ENTRY (scm_def_errp, pt); - SCM_SETSTREAM (scm_def_errp, (SCM)err); - scm_set_port_revealed_x (scm_def_errp, SCM_MAKINUM (1)); - } - - scm_cur_inp = scm_def_inp; - scm_cur_outp = scm_def_outp; - scm_cur_errp = scm_def_errp; - - - scm_progargs = SCM_BOOL_F; /* vestigial */ scm_exitval = SCM_BOOL_F; /* vestigial */ scm_top_level_lookup_thunk_var = SCM_BOOL_F; @@ -198,7 +140,8 @@ scm_start_stack (base, in, out, err) /* Create an object to hold the root continuation. */ SCM_NEWCELL (scm_rootcont); - SCM_SETJMPBUF (scm_rootcont, scm_must_malloc ((long) sizeof (scm_contregs), "continuation")); + SCM_SETJMPBUF (scm_rootcont, scm_must_malloc ((long) sizeof (scm_contregs), + "continuation")); SCM_SETCAR (scm_rootcont, scm_tc7_contin); SCM_SEQ (scm_rootcont) = 0; /* The root continuation if further initialized by scm_restart_stack. */ @@ -206,17 +149,18 @@ scm_start_stack (base, in, out, err) /* 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); + scm_continuation_stack = scm_make_vector (SCM_MAKINUM (512), + SCM_UNDEFINED, SCM_UNDEFINED); /* The continuation stack is further initialized by scm_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. - */ + /* 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); } -void +static void scm_restart_stack (base) void * base; { @@ -289,79 +233,94 @@ check_config () +/* initializing standard and current I/O ports */ + +/* Create standard ports from stdio stdin, stdout, and stderr. */ +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, + (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_cur_inp = scm_def_inp; + scm_cur_outp = scm_def_outp; + scm_cur_errp = scm_def_errp; +} + + + #ifdef _UNICOS typedef int setjmp_type; #else typedef long setjmp_type; #endif -/* Fire up Scheme. - * - * argc and argv are made the return values of program-arguments. - * - * in, out, and err, if not NULL, become the standard ports. - * If NULL is passed, your "initfunc" should set up the - * standard ports. - * - * boot_cmd is a string containing a Scheme expression to evaluate - * to get things rolling. - * - * result is returned a string containing a printed result of evaluating - * the boot command. - * - * the return value is: - * scm_boot_ok - evaluation concluded normally - * scm_boot_error - evaluation concluded with a Scheme error - * scm_boot_emem - allocation error mallocing *result - * scm_boot_ereenter - scm_boot_guile was called re-entrantly, which is - * prohibited. - */ +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)); + + +/* Fire up the Guile Scheme interpreter. + + Call MAIN_FUNC, passing it CLOSURE, ARGC, and ARGV. MAIN_FUNC + should do all the work of the program (initializing other packages, + reading user input, etc.) before returning. When MAIN_FUNC + returns, call exit (0); this function never returns. If you want + some other exit value, MAIN_FUNC may call exit itself. -int scm_boot_guile_1 SCM_P ((SCM_STACKITEM *base, - char **result, - int argc, char **argv, - FILE *in, FILE *out, FILE *err, - void (*init_func) (), - char *boot_cmd)); + scm_boot_guile arranges for program-arguments to return the strings + given by ARGC and ARGV. If MAIN_FUNC modifies ARGC/ARGV, should + call scm_set_program_arguments with the final list, so Scheme code + will know which arguments have been processed. -int -scm_boot_guile (result, argc, argv, in, out, err, init_func, boot_cmd) - char ** result; + 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 + manipulate SCM values after this function returns, it's the luck of + the draw whether the GC will be able to find the objects you + allocate. So, scm_boot_guile function exits, rather than + returning, to discourage people from making that mistake. */ + + +void +scm_boot_guile (argc, argv, main_func, closure) int argc; char ** argv; - FILE * in; - FILE * out; - FILE * err; - void (*init_func) (); - char * boot_cmd; + void (*main_func) (); + void *closure; { + /* The garbage collector uses the address of this variable as one + end of the stack, and the address of one of its own local + variables as the other end. */ SCM_STACKITEM dummy; - return scm_boot_guile_1 (&dummy, result, argc, argv, in, out, err, - init_func, boot_cmd); + return scm_boot_guile_1 (&dummy, argc, argv, main_func, closure); } -int -scm_boot_guile_1 (base, result, argc, argv, in, out, err, init_func, boot_cmd) + +static void +scm_boot_guile_1 (base, argc, argv, main_func, closure) SCM_STACKITEM *base; - char ** result; int argc; - char ** argv; - FILE * in; - FILE * out; - FILE * err; - void (*init_func) (); - char * boot_cmd; + char **argv; + void (*main_func) (); + void *closure; { static int initialized = 0; static int live = 0; setjmp_type setjmp_val; - int stat; - if (live) /* This function is not re-entrant. */ - { - return scm_boot_ereenter; - } + /* This function is not re-entrant. */ + if (live) + abort (); live = 1; @@ -382,7 +341,7 @@ scm_boot_guile_1 (base, result, argc, argv, in, out, err, init_func, boot_cmd) #ifdef USE_THREADS scm_init_threads (base); #endif - scm_start_stack (base, in, out, err); + scm_start_stack (base); scm_init_gsubr (); scm_init_feature (); scm_init_alist (); @@ -452,119 +411,36 @@ scm_boot_guile_1 (base, result, argc, argv, in, out, err, init_func, boot_cmd) scm_init_ramap (); scm_init_unif (); scm_init_simpos (); - scm_progargs = scm_makfromstrs (argc, argv); scm_init_load_path (); + scm_init_standard_ports (); initialized = 1; } scm_block_gc = 0; /* permit the gc to run */ /* ints still disabled */ - { - SCM command; +#ifdef STACK_CHECKING + scm_stack_checking_enabled_p = SCM_STACK_CHECKING_P; +#endif - command = scm_makfrom0str (boot_cmd); + setjmp_val = setjmp (SCM_JMPBUF (scm_rootcont)); + if (!setjmp_val) + { + scm_init_signals (); - setjmp_val = setjmp (SCM_JMPBUF (scm_rootcont)); + scm_set_program_arguments (argc, argv); + (*main_func) (closure, argc, argv); + } -#ifdef STACK_CHECKING - scm_stack_checking_enabled_p = SCM_STACK_CHECKING_P; -#endif - if (!setjmp_val) - { - SCM last = SCM_UNDEFINED; - scm_init_signals (); - - /* Call the initialization function passed in by the user, if - present. */ - if (init_func) (*init_func) (); - - /* Evaluate boot_cmd string. */ - { - SCM p; - SCM form; - - p = scm_mkstrport (SCM_MAKINUM (0), - command, - SCM_OPN | SCM_RDNG, - "boot_guile"); - while (1) - { - form = scm_read (p, SCM_BOOL_F, SCM_BOOL_F); - if (SCM_EOF_VAL == form) - break; - last = scm_eval_x (form); - } - - } - - scm_restore_signals (); - /* This tick gives any pending - * asyncs a chance to run. This must be done after - * the call to scm_restore_signals. - */ - SCM_ASYNC_TICK; - - scm_ints_disabled = 1; /* Hopefully redundant but just to be sure. */ - - { - SCM str_answer; - - str_answer = scm_strprint_obj (last); - *result = (char *)malloc (1 + SCM_LENGTH (str_answer)); - if (!*result) - stat = scm_boot_emem; - else - { - memcpy (*result, SCM_CHARS (str_answer), SCM_LENGTH (str_answer)); - (*result)[SCM_LENGTH (str_answer)] = 0; - stat = scm_boot_ok; - } - } - } - else - { - /* This is reached if an unhandled throw terminated Scheme. - * Such an occurence should be extremely unlikely -- it indicates - * a programming error in the boot code. - * - * Details of the bogus exception are stored in scm_exitval even - * though that isn't currently reflected in the return value. - * !!! - */ - - scm_restore_signals (); - /* This tick gives any pending - * asyncs a chance to run. This must be done after - * the call to scm_restore_signals. - * - * Note that an unhandled exception during signal handling - * will put as back at the call to scm_restore_signals immediately - * preceeding. A sufficiently bogus signal handler could - * conceivably cause an infinite loop here. - */ - SCM_ASYNC_TICK; - - scm_ints_disabled = 1; /* Hopefully redundant but just to be sure. */ - - { - SCM str_answer; - - str_answer = scm_strprint_obj (scm_exitval); - *result = (char *)malloc (1 + SCM_LENGTH (str_answer)); - if (!*result) - stat = scm_boot_emem; - else - { - memcpy (*result, SCM_CHARS (str_answer), SCM_LENGTH (str_answer)); - (*result)[SCM_LENGTH (str_answer)] = 0; - stat = scm_boot_error; - } - } - } - } + scm_restore_signals (); - scm_block_gc = 1; - live = 0; - return stat; + /* This tick gives any pending + * asyncs a chance to run. This must be done after + * the call to scm_restore_signals. + */ + SCM_ASYNC_TICK; + + /* If the caller doesn't want this, they should return from + main_func themselves. */ + exit (0); } |