basis/compiler/cfg/linear-scan/assignment/assignment-tests.factor

   1 USING: accessors arrays compiler.cfg compiler.cfg.instructions
   2 compiler.cfg.linear-scan.allocation.state
   3 compiler.cfg.linear-scan.assignment
   4 compiler.cfg.linear-scan.live-intervals compiler.cfg.registers
   5 compiler.cfg.ssa.destruction.leaders compiler.cfg.utilities
   6 cpu.architecture cpu.x86.assembler.operands heaps kernel make
   7 namespaces sequences sorting tools.test ;
   8 IN: compiler.cfg.linear-scan.assignment.tests
   9
  10 : cherry-pick ( seq indices -- seq' )
  11     [ swap nth ] with map  ;
  12
  13 : (setup-vreg-spills) ( vreg-defs -- reps leaders spill-slots )
  14     [ [ 2 head ] map ]
  15     [ [ { 0 2 } cherry-pick ] map ]
  16     [
  17         [
  18             first4 [ nip [ rep-size 2array ] dip 2array ] [ 3drop f ] if*
  19         ] map sift
  20     ] tri ;
  21
  22 : setup-vreg-spills ( vreg-defs -- )
  23     (setup-vreg-spills)
  24     [ representations set ] [ leader-map set ] [ spill-slots set ] tri* ;
  25
  26 ! activate-new-intervals
  27 {
  28     {
  29         T{ ##reload
  30            { dst RBX }
  31            { rep tagged-rep }
  32            { src T{ spill-slot } }
  33         }
  34     }
  35 } [
  36     ! Setup
  37     H{ } clone pending-interval-assoc set
  38     <min-heap> pending-interval-heap set
  39     30 {
  40         T{ live-interval-state
  41            { vreg 789 }
  42            { reg RBX }
  43            { reload-from T{ spill-slot } }
  44            { reload-rep tagged-rep }
  45            { ranges V{ { 30 30  } } }
  46            { uses
  47              V{ T{ vreg-use { n 26 } { use-rep tagged-rep } } }
  48            }
  49         }
  50     } live-intervals>min-heap [ activate-new-intervals ] { } make
  51 ] unit-test
  52
  53 ! assign-insn-defs
  54 {
  55     T{ ##peek { dst RAX } { loc T{ ds-loc } } { insn# 0 } }
  56 } [
  57     H{ { 37 RAX } } pending-interval-assoc set
  58     { { 37 int-rep 37 f } } setup-vreg-spills
  59     T{ ##peek f 37 D: 0 0 } [ assign-insn-defs ] keep
  60 ] unit-test
  61
  62 ! assign-all-registers
  63 {
  64     T{ ##replace-imm f 20 D: 0 f }
  65     T{ ##replace f RAX D: 0 f }
  66 } [
  67     ! It doesn't do anything because ##replace-imm isn't a vreg-insn.
  68     T{ ##replace-imm { src 20 } { loc D: 0 } } [ assign-all-registers ] keep
  69
  70     ! This one does something.
  71     H{ { 37 RAX } } pending-interval-assoc set
  72     H{ { 37 37 } } leader-map set
  73     T{ ##replace { src 37 } { loc D: 0 } } clone
  74     [ assign-all-registers ] keep
  75 ] unit-test
  76
  77 ! assign-registers
  78 { } [
  79     V{ T{ ##inc { loc D: 3 } { insn# 7 } } } 0 insns>block block>cfg { }
  80     assign-registers
  81 ] unit-test
  82
  83 ! assign-registers-in-block
  84 {
  85     V{ T{ ##inc { loc T{ ds-loc { n 3 } } } { insn# 7 } } }
  86 } [
  87     { } init-assignment
  88     V{ T{ ##inc { loc D: 3 } { insn# 7 } } } 0 insns>block
  89     [ assign-registers-in-block ] keep instructions>>
  90 ] unit-test
  91
  92 ! expire-old-intervals
  93 { 3 H{ } } [
  94     H{ { 25 RBX } } clone pending-interval-assoc set
  95     90 { 50 90 95 120 } [ 25 <live-interval> 2array ] map >min-heap
  96     [ expire-old-intervals ] keep heap-size
  97     pending-interval-assoc get
  98 ] unit-test
  99
 100 ! insert-reload
 101 {
 102     { T{ ##reload { dst RAX } { rep int-rep } { src T{ spill-slot } } } }
 103 } [
 104     [
 105         T{ live-interval-state
 106            { reg RAX }
 107            { reload-from T{ spill-slot } }
 108            { reload-rep int-rep }
 109         } insert-reload
 110     ] { } make
 111 ] unit-test
 112
 113 ! insert-spill
 114 { { T{ ##spill { src RAX } } } } [
 115     [
 116         T{ live-interval-state { vreg 1234 } { reg RAX } } insert-spill
 117     ] { } make
 118 ] unit-test
 119
 120 { V{ T{ ##spill { src RAX } { rep int-rep } } } } [
 121     [
 122         1234 <live-interval>
 123         RAX >>reg int-rep >>spill-rep
 124         insert-spill
 125     ] V{ } make
 126 ] unit-test
 127
 128 ! spill/reloads-for-call-gc
 129
 130 ! The interval should be spilled around the gc instruction at 128. And
 131 ! it's spill representation should be int-rep because on instruction
 132 ! 102 it was converted from a tagged-rep to an int-rep.
 133 : test-call-gc ( -- ##call-gc )
 134     T{ gc-map { gc-roots { 149 109 110 } } { derived-roots V{ } } } 128
 135     ##call-gc boa ;
 136
 137 : test-interval ( -- live-interval )
 138     T{ live-interval-state
 139        { vreg 235 }
 140        { reg RDI }
 141        { ranges V{ { 88 94 } { 100 154 } } }
 142        { uses
 143          V{
 144              T{ vreg-use
 145                 { n 88 }
 146                 { def-rep tagged-rep }
 147               }
 148              T{ vreg-use
 149                 { n 90 }
 150                 { def-rep int-rep }
 151                 { use-rep tagged-rep }
 152               }
 153              T{ vreg-use
 154                 { n 100 }
 155                 { def-rep tagged-rep }
 156               }
 157              T{ vreg-use
 158                 { n 102 }
 159                 { def-rep int-rep }
 160                 { use-rep tagged-rep }
 161               }
 162              T{ vreg-use { n 144 } { use-rep int-rep } }
 163              T{ vreg-use { n 146 } { use-rep int-rep } }
 164              T{ vreg-use
 165                 { n 148 }
 166                 { def-rep int-rep }
 167                 { use-rep int-rep }
 168               }
 169              T{ vreg-use
 170                 { n 150 }
 171                 { def-rep tagged-rep }
 172                 { use-rep int-rep }
 173               }
 174              T{ vreg-use
 175                 { n 154 }
 176                 { use-rep tagged-rep }
 177               }
 178          } }
 179     } ;
 180
 181 {
 182     V{ { RDI int-rep T{ spill-slot } } }
 183 } [
 184     f f <basic-block> <cfg> cfg set
 185     H{ } clone spill-slots set
 186     H{ } clone pending-interval-assoc set
 187     <min-heap> pending-interval-heap set
 188     H{ { 235 float-rep } } representations set
 189     test-interval add-pending
 190     test-call-gc spill/reloads-for-call-gc
 191 ] unit-test
 192
 193 ! vreg>spill-slot
 194 { T{ spill-slot { n 990 } } } [
 195     { { 10 int-rep 10 T{ spill-slot { n 990 } } } } setup-vreg-spills
 196     10 vreg>spill-slot
 197 ] unit-test
 198
 199 ! vreg>reg
 200 { T{ spill-slot f 16 } } [
 201     { { 45 double-rep 45 T{ spill-slot { n 16 } } } } setup-vreg-spills
 202     45 vreg>reg
 203 ] unit-test
 204
 205 [
 206     ! It gets very strange if the leader of a vreg has a different
 207     ! sized representation than the vreg being led.
 208     { { 45 double-2-rep 45 T{ spill-slot { n 16 } } }
 209       { 46 double-rep 45 f } } setup-vreg-spills
 210     46 vreg>reg
 211 ] [ bad-vreg? ] must-fail-with
 212
 213 ! vregs>regs
 214 { { { 33 RAX } { 44 RBX } } } [
 215     { { 33 int-rep 33 f } { 44 int-rep 44 f } } setup-vreg-spills
 216     H{ { 33 RAX } { 44 RBX } } pending-interval-assoc set
 217     { { 33 33 } { 44 44 } } vregs>regs
 218 ] unit-test
 219
 220
 221 { { 3 56 } } [
 222     { { 3 7 } { -1 56 } { -1 3 } } >min-heap [ -1 = ] heap-pop-while
 223     sort
 224 ] unit-test