diff options
author | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2001-03-04 22:48:13 +0000 |
---|---|---|
committer | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2001-03-04 22:48:13 +0000 |
commit | 276dd6775cbb0fef46a7e75d3c004c4db1590703 (patch) | |
tree | 4b580ec2462b2b54fb9127324da78aaaa315b447 | |
parent | b432fb4b9929475c963e8be69ed6c7293bc964d2 (diff) | |
download | guile-276dd6775cbb0fef46a7e75d3c004c4db1590703.tar.gz |
* Eliminate another couple of calls to scm_wta.
-rw-r--r-- | NEWS | 4 | ||||
-rw-r--r-- | RELEASE | 2 | ||||
-rw-r--r-- | libguile/ChangeLog | 17 | ||||
-rw-r--r-- | libguile/debug.c | 8 | ||||
-rw-r--r-- | libguile/print.c | 2 | ||||
-rw-r--r-- | libguile/ramap.c | 4 | ||||
-rw-r--r-- | libguile/sort.c | 8 | ||||
-rw-r--r-- | libguile/stacks.c | 8 | ||||
-rw-r--r-- | libguile/symbols.c | 10 | ||||
-rw-r--r-- | libguile/unif.c | 40 | ||||
-rw-r--r-- | libguile/validate.h | 16 |
11 files changed, 70 insertions, 49 deletions
@@ -506,7 +506,7 @@ SCM_SUBSTRP, SCM_SUBSTR_STR, SCM_SUBSTR_OFFSET, SCM_COERCE_SUBSTR, SCM_ROSTRINGP, SCM_RWSTRINGP, SCM_VALIDATE_RWSTRING, SCM_ROCHARS, SCM_ROUCHARS, SCM_SETLENGTH, SCM_SETCHARS, SCM_LENGTH_MAX, SCM_GC8MARKP, SCM_SETGC8MARK, SCM_CLRGC8MARK, SCM_GCTYP16, SCM_GCCDR, SCM_SUBR_DOC, -SCM_OPDIRP, SCM_VALIDATE_OPDIR +SCM_OPDIRP, SCM_VALIDATE_OPDIR, SCM_WTA, RETURN_SCM_WTA Use SCM_ASSERT_RANGE or SCM_VALIDATE_XXX_RANGE instead of SCM_OUTOFRANGE. Use scm_memory_error instead of SCM_NALLOC. @@ -531,6 +531,8 @@ Use SCM_CLRGCMARK instead of SCM_CLRGC8MARK. Use SCM_TYP16 instead of SCM_GCTYP16. Use SCM_CDR instead of SCM_GCCDR. 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 RETURN_SCM_WTA. ** Removed function: scm_struct_init @@ -59,7 +59,7 @@ In release 1.6: SCM_COERCE_SUBSTR, SCM_ROSTRINGP, SCM_RWSTRINGP, SCM_VALIDATE_RWSTRING, SCM_ROCHARS, SCM_ROUCHARS, SCM_SETLENGTH, SCM_SETCHARS, SCM_LENGTH_MAX, SCM_GC8MARKP, SCM_SETGC8MARK, SCM_CLRGC8MARK, SCM_GCTYP16, SCM_GCCDR, - SCM_SUBR_DOC, SCM_OPDIRP, SCM_VALIDATE_OPDIR + SCM_SUBR_DOC, SCM_OPDIRP, SCM_VALIDATE_OPDIR, SCM_WTA, RETURN_SCM_WTA - remove scm_vector_set_length_x - remove function scm_call_catching_errors (replaced by catch functions from throw.[ch]) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 2d1c80d8d..31363d904 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,20 @@ +2001-03-04 Dirk Herrmann <D.Herrmann@tu-bs.de> + + * debug.c (scm_procedure_source, scm_procedure_environment), + print.c (scm_get_print_state), ramap.c (scm_array_fill_int, + scm_array_index_map_x), sort.c (scm_sort_x, scm_sort, + scm_stable_sort_x, scm_stable_sort), stacks.c (scm_make_stack, + scm_last_stack_frame), symbols.c (scm_sym2vcell, scm_sym2ovcell), + unif.c (scm_list_to_uniform_array, scm_uniform_vector_length, + scm_transpose_array, scm_enclose_array, scm_array_in_bounds_p, + scm_uniform_vector_ref, scm_array_set_x, scm_uniform_array_read_x, + scm_uniform_array_write, scm_bit_set_star_x, scm_bit_count_star, + scm_array_to_list, scm_array_prototype), validate.h + (SCM_VALIDATE_NUMBER_COPY): Don't call function scm_wta, call + scm_misc_error or scm_wrong_type_arg instead. + + * validate.h (SCM_WTA, RETURN_SCM_WTA): Deprecated. + 2001-03-04 Mikael Djurfeldt <mdj@linnaeus.mit.edu> * goops.c, goops.h (scm_sys_pre_expand_closure_x): Removed. diff --git a/libguile/debug.c b/libguile/debug.c index 6fbb08764..275c05bc4 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -446,8 +446,8 @@ SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0, 0, built in procedures! */ return scm_procedure_property (proc, scm_sym_source); default: - SCM_WTA(1,proc); - return SCM_BOOL_F; + SCM_WRONG_TYPE_ARG (1, proc); + /* not reached */ } } #undef FUNC_NAME @@ -467,8 +467,8 @@ SCM_DEFINE (scm_procedure_environment, "procedure-environment", 1, 0, 0, #endif return SCM_EOL; default: - SCM_WTA(1,proc); - return SCM_BOOL_F; + SCM_WRONG_TYPE_ARG (1, proc); + /* not reached */ } } #undef FUNC_NAME diff --git a/libguile/print.c b/libguile/print.c index bc205ef79..09f5c4547 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -1130,7 +1130,7 @@ SCM_DEFINE (scm_get_print_state, "get-print-state", 1, 0, 0, return SCM_PORT_WITH_PS_PS (port); if (SCM_OUTPUT_PORT_P (port)) return SCM_BOOL_F; - RETURN_SCM_WTA (1,port); + SCM_WRONG_TYPE_ARG (1, port); } #undef FUNC_NAME diff --git a/libguile/ramap.c b/libguile/ramap.c index 7ef09128d..702979664 100644 --- a/libguile/ramap.c +++ b/libguile/ramap.c @@ -535,7 +535,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore) ve[i] |= ~(~0L << ((base + n) % SCM_LONG_BIT)); } else - badarg2:SCM_WTA (2,fill); + badarg2:SCM_WRONG_TYPE_ARG (2, fill); } else { @@ -1700,7 +1700,7 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0, switch (SCM_TYP7(ra)) { default: - badarg:SCM_WTA (1,ra); + badarg:SCM_WRONG_TYPE_ARG (1, ra); case scm_tc7_vector: case scm_tc7_wvect: { diff --git a/libguile/sort.c b/libguile/sort.c index 8b7dd62da..659c901bd 100644 --- a/libguile/sort.c +++ b/libguile/sort.c @@ -737,7 +737,7 @@ SCM_DEFINE (scm_sort_x, "sort!", 2, 0, 0, return items; } else - RETURN_SCM_WTA (1,items); + SCM_WRONG_TYPE_ARG (1, items); } #undef FUNC_NAME @@ -777,7 +777,7 @@ SCM_DEFINE (scm_sort, "sort", 2, 0, 0, } #endif else - RETURN_SCM_WTA (1,items); + SCM_WRONG_TYPE_ARG (1, items); } #undef FUNC_NAME @@ -872,7 +872,7 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0, return items; } else - RETURN_SCM_WTA (1,items); + SCM_WRONG_TYPE_ARG (1, items); } #undef FUNC_NAME @@ -918,7 +918,7 @@ SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0, } #endif else - RETURN_SCM_WTA (1,items); + SCM_WRONG_TYPE_ARG (1, items); } #undef FUNC_NAME diff --git a/libguile/stacks.c b/libguile/stacks.c index 91051f2c9..e223d4ff1 100644 --- a/libguile/stacks.c +++ b/libguile/stacks.c @@ -449,8 +449,8 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1, } else { - SCM_WTA (SCM_ARG1, obj); - abort (); + SCM_WRONG_TYPE_ARG (SCM_ARG1, obj); + /* not reached */ } } @@ -605,8 +605,8 @@ SCM_DEFINE (scm_last_stack_frame, "last-stack-frame", 1, 0, 0, } else { - SCM_WTA (1,obj); - abort (); + SCM_WRONG_TYPE_ARG (1, obj); + /* not reached */ } if (!dframe || SCM_VOIDFRAMEP (*dframe)) diff --git a/libguile/symbols.c b/libguile/symbols.c index 83b32560b..818fb5991 100644 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@ -155,6 +155,7 @@ scm_str2symbol (const char *str) SCM scm_sym2vcell (SCM sym, SCM thunk, SCM definep) +#define FUNC_NAME "scm_sym2vcell" { if (SCM_NIMP (thunk)) { @@ -171,7 +172,7 @@ scm_sym2vcell (SCM sym, SCM thunk, SCM definep) else if (SCM_VARIABLEP (var)) return SCM_VARVCELL (var); else - return scm_wta (sym, "strangely interned symbol? ", ""); + SCM_MISC_ERROR ("strangely interned symbol: ~S", SCM_LIST1 (sym)); } else { @@ -207,6 +208,8 @@ scm_sym2vcell (SCM sym, SCM thunk, SCM definep) } } } +#undef FUNC_NAME + /* scm_sym2ovcell * looks up the symbol in an arbitrary obarray. @@ -236,14 +239,17 @@ scm_sym2ovcell_soft (SCM sym, SCM obarray) SCM scm_sym2ovcell (SCM sym, SCM obarray) +#define FUNC_NAME "scm_sym2ovcell" { SCM answer; answer = scm_sym2ovcell_soft (sym, obarray); if (!SCM_FALSEP (answer)) return answer; - scm_wta (sym, "uninterned symbol? ", ""); + SCM_MISC_ERROR ("uninterned symbol: ~S", SCM_LIST1 (sym)); return SCM_UNSPECIFIED; /* not reached */ } +#undef FUNC_NAME + /* Intern a symbol whose name is the LEN characters at NAME in OBARRAY. diff --git a/libguile/unif.c b/libguile/unif.c index 59b3fc659..1a801317b 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -256,7 +256,7 @@ SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0, switch SCM_TYP7 (v) { default: - badarg1:SCM_WTA(1,v); + badarg1:SCM_WRONG_TYPE_ARG (1, v); case scm_tc7_vector: case scm_tc7_wvect: return SCM_MAKINUM (SCM_VECTOR_LENGTH (v)); @@ -798,7 +798,7 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, switch (SCM_TYP7 (ra)) { default: - badarg:SCM_WTA (1,ra); + badarg:SCM_WRONG_TYPE_ARG (1, ra); case scm_tc7_bvect: case scm_tc7_string: case scm_tc7_byvect: @@ -911,7 +911,7 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1, switch SCM_TYP7 (ra) { default: - badarg1:SCM_WTA (1,ra); + badarg1:SCM_WRONG_TYPE_ARG (1, ra); case scm_tc7_string: case scm_tc7_bvect: case scm_tc7_byvect: @@ -996,7 +996,7 @@ tail: switch SCM_TYP7 (v) { default: - badarg1:SCM_WTA (1,v); + badarg1:SCM_WRONG_TYPE_ARG (1, v); wna: scm_wrong_num_args (scm_makfrom0str (FUNC_NAME)); case scm_tc7_smob: k = SCM_ARRAY_NDIM (v); @@ -1095,8 +1095,8 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, if (SCM_NULLP (args)) return v; badarg: - SCM_WTA (1,v); - abort (); + SCM_WRONG_TYPE_ARG (1, v); + /* not reached */ outrng: scm_out_of_range (FUNC_NAME, SCM_MAKINUM (pos)); @@ -1265,8 +1265,8 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, switch (SCM_TYP7 (v)) { default: badarg1: - SCM_WTA (1,v); - abort (); + SCM_WRONG_TYPE_ARG (1, v); + /* not reached */ outrng: scm_out_of_range (FUNC_NAME, SCM_MAKINUM (pos)); wna: @@ -1279,7 +1279,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, else if (SCM_EQ_P (obj, SCM_BOOL_T)) SCM_BITVEC_SET(v,pos); else - badobj:SCM_WTA (2,obj); + badobj:SCM_WRONG_TYPE_ARG (2, obj); break; case scm_tc7_string: SCM_ASRTGO (SCM_CHARP (obj), badobj); @@ -1485,7 +1485,7 @@ loop: switch SCM_TYP7 (v) { default: - badarg1:SCM_WTA (SCM_ARG1,v); + badarg1:SCM_WRONG_TYPE_ARG (SCM_ARG1, v); case scm_tc7_smob: SCM_ASRTGO (SCM_ARRAYP (v), badarg1); cra = scm_ra2contig (ra, 0); @@ -1649,7 +1649,7 @@ loop: switch SCM_TYP7 (v) { default: - badarg1:SCM_WTA (1, v); + badarg1:SCM_WRONG_TYPE_ARG (1, v); case scm_tc7_smob: SCM_ASRTGO (SCM_ARRAYP (v), badarg1); v = scm_ra2contig (v, 1); @@ -1866,7 +1866,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, switch SCM_TYP7 (kv) { default: - badarg2:SCM_WTA (2,kv); + badarg2:SCM_WRONG_TYPE_ARG (2, kv); case scm_tc7_uvect: vlen = SCM_BITVECTOR_LENGTH (v); if (SCM_FALSEP (obj)) @@ -1886,7 +1886,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, SCM_BITVEC_SET(v,k); } else - badarg3:SCM_WTA (3,obj); + badarg3:SCM_WRONG_TYPE_ARG (3, obj); break; case scm_tc7_bvect: SCM_ASSERT (SCM_BITVECTOR_LENGTH (v) == SCM_BITVECTOR_LENGTH (kv), v, SCM_ARG1, FUNC_NAME); @@ -1924,7 +1924,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, { default: badarg2: - SCM_WTA (2,kv); + SCM_WRONG_TYPE_ARG (2, kv); case scm_tc7_uvect: vlen = SCM_BITVECTOR_LENGTH (v); if (SCM_FALSEP (obj)) @@ -1946,7 +1946,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, count++; } else - badarg3:SCM_WTA (3,obj); + badarg3:SCM_WRONG_TYPE_ARG (3, obj); break; case scm_tc7_bvect: SCM_ASSERT (SCM_BITVECTOR_LENGTH (v) == SCM_BITVECTOR_LENGTH (kv), v, SCM_ARG1, FUNC_NAME); @@ -2062,7 +2062,7 @@ SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0, switch SCM_TYP7 (v) { default: - badarg1:SCM_WTA (1,v); + badarg1:SCM_WRONG_TYPE_ARG (1, v); case scm_tc7_smob: SCM_ASRTGO (SCM_ARRAYP (v), badarg1); return ra2l (v, SCM_ARRAY_BASE (v), 0); @@ -2138,8 +2138,6 @@ SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0, #undef FUNC_NAME -static char s_bad_ralst[] = "Bad scm_array contents list"; - static int l2ra(SCM lst, SCM ra, scm_sizet base, scm_sizet k); SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0, @@ -2167,7 +2165,6 @@ SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0, ra = scm_dimensions_to_uniform_array (scm_reverse (shp), prot, SCM_UNDEFINED); if (SCM_NULLP (shp)) - { SCM_ASRTGO (1 == scm_ilength (lst), badlst); scm_array_set_x (ra, SCM_CAR (lst), SCM_EOL); @@ -2183,8 +2180,7 @@ SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0, if (l2ra (lst, ra, SCM_ARRAY_BASE (ra), 0)) return ra; else - badlst:scm_wta (lst, s_bad_ralst, FUNC_NAME); - return SCM_BOOL_F; + badlst:SCM_MISC_ERROR ("Bad scm_array contents list: ~S", SCM_LIST1 (lst)); } #undef FUNC_NAME @@ -2509,7 +2505,7 @@ loop: switch SCM_TYP7 (ra) { default: - badarg:SCM_WTA (1,ra); + badarg:SCM_WRONG_TYPE_ARG (1, ra); case scm_tc7_smob: SCM_ASRTGO (SCM_ARRAYP (ra), badarg); if (enclosed++) diff --git a/libguile/validate.h b/libguile/validate.h index 029d7e337..87fdb716b 100644 --- a/libguile/validate.h +++ b/libguile/validate.h @@ -1,4 +1,4 @@ -/* $Id: validate.h,v 1.26 2001-02-28 16:58:12 dirk Exp $ */ +/* $Id: validate.h,v 1.27 2001-03-04 22:48:13 dirk Exp $ */ /* Copyright (C) 1999, 2000 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify @@ -54,12 +54,6 @@ #define SCM_SYSERROR_MSG(str, args, val) \ do { scm_syserror_msg (FUNC_NAME, (str), (args), (val)); } while (0) -#define SCM_WTA(pos, scm) \ - do { scm_wta (scm, (char *) pos, FUNC_NAME); } while (0) - -#define RETURN_SCM_WTA(pos, scm) \ - do { return scm_wta (scm, (char *) pos, FUNC_NAME); } while (0) - #define SCM_MISC_ERROR(str, args) \ do { scm_misc_error (FUNC_NAME, str, args); } while (0) @@ -166,7 +160,7 @@ else \ { \ cvar = 0.0; \ - SCM_WTA (pos, z); \ + SCM_WRONG_TYPE_ARG (pos, z); \ } \ } while (0) @@ -408,6 +402,12 @@ #if (SCM_DEBUG_DEPRECATED == 0) +#define SCM_WTA(pos, scm) \ + do { scm_wta (scm, (char *) pos, FUNC_NAME); } while (0) + +#define RETURN_SCM_WTA(pos, scm) \ + do { return scm_wta (scm, (char *) pos, FUNC_NAME); } while (0) + #define SCM_VALIDATE_STRINGORSUBSTR SCM_VALIDATE_STRING #define SCM_VALIDATE_ROSTRING(pos, str) SCM_MAKE_VALIDATE (pos, str, ROSTRINGP) |