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

* Added fxcopy-bit.

This commit is contained in:
Abdulaziz Ghuloum 2007-11-15 06:47:51 -05:00
parent edb0abd366
commit d977720ae6
3 changed files with 18 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
scheme/ikarus.numerics.ss
View File

@ -2889,7 +2889,8 @@
(export fxfirst-bit-set bitwise-first-bit-set (export fxfirst-bit-set bitwise-first-bit-set
fxbit-count bitwise-bit-count fxbit-count bitwise-bit-count
fxlength fxlength
fxbit-set?) fxbit-set?
fxcopy-bit)
(import (import
(ikarus system $fx) (ikarus system $fx)
(ikarus system $bignums) (ikarus system $bignums)
@ -2898,7 +2899,8 @@
fxfirst-bit-set bitwise-first-bit-set fxfirst-bit-set bitwise-first-bit-set
fxbit-count bitwise-bit-count fxbit-count bitwise-bit-count
fxlength fxlength
fxbit-set?)) fxbit-set?
fxcopy-bit))
(module (bitwise-first-bit-set fxfirst-bit-set) (module (bitwise-first-bit-set fxfirst-bit-set)
(define (byte-first-bit-set x i) (define (byte-first-bit-set x i)
@ -3012,6 +3014,18 @@
(error who "index is not a fixnum" i)) (error who "index is not a fixnum" i))
(error who "not a fixnum" x))) (error who "not a fixnum" x)))
(define (fxcopy-bit x i b)
(define who 'fxcopy-bit)
(if (fixnum? x)
(if (fixnum? i)
(if (and ($fx<= 0 i) ($fx< i (fixnum-width)))
(case b
[(0) ($fxlogand x ($fxlognot ($fxsll 1 i)))]
[(1) ($fxlogor x ($fxsll 1 i))]
[else (error who "invalid bit value" b)])
(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

@ -789,7 +789,7 @@
[fxbit-count i r fx] [fxbit-count i r fx]
[fxbit-field r fx] [fxbit-field r fx]
[fxbit-set? i r fx] [fxbit-set? i r fx]
[fxcopy-bit r fx] [fxcopy-bit i r fx]
[fxcopy-bit-field r fx] [fxcopy-bit-field r fx]
[fxdiv i r fx] [fxdiv i r fx]
[fxdiv-and-mod i r fx] [fxdiv-and-mod i r fx]

2
scheme/todo-r6rs.ss
View File

@ -291,7 +291,7 @@
[fxbit-count C fx] [fxbit-count C fx]
[fxbit-field S fx] [fxbit-field S fx]
[fxbit-set? C fx] [fxbit-set? C fx]
[fxcopy-bit S fx] [fxcopy-bit C fx]
[fxcopy-bit-field S fx] [fxcopy-bit-field S fx]
[fxdiv C fx] [fxdiv C fx]
[fxdiv-and-mod C fx] [fxdiv-and-mod C fx]