basis/compiler/cfg/representations/conversion/conversion.factor

   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
   7
   8 ERROR: bad-conversion dst src dst-rep src-rep ;
   9
  10 GENERIC: rep>tagged ( dst src rep -- )
  11 GENERIC: tagged>rep ( dst src rep -- )
  12
  13 M: int-rep rep>tagged ( dst src rep -- )
  14     drop tag-bits get ##shl-imm, ;
  15
  16 M: int-rep tagged>rep ( dst src rep -- )
  17     drop tag-bits get ##sar-imm, ;
  18
  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 ;
  23
  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, ;
  28
  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, ;
  32
  33 M: double-rep tagged>rep
  34     drop float-offset double-rep f ##load-memory-imm, ;
  35
  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, ;
  42
  43 M: vector-rep tagged>rep
  44     [ byte-array-offset ] dip f ##load-memory-imm, ;
  45
  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 ;
  50
  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, ;
  55
  56 GENERIC: rep>int ( dst src rep -- )
  57 GENERIC: int>rep ( dst src rep -- )
  58
  59 M: scalar-rep rep>int ( dst src rep -- )
  60     ##scalar>integer, ;
  61
  62 M: scalar-rep int>rep ( dst src rep -- )
  63     ##integer>scalar, ;
  64
  65 : emit-conversion ( dst src dst-rep src-rep -- )
  66     {
  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 ] }
  72         [
  73             2dup 2array {
  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.
  78                 [
  79                     drop 2dup [ reg-class-of ] bi@ eq?
  80                     [ drop ##copy, ] [ bad-conversion ] if
  81                 ]
  82             } case
  83         ]
  84     } cond ;