diff --git a/src/ikarus.boot b/src/ikarus.boot index 0e9fc6b..64de896 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.bytevectors.ss b/src/ikarus.bytevectors.ss index 58f0a62..464d682 100644 --- a/src/ikarus.bytevectors.ss +++ b/src/ikarus.bytevectors.ss @@ -3,8 +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-u16-native-ref bytevector-u16-native-set! + bytevector-u16-ref bytevector-u16-set! bytevector-s16-native-ref bytevector-s16-ref bytevector-fill! bytevector-copy bytevector=? @@ -17,8 +17,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-u16-native-ref bytevector-u16-native-set! + bytevector-u16-ref bytevector-u16-set! bytevector-s16-native-ref bytevector-s16-ref bytevector-fill! bytevector-copy bytevector=? @@ -114,6 +114,22 @@ (error 'bytevector-u16-native-ref "invalid index ~s" i)) (error 'bytevector-u16-native-ref "~s is not a bytevector" x)))) + (define bytevector-u16-native-set! + (lambda (x i n) + (if (bytevector? x) + (if (and (fixnum? n) + ($fx<= 0 n) + ($fx<= n (expt 2 16))) + (if (and (fixnum? i) + ($fx<= 0 i) + ($fx< i ($fxsub1 ($bytevector-length x))) + ($fxzero? ($fxlogand i 1))) + (begin + ($bytevector-set! x i ($fxsra n 8)) + ($bytevector-set! x ($fxadd1 i) n)) + (error 'bytevector-u16-native-set! "invalid index ~s" i)) + (error 'bytevector-u8-native-set! "invalid value ~s" n)) + (error 'bytevector-u16-native-set! "~s is not a bytevector" x)))) (define bytevector-s16-native-ref (lambda (x i) @@ -146,7 +162,27 @@ [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-u16-set! + (lambda (x i n end) + (if (bytevector? x) + (if (and (fixnum? n) + ($fx<= 0 n) + ($fx<= n #xFFFF)) + (if (and (fixnum? i) + ($fx<= 0 i) + ($fx< i ($fxsub1 ($bytevector-length x)))) + (case end + [(big) + ($bytevector-set! x i ($fxsra n 8)) + ($bytevector-set! x ($fxadd1 i) n)] + [(little) + ($bytevector-set! x i n) + ($bytevector-set! x ($fxadd1 i) (fxsra n 8))] + [else (error 'bytevector-u16-ref "invalid endianness ~s" end)]) + (error 'bytevector-u16-set! "invalid index ~s" i)) + (error 'bytevector-u16-set! "invalid value ~s" n)) + (error 'bytevector-u16-set! "~s is not a bytevector" x)))) (define bytevector-s16-ref (lambda (x i end) diff --git a/src/makefile.ss b/src/makefile.ss index 42309e5..5c31d31 100755 --- a/src/makefile.ss +++ b/src/makefile.ss @@ -391,10 +391,12 @@ [bytevector-u8-ref i] [bytevector-s8-set! i] [bytevector-u8-set! i] - [bytevector-u16-ref i] - [bytevector-u16-native-ref i] - [bytevector-s16-ref i] - [bytevector-s16-native-ref i] + [bytevector-u16-ref i] + [bytevector-u16-set! i] + [bytevector-u16-native-ref i] + [bytevector-u16-native-set! i] + [bytevector-s16-ref i] + [bytevector-s16-native-ref i] [bytevector->u8-list i] [u8-list->bytevector i] [bytevector-copy! i] diff --git a/src/tests/bytevectors.ss b/src/tests/bytevectors.ss index a64a082..8bab11c 100644 --- a/src/tests/bytevectors.ss +++ b/src/tests/bytevectors.ss @@ -197,6 +197,19 @@ [(lambda (x) (= x -3)) (bytevector-s16-ref '#vu8(255 253) 0 'big)] + [(lambda (x) (= x 12345)) + (let ([v (make-bytevector 2)]) + (bytevector-u16-native-set! v 0 12345) + (bytevector-u16-native-ref v 0))] + [(lambda (x) (= x 12345)) + (let ([v (make-bytevector 2)]) + (bytevector-u16-set! v 0 12345 'little) + (bytevector-u16-ref v 0 'little))] + [(lambda (x) (= x 12345)) + (let ([v (make-bytevector 2)]) + (bytevector-u16-set! v 0 12345 'big) + (bytevector-u16-ref v 0 'big))] + )) diff --git a/src/todo-r6rs.ss b/src/todo-r6rs.ss index fcb4af1..c68af99 100755 --- a/src/todo-r6rs.ss +++ b/src/todo-r6rs.ss @@ -381,7 +381,7 @@ [bytevector-sint-ref C bv] [bytevector-sint-set! C bv] [bytevector-u16-native-ref C bv] - [bytevector-u16-native-set! S bv] + [bytevector-u16-native-set! C bv] [bytevector-u16-ref C bv] [bytevector-u16-set! S bv] [bytevector-u32-native-ref S bv]