diff --git a/scheme/ikarus.bytevectors.ss b/scheme/ikarus.bytevectors.ss index 11b11fd..0fdf8cf 100644 --- a/scheme/ikarus.bytevectors.ss +++ b/scheme/ikarus.bytevectors.ss @@ -20,13 +20,17 @@ bytevector-u8-ref bytevector-u8-set! bytevector-s8-set! bytevector-copy! u8-list->bytevector bytevector->u8-list bytevector-u16-native-ref bytevector-u16-native-set! + bytevector-s16-native-ref bytevector-s16-native-set! bytevector-u32-native-ref bytevector-u32-native-set! bytevector-s32-native-ref bytevector-s32-native-set! + bytevector-u64-native-ref bytevector-u64-native-set! + bytevector-s64-native-ref bytevector-s64-native-set! bytevector-u16-ref bytevector-u16-set! + bytevector-s16-ref bytevector-s16-set! bytevector-u32-ref bytevector-u32-set! bytevector-s32-ref bytevector-s32-set! - bytevector-s16-native-ref bytevector-s16-native-set! - bytevector-s16-ref bytevector-s16-set! + bytevector-u64-ref bytevector-u64-set! + bytevector-s64-ref bytevector-s64-set! bytevector-fill! bytevector-copy bytevector=? bytevector-uint-ref bytevector-sint-ref bytevector-uint-set! bytevector-sint-set! @@ -43,13 +47,17 @@ bytevector-u8-ref bytevector-u8-set! bytevector-s8-set! bytevector-copy! u8-list->bytevector bytevector->u8-list bytevector-u16-native-ref bytevector-u16-native-set! + bytevector-s16-native-ref bytevector-s16-native-set! bytevector-u32-native-ref bytevector-u32-native-set! bytevector-s32-native-ref bytevector-s32-native-set! + bytevector-u64-native-ref bytevector-u64-native-set! + bytevector-s64-native-ref bytevector-s64-native-set! bytevector-u16-ref bytevector-u16-set! + bytevector-s16-ref bytevector-s16-set! bytevector-u32-ref bytevector-u32-set! bytevector-s32-ref bytevector-s32-set! - bytevector-s16-native-ref bytevector-s16-native-set! - bytevector-s16-ref bytevector-s16-set! + bytevector-u64-ref bytevector-u64-set! + bytevector-s64-ref bytevector-s64-set! bytevector-fill! bytevector-copy bytevector=? bytevector-uint-ref bytevector-sint-ref bytevector-uint-set! bytevector-sint-set! @@ -1075,6 +1083,67 @@ (error 'bytevector-ieee-single-set! "invalid index" i)) (error 'bytevector-ieee-single-set! "not a bytevector" bv))) + + (define ($bytevector-ref/64 bv i who decoder endianness) + (if (bytevector? bv) + (if (and (fixnum? i) + ($fx>= i 0) + ($fxzero? ($fxlogand i 7)) + ($fx< i ($bytevector-length bv))) + (case endianness + [(little big) + (decoder bv i endianness 8)] + [else (error who "invalid endianness" endianness)]) + (error who "invalid index" i)) + (error who "not a bytevector" bv))) + + (define (bytevector-u64-native-ref bv i) + ($bytevector-ref/64 bv i 'bytevector-u64-native-ref + bytevector-uint-ref 'little)) + (define (bytevector-s64-native-ref bv i) + ($bytevector-ref/64 bv i 'bytevector-s64-native-ref + bytevector-sint-ref 'little)) + (define (bytevector-u64-ref bv i endianness) + ($bytevector-ref/64 bv i 'bytevector-u64-native-ref + bytevector-uint-ref endianness)) + (define (bytevector-s64-ref bv i endianness) + ($bytevector-ref/64 bv i 'bytevector-s64-native-ref + bytevector-sint-ref endianness)) + + (define ($bytevector-set/64 bv i n lo hi who setter endianness) + (if (bytevector? bv) + (if (and (fixnum? i) + ($fx>= i 0) + ($fxzero? ($fxlogand i 7)) + ($fx< i ($bytevector-length bv))) + (case endianness + [(little big) + (unless (or (fixnum? n) (bignum? n)) + (error who + (if (number? n) + "number is not exact" + "not a number") + n)) + (unless (and (<= lo n) (< n hi)) + (error who "number out of range" n)) + (setter bv i n endianness 8)] + [else (error who "invalid endianness" endianness)]) + (error who "invalid index" i)) + (error who "not a bytevector" bv))) + + (define (bytevector-u64-native-set! bv i n) + ($bytevector-set/64 bv i n 0 (expt 2 64) + 'bytevector-u64-native-ref bytevector-uint-set! 'little)) + (define (bytevector-s64-native-set! bv i n) + ($bytevector-set/64 bv i n (- (expt 2 63)) (expt 2 63) + 'bytevector-s64-native-ref bytevector-sint-set! 'little)) + (define (bytevector-u64-set! bv i n endianness) + ($bytevector-set/64 bv i n 0 (expt 2 64) + 'bytevector-u64-ref bytevector-uint-set! endianness)) + (define (bytevector-s64-set! bv i n endianness) + ($bytevector-set/64 bv i n (- (expt 2 63)) (expt 2 63) + 'bytevector-s64-ref bytevector-sint-set! endianness)) + ) diff --git a/scheme/makefile.ss b/scheme/makefile.ss index c91ec43..c06fea4 100755 --- a/scheme/makefile.ss +++ b/scheme/makefile.ss @@ -884,10 +884,10 @@ [bytevector-s32-native-set! i r bv] [bytevector-s32-ref i r bv] [bytevector-s32-set! i r bv] - [bytevector-s64-native-ref r bv] - [bytevector-s64-native-set! r bv] - [bytevector-s64-ref r bv] - [bytevector-s64-set! r bv] + [bytevector-s64-native-ref i r bv] + [bytevector-s64-native-set! i r bv] + [bytevector-s64-ref i r bv] + [bytevector-s64-set! i r bv] [bytevector-s8-ref i r bv] [bytevector-s8-set! i r bv] [bytevector-sint-ref i r bv] @@ -900,10 +900,10 @@ [bytevector-u32-native-set! i r bv] [bytevector-u32-ref i r bv] [bytevector-u32-set! i r bv] - [bytevector-u64-native-ref r bv] - [bytevector-u64-native-set! r bv] - [bytevector-u64-ref r bv] - [bytevector-u64-set! r bv] + [bytevector-u64-native-ref i r bv] + [bytevector-u64-native-set! i r bv] + [bytevector-u64-ref i r bv] + [bytevector-u64-set! i r bv] [bytevector-u8-ref i r bv] [bytevector-u8-set! i r bv] [bytevector-uint-ref i r bv] diff --git a/scheme/tests/bytevectors.ss b/scheme/tests/bytevectors.ss index 8bffb9b..0f10776 100644 --- a/scheme/tests/bytevectors.ss +++ b/scheme/tests/bytevectors.ss @@ -336,6 +336,44 @@ (reverse (bytevector->u8-list v1)))]) (bytevector-ieee-single-ref v2 0 'little)))] + [(lambda (x) (= x 18302628885633695743)) + (let ([bv (u8-list->bytevector + '(255 255 255 255 255 255 255 255 + 255 255 255 255 255 255 255 253))]) + (bytevector-u64-ref bv 8 (endianness little)))] + + [(lambda (x) (= x -144115188075855873)) + (let ([bv (u8-list->bytevector + '(255 255 255 255 255 255 255 255 + 255 255 255 255 255 255 255 253))]) + (bytevector-s64-ref bv 8 (endianness little)))] + + [(lambda (x) (= x 18446744073709551613)) + (let ([bv (u8-list->bytevector + '(255 255 255 255 255 255 255 255 + 255 255 255 255 255 255 255 253))]) + (bytevector-u64-ref bv 8 (endianness big)))] + + [(lambda (x) (= x -3)) + (let ([bv (u8-list->bytevector + '(255 255 255 255 255 255 255 255 + 255 255 255 255 255 255 255 253))]) + (bytevector-s64-ref bv 8 (endianness big)))] + + [(lambda (x) (= x 18302628885633695743)) + (let ([bv (u8-list->bytevector + '(255 255 255 255 255 255 255 255 + 255 255 255 255 255 255 255 253))]) + (bytevector-u64-native-ref bv 8))] + + [(lambda (x) (= x -144115188075855873)) + (let ([bv (u8-list->bytevector + '(255 255 255 255 255 255 255 255 + 255 255 255 255 255 255 255 253))]) + (bytevector-s64-native-ref bv 8))] + + + )) diff --git a/scheme/todo-r6rs.ss b/scheme/todo-r6rs.ss index 0bc5b48..2f28dff 100755 --- a/scheme/todo-r6rs.ss +++ b/scheme/todo-r6rs.ss @@ -391,10 +391,10 @@ [bytevector-s32-native-set! C bv] [bytevector-s32-ref C bv] [bytevector-s32-set! C bv] - [bytevector-s64-native-ref S bv] - [bytevector-s64-native-set! S bv] - [bytevector-s64-ref S bv] - [bytevector-s64-set! S bv] + [bytevector-s64-native-ref C bv] + [bytevector-s64-native-set! C bv] + [bytevector-s64-ref C bv] + [bytevector-s64-set! C bv] [bytevector-s8-ref C bv] [bytevector-s8-set! C bv] [bytevector-sint-ref C bv] @@ -407,10 +407,10 @@ [bytevector-u32-native-set! C bv] [bytevector-u32-ref C bv] [bytevector-u32-set! C bv] - [bytevector-u64-native-ref S bv] - [bytevector-u64-native-set! S bv] - [bytevector-u64-ref S bv] - [bytevector-u64-set! S bv] + [bytevector-u64-native-ref C bv] + [bytevector-u64-native-set! C bv] + [bytevector-u64-ref C bv] + [bytevector-u64-set! C bv] [bytevector-u8-ref C bv] [bytevector-u8-set! C bv] [bytevector-uint-ref C bv]