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

* 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
scheme/ikarus.numerics.ss
View File

@ -2891,7 +2891,8 @@
fxlength fxlength
fxbit-set? fxbit-set?
fxcopy-bit fxcopy-bit
fxcopy-bit-field) fxcopy-bit-field
fxbit-field)
(import (import
(ikarus system $fx) (ikarus system $fx)
(ikarus system $bignums) (ikarus system $bignums)
@ -2902,7 +2903,8 @@
fxlength fxlength
fxbit-set? fxbit-set?
fxcopy-bit fxcopy-bit
fxcopy-bit-field)) fxcopy-bit-field
fxbit-field))
(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)
@ -3055,6 +3057,26 @@
(error who "not a fixnum" i)) (error who "not a fixnum" i))
(error who "not a fixnum" x))) (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)))
) )

2
scheme/makefile.ss
View File

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

2
scheme/todo-r6rs.ss
View File

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