conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* Added fxbit-set?

This commit is contained in:
Abdulaziz Ghuloum 2007-11-15 06:40:50 -05:00
parent 42866c21c3
commit edb0abd366
3 changed files with 17 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
scheme/ikarus.numerics.ss
View File

@ -2888,7 +2888,8 @@
(library (ikarus bitwise misc)
(export fxfirst-bit-set bitwise-first-bit-set
fxbit-count bitwise-bit-count
fxlength)
fxlength
fxbit-set?)
(import
(ikarus system $fx)
(ikarus system $bignums)
@ -2896,7 +2897,8 @@
(except (ikarus)
fxfirst-bit-set bitwise-first-bit-set
fxbit-count bitwise-bit-count
fxlength))
fxlength
fxbit-set?))
(module (bitwise-first-bit-set fxfirst-bit-set)
(define (byte-first-bit-set x i)
@ -2988,7 +2990,6 @@
[(bignum? n) (bnbitcount n)]
[else (error 'bitwise-bit-count "not an exact integer" n)])))
(define (fxlength x)
(if (fixnum? x)
(let ([fl ($fixnum->flonum
@ -3001,6 +3002,16 @@
[else ($fx- sbe 1022)])))
(error 'fxlength "not a fixnum" x)))
(define (fxbit-set? x i)
(define who 'fxbit-set?)
(if (fixnum? x)
(if (fixnum? i)
(if (and ($fx<= 0 i) ($fx< i (fixnum-width)))
(not ($fxzero? ($fxlogand ($fxsra x i) 1)))
(error who "index out of range" i))
(error who "index is not a fixnum" i))
(error who "not a fixnum" x)))
)

2
scheme/makefile.ss
View File

@ -788,7 +788,7 @@
[fxarithmetic-shift-right i r fx]
[fxbit-count i r fx]
[fxbit-field r fx]
[fxbit-set? r fx]
[fxbit-set? i r fx]
[fxcopy-bit r fx]
[fxcopy-bit-field r fx]
[fxdiv i r fx]

4
scheme/todo-r6rs.ss
View File

@ -290,7 +290,7 @@
[fxarithmetic-shift-right C fx]
[fxbit-count C fx]
[fxbit-field S fx]
[fxbit-set? S fx]
[fxbit-set? C fx]
[fxcopy-bit S fx]
[fxcopy-bit-field S fx]
[fxdiv C fx]
@ -298,7 +298,7 @@
[fxdiv0 C fx]
[fxdiv0-and-mod0 C fx]
[fxeven? C fx]
[fxfirst-bit-set S fx]
[fxfirst-bit-set C fx]
[fxif C fx]
[fxior C fx]
[fxlength C fx]