diff options
author | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2001-06-07 21:12:19 +0000 |
---|---|---|
committer | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2001-06-07 21:12:19 +0000 |
commit | e81d98ec2d12d9101dc79928833b2c064d148afc (patch) | |
tree | d5966566fc4c86bca904ea941bfc6a19cc464918 /libguile | |
parent | 563058efbe03208cacb43f664c702e3979922cb6 (diff) | |
download | guile-e81d98ec2d12d9101dc79928833b2c064d148afc.tar.gz |
* Introduce SCM_UNUSED and mark unused function parameters.
* Introduce SCM_DEBUG_PAIR_ACCESSES.
* Extend the possibilities of SCM_DEBUG_CELL_ACCESSES.
Diffstat (limited to 'libguile')
35 files changed, 365 insertions, 135 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index a4cc49e64..ef708e74e 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,77 @@ +2001-06-07 Dirk Herrmann <D.Herrmann@tu-bs.de> + + * __scm.h (SCM_NORETURN): Moved here from error.h. + + (SCM_UNUSED): New macro. + + (SCM_DEBUG_PAIR_ACCESSES): New macro. + + * backtrace.c (display_error_handler), continuations.c + (continuation_print), debug.c (debugobj_print), dynwind.c + (guards_print), environments.c (observer_print, + core_environments_finalize, leaf_environment_cell, + leaf_environment_print, eval_environment_print, + eval_environment_observer, import_environment_define, + import_environment_undefine, import_environment_print, + import_environment_observer, export_environment_define, + export_environment_undefine, export_environment_print, + export_environment_observer), eval.c (scm_m_quote, scm_m_begin, + scm_m_if, scm_m_set_x, scm_m_and, scm_m_or, scm_m_case, + scm_m_cond, scm_m_lambda, scm_m_letstar, scm_m_do, scm_m_delay, + scm_m_letrec1, scm_m_apply, scm_m_cont, scm_m_nil_cond, + scm_m_nil_ify, scm_m_t_ify, scm_m_0_cond, scm_m_0_ify, + scm_m_1_ify, scm_m_atfop, scm_m_at_call_with_values), evalext.c + (scm_m_generalized_set_x), fluids.c (fluid_print), fports.c + (fport_print), gc.c (gc_start_stats, scm_remember_upto_here_1, + scm_remember_upto_here_2, scm_remember_upto_here, mark_gc_async), + gh_init.c (gh_standard_handler), goops.c (get_slot_value, + set_slot_value, test_slot_existence, scm_change_object_class, + scm_m_atslot_ref, scm_m_atslot_set_x, make_struct_class, + default_setter), guardians.c (guardian_print, guardian_gc_init, + guardian_zombify, whine_about_self_centered_zombies), guile.c + (inner_main), init.c (stream_handler), keywords.c (keyword_print), + mallocs.c (malloc_print), numbers.c (scm_print_real, + scm_print_complex, scm_bigprint), ports.c (flush_port_default, + end_input_default, scm_port_print, fill_input_void_port, + write_void_port), root.c (root_print), smob.c (scm_mark0, + scm_free0, scm_smob_print, scm_smob_apply_1_error, + scm_smob_apply_2_error, scm_smob_apply_3_error, free_print), + stime.c (restorezone), strings.c (scm_makfromstr), struct.c + (scm_struct_free_0, scm_struct_free_standard, + scm_struct_free_entity, scm_struct_gc_init, scm_free_structs), + throw.c (jmpbuffer_print, lazy_catch_print, ss_handler, + scm_handle_by_throw, scm_ithrow), weaks.c + (scm_weak_vector_gc_init, scm_mark_weak_vector_spines, + scm_scan_weak_vectors), ramap.c (scm_array_fill_int), filesys.c + (scm_dir_print): Mark unused parameters with SCM_UNUSED. + + * error.h (SCM_NORETURN): Moved to __scm.h. + + * error.h (ERRORH, SCM_ERROR_H), pairs.h (PAIRSH, SCM_PAIRS_H): + Renamed <foo>H to SCM_<foo>_H. + + * gc.c (debug_cells_gc_interval): New static variable. + + (scm_assert_cell_valid): If selected by the user, perform + additional garbage collections. + + (scm_set_debug_cell_accesses_x): Extended to let the user specify + if additional garbage collections are desired. + + (mark_gc_async): If additional garbage collections are selected + by the user, don't call the after-gc-hook. Instead require the + user to run the hook manually. + + * pairs.c (scm_error_pair_access): New function. Only compiled + if SCM_DEBUG_PAIR_ACCESSES is set to 1. + + * pairs.h (SCM_VALIDATE_PAIR): New macro. + + (SCM_CAR, SCM_CDR, SCM_SETCAR, SCM_SETCDR): If + SCM_DEBUG_PAIR_ACCESSES is set to 1, make sure that the argument + is a real pair object. (Glocs are also accepted, but that may + change.) If not, abort with an error message. + 2001-06-05 Dirk Herrmann <D.Herrmann@tu-bs.de> * eval.c (SCM_VALIDATE_NON_EMPTY_COMBINATION): New macro. diff --git a/libguile/__scm.h b/libguile/__scm.h index 2a06b9caa..f5e7ed3a0 100644 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@ -55,6 +55,38 @@ should go in __scm.h. */ +/* {Compiler hints} + * + * The following macros are used to provide additional information for the + * compiler, which may help to do better error checking and code + * optimization. A second benefit of these macros is, that they also provide + * additional information to the developers. + */ + +/* The macro SCM_NORETURN indicates that a function will never return. + * Examples: + * 1) int foo (char arg) SCM_NORETURN; + */ +#ifdef __GNUC__ +#define SCM_NORETURN __attribute__ ((noreturn)) +#else +#define SCM_NORETURN +#endif + +/* The macro SCM_UNUSED indicates that a function, function argument or + * variable may potentially be unused. + * Examples: + * 1) static int unused_function (char arg) SCM_UNUSED; + * 2) int foo (char unused_argument SCM_UNUSED); + * 3) int unused_variable SCM_UNUSED; + */ +#ifdef __GNUC__ +#define SCM_UNUSED __attribute__ ((unused)) +#else +#define SCM_UNUSED +#endif + + /* {Supported Options} * * These may be defined or undefined. @@ -177,6 +209,14 @@ #define SCM_DEBUG_INTERRUPTS SCM_DEBUG #endif +/* If SCM_DEBUG_PAIR_ACCESSES is set to 1, accesses to cons cells will be + * exhaustively checked. Note: If this option is enabled, guile will run + * slower than normally. + */ +#ifndef SCM_DEBUG_PAIR_ACCESSES +#define SCM_DEBUG_PAIR_ACCESSES SCM_DEBUG +#endif + /* If SCM_DEBUG_REST_ARGUMENT is set to 1, functions that take rest arguments * will check whether the rest arguments are actually passed as a proper list. * Otherwise, if SCM_DEBUG_REST_ARGUMENT is 0, functions that take rest diff --git a/libguile/backtrace.c b/libguile/backtrace.c index a602d9139..8ddc473df 100644 --- a/libguile/backtrace.c +++ b/libguile/backtrace.c @@ -1,5 +1,5 @@ /* Printing of backtraces and error messages - * Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation + * Copyright (C) 1996,1997,1998,1999,2000,2001 Free Software Foundation * * 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 @@ -216,7 +216,7 @@ struct display_error_handler_data { try to print all objects, we would enter an infinite loop. */ static SCM display_error_handler (struct display_error_handler_data *data, - SCM tag, SCM args) + SCM tag, SCM args SCM_UNUSED) { SCM print_state = scm_make_print_state (); scm_puts ("\nException during displaying of ", data->port); diff --git a/libguile/continuations.c b/libguile/continuations.c index 7b33d7248..49f2890d8 100644 --- a/libguile/continuations.c +++ b/libguile/continuations.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1998, 2000 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,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 @@ -94,7 +94,7 @@ continuation_free (SCM obj) } static int -continuation_print (SCM obj, SCM port, scm_print_state *state) +continuation_print (SCM obj, SCM port, scm_print_state *state SCM_UNUSED) { scm_contregs_t *continuation = SCM_CONTREGS (obj); diff --git a/libguile/debug.c b/libguile/debug.c index dc47c9dbc..bd0b4ba7f 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -557,7 +557,7 @@ scm_m_start_stack (SCM exp, SCM env) scm_bits_t scm_tc16_debugobj; static int -debugobj_print (SCM obj, SCM port, scm_print_state *pstate) +debugobj_print (SCM obj, SCM port, scm_print_state *pstate SCM_UNUSED) { scm_puts ("#<debug-object ", port); scm_intprint ((int) SCM_DEBUGOBJ_FRAME (obj), 16, port); diff --git a/libguile/dynwind.c b/libguile/dynwind.c index bc4c72575..24d2e415f 100644 --- a/libguile/dynwind.c +++ b/libguile/dynwind.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 @@ -147,7 +147,7 @@ SCM_DEFINE (scm_dynamic_wind, "dynamic-wind", 3, 0, 0, static scm_bits_t tc16_guards; static int -guards_print (SCM exp, SCM port, scm_print_state *pstate) +guards_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) { scm_puts ("#<guards ", port); scm_intprint (SCM_UNPACK (SCM_CDR (exp)), 16, port); diff --git a/libguile/environments.c b/libguile/environments.c index eecf4fe3f..211ce2816 100644 --- a/libguile/environments.c +++ b/libguile/environments.c @@ -506,7 +506,7 @@ observer_mark (SCM observer) static int -observer_print (SCM type, SCM port, scm_print_state *pstate) +observer_print (SCM type, SCM port, scm_print_state *pstate SCM_UNUSED) { SCM address = scm_ulong2num (SCM_UNPACK (type)); SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16)); @@ -752,7 +752,7 @@ core_environments_mark (SCM env) static void -core_environments_finalize (SCM env) +core_environments_finalize (SCM env SCM_UNUSED) { } @@ -975,7 +975,7 @@ leaf_environment_set_x (SCM env, SCM sym, SCM val) static SCM -leaf_environment_cell(SCM env, SCM sym, int for_write) +leaf_environment_cell (SCM env, SCM sym, int for_write SCM_UNUSED) { SCM obarray = LEAF_ENVIRONMENT (env)->obarray; SCM binding = obarray_retrieve (obarray, sym); @@ -1002,7 +1002,7 @@ leaf_environment_free (SCM env) static int -leaf_environment_print (SCM type, SCM port, scm_print_state *pstate) +leaf_environment_print (SCM type, SCM port, scm_print_state *pstate SCM_UNUSED) { SCM address = scm_ulong2num (SCM_UNPACK (type)); SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16)); @@ -1363,7 +1363,7 @@ eval_environment_free (SCM env) static int -eval_environment_print (SCM type, SCM port, scm_print_state *pstate) +eval_environment_print (SCM type, SCM port, scm_print_state *pstate SCM_UNUSED) { SCM address = scm_ulong2num (SCM_UNPACK (type)); SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16)); @@ -1395,7 +1395,7 @@ void *scm_type_eval_environment = &eval_environment_funcs; static void -eval_environment_observer (SCM caller, SCM eval_env) +eval_environment_observer (SCM caller SCM_UNUSED, SCM eval_env) { SCM obarray = EVAL_ENVIRONMENT (eval_env)->obarray; @@ -1687,7 +1687,9 @@ import_environment_fold (SCM env, scm_environment_folder proc, SCM data, SCM ini static SCM -import_environment_define (SCM env, SCM sym, SCM val) +import_environment_define (SCM env SCM_UNUSED, + SCM sym SCM_UNUSED, + SCM val SCM_UNUSED) #define FUNC_NAME "import_environment_define" { return SCM_ENVIRONMENT_BINDING_IMMUTABLE; @@ -1696,7 +1698,8 @@ import_environment_define (SCM env, SCM sym, SCM val) static SCM -import_environment_undefine (SCM env, SCM sym) +import_environment_undefine (SCM env SCM_UNUSED, + SCM sym SCM_UNUSED) #define FUNC_NAME "import_environment_undefine" { return SCM_ENVIRONMENT_BINDING_IMMUTABLE; @@ -1779,7 +1782,8 @@ import_environment_free (SCM env) static int -import_environment_print (SCM type, SCM port, scm_print_state *pstate) +import_environment_print (SCM type, SCM port, + scm_print_state *pstate SCM_UNUSED) { SCM address = scm_ulong2num (SCM_UNPACK (type)); SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16)); @@ -1811,7 +1815,7 @@ void *scm_type_import_environment = &import_environment_funcs; static void -import_environment_observer (SCM caller, SCM import_env) +import_environment_observer (SCM caller SCM_UNUSED, SCM import_env) { core_environments_broadcast (import_env); } @@ -1997,7 +2001,9 @@ export_environment_fold (SCM env, scm_environment_folder proc, SCM data, SCM ini static SCM -export_environment_define (SCM env, SCM sym, SCM val) +export_environment_define (SCM env SCM_UNUSED, + SCM sym SCM_UNUSED, + SCM val SCM_UNUSED) #define FUNC_NAME "export_environment_define" { return SCM_ENVIRONMENT_BINDING_IMMUTABLE; @@ -2006,7 +2012,7 @@ export_environment_define (SCM env, SCM sym, SCM val) static SCM -export_environment_undefine (SCM env, SCM sym) +export_environment_undefine (SCM env SCM_UNUSED, SCM sym SCM_UNUSED) #define FUNC_NAME "export_environment_undefine" { return SCM_ENVIRONMENT_BINDING_IMMUTABLE; @@ -2082,7 +2088,8 @@ export_environment_free (SCM env) static int -export_environment_print (SCM type, SCM port, scm_print_state *pstate) +export_environment_print (SCM type, SCM port, + scm_print_state *pstate SCM_UNUSED) { SCM address = scm_ulong2num (SCM_UNPACK (type)); SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16)); @@ -2114,7 +2121,7 @@ void *scm_type_export_environment = &export_environment_funcs; static void -export_environment_observer (SCM caller, SCM export_env) +export_environment_observer (SCM caller SCM_UNUSED, SCM export_env) { core_environments_broadcast (export_env); } diff --git a/libguile/error.h b/libguile/error.h index cfdc604a1..37b8ee342 100644 --- a/libguile/error.h +++ b/libguile/error.h @@ -1,8 +1,8 @@ /* classes: h_files */ -#ifndef ERRORH -#define ERRORH -/* Copyright (C) 1995,1996,1997,1998, 2000 Free Software Foundation, Inc. +#ifndef SCM_ERROR_H +#define SCM_ERROR_H +/* 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 @@ -50,15 +50,6 @@ extern int scm_ints_disabled; -/* GCC can be told that a function doesn't return; this helps it do - better error checking (for uninitialized variable use, for - example), and some optimization. */ -#ifdef __GNUC__ -#define SCM_NORETURN __attribute__ ((noreturn)) -#else -#define SCM_NORETURN -#endif - extern void scm_error (SCM key, const char *subr, const char *message, SCM args, SCM rest) SCM_NORETURN; extern SCM scm_error_scm (SCM key, SCM subr, SCM message, @@ -91,7 +82,7 @@ extern SCM scm_wta (SCM arg, const char *pos, const char *s_subr); #endif /* SCM_DEBUG_DEPRECATED == 0 */ -#endif /* ERRORH */ +#endif /* SCM_ERROR_H */ /* Local Variables: diff --git a/libguile/eval.c b/libguile/eval.c index ee577c1e1..a45ae0851 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -518,7 +518,7 @@ SCM_SYNTAX(s_quote,"quote", scm_makmmacro, scm_m_quote); SCM_GLOBAL_SYMBOL(scm_sym_quote, s_quote); SCM -scm_m_quote (SCM xorig, SCM env) +scm_m_quote (SCM xorig, SCM env SCM_UNUSED) { SCM x = scm_copy_tree (SCM_CDR (xorig)); @@ -532,7 +532,7 @@ SCM_SYNTAX(s_begin, "begin", scm_makmmacro, scm_m_begin); SCM_GLOBAL_SYMBOL(scm_sym_begin, s_begin); SCM -scm_m_begin (SCM xorig, SCM env) +scm_m_begin (SCM xorig, SCM env SCM_UNUSED) { SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) >= 1, scm_s_expression, s_begin); return scm_cons (SCM_IM_BEGIN, SCM_CDR (xorig)); @@ -542,7 +542,7 @@ SCM_SYNTAX(s_if, "if", scm_makmmacro, scm_m_if); SCM_GLOBAL_SYMBOL(scm_sym_if, s_if); SCM -scm_m_if (SCM xorig, SCM env) +scm_m_if (SCM xorig, SCM env SCM_UNUSED) { long len = scm_ilength (SCM_CDR (xorig)); SCM_ASSYNT (len >= 2 && len <= 3, scm_s_expression, "if"); @@ -556,7 +556,7 @@ const char scm_s_set_x[] = "set!"; SCM_GLOBAL_SYMBOL(scm_sym_set_x, scm_s_set_x); SCM -scm_m_set_x (SCM xorig, SCM env) +scm_m_set_x (SCM xorig, SCM env SCM_UNUSED) { SCM x = SCM_CDR (xorig); SCM_ASSYNT (2 == scm_ilength (x), scm_s_expression, scm_s_set_x); @@ -569,7 +569,7 @@ SCM_SYNTAX(s_and, "and", scm_makmmacro, scm_m_and); SCM_GLOBAL_SYMBOL(scm_sym_and, s_and); SCM -scm_m_and (SCM xorig, SCM env) +scm_m_and (SCM xorig, SCM env SCM_UNUSED) { long len = scm_ilength (SCM_CDR (xorig)); SCM_ASSYNT (len >= 0, scm_s_test, s_and); @@ -583,7 +583,7 @@ SCM_SYNTAX(s_or,"or", scm_makmmacro, scm_m_or); SCM_GLOBAL_SYMBOL(scm_sym_or,s_or); SCM -scm_m_or (SCM xorig, SCM env) +scm_m_or (SCM xorig, SCM env SCM_UNUSED) { long len = scm_ilength (SCM_CDR (xorig)); SCM_ASSYNT (len >= 0, scm_s_test, s_or); @@ -598,7 +598,7 @@ SCM_SYNTAX(s_case, "case", scm_makmmacro, scm_m_case); SCM_GLOBAL_SYMBOL(scm_sym_case, s_case); SCM -scm_m_case (SCM xorig, SCM env) +scm_m_case (SCM xorig, SCM env SCM_UNUSED) { SCM proc, cdrx = scm_list_copy (SCM_CDR (xorig)), x = cdrx; SCM_ASSYNT (scm_ilength (x) >= 2, scm_s_clauses, s_case); @@ -620,7 +620,7 @@ SCM_GLOBAL_SYMBOL(scm_sym_cond, s_cond); SCM -scm_m_cond (SCM xorig, SCM env) +scm_m_cond (SCM xorig, SCM env SCM_UNUSED) { SCM arg1, cdrx = scm_list_copy (SCM_CDR (xorig)), x = cdrx; long len = scm_ilength (x); @@ -663,7 +663,7 @@ scm_c_improper_memq (SCM obj, SCM list) } SCM -scm_m_lambda (SCM xorig, SCM env) +scm_m_lambda (SCM xorig, SCM env SCM_UNUSED) { SCM proc, x = SCM_CDR (xorig); if (scm_ilength (x) < 2) @@ -710,7 +710,7 @@ SCM_GLOBAL_SYMBOL(scm_sym_letstar,s_letstar); SCM -scm_m_letstar (SCM xorig, SCM env) +scm_m_letstar (SCM xorig, SCM env SCM_UNUSED) { SCM x = SCM_CDR (xorig), arg1, proc, vars = SCM_EOL, *varloc = &vars; long len = scm_ilength (x); @@ -750,7 +750,7 @@ SCM_SYNTAX(s_do, "do", scm_makmmacro, scm_m_do); SCM_GLOBAL_SYMBOL(scm_sym_do, s_do); SCM -scm_m_do (SCM xorig, SCM env) +scm_m_do (SCM xorig, SCM env SCM_UNUSED) { SCM x = SCM_CDR (xorig), arg1, proc; SCM vars = SCM_EOL, inits = SCM_EOL, steps = SCM_EOL; @@ -852,7 +852,7 @@ SCM_SYNTAX (s_delay, "delay", scm_makmmacro, scm_m_delay); SCM_GLOBAL_SYMBOL (scm_sym_delay, s_delay); SCM -scm_m_delay (SCM xorig, SCM env) +scm_m_delay (SCM xorig, SCM env SCM_UNUSED) { SCM_ASSYNT (scm_ilength (xorig) == 2, scm_s_expression, s_delay); return scm_cons2 (SCM_IM_DELAY, SCM_EOL, SCM_CDR (xorig)); @@ -912,7 +912,7 @@ scm_m_define (SCM x, SCM env) /* end of acros */ static SCM -scm_m_letrec1 (SCM op, SCM imm, SCM xorig, SCM env) +scm_m_letrec1 (SCM op, SCM imm, SCM xorig, SCM env SCM_UNUSED) { SCM cdrx = SCM_CDR (xorig); /* locally mutable version of form */ char *what = SCM_SYMBOL_CHARS (SCM_CAR (xorig)); @@ -1022,7 +1022,7 @@ SCM_GLOBAL_SYMBOL (scm_sym_atapply, s_atapply); SCM_GLOBAL_SYMBOL (scm_sym_apply, s_atapply + 1); SCM -scm_m_apply (SCM xorig, SCM env) +scm_m_apply (SCM xorig, SCM env SCM_UNUSED) { SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 2, scm_s_expression, s_atapply); return scm_cons (SCM_IM_APPLY, SCM_CDR (xorig)); @@ -1034,7 +1034,7 @@ SCM_GLOBAL_SYMBOL(scm_sym_atcall_cc,s_atcall_cc); SCM -scm_m_cont (SCM xorig, SCM env) +scm_m_cont (SCM xorig, SCM env SCM_UNUSED) { SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, scm_s_expression, s_atcall_cc); @@ -1049,7 +1049,7 @@ SCM_GLOBAL_SYMBOL (scm_lisp_t, "t"); SCM_SYNTAX (s_nil_cond, "nil-cond", scm_makmmacro, scm_m_nil_cond); SCM -scm_m_nil_cond (SCM xorig, SCM env) +scm_m_nil_cond (SCM xorig, SCM env SCM_UNUSED) { long len = scm_ilength (SCM_CDR (xorig)); SCM_ASSYNT (len >= 1 && (len & 1) == 1, scm_s_expression, "nil-cond"); @@ -1059,7 +1059,7 @@ scm_m_nil_cond (SCM xorig, SCM env) SCM_SYNTAX (s_nil_ify, "nil-ify", scm_makmmacro, scm_m_nil_ify); SCM -scm_m_nil_ify (SCM xorig, SCM env) +scm_m_nil_ify (SCM xorig, SCM env SCM_UNUSED) { SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, scm_s_expression, "nil-ify"); return scm_cons (SCM_IM_NIL_IFY, SCM_CDR (xorig)); @@ -1068,7 +1068,7 @@ scm_m_nil_ify (SCM xorig, SCM env) SCM_SYNTAX (s_t_ify, "t-ify", scm_makmmacro, scm_m_t_ify); SCM -scm_m_t_ify (SCM xorig, SCM env) +scm_m_t_ify (SCM xorig, SCM env SCM_UNUSED) { SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, scm_s_expression, "t-ify"); return scm_cons (SCM_IM_T_IFY, SCM_CDR (xorig)); @@ -1077,7 +1077,7 @@ scm_m_t_ify (SCM xorig, SCM env) SCM_SYNTAX (s_0_cond, "0-cond", scm_makmmacro, scm_m_0_cond); SCM -scm_m_0_cond (SCM xorig, SCM env) +scm_m_0_cond (SCM xorig, SCM env SCM_UNUSED) { long len = scm_ilength (SCM_CDR (xorig)); SCM_ASSYNT (len >= 1 && (len & 1) == 1, scm_s_expression, "0-cond"); @@ -1087,7 +1087,7 @@ scm_m_0_cond (SCM xorig, SCM env) SCM_SYNTAX (s_0_ify, "0-ify", scm_makmmacro, scm_m_0_ify); SCM -scm_m_0_ify (SCM xorig, SCM env) +scm_m_0_ify (SCM xorig, SCM env SCM_UNUSED) { SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, scm_s_expression, "0-ify"); return scm_cons (SCM_IM_0_IFY, SCM_CDR (xorig)); @@ -1096,7 +1096,7 @@ scm_m_0_ify (SCM xorig, SCM env) SCM_SYNTAX (s_1_ify, "1-ify", scm_makmmacro, scm_m_1_ify); SCM -scm_m_1_ify (SCM xorig, SCM env) +scm_m_1_ify (SCM xorig, SCM env SCM_UNUSED) { SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, scm_s_expression, "1-ify"); return scm_cons (SCM_IM_1_IFY, SCM_CDR (xorig)); @@ -1105,7 +1105,7 @@ scm_m_1_ify (SCM xorig, SCM env) SCM_SYNTAX (s_atfop, "@fop", scm_makmmacro, scm_m_atfop); SCM -scm_m_atfop (SCM xorig, SCM env) +scm_m_atfop (SCM xorig, SCM env SCM_UNUSED) { SCM x = SCM_CDR (xorig), var; SCM_ASSYNT (scm_ilength (x) >= 1, scm_s_expression, "@fop"); @@ -1148,7 +1148,7 @@ SCM_SYNTAX (s_at_call_with_values, "@call-with-values", scm_makmmacro, scm_m_at_ SCM_GLOBAL_SYMBOL(scm_sym_at_call_with_values, s_at_call_with_values); SCM -scm_m_at_call_with_values (SCM xorig, SCM env) +scm_m_at_call_with_values (SCM xorig, SCM env SCM_UNUSED) { SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 2, scm_s_expression, s_at_call_with_values); diff --git a/libguile/evalext.c b/libguile/evalext.c index a36ef687b..b19f94c21 100644 --- a/libguile/evalext.c +++ b/libguile/evalext.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. +/* Copyright (C) 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 @@ -56,7 +56,7 @@ SCM_SYMBOL (scm_sym_setter, "setter"); SCM -scm_m_generalized_set_x (SCM xorig, SCM env) +scm_m_generalized_set_x (SCM xorig, SCM env SCM_UNUSED) { SCM x = SCM_CDR (xorig); SCM_ASSYNT (2 == scm_ilength (x), scm_s_expression, scm_s_set_x); diff --git a/libguile/filesys.c b/libguile/filesys.c index 0960300e6..56b4737d1 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -783,7 +783,7 @@ SCM_DEFINE (scm_closedir, "closedir", 1, 0, 0, static int -scm_dir_print (SCM exp, SCM port, scm_print_state *pstate) +scm_dir_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) { scm_puts ("#<", port); if (!SCM_DIR_OPEN_P (exp)) diff --git a/libguile/fluids.c b/libguile/fluids.c index 718dc5f3f..b3a12d666 100644 --- a/libguile/fluids.c +++ b/libguile/fluids.c @@ -96,7 +96,7 @@ scm_copy_fluids (scm_root_state *root_state) } static int -fluid_print (SCM exp, SCM port, scm_print_state *pstate) +fluid_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) { scm_puts ("#<fluid ", port); scm_intprint ((int) SCM_FLUID_NUM (exp), 10, port); diff --git a/libguile/fports.c b/libguile/fports.c index acf7b3f2f..f5c63d0d0 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1995,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 @@ -441,7 +441,7 @@ fport_input_waiting (SCM port) static int -fport_print (SCM exp, SCM port, scm_print_state *pstate) +fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) { scm_puts ("#<", port); scm_print_port_mode (exp, port); diff --git a/libguile/gc.c b/libguile/gc.c index 48f688b93..29eee3392 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -108,11 +108,19 @@ scm_bits_t scm_tc16_allocated; */ unsigned int scm_debug_cell_accesses_p = 1; +/* Set this to 0 if no additional gc's shall be performed, otherwise set it to + * the number of cell accesses after which a gc shall be called. + */ +static unsigned int debug_cells_gc_interval = 0; + /* Assert that the given object is a valid reference to a valid cell. This * test involves to determine whether the object is a cell pointer, whether * this pointer actually points into a heap segment and whether the cell - * pointed to is not a free cell. + * pointed to is not a free cell. Further, additional garbage collections may + * get executed after a user defined number of cell accesses. This helps to + * find places in the C code where references are dropped for extremely short + * periods. */ void scm_assert_cell_valid (SCM cell) @@ -146,6 +154,24 @@ scm_assert_cell_valid (SCM cell) (unsigned long) SCM_UNPACK (cell)); abort (); } + + /* If desired, perform additional garbage collections after a user + * defined number of cell accesses. + */ + if (debug_cells_gc_interval) + { + static unsigned int counter = 0; + + if (counter != 0) + { + --counter; + } + else + { + counter = debug_cells_gc_interval; + scm_igc ("scm_assert_cell_valid"); + } + } } already_running = 0; /* re-enable */ } @@ -155,7 +181,11 @@ scm_assert_cell_valid (SCM cell) SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0, (SCM flag), "If @var{flag} is @code{#f}, cell access checking is disabled.\n" - "If @var{flag} is @code{#t}, cell access checking is enabled.\n" + "If @var{flag} is @code{#t}, cell access checking is enabled,\n" + "but no additional calls to garbage collection are issued.\n" + "If @var{flag} is a number, cell access checking is enabled,\n" + "with an additional garbage collection after the given\n" + "number of cell accesses.\n" "This procedure only exists when the compile-time flag\n" "@code{SCM_DEBUG_CELL_ACCESSES} was set to 1.") #define FUNC_NAME s_scm_set_debug_cell_accesses_x @@ -163,6 +193,12 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0, if (SCM_FALSEP (flag)) { scm_debug_cell_accesses_p = 0; } else if (SCM_EQ_P (flag, SCM_BOOL_T)) { + debug_cells_gc_interval = 0; + scm_debug_cell_accesses_p = 1; + } else if (SCM_INUMP (flag)) { + long int f = SCM_INUM (flag); + if (f <= 0) SCM_OUT_OF_RANGE (1, flag); + debug_cells_gc_interval = f; scm_debug_cell_accesses_p = 1; } else { SCM_WRONG_TYPE_ARG (1, flag); @@ -824,7 +860,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, static void -gc_start_stats (const char *what) +gc_start_stats (const char *what SCM_UNUSED) { t_before_gc = scm_c_get_internal_run_time (); scm_gc_cells_swept = 0; @@ -2449,19 +2485,19 @@ alloc_some_heap (scm_freelist_t *freelist, policy_on_error error_policy) */ void -scm_remember_upto_here_1 (SCM obj) +scm_remember_upto_here_1 (SCM obj SCM_UNUSED) { /* Empty. Protects a single object from garbage collection. */ } void -scm_remember_upto_here_2 (SCM obj1, SCM obj2) +scm_remember_upto_here_2 (SCM obj1 SCM_UNUSED, SCM obj2 SCM_UNUSED) { /* Empty. Protects two objects from garbage collection. */ } void -scm_remember_upto_here (SCM obj, ...) +scm_remember_upto_here (SCM obj SCM_UNUSED, ...) { /* Empty. Protects any number of objects from garbage collection. */ } @@ -2828,9 +2864,41 @@ gc_async_thunk (void) * gc_async_thunk). */ static void * -mark_gc_async (void * hook_data, void *func_data, void *data) -{ +mark_gc_async (void * hook_data SCM_UNUSED, + void *func_data SCM_UNUSED, + void *data SCM_UNUSED) +{ + /* If cell access debugging is enabled, the user may choose to perform + * additional garbage collections after an arbitrary number of cell + * accesses. We don't want the scheme level after-gc-hook to be performed + * for each of these garbage collections for the following reason: The + * execution of the after-gc-hook causes cell accesses itself. Thus, if the + * after-gc-hook was performed with every gc, and if the gc was performed + * after a very small number of cell accesses, then the number of cell + * accesses during the execution of the after-gc-hook will suffice to cause + * the execution of the next gc. Then, guile would keep executing the + * after-gc-hook over and over again, and would never come to do other + * things. + * + * To overcome this problem, if cell access debugging with additional + * garbage collections is enabled, the after-gc-hook is never run by the + * garbage collecter. When running guile with cell access debugging and the + * execution of the after-gc-hook is desired, then it is necessary to run + * the hook explicitly from the user code. This has the effect, that from + * the scheme level point of view it seems that garbage collection is + * performed with a much lower frequency than it actually is. Obviously, + * this will not work for code that depends on a fixed one to one + * relationship between the execution counts of the C level garbage + * collection hooks and the execution count of the scheme level + * after-gc-hook. + */ +#if (SCM_DEBUG_CELL_ACCESSES == 1) + if (debug_cells_gc_interval == 0) + scm_system_async_mark (gc_async); +#else scm_system_async_mark (gc_async); +#endif + return NULL; } diff --git a/libguile/gh_init.c b/libguile/gh_init.c index 5dbc7daad..62b684d29 100644 --- a/libguile/gh_init.c +++ b/libguile/gh_init.c @@ -1,5 +1,5 @@ -/* Copyright (C) 1995,1996,1997, 2000 Free Software Foundation, Inc. - +/* Copyright (C) 1995,1996,1997,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) @@ -94,7 +94,7 @@ gh_catch (SCM tag, scm_catch_body_t body, void *body_data, } SCM -gh_standard_handler (void *data, SCM tag, SCM throw_args) +gh_standard_handler (void *data SCM_UNUSED, SCM tag, SCM throw_args SCM_UNUSED) { fprintf (stderr, "\nJust got an error; tag is\n "); scm_display (tag, scm_current_output_port ()); diff --git a/libguile/goops.c b/libguile/goops.c index a85f4975c..4ea756a10 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -1047,7 +1047,7 @@ slot_definition_using_name (SCM class, SCM slot_name) } static SCM -get_slot_value (SCM class, SCM obj, SCM slotdef) +get_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef) { SCM access = SCM_CDDR (slotdef); /* Two cases here: @@ -1084,7 +1084,7 @@ get_slot_value_using_name (SCM class, SCM obj, SCM slot_name) } static SCM -set_slot_value (SCM class, SCM obj, SCM slotdef, SCM value) +set_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef, SCM value) { SCM access = SCM_CDDR (slotdef); /* Two cases here: @@ -1125,7 +1125,7 @@ set_slot_value_using_name (SCM class, SCM obj, SCM slot_name, SCM value) } static SCM -test_slot_existence (SCM class, SCM obj, SCM slot_name) +test_slot_existence (SCM class SCM_UNUSED, SCM obj, SCM slot_name) { register SCM l; @@ -1518,7 +1518,7 @@ purgatory (void *args) } void -scm_change_object_class (SCM obj, SCM old_class, SCM new_class) +scm_change_object_class (SCM obj, SCM old_class SCM_UNUSED, SCM new_class) { if (!burnin (obj)) scm_internal_dynamic_wind (go_to_hell, purgatory, go_to_heaven, @@ -1868,7 +1868,7 @@ SCM_VARIABLE_INIT (var_compute_applicable_methods, "compute-applicable-methods", SCM_SYNTAX (s_atslot_ref, "@slot-ref", scm_makmmacro, scm_m_atslot_ref); SCM -scm_m_atslot_ref (SCM xorig, SCM env) +scm_m_atslot_ref (SCM xorig, SCM env SCM_UNUSED) #define FUNC_NAME s_atslot_ref { SCM x = SCM_CDR (xorig); @@ -1882,7 +1882,7 @@ scm_m_atslot_ref (SCM xorig, SCM env) SCM_SYNTAX (s_atslot_set_x, "@slot-set!", scm_makmmacro, scm_m_atslot_set_x); SCM -scm_m_atslot_set_x (SCM xorig, SCM env) +scm_m_atslot_set_x (SCM xorig, SCM env SCM_UNUSED) #define FUNC_NAME s_atslot_set_x { SCM x = SCM_CDR (xorig); @@ -2413,7 +2413,8 @@ create_port_classes (void) } static SCM -make_struct_class (void *closure, SCM key, SCM data, SCM prev) +make_struct_class (void *closure SCM_UNUSED, SCM key SCM_UNUSED, + SCM data, SCM prev SCM_UNUSED) { if (SCM_NFALSEP (SCM_STRUCT_TABLE_NAME (data))) SCM_SET_STRUCT_TABLE_CLASS (data, @@ -2499,7 +2500,7 @@ SCM_KEYWORD (k_accessor, "accessor"); SCM_KEYWORD (k_getter, "getter"); static SCM -default_setter (SCM obj, SCM c) +default_setter (SCM obj SCM_UNUSED, SCM c SCM_UNUSED) { scm_misc_error ("slot-set!", "read-only slot", SCM_EOL); return 0; diff --git a/libguile/guardians.c b/libguile/guardians.c index c41f048bd..b62d8088d 100644 --- a/libguile/guardians.c +++ b/libguile/guardians.c @@ -184,7 +184,7 @@ guardian_free (SCM ptr) static int -guardian_print (SCM guardian, SCM port, scm_print_state *pstate) +guardian_print (SCM guardian, SCM port, scm_print_state *pstate SCM_UNUSED) { guardian_t *g = GUARDIAN (guardian); @@ -428,7 +428,9 @@ SCM_DEFINE (scm_destroy_guardian_x, "destroy-guardian!", 1, 0, 0, /* called before gc mark phase begins to initialise the live guardian list. */ static void * -guardian_gc_init (void *dummy1, void *dummy2, void *dummy3) +guardian_gc_init (void *dummy1 SCM_UNUSED, + void *dummy2 SCM_UNUSED, + void *dummy3 SCM_UNUSED) { greedy_guardians = sharing_guardians = NULL; @@ -530,7 +532,9 @@ mark_and_zombify (guardian_t *g) phases. for each marked guardian, it moves any unmarked object in its live list (tconc) to its zombie list (tconc). */ static void * -guardian_zombify (void *dummy1, void *dummy2, void *dummy3) +guardian_zombify (void *dummy1 SCM_UNUSED, + void *dummy2 SCM_UNUSED, + void *dummy3 SCM_UNUSED) { guardian_t *last_greedy_guardian = NULL; guardian_t *last_sharing_guardian = NULL; @@ -588,7 +592,9 @@ guardian_zombify (void *dummy1, void *dummy2, void *dummy3) } static void * -whine_about_self_centered_zombies (void *dummy1, void *dummy2, void *dummy3) +whine_about_self_centered_zombies (void *dummy1 SCM_UNUSED, + void *dummy2 SCM_UNUSED, + void *dummy3 SCM_UNUSED) { if (! SCM_NULLP (SCM_CDR (self_centered_zombies))) { diff --git a/libguile/guile.c b/libguile/guile.c index aed12f4f8..21be17871 100644 --- a/libguile/guile.c +++ b/libguile/guile.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc. +/* Copyright (C) 1996,1997,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 @@ -61,7 +61,7 @@ GDB_INTERFACE; static void -inner_main (void *closure, int argc, char **argv) +inner_main (void *closure SCM_UNUSED, int argc, char **argv) { /* module initializations would go here */ scm_shell (argc, argv); diff --git a/libguile/init.c b/libguile/init.c index 0cb54f3ad..0c7e04578 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -279,7 +279,9 @@ stream_body (void *data) /* exception handler for stream_body. */ static SCM -stream_handler (void *data, SCM tag, SCM throw_args) +stream_handler (void *data SCM_UNUSED, + SCM tag SCM_UNUSED, + SCM throw_args SCM_UNUSED) { return SCM_BOOL_F; } diff --git a/libguile/keywords.c b/libguile/keywords.c index 53f457c1a..cea7ac526 100644 --- a/libguile/keywords.c +++ b/libguile/keywords.c @@ -59,7 +59,7 @@ scm_bits_t scm_tc16_keyword; static int -keyword_print (SCM exp, SCM port, scm_print_state *pstate) +keyword_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) { scm_puts ("#:", port); scm_print_symbol_name (SCM_SYMBOL_CHARS (SCM_CDR (exp)) + 1, diff --git a/libguile/mallocs.c b/libguile/mallocs.c index 0a6a1db61..168f0632e 100644 --- a/libguile/mallocs.c +++ b/libguile/mallocs.c @@ -74,7 +74,7 @@ malloc_free (SCM ptr) static int -malloc_print (SCM exp, SCM port, scm_print_state *pstate) +malloc_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) { scm_puts("#<malloc ", port); scm_intprint (SCM_CELL_WORD_1 (exp), 16, port); diff --git a/libguile/numbers.c b/libguile/numbers.c index 993b722ca..0beb8b2f0 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -2205,7 +2205,7 @@ SCM_DEFINE (scm_number_to_string, "number->string", 1, 1, 0, SCM_BIGDIG conditionals */ int -scm_print_real (SCM sexp, SCM port, scm_print_state *pstate) +scm_print_real (SCM sexp, SCM port, scm_print_state *pstate SCM_UNUSED) { char num_buf[FLOBUFLEN]; scm_lfwrite (num_buf, iflo2str (sexp, num_buf), port); @@ -2213,7 +2213,7 @@ scm_print_real (SCM sexp, SCM port, scm_print_state *pstate) } int -scm_print_complex (SCM sexp, SCM port, scm_print_state *pstate) +scm_print_complex (SCM sexp, SCM port, scm_print_state *pstate SCM_UNUSED) { char num_buf[FLOBUFLEN]; scm_lfwrite (num_buf, iflo2str (sexp, num_buf), port); @@ -2221,7 +2221,7 @@ scm_print_complex (SCM sexp, SCM port, scm_print_state *pstate) } int -scm_bigprint (SCM exp, SCM port, scm_print_state *pstate) +scm_bigprint (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) { #ifdef SCM_BIGDIG exp = big2str (exp, (unsigned int) 10); diff --git a/libguile/pairs.c b/libguile/pairs.c index 812c39235..48db366b3 100644 --- a/libguile/pairs.c +++ b/libguile/pairs.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996, 2000 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,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 @@ -54,6 +54,20 @@ /* {Pairs} */ +#if (SCM_DEBUG_PAIR_ACCESSES == 1) + +#include "libguile/ports.h" +#include "libguile/strings.h" + +void scm_error_pair_access (SCM non_pair) +{ + SCM message = scm_makfrom0str ("Non-pair accessed with SCM_C[AD]R: `~Sī\n"); + scm_simple_format (scm_current_error_port (), message, SCM_LIST1 (non_pair)); + abort (); +} + +#endif + SCM_DEFINE (scm_cons, "cons", 2, 0, 0, (SCM x, SCM y), "Return a newly allocated pair whose car is @var{x} and whose\n" diff --git a/libguile/pairs.h b/libguile/pairs.h index 96b0e47d7..17aa76cd1 100644 --- a/libguile/pairs.h +++ b/libguile/pairs.h @@ -1,8 +1,8 @@ /* classes: h_files */ -#ifndef PAIRSH -#define PAIRSH -/* Copyright (C) 1995,1996,2000 Free Software Foundation, Inc. +#ifndef SCM_PAIRS_H +#define SCM_PAIRS_H +/* Copyright (C) 1995,1996,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 @@ -52,14 +52,22 @@ +#if (SCM_DEBUG_PAIR_ACCESSES == 1) +# include "libguile/struct.h" +# define SCM_VALIDATE_PAIR(cell, expr) \ + ((!SCM_ECONSP (cell) ? scm_error_pair_access (cell), 0 : 0), (expr)) +#else +# define SCM_VALIDATE_PAIR(cell, expr) (expr) +#endif + #define SCM_NULLP(x) (SCM_EQ_P ((x), SCM_EOL)) #define SCM_NNULLP(x) (!SCM_NULLP (x)) -#define SCM_CAR(x) (SCM_CELL_OBJECT_0 (x)) -#define SCM_CDR(x) (SCM_CELL_OBJECT_1 (x)) +#define SCM_CAR(x) (SCM_VALIDATE_PAIR (x, SCM_CELL_OBJECT_0 (x))) +#define SCM_CDR(x) (SCM_VALIDATE_PAIR (x, SCM_CELL_OBJECT_1 (x))) -#define SCM_SETCAR(x, v) (SCM_SET_CELL_OBJECT_0 ((x), (v))) -#define SCM_SETCDR(x, v) (SCM_SET_CELL_OBJECT_1 ((x), (v))) +#define SCM_SETCAR(x, v) (SCM_VALIDATE_PAIR (x, SCM_SET_CELL_OBJECT_0 ((x), (v)))) +#define SCM_SETCDR(x, v) (SCM_VALIDATE_PAIR (x, SCM_SET_CELL_OBJECT_1 ((x), (v)))) #define SCM_CAAR(OBJ) SCM_CAR (SCM_CAR (OBJ)) #define SCM_CDAR(OBJ) SCM_CDR (SCM_CAR (OBJ)) @@ -94,6 +102,9 @@ +#if (SCM_DEBUG_PAIR_ACCESSES == 1) +extern void scm_error_pair_access (SCM) SCM_NORETURN; +#endif extern SCM scm_cons (SCM x, SCM y); extern SCM scm_cons2 (SCM w, SCM x, SCM y); extern SCM scm_pair_p (SCM x); @@ -101,7 +112,7 @@ extern SCM scm_set_car_x (SCM pair, SCM value); extern SCM scm_set_cdr_x (SCM pair, SCM value); extern void scm_init_pairs (void); -#endif /* PAIRSH */ +#endif /* SCM_PAIRS_H */ /* Local Variables: diff --git a/libguile/ports.c b/libguile/ports.c index 9bc8168bd..cf1ac56c7 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -108,12 +108,12 @@ scm_markstream (SCM ptr) */ static void -flush_port_default (SCM port) +flush_port_default (SCM port SCM_UNUSED) { } static void -end_input_default (SCM port, int offset) +end_input_default (SCM port SCM_UNUSED, int offset SCM_UNUSED) { } @@ -1487,7 +1487,7 @@ scm_print_port_mode (SCM exp, SCM port) } int -scm_port_print (SCM exp, SCM port, scm_print_state *pstate) +scm_port_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) { char *type = SCM_PTOBNAME (SCM_PTOBNUM (exp)); if (!type) @@ -1514,13 +1514,15 @@ scm_ports_prehistory () scm_bits_t scm_tc16_void_port = 0; -static int fill_input_void_port (SCM port) +static int fill_input_void_port (SCM port SCM_UNUSED) { return EOF; } static void -write_void_port (SCM port, const void *data, size_t size) +write_void_port (SCM port SCM_UNUSED, + const void *data SCM_UNUSED, + size_t size SCM_UNUSED) { } diff --git a/libguile/ramap.c b/libguile/ramap.c index 74e281c65..4c169753b 100644 --- a/libguile/ramap.c +++ b/libguile/ramap.c @@ -475,7 +475,7 @@ SCM_DEFINE (scm_array_fill_x, "array-fill!", 2, 0, 0, /* to be used as cproc in scm_ramapc to fill an array dimension with "fill". */ int -scm_array_fill_int (SCM ra, SCM fill, SCM ignore) +scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED) #define FUNC_NAME s_scm_array_fill_x { unsigned long i; diff --git a/libguile/rdelim.c b/libguile/rdelim.c index c029b3f8c..b8fde12e2 100644 --- a/libguile/rdelim.c +++ b/libguile/rdelim.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +/* Copyright (C) 1995,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 diff --git a/libguile/root.c b/libguile/root.c index f3d6edd86..e37d77b8f 100644 --- a/libguile/root.c +++ b/libguile/root.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998, 1999, 2000 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000 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 @@ -92,7 +92,7 @@ root_mark (SCM root) static int -root_print (SCM exp, SCM port, scm_print_state *pstate) +root_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) { scm_puts ("#<root ", port); scm_intprint(SCM_SEQ (SCM_ROOT_STATE (exp) -> rootcont), 16, port); diff --git a/libguile/smob.c b/libguile/smob.c index e2d9fcb7c..558adc979 100644 --- a/libguile/smob.c +++ b/libguile/smob.c @@ -84,7 +84,7 @@ scm_smob_descriptor scm_smobs[MAX_SMOB_COUNT]; to make their links fail. */ SCM -scm_mark0 (SCM ptr) +scm_mark0 (SCM ptr SCM_UNUSED) { return SCM_BOOL_F; } @@ -101,7 +101,7 @@ scm_markcdr (SCM ptr) */ size_t -scm_free0 (SCM ptr) +scm_free0 (SCM ptr SCM_UNUSED) { return 0; } @@ -117,7 +117,7 @@ scm_smob_free (SCM obj) */ int -scm_smob_print (SCM exp, SCM port, scm_print_state *pstate) +scm_smob_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) { long n = SCM_SMOBNUM (exp); scm_puts ("#<", port); @@ -216,7 +216,7 @@ scm_smob_apply_1_021 (SCM smob, SCM a1) } static SCM -scm_smob_apply_1_error (SCM smob, SCM a1) +scm_smob_apply_1_error (SCM smob, SCM a1 SCM_UNUSED) { scm_wrong_num_args (smob); } @@ -246,7 +246,7 @@ scm_smob_apply_2_021 (SCM smob, SCM a1, SCM a2) } static SCM -scm_smob_apply_2_error (SCM smob, SCM a1, SCM a2) +scm_smob_apply_2_error (SCM smob, SCM a1 SCM_UNUSED, SCM a2 SCM_UNUSED) { scm_wrong_num_args (smob); } @@ -278,7 +278,10 @@ scm_smob_apply_3_021 (SCM smob, SCM a1, SCM a2, SCM rst) } static SCM -scm_smob_apply_3_error (SCM smob, SCM a1, SCM a2, SCM rst) +scm_smob_apply_3_error (SCM smob, + SCM a1 SCM_UNUSED, + SCM a2 SCM_UNUSED, + SCM rst SCM_UNUSED) { scm_wrong_num_args (smob); } @@ -512,7 +515,7 @@ scm_set_smob_mfpe (long tc, */ static int -free_print (SCM exp, SCM port, scm_print_state *pstate) +free_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) { char buf[100]; diff --git a/libguile/stime.c b/libguile/stime.c index ac99a1587..f99656da4 100644 --- a/libguile/stime.c +++ b/libguile/stime.c @@ -325,7 +325,7 @@ setzone (SCM zone, int pos, const char *subr) } static void -restorezone (SCM zone, char **oldenv, const char *subr) +restorezone (SCM zone, char **oldenv, const char *subr SCM_UNUSED) { if (!SCM_UNBNDP (zone)) { diff --git a/libguile/strings.c b/libguile/strings.c index b87864973..a60c03ac1 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -192,7 +192,7 @@ scm_take0str (char *s) } SCM -scm_makfromstr (const char *src, size_t len, int dummy) +scm_makfromstr (const char *src, size_t len, int dummy SCM_UNUSED) { SCM s = scm_allocate_string (len); char *dst = SCM_STRING_CHARS (s); diff --git a/libguile/struct.c b/libguile/struct.c index b13a8c1c8..dc9b7d981 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -332,7 +332,8 @@ scm_alloc_struct (int n_words, int n_extra, char *who) } size_t -scm_struct_free_0 (scm_bits_t * vtable, scm_bits_t * data) +scm_struct_free_0 (scm_bits_t * vtable SCM_UNUSED, + scm_bits_t * data SCM_UNUSED) { return 0; } @@ -345,7 +346,7 @@ scm_struct_free_light (scm_bits_t * vtable, scm_bits_t * data) } size_t -scm_struct_free_standard (scm_bits_t * vtable, scm_bits_t * data) +scm_struct_free_standard (scm_bits_t * vtable SCM_UNUSED, scm_bits_t * data) { size_t n = (data[scm_struct_i_n_words] + scm_struct_n_extra_words) * sizeof (scm_bits_t) + 7; @@ -354,7 +355,7 @@ scm_struct_free_standard (scm_bits_t * vtable, scm_bits_t * data) } size_t -scm_struct_free_entity (scm_bits_t * vtable, scm_bits_t * data) +scm_struct_free_entity (scm_bits_t * vtable SCM_UNUSED, scm_bits_t * data) { size_t n = (data[scm_struct_i_n_words] + scm_struct_entity_n_extra_words) * sizeof (scm_bits_t) + 7; @@ -363,14 +364,18 @@ scm_struct_free_entity (scm_bits_t * vtable, scm_bits_t * data) } static void * -scm_struct_gc_init (void *dummy1, void *dummy2, void *dummy3) +scm_struct_gc_init (void *dummy1 SCM_UNUSED, + void *dummy2 SCM_UNUSED, + void *dummy3 SCM_UNUSED) { scm_structs_to_free = SCM_EOL; return 0; } static void * -scm_free_structs (void *dummy1, void *dummy2, void *dummy3) +scm_free_structs (void *dummy1 SCM_UNUSED, + void *dummy2 SCM_UNUSED, + void *dummy3 SCM_UNUSED) { SCM newchain = scm_structs_to_free; do diff --git a/libguile/symbols.c b/libguile/symbols.c index 83cddc0da..448c9d85f 100644 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@ -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 * it under the terms of the GNU General Public License as published by diff --git a/libguile/throw.c b/libguile/throw.c index 63af28650..765924bf6 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -84,7 +84,7 @@ static scm_bits_t tc16_jmpbuffer; #endif static int -jmpbuffer_print (SCM exp, SCM port, scm_print_state *pstate) +jmpbuffer_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) { scm_puts ("#<jmpbuffer ", port); scm_puts (JBACTIVE(exp) ? "(active) " : "(inactive) ", port); @@ -238,7 +238,7 @@ struct lazy_catch { appear in normal data structures, only in the wind list. However, it might be nice for debugging someday... */ static int -lazy_catch_print (SCM closure, SCM port, scm_print_state *pstate) +lazy_catch_print (SCM closure, SCM port, scm_print_state *pstate SCM_UNUSED) { struct lazy_catch *c = (struct lazy_catch *) SCM_CELL_WORD_1 (closure); char buf[200]; @@ -295,7 +295,7 @@ scm_internal_lazy_catch (SCM tag, scm_catch_body_t body, void *body_data, scm_ca scm_the_last_stack_fluid_var on error. */ static SCM -ss_handler (void *data, SCM tag, SCM throw_args) +ss_handler (void *data SCM_UNUSED, SCM tag, SCM throw_args) { /* Save the stack */ scm_fluid_set_x (SCM_VARIABLE_REF (scm_the_last_stack_fluid_var), @@ -503,7 +503,7 @@ scm_handle_by_message_noexit (void *handler_data, SCM tag, SCM args) SCM -scm_handle_by_throw (void *handler_data, SCM tag, SCM args) +scm_handle_by_throw (void *handler_data SCM_UNUSED, SCM tag, SCM args) { scm_ithrow (tag, args, 1); return SCM_UNSPECIFIED; /* never returns */ @@ -602,7 +602,7 @@ SCM_DEFINE (scm_throw, "throw", 1, 0, 1, #undef FUNC_NAME SCM -scm_ithrow (SCM key, SCM args, int noreturn) +scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED) { SCM jmpbuf = SCM_UNDEFINED; SCM wind_goal; diff --git a/libguile/weaks.c b/libguile/weaks.c index 4bfe975a0..144f32cb9 100644 --- a/libguile/weaks.c +++ b/libguile/weaks.c @@ -217,7 +217,9 @@ SCM_DEFINE (scm_doubly_weak_hash_table_p, "doubly-weak-hash-table?", 1, 0, 0, #undef FUNC_NAME static void * -scm_weak_vector_gc_init (void *dummy1, void *dummy2, void *dummy3) +scm_weak_vector_gc_init (void *dummy1 SCM_UNUSED, + void *dummy2 SCM_UNUSED, + void *dummy3 SCM_UNUSED) { scm_weak_vectors = SCM_EOL; @@ -225,7 +227,9 @@ scm_weak_vector_gc_init (void *dummy1, void *dummy2, void *dummy3) } static void * -scm_mark_weak_vector_spines (void *dummy1, void *dummy2, void *dummy3) +scm_mark_weak_vector_spines (void *dummy1 SCM_UNUSED, + void *dummy2 SCM_UNUSED, + void *dummy3 SCM_UNUSED) { SCM w; @@ -262,7 +266,9 @@ scm_mark_weak_vector_spines (void *dummy1, void *dummy2, void *dummy3) } static void * -scm_scan_weak_vectors (void *dummy1, void *dummy2, void *dummy3) +scm_scan_weak_vectors (void *dummy1 SCM_UNUSED, + void *dummy2 SCM_UNUSED, + void *dummy3 SCM_UNUSED) { SCM *ptr, w; for (w = scm_weak_vectors; !SCM_NULLP (w); w = SCM_WVECT_GC_CHAIN (w)) |