basis/compiler/tests/low-level-ir.factor

   1 USING: accessors assocs compiler compiler.cfg
   2 compiler.cfg.debugger compiler.cfg.instructions compiler.cfg.mr
   3 compiler.cfg.registers compiler.codegen compiler.units
   4 cpu.architecture hashtables kernel namespaces sequences
   5 tools.test vectors words layouts literals math arrays
   6 alien.syntax math.private ;
   7 IN: compiler.tests.low-level-ir
   8
   9 : compile-cfg ( cfg -- word )
  10     gensym
  11     [ build-mr generate code>> ] dip
  12     [ associate >alist modify-code-heap ] keep ;
  13
  14 : compile-test-cfg ( -- word )
  15     cfg new 0 get >>entry
  16     dup cfg set
  17     dup fake-representations representations get >>reps
  18     compile-cfg ;
  19
  20 : compile-test-bb ( insns -- result )
  21     V{ T{ ##prologue } T{ ##branch } } [ clone ] map 0 test-bb
  22     V{
  23         T{ ##inc-d f 1 }
  24         T{ ##replace f 0 D 0 }
  25         T{ ##branch }
  26     } [ clone ] map append 1 test-bb
  27     V{
  28         T{ ##epilogue }
  29         T{ ##return }
  30     } [ clone ] map 2 test-bb
  31     0 1 edge
  32     1 2 edge
  33     compile-test-cfg
  34     execute( -- result ) ;
  35
  36 ! loading immediates
  37 [ f ] [
  38     V{
  39         T{ ##load-immediate f 0 5 }
  40     } compile-test-bb
  41 ] unit-test
  42
  43 [ "hello" ] [
  44     V{
  45         T{ ##load-reference f 0 "hello" }
  46     } compile-test-bb
  47 ] unit-test
  48
  49 ! ##copy on floats. We can only run this test if float intrinsics
  50 ! are enabled.
  51 \ float+ "intrinsic" word-prop [
  52     [ 1.5 ] [
  53         V{
  54             T{ ##load-reference f 4 1.5 }
  55             T{ ##unbox-float f 1 4 }
  56             T{ ##copy f 2 1 double-rep }
  57             T{ ##box-float f 3 2 }
  58             T{ ##copy f 0 3 int-rep }
  59         } compile-test-bb
  60     ] unit-test
  61 ] when
  62
  63 ! make sure slot access works when the destination is
  64 ! one of the sources
  65 [ t ] [
  66     V{
  67         T{ ##load-immediate f 1 $[ 2 cell log2 shift ] }
  68         T{ ##load-reference f 0 { t f t } }
  69         T{ ##slot f 0 0 1 $[ array tag-number ] 2 }
  70     } compile-test-bb
  71 ] unit-test
  72
  73 [ t ] [
  74     V{
  75         T{ ##load-reference f 0 { t f t } }
  76         T{ ##slot-imm f 0 0 2 $[ array tag-number ] }
  77     } compile-test-bb
  78 ] unit-test
  79
  80 [ t ] [
  81     V{
  82         T{ ##load-immediate f 1 $[ 2 cell log2 shift ] }
  83         T{ ##load-reference f 0 { t f t } }
  84         T{ ##set-slot f 0 0 1 $[ array tag-number ] 2 }
  85     } compile-test-bb
  86     dup first eq?
  87 ] unit-test
  88
  89 [ t ] [
  90     V{
  91         T{ ##load-reference f 0 { t f t } }
  92         T{ ##set-slot-imm f 0 0 2 $[ array tag-number ] }
  93     } compile-test-bb
  94     dup first eq?
  95 ] unit-test
  96
  97 [ 8 ] [
  98     V{
  99         T{ ##load-immediate f 0 4 }
 100         T{ ##shl f 0 0 0 }
 101     } compile-test-bb
 102 ] unit-test
 103
 104 [ 4 ] [
 105     V{
 106         T{ ##load-immediate f 0 4 }
 107         T{ ##shl-imm f 0 0 3 }
 108     } compile-test-bb
 109 ] unit-test
 110
 111 [ 31 ] [
 112     V{
 113         T{ ##load-reference f 1 B{ 31 67 52 } }
 114         T{ ##unbox-any-c-ptr f 0 1 2 }
 115         T{ ##alien-unsigned-1 f 0 0 }
 116         T{ ##shl-imm f 0 0 3 }
 117     } compile-test-bb
 118 ] unit-test
 119
 120 [ CHAR: l ] [
 121     V{
 122         T{ ##load-reference f 0 "hello world" }
 123         T{ ##load-immediate f 1 3 }
 124         T{ ##string-nth f 0 0 1 2 }
 125         T{ ##shl-imm f 0 0 3 }
 126     } compile-test-bb
 127 ] unit-test
 128
 129 [ 1 ] [
 130     V{
 131         T{ ##load-immediate f 0 16 }
 132         T{ ##add-imm f 0 0 -8 }
 133     } compile-test-bb
 134 ] unit-test
 135
 136 ! These are def-is-use-insns
 137 USE: multiline
 138
 139 /*
 140
 141 [ 100 ] [
 142     V{
 143         T{ ##load-immediate f 0 100 }
 144         T{ ##integer>bignum f 0 0 1 }
 145     } compile-test-bb
 146 ] unit-test
 147
 148 [ 1 ] [
 149     V{
 150         T{ ##load-reference f 0 ALIEN: 8 }
 151         T{ ##unbox-any-c-ptr f 0 0 1 }
 152     } compile-test-bb
 153 ] unit-test
 154
 155 */