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

* Added bytevector-s16-ref and bytevector-s16-native-ref.

This commit is contained in:
Abdulaziz Ghuloum 2007-09-10 14:24:35 -04:00
parent 3e4c7150f6
commit e273953b39
5 changed files with 56 additions and 10 deletions

BIN
src/ikarus.boot
View File

Binary file not shown.

56
src/ikarus.bytevectors.ss
View File

@ -5,6 +5,8 @@
bytevector-copy! u8-list->bytevector bytevector->u8-list bytevector-copy! u8-list->bytevector bytevector->u8-list
bytevector-u16-native-ref bytevector-u16-native-ref
bytevector-u16-ref bytevector-u16-ref
bytevector-s16-native-ref
bytevector-s16-ref
bytevector-fill! bytevector-copy bytevector=? bytevector-fill! bytevector-copy bytevector=?
bytevector-uint-ref bytevector-sint-ref bytevector-uint-ref bytevector-sint-ref
bytevector-uint-set! bytevector-sint-set! bytevector-uint-set! bytevector-sint-set!
@ -17,6 +19,8 @@
bytevector-copy! u8-list->bytevector bytevector->u8-list bytevector-copy! u8-list->bytevector bytevector->u8-list
bytevector-u16-native-ref bytevector-u16-native-ref
bytevector-u16-ref bytevector-u16-ref
bytevector-s16-native-ref
bytevector-s16-ref
bytevector-fill! bytevector-copy bytevector=? bytevector-fill! bytevector-copy bytevector=?
bytevector-uint-ref bytevector-sint-ref bytevector-uint-ref bytevector-sint-ref
bytevector-uint-set! bytevector-sint-set! bytevector-uint-set! bytevector-sint-set!
@ -104,29 +108,65 @@
($fx<= 0 i) ($fx<= 0 i)
($fx< i ($fxsub1 ($bytevector-length x))) ($fx< i ($fxsub1 ($bytevector-length x)))
($fxzero? ($fxlogand i 1))) ($fxzero? ($fxlogand i 1)))
($fx+ ($fxsll ($bytevector-u8-ref x i) 8) ($fxlogor
($bytevector-u8-ref x ($fxadd1 i))) ($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 "invalid index ~s" i))
(error 'bytevector-u16-native-ref "~s is not a bytevector" x)))) (error 'bytevector-u16-native-ref "~s is not a bytevector" x))))
(define bytevector-s16-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)))
($fxlogor
($fxsll ($bytevector-s8-ref x i) 8)
($bytevector-u8-ref x ($fxadd1 i)))
(error 'bytevector-s16-native-ref "invalid index ~s" i))
(error 'bytevector-s16-native-ref "~s is not a bytevector" x))))
(define bytevector-u16-ref (define bytevector-u16-ref
(lambda (x i end) (lambda (x i end)
(if (bytevector? x) (if (bytevector? x)
(if (and (fixnum? i) (if (and (fixnum? i)
($fx<= 0 i) ($fx<= 0 i)
($fx< i ($fxsub1 ($bytevector-length x))) ($fx< i ($fxsub1 ($bytevector-length x))))
($fxzero? ($fxlogand i 1)))
(case end (case end
[(big) [(big)
($fx+ ($fxsll ($bytevector-u8-ref x i) 8) ($fxlogor
($bytevector-u8-ref x ($fxadd1 i)))] ($fxsll ($bytevector-u8-ref x i) 8)
($bytevector-u8-ref x ($fxadd1 i)))]
[(little) [(little)
($fx+ ($fxsll ($bytevector-u8-ref x (fxadd1 i)) 8) ($fxlogor
($bytevector-u8-ref x i))] ($fxsll ($bytevector-u8-ref x (fxadd1 i)) 8)
($bytevector-u8-ref x i))]
[else (error 'bytevector-u16-ref "invalid endianness ~s" end)]) [else (error 'bytevector-u16-ref "invalid endianness ~s" end)])
(error 'bytevector-u16-ref "invalid index ~s" i)) (error 'bytevector-u16-ref "invalid index ~s" i))
(error 'bytevector-u16-ref "~s is not a bytevector" x)))) (error 'bytevector-u16-ref "~s is not a bytevector" x))))
(define bytevector-s16-ref
(lambda (x i end)
(if (bytevector? x)
(if (and (fixnum? i)
($fx<= 0 i)
($fx< i ($fxsub1 ($bytevector-length x))))
(case end
[(big)
($fxlogor
($fxsll ($bytevector-s8-ref x i) 8)
($bytevector-u8-ref x ($fxadd1 i)))]
[(little)
($fxlogor
($fxsll ($bytevector-s8-ref x (fxadd1 i)) 8)
($bytevector-u8-ref x i))]
[else (error 'bytevector-s16-ref "invalid endianness ~s" end)])
(error 'bytevector-s16-ref "invalid index ~s" i))
(error 'bytevector-s16-ref "~s is not a bytevector" x))))
(define bytevector->u8-list (define bytevector->u8-list
(lambda (x) (lambda (x)
(unless (bytevector? x) (unless (bytevector? x)

2
src/makefile.ss
View File

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

4
src/tests/bytevectors.ss
View File

@ -192,6 +192,10 @@
(bytevector-u16-ref '#vu8(255 253) 0 'little)] (bytevector-u16-ref '#vu8(255 253) 0 'little)]
[(lambda (x) (= x 65533)) [(lambda (x) (= x 65533))
(bytevector-u16-ref '#vu8(255 253) 0 'big)] (bytevector-u16-ref '#vu8(255 253) 0 'big)]
[(lambda (x) (= x -513))
(bytevector-s16-ref '#vu8(255 253) 0 'little)]
[(lambda (x) (= x -3))
(bytevector-s16-ref '#vu8(255 253) 0 'big)]
)) ))

4
src/todo-r6rs.ss
View File

@ -364,9 +364,9 @@
[bytevector-ieee-single-native-set! S bv] [bytevector-ieee-single-native-set! S bv]
[bytevector-ieee-single-ref S bv] [bytevector-ieee-single-ref S bv]
[bytevector-length C bv] [bytevector-length C bv]
[bytevector-s16-native-ref S bv] [bytevector-s16-native-ref C bv]
[bytevector-s16-native-set! S bv] [bytevector-s16-native-set! S bv]
[bytevector-s16-ref S bv] [bytevector-s16-ref C bv]
[bytevector-s16-set! S bv] [bytevector-s16-set! S bv]
[bytevector-s32-native-ref S bv] [bytevector-s32-native-ref S bv]
[bytevector-s32-native-set! S bv] [bytevector-s32-native-set! S bv]