summaryrefslogtreecommitdiff
path: root/libguile
diff options
context:
space:
mode:
Diffstat (limited to 'libguile')
-rw-r--r--libguile/ChangeLog20
-rw-r--r--libguile/keywords.c7
-rw-r--r--libguile/objects.c5
-rw-r--r--libguile/pairs.c11
-rw-r--r--libguile/unif.c6
-rw-r--r--libguile/unif.h2
-rw-r--r--libguile/vectors.h6
7 files changed, 44 insertions, 13 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 557b9b808..5eb22ccd8 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,5 +1,25 @@
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.
* vectors.h (VECTORSH, SCM_VECTORS_H): Renamed <foo>H to
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))