1 ! Copyright (C) 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: arrays byte-arrays combinators compiler.cfg.instructions
4 compiler.cfg.registers compiler.constants cpu.architecture
5 kernel layouts locals math namespaces ;
6 IN: compiler.cfg.representations.conversion
8 ERROR: bad-conversion dst src dst-rep src-rep ;
10 GENERIC: rep>tagged ( dst src rep -- )
11 GENERIC: tagged>rep ( dst src rep -- )
13 M: int-rep rep>tagged ( dst src rep -- )
14 drop tag-bits get ##shl-imm, ;
16 M: int-rep tagged>rep ( dst src rep -- )
17 drop tag-bits get ##sar-imm, ;
19 M:: float-rep rep>tagged ( dst src rep -- )
20 double-rep next-vreg-rep :> temp
21 temp src ##single>double-float,
22 dst temp double-rep rep>tagged ;
24 M:: float-rep tagged>rep ( dst src rep -- )
25 double-rep next-vreg-rep :> temp
26 temp src double-rep tagged>rep
27 dst temp ##double>single-float, ;
29 M:: double-rep rep>tagged ( dst src rep -- )
30 dst 16 float int-rep next-vreg-rep ##allot,
31 src dst float-offset double-rep f ##store-memory-imm, ;
33 M: double-rep tagged>rep
34 drop float-offset double-rep f ##load-memory-imm, ;
36 M:: vector-rep rep>tagged ( dst src rep -- )
37 tagged-rep next-vreg-rep :> temp
38 dst 16 2 cells + byte-array int-rep next-vreg-rep ##allot,
39 temp 16 tag-fixnum ##load-tagged,
40 temp dst 1 byte-array type-number ##set-slot-imm,
41 src dst byte-array-offset rep f ##store-memory-imm, ;
43 M: vector-rep tagged>rep
44 [ byte-array-offset ] dip f ##load-memory-imm, ;
46 M:: scalar-rep rep>tagged ( dst src rep -- )
47 tagged-rep next-vreg-rep :> temp
48 temp src rep ##scalar>integer,
49 dst temp int-rep rep>tagged ;
51 M:: scalar-rep tagged>rep ( dst src rep -- )
52 tagged-rep next-vreg-rep :> temp
53 temp src int-rep tagged>rep
54 dst temp rep ##integer>scalar, ;
56 GENERIC: rep>int ( dst src rep -- )
57 GENERIC: int>rep ( dst src rep -- )
59 M: scalar-rep rep>int ( dst src rep -- )
62 M: scalar-rep int>rep ( dst src rep -- )
65 : emit-conversion ( dst src dst-rep src-rep -- )
67 { [ 2dup eq? ] [ drop ##copy, ] }
68 { [ dup tagged-rep? ] [ drop tagged>rep ] }
69 { [ over tagged-rep? ] [ nip rep>tagged ] }
70 { [ dup int-rep? ] [ drop int>rep ] }
71 { [ over int-rep? ] [ nip rep>int ] }
74 { { double-rep float-rep } [ 2drop ##single>double-float, ] }
75 { { float-rep double-rep } [ 2drop ##double>single-float, ] }
76 ! Punning SIMD vector types? Naughty naughty! But
77 ! it is allowed... otherwise bail out.
79 drop 2dup [ reg-class-of ] bi@ eq?
80 [ drop ##copy, ] [ throw-bad-conversion ] if