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

* Added bytevector-s16-native-set! and bytevector-s16-set!.

This commit is contained in:
Abdulaziz Ghuloum 2007-09-10 14:58:37 -04:00
parent 9d478bc6b4
commit 64b06d698b
5 changed files with 79 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

50
src/ikarus.bytevectors.ss
View File

@ -5,8 +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-set! bytevector-u16-native-ref bytevector-u16-native-set!
bytevector-u16-ref bytevector-u16-set! bytevector-u16-ref bytevector-u16-set!
bytevector-s16-native-ref bytevector-s16-native-ref bytevector-s16-native-set!
bytevector-s16-ref bytevector-s16-ref bytevector-s16-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!
@ -19,8 +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-set! bytevector-u16-native-ref bytevector-u16-native-set!
bytevector-u16-ref bytevector-u16-set! bytevector-u16-ref bytevector-u16-set!
bytevector-s16-native-ref bytevector-s16-native-ref bytevector-s16-native-set!
bytevector-s16-ref bytevector-s16-ref bytevector-s16-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!
@ -119,7 +119,7 @@
(if (bytevector? x) (if (bytevector? x)
(if (and (fixnum? n) (if (and (fixnum? n)
($fx<= 0 n) ($fx<= 0 n)
($fx<= n (expt 2 16))) ($fx<= n #xFFFF))
(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)))
@ -131,6 +131,24 @@
(error 'bytevector-u8-native-set! "invalid value ~s" n)) (error 'bytevector-u8-native-set! "invalid value ~s" n))
(error 'bytevector-u16-native-set! "~s is not a bytevector" x)))) (error 'bytevector-u16-native-set! "~s is not a bytevector" x))))
(define bytevector-s16-native-set!
(lambda (x i n)
(if (bytevector? x)
(if (and (fixnum? n)
($fx<= #x-8000 n)
($fx<= n #x7FFF))
(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-s16-native-set! "invalid index ~s" i))
(error 'bytevector-s16-native-set! "invalid value ~s" n))
(error 'bytevector-s16-native-set! "~s is not a bytevector" x))))
(define bytevector-s16-native-ref (define bytevector-s16-native-ref
(lambda (x i) (lambda (x i)
(if (bytevector? x) (if (bytevector? x)
@ -203,6 +221,28 @@
(error 'bytevector-s16-ref "invalid index ~s" i)) (error 'bytevector-s16-ref "invalid index ~s" i))
(error 'bytevector-s16-ref "~s is not a bytevector" x)))) (error 'bytevector-s16-ref "~s is not a bytevector" x))))
(define bytevector-s16-set!
(lambda (x i n end)
(if (bytevector? x)
(if (and (fixnum? n)
($fx<= #x-8000 n)
($fx<= n #x7FFF))
(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-s16-ref "invalid endianness ~s" end)])
(error 'bytevector-s16-set! "invalid index ~s" i))
(error 'bytevector-s16-set! "invalid value ~s" n))
(error 'bytevector-s16-set! "~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

@ -396,7 +396,9 @@
[bytevector-u16-native-ref i] [bytevector-u16-native-ref i]
[bytevector-u16-native-set! i] [bytevector-u16-native-set! i]
[bytevector-s16-ref i] [bytevector-s16-ref i]
[bytevector-s16-set! i]
[bytevector-s16-native-ref i] [bytevector-s16-native-ref i]
[bytevector-s16-native-set! i]
[bytevector->u8-list i] [bytevector->u8-list i]
[u8-list->bytevector i] [u8-list->bytevector i]
[bytevector-copy! i] [bytevector-copy! i]

29
src/tests/bytevectors.ss
View File

@ -210,6 +210,35 @@
(bytevector-u16-set! v 0 12345 'big) (bytevector-u16-set! v 0 12345 'big)
(bytevector-u16-ref v 0 'big))] (bytevector-u16-ref v 0 'big))]
[(lambda (x) (= x 12345))
(let ([v (make-bytevector 2)])
(bytevector-s16-native-set! v 0 12345)
(bytevector-s16-native-ref v 0))]
[(lambda (x) (= x 12345))
(let ([v (make-bytevector 2)])
(bytevector-s16-set! v 0 12345 'little)
(bytevector-s16-ref v 0 'little))]
[(lambda (x) (= x 12345))
(let ([v (make-bytevector 2)])
(bytevector-s16-set! v 0 12345 'big)
(bytevector-s16-ref v 0 'big))]
[(lambda (x) (= x -12345))
(let ([v (make-bytevector 2)])
(bytevector-s16-native-set! v 0 -12345)
(bytevector-s16-native-ref v 0))]
[(lambda (x) (= x -12345))
(let ([v (make-bytevector 2)])
(bytevector-s16-set! v 0 -12345 'little)
(bytevector-s16-ref v 0 'little))]
[(lambda (x) (= x -12345))
(let ([v (make-bytevector 2)])
(bytevector-s16-set! v 0 -12345 'big)
(bytevector-s16-ref v 0 'big))]
)) ))

6
src/todo-r6rs.ss
View File

@ -365,9 +365,9 @@
[bytevector-ieee-single-ref S bv] [bytevector-ieee-single-ref S bv]
[bytevector-length C bv] [bytevector-length C bv]
[bytevector-s16-native-ref C bv] [bytevector-s16-native-ref C bv]
[bytevector-s16-native-set! S bv] [bytevector-s16-native-set! C bv]
[bytevector-s16-ref C bv] [bytevector-s16-ref C bv]
[bytevector-s16-set! S bv] [bytevector-s16-set! C 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]
[bytevector-s32-ref S bv] [bytevector-s32-ref S bv]
@ -383,7 +383,7 @@
[bytevector-u16-native-ref C bv] [bytevector-u16-native-ref C bv]
[bytevector-u16-native-set! C bv] [bytevector-u16-native-set! C bv]
[bytevector-u16-ref C bv] [bytevector-u16-ref C bv]
[bytevector-u16-set! S bv] [bytevector-u16-set! C bv]
[bytevector-u32-native-ref S bv] [bytevector-u32-native-ref S bv]
[bytevector-u32-native-set! S bv] [bytevector-u32-native-set! S bv]
[bytevector-u32-ref S bv] [bytevector-u32-ref S bv]