mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-15 16:20:17 +02:00
* __scm.h (SCM_ASSERT, SCM_WTA_DISPATCH_0, SCM_WTA_DISPATCH_1,
SCM_WTA_DISPATCH_2, SCM_WTA_DISPATCH_n): Don't call scm_wta, call scm_wrong_type_arg instead. (SCM_WNA): Deprecated. * error.[ch] (scm_wta): Deprecated. * numbers.c (s_i_log): Minor comment fix. * read.c (scm_lreadr), unif.c (scm_aind, scm_shap2ra, scm_make_shared_array, scm_transpose_array, scm_enclose_array, scm_array_in_bounds_p): Don't use SCM_ASSERT to check for wrong-num-args or misc errors. * unif.c (scm_make_shared_array, scm_transpose_array, scm_enclose_array, scm_array_in_bounds_p, scm_array_set_x): Validate the rest argument (note: this is only done when guile is built with SCM_DEBUG_REST_ARGUMENT=1) (scm_array_in_bounds_p, scm_uniform_vector_ref, scm_array_set_x): Replace calls to scm_wrong_num_args by SCM_WRONG_NUM_ARGS. * validate.h (SCM_FUNC_NAME, SCM_VALIDATE_NUMBER_COPY, SCM_VALIDATE_NUMBER_DEF_COPY): Deprecated.
This commit is contained in:
parent
68baa7e7f8
commit
b3fcac341b
10 changed files with 140 additions and 85 deletions
10
NEWS
10
NEWS
|
@ -572,7 +572,9 @@ SCM_SUBSTRP, SCM_SUBSTR_STR, SCM_SUBSTR_OFFSET, SCM_COERCE_SUBSTR,
|
||||||
SCM_ROSTRINGP, SCM_RWSTRINGP, SCM_VALIDATE_RWSTRING, SCM_ROCHARS,
|
SCM_ROSTRINGP, SCM_RWSTRINGP, SCM_VALIDATE_RWSTRING, SCM_ROCHARS,
|
||||||
SCM_ROUCHARS, SCM_SETLENGTH, SCM_SETCHARS, SCM_LENGTH_MAX, SCM_GC8MARKP,
|
SCM_ROUCHARS, SCM_SETLENGTH, SCM_SETCHARS, SCM_LENGTH_MAX, SCM_GC8MARKP,
|
||||||
SCM_SETGC8MARK, SCM_CLRGC8MARK, SCM_GCTYP16, SCM_GCCDR, SCM_SUBR_DOC,
|
SCM_SETGC8MARK, SCM_CLRGC8MARK, SCM_GCTYP16, SCM_GCCDR, SCM_SUBR_DOC,
|
||||||
SCM_OPDIRP, SCM_VALIDATE_OPDIR, SCM_WTA, RETURN_SCM_WTA, SCM_CONST_LONG
|
SCM_OPDIRP, SCM_VALIDATE_OPDIR, SCM_WTA, RETURN_SCM_WTA, SCM_CONST_LONG,
|
||||||
|
SCM_WNA, SCM_FUNC_NAME, SCM_VALIDATE_NUMBER_COPY,
|
||||||
|
SCM_VALIDATE_NUMBER_DEF_COPY
|
||||||
|
|
||||||
Use SCM_ASSERT_RANGE or SCM_VALIDATE_XXX_RANGE instead of SCM_OUTOFRANGE.
|
Use SCM_ASSERT_RANGE or SCM_VALIDATE_XXX_RANGE instead of SCM_OUTOFRANGE.
|
||||||
Use scm_memory_error instead of SCM_NALLOC.
|
Use scm_memory_error instead of SCM_NALLOC.
|
||||||
|
@ -600,6 +602,7 @@ Use SCM_DIR_OPEN_P instead of SCM_OPDIRP.
|
||||||
Use SCM_MISC_ERROR or SCM_WRONG_TYPE_ARG instead of SCM_WTA.
|
Use SCM_MISC_ERROR or SCM_WRONG_TYPE_ARG instead of SCM_WTA.
|
||||||
Use SCM_MISC_ERROR or SCM_WRONG_TYPE_ARG instead of RETURN_SCM_WTA.
|
Use SCM_MISC_ERROR or SCM_WRONG_TYPE_ARG instead of RETURN_SCM_WTA.
|
||||||
Use SCM_VCELL_INIT instead of SCM_CONST_LONG.
|
Use SCM_VCELL_INIT instead of SCM_CONST_LONG.
|
||||||
|
Use SCM_WRONG_NUM_ARGS instead of SCM_WNA.
|
||||||
|
|
||||||
** Removed function: scm_struct_init
|
** Removed function: scm_struct_init
|
||||||
|
|
||||||
|
@ -646,6 +649,11 @@ This can be used to set an apply function to a smob type.
|
||||||
|
|
||||||
Use scm_object_to_string instead.
|
Use scm_object_to_string instead.
|
||||||
|
|
||||||
|
** Deprecated function: scm_wta
|
||||||
|
|
||||||
|
Use scm_wrong_type_arg, or another appropriate error signalling function
|
||||||
|
instead.
|
||||||
|
|
||||||
|
|
||||||
Changes since Guile 1.3.4:
|
Changes since Guile 1.3.4:
|
||||||
|
|
||||||
|
|
5
RELEASE
5
RELEASE
|
@ -59,7 +59,9 @@ In release 1.6:
|
||||||
SCM_COERCE_SUBSTR, SCM_ROSTRINGP, SCM_RWSTRINGP, SCM_VALIDATE_RWSTRING,
|
SCM_COERCE_SUBSTR, SCM_ROSTRINGP, SCM_RWSTRINGP, SCM_VALIDATE_RWSTRING,
|
||||||
SCM_ROCHARS, SCM_ROUCHARS, SCM_SETLENGTH, SCM_SETCHARS, SCM_LENGTH_MAX,
|
SCM_ROCHARS, SCM_ROUCHARS, SCM_SETLENGTH, SCM_SETCHARS, SCM_LENGTH_MAX,
|
||||||
SCM_GC8MARKP, SCM_SETGC8MARK, SCM_CLRGC8MARK, SCM_GCTYP16, SCM_GCCDR,
|
SCM_GC8MARKP, SCM_SETGC8MARK, SCM_CLRGC8MARK, SCM_GCTYP16, SCM_GCCDR,
|
||||||
SCM_SUBR_DOC, SCM_OPDIRP, SCM_VALIDATE_OPDIR, SCM_WTA, RETURN_SCM_WTA
|
SCM_SUBR_DOC, SCM_OPDIRP, SCM_VALIDATE_OPDIR, SCM_WTA, RETURN_SCM_WTA,
|
||||||
|
SCM_WNA, SCM_FUNC_NAME, SCM_VALIDATE_NUMBER_COPY,
|
||||||
|
SCM_VALIDATE_NUMBER_DEF_COPY
|
||||||
- remove scm_vector_set_length_x
|
- remove scm_vector_set_length_x
|
||||||
- remove function scm_call_catching_errors
|
- remove function scm_call_catching_errors
|
||||||
(replaced by catch functions from throw.[ch])
|
(replaced by catch functions from throw.[ch])
|
||||||
|
@ -80,6 +82,7 @@ In release 1.6:
|
||||||
- remove scm_close_all_ports_except
|
- remove scm_close_all_ports_except
|
||||||
- remove scm_strprint_obj
|
- remove scm_strprint_obj
|
||||||
- remove SCM_CONST_LONG
|
- remove SCM_CONST_LONG
|
||||||
|
- remove scm_wta
|
||||||
|
|
||||||
Modules sort.c and random.c should be factored out into separate
|
Modules sort.c and random.c should be factored out into separate
|
||||||
modules (but still be distributed with guile-core) when we get a new
|
modules (but still be distributed with guile-core) when we get a new
|
||||||
|
|
|
@ -1,3 +1,31 @@
|
||||||
|
2001-03-17 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||||
|
|
||||||
|
* __scm.h (SCM_ASSERT, SCM_WTA_DISPATCH_0, SCM_WTA_DISPATCH_1,
|
||||||
|
SCM_WTA_DISPATCH_2, SCM_WTA_DISPATCH_n): Don't call scm_wta, call
|
||||||
|
scm_wrong_type_arg instead.
|
||||||
|
|
||||||
|
(SCM_WNA): Deprecated.
|
||||||
|
|
||||||
|
* error.[ch] (scm_wta): Deprecated.
|
||||||
|
|
||||||
|
* numbers.c (s_i_log): Minor comment fix.
|
||||||
|
|
||||||
|
* read.c (scm_lreadr), unif.c (scm_aind, scm_shap2ra,
|
||||||
|
scm_make_shared_array, scm_transpose_array, scm_enclose_array,
|
||||||
|
scm_array_in_bounds_p): Don't use SCM_ASSERT to check for
|
||||||
|
wrong-num-args or misc errors.
|
||||||
|
|
||||||
|
* unif.c (scm_make_shared_array, scm_transpose_array,
|
||||||
|
scm_enclose_array, scm_array_in_bounds_p, scm_array_set_x):
|
||||||
|
Validate the rest argument (note: this is only done when guile is
|
||||||
|
built with SCM_DEBUG_REST_ARGUMENT=1)
|
||||||
|
|
||||||
|
(scm_array_in_bounds_p, scm_uniform_vector_ref, scm_array_set_x):
|
||||||
|
Replace calls to scm_wrong_num_args by SCM_WRONG_NUM_ARGS.
|
||||||
|
|
||||||
|
* validate.h (SCM_FUNC_NAME, SCM_VALIDATE_NUMBER_COPY,
|
||||||
|
SCM_VALIDATE_NUMBER_DEF_COPY): Deprecated.
|
||||||
|
|
||||||
2001-03-17 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
2001-03-17 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||||
|
|
||||||
* validate.h (SCM_WRONG_NUM_ARGS): Call scm_error_num_args_subr
|
* validate.h (SCM_WRONG_NUM_ARGS): Call scm_error_num_args_subr
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
|
|
||||||
#ifndef __SCMH
|
#ifndef __SCMH
|
||||||
#define __SCMH
|
#define __SCMH
|
||||||
/* Copyright (C) 1995, 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
|
/* Copyright (C) 1995,1996,1998,1999,2000,2001 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
|
||||||
* it under the terms of the GNU General Public License as published by
|
* it under the terms of the GNU General Public License as published by
|
||||||
|
@ -488,7 +488,7 @@ do { \
|
||||||
#else
|
#else
|
||||||
#define SCM_ASSERT(_cond, _arg, _pos, _subr) \
|
#define SCM_ASSERT(_cond, _arg, _pos, _subr) \
|
||||||
if (!(_cond)) \
|
if (!(_cond)) \
|
||||||
scm_wta(_arg, (char *)(_pos), _subr)
|
scm_wrong_type_arg (_subr, _pos, _arg)
|
||||||
#define SCM_ASSERT_TYPE(_cond, _arg, _pos, _subr, _msg) \
|
#define SCM_ASSERT_TYPE(_cond, _arg, _pos, _subr, _msg) \
|
||||||
if (!(_cond)) \
|
if (!(_cond)) \
|
||||||
scm_wrong_type_arg_msg(_subr, _pos, _arg, _msg)
|
scm_wrong_type_arg_msg(_subr, _pos, _arg, _msg)
|
||||||
|
@ -511,7 +511,7 @@ extern SCM scm_call_generic_0 (SCM gf);
|
||||||
#define SCM_WTA_DISPATCH_0(gf, arg, pos, subr) \
|
#define SCM_WTA_DISPATCH_0(gf, arg, pos, subr) \
|
||||||
return (SCM_UNPACK (gf) \
|
return (SCM_UNPACK (gf) \
|
||||||
? scm_call_generic_0 ((gf)) \
|
? scm_call_generic_0 ((gf)) \
|
||||||
: scm_wta ((arg), (char *) (pos), (subr)))
|
: scm_wrong_type_arg ((subr), (pos), (arg)), 0)
|
||||||
#define SCM_GASSERT0(cond, gf, arg, pos, subr) \
|
#define SCM_GASSERT0(cond, gf, arg, pos, subr) \
|
||||||
if (!(cond)) SCM_WTA_DISPATCH_0((gf), (arg), (pos), (subr))
|
if (!(cond)) SCM_WTA_DISPATCH_0((gf), (arg), (pos), (subr))
|
||||||
|
|
||||||
|
@ -520,7 +520,7 @@ extern SCM scm_call_generic_1 (SCM gf, SCM a1);
|
||||||
#define SCM_WTA_DISPATCH_1(gf, a1, pos, subr) \
|
#define SCM_WTA_DISPATCH_1(gf, a1, pos, subr) \
|
||||||
return (SCM_UNPACK (gf) \
|
return (SCM_UNPACK (gf) \
|
||||||
? scm_call_generic_1 ((gf), (a1)) \
|
? scm_call_generic_1 ((gf), (a1)) \
|
||||||
: scm_wta ((a1), (char *) (pos), (subr)))
|
: scm_wrong_type_arg ((subr), (pos), (a1)), 0)
|
||||||
#define SCM_GASSERT1(cond, gf, a1, pos, subr) \
|
#define SCM_GASSERT1(cond, gf, a1, pos, subr) \
|
||||||
if (!(cond)) SCM_WTA_DISPATCH_1((gf), (a1), (pos), (subr))
|
if (!(cond)) SCM_WTA_DISPATCH_1((gf), (a1), (pos), (subr))
|
||||||
|
|
||||||
|
@ -529,7 +529,8 @@ extern SCM scm_call_generic_2 (SCM gf, SCM a1, SCM a2);
|
||||||
#define SCM_WTA_DISPATCH_2(gf, a1, a2, pos, subr) \
|
#define SCM_WTA_DISPATCH_2(gf, a1, a2, pos, subr) \
|
||||||
return (SCM_UNPACK (gf) \
|
return (SCM_UNPACK (gf) \
|
||||||
? scm_call_generic_2 ((gf), (a1), (a2)) \
|
? scm_call_generic_2 ((gf), (a1), (a2)) \
|
||||||
: scm_wta ((pos) == SCM_ARG1 ? (a1) : (a2), (char *) (pos), (subr)))
|
: scm_wrong_type_arg ((subr), (pos), \
|
||||||
|
(pos) == SCM_ARG1 ? (a1) : (a2)), 0)
|
||||||
#define SCM_GASSERT2(cond, gf, a1, a2, pos, subr) \
|
#define SCM_GASSERT2(cond, gf, a1, a2, pos, subr) \
|
||||||
if (!(cond)) SCM_WTA_DISPATCH_2((gf), (a1), (a2), (pos), (subr))
|
if (!(cond)) SCM_WTA_DISPATCH_2((gf), (a1), (a2), (pos), (subr))
|
||||||
|
|
||||||
|
@ -538,9 +539,9 @@ extern SCM scm_apply_generic (SCM gf, SCM args);
|
||||||
#define SCM_WTA_DISPATCH_n(gf, args, pos, subr) \
|
#define SCM_WTA_DISPATCH_n(gf, args, pos, subr) \
|
||||||
return (SCM_UNPACK (gf) \
|
return (SCM_UNPACK (gf) \
|
||||||
? scm_apply_generic ((gf), (args)) \
|
? scm_apply_generic ((gf), (args)) \
|
||||||
: scm_wta (scm_list_ref ((args), SCM_MAKINUM ((pos) - 1)), \
|
: scm_wrong_type_arg ((subr), (pos), \
|
||||||
(char *) (pos), \
|
scm_list_ref ((args), \
|
||||||
(subr)))
|
SCM_MAKINUM ((pos) - 1))), 0)
|
||||||
#define SCM_GASSERTn(cond, gf, args, pos, subr) \
|
#define SCM_GASSERTn(cond, gf, args, pos, subr) \
|
||||||
if (!(cond)) SCM_WTA_DISPATCH_n((gf), (args), (pos), (subr))
|
if (!(cond)) SCM_WTA_DISPATCH_n((gf), (args), (pos), (subr))
|
||||||
|
|
||||||
|
@ -562,12 +563,11 @@ extern SCM scm_apply_generic (SCM gf, SCM args);
|
||||||
#define SCM_ARG6 6
|
#define SCM_ARG6 6
|
||||||
#define SCM_ARG7 7
|
#define SCM_ARG7 7
|
||||||
|
|
||||||
/* SCM_WNA must follow the last SCM_ARGn in sequence.
|
|
||||||
*/
|
|
||||||
#define SCM_WNA 8
|
|
||||||
|
|
||||||
#if (SCM_DEBUG_DEPRECATED == 0)
|
#if (SCM_DEBUG_DEPRECATED == 0)
|
||||||
|
|
||||||
|
/* Use SCM_WRONG_NUM_ARGS instead of: */
|
||||||
|
#define SCM_WNA 8
|
||||||
|
|
||||||
/* Use SCM_ASSERT_RANGE or SCM_VALIDATE_XXX_RANGE instead of: */
|
/* Use SCM_ASSERT_RANGE or SCM_VALIDATE_XXX_RANGE instead of: */
|
||||||
#define SCM_OUTOFRANGE 10
|
#define SCM_OUTOFRANGE 10
|
||||||
|
|
||||||
|
|
|
@ -314,7 +314,8 @@ scm_misc_error (const char *subr, const char *message, SCM args)
|
||||||
scm_error (scm_misc_error_key, subr, message, args, SCM_BOOL_F);
|
scm_error (scm_misc_error_key, subr, message, args, SCM_BOOL_F);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* implements the SCM_ASSERT interface. */
|
#if (SCM_DEBUG_DEPRECATED == 0)
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
scm_wta (SCM arg, const char *pos, const char *s_subr)
|
scm_wta (SCM arg, const char *pos, const char *s_subr)
|
||||||
{
|
{
|
||||||
|
@ -350,16 +351,10 @@ scm_wta (SCM arg, const char *pos, const char *s_subr)
|
||||||
scm_wrong_type_arg (s_subr, 7, arg);
|
scm_wrong_type_arg (s_subr, 7, arg);
|
||||||
case SCM_WNA:
|
case SCM_WNA:
|
||||||
scm_wrong_num_args (arg);
|
scm_wrong_num_args (arg);
|
||||||
|
|
||||||
#if (SCM_DEBUG_DEPRECATED == 0)
|
|
||||||
|
|
||||||
case SCM_OUTOFRANGE:
|
case SCM_OUTOFRANGE:
|
||||||
scm_out_of_range (s_subr, arg);
|
scm_out_of_range (s_subr, arg);
|
||||||
case SCM_NALLOC:
|
case SCM_NALLOC:
|
||||||
scm_memory_error (s_subr);
|
scm_memory_error (s_subr);
|
||||||
|
|
||||||
#endif /* SCM_DEBUG_DEPRECATED == 0 */
|
|
||||||
|
|
||||||
default:
|
default:
|
||||||
/* this shouldn't happen. */
|
/* this shouldn't happen. */
|
||||||
scm_misc_error (s_subr, "Unknown error", SCM_EOL);
|
scm_misc_error (s_subr, "Unknown error", SCM_EOL);
|
||||||
|
@ -368,6 +363,8 @@ scm_wta (SCM arg, const char *pos, const char *s_subr)
|
||||||
return SCM_UNSPECIFIED;
|
return SCM_UNSPECIFIED;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#endif /* SCM_DEBUG_DEPRECATED == 0 */
|
||||||
|
|
||||||
void
|
void
|
||||||
scm_init_error ()
|
scm_init_error ()
|
||||||
{
|
{
|
||||||
|
|
|
@ -81,7 +81,6 @@ extern void scm_wrong_type_arg_msg (const char *subr, int pos,
|
||||||
extern void scm_memory_error (const char *subr) SCM_NORETURN;
|
extern void scm_memory_error (const char *subr) SCM_NORETURN;
|
||||||
extern void scm_misc_error (const char *subr, const char *message,
|
extern void scm_misc_error (const char *subr, const char *message,
|
||||||
SCM args) SCM_NORETURN;
|
SCM args) SCM_NORETURN;
|
||||||
extern SCM scm_wta (SCM arg, const char *pos, const char *s_subr);
|
|
||||||
extern void scm_init_error (void);
|
extern void scm_init_error (void);
|
||||||
|
|
||||||
|
|
||||||
|
@ -89,6 +88,7 @@ extern void scm_init_error (void);
|
||||||
#if (SCM_DEBUG_DEPRECATED == 0)
|
#if (SCM_DEBUG_DEPRECATED == 0)
|
||||||
|
|
||||||
extern void scm_sysmissing (const char *subr) SCM_NORETURN;
|
extern void scm_sysmissing (const char *subr) SCM_NORETURN;
|
||||||
|
extern SCM scm_wta (SCM arg, const char *pos, const char *s_subr);
|
||||||
|
|
||||||
#endif /* SCM_DEBUG_DEPRECATED == 0 */
|
#endif /* SCM_DEBUG_DEPRECATED == 0 */
|
||||||
|
|
||||||
|
|
|
@ -4000,7 +4000,7 @@ SCM_GPROC1 (s_i_exp, "$exp", scm_tc7_cxr, (SCM (*)()) exp, g_i_exp);
|
||||||
/* "Return the @var{x}th power of e."
|
/* "Return the @var{x}th power of e."
|
||||||
*/
|
*/
|
||||||
SCM_GPROC1 (s_i_log, "$log", scm_tc7_cxr, (SCM (*)()) log, g_i_log);
|
SCM_GPROC1 (s_i_log, "$log", scm_tc7_cxr, (SCM (*)()) log, g_i_log);
|
||||||
/* "Return the natural logarithm of the real number@var{x}."
|
/* "Return the natural logarithm of the real number @var{x}."
|
||||||
*/
|
*/
|
||||||
SCM_GPROC1 (s_i_sin, "$sin", scm_tc7_cxr, (SCM (*)()) sin, g_i_sin);
|
SCM_GPROC1 (s_i_sin, "$sin", scm_tc7_cxr, (SCM (*)()) sin, g_i_sin);
|
||||||
/* "Return the sine of the real number @var{x}."
|
/* "Return the sine of the real number @var{x}."
|
||||||
|
|
|
@ -445,7 +445,8 @@ tryagain_no_flush_ws:
|
||||||
j = 0;
|
j = 0;
|
||||||
while ('"' != (c = scm_getc (port)))
|
while ('"' != (c = scm_getc (port)))
|
||||||
{
|
{
|
||||||
SCM_ASSERT (EOF != c, SCM_UNDEFINED, "end of file in ", "string");
|
if (c == EOF)
|
||||||
|
SCM_MISC_ERROR ("end of file in string constant", SCM_EOL);
|
||||||
|
|
||||||
while (j + 2 >= SCM_STRING_LENGTH (*tok_buf))
|
while (j + 2 >= SCM_STRING_LENGTH (*tok_buf))
|
||||||
scm_grow_tok_buf (tok_buf);
|
scm_grow_tok_buf (tok_buf);
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
/* Copyright (C) 1995,1996,1997,1998, 2000, 2001 Free Software Foundation, Inc.
|
/* Copyright (C) 1995,1996,1997,1998,2000,2001 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
|
||||||
* it under the terms of the GNU General Public License as published by
|
* it under the terms of the GNU General Public License as published by
|
||||||
|
@ -485,6 +485,7 @@ static char s_bad_ind[] = "Bad scm_array index";
|
||||||
|
|
||||||
long
|
long
|
||||||
scm_aind (SCM ra, SCM args, const char *what)
|
scm_aind (SCM ra, SCM args, const char *what)
|
||||||
|
#define FUNC_NAME what
|
||||||
{
|
{
|
||||||
SCM ind;
|
SCM ind;
|
||||||
register long j;
|
register long j;
|
||||||
|
@ -493,14 +494,16 @@ scm_aind (SCM ra, SCM args, const char *what)
|
||||||
scm_array_dim *s = SCM_ARRAY_DIMS (ra);
|
scm_array_dim *s = SCM_ARRAY_DIMS (ra);
|
||||||
if (SCM_INUMP (args))
|
if (SCM_INUMP (args))
|
||||||
{
|
{
|
||||||
SCM_ASSERT (1 == k, scm_makfrom0str (what), SCM_WNA, NULL);
|
if (k != 1)
|
||||||
|
scm_error_num_args_subr (what);
|
||||||
return pos + (SCM_INUM (args) - s->lbnd) * (s->inc);
|
return pos + (SCM_INUM (args) - s->lbnd) * (s->inc);
|
||||||
}
|
}
|
||||||
while (k && SCM_NIMP (args))
|
while (k && SCM_NIMP (args))
|
||||||
{
|
{
|
||||||
ind = SCM_CAR (args);
|
ind = SCM_CAR (args);
|
||||||
args = SCM_CDR (args);
|
args = SCM_CDR (args);
|
||||||
SCM_ASSERT (SCM_INUMP (ind), ind, s_bad_ind, what);
|
if (!SCM_INUMP (ind))
|
||||||
|
scm_misc_error (what, s_bad_ind, SCM_EOL);
|
||||||
j = SCM_INUM (ind);
|
j = SCM_INUM (ind);
|
||||||
if (j < s->lbnd || j > s->ubnd)
|
if (j < s->lbnd || j > s->ubnd)
|
||||||
scm_out_of_range (what, ind);
|
scm_out_of_range (what, ind);
|
||||||
|
@ -508,11 +511,12 @@ scm_aind (SCM ra, SCM args, const char *what)
|
||||||
k--;
|
k--;
|
||||||
s++;
|
s++;
|
||||||
}
|
}
|
||||||
SCM_ASSERT (0 == k && SCM_NULLP (args), scm_makfrom0str (what), SCM_WNA,
|
if (k != 0 || !SCM_NULLP (args))
|
||||||
NULL);
|
scm_error_num_args_subr (what);
|
||||||
|
|
||||||
return pos;
|
return pos;
|
||||||
}
|
}
|
||||||
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
|
@ -539,7 +543,9 @@ scm_shap2ra (SCM args, const char *what)
|
||||||
scm_array_dim *s;
|
scm_array_dim *s;
|
||||||
SCM ra, spec, sp;
|
SCM ra, spec, sp;
|
||||||
int ndim = scm_ilength (args);
|
int ndim = scm_ilength (args);
|
||||||
SCM_ASSERT (0 <= ndim, args, s_bad_spec, what);
|
if (ndim < 0)
|
||||||
|
scm_misc_error (what, s_bad_spec, SCM_EOL);
|
||||||
|
|
||||||
ra = scm_make_ra (ndim);
|
ra = scm_make_ra (ndim);
|
||||||
SCM_ARRAY_BASE (ra) = 0;
|
SCM_ARRAY_BASE (ra) = 0;
|
||||||
s = SCM_ARRAY_DIMS (ra);
|
s = SCM_ARRAY_DIMS (ra);
|
||||||
|
@ -548,20 +554,22 @@ scm_shap2ra (SCM args, const char *what)
|
||||||
spec = SCM_CAR (args);
|
spec = SCM_CAR (args);
|
||||||
if (SCM_INUMP (spec))
|
if (SCM_INUMP (spec))
|
||||||
{
|
{
|
||||||
SCM_ASSERT (SCM_INUM (spec) >= 0, spec, s_bad_spec, what);
|
if (SCM_INUM (spec) < 0)
|
||||||
|
scm_misc_error (what, s_bad_spec, SCM_EOL);
|
||||||
s->lbnd = 0;
|
s->lbnd = 0;
|
||||||
s->ubnd = SCM_INUM (spec) - 1;
|
s->ubnd = SCM_INUM (spec) - 1;
|
||||||
s->inc = 1;
|
s->inc = 1;
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
SCM_ASSERT (SCM_CONSP (spec) && SCM_INUMP (SCM_CAR (spec)), spec,
|
if (!SCM_CONSP (spec) || !SCM_INUMP (SCM_CAR (spec)))
|
||||||
s_bad_spec, what);
|
scm_misc_error (what, s_bad_spec, SCM_EOL);
|
||||||
s->lbnd = SCM_INUM (SCM_CAR (spec));
|
s->lbnd = SCM_INUM (SCM_CAR (spec));
|
||||||
sp = SCM_CDR (spec);
|
sp = SCM_CDR (spec);
|
||||||
SCM_ASSERT (SCM_CONSP (sp)
|
if (!SCM_CONSP (sp)
|
||||||
&& SCM_INUMP (SCM_CAR (sp)) && SCM_NULLP (SCM_CDR (sp)),
|
|| !SCM_INUMP (SCM_CAR (sp))
|
||||||
spec, s_bad_spec, what);
|
|| !SCM_NULLP (SCM_CDR (sp)))
|
||||||
|
scm_misc_error (what, s_bad_spec, SCM_EOL);
|
||||||
s->ubnd = SCM_INUM (SCM_CAR (sp));
|
s->ubnd = SCM_INUM (SCM_CAR (sp));
|
||||||
s->inc = 1;
|
s->inc = 1;
|
||||||
}
|
}
|
||||||
|
@ -670,6 +678,8 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
|
||||||
scm_sizet i, k;
|
scm_sizet i, k;
|
||||||
long old_min, new_min, old_max, new_max;
|
long old_min, new_min, old_max, new_max;
|
||||||
scm_array_dim *s;
|
scm_array_dim *s;
|
||||||
|
|
||||||
|
SCM_VALIDATE_REST_ARGUMENT (dims);
|
||||||
SCM_VALIDATE_ARRAY (1,oldra);
|
SCM_VALIDATE_ARRAY (1,oldra);
|
||||||
SCM_VALIDATE_PROC (2,mapfunc);
|
SCM_VALIDATE_PROC (2,mapfunc);
|
||||||
ra = scm_shap2ra (dims, FUNC_NAME);
|
ra = scm_shap2ra (dims, FUNC_NAME);
|
||||||
|
@ -715,8 +725,8 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
|
||||||
if (SCM_NINUMP (imap))
|
if (SCM_NINUMP (imap))
|
||||||
|
|
||||||
{
|
{
|
||||||
SCM_ASSERT (1 == scm_ilength (imap) && SCM_INUMP (SCM_CAR (imap)),
|
if (scm_ilength (imap) != 1 || !SCM_INUMP (SCM_CAR (imap)))
|
||||||
imap, s_bad_ind, FUNC_NAME);
|
SCM_MISC_ERROR (s_bad_ind, SCM_EOL);
|
||||||
imap = SCM_CAR (imap);
|
imap = SCM_CAR (imap);
|
||||||
}
|
}
|
||||||
i = SCM_INUM (imap);
|
i = SCM_INUM (imap);
|
||||||
|
@ -736,10 +746,9 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
if (SCM_NINUMP (imap))
|
if (SCM_NINUMP (imap))
|
||||||
|
|
||||||
{
|
{
|
||||||
SCM_ASSERT (1 == scm_ilength (imap) && SCM_INUMP (SCM_CAR (imap)),
|
if (scm_ilength (imap) != 1 || !SCM_INUMP (SCM_CAR (imap)))
|
||||||
imap, s_bad_ind, FUNC_NAME);
|
SCM_MISC_ERROR (s_bad_ind, SCM_EOL);
|
||||||
imap = SCM_CAR (imap);
|
imap = SCM_CAR (imap);
|
||||||
}
|
}
|
||||||
s[k].inc = (long) SCM_INUM (imap) - i;
|
s[k].inc = (long) SCM_INUM (imap) - i;
|
||||||
|
@ -754,8 +763,8 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
|
||||||
s[k].inc = new_max - new_min + 1; /* contiguous by default */
|
s[k].inc = new_max - new_min + 1; /* contiguous by default */
|
||||||
indptr = SCM_CDR (indptr);
|
indptr = SCM_CDR (indptr);
|
||||||
}
|
}
|
||||||
SCM_ASSERT (old_min <= new_min && old_max >= new_max, SCM_UNDEFINED,
|
if (old_min > new_min || old_max < new_max)
|
||||||
"mapping out of range", FUNC_NAME);
|
SCM_MISC_ERROR ("mapping out of range", SCM_EOL);
|
||||||
if (1 == SCM_ARRAY_NDIM (ra) && 0 == SCM_ARRAY_BASE (ra))
|
if (1 == SCM_ARRAY_NDIM (ra) && 0 == SCM_ARRAY_BASE (ra))
|
||||||
{
|
{
|
||||||
SCM v = SCM_ARRAY_V (ra);
|
SCM v = SCM_ARRAY_V (ra);
|
||||||
|
@ -797,6 +806,7 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
|
||||||
scm_array_dim *s, *r;
|
scm_array_dim *s, *r;
|
||||||
int ndim, i, k;
|
int ndim, i, k;
|
||||||
|
|
||||||
|
SCM_VALIDATE_REST_ARGUMENT (args);
|
||||||
SCM_ASSERT (SCM_NIMP (ra), ra, SCM_ARG1, FUNC_NAME);
|
SCM_ASSERT (SCM_NIMP (ra), ra, SCM_ARG1, FUNC_NAME);
|
||||||
switch (SCM_TYP7 (ra))
|
switch (SCM_TYP7 (ra))
|
||||||
{
|
{
|
||||||
|
@ -814,18 +824,17 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
|
||||||
#ifdef HAVE_LONG_LONGS
|
#ifdef HAVE_LONG_LONGS
|
||||||
case scm_tc7_llvect:
|
case scm_tc7_llvect:
|
||||||
#endif
|
#endif
|
||||||
SCM_ASSERT (!SCM_NULLP (args) && SCM_NULLP (SCM_CDR (args)),
|
if (SCM_NULLP (args) || !SCM_NULLP (SCM_CDR (args)))
|
||||||
scm_makfrom0str (FUNC_NAME), SCM_WNA, NULL);
|
SCM_WRONG_NUM_ARGS ();
|
||||||
SCM_ASSERT (SCM_INUMP (SCM_CAR (args)), SCM_CAR (args), SCM_ARG2,
|
SCM_VALIDATE_INUM (SCM_ARG2, SCM_CAR (args));
|
||||||
FUNC_NAME);
|
|
||||||
SCM_ASSERT_RANGE (SCM_ARG2, SCM_CAR (args),
|
SCM_ASSERT_RANGE (SCM_ARG2, SCM_CAR (args),
|
||||||
SCM_EQ_P (SCM_INUM0, SCM_CAR (args)));
|
SCM_EQ_P (SCM_INUM0, SCM_CAR (args)));
|
||||||
return ra;
|
return ra;
|
||||||
case scm_tc7_smob:
|
case scm_tc7_smob:
|
||||||
SCM_ASRTGO (SCM_ARRAYP (ra), badarg);
|
SCM_ASRTGO (SCM_ARRAYP (ra), badarg);
|
||||||
vargs = scm_vector (args);
|
vargs = scm_vector (args);
|
||||||
SCM_ASSERT (SCM_VECTOR_LENGTH (vargs) == SCM_ARRAY_NDIM (ra),
|
if (SCM_VECTOR_LENGTH (vargs) != SCM_ARRAY_NDIM (ra))
|
||||||
scm_makfrom0str (FUNC_NAME), SCM_WNA, NULL);
|
SCM_WRONG_NUM_ARGS ();
|
||||||
ve = SCM_VELTS (vargs);
|
ve = SCM_VELTS (vargs);
|
||||||
ndim = 0;
|
ndim = 0;
|
||||||
for (k = 0; k < SCM_ARRAY_NDIM (ra); k++)
|
for (k = 0; k < SCM_ARRAY_NDIM (ra); k++)
|
||||||
|
@ -871,7 +880,8 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
|
||||||
r->inc += s->inc;
|
r->inc += s->inc;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
SCM_ASSERT (ndim <= 0, args, "bad argument list", FUNC_NAME);
|
if (ndim > 0)
|
||||||
|
SCM_MISC_ERROR ("bad argument list", SCM_EOL);
|
||||||
scm_ra_set_contp (res);
|
scm_ra_set_contp (res);
|
||||||
return res;
|
return res;
|
||||||
}
|
}
|
||||||
|
@ -905,10 +915,12 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
|
||||||
scm_array_dim vdim, *s = &vdim;
|
scm_array_dim vdim, *s = &vdim;
|
||||||
int ndim, j, k, ninr, noutr;
|
int ndim, j, k, ninr, noutr;
|
||||||
|
|
||||||
|
SCM_VALIDATE_REST_ARGUMENT (axes);
|
||||||
if (SCM_NULLP (axes))
|
if (SCM_NULLP (axes))
|
||||||
axes = scm_cons ((SCM_ARRAYP (ra) ? SCM_MAKINUM (SCM_ARRAY_NDIM (ra) - 1) : SCM_INUM0), SCM_EOL);
|
axes = scm_cons ((SCM_ARRAYP (ra) ? SCM_MAKINUM (SCM_ARRAY_NDIM (ra) - 1) : SCM_INUM0), SCM_EOL);
|
||||||
ninr = scm_ilength (axes);
|
ninr = scm_ilength (axes);
|
||||||
SCM_ASSERT (0 <= ninr, scm_makfrom0str (FUNC_NAME), SCM_WNA, NULL);
|
if (ninr < 0)
|
||||||
|
SCM_WRONG_NUM_ARGS ();
|
||||||
ra_inr = scm_make_ra (ninr);
|
ra_inr = scm_make_ra (ninr);
|
||||||
SCM_ASRTGO (SCM_NIMP (ra), badarg1);
|
SCM_ASRTGO (SCM_NIMP (ra), badarg1);
|
||||||
switch SCM_TYP7 (ra)
|
switch SCM_TYP7 (ra)
|
||||||
|
@ -945,14 +957,16 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
noutr = ndim - ninr;
|
noutr = ndim - ninr;
|
||||||
|
if (noutr < 0)
|
||||||
|
SCM_WRONG_NUM_ARGS ();
|
||||||
axv = scm_make_string (SCM_MAKINUM (ndim), SCM_MAKE_CHAR (0));
|
axv = scm_make_string (SCM_MAKINUM (ndim), SCM_MAKE_CHAR (0));
|
||||||
SCM_ASSERT (0 <= noutr, scm_makfrom0str (FUNC_NAME), SCM_WNA, NULL);
|
|
||||||
res = scm_make_ra (noutr);
|
res = scm_make_ra (noutr);
|
||||||
SCM_ARRAY_BASE (res) = SCM_ARRAY_BASE (ra_inr);
|
SCM_ARRAY_BASE (res) = SCM_ARRAY_BASE (ra_inr);
|
||||||
SCM_ARRAY_V (res) = ra_inr;
|
SCM_ARRAY_V (res) = ra_inr;
|
||||||
for (k = 0; k < ninr; k++, axes = SCM_CDR (axes))
|
for (k = 0; k < ninr; k++, axes = SCM_CDR (axes))
|
||||||
{
|
{
|
||||||
SCM_ASSERT (SCM_INUMP (SCM_CAR (axes)), SCM_CAR (axes), "bad axis", FUNC_NAME);
|
if (!SCM_INUMP (SCM_CAR (axes)))
|
||||||
|
SCM_MISC_ERROR ("bad axis", SCM_EOL);
|
||||||
j = SCM_INUM (SCM_CAR (axes));
|
j = SCM_INUM (SCM_CAR (axes));
|
||||||
SCM_ARRAY_DIMS (ra_inr)[k].lbnd = s[j].lbnd;
|
SCM_ARRAY_DIMS (ra_inr)[k].lbnd = s[j].lbnd;
|
||||||
SCM_ARRAY_DIMS (ra_inr)[k].ubnd = s[j].ubnd;
|
SCM_ARRAY_DIMS (ra_inr)[k].ubnd = s[j].ubnd;
|
||||||
|
@ -986,6 +1000,7 @@ SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1,
|
||||||
register long j;
|
register long j;
|
||||||
scm_array_dim *s;
|
scm_array_dim *s;
|
||||||
|
|
||||||
|
SCM_VALIDATE_REST_ARGUMENT (args);
|
||||||
SCM_ASRTGO (SCM_NIMP (v), badarg1);
|
SCM_ASRTGO (SCM_NIMP (v), badarg1);
|
||||||
if (SCM_NIMP (args))
|
if (SCM_NIMP (args))
|
||||||
|
|
||||||
|
@ -1000,7 +1015,7 @@ tail:
|
||||||
{
|
{
|
||||||
default:
|
default:
|
||||||
badarg1:SCM_WRONG_TYPE_ARG (1, v);
|
badarg1:SCM_WRONG_TYPE_ARG (1, v);
|
||||||
wna: scm_wrong_num_args (scm_makfrom0str (FUNC_NAME));
|
wna: SCM_WRONG_NUM_ARGS ();
|
||||||
case scm_tc7_smob:
|
case scm_tc7_smob:
|
||||||
k = SCM_ARRAY_NDIM (v);
|
k = SCM_ARRAY_NDIM (v);
|
||||||
s = SCM_ARRAY_DIMS (v);
|
s = SCM_ARRAY_DIMS (v);
|
||||||
|
@ -1025,7 +1040,8 @@ tail:
|
||||||
ind = SCM_CAR (args);
|
ind = SCM_CAR (args);
|
||||||
args = SCM_CDR (args);
|
args = SCM_CDR (args);
|
||||||
s++;
|
s++;
|
||||||
SCM_ASSERT (SCM_INUMP (ind), ind, s_bad_ind, FUNC_NAME);
|
if (!SCM_INUMP (ind))
|
||||||
|
SCM_MISC_ERROR (s_bad_ind, SCM_EOL);
|
||||||
}
|
}
|
||||||
SCM_ASRTGO (0 == k, wna);
|
SCM_ASRTGO (0 == k, wna);
|
||||||
v = SCM_ARRAY_V (v);
|
v = SCM_ARRAY_V (v);
|
||||||
|
@ -1104,7 +1120,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
|
||||||
outrng:
|
outrng:
|
||||||
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (pos));
|
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (pos));
|
||||||
wna:
|
wna:
|
||||||
scm_wrong_num_args (SCM_FUNC_NAME);
|
SCM_WRONG_NUM_ARGS ();
|
||||||
case scm_tc7_smob:
|
case scm_tc7_smob:
|
||||||
{ /* enclosed */
|
{ /* enclosed */
|
||||||
int k = SCM_ARRAY_NDIM (v);
|
int k = SCM_ARRAY_NDIM (v);
|
||||||
|
@ -1242,6 +1258,8 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1,
|
||||||
#define FUNC_NAME s_scm_array_set_x
|
#define FUNC_NAME s_scm_array_set_x
|
||||||
{
|
{
|
||||||
long pos = 0;
|
long pos = 0;
|
||||||
|
|
||||||
|
SCM_VALIDATE_REST_ARGUMENT (args);
|
||||||
SCM_ASRTGO (SCM_NIMP (v), badarg1);
|
SCM_ASRTGO (SCM_NIMP (v), badarg1);
|
||||||
if (SCM_ARRAYP (v))
|
if (SCM_ARRAYP (v))
|
||||||
{
|
{
|
||||||
|
@ -1273,7 +1291,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1,
|
||||||
outrng:
|
outrng:
|
||||||
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (pos));
|
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (pos));
|
||||||
wna:
|
wna:
|
||||||
scm_wrong_num_args (SCM_FUNC_NAME);
|
SCM_WRONG_NUM_ARGS ();
|
||||||
case scm_tc7_smob: /* enclosed */
|
case scm_tc7_smob: /* enclosed */
|
||||||
goto badarg1;
|
goto badarg1;
|
||||||
case scm_tc7_bvect:
|
case scm_tc7_bvect:
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
/* $Id: validate.h,v 1.29 2001-03-17 12:20:36 dirk Exp $ */
|
/* $Id: validate.h,v 1.30 2001-03-17 13:34:21 dirk Exp $ */
|
||||||
/* Copyright (C) 1999, 2000 Free Software Foundation, Inc.
|
/* Copyright (C) 1999, 2000 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
|
||||||
|
@ -45,8 +45,6 @@
|
||||||
#ifndef SCM_VALIDATE_H__
|
#ifndef SCM_VALIDATE_H__
|
||||||
#define SCM_VALIDATE_H__
|
#define SCM_VALIDATE_H__
|
||||||
|
|
||||||
#define SCM_FUNC_NAME (scm_makfrom0str (FUNC_NAME))
|
|
||||||
|
|
||||||
#define SCM_SYSERROR do { scm_syserror (FUNC_NAME); } while (0)
|
#define SCM_SYSERROR do { scm_syserror (FUNC_NAME); } while (0)
|
||||||
|
|
||||||
#define SCM_MEMORY_ERROR do { scm_memory_error (FUNC_NAME); } while (0)
|
#define SCM_MEMORY_ERROR do { scm_memory_error (FUNC_NAME); } while (0)
|
||||||
|
@ -149,29 +147,6 @@
|
||||||
|
|
||||||
#define SCM_VALIDATE_NUMBER(pos, z) SCM_MAKE_VALIDATE (pos, z, NUMBERP)
|
#define SCM_VALIDATE_NUMBER(pos, z) SCM_MAKE_VALIDATE (pos, z, NUMBERP)
|
||||||
|
|
||||||
#define SCM_VALIDATE_NUMBER_COPY(pos, z, cvar) \
|
|
||||||
do { \
|
|
||||||
if (SCM_INUMP (z)) \
|
|
||||||
cvar = (double) SCM_INUM (z); \
|
|
||||||
else if (SCM_REALP (z)) \
|
|
||||||
cvar = SCM_REAL_VALUE (z); \
|
|
||||||
else if (SCM_BIGP (z)) \
|
|
||||||
cvar = scm_big2dbl (z); \
|
|
||||||
else \
|
|
||||||
{ \
|
|
||||||
cvar = 0.0; \
|
|
||||||
SCM_WRONG_TYPE_ARG (pos, z); \
|
|
||||||
} \
|
|
||||||
} while (0)
|
|
||||||
|
|
||||||
#define SCM_VALIDATE_NUMBER_DEF_COPY(pos, number, def, cvar) \
|
|
||||||
do { \
|
|
||||||
if (SCM_UNBNDP (number)) \
|
|
||||||
cvar = def; \
|
|
||||||
else \
|
|
||||||
SCM_VALIDATE_NUMBER_COPY(pos, number, cvar); \
|
|
||||||
} while (0)
|
|
||||||
|
|
||||||
#define SCM_VALIDATE_INUM(pos, k) SCM_MAKE_VALIDATE (pos, k, INUMP)
|
#define SCM_VALIDATE_INUM(pos, k) SCM_MAKE_VALIDATE (pos, k, INUMP)
|
||||||
|
|
||||||
#define SCM_VALIDATE_INUM_COPY(pos, k, cvar) \
|
#define SCM_VALIDATE_INUM_COPY(pos, k, cvar) \
|
||||||
|
@ -405,12 +380,37 @@
|
||||||
|
|
||||||
#if (SCM_DEBUG_DEPRECATED == 0)
|
#if (SCM_DEBUG_DEPRECATED == 0)
|
||||||
|
|
||||||
|
#define SCM_FUNC_NAME (scm_makfrom0str (FUNC_NAME))
|
||||||
|
|
||||||
#define SCM_WTA(pos, scm) \
|
#define SCM_WTA(pos, scm) \
|
||||||
do { scm_wta (scm, (char *) pos, FUNC_NAME); } while (0)
|
do { scm_wta (scm, (char *) pos, FUNC_NAME); } while (0)
|
||||||
|
|
||||||
#define RETURN_SCM_WTA(pos, scm) \
|
#define RETURN_SCM_WTA(pos, scm) \
|
||||||
do { return scm_wta (scm, (char *) pos, FUNC_NAME); } while (0)
|
do { return scm_wta (scm, (char *) pos, FUNC_NAME); } while (0)
|
||||||
|
|
||||||
|
#define SCM_VALIDATE_NUMBER_COPY(pos, z, cvar) \
|
||||||
|
do { \
|
||||||
|
if (SCM_INUMP (z)) \
|
||||||
|
cvar = (double) SCM_INUM (z); \
|
||||||
|
else if (SCM_REALP (z)) \
|
||||||
|
cvar = SCM_REAL_VALUE (z); \
|
||||||
|
else if (SCM_BIGP (z)) \
|
||||||
|
cvar = scm_big2dbl (z); \
|
||||||
|
else \
|
||||||
|
{ \
|
||||||
|
cvar = 0.0; \
|
||||||
|
SCM_WRONG_TYPE_ARG (pos, z); \
|
||||||
|
} \
|
||||||
|
} while (0)
|
||||||
|
|
||||||
|
#define SCM_VALIDATE_NUMBER_DEF_COPY(pos, number, def, cvar) \
|
||||||
|
do { \
|
||||||
|
if (SCM_UNBNDP (number)) \
|
||||||
|
cvar = def; \
|
||||||
|
else \
|
||||||
|
SCM_VALIDATE_NUMBER_COPY(pos, number, cvar); \
|
||||||
|
} while (0)
|
||||||
|
|
||||||
#define SCM_VALIDATE_STRINGORSUBSTR SCM_VALIDATE_STRING
|
#define SCM_VALIDATE_STRINGORSUBSTR SCM_VALIDATE_STRING
|
||||||
|
|
||||||
#define SCM_VALIDATE_ROSTRING(pos, str) SCM_MAKE_VALIDATE (pos, str, ROSTRINGP)
|
#define SCM_VALIDATE_ROSTRING(pos, str) SCM_MAKE_VALIDATE (pos, str, ROSTRINGP)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue