mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

* Fixed some bugs, some reported by Matthias Koeppe.

Browse source
This commit is contained in:
Dirk Herrmann 2001-06-08 10:02:33 +00:00
parent dcb410ec07
commit bab246f334
7 changed files with 44 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

20
libguile/ChangeLog
View file

@ -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.

7
libguile/keywords.c
View file

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

5
libguile/objects.c
View file

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

9
libguile/pairs.c
View file

@ -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));
if (!running)
{
running = 1;
scm_simple_format (scm_current_error_port (),
message, SCM_LIST1 (non_pair));
abort ();
}
}
#endif

6
libguile/unif.c
View file

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

2
libguile/unif.h
View file

@ -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)

6
libguile/vectors.h
View file

@ -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))