diff --git a/src/ikarus.boot b/src/ikarus.boot index 5dca912..51e848c 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 92177dd..373d036 100644 --- a/src/ikarus.bytevectors.ss +++ b/src/ikarus.bytevectors.ss @@ -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) diff --git a/src/makefile.ss b/src/makefile.ss index 0470f45..fd51ac5 100755 --- a/src/makefile.ss +++ b/src/makefile.ss @@ -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] diff --git a/src/tests/bytevectors.ss b/src/tests/bytevectors.ss index f94e4c2..21c06c4 100644 --- a/src/tests/bytevectors.ss +++ b/src/tests/bytevectors.ss @@ -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)] + )) diff --git a/src/todo-r6rs.ss b/src/todo-r6rs.ss index d20b48a..a985de3 100755 --- a/src/todo-r6rs.ss +++ b/src/todo-r6rs.ss @@ -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]