From: Gary Houston Date: Sun, 27 Oct 1996 02:38:39 +0000 (+0000) Subject: * load.c: change s_try_load and s_try_load_path to s_primitive_load X-Git-Url: http://git.hcoop.net/bpt/guile.git/commitdiff_plain/523f52665864ee9a07d3b74e4d5f4374b21aee41 * load.c: change s_try_load and s_try_load_path to s_primitive_load and s_primitive_load_path. * eval.c, load.c, error.c (scm_wta): use scm_misc_error. * error.h: don't declare error symbols. prototype for scm_misc_error. * stackchk.c (scm_stack_overflow_key): defined here instead of in error.c. * error.c: use SCM_SYMBOL to set up error keys. scm_misc_error: new procedure. --- diff --git a/libguile/ChangeLog b/libguile/ChangeLog index f4e6c82e3..8606701cc 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,18 @@ +Sun Oct 27 01:22:04 1996 Gary Houston + + * load.c: change s_try_load and s_try_load_path to s_primitive_load + and s_primitive_load_path. + + * eval.c, load.c, error.c (scm_wta): use scm_misc_error. + + * error.h: don't declare error symbols. prototype for scm_misc_error. + + * stackchk.c (scm_stack_overflow_key): defined here instead of in + error.c. + + * error.c: use SCM_SYMBOL to set up error keys. + scm_misc_error: new procedure. + Fri Oct 25 01:56:30 1996 Jim Blandy * read.c (scm_lreadr): Recognize SCSH-style block comments; text diff --git a/libguile/error.c b/libguile/error.c index 5855defd2..68f24a985 100644 --- a/libguile/error.c +++ b/libguile/error.c @@ -125,7 +125,6 @@ scm_perror (arg) void (*scm_error_callback) () = 0; /* all errors thrown from C should pass through here. */ -/* also known as scm_error. */ void scm_error (key, subr, message, args, rest) SCM key; @@ -151,17 +150,7 @@ scm_error (key, subr, message, args, rest) exit (1); } -/* error keys: defined here, initialized below, prototyped in error.h, - associated with handler procedures in boot-9.scm. */ -SCM scm_system_error_key; -SCM scm_num_overflow_key; -SCM scm_out_of_range_key; -SCM scm_arg_type_key; -SCM scm_args_number_key; -SCM scm_memory_alloc_key; -SCM scm_stack_overflow_key; -SCM scm_misc_error_key; - +SCM_SYMBOL (scm_system_error_key, "system-error"); void scm_syserror (subr) char *subr; @@ -206,6 +195,7 @@ scm_sysmissing (subr) #endif } +SCM_SYMBOL (scm_num_overflow_key, "numerical-overflow"); void scm_num_overflow (subr) char *subr; @@ -217,6 +207,7 @@ scm_num_overflow (subr) SCM_BOOL_F); } +SCM_SYMBOL (scm_out_of_range_key, "out-of-range"); void scm_out_of_range (subr, bad_value) char *subr; @@ -229,6 +220,7 @@ scm_out_of_range (subr, bad_value) SCM_BOOL_F); } +SCM_SYMBOL (scm_args_number_key, "wrong-number-of-args"); void scm_wrong_num_args (proc) SCM proc; @@ -240,6 +232,7 @@ scm_wrong_num_args (proc) SCM_BOOL_F); } +SCM_SYMBOL (scm_arg_type_key, "wrong-type-arg"); void scm_wrong_type_arg (subr, pos, bad_value) char *subr; @@ -255,6 +248,7 @@ scm_wrong_type_arg (subr, pos, bad_value) SCM_BOOL_F); } +SCM_SYMBOL (scm_memory_alloc_key, "memory-allocation-error"); void scm_memory_error (subr) char *subr; @@ -266,6 +260,16 @@ scm_memory_error (subr) SCM_BOOL_F); } +SCM_SYMBOL (scm_misc_error_key, "misc-error"); +void +scm_misc_error (subr, message, args) + char *subr; + char *message; + SCM args; +{ + scm_error (scm_misc_error_key, subr, message, args, SCM_BOOL_F); +} + /* implements the SCM_ASSERT interface. */ SCM scm_wta (arg, pos, s_subr) @@ -278,11 +282,7 @@ scm_wta (arg, pos, s_subr) if ((~0x1fL) & (long) pos) { /* error string supplied. */ - scm_error (scm_misc_error_key, - s_subr, - pos, - SCM_BOOL_F, - SCM_BOOL_F); + scm_misc_error (s_subr, pos, SCM_BOOL_F); } else { @@ -311,11 +311,7 @@ scm_wta (arg, pos, s_subr) scm_memory_error (s_subr); default: /* this shouldn't happen. */ - scm_error (scm_misc_error_key, - s_subr, - "Unknown error", - SCM_BOOL_F, - SCM_BOOL_F); + scm_misc_error (s_subr, "Unknown error", SCM_BOOL_F); } } return SCM_UNSPECIFIED; @@ -327,22 +323,6 @@ scm_wta (arg, pos, s_subr) void scm_init_error () { - scm_system_error_key - = scm_permanent_object (SCM_CAR (scm_intern0 ("system-error"))); - scm_num_overflow_key - = scm_permanent_object (SCM_CAR (scm_intern0 ("numerical-overflow"))); - scm_out_of_range_key - = scm_permanent_object (SCM_CAR (scm_intern0 ("out-of-range"))); - scm_arg_type_key - = scm_permanent_object (SCM_CAR (scm_intern0 ("wrong-type-arg"))); - scm_args_number_key - = scm_permanent_object (SCM_CAR (scm_intern0 ("wrong-number-of-args"))); - scm_memory_alloc_key - = scm_permanent_object (SCM_CAR (scm_intern0 ("memory-allocation-error"))); - scm_stack_overflow_key - = scm_permanent_object (SCM_CAR (scm_intern0 ("stack-overflow"))); - scm_misc_error_key - = scm_permanent_object (SCM_CAR (scm_intern0 ("misc-error"))); #include "error.x" } diff --git a/libguile/error.h b/libguile/error.h index 68ddfcdad..385497e8f 100644 --- a/libguile/error.h +++ b/libguile/error.h @@ -48,15 +48,6 @@ extern int scm_ints_disabled; -extern SCM scm_system_error_key; -extern SCM scm_num_overflow_key; -extern SCM scm_out_of_range_key; -extern SCM scm_arg_type_key; -extern SCM scm_args_number_key; -extern SCM scm_memory_alloc_key; -extern SCM scm_stack_overflow_key; -extern SCM scm_misc_error_key; - extern SCM scm_errno SCM_P ((SCM arg)); @@ -73,6 +64,7 @@ extern void scm_out_of_range SCM_P ((char *subr, SCM bad_value)); extern void scm_wrong_num_args SCM_P ((SCM proc)); extern void scm_wrong_type_arg SCM_P ((char *subr, int pos, SCM bad_value)); extern void scm_memory_error SCM_P ((char *subr)); +extern void scm_misc_error SCM_P ((char *subr, char *message, SCM args)); extern SCM scm_wta SCM_P ((SCM arg, char *pos, char *s_subr)); extern void scm_init_error SCM_P ((void)); diff --git a/libguile/eval.c b/libguile/eval.c index 6bb13543d..32fd95b28 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -235,13 +235,11 @@ scm_lookupcar (vloc, genv) var = SCM_CAR (var); errout: /* scm_everr (vloc, genv,...) */ - scm_error (scm_misc_error_key, - NULL, - SCM_NULLP (env) - ? "Unbound variable: %S" - : "Damaged environment: %S", - scm_listify (var, SCM_UNDEFINED), - SCM_BOOL_F); + scm_misc_error (NULL, + SCM_NULLP (env) + ? "Unbound variable: %S" + : "Damaged environment: %S", + scm_listify (var, SCM_UNDEFINED)); } #endif SCM_SETCAR (vloc, var + 1); @@ -397,11 +395,9 @@ scm_m_vref (xorig, env) if (SCM_NIMP(x) && UDSCM_VARIABLEP (SCM_CAR (x))) { /* scm_everr (SCM_UNDEFINED, env,..., "global variable reference") */ - scm_error (scm_misc_error_key, - NULL, - "Bad variable: %S", - scm_listify (SCM_CAR (SCM_CDR (x)), SCM_UNDEFINED), - SCM_BOOL_F); + scm_misc_error (NULL, + "Bad variable: %S", + scm_listify (SCM_CAR (SCM_CDR (x)), SCM_UNDEFINED)); } ASSYNT (SCM_NIMP(x) && DEFSCM_VARIABLEP (SCM_CAR (x)), xorig, s_variable, s_vref); @@ -1735,11 +1731,9 @@ dispatch: proc = x; badfun: /* scm_everr (x, env,...) */ - scm_error (scm_misc_error_key, - NULL, - "Wrong type to apply: %S", - scm_listify (proc, SCM_UNDEFINED), - SCM_BOOL_F); + scm_misc_error (NULL, + "Wrong type to apply: %S", + scm_listify (proc, SCM_UNDEFINED)); case scm_tc7_vector: case scm_tc7_wvect: case scm_tc7_bvect: diff --git a/libguile/load.c b/libguile/load.c index bb6ce3b64..5a4fea98f 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -63,7 +63,7 @@ /* Loading a file, given an absolute filename. */ -SCM_PROC(s_sys_try_load, "primitive-load", 1, 2, 0, scm_primitive_load); +SCM_PROC(s_primitive_load, "primitive-load", 1, 2, 0, scm_primitive_load); SCM scm_primitive_load (filename, case_insensitive_p, sharp) SCM filename; @@ -71,7 +71,7 @@ scm_primitive_load (filename, case_insensitive_p, sharp) SCM sharp; { SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, - SCM_ARG1, s_sys_try_load); + SCM_ARG1, s_primitive_load); { SCM form, port; port = scm_open_file (filename, @@ -197,7 +197,7 @@ scm_sys_search_load_path (filename) } -SCM_PROC(s_sys_try_load_path, "primitive-load-path", 1, 2, 0,scm_primitive_load_path); +SCM_PROC(s_primitive_load_path, "primitive-load-path", 1, 2, 0,scm_primitive_load_path); SCM scm_primitive_load_path (filename, case_insensitive_p, sharp) SCM filename; @@ -207,11 +207,10 @@ scm_primitive_load_path (filename, case_insensitive_p, sharp) SCM full_filename = scm_sys_search_load_path (filename); if (SCM_FALSEP (full_filename)) { - scm_error (scm_misc_error_key, - s_sys_try_load_path, - "Unable to find file %S in %S", - scm_listify (filename, *scm_loc_load_path, SCM_UNDEFINED), - SCM_BOOL_F); + scm_misc_error (s_primitive_load_path, + "Unable to find file %S in %S", + scm_listify (filename, *scm_loc_load_path, + SCM_UNDEFINED)); } return scm_primitive_load (full_filename, case_insensitive_p, sharp); } diff --git a/libguile/stackchk.c b/libguile/stackchk.c index c01eecbec..92846170f 100644 --- a/libguile/stackchk.c +++ b/libguile/stackchk.c @@ -53,6 +53,8 @@ #ifdef STACK_CHECKING int scm_stack_checking_enabled_p; +SCM_SYMBOL (scm_stack_overflow_key, "stack-overflow"); + void scm_report_stack_overflow () {