basis/compiler/cfg/stacks/local/local-tests.factor

   1 USING: accessors assocs biassocs combinators compiler.cfg
   2 compiler.cfg.instructions compiler.cfg.registers compiler.cfg.stacks
   3 compiler.cfg.stacks.height compiler.cfg.stacks.local compiler.cfg.utilities
   4 compiler.test cpu.architecture make namespaces kernel tools.test ;
   5 QUALIFIED: sets
   6 IN: compiler.cfg.stacks.local.tests
   7
   8 ! loc>vreg
   9 { 1 } [
  10     D 0 loc>vreg
  11 ] cfg-unit-test
  12
  13 ! stack-changes
  14 {
  15     {
  16         T{ ##copy { dst 1 } { src 25 } { rep any-rep } }
  17         T{ ##copy { dst 2 } { src 26 } { rep any-rep } }
  18     }
  19 } [
  20     { { D 0 25 } { R 0 26 } } replaces>copy-insns
  21 ] cfg-unit-test
  22
  23 ! replace-loc
  24 { 80 } [
  25     80 D 77 replace-loc
  26     D 77 peek-loc
  27 ] cfg-unit-test
  28
  29 ! end-local-analysis
  30 {
  31     HS{ }
  32     { }
  33     HS{ }
  34 } [
  35     V{ } 137 insns>block
  36     [ 0 0 rot record-stack-heights ]
  37     [ [ "eh" , end-local-analysis ] V{ } make drop ]
  38     [ [ peek-sets ] [ replace-sets ] [ kill-sets ] tri [ get at ] 2tri@ ] tri
  39 ] cfg-unit-test
  40
  41 {
  42     { D 3 }
  43 } [
  44     V{ } 137 insns>block
  45     [ 0 0 rot record-stack-heights ]
  46     [ [ 3 D 3 replace-loc "eh" , end-local-analysis ] V{ } make drop ]
  47     [ replace-sets get at ] tri
  48 ] cfg-unit-test
  49
  50 ! remove-redundant-replaces
  51 {
  52     H{ { T{ ds-loc { n 3 } } 7 } }
  53 } [
  54     D 0 loc>vreg D 2 loc>vreg 2drop
  55     2 D 2 replace-loc 7 D 3 replace-loc
  56     replaces get remove-redundant-replaces
  57 ] cfg-unit-test
  58
  59 ! emit-changes
  60 {
  61     V{
  62         T{ ##copy { dst 1 } { src 3 } { rep any-rep } }
  63         T{ ##replace { src 1 } { loc D 0 } }
  64         "eh"
  65     }
  66 } [
  67     3 D 0 replace-loc [
  68         "eh",
  69         replaces get height-state get emit-changes
  70     ] V{ } make
  71 ] cfg-unit-test
  72
  73 { D 2 } [
  74     D 3 { { 1 2 } { 3 4 } } translate-local-loc
  75 ] unit-test
  76
  77 ! height-state
  78 {
  79     { { 3 3 } { 0 0 } }
  80 } [
  81     D 3 inc-stack height-state get
  82 ] cfg-unit-test
  83
  84 {
  85     { { 5 3 } { 0 0 } }
  86 } [
  87     { { 2 0 } { 0 0 } } height-state set
  88     D 3 inc-stack height-state get
  89 ] cfg-unit-test
  90
  91 {
  92     { T{ ##inc { loc D 4 } } T{ ##inc { loc R -2 } } }
  93 } [
  94     { { 0 4  } { 0 -2 } } height-state>insns
  95 ] unit-test
  96
  97 { H{ { D -1 40 } } } [
  98     D 1 inc-stack 40 D 0 replace-loc replaces get
  99 ] cfg-unit-test
 100
 101 { 0 } [
 102     V{ } 0 insns>block 0 0 pick record-stack-heights
 103     compute-local-kill-set sets:cardinality
 104 ] unit-test
 105
 106 { HS{ R -4 } } [
 107     V{ } 0 insns>block 4 4 pick record-stack-heights
 108     { { 8 0 } { 3 0 } } height-state set
 109     compute-local-kill-set
 110 ] unit-test