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

* Added bytevector-ieee-single-ref and bytevector-ieee-single-set!

This commit is contained in:
Abdulaziz Ghuloum 2007-11-08 22:56:14 -05:00
parent 5ce6ca4efb
commit 2a8cc2a7b4
5 changed files with 52 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
scheme/ikarus.boot.orig
View File

Binary file not shown.

4
scheme/ikarus.bytevectors.ss
View File

@ -1037,7 +1037,7 @@
($fx< i ($bytevector-length bv)))
(case endianness
[(little) ($bytevector-ieee-single-native-ref bv i)]
;[(big) ($bytevector-ieee-single-nonnative-ref bv i)]
[(big) ($bytevector-ieee-single-nonnative-ref bv i)]
[else (error 'bytevector-ieee-single-ref
"invalid endianness" endianness)])
(error 'bytevector-ieee-single-ref "invalid index" i))
@ -1068,7 +1068,7 @@
(if (flonum? x)
(case endianness
[(little) ($bytevector-ieee-single-native-set! bv i x)]
; [(big) ($bytevector-ieee-single-nonnative-set! bv i x)]
[(big) ($bytevector-ieee-single-nonnative-set! bv i x)]
[else (error 'bytevector-ieee-single-set!
"invalid endianness" endianness)])
(error 'bytevector-ieee-single-set! "not a flonum" x))

29
scheme/pass-specify-rep-primops.ss
View File

@ -1499,6 +1499,22 @@
(prm 'int+ (T bv) (prm 'sra (T i) (K fixnum-shift)))
(K (- disp-bytevector-data bytevector-tag))))])
(define-primop $bytevector-ieee-single-nonnative-ref unsafe
[(V bv i)
(let ([bvoff (- disp-bytevector-data bytevector-tag)]
[floff (- disp-flonum-data vector-tag)])
(with-tmp ([x (prm 'alloc (K (align flonum-size)) (K vector-tag))])
(prm 'mset x (K (- vector-tag)) (K flonum-tag))
(with-tmp ([t (prm 'int+ (T bv) (prm 'sra (T i) (K fixnum-shift)))])
(with-tmp ([x0 (prm 'mref t (K bvoff))])
(prm 'bswap! x0 x0)
(prm 'mset x (K floff) x0)))
(prm 'fl:load-single x (K floff))
(prm 'fl:single->double)
(prm 'fl:store x (K floff))
x))])
;;; the following uses unsupported sse3 instructions
;(define-primop $bytevector-ieee-double-nonnative-set! unsafe
; [(E bv i x)
@ -1524,6 +1540,19 @@
(prm 'bswap! x0 x0)
(prm 'mset t (K bvoff) x0))))])
(define-primop $bytevector-ieee-single-nonnative-set! unsafe
[(E bv i x)
(let ([bvoff (- disp-bytevector-data bytevector-tag)]
[floff (- disp-flonum-data vector-tag)])
(seq*
(prm 'fl:load (T x) (K floff))
(prm 'fl:double->single)
(with-tmp ([t (prm 'int+ (T bv)
(prm 'sra (T i) (K fixnum-shift)))])
(prm 'fl:store-single t (K bvoff))
(with-tmp ([x0 (prm 'mref t (K bvoff))])
(prm 'bswap! x0 x0)
(prm 'mset t (K bvoff) x0)))))])
/section)
(section ;;; strings

37
scheme/tests/bytevectors.ss
View File

@ -317,27 +317,24 @@
(bytevector-ieee-single-set! v 0 17.0 'little)
(bytevector-ieee-single-ref v 0 'little))]
; [(lambda (x) (= x 17.0))
; (let ([v (make-bytevector 8)])
; (bytevector-ieee-single-set! v 0 17.0 'big)
; (bytevector-ieee-single-ref v 0 'big))]
;
; [(lambda (x) (= x 17.0))
; (let ([v1 (make-bytevector 8)])
; (bytevector-ieee-single-set! v1 0 17.0 'little)
; (let ([v2 (u8-list->bytevector
; (reverse (bytevector->u8-list v1)))])
; (bytevector-ieee-single-ref v2 0 'big)))]
;
; [(lambda (x) (= x 17.0))
; (let ([v1 (make-bytevector 8)])
; (bytevector-ieee-single-set! v1 0 17.0 'big)
; (let ([v2 (u8-list->bytevector
; (reverse (bytevector->u8-list v1)))])
; (bytevector-ieee-single-ref v2 0 'little)))]
[(lambda (x) (= x 17.0))
(let ([v (make-bytevector 4)])
(bytevector-ieee-single-set! v 0 17.0 'big)
(bytevector-ieee-single-ref v 0 'big))]
[(lambda (x) (= x 17.0))
(let ([v1 (make-bytevector 4)])
(bytevector-ieee-single-set! v1 0 17.0 'little)
(let ([v2 (u8-list->bytevector
(reverse (bytevector->u8-list v1)))])
(bytevector-ieee-single-ref v2 0 'big)))]
[(lambda (x) (= x 17.0))
(let ([v1 (make-bytevector 4)])
(bytevector-ieee-single-set! v1 0 17.0 'big)
(let ([v2 (u8-list->bytevector
(reverse (bytevector->u8-list v1)))])
(bytevector-ieee-single-ref v2 0 'little)))]
))

8
scheme/todo-r6rs.ss
View File

@ -379,10 +379,10 @@
[bytevector-ieee-double-native-set! C bv]
[bytevector-ieee-double-ref C bv]
[bytevector-ieee-double-set! C bv]
[bytevector-ieee-single-native-ref S bv]
[bytevector-ieee-single-native-set! S bv]
[bytevector-ieee-single-ref S bv]
[bytevector-ieee-single-set! S bv]
[bytevector-ieee-single-native-ref C bv]
[bytevector-ieee-single-native-set! C bv]
[bytevector-ieee-single-ref C bv]
[bytevector-ieee-single-set! C bv]
[bytevector-length C bv]
[bytevector-s16-native-ref C bv]
[bytevector-s16-native-set! C bv]