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

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

(which does not yet support big endianness)
This commit is contained in:
Abdulaziz Ghuloum 2007-11-07 01:26:38 -05:00
parent bcd96a8dd4
commit 7dbce6e888
8 changed files with 80 additions and 15 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.

39
scheme/ikarus.bytevectors.ss
View File

@ -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)))
)

12
scheme/ikarus.compiler.altcogen.ss
View File

@ -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!)

8
scheme/ikarus.intel-assembler.ss
View File

@ -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))

4
scheme/makefile.ss
View File

@ -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]

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

@ -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*

14
scheme/tests/bytevectors.ss
View File

@ -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)))]
))

4
src/geninstr/t.s
View File

@ -1,4 +1,4 @@
.text
addl $10, %esp
addl $-10, %esp
pshufb ($0x12345678), %xmm0
ret