* Fixed some bugs, some reported by Matthias Koeppe.

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.

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_print_symbol_name (SCM_SYMBOL_CHARS (symbol) + 1,
-			 SCM_SYMBOL_LENGTH (SCM_CDR (exp)) - 1,
+			 SCM_SYMBOL_LENGTH (symbol) - 1,
 			 port);
+  scm_remember_upto_here_1 (symbol);
   return 1;
 }
 

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;

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

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;
 }

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)

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_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_VECTOR_BASE (a) [(i) / SCM_LONG_BIT] |= (1L << ((i) % SCM_LONG_BIT))
+#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_VECTOR_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))