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

* Added bytevector-u64-native-ref, bytevector-u64-native-set!, 

bytevector-s64-native-ref, bytevector-s64-native-set!,
        bytevector-u64-ref, bytevector-u64-set!,
        bytevector-s64-ref, and bytevector-s64-set!.
This commit is contained in:
Abdulaziz Ghuloum 2007-11-11 23:29:54 -05:00
parent 9c8bf4f5c7
commit 0bda5990ec
4 changed files with 127 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
scheme/ikarus.bytevectors.ss
View File

@ -20,13 +20,17 @@
bytevector-u8-ref bytevector-u8-set! bytevector-s8-set! bytevector-u8-ref bytevector-u8-set! bytevector-s8-set!
bytevector-copy! u8-list->bytevector bytevector->u8-list bytevector-copy! u8-list->bytevector bytevector->u8-list
bytevector-u16-native-ref bytevector-u16-native-set! 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-u32-native-ref bytevector-u32-native-set!
bytevector-s32-native-ref bytevector-s32-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-u16-ref bytevector-u16-set!
bytevector-s16-ref bytevector-s16-set!
bytevector-u32-ref bytevector-u32-set! bytevector-u32-ref bytevector-u32-set!
bytevector-s32-ref bytevector-s32-set! bytevector-s32-ref bytevector-s32-set!
bytevector-s16-native-ref bytevector-s16-native-set! bytevector-u64-ref bytevector-u64-set!
bytevector-s16-ref bytevector-s16-set! bytevector-s64-ref bytevector-s64-set!
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!
@ -43,13 +47,17 @@
bytevector-u8-ref bytevector-u8-set! bytevector-s8-set! bytevector-u8-ref bytevector-u8-set! bytevector-s8-set!
bytevector-copy! u8-list->bytevector bytevector->u8-list bytevector-copy! u8-list->bytevector bytevector->u8-list
bytevector-u16-native-ref bytevector-u16-native-set! 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-u32-native-ref bytevector-u32-native-set!
bytevector-s32-native-ref bytevector-s32-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-u16-ref bytevector-u16-set!
bytevector-s16-ref bytevector-s16-set!
bytevector-u32-ref bytevector-u32-set! bytevector-u32-ref bytevector-u32-set!
bytevector-s32-ref bytevector-s32-set! bytevector-s32-ref bytevector-s32-set!
bytevector-s16-native-ref bytevector-s16-native-set! bytevector-u64-ref bytevector-u64-set!
bytevector-s16-ref bytevector-s16-set! bytevector-s64-ref bytevector-s64-set!
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!
@ -1075,6 +1083,67 @@
(error 'bytevector-ieee-single-set! "invalid index" i)) (error 'bytevector-ieee-single-set! "invalid index" i))
(error 'bytevector-ieee-single-set! "not a bytevector" bv))) (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))
) )

16
scheme/makefile.ss
View File

@ -884,10 +884,10 @@
[bytevector-s32-native-set! i r bv] [bytevector-s32-native-set! i r bv]
[bytevector-s32-ref i r bv] [bytevector-s32-ref i r bv]
[bytevector-s32-set! i r bv] [bytevector-s32-set! i r bv]
[bytevector-s64-native-ref r bv] [bytevector-s64-native-ref i r bv]
[bytevector-s64-native-set! r bv] [bytevector-s64-native-set! i r bv]
[bytevector-s64-ref r bv] [bytevector-s64-ref i r bv]
[bytevector-s64-set! r bv] [bytevector-s64-set! i r bv]
[bytevector-s8-ref i r bv] [bytevector-s8-ref i r bv]
[bytevector-s8-set! i r bv] [bytevector-s8-set! i r bv]
[bytevector-sint-ref i r bv] [bytevector-sint-ref i r bv]
@ -900,10 +900,10 @@
[bytevector-u32-native-set! i r bv] [bytevector-u32-native-set! i r bv]
[bytevector-u32-ref i r bv] [bytevector-u32-ref i r bv]
[bytevector-u32-set! i r bv] [bytevector-u32-set! i r bv]
[bytevector-u64-native-ref r bv] [bytevector-u64-native-ref i r bv]
[bytevector-u64-native-set! r bv] [bytevector-u64-native-set! i r bv]
[bytevector-u64-ref r bv] [bytevector-u64-ref i r bv]
[bytevector-u64-set! r bv] [bytevector-u64-set! i r bv]
[bytevector-u8-ref i r bv] [bytevector-u8-ref i r bv]
[bytevector-u8-set! i r bv] [bytevector-u8-set! i r bv]
[bytevector-uint-ref i r bv] [bytevector-uint-ref i r bv]

38
scheme/tests/bytevectors.ss
View File

@ -336,6 +336,44 @@
(reverse (bytevector->u8-list v1)))]) (reverse (bytevector->u8-list v1)))])
(bytevector-ieee-single-ref v2 0 'little)))] (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))]
)) ))

16
scheme/todo-r6rs.ss
View File

@ -391,10 +391,10 @@
[bytevector-s32-native-set! C bv] [bytevector-s32-native-set! C bv]
[bytevector-s32-ref C bv] [bytevector-s32-ref C bv]
[bytevector-s32-set! C bv] [bytevector-s32-set! C bv]
[bytevector-s64-native-ref S bv] [bytevector-s64-native-ref C bv]
[bytevector-s64-native-set! S bv] [bytevector-s64-native-set! C bv]
[bytevector-s64-ref S bv] [bytevector-s64-ref C bv]
[bytevector-s64-set! S bv] [bytevector-s64-set! C bv]
[bytevector-s8-ref C bv] [bytevector-s8-ref C bv]
[bytevector-s8-set! C bv] [bytevector-s8-set! C bv]
[bytevector-sint-ref C bv] [bytevector-sint-ref C bv]
@ -407,10 +407,10 @@
[bytevector-u32-native-set! C bv] [bytevector-u32-native-set! C bv]
[bytevector-u32-ref C bv] [bytevector-u32-ref C bv]
[bytevector-u32-set! C bv] [bytevector-u32-set! C bv]
[bytevector-u64-native-ref S bv] [bytevector-u64-native-ref C bv]
[bytevector-u64-native-set! S bv] [bytevector-u64-native-set! C bv]
[bytevector-u64-ref S bv] [bytevector-u64-ref C bv]
[bytevector-u64-set! S bv] [bytevector-u64-set! C bv]
[bytevector-u8-ref C bv] [bytevector-u8-ref C bv]
[bytevector-u8-set! C bv] [bytevector-u8-set! C bv]
[bytevector-uint-ref C bv] [bytevector-uint-ref C bv]