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         "eh"
  64     }
  65 } [
  66     3 D 0 replace-loc [
  67         "eh" ,
  68         replaces get height-state get emit-changes
  69     ] V{ } make
  70 ] cfg-unit-test
  71
  72 ! compute-local-kill-set
  73 { 0 } [
  74     V{ } 0 insns>block 0 0 pick record-stack-heights
  75     compute-local-kill-set sets:cardinality
  76 ] unit-test
  77
  78 { HS{ R -4 } } [
  79     V{ } 0 insns>block 4 4 pick record-stack-heights
  80     { { 8 0 } { 3 0 } } height-state set
  81     compute-local-kill-set
  82 ] unit-test
  83
  84 { HS{ D -1 D -2 } } [
  85     V{ } 0 insns>block [ 2 0 rot record-stack-heights ] keep
  86     { { 0 0 } { 0 0 } } height-state set
  87     compute-local-kill-set
  88 ] cfg-unit-test
  89
  90 ! translate-local-loc
  91 { D 2 } [
  92     D 3 { { 1 2 } { 3 4 } } translate-local-loc
  93 ] unit-test
  94
  95 ! height-state
  96 {
  97     { { 3 3 } { 0 0 } }
  98 } [
  99     D 3 inc-stack height-state get
 100 ] cfg-unit-test
 101
 102 {
 103     { { 5 3 } { 0 0 } }
 104 } [
 105     { { 2 0 } { 0 0 } } height-state set
 106     D 3 inc-stack height-state get
 107 ] cfg-unit-test
 108
 109 {
 110     { T{ ##inc { loc D 4 } } T{ ##inc { loc R -2 } } }
 111 } [
 112     { { 0 4  } { 0 -2 } } height-state>insns
 113 ] unit-test
 114
 115 { H{ { D -1 40 } } } [
 116     D 1 inc-stack 40 D 0 replace-loc replaces get
 117 ] cfg-unit-test