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

* Added bitwise-first-bit-set.

This commit is contained in:
Abdulaziz Ghuloum 2007-11-13 00:10:10 -05:00
parent 99d15d2705
commit 4b7f03df1a
3 changed files with 42 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
scheme/ikarus.numerics.ss
View File

@ -2858,6 +2858,45 @@
(error 'fldiv0-and-mod0 "not a flonum" m))
(error 'fldiv0-and-mod0 "not a flonum" n))))
(library (ikarus bitwise misc)
(export bitwise-first-bit-set)
(import
(ikarus system $fx)
(ikarus system $bignums)
(except (ikarus) bitwise-first-bit-set))
(module (bitwise-first-bit-set)
(define (byte-first-bit-set x i)
(case ($fxlogand x #b11)
[(0) (byte-first-bit-set ($fxsra x 2) ($fx+ i 2))]
[(2) ($fx+ i 1)]
[else i]))
(define (fx-first-bit-set x i)
(let ([y ($fxlogand x 255)])
(if ($fx= y 0)
(fx-first-bit-set ($fxsra x 8) ($fx+ i 8))
(byte-first-bit-set y i))))
(define (bn-first-bit-set x i idx)
(let ([b ($bignum-byte-ref x idx)])
(if ($fxzero? b)
(bn-first-bit-set x ($fx+ i 8) ($fx+ idx 1))
(byte-first-bit-set b i))))
(define (bitwise-first-bit-set x)
(cond
[(fixnum? x)
(if ($fx> x 0)
(fx-first-bit-set x 0)
(if ($fx= x 0)
-1
(if ($fx> x (least-fixnum))
(fx-first-bit-set ($fx- 0 x) 0)
(bn-first-bit-set (- x) 0 0))))]
[(bignum? x) (bn-first-bit-set x 0 0)]
[else (error 'bitwise-first-bit-set "not an exact integer" x)])))
)

2
scheme/makefile.ss
View File

@ -760,7 +760,7 @@
[bitwise-bit-set? r bw]
[bitwise-copy-bit r bw]
[bitwise-copy-bit-field r bw]
[bitwise-first-bit-set r bw]
[bitwise-first-bit-set i r bw]
[bitwise-if r bw]
[bitwise-length r bw]
[bitwise-reverse-bit-field r bw]

2
scheme/todo-r6rs.ss
View File

@ -263,7 +263,7 @@
[bitwise-bit-set? S bw]
[bitwise-copy-bit S bw]
[bitwise-copy-bit-field S bw]
[bitwise-first-bit-set S bw]
[bitwise-first-bit-set C bw]
[bitwise-if S bw]
[bitwise-length S bw]
[bitwise-reverse-bit-field S bw]