diff options
-rw-r--r-- | libguile/debug.c | 2 | ||||
-rw-r--r-- | libguile/error.c | 11 | ||||
-rw-r--r-- | libguile/error.h | 2 | ||||
-rw-r--r-- | libguile/scm_validate.h | 4 | ||||
-rw-r--r-- | libguile/snarf.h | 102 |
5 files changed, 66 insertions, 55 deletions
diff --git a/libguile/debug.c b/libguile/debug.c index 06e7e6c6b..ad1be6a99 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -87,7 +87,7 @@ SCM_DEFINE (scm_debug_options, "debug-options-interface", 0, 1, 0, if (!(1 <= SCM_N_FRAMES && SCM_N_FRAMES <= SCM_MAX_FRAME_SIZE)) { scm_options (ans, scm_debug_opts, SCM_N_DEBUG_OPTIONS, FUNC_NAME); - scm_out_of_range (FUNC_NAME, setting); + SCM_OUT_OF_RANGE (1, setting); } #endif SCM_RESET_DEBUG_MODE; diff --git a/libguile/error.c b/libguile/error.c index 4ff12ae01..52bda683c 100644 --- a/libguile/error.c +++ b/libguile/error.c @@ -185,6 +185,17 @@ scm_out_of_range (const char *subr, SCM bad_value) SCM_BOOL_F); } +void +scm_out_of_range_pos (const char *subr, SCM bad_value, SCM pos) +{ + scm_error (scm_out_of_range_key, + subr, + "Argument %S out of range: %S", + scm_listify (pos, bad_value, SCM_UNDEFINED), + SCM_BOOL_F); +} + + SCM_SYMBOL (scm_args_number_key, "wrong-number-of-args"); void scm_wrong_num_args (SCM proc) diff --git a/libguile/error.h b/libguile/error.h index 6dfbbc230..61bf5ec8d 100644 --- a/libguile/error.h +++ b/libguile/error.h @@ -71,6 +71,8 @@ extern void scm_sysmissing SCM_P ((const char *subr)) SCM_NORETURN; extern void scm_num_overflow SCM_P ((const char *subr)) SCM_NORETURN; extern void scm_out_of_range SCM_P ((const char *subr, SCM bad_value)) SCM_NORETURN; +extern void scm_out_of_range_pos SCM_P ((const char *subr, SCM bad_value, SCM pos)) + SCM_NORETURN; extern void scm_wrong_num_args SCM_P ((SCM proc)) SCM_NORETURN; extern void scm_wrong_type_arg SCM_P ((const char *subr, int pos, SCM bad_value)) SCM_NORETURN; diff --git a/libguile/scm_validate.h b/libguile/scm_validate.h index 6b01d2293..3186f1f2e 100644 --- a/libguile/scm_validate.h +++ b/libguile/scm_validate.h @@ -1,4 +1,4 @@ -/* $Id: scm_validate.h,v 1.12 2000-01-06 18:04:14 gjb Exp $ */ +/* $Id: scm_validate.h,v 1.13 2000-01-07 23:53:20 gjb Exp $ */ /* Copyright (C) 1999 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify @@ -75,7 +75,7 @@ #define SCM_NUM2LONG_LONG(pos,arg) (scm_num2long_long(arg, (char *) pos, FUNC_NAME)) -#define SCM_OUT_OF_RANGE(pos,arg) do { scm_out_of_range(FUNC_NAME,arg); } while (0) +#define SCM_OUT_OF_RANGE(pos,arg) do { scm_out_of_range_pos(FUNC_NAME,arg,scm_long2num(pos)); } while (0) #define SCM_ASSERT_RANGE(pos,arg,f) do { SCM_ASSERT(f,arg,SCM_OUTOFRANGE,FUNC_NAME); } while (0) diff --git a/libguile/snarf.h b/libguile/snarf.h index 93c171ae1..e70565cc5 100644 --- a/libguile/snarf.h +++ b/libguile/snarf.h @@ -57,120 +57,118 @@ #define SCM_FUNC_CAST_ARBITRARY_ARGS SCM (*)() #endif -#ifndef SCM_MAGIC_SNARFER -# define SCM_NOTSNARF(X) X -# define SCM_SNARFING(X) -#else -# define SCM_NOTSNARF(X) -# define SCM_SNARFING(X) X -#endif - /* Generic macros to be used in user macro definitions. * * For example, in order to define a macro which creates ints and * initializes them to the result of foo (), do: * * #define SCM_FOO(NAME) \ - * SCM_INSITU (int NAME) \ + * SCM_HERE (int NAME) \ * SCM_INIT (NAME = foo ()) + * + * The SCM_INIT text goes into the corresponding .x file + * up through the first occurrence of $$$ on that line, if any. */ -#define SCM_INSITU(X) SCM_NOTSNARF(X) -#define SCM_INIT(X) SCM_SNARFING(\ -%%% X \ -) +#ifndef SCM_MAGIC_SNARFER +# define SCM_HERE(X) X +# define SCM_INIT(X) +#else +# define SCM_HERE(X) +# define SCM_INIT(X) %%% X +#endif #define SCM_DEFINE(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \ -SCM_NOTSNARF(\ +SCM_HERE(\ static const char s_ ## FNAME [] = PRIMNAME; \ SCM FNAME ARGLIST\ )\ -SCM_SNARFING(\ -%%% scm_make_gsubr (s_ ## FNAME, REQ, OPT, VAR, (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \ +SCM_INIT(\ +scm_make_gsubr (s_ ## FNAME, REQ, OPT, VAR, (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \ $$$P PRIMNAME #ARGLIST | REQ | OPT | VAR | __FILE__:__LINE__ | @@@ DOCSTRING @!!! \ ) #define SCM_DEFINE1(FNAME, PRIMNAME, TYPE, ARGLIST, DOCSTRING) \ -SCM_NOTSNARF(\ +SCM_HERE(\ static const char s_ ## FNAME [] = PRIMNAME; \ SCM FNAME ARGLIST\ -)SCM_SNARFING(\ -%%% scm_make_subr (s_ ## FNAME, TYPE, FNAME); \ +)SCM_INIT(\ +scm_make_subr (s_ ## FNAME, TYPE, FNAME); \ $$$1 PRIMNAME #ARGLIST | 2 | 0 | 0 | __FILE__:__LINE__ | @@@ DOCSTRING @!!! \ ) #define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \ -SCM_NOTSNARF(static const char RANAME[]=STR) \ -SCM_SNARFING(\ -%%% scm_make_gsubr (RANAME, REQ, OPT, VAR, (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN) \ +SCM_HERE(static const char RANAME[]=STR) \ +SCM_INIT(\ +scm_make_gsubr (RANAME, REQ, OPT, VAR, (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN) \ ) #define SCM_REGISTER_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \ -SCM_NOTSNARF(\ +SCM_HERE(\ static const char RANAME[]=STR \ -)SCM_SNARFING(\ -%%% scm_make_gsubr (RANAME, REQ, OPT, VAR, (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN); \ +)SCM_INIT(\ +scm_make_gsubr (RANAME, REQ, OPT, VAR, (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN); \ $$$R STR | REQ | OPT | VAR | __FILE__:__LINE__ | @@@ CFN @!!! \ ) #define SCM_GPROC(RANAME, STR, REQ, OPT, VAR, CFN, GF) \ -SCM_NOTSNARF(\ +SCM_HERE(\ static const char RANAME[]=STR;\ static SCM GF = 0 \ -)SCM_SNARFING(\ -%%% scm_make_gsubr_with_generic (RANAME, REQ, OPT, VAR, (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \ +)SCM_INIT(\ +scm_make_gsubr_with_generic (RANAME, REQ, OPT, VAR, (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \ ) #define SCM_PROC1(RANAME, STR, TYPE, CFN) \ -SCM_NOTSNARF(static const char RANAME[]=STR) \ -SCM_SNARFING(\ -%%% scm_make_subr(RANAME, TYPE, (SCM (*)(...))CFN) \ +SCM_HERE(static const char RANAME[]=STR) \ +SCM_INIT(\ +scm_make_subr(RANAME, TYPE, (SCM (*)(...))CFN) \ ) #define SCM_GPROC1(RANAME, STR, TYPE, CFN, GF) \ -SCM_NOTSNARF(\ +SCM_HERE(\ static const char RANAME[]=STR; \ static SCM GF = 0 \ -)SCM_SNARFING(\ -%%% scm_make_subr_with_generic(RANAME, TYPE, (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \ +)SCM_INIT(\ +scm_make_subr_with_generic(RANAME, TYPE, (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \ ) #define SCM_SYNTAX(RANAME, STR, TYPE, CFN) \ -SCM_NOTSNARF(static const char RANAME[]=STR)\ -SCM_SNARFING(%%% scm_make_synt (RANAME, TYPE, CFN)) +SCM_HERE(static const char RANAME[]=STR)\ +SCM_INIT(scm_make_synt (RANAME, TYPE, CFN)) #define SCM_SYMBOL(c_name, scheme_name) \ -SCM_NOTSNARF(static SCM c_name = SCM_BOOL_F) \ -SCM_SNARFING(%%% c_name = scm_permanent_object (SCM_CAR (scm_intern0 (scheme_name)))) +SCM_HERE(static SCM c_name = SCM_BOOL_F) \ +SCM_INIT(c_name = scm_permanent_object (SCM_CAR (scm_intern0 (scheme_name)))) #define SCM_GLOBAL_SYMBOL(c_name, scheme_name) \ -SCM_NOTSNARF(SCM c_name = SCM_BOOL_F) \ -SCM_SNARFING(%%% c_name = scm_permanent_object (SCM_CAR (scm_intern0 (scheme_name)))) +SCM_HERE(SCM c_name = SCM_BOOL_F) \ +SCM_INIT(c_name = scm_permanent_object (SCM_CAR (scm_intern0 (scheme_name)))) #define SCM_KEYWORD(c_name, scheme_name) \ -SCM_NOTSNARF(static SCM c_name = SCM_BOOL_F) \ -SCM_SNARFING(%%% c_name = scm_permanent_object (scm_c_make_keyword (scheme_name))) +SCM_HERE(static SCM c_name = SCM_BOOL_F) \ +SCM_INIT(c_name = scm_permanent_object (scm_c_make_keyword (scheme_name))) #define SCM_GLOBAL_KEYWORD(c_name, scheme_name) \ -SCM_NOTSNARF(SCM c_name = SCM_BOOL_F) \ -SCM_SNARFING(%%% c_name = scm_permanent_object (scm_c_make_keyword (scheme_name))) +SCM_HERE(SCM c_name = SCM_BOOL_F) \ +SCM_INIT(c_name = scm_permanent_object (scm_c_make_keyword (scheme_name))) #define SCM_VCELL(c_name, scheme_name) \ -SCM_NOTSNARF(static SCM c_name = SCM_BOOL_F) \ -SCM_SNARFING(%%% c_name = scm_permanent_object (scm_intern0 (scheme_name)); SCM_SETCDR (c_name, SCM_BOOL_F)) +SCM_HERE(static SCM c_name = SCM_BOOL_F) \ +SCM_INIT(c_name = scm_permanent_object (scm_intern0 (scheme_name)); SCM_SETCDR (c_name, SCM_BOOL_F)) #define SCM_GLOBAL_VCELL(c_name, scheme_name) \ -SCM_NOTSNARF(SCM c_name = SCM_BOOL_F) \ -SCM_SNARFING(%%% c_name = scm_permanent_object (scm_intern0 (scheme_name)); SCM_SETCDR (c_name, SCM_BOOL_F)) +SCM_HERE(SCM c_name = SCM_BOOL_F) \ +SCM_INIT(c_name = scm_permanent_object (scm_intern0 (scheme_name)); SCM_SETCDR (c_name, SCM_BOOL_F)) #define SCM_VCELL_INIT(c_name, scheme_name, init_val) \ -SCM_NOTSNARF(static SCM c_name = SCM_BOOL_F) \ -SCM_SNARFING(%%% c_name = scm_permanent_object (scm_intern0 (scheme_name)); SCM_SETCDR (c_name, init_val)) +SCM_HERE(static SCM c_name = SCM_BOOL_F) \ +SCM_INIT(c_name = scm_permanent_object (scm_intern0 (scheme_name)); SCM_SETCDR (c_name, init_val)) #define SCM_GLOBAL_VCELL_INIT(c_name, scheme_name, init_val) \ -SCM_NOTSNARF(SCM c_name = SCM_BOOL_F) \ -SCM_SNARFING(%%% c_name = scm_permanent_object (scm_intern0 (scheme_name)); SCM_SETCDR (c_name, init_val)) +SCM_HERE(SCM c_name = SCM_BOOL_F) \ +SCM_INIT(c_name = scm_permanent_object (scm_intern0 (scheme_name)); SCM_SETCDR (c_name, init_val)) #define SCM_CONST_LONG(c_name, scheme_name,value) \ SCM_VCELL_INIT(c_name, scheme_name, scm_long2num(value)) |