summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/debug.c2
-rw-r--r--libguile/error.c11
-rw-r--r--libguile/error.h2
-rw-r--r--libguile/scm_validate.h4
-rw-r--r--libguile/snarf.h102
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))