mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-19 18:20:22 +02:00
Code Activity

* Reordered some dispatch sequences.

Browse source 
* scm_bit_extract:  Fixed handling of bignums.
This commit is contained in:
Dirk Herrmann 2000-05-15 17:03:59 +00:00
parent f5f2dcffbe
commit 78166ad555
2 changed files with 46 additions and 31 deletions
Download patch file Download diff file Expand all files Collapse all files

7
libguile/ChangeLog
View file

@ -1,3 +1,10 @@
2000-05-15 Dirk Herrmann <D.Herrmann@tu-bs.de>
* numbers.c (scm_logbit_p, scm_bit_extract): Reordered dispatch
sequence.
(scm_bit_extract): Fixed handling of bignums.
2000-05-15 Dirk Herrmann <D.Herrmann@tu-bs.de>
* async.c (scm_sys_gc_async_thunk), chars.h (SCM_ICHRP, SCM_ICHR,

70
libguile/numbers.c
View file

@ -1030,34 +1030,42 @@ SCM_DEFINE (scm_logbit_p, "logbit?", 2, 0, 0,
"@end example")
#define FUNC_NAME s_scm_logbit_p
{
SCM_ASSERT(SCM_INUMP(index) && SCM_INUM(index) >= 0, index, SCM_ARG1, FUNC_NAME);
#ifdef SCM_BIGDIG
if SCM_NINUMP(j) {
SCM_ASSERT(SCM_BIGP (j), j, SCM_ARG2, FUNC_NAME);
if (SCM_NUMDIGS(j) * SCM_BITSPERDIG < SCM_INUM(index)) return SCM_BOOL_F;
else if SCM_BIGSIGN(j) {
unsigned long int iindex;
SCM_VALIDATE_INUM_MIN (SCM_ARG1, index, 0);
iindex = (unsigned long int) SCM_INUM (index);
if (SCM_INUMP (j)) {
return SCM_BOOL ((1L << iindex) & SCM_INUM (j));
} else if (SCM_BIGP (j)) {
if (SCM_NUMDIGS (j) * SCM_BITSPERDIG < iindex) {
return SCM_BOOL_F;
} else if (SCM_BIGSIGN (j)) {
long num = -1;
scm_sizet i = 0;
SCM_BIGDIG *x = SCM_BDIGITS(j);
scm_sizet nx = SCM_INUM(index)/SCM_BITSPERDIG;
while (!0) {
SCM_BIGDIG * x = SCM_BDIGITS (j);
scm_sizet nx = iindex / SCM_BITSPERDIG;
while (1) {
num += x[i];
if (nx==i++)
return ((1L << (SCM_INUM(index)%SCM_BITSPERDIG)) & num) ? SCM_BOOL_F : SCM_BOOL_T;
if (num < 0) num = -1;
else num = 0;
if (nx == i++) {
return SCM_BOOL (((1L << (iindex % SCM_BITSPERDIG)) & num) == 0);
} else if (num < 0) {
num = -1;
} else {
num = 0;
}
}
} else {
return SCM_BOOL (SCM_BDIGITS (j) [iindex / SCM_BITSPERDIG]
& (1L << (iindex % SCM_BITSPERDIG)));
}
else return (SCM_BDIGITS(j)[SCM_INUM(index)/SCM_BITSPERDIG] &
(1L << (SCM_INUM(index)%SCM_BITSPERDIG))) ? SCM_BOOL_T : SCM_BOOL_F;
} else {
SCM_WRONG_TYPE_ARG (SCM_ARG2, j);
}
#else
SCM_ASSERT(SCM_INUMP(j), j, SCM_ARG2, FUNC_NAME);
#endif
return ((1L << SCM_INUM(index)) & SCM_INUM(j)) ? SCM_BOOL_T : SCM_BOOL_F;
}
#undef FUNC_NAME
SCM_DEFINE (scm_lognot, "lognot", 1, 0, 0,
(SCM n),
"Returns the integer which is the 2s-complement of the integer argument.\n\n"
@ -1188,21 +1196,21 @@ SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0,
#define FUNC_NAME s_scm_bit_extract
{
int istart, iend;
SCM_VALIDATE_INUM (1,n);
SCM_VALIDATE_INUM_MIN_COPY (2,start,0,istart);
SCM_VALIDATE_INUM_MIN_COPY (3, end, 0, iend);
SCM_ASSERT_RANGE (3, end, (iend >= istart));
#ifdef SCM_BIGDIG
if (SCM_NINUMP (n))
return
scm_logand (scm_difference (scm_integer_expt (SCM_MAKINUM (2),
SCM_MAKINUM (iend - istart)),
SCM_MAKINUM (1L)),
scm_ash (n, SCM_MAKINUM (-istart)));
#else
SCM_VALIDATE_INUM (1,n);
#endif
return SCM_MAKINUM ((SCM_INUM (n) >> istart) & ((1L << (iend - istart)) - 1));
if (SCM_INUMP (n)) {
return SCM_MAKINUM ((SCM_INUM (n) >> istart) & ((1L << (iend - istart)) - 1));
} else if (SCM_BIGP (n)) {
SCM num1 = SCM_MAKINUM (1L);
SCM num2 = SCM_MAKINUM (2L);
SCM bits = SCM_MAKINUM (iend - istart);
SCM mask = scm_difference (scm_integer_expt (num2, bits), num1);
return scm_logand (mask, scm_ash (n, SCM_MAKINUM (-istart)));
} else {
SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
}
}
#undef FUNC_NAME