* Added fxbit-field.
This commit is contained in:
parent
ab6c871d76
commit
7def83f487
|
@ -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)))
|
||||
|
||||
)
|
||||
|
||||
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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]
|
||||
|
|
Loading…
Reference in New Issue