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

* Added bytevector-u16-native-ref and bytevector-u16-ref

This commit is contained in:
Abdulaziz Ghuloum 2007-09-10 14:10:37 -04:00
parent 18b4a78045
commit 3e4c7150f6
5 changed files with 43 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

34
src/ikarus.bytevectors.ss
View File

@ -3,6 +3,8 @@
(export make-bytevector bytevector-length bytevector-s8-ref
bytevector-u8-ref bytevector-u8-set! bytevector-s8-set!
bytevector-copy! u8-list->bytevector bytevector->u8-list
bytevector-u16-native-ref
bytevector-u16-ref
bytevector-fill! bytevector-copy bytevector=?
bytevector-uint-ref bytevector-sint-ref
bytevector-uint-set! bytevector-sint-set!
@ -13,6 +15,8 @@
make-bytevector bytevector-length bytevector-s8-ref
bytevector-u8-ref bytevector-u8-set! bytevector-s8-set!
bytevector-copy! u8-list->bytevector bytevector->u8-list
bytevector-u16-native-ref
bytevector-u16-ref
bytevector-fill! bytevector-copy bytevector=?
bytevector-uint-ref bytevector-sint-ref
bytevector-uint-set! bytevector-sint-set!
@ -92,6 +96,36 @@
(error 'bytevector-u8-set! "~s is not an octet" v))
(error 'bytevector-u8-set! "invalid index ~s for ~s" i x))
(error 'bytevector-u8-set! "~s is not a bytevector" x))))
(define bytevector-u16-native-ref
(lambda (x i)
(if (bytevector? x)
(if (and (fixnum? i)
($fx<= 0 i)
($fx< i ($fxsub1 ($bytevector-length x)))
($fxzero? ($fxlogand i 1)))
($fx+ ($fxsll ($bytevector-u8-ref x i) 8)
($bytevector-u8-ref x ($fxadd1 i)))
(error 'bytevector-u16-native-ref "invalid index ~s" i))
(error 'bytevector-u16-native-ref "~s is not a bytevector" x))))
(define bytevector-u16-ref
(lambda (x i end)
(if (bytevector? x)
(if (and (fixnum? i)
($fx<= 0 i)
($fx< i ($fxsub1 ($bytevector-length x)))
($fxzero? ($fxlogand i 1)))
(case end
[(big)
($fx+ ($fxsll ($bytevector-u8-ref x i) 8)
($bytevector-u8-ref x ($fxadd1 i)))]
[(little)
($fx+ ($fxsll ($bytevector-u8-ref x (fxadd1 i)) 8)
($bytevector-u8-ref x i))]
[else (error 'bytevector-u16-ref "invalid endianness ~s" end)])
(error 'bytevector-u16-ref "invalid index ~s" i))
(error 'bytevector-u16-ref "~s is not a bytevector" x))))
(define bytevector->u8-list
(lambda (x)

2
src/makefile.ss
View File

@ -391,6 +391,8 @@
[bytevector-u8-ref i]
[bytevector-s8-set! i]
[bytevector-u8-set! i]
[bytevector-u16-ref i]
[bytevector-u16-native-ref i]
[bytevector->u8-list i]
[u8-list->bytevector i]
[bytevector-copy! i]

5
src/tests/bytevectors.ss
View File

@ -188,6 +188,11 @@
(bytevector-sint-set! b 0 (- (expt 2 32)) 'big 5)
(bytevector-sint-ref b 0 'big 5))]
[(lambda (x) (= x 65023))
(bytevector-u16-ref '#vu8(255 253) 0 'little)]
[(lambda (x) (= x 65533))
(bytevector-u16-ref '#vu8(255 253) 0 'big)]
))

4
src/todo-r6rs.ss
View File

@ -380,9 +380,9 @@
[bytevector-s8-set! C bv]
[bytevector-sint-ref C bv]
[bytevector-sint-set! C bv]
[bytevector-u16-native-ref S bv]
[bytevector-u16-native-ref C bv]
[bytevector-u16-native-set! S bv]
[bytevector-u16-ref S bv]
[bytevector-u16-ref C bv]
[bytevector-u16-set! S bv]
[bytevector-u32-native-ref S bv]
[bytevector-u32-native-set! S bv]