diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 2978ce298..4528fab21 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,18 @@ +2001-03-06 Dirk Herrmann + + * coop-threads.c (scm_call_with_new_thread), load.c + (scm_primitive_load, scm_sys_search_load_path), random.c + (scm_c_default_rstate), struct.c (scm_make_struct_layout, + scm_struct_ref, scm_struct_set_x): Don't use SCM_ASSERT to + (potentially) issue a scm-misc-error or wrong-num-args error + message. + + * load.c (scm_search_path): Use SCM_ASSERT_TYPE to give details + about the expected type with the wrong-type-arg error message. + + * smob.c (scm_make_smob): Abort on misuse of smob - it indicates + a C level bug that can't be fixed from scheme anyway. + 2001-03-05 Mikael Djurfeldt * eval.c (scm_m_letstar): Removed check for duplicate bindings. diff --git a/libguile/coop-threads.c b/libguile/coop-threads.c index 60f07f64e..aa668e401 100644 --- a/libguile/coop-threads.c +++ b/libguile/coop-threads.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995, 1996, 1997, 1998, 2000 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 * it under the terms of the GNU General Public License as published by @@ -220,8 +220,10 @@ scheme_launch_thread (void *p) SCM_DEFER_INTS; } + SCM scm_call_with_new_thread (SCM argl) +#define FUNC_NAME s_call_with_new_thread { SCM thread; @@ -229,26 +231,23 @@ scm_call_with_new_thread (SCM argl) { register SCM args = argl; SCM thunk, handler; - SCM_ASSERT (SCM_NIMP (args), - scm_makfrom0str (s_call_with_new_thread), - SCM_WNA, NULL); + if (!SCM_CONSP (args)) + SCM_WRONG_NUM_ARGS (); thunk = SCM_CAR (args); SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)), thunk, SCM_ARG1, s_call_with_new_thread); args = SCM_CDR (args); - SCM_ASSERT (SCM_NIMP (args), - scm_makfrom0str (s_call_with_new_thread), - SCM_WNA, NULL); + if (!SCM_CONSP (args)) + SCM_WRONG_NUM_ARGS (); handler = SCM_CAR (args); SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (handler)), handler, SCM_ARG2, s_call_with_new_thread); - SCM_ASSERT (SCM_NULLP (SCM_CDR (args)), - scm_makfrom0str (s_call_with_new_thread), - SCM_WNA, NULL); + if (!SCM_NULLP (SCM_CDR (args)) + SCM_WRONG_NUM_ARGS (); } /* Make new thread. */ @@ -285,6 +284,8 @@ scm_call_with_new_thread (SCM argl) return thread; } +#undef FUNC_NAME + /* This is the second thread spawning mechanism: threads from C */ diff --git a/libguile/load.c b/libguile/load.c index 5002be721..8be776db7 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -1,4 +1,4 @@ -/* 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 * it under the terms of the GNU General Public License as published by @@ -114,9 +114,9 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0, { SCM hook = *scm_loc_load_hook; SCM_VALIDATE_STRING (1, filename); - SCM_ASSERT (SCM_FALSEP (hook) || (SCM_EQ_P (scm_procedure_p (hook), SCM_BOOL_T)), - hook, "value of %load-hook is neither a procedure nor #f", - FUNC_NAME); + if (!SCM_FALSEP (hook) && !SCM_EQ_P (scm_procedure_p (hook), SCM_BOOL_T)) + SCM_MISC_ERROR ("value of %load-hook is neither a procedure nor #f", + SCM_EOL); if (! SCM_FALSEP (hook)) scm_apply (hook, scm_listify (filename, SCM_UNDEFINED), SCM_EOL); @@ -301,9 +301,8 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0, for (walk = path; !SCM_NULLP (walk); walk = SCM_CDR (walk)) { SCM elt = SCM_CAR (walk); - SCM_ASSERT (SCM_STRINGP (elt), elt, - "path is not a list of strings", - FUNC_NAME); + SCM_ASSERT_TYPE (SCM_STRINGP (elt), path, 1, FUNC_NAME, + "list of strings"); if (SCM_STRING_LENGTH (elt) > max_path_len) max_path_len = SCM_STRING_LENGTH (elt); } @@ -340,9 +339,8 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0, for (walk = extensions; !SCM_NULLP (walk); walk = SCM_CDR (walk)) { SCM elt = SCM_CAR (walk); - SCM_ASSERT (SCM_STRINGP (elt), elt, - "extension list is not a list of strings", - FUNC_NAME); + SCM_ASSERT_TYPE (SCM_STRINGP (elt), elt, 3, FUNC_NAME, + "list of strings"); if (SCM_STRING_LENGTH (elt) > max_ext_len) max_ext_len = SCM_STRING_LENGTH (elt); } @@ -426,11 +424,10 @@ SCM_DEFINE (scm_sys_search_load_path, "%search-load-path", 1, 0, 0, SCM exts = *scm_loc_load_extensions; SCM_VALIDATE_STRING (1, filename); - SCM_ASSERT (scm_ilength (path) >= 0, path, "load path is not a proper list", - FUNC_NAME); - SCM_ASSERT (scm_ilength (exts) >= 0, exts, - "load extension list is not a proper list", - FUNC_NAME); + if (scm_ilength (path) < 0) + SCM_MISC_ERROR ("%load-path is not a proper list", SCM_EOL); + if (scm_ilength (exts) < 0) + SCM_MISC_ERROR ("%load-extension list is not a proper list", SCM_EOL); return scm_search_path (path, filename, exts); } #undef FUNC_NAME diff --git a/libguile/random.c b/libguile/random.c index 4af5c4aa6..f06d984f2 100644 --- a/libguile/random.c +++ b/libguile/random.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1999, 2000 Free Software Foundation, Inc. +/* Copyright (C) 1999,2000,2001 Free Software Foundation, Inc. * 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 * the Free Software Foundation; either version 2, or (at your option) @@ -192,14 +192,18 @@ scm_c_make_rstate (char *seed, int n) return state; } + scm_rstate * scm_c_default_rstate () +#define FUNC_NAME "scm_c_default_rstate" { SCM state = SCM_CDR (scm_var_random_state); - SCM_ASSERT (SCM_RSTATEP (state), - state, "*random-state* contains bogus random state", 0); + if (!SCM_RSTATEP (state)) + SCM_MISC_ERROR ("*random-state* contains bogus random state", SCM_EOL); return SCM_RSTATE (state); } +#undef FUNC_NAME + inline double scm_c_uniform01 (scm_rstate *state) diff --git a/libguile/smob.c b/libguile/smob.c index 5c859e6d0..87f721207 100644 --- a/libguile/smob.c +++ b/libguile/smob.c @@ -1,4 +1,4 @@ -/* 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 * it under the terms of the GNU General Public License as published by @@ -459,10 +459,13 @@ scm_make_smob (scm_bits_t tc) if (size != 0) { #if 0 - SCM_ASSERT (scm_smobs[n].mark == 0, - 0, - "forbidden operation for smobs with GC data, use SCM_NEWSMOB", - SCM_SMOBNAME (n)); + if (scm_smobs[n].mark != 0) + { + fprintf + (stderr, + "forbidden operation for smobs with GC data, use SCM_NEWSMOB\n"); + abort (); + } #endif SCM_SET_SMOB_DATA (z, scm_must_malloc (size, SCM_SMOBNAME (n))); } diff --git a/libguile/struct.c b/libguile/struct.c index f2d065b80..52af06f2e 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1996, 97, 98, 99, 2000 Free Software Foundation, Inc. +/* Copyright (C) 1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc. * * 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 @@ -82,14 +82,18 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0, { SCM new_sym; SCM_VALIDATE_STRING (1, fields); + { /* scope */ char * field_desc; - int len; + scm_sizet len; int x; len = SCM_STRING_LENGTH (fields); + if (len % 2 == 1) + SCM_MISC_ERROR ("odd length field specification: ~S", + SCM_LIST1 (fields)); + field_desc = SCM_STRING_CHARS (fields); - SCM_ASSERT (!(len & 1), fields, "odd length field specification", FUNC_NAME); for (x = 0; x < len; x += 2) { @@ -104,35 +108,38 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0, case 's': break; default: - SCM_ASSERT (0, SCM_MAKE_CHAR (field_desc[x]) , "unrecognized field type", FUNC_NAME); + SCM_MISC_ERROR ("unrecognized field type: ~S", + SCM_LIST1 (SCM_MAKE_CHAR (field_desc[x]))); } switch (field_desc[x + 1]) { case 'w': - SCM_ASSERT (field_desc[x] != 's', SCM_MAKE_CHAR (field_desc[x + 1]), - "self fields not writable", FUNC_NAME); - + if (field_desc[x] == 's') + SCM_MISC_ERROR ("self fields not writable", SCM_EOL); case 'r': case 'o': break; case 'R': case 'W': case 'O': - SCM_ASSERT (field_desc[x] != 's', SCM_MAKE_CHAR (field_desc[x + 1]), - "self fields not allowed in tail array", - FUNC_NAME); - SCM_ASSERT (x == len - 2, SCM_MAKE_CHAR (field_desc[x + 1]), - "tail array field must be last field in layout", - FUNC_NAME); + if (field_desc[x] == 's') + SCM_MISC_ERROR ("self fields not allowed in tail array", + SCM_EOL); + if (x != len - 2) + SCM_MISC_ERROR ("tail array field must be last field in layout", + SCM_EOL); break; default: - SCM_ASSERT (0, SCM_MAKE_CHAR (field_desc[x]) , "unrecognized ref specification", FUNC_NAME); + SCM_MISC_ERROR ("unrecognized ref specification: ~S", + SCM_LIST1 (SCM_MAKE_CHAR (field_desc[x + 1]))); } #if 0 if (field_desc[x] == 'd') { - SCM_ASSERT (field_desc[x + 2] == '-', SCM_MAKINUM (x / 2), "missing dash field", FUNC_NAME); + if (field_desc[x + 2] != '-') + SCM_MISC_ERROR ("missing dash field at position ~A", + SCM_LIST1 (SCM_MAKINUM (x / 2))); x += 2; goto recheck_ref; } @@ -592,16 +599,13 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0, if ((ref == 'R') || (ref == 'W')) field_type = 'u'; else - SCM_ASSERT (0, pos, "ref denied", FUNC_NAME); + SCM_MISC_ERROR ("ref denied for field ~A", SCM_LIST1 (pos)); } } else if (fields_desc[SCM_SYMBOL_LENGTH (layout) - 1] != 'O') field_type = fields_desc[SCM_SYMBOL_LENGTH (layout) - 2]; else - { - SCM_ASSERT (0, pos, "ref denied", FUNC_NAME); - abort (); - } + SCM_MISC_ERROR ("ref denied for field ~A", SCM_LIST1 (pos)); switch (field_type) { @@ -626,8 +630,8 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0, default: - SCM_ASSERT (0, SCM_MAKE_CHAR (field_type), "unrecognized field type", FUNC_NAME); - break; + SCM_MISC_ERROR ("unrecognized field type: ~S", + SCM_LIST1 (SCM_MAKE_CHAR (field_type))); } return answer; @@ -667,15 +671,12 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0, field_type = fields_desc[p * 2]; set_x = fields_desc [p * 2 + 1]; if (set_x != 'w') - SCM_ASSERT (0, pos, "set_x denied", FUNC_NAME); + SCM_MISC_ERROR ("set! denied for field ~A", SCM_LIST1 (pos)); } else if (fields_desc[SCM_SYMBOL_LENGTH (layout) - 1] == 'W') field_type = fields_desc[SCM_SYMBOL_LENGTH (layout) - 2]; else - { - SCM_ASSERT (0, pos, "set_x denied", FUNC_NAME); - abort (); - } + SCM_MISC_ERROR ("set! denied for field ~A", SCM_LIST1 (pos)); switch (field_type) { @@ -698,12 +699,11 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0, break; case 's': - SCM_ASSERT (0, SCM_MAKE_CHAR (field_type), "self fields immutable", FUNC_NAME); - break; + SCM_MISC_ERROR ("self fields immutable", SCM_EOL); default: - SCM_ASSERT (0, SCM_MAKE_CHAR (field_type), "unrecognized field type", FUNC_NAME); - break; + SCM_MISC_ERROR ("unrecognized field type: ~S", + SCM_LIST1 (SCM_MAKE_CHAR (field_type))); } return val;