* Fixed some bugs, some reported by Matthias Koeppe.

diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 557b9b8..5eb22cc 100644 (file)
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,23 @@
+2001-06-08  Dirk Herrmann  <D.Herrmann@tu-bs.de>
+
+       * 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  <D.Herrmann@tu-bs.de>
 
        * goops.c (SCM_CLASS_REDEF):  Removed.

diff --git a/libguile/keywords.c b/libguile/keywords.c
index cea7ac5..36e0ce2 100644 (file)
--- 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 4cec90b..a8ece94 100644 (file)
--- 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 48db366..24d1aec 100644 (file)
--- 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 5e0a801..e1f1bd0 100644 (file)
--- 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 1a7b1b4..867c044 100644 (file)
--- 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 0f14568..7a788f0 100644 (file)
--- 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))
 
 
 \f