* Added bytevector-ieee-double-ref and bytevector-ieee-double-set!
(which does not yet support big endianness)
This commit is contained in:
parent
bcd96a8dd4
commit
7dbce6e888
Binary file not shown.
|
@ -33,6 +33,7 @@
|
|||
bytevector->uint-list bytevector->sint-list
|
||||
uint-list->bytevector sint-list->bytevector
|
||||
bytevector-ieee-double-native-ref bytevector-ieee-double-native-set!
|
||||
bytevector-ieee-double-ref bytevector-ieee-double-set!
|
||||
native-endianness)
|
||||
(import
|
||||
(except (ikarus)
|
||||
|
@ -53,6 +54,7 @@
|
|||
bytevector->uint-list bytevector->sint-list
|
||||
uint-list->bytevector sint-list->bytevector
|
||||
bytevector-ieee-double-native-ref bytevector-ieee-double-native-set!
|
||||
bytevector-ieee-double-ref bytevector-ieee-double-set!
|
||||
native-endianness)
|
||||
(ikarus system $fx)
|
||||
(ikarus system $bignums)
|
||||
|
@ -991,10 +993,39 @@
|
|||
($fx< i ($bytevector-length bv)))
|
||||
(if (flonum? x)
|
||||
($bytevector-ieee-double-native-set! bv i x)
|
||||
(error 'bytevector-ieee-double-native-ref "not a flonum" x))
|
||||
(error 'bytevector-ieee-double-native-ref "invalid index" i))
|
||||
(error 'bytevector-ieee-double-native-ref "not a bytevector" bv)))
|
||||
|
||||
(error 'bytevector-ieee-double-native-set! "not a flonum" x))
|
||||
(error 'bytevector-ieee-double-native-set! "invalid index" i))
|
||||
(error 'bytevector-ieee-double-native-set! "not a bytevector" bv)))
|
||||
|
||||
(define (bytevector-ieee-double-ref bv i endianness)
|
||||
(if (bytevector? bv)
|
||||
(if (and (fixnum? i)
|
||||
($fx>= i 0)
|
||||
($fxzero? ($fxlogand i 3))
|
||||
($fx< i ($bytevector-length bv)))
|
||||
(case endianness
|
||||
[(little) ($bytevector-ieee-double-native-ref bv i)]
|
||||
[(big) ($bytevector-ieee-double-nonnative-ref bv i)]
|
||||
[else (error 'bytevector-ieee-double-ref
|
||||
"invalid endianness" endianness)])
|
||||
(error 'bytevector-ieee-double-ref "invalid index" i))
|
||||
(error 'bytevector-ieee-double-ref "not a bytevector" bv)))
|
||||
|
||||
(define (bytevector-ieee-double-set! bv i x endianness)
|
||||
(if (bytevector? bv)
|
||||
(if (and (fixnum? i)
|
||||
($fx>= i 0)
|
||||
($fxzero? ($fxlogand i 3))
|
||||
($fx< i ($bytevector-length bv)))
|
||||
(if (flonum? x)
|
||||
(case endianness
|
||||
[(little) ($bytevector-ieee-double-native-set! bv i x)]
|
||||
[(big) (error 'bytevector-ieee-double-set! "no big")]
|
||||
[else (error 'bytevector-ieee-double-set!
|
||||
"invalid endianness" endianness)])
|
||||
(error 'bytevector-ieee-double-set! "not a flonum" x))
|
||||
(error 'bytevector-ieee-double-set! "invalid index" i))
|
||||
(error 'bytevector-ieee-double-set! "not a bytevector" bv)))
|
||||
|
||||
)
|
||||
|
||||
|
|
|
@ -548,7 +548,7 @@
|
|||
(make-disp (car s*) (cadr s*))
|
||||
(caddr s*))))]
|
||||
[(fl:load fl:store fl:add! fl:sub! fl:mul! fl:div!
|
||||
fl:from-int)
|
||||
fl:from-int fl:shuffle)
|
||||
(S* rands
|
||||
(lambda (s*)
|
||||
(make-asm-instr op (car s*) (cadr s*))))]
|
||||
|
@ -1504,7 +1504,7 @@
|
|||
(mark-reg/vars-conf! edx vs)
|
||||
(R s vs (rem-reg edx rs) fs ns)]
|
||||
[(mset bset/c bset/h fl:load fl:store fl:add! fl:sub!
|
||||
fl:mul! fl:div! fl:from-int)
|
||||
fl:mul! fl:div! fl:from-int fl:shuffle)
|
||||
(R* (list s d) vs rs fs ns)]
|
||||
[else (error who "invalid effect op" (unparse x))])]
|
||||
[(ntcall target value args mask size)
|
||||
|
@ -1709,7 +1709,7 @@
|
|||
sll sra srl
|
||||
cltd idiv int-/overflow int+/overflow int*/overflow
|
||||
fl:load fl:store fl:add! fl:sub! fl:mul! fl:div!
|
||||
fl:from-int)
|
||||
fl:from-int fl:shuffle)
|
||||
(make-asm-instr op (R d) (R s))]
|
||||
[(nop) (make-primcall 'nop '())]
|
||||
[else (error who "invalid op" op)])]
|
||||
|
@ -1956,7 +1956,7 @@
|
|||
(set-union (set-union (R eax) (R edx))
|
||||
(set-union (R v) s)))]
|
||||
[(mset fl:load fl:store fl:add! fl:sub! fl:mul! fl:div!
|
||||
fl:from-int)
|
||||
fl:from-int fl:shuffle)
|
||||
(set-union (R v) (set-union (R d) s))]
|
||||
[else (error who "invalid effect" x)])]
|
||||
[(seq e0 e1) (E e0 (E e1 s))]
|
||||
|
@ -2288,7 +2288,7 @@
|
|||
(E (make-asm-instr 'move u a))
|
||||
(E (make-asm-instr op u b))))]
|
||||
[else x])]
|
||||
[(fl:from-int) x]
|
||||
[(fl:from-int fl:shuffle) x]
|
||||
[else (error who "invalid effect" op)])]
|
||||
[(primcall op rands)
|
||||
(case op
|
||||
|
@ -2572,6 +2572,8 @@
|
|||
(cons `(movsd ,(R (make-disp s d)) xmm0) ac)]
|
||||
[(fl:from-int)
|
||||
(cons `(cvtsi2sd ,(R s) xmm0) ac)]
|
||||
[(fl:shuffle)
|
||||
(cons `(pshufb ,(R (make-disp s d)) xmm0) ac)]
|
||||
[(fl:add!)
|
||||
(cons `(addsd ,(R (make-disp s d)) xmm0) ac)]
|
||||
[(fl:sub!)
|
||||
|
|
|
@ -529,6 +529,14 @@
|
|||
[(and (xmmreg? dst) (or (xmmreg? src) (mem? src)))
|
||||
(CODE #x66 (CODE #x0F ((CODE/digit #x2E dst) src ac)))]
|
||||
[else (error who "invalid" instr)])]
|
||||
[(pshufb src dst)
|
||||
(cond
|
||||
[(and (xmmreg? dst) (mem? src))
|
||||
(CODE #x66
|
||||
(CODE #x0F
|
||||
(CODE #x38
|
||||
((CODE/digit #x00 dst) src ac))))]
|
||||
[else (error who "invalid" instr)])]
|
||||
[(addl src dst)
|
||||
(cond
|
||||
[(and (imm8? src) (reg? dst))
|
||||
|
|
|
@ -409,6 +409,7 @@
|
|||
[$bytevector-u8-ref $bytes]
|
||||
[$bytevector-set! $bytes]
|
||||
[$bytevector-ieee-double-native-ref $bytes]
|
||||
[$bytevector-ieee-double-nonnative-ref $bytes]
|
||||
[$bytevector-ieee-double-native-set! $bytes]
|
||||
[$flonum-u8-ref $flonums]
|
||||
[$make-flonum $flonums]
|
||||
|
@ -864,7 +865,8 @@
|
|||
[bytevector-fill! i r bv]
|
||||
[bytevector-ieee-double-native-ref i r bv]
|
||||
[bytevector-ieee-double-native-set! i r bv]
|
||||
[bytevector-ieee-double-ref r bv]
|
||||
[bytevector-ieee-double-ref i r bv]
|
||||
[bytevector-ieee-double-set! i r bv]
|
||||
[bytevector-ieee-single-native-ref r bv]
|
||||
[bytevector-ieee-single-native-set! r bv]
|
||||
[bytevector-ieee-single-ref r bv]
|
||||
|
|
|
@ -1375,6 +1375,20 @@
|
|||
(prm 'fl:store x (K (- disp-flonum-data vector-tag)))
|
||||
x)])
|
||||
|
||||
(define-primop $bytevector-ieee-double-nonnative-ref unsafe
|
||||
[(V bv i)
|
||||
(with-tmp ([x (prm 'alloc (K (align flonum-size)) (K vector-tag))])
|
||||
(prm 'mset x (K (- vector-tag)) (K flonum-tag))
|
||||
(prm 'fl:load
|
||||
(prm 'int+ (T bv) (prm 'sra (T i) (K fixnum-shift)))
|
||||
(K (- disp-bytevector-data bytevector-tag)))
|
||||
(prm 'fl:shuffle
|
||||
(K (make-object '#vu8(7 6 2 3 4 5 1 0)))
|
||||
(K (- disp-bytevector-data bytevector-tag)))
|
||||
(prm 'fl:store x (K (- disp-flonum-data vector-tag)))
|
||||
x)])
|
||||
|
||||
|
||||
(define-primop $bytevector-ieee-double-native-set! unsafe
|
||||
[(E bv i x)
|
||||
(seq*
|
||||
|
|
|
@ -282,9 +282,17 @@
|
|||
(bytevector-ieee-double-native-set! v 0 17.0)
|
||||
(bytevector-ieee-double-native-ref v 0))]
|
||||
|
||||
|
||||
|
||||
|
||||
[(lambda (x) (= x 17.0))
|
||||
(let ([v (make-bytevector 8)])
|
||||
(bytevector-ieee-double-set! v 0 17.0 'little)
|
||||
(bytevector-ieee-double-ref v 0 'little))]
|
||||
|
||||
[(lambda (x) (= x 17.0))
|
||||
(let ([v1 (make-bytevector 8)])
|
||||
(bytevector-ieee-double-set! v1 0 17.0 'little)
|
||||
(let ([v2 (u8-list->bytevector
|
||||
(reverse (bytevector->u8-list v1)))])
|
||||
(bytevector-ieee-double-ref v2 0 'big)))]
|
||||
|
||||
))
|
||||
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
|
||||
.text
|
||||
addl $10, %esp
|
||||
addl $-10, %esp
|
||||
pshufb ($0x12345678), %xmm0
|
||||
ret
|
||||
|
|
Loading…
Reference in New Issue