diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 557b9b808..5eb22ccd8 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,23 @@ +2001-06-08 Dirk Herrmann + + * keywords.c (keyword_print): Don't use SCM_C[AD]R to access + keywords. Fix gc protection. + + * objects.c (scm_mcache_lookup_cmethod): Don't use side effecting + operations in macro calls. + + * pairs.c (scm_error_pair_access): Avoid recursion. + + Thanks to Matthias Koeppe for reporting the bugs that correspond + to the following set of patches. + + * unif.c (scm_bit_set_star_x, scm_bit_invert_x), vectors.h + (SCM_BITVEC_REF, SCM_BITVEC_SET, SCM_BITVEC_CLR): Obtain the + bitvector base address using SCM_BITVECTOR_BASE. + + * unif.h (SCM_BITVECTOR_BASE): Return the base address as an + unsigned long*. + 2001-06-08 Dirk Herrmann * goops.c (SCM_CLASS_REDEF): Removed. diff --git a/libguile/keywords.c b/libguile/keywords.c index cea7ac526..36e0ce26e 100644 --- a/libguile/keywords.c +++ b/libguile/keywords.c @@ -61,10 +61,13 @@ scm_bits_t scm_tc16_keyword; static int keyword_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) { + SCM symbol = SCM_KEYWORDSYM (exp); + scm_puts ("#:", port); - scm_print_symbol_name (SCM_SYMBOL_CHARS (SCM_CDR (exp)) + 1, - SCM_SYMBOL_LENGTH (SCM_CDR (exp)) - 1, + scm_print_symbol_name (SCM_SYMBOL_CHARS (symbol) + 1, + SCM_SYMBOL_LENGTH (symbol) - 1, port); + scm_remember_upto_here_1 (symbol); return 1; } diff --git a/libguile/objects.c b/libguile/objects.c index 4cec90ba2..a8ece94a3 100644 --- a/libguile/objects.c +++ b/libguile/objects.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995, 1996, 1999, 2000 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,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 @@ -268,7 +268,8 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args) /* Compute a hash value */ long hashset = SCM_INUM (methods); long j = n; - mask = SCM_INUM (SCM_CAR (z = SCM_CDDR (z))); + z = SCM_CDDR (z); + mask = SCM_INUM (SCM_CAR (z)); methods = SCM_CADR (z); i = 0; ls = args; diff --git a/libguile/pairs.c b/libguile/pairs.c index 48db366b3..24d1aec07 100644 --- a/libguile/pairs.c +++ b/libguile/pairs.c @@ -61,9 +61,16 @@ void scm_error_pair_access (SCM non_pair) { + static unsigned int running = 0; 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 (); + + if (!running) + { + running = 1; + scm_simple_format (scm_current_error_port (), + message, SCM_LIST1 (non_pair)); + abort (); + } } #endif diff --git a/libguile/unif.c b/libguile/unif.c index 5e0a801df..e1f1bd017 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -1924,10 +1924,10 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, SCM_ASSERT (SCM_BITVECTOR_LENGTH (v) == SCM_BITVECTOR_LENGTH (kv), v, SCM_ARG1, FUNC_NAME); if (SCM_FALSEP (obj)) for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;) - SCM_UNPACK (SCM_VELTS (v)[k]) &= ~ SCM_UNPACK(SCM_VELTS (kv)[k]); + SCM_BITVECTOR_BASE (v) [k] &= ~SCM_BITVECTOR_BASE (kv) [k]; else if (SCM_EQ_P (obj, SCM_BOOL_T)) for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;) - SCM_UNPACK (SCM_VELTS (v)[k]) |= SCM_UNPACK (SCM_VELTS (kv)[k]); + SCM_BITVECTOR_BASE (v) [k] |= SCM_BITVECTOR_BASE (kv) [k]; else goto badarg3; break; @@ -2016,7 +2016,7 @@ SCM_DEFINE (scm_bit_invert_x, "bit-invert!", 1, 0, 0, k = SCM_BITVECTOR_LENGTH (v); for (k = (k + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;) - SCM_UNPACK (SCM_VELTS (v)[k]) = ~SCM_UNPACK (SCM_VELTS (v)[k]); + SCM_BITVECTOR_BASE (v) [k] = ~SCM_BITVECTOR_BASE (v) [k]; return SCM_UNSPECIFIED; } diff --git a/libguile/unif.h b/libguile/unif.h index 1a7b1b46f..867c04427 100644 --- a/libguile/unif.h +++ b/libguile/unif.h @@ -109,7 +109,7 @@ extern scm_bits_t scm_tc16_array; #define SCM_SET_UVECTOR_LENGTH(v, l, t) (SCM_SET_CELL_WORD_0 ((v), ((l) << 8) + (t))) #define SCM_BITVECTOR_P(x) (!SCM_IMP (x) && (SCM_TYP7 (x) == scm_tc7_bvect)) -#define SCM_BITVECTOR_BASE(x) ((void *) (SCM_CELL_WORD_1 (x))) +#define SCM_BITVECTOR_BASE(x) ((unsigned long *) (SCM_CELL_WORD_1 (x))) #define SCM_SET_BITVECTOR_BASE(v, b) (SCM_SET_CELL_WORD_1 ((v), (b))) #define SCM_BITVECTOR_MAX_LENGTH SCM_I_MAX_LENGTH #define SCM_BITVECTOR_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8) diff --git a/libguile/vectors.h b/libguile/vectors.h index 0f1456853..7a788f00b 100644 --- a/libguile/vectors.h +++ b/libguile/vectors.h @@ -67,9 +67,9 @@ /* bit vectors */ -#define SCM_BITVEC_REF(a, i) ((SCM_VECTOR_BASE (a) [(i) / SCM_LONG_BIT] & (1L << ((i) % SCM_LONG_BIT))) ? 1 : 0) -#define SCM_BITVEC_SET(a, i) SCM_VECTOR_BASE (a) [(i) / SCM_LONG_BIT] |= (1L << ((i) % SCM_LONG_BIT)) -#define SCM_BITVEC_CLR(a, i) SCM_VECTOR_BASE (a) [(i) / SCM_LONG_BIT] &= ~(1L << ((i) % SCM_LONG_BIT)) +#define SCM_BITVEC_REF(a, i) ((SCM_BITVECTOR_BASE (a) [(i) / SCM_LONG_BIT] & (1L << ((i) % SCM_LONG_BIT))) ? 1 : 0) +#define SCM_BITVEC_SET(a, i) SCM_BITVECTOR_BASE (a) [(i) / SCM_LONG_BIT] |= (1L << ((i) % SCM_LONG_BIT)) +#define SCM_BITVEC_CLR(a, i) SCM_BITVECTOR_BASE (a) [(i) / SCM_LONG_BIT] &= ~(1L << ((i) % SCM_LONG_BIT))