basis/compiler/cfg/liveness/liveness-tests.factor

   1 USING: accessors compiler.cfg.liveness
   2 compiler.cfg compiler.cfg.debugger compiler.cfg.instructions
   3 compiler.cfg.predecessors compiler.cfg.registers
   4 compiler.cfg.ssa.destruction.leaders compiler.cfg.utilities cpu.architecture
   5 dlists namespaces sequences kernel tools.test vectors alien math
   6 compiler.cfg.comparisons cpu.x86.assembler.operands assocs ;
   7 IN: compiler.cfg.liveness.tests
   8 QUALIFIED: sets
   9
  10 ! compute-edge-live-in
  11 { H{ } } [
  12     { } 0 insns>block compute-edge-live-in
  13 ] unit-test
  14
  15 {
  16     H{
  17         { "bl1" H{ { 7 7 } } }
  18         { "bl2" H{ { 99 99 } } }
  19     }
  20 } [
  21     {
  22         T{ ##phi
  23            { dst 103 }
  24            { inputs H{ { "bl1" 7 } { "bl2" 99 } } }
  25         }
  26     } 0 insns>block
  27     compute-edge-live-in
  28 ] unit-test
  29
  30 {
  31     H{
  32         { "b-31" H{ { 192 192 } { 193 193 } { 194 194 } { 195 195 } } }
  33         { "b-23" H{ { 181 181 } { 182 182 } { 183 183 } { 187 187 } } }
  34         { "b-26" H{ { 188 188 } { 189 189 } { 190 190 } { 191 191 } } }
  35     }
  36 } [
  37     {
  38         T{ ##phi
  39            { dst 196 }
  40            { inputs H{ { "b-26" 189 } { "b-23" 183 } { "b-31" 193 } } }
  41         }
  42         T{ ##phi
  43            { dst 197 }
  44            { inputs H{ { "b-26" 190 } { "b-23" 182 } { "b-31" 194 } } }
  45         }
  46         T{ ##phi
  47            { dst 198 }
  48            { inputs H{ { "b-26" 191 } { "b-23" 181 } { "b-31" 195 } } }
  49         }
  50         T{ ##phi
  51            { dst 199 }
  52            { inputs H{ { "b-26" 188 } { "b-23" 187 } { "b-31" 192 } } }
  53         }
  54     } 0 insns>block compute-edge-live-in
  55 ] unit-test
  56
  57 ! fill-gc-map
  58 {
  59     T{ gc-map { gc-roots { 48 } } { derived-roots V{ } } }
  60 } [
  61     H{ { 48 tagged-rep } } representations set
  62     H{ { 48 48  } } clone
  63     T{ gc-map } [ fill-gc-map ] keep
  64 ] unit-test
  65
  66 ! gc-roots
  67 ! only vregs that are tagged are real gc roots
  68 { V{ } { 125 } } [
  69     H{
  70         { 123 double-rep }
  71         { 124 double-2-rep }
  72         { 125 tagged-rep }
  73     } representations set
  74     { 123 124 125 } sets:unique gc-roots
  75 ] unit-test
  76
  77 ! kill-defs
  78 { H{ } } [
  79     H{ } dup T{ ##peek f 37 D 0 0 } kill-defs
  80 ] unit-test
  81
  82 { H{ { 3 3 } } } [
  83     H{ { 37 99 } { 99 99 } { 2 99 } } leader-map set
  84     H{ { 37 37 } { 3 3 } } dup T{ ##peek f 2 D 0 0 } kill-defs
  85 ] unit-test
  86
  87 ! liveness-step
  88 { 3 } [
  89     init-liveness
  90     3 iota [ <basic-block> swap >>number ] map <basic-block>
  91     [ connect-Nto1-bbs ] keep liveness-step length
  92 ] unit-test
  93
  94 ! lookup-base-pointer
  95 { 84 } [
  96     H{ { 84 84 } } clone base-pointers set 84 lookup-base-pointer
  97 ] unit-test
  98
  99 { 15 } [
 100     { T{ ##tagged>integer f 30 15 } } 0 insns>block block>cfg compute-live-sets
 101     30 lookup-base-pointer
 102 ] unit-test
 103
 104 ! lookup-base-pointer*
 105 { f } [
 106     456 T{ ##peek f 123 D 0 } lookup-base-pointer*
 107 ] unit-test
 108
 109 ! transfer-liveness
 110 {
 111     H{ { 37 37 } }
 112 } [
 113     H{ } clone dup { T{ ##replace f 37 D 1 6 } T{ ##peek f 37 D 0 0 } }
 114     transfer-liveness
 115 ] unit-test
 116
 117 ! visit-gc-root
 118 { V{ } HS{ 48 } } [
 119     H{ { 48 tagged-rep } } representations set
 120     48 V{ } clone HS{ } clone [ visit-gc-root ] 2keep
 121 ] unit-test
 122
 123 ! So the real root is 40?
 124 { V{ { 48 40 } } HS{ 40 } } [
 125     H{ { 48 40 } } base-pointers set
 126     H{ { 48 int-rep } } representations set
 127     48 V{ } clone HS{ } clone [ visit-gc-root ] 2keep
 128 ] unit-test
 129
 130 ! visit-insn
 131 { H{ } } [
 132     H{ } clone [ T{ ##peek f 0 D 0 } visit-insn ] keep
 133 ] unit-test
 134
 135 { H{ { 48 48 } { 37 37 } } } [
 136     H{ { 48 tagged-rep } } representations set
 137     H{ { 48 48  } } clone [ T{ ##replace f 37 D 1 6 } visit-insn ] keep
 138 ] unit-test
 139
 140 {
 141     T{ ##call-gc
 142        { gc-map
 143          T{ gc-map { gc-roots { 93 } } { derived-roots V{ } } }
 144        }
 145     }
 146 } [
 147     H{ { 93 tagged-rep } } representations set
 148     H{ { 93 93  } } clone T{ ##call-gc f T{ gc-map } }
 149     [ visit-insn ] keep
 150 ] unit-test
 151
 152 : test-liveness ( -- )
 153     1 get block>cfg compute-live-sets ;
 154
 155 ! Sanity check...
 156
 157 V{
 158     T{ ##peek f 0 D 0 }
 159     T{ ##replace f 0 D 0 }
 160     T{ ##replace f 1 D 1 }
 161     T{ ##peek f 1 D 1 }
 162     T{ ##branch }
 163 } 1 test-bb
 164
 165 V{
 166     T{ ##replace f 2 D 0 }
 167     T{ ##branch }
 168 } 2 test-bb
 169
 170 V{
 171     T{ ##replace f 3 D 0 }
 172     T{ ##return }
 173 } 3 test-bb
 174
 175 1 { 2 3 } edges
 176
 177 [ ] [ test-liveness ] unit-test
 178
 179 [
 180     H{
 181         { 1 1 }
 182         { 2 2 }
 183         { 3 3 }
 184     }
 185 ]
 186 [ 1 get live-in ]
 187 unit-test
 188
 189 ! Tricky case; defs must be killed before uses
 190
 191 V{
 192     T{ ##peek f 0 D 0 }
 193     T{ ##branch }
 194 } 1 test-bb
 195
 196 V{
 197     T{ ##add-imm f 0 0 10 }
 198     T{ ##return }
 199 } 2 test-bb
 200
 201 1 2 edge
 202
 203 [ ] [ test-liveness ] unit-test
 204
 205 [ H{ { 0 0 } } ] [ 2 get live-in ] unit-test
 206
 207 ! Regression
 208 V{
 209     T{ ##prologue }
 210     T{ ##branch }
 211 } 0 test-bb
 212
 213 V{
 214     T{ ##inc { loc R 2 } }
 215     T{ ##inc { loc D -2 } }
 216     T{ ##peek f 21 D -1 }
 217     T{ ##peek f 22 D -2 }
 218     T{ ##replace f 21 R 0 }
 219     T{ ##replace f 22 R 1 }
 220     T{ ##branch }
 221 } 1 test-bb
 222
 223 V{
 224     T{ ##call f >c-ptr }
 225     T{ ##branch }
 226 } 2 test-bb
 227
 228 V{
 229     T{ ##inc { loc R -1 } }
 230     T{ ##inc { loc D 1 } }
 231     T{ ##peek f 25 R -1 }
 232     T{ ##replace f 25 D 0 }
 233     T{ ##branch }
 234 } 3 test-bb
 235
 236 V{
 237     T{ ##call f >float }
 238     T{ ##branch }
 239 } 4 test-bb
 240
 241 V{
 242     T{ ##inc f R -1 }
 243     T{ ##inc f D 2 }
 244     T{ ##peek f 27 R -1 }
 245     T{ ##peek f 28 D 2 }
 246     T{ ##peek f 29 D 3 }
 247     T{ ##load-integer f 30 1 }
 248     T{ ##load-integer f 31 0 }
 249     T{ ##compare-imm-branch f 27 f cc/= }
 250 } 5 test-bb
 251
 252 V{
 253     T{ ##inc f D -1 }
 254     T{ ##branch }
 255 } 6 test-bb
 256
 257 V{
 258     T{ ##inc f D -1 }
 259     T{ ##branch }
 260 } 7 test-bb
 261
 262 V{
 263     T{ ##phi f 36 H{ { 6 30 } { 7 31 } } }
 264     T{ ##inc f D -2 }
 265     T{ ##unbox f 37 29 "alien_offset" int-rep }
 266     T{ ##unbox f 38 28 "to_double" double-rep }
 267     T{ ##unbox f 39 36 "to_cell" int-rep }
 268     T{ ##alien-invoke f V{ } V{ { 37 int-rep 0 } { 38 double-rep 4 } { 39 int-rep 12 } } { { 40 int-rep EAX } } { } 0 16 "CFRunLoopRunInMode" f T{ gc-map } }
 269     T{ ##box f 41 40 "from_signed_cell" int-rep T{ gc-map } }
 270     T{ ##replace f 41 D 0 }
 271     T{ ##branch }
 272 } 8 test-bb
 273
 274 V{
 275     T{ ##epilogue }
 276     T{ ##return }
 277 } 9 test-bb
 278
 279 0 1 edge
 280 1 2 edge
 281 2 3 edge
 282 3 4 edge
 283 4 5 edge
 284 5 { 6 7 } edges
 285 6 8 edge
 286 7 8 edge
 287 8 9 edge
 288
 289 [ ] [ test-liveness ] unit-test
 290
 291 [ H{ { 28 28 } { 29 29 } { 30 30 } { 31 31 } } ] [ 5 get live-out ] unit-test
 292 [ H{ { 28 28 } { 29 29 } { 30 30 } } ] [ 6 get live-in ] unit-test
 293 [ H{ { 28 28 } { 29 29 } { 31 31 } } ] [ 7 get live-in ] unit-test
 294 [ H{ { 30 30 } } ] [ 6 get 8 get edge-live-in ] unit-test
 295
 296 V{
 297     T{ ##prologue }
 298     T{ ##branch }
 299 } 0 test-bb
 300
 301 V{
 302     T{ ##branch }
 303 } 1 test-bb
 304
 305 V{
 306     T{ ##load-integer f 0 0 }
 307     T{ ##branch }
 308 } 2 test-bb
 309
 310 V{
 311     T{ ##load-integer f 1 1 }
 312     T{ ##branch }
 313 } 3 test-bb
 314
 315 V{
 316     T{ ##phi f 2 H{ { 2 0 } { 3 1 } } }
 317     T{ ##branch }
 318 } 4 test-bb
 319
 320 V{
 321     T{ ##branch }
 322 } 5 test-bb
 323
 324 V{
 325     T{ ##replace f 2 D 0 }
 326     T{ ##branch }
 327 } 6 test-bb
 328
 329 V{
 330     T{ ##epilogue }
 331     T{ ##return }
 332 } 7 test-bb
 333
 334 0 1 edge
 335 1 { 2 3 } edges
 336 2 4 edge
 337 3 4 edge
 338 4 { 5 6 } edges
 339 5 6 edge
 340 6 7 edge
 341
 342 [ ] [ 0 get block>cfg dup cfg set compute-live-sets ] unit-test
 343
 344 [ t ] [ 0 get live-in assoc-empty? ] unit-test
 345
 346 [ H{ { 2 2 } } ] [ 4 get live-out ] unit-test
 347
 348 [ H{ { 0 0 } } ] [ 2 get 4 get edge-live-in ] unit-test
 349
 350 [ H{ { 1 1 } } ] [ 3 get 4 get edge-live-in ] unit-test
 351
 352
 353 V{
 354     T{ ##prologue }
 355     T{ ##branch }
 356 } 0 test-bb
 357
 358 V{
 359     T{ ##peek f 0 D 0 }
 360     T{ ##tagged>integer f 1 0 }
 361     T{ ##call-gc f T{ gc-map } }
 362     T{ ##replace f 0 D 0 }
 363     T{ ##call-gc f T{ gc-map } }
 364     T{ ##replace f 1 D 0 }
 365     T{ ##branch }
 366 } 1 test-bb
 367
 368 V{
 369     T{ ##epilogue }
 370     T{ ##return }
 371 } 2 test-bb
 372
 373 0 1 edge
 374 1 2 edge
 375
 376 H{
 377     { 0 tagged-rep }
 378     { 1 int-rep }
 379 } representations set
 380
 381 [ ] [ 0 get block>cfg dup cfg set compute-live-sets ] unit-test
 382
 383 [ V{ { 1 0 } } ] [ 1 get instructions>> 2 swap nth gc-map>> derived-roots>> ] unit-test
 384
 385 [ { 0 } ] [ 1 get instructions>> 2 swap nth gc-map>> gc-roots>> ] unit-test
 386
 387 [ V{ { 1 0 } } ] [ 1 get instructions>> 4 swap nth gc-map>> derived-roots>> ] unit-test
 388
 389 [ { 0 } ] [ 1 get instructions>> 4 swap nth gc-map>> gc-roots>> ] unit-test