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

* Added fxcopy-bit-field.

This commit is contained in:
Abdulaziz Ghuloum 2007-11-15 07:03:04 -05:00
parent d977720ae6
commit ab6c871d76
3 changed files with 33 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
scheme/ikarus.numerics.ss
View File

@ -2890,7 +2890,8 @@
fxbit-count bitwise-bit-count
fxlength
fxbit-set?
fxcopy-bit)
fxcopy-bit
fxcopy-bit-field)
(import
(ikarus system $fx)
(ikarus system $bignums)
@ -2900,7 +2901,8 @@
fxbit-count bitwise-bit-count
fxlength
fxbit-set?
fxcopy-bit))
fxcopy-bit
fxcopy-bit-field))
(module (bitwise-first-bit-set fxfirst-bit-set)
(define (byte-first-bit-set x i)
@ -3026,6 +3028,33 @@
(error who "index out of range" i))
(error who "index is not a fixnum" i))
(error who "not a fixnum" x)))
(define (fxcopy-bit-field x i j b)
(define who 'fxcopy-bit-field)
(if (fixnum? x)
(if (fixnum? i)
(if ($fx<= 0 i)
(if (fixnum? j)
(if ($fx< j (fixnum-width))
(if ($fx<= i j)
(if (fixnum? b)
(let ([m
($fxlogxor
($fxsub1 ($fxsll 1 i))
($fxsub1 ($fxsll 1 j)))])
($fxlogor
($fxlogand m b)
($fxlogand ($fxlognot m) x)))
(error who "not a fixnum" b))
(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

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

2
scheme/todo-r6rs.ss
View File

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