* Added fxbit-field.

This commit is contained in:
Abdulaziz Ghuloum 2007-11-15 07:14:47 -05:00
parent ab6c871d76
commit 7def83f487
3 changed files with 26 additions and 4 deletions

View File

@ -2891,7 +2891,8 @@
fxlength
fxbit-set?
fxcopy-bit
fxcopy-bit-field)
fxcopy-bit-field
fxbit-field)
(import
(ikarus system $fx)
(ikarus system $bignums)
@ -2902,7 +2903,8 @@
fxlength
fxbit-set?
fxcopy-bit
fxcopy-bit-field))
fxcopy-bit-field
fxbit-field))
(module (bitwise-first-bit-set fxfirst-bit-set)
(define (byte-first-bit-set x i)
@ -3055,6 +3057,26 @@
(error who "not a fixnum" i))
(error who "not a fixnum" x)))
(define (fxbit-field x i j)
(define who 'fxbit-field)
(if (fixnum? x)
(if (fixnum? i)
(if ($fx<= 0 i)
(if (fixnum? j)
(if ($fx< j (fixnum-width))
(if ($fx<= i j)
($fxsra
($fxlogand x ($fxsub1 ($fxsll 1 j)))
i)
(if ($fx<= 0 j)
(error who "index out of range" j)
(error who "indices not in order" i j)))
(error who "index out of range" j))
(error who "not a fixnum" j))
(error who "index out of range" i))
(error who "not a fixnum" i))
(error who "not a fixnum" x)))
)

View File

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

View File

@ -289,7 +289,7 @@
[fxarithmetic-shift-left C fx]
[fxarithmetic-shift-right C fx]
[fxbit-count C fx]
[fxbit-field S fx]
[fxbit-field C fx]
[fxbit-set? C fx]
[fxcopy-bit C fx]
[fxcopy-bit-field C fx]