mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-15 16:20:17 +02:00
Code Activity

* scm_validate.h (SCM_OUT_OF_RANGE): Use scm_out_of_range_pos to

Browse source 
report the position of the argument.

* error.h, error.c (scm_out_of_range_pos):  Added this function to
take extra "pos" argument, the position number of the errant
argument.

* debug.c: Use SCM_OUT_OF_RANGE instead of scm_out_of_range.

* snarf.h: Use SCM_HERE and SCM_INIT as names, not SCM_NOTSNARF
and SCM_SNARFING.  Also put the %%% in the SCM_INIT since Mikael
prefers that and I'm reasonably indifferent.
This commit is contained in:
Greg J. Badros 2000-01-07 23:53:20 +00:00
parent 73d8385e9f
commit 1e76143f0f
5 changed files with 66 additions and 55 deletions
Download patch file Download diff file Expand all files Collapse all files

2
libguile/debug.c
View file

@ -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)) 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_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 #endif
SCM_RESET_DEBUG_MODE; SCM_RESET_DEBUG_MODE;

11
libguile/error.c
View file

@ -185,6 +185,17 @@ scm_out_of_range (const char *subr, SCM bad_value)
SCM_BOOL_F); 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"); SCM_SYMBOL (scm_args_number_key, "wrong-number-of-args");
void void
scm_wrong_num_args (SCM proc) scm_wrong_num_args (SCM proc)

2
libguile/error.h
View file

@ -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_num_overflow SCM_P ((const char *subr)) SCM_NORETURN;
extern void scm_out_of_range SCM_P ((const char *subr, SCM bad_value)) extern void scm_out_of_range SCM_P ((const char *subr, SCM bad_value))
SCM_NORETURN; 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_num_args SCM_P ((SCM proc)) SCM_NORETURN;
extern void scm_wrong_type_arg SCM_P ((const char *subr, int pos, extern void scm_wrong_type_arg SCM_P ((const char *subr, int pos,
SCM bad_value)) SCM_NORETURN; SCM bad_value)) SCM_NORETURN;

4
libguile/scm_validate.h
View file

@ -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. /* Copyright (C) 1999 Free Software Foundation, Inc.
* *
* This program is free software; you can redistribute it and/or modify * 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_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) #define SCM_ASSERT_RANGE(pos,arg,f) do { SCM_ASSERT(f,arg,SCM_OUTOFRANGE,FUNC_NAME); } while (0)

102
libguile/snarf.h
View file

@ -57,120 +57,118 @@
#define SCM_FUNC_CAST_ARBITRARY_ARGS SCM (*)() #define SCM_FUNC_CAST_ARBITRARY_ARGS SCM (*)()
#endif #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. /* Generic macros to be used in user macro definitions.
* *
* For example, in order to define a macro which creates ints and * For example, in order to define a macro which creates ints and
* initializes them to the result of foo (), do: * initializes them to the result of foo (), do:
* *
* #define SCM_FOO(NAME) \ * #define SCM_FOO(NAME) \
* SCM_INSITU (int NAME) \ * SCM_HERE (int NAME) \
* SCM_INIT (NAME = foo ()) * 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) #ifndef SCM_MAGIC_SNARFER
#define SCM_INIT(X) SCM_SNARFING(\ # define SCM_HERE(X) 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) \ #define SCM_DEFINE(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
SCM_NOTSNARF(\ SCM_HERE(\
static const char s_ ## FNAME [] = PRIMNAME; \ static const char s_ ## FNAME [] = PRIMNAME; \
SCM FNAME ARGLIST\ SCM FNAME ARGLIST\
)\ )\
SCM_SNARFING(\ SCM_INIT(\
%%% scm_make_gsubr (s_ ## FNAME, REQ, OPT, VAR, (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \ scm_make_gsubr (s_ ## FNAME, REQ, OPT, VAR, (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \
$$$P PRIMNAME #ARGLIST | REQ | OPT | VAR | __FILE__:__LINE__ | @@@ DOCSTRING @!!! \ $$$P PRIMNAME #ARGLIST | REQ | OPT | VAR | __FILE__:__LINE__ | @@@ DOCSTRING @!!! \
) )
#define SCM_DEFINE1(FNAME, PRIMNAME, TYPE, ARGLIST, DOCSTRING) \ #define SCM_DEFINE1(FNAME, PRIMNAME, TYPE, ARGLIST, DOCSTRING) \
SCM_NOTSNARF(\ SCM_HERE(\
static const char s_ ## FNAME [] = PRIMNAME; \ static const char s_ ## FNAME [] = PRIMNAME; \
SCM FNAME ARGLIST\ SCM FNAME ARGLIST\
)SCM_SNARFING(\ )SCM_INIT(\
%%% scm_make_subr (s_ ## FNAME, TYPE, FNAME); \ scm_make_subr (s_ ## FNAME, TYPE, FNAME); \
$$$1 PRIMNAME #ARGLIST | 2 | 0 | 0 | __FILE__:__LINE__ | @@@ DOCSTRING @!!! \ $$$1 PRIMNAME #ARGLIST | 2 | 0 | 0 | __FILE__:__LINE__ | @@@ DOCSTRING @!!! \
) )
#define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \ #define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \
SCM_NOTSNARF(static const char RANAME[]=STR) \ SCM_HERE(static const char RANAME[]=STR) \
SCM_SNARFING(\ SCM_INIT(\
%%% scm_make_gsubr (RANAME, REQ, OPT, VAR, (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN) \ scm_make_gsubr (RANAME, REQ, OPT, VAR, (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN) \
) )
#define SCM_REGISTER_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \ #define SCM_REGISTER_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \
SCM_NOTSNARF(\ SCM_HERE(\
static const char RANAME[]=STR \ static const char RANAME[]=STR \
)SCM_SNARFING(\ )SCM_INIT(\
%%% scm_make_gsubr (RANAME, REQ, OPT, VAR, (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN); \ scm_make_gsubr (RANAME, REQ, OPT, VAR, (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN); \
$$$R STR | REQ | OPT | VAR | __FILE__:__LINE__ | @@@ CFN @!!! \ $$$R STR | REQ | OPT | VAR | __FILE__:__LINE__ | @@@ CFN @!!! \
) )
#define SCM_GPROC(RANAME, STR, REQ, OPT, VAR, CFN, GF) \ #define SCM_GPROC(RANAME, STR, REQ, OPT, VAR, CFN, GF) \
SCM_NOTSNARF(\ SCM_HERE(\
static const char RANAME[]=STR;\ static const char RANAME[]=STR;\
static SCM GF = 0 \ static SCM GF = 0 \
)SCM_SNARFING(\ )SCM_INIT(\
%%% scm_make_gsubr_with_generic (RANAME, REQ, OPT, VAR, (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \ scm_make_gsubr_with_generic (RANAME, REQ, OPT, VAR, (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \
) )
#define SCM_PROC1(RANAME, STR, TYPE, CFN) \ #define SCM_PROC1(RANAME, STR, TYPE, CFN) \
SCM_NOTSNARF(static const char RANAME[]=STR) \ SCM_HERE(static const char RANAME[]=STR) \
SCM_SNARFING(\ SCM_INIT(\
%%% scm_make_subr(RANAME, TYPE, (SCM (*)(...))CFN) \ scm_make_subr(RANAME, TYPE, (SCM (*)(...))CFN) \
) )
#define SCM_GPROC1(RANAME, STR, TYPE, CFN, GF) \ #define SCM_GPROC1(RANAME, STR, TYPE, CFN, GF) \
SCM_NOTSNARF(\ SCM_HERE(\
static const char RANAME[]=STR; \ static const char RANAME[]=STR; \
static SCM GF = 0 \ static SCM GF = 0 \
)SCM_SNARFING(\ )SCM_INIT(\
%%% scm_make_subr_with_generic(RANAME, TYPE, (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \ scm_make_subr_with_generic(RANAME, TYPE, (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \
) )
#define SCM_SYNTAX(RANAME, STR, TYPE, CFN) \ #define SCM_SYNTAX(RANAME, STR, TYPE, CFN) \
SCM_NOTSNARF(static const char RANAME[]=STR)\ SCM_HERE(static const char RANAME[]=STR)\
SCM_SNARFING(%%% scm_make_synt (RANAME, TYPE, CFN)) SCM_INIT(scm_make_synt (RANAME, TYPE, CFN))
#define SCM_SYMBOL(c_name, scheme_name) \ #define SCM_SYMBOL(c_name, scheme_name) \
SCM_NOTSNARF(static SCM c_name = SCM_BOOL_F) \ SCM_HERE(static SCM c_name = SCM_BOOL_F) \
SCM_SNARFING(%%% c_name = scm_permanent_object (SCM_CAR (scm_intern0 (scheme_name)))) SCM_INIT(c_name = scm_permanent_object (SCM_CAR (scm_intern0 (scheme_name))))
#define SCM_GLOBAL_SYMBOL(c_name, scheme_name) \ #define SCM_GLOBAL_SYMBOL(c_name, scheme_name) \
SCM_NOTSNARF(SCM c_name = SCM_BOOL_F) \ SCM_HERE(SCM c_name = SCM_BOOL_F) \
SCM_SNARFING(%%% c_name = scm_permanent_object (SCM_CAR (scm_intern0 (scheme_name)))) SCM_INIT(c_name = scm_permanent_object (SCM_CAR (scm_intern0 (scheme_name))))
#define SCM_KEYWORD(c_name, scheme_name) \ #define SCM_KEYWORD(c_name, scheme_name) \
SCM_NOTSNARF(static SCM c_name = SCM_BOOL_F) \ SCM_HERE(static SCM c_name = SCM_BOOL_F) \
SCM_SNARFING(%%% c_name = scm_permanent_object (scm_c_make_keyword (scheme_name))) SCM_INIT(c_name = scm_permanent_object (scm_c_make_keyword (scheme_name)))
#define SCM_GLOBAL_KEYWORD(c_name, scheme_name) \ #define SCM_GLOBAL_KEYWORD(c_name, scheme_name) \
SCM_NOTSNARF(SCM c_name = SCM_BOOL_F) \ SCM_HERE(SCM c_name = SCM_BOOL_F) \
SCM_SNARFING(%%% c_name = scm_permanent_object (scm_c_make_keyword (scheme_name))) SCM_INIT(c_name = scm_permanent_object (scm_c_make_keyword (scheme_name)))
#define SCM_VCELL(c_name, scheme_name) \ #define SCM_VCELL(c_name, scheme_name) \
SCM_NOTSNARF(static SCM c_name = SCM_BOOL_F) \ SCM_HERE(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_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) \ #define SCM_GLOBAL_VCELL(c_name, scheme_name) \
SCM_NOTSNARF(SCM c_name = SCM_BOOL_F) \ SCM_HERE(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_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) \ #define SCM_VCELL_INIT(c_name, scheme_name, init_val) \
SCM_NOTSNARF(static SCM c_name = SCM_BOOL_F) \ SCM_HERE(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_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) \ #define SCM_GLOBAL_VCELL_INIT(c_name, scheme_name, init_val) \
SCM_NOTSNARF(SCM c_name = SCM_BOOL_F) \ SCM_HERE(SCM c_name = SCM_BOOL_F) \
SCM_SNARFING(%%% c_name = scm_permanent_object (scm_intern0 (scheme_name)); SCM_SETCDR (c_name, init_val)) 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) \ #define SCM_CONST_LONG(c_name, scheme_name,value) \
SCM_VCELL_INIT(c_name, scheme_name, scm_long2num(value)) SCM_VCELL_INIT(c_name, scheme_name, scm_long2num(value))