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 ! make sure slot access works when the destination is
  50 ! one of the sources
  51 [ t ] [
  52     V{
  53         T{ ##load-immediate f 1 $[ 2 cell log2 shift array tag-number - ] }
  54         T{ ##load-reference f 0 { t f t } }
  55         T{ ##slot f 0 0 1 }
  56     } compile-test-bb
  57 ] unit-test
  58
  59 [ t ] [
  60     V{
  61         T{ ##load-reference f 0 { t f t } }
  62         T{ ##slot-imm f 0 0 2 $[ array tag-number ] }
  63     } compile-test-bb
  64 ] unit-test
  65
  66 [ t ] [
  67     V{
  68         T{ ##load-immediate f 1 $[ 2 cell log2 shift array tag-number - ] }
  69         T{ ##load-reference f 0 { t f t } }
  70         T{ ##set-slot f 0 0 1 }
  71     } compile-test-bb
  72     dup first eq?
  73 ] unit-test
  74
  75 [ t ] [
  76     V{
  77         T{ ##load-reference f 0 { t f t } }
  78         T{ ##set-slot-imm f 0 0 2 $[ array tag-number ] }
  79     } compile-test-bb
  80     dup first eq?
  81 ] unit-test
  82
  83 [ 8 ] [
  84     V{
  85         T{ ##load-immediate f 0 4 }
  86         T{ ##shl f 0 0 0 }
  87     } compile-test-bb
  88 ] unit-test
  89
  90 [ 4 ] [
  91     V{
  92         T{ ##load-immediate f 0 4 }
  93         T{ ##shl-imm f 0 0 3 }
  94     } compile-test-bb
  95 ] unit-test
  96
  97 [ 31 ] [
  98     V{
  99         T{ ##load-reference f 1 B{ 31 67 52 } }
 100         T{ ##unbox-any-c-ptr f 0 1 2 }
 101         T{ ##alien-unsigned-1 f 0 0 0 }
 102         T{ ##shl-imm f 0 0 3 }
 103     } compile-test-bb
 104 ] unit-test
 105
 106 [ CHAR: l ] [
 107     V{
 108         T{ ##load-reference f 0 "hello world" }
 109         T{ ##load-immediate f 1 3 }
 110         T{ ##string-nth f 0 0 1 2 }
 111         T{ ##shl-imm f 0 0 3 }
 112     } compile-test-bb
 113 ] unit-test
 114
 115 [ 1 ] [
 116     V{
 117         T{ ##load-immediate f 0 16 }
 118         T{ ##add-imm f 0 0 -8 }
 119     } compile-test-bb
 120 ] unit-test