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

scm_ash: Fixed typing problems with the second parameter and added some

Browse source 
documentation.  (Thanks Thien-Thi Nguyen for indicating the problem.)
This commit is contained in:
Dirk Herrmann 2000-03-20 04:02:56 +00:00
parent 78a4915a1e
commit 3ab9f56eaf
2 changed files with 45 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

6
libguile/ChangeLog
View file

@ -1,3 +1,9 @@
2000-03-20 Dirk Herrmann <D.Herrmann@tu-bs.de>
* numbers.c (scm_ash): Fixed typing problems with the second
parameter and added some documentation. (Thanks Thien-Thi Nguyen
for indicating the problem.)
2000-03-19 Mikael Djurfeldt <mdj@mdj.nada.kth.se> 2000-03-19 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* gc.c, gc.h (scm_gc_yield): New variable. * gc.c, gc.h (scm_gc_yield): New variable.

52
libguile/numbers.c
View file

@ -1053,8 +1053,14 @@ SCM_DEFINE (scm_integer_expt, "integer-expt", 2, 0, 0,
SCM_DEFINE (scm_ash, "ash", 2, 0, 0, SCM_DEFINE (scm_ash, "ash", 2, 0, 0,
(SCM n, SCM cnt), (SCM n, SCM cnt),
"Returns an integer equivalent to\n" "The function ash performs an arithmetic shift left by CNT bits\n"
"@code{(inexact->exact (floor (* @var{int} (expt 2 @var{count}))))}.@refill\n\n" "(or shift right, if CNT is negative). 'Arithmetic' means, that\n"
"the function does not guarantee to keep the bit structure of N,\n"
"but rather guarantees that the result will always be rounded\n"
"towards minus infinity. Therefore, the results of ash and a\n"
"corresponding bitwise shift will differ if N is negative.\n\n"
"Formally, the function returns an integer equivalent to\n"
"@code{(inexact->exact (floor (* N (expt 2 CNT))))}.@refill\n\n"
"Example:\n" "Example:\n"
"@lisp\n" "@lisp\n"
"(number->string (ash #b1 3) 2)\n" "(number->string (ash #b1 3) 2)\n"
@ -1064,30 +1070,40 @@ SCM_DEFINE (scm_ash, "ash", 2, 0, 0,
"@end lisp") "@end lisp")
#define FUNC_NAME s_scm_ash #define FUNC_NAME s_scm_ash
{ {
/* GJB:FIXME:: what is going on here? */ long bits_to_shift;
SCM res = SCM_PACK (SCM_INUM (n));
#ifndef SCM_BIGDIG
SCM_VALIDATE_INUM (1, n)
#endif
SCM_VALIDATE_INUM (2, cnt); SCM_VALIDATE_INUM (2, cnt);
bits_to_shift = SCM_INUM (cnt);
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (cnt < 0) if (bits_to_shift < 0) {
{ /* Shift right by abs(cnt) bits. This is realized as a division by
res = scm_integer_expt (SCM_MAKINUM (2), SCM_MAKINUM (-SCM_INUM (cnt))); div:=2^abs(cnt). However, to guarantee the floor rounding, negative
if (SCM_NFALSEP (scm_negative_p (n))) values require some special treatment.
*/
SCM div = scm_integer_expt (SCM_MAKINUM (2), SCM_MAKINUM (-bits_to_shift));
if (SCM_FALSEP (scm_negative_p (n)))
return scm_quotient (n, div);
else
return scm_sum (SCM_MAKINUM (-1L), return scm_sum (SCM_MAKINUM (-1L),
scm_quotient (scm_sum (SCM_MAKINUM (1L), n), res)); scm_quotient (scm_sum (SCM_MAKINUM (1L), n), div));
else } else
return scm_quotient (n, res); /* Shift left is done by multiplication with 2^CNT */
}
else
return scm_product (n, scm_integer_expt (SCM_MAKINUM (2), cnt)); return scm_product (n, scm_integer_expt (SCM_MAKINUM (2), cnt));
#else #else
SCM_VALIDATE_INUM (1,n) if (bits_to_shift < 0)
cnt = SCM_INUM (cnt); /* Signed right shift (SCM_SRS does it right) by abs(cnt) bits. */
if (cnt < 0) return SCM_MAKINUM (SCM_SRS (SCM_INUM (n), -bits_to_shift));
return SCM_MAKINUM (SCM_SRS (res, -cnt)); else {
res = SCM_MAKINUM (res << cnt); /* Shift left, but make sure not to leave the range of inums */
SCM res = SCM_MAKINUM (SCM_INUM (n) << cnt);
if (SCM_INUM (res) >> cnt != SCM_INUM (n)) if (SCM_INUM (res) >> cnt != SCM_INUM (n))
scm_num_overflow (FUNC_NAME); scm_num_overflow (FUNC_NAME);
return res; return res;
}
#endif #endif
} }
#undef FUNC_NAME #undef FUNC_NAME