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 ;
   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
  16     0 get >>entry
  17     compile-cfg ;
  18
  19 : compile-test-bb ( insns -- result )
  20     V{ T{ ##prologue } T{ ##branch } } 0 test-bb
  21     V{
  22         T{ ##inc-d f 1 }
  23         T{ ##replace f V int-regs 0 D 0 }
  24         T{ ##branch }
  25     } append 1 test-bb
  26     V{
  27         T{ ##epilogue }
  28         T{ ##return }
  29     } 2 test-bb
  30     0 get 1 get 1vector >>successors drop
  31     1 get 2 get 1vector >>successors drop
  32     compile-test-cfg
  33     execute( -- result ) ;
  34
  35 ! loading immediates
  36 [ f ] [
  37     V{
  38         T{ ##load-immediate f V int-regs 0 5 }
  39     } compile-test-bb
  40 ] unit-test
  41
  42 [ "hello" ] [
  43     V{
  44         T{ ##load-reference f V int-regs 0 "hello" }
  45     } compile-test-bb
  46 ] unit-test
  47
  48 ! make sure slot access works when the destination is
  49 ! one of the sources
  50 [ t ] [
  51     V{
  52         T{ ##load-immediate f V int-regs 1 $[ 2 cell log2 shift ] }
  53         T{ ##load-reference f V int-regs 0 { t f t } }
  54         T{ ##slot f V int-regs 0 V int-regs 0 V int-regs 1 $[ array tag-number ] V int-regs 2 }
  55     } compile-test-bb
  56 ] unit-test
  57
  58 [ t ] [
  59     V{
  60         T{ ##load-reference f V int-regs 0 { t f t } }
  61         T{ ##slot-imm f V int-regs 0 V int-regs 0 2 $[ array tag-number ] V int-regs 2 }
  62     } compile-test-bb
  63 ] unit-test
  64
  65 [ t ] [
  66     V{
  67         T{ ##load-immediate f V int-regs 1 $[ 2 cell log2 shift ] }
  68         T{ ##load-reference f V int-regs 0 { t f t } }
  69         T{ ##set-slot f V int-regs 0 V int-regs 0 V int-regs 1 $[ array tag-number ] V int-regs 2 }
  70     } compile-test-bb
  71     dup first eq?
  72 ] unit-test
  73
  74 [ t ] [
  75     V{
  76         T{ ##load-reference f V int-regs 0 { t f t } }
  77         T{ ##set-slot-imm f V int-regs 0 V int-regs 0 2 $[ array tag-number ] }
  78     } compile-test-bb
  79     dup first eq?
  80 ] unit-test
  81
  82 [ 8 ] [
  83     V{
  84         T{ ##load-immediate f V int-regs 0 4 }
  85         T{ ##shl f V int-regs 0 V int-regs 0 V int-regs 0 }
  86     } compile-test-bb
  87 ] unit-test
  88
  89 [ 4 ] [
  90     V{
  91         T{ ##load-immediate f V int-regs 0 4 }
  92         T{ ##shl-imm f V int-regs 0 V int-regs 0 3 }
  93     } compile-test-bb
  94 ] unit-test
  95
  96 [ 31 ] [
  97     V{
  98         T{ ##load-reference f V int-regs 1 B{ 31 67 52 } }
  99         T{ ##unbox-any-c-ptr f V int-regs 0 V int-regs 1 V int-regs 2 }
 100         T{ ##alien-unsigned-1 f V int-regs 0 V int-regs 0 }
 101         T{ ##shl-imm f V int-regs 0 V int-regs 0 3 }
 102     } compile-test-bb
 103 ] unit-test
 104
 105 [ CHAR: l ] [
 106     V{
 107         T{ ##load-reference f V int-regs 0 "hello world" }
 108         T{ ##load-immediate f V int-regs 1 3 }
 109         T{ ##string-nth f V int-regs 0 V int-regs 0 V int-regs 1 V int-regs 2 }
 110         T{ ##shl-imm f V int-regs 0 V int-regs 0 3 }
 111     } compile-test-bb
 112 ] unit-test
 113
 114 [ 1 ] [
 115     V{
 116         T{ ##load-immediate f V int-regs 0 16 }
 117         T{ ##add-imm f V int-regs 0 V int-regs 0 -8 }
 118     } compile-test-bb
 119 ] unit-test
 120
 121 ! These are def-is-use-insns
 122 USE: multiline
 123
 124 /*
 125
 126 [ 100 ] [
 127     V{
 128         T{ ##load-immediate f V int-regs 0 100 }
 129         T{ ##integer>bignum f V int-regs 0 V int-regs 0 V int-regs 1 }
 130     } compile-test-bb
 131 ] unit-test
 132
 133 [ 1 ] [
 134     V{
 135         T{ ##load-reference f V int-regs 0 ALIEN: 8 }
 136         T{ ##unbox-any-c-ptr f V int-regs 0 V int-regs 0 V int-regs 1 }
 137     } compile-test-bb
 138 ] unit-test
 139
 140 */