76 lines
2.4 KiB
Factor
76 lines
2.4 KiB
Factor
|
! Copyright (C) 2010 Slava Pestov.
|
||
|
|
! See http://factorcode.org/license.txt for BSD license.
|
||
|
|
USING: arrays byte-arrays combinators compiler.cfg.instructions
|
||
|
|
compiler.cfg.registers compiler.constants cpu.architecture
|
||
|
|
kernel layouts locals math namespaces ;
|
||
|
|
IN: compiler.cfg.representations.conversion
|
||
|
|
|
||
|
|
ERROR: bad-conversion dst src dst-rep src-rep ;
|
||
|
|
|
||
|
|
GENERIC: emit-box ( dst src rep -- )
|
||
|
|
GENERIC: emit-unbox ( dst src rep -- )
|
||
|
|
|
||
|
|
M: int-rep emit-box ( dst src rep -- )
|
||
|
|
drop tag-bits get ##shl-imm ;
|
||
|
|
|
||
|
|
M: int-rep emit-unbox ( dst src rep -- )
|
||
|
|
drop tag-bits get ##sar-imm ;
|
||
|
|
|
||
|
|
M:: float-rep emit-box ( dst src rep -- )
|
||
|
|
double-rep next-vreg-rep :> temp
|
||
|
|
temp src ##single>double-float
|
||
|
|
dst temp double-rep emit-box ;
|
||
|
|
|
||
|
|
M:: float-rep emit-unbox ( dst src rep -- )
|
||
|
|
double-rep next-vreg-rep :> temp
|
||
|
|
temp src double-rep emit-unbox
|
||
|
|
dst temp ##double>single-float ;
|
||
|
|
|
||
|
|
M: double-rep emit-box
|
||
|
|
drop
|
||
|
|
[ drop 16 float tagged-rep next-vreg-rep ##allot ]
|
||
|
|
[ float-offset swap ##set-alien-double ]
|
||
|
|
2bi ;
|
||
|
|
|
||
|
|
M: double-rep emit-unbox
|
||
|
|
drop float-offset ##alien-double ;
|
||
|
|
|
||
|
|
M:: vector-rep emit-box ( dst src rep -- )
|
||
|
|
tagged-rep next-vreg-rep :> temp
|
||
|
|
dst 16 2 cells + byte-array tagged-rep next-vreg-rep ##allot
|
||
|
|
temp 16 tag-fixnum ##load-immediate
|
||
|
|
temp dst 1 byte-array type-number ##set-slot-imm
|
||
|
|
dst byte-array-offset src rep ##set-alien-vector ;
|
||
|
|
|
||
|
|
M: vector-rep emit-unbox
|
||
|
|
[ byte-array-offset ] dip ##alien-vector ;
|
||
|
|
|
||
|
|
M:: scalar-rep emit-box ( dst src rep -- )
|
||
|
|
tagged-rep next-vreg-rep :> temp
|
||
|
|
temp src rep ##scalar>integer
|
||
|
|
dst temp int-rep emit-box ;
|
||
|
|
|
||
|
|
M:: scalar-rep emit-unbox ( dst src rep -- )
|
||
|
|
tagged-rep next-vreg-rep :> temp
|
||
|
|
temp src int-rep emit-unbox
|
||
|
|
dst temp rep ##integer>scalar ;
|
||
|
|
|
||
|
|
: emit-conversion ( dst src dst-rep src-rep -- )
|
||
|
|
{
|
||
|
|
{ [ 2dup eq? ] [ drop ##copy ] }
|
||
|
|
{ [ dup tagged-rep eq? ] [ drop emit-unbox ] }
|
||
|
|
{ [ over tagged-rep eq? ] [ nip emit-box ] }
|
||
|
|
[
|
||
|
|
2dup 2array {
|
||
|
|
{ { double-rep float-rep } [ 2drop ##single>double-float ] }
|
||
|
|
{ { float-rep double-rep } [ 2drop ##double>single-float ] }
|
||
|
|
! Punning SIMD vector types? Naughty naughty! But
|
||
|
|
! it is allowed... otherwise bail out.
|
||
|
|
[
|
||
|
|
drop 2dup [ reg-class-of ] bi@ eq?
|
||
|
|
[ drop ##copy ] [ bad-conversion ] if
|
||
|
|
]
|
||
|
|
} case
|
||
|
|
]
|
||
|
|
} cond ;
|