basis/compiler/cfg/ssa/construction/construction.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: namespaces kernel accessors sequences fry assocs
   4 sets math combinators
   5 compiler.cfg
   6 compiler.cfg.rpo
   7 compiler.cfg.def-use
   8 compiler.cfg.liveness
   9 compiler.cfg.registers
  10 compiler.cfg.dominance
  11 compiler.cfg.instructions
  12 compiler.cfg.renaming
  13 compiler.cfg.renaming.functor
  14 compiler.cfg.ssa.construction.tdmsc ;
  15 FROM: namespaces => set ;
  16 IN: compiler.cfg.ssa.construction
  17
  18 ! The phi placement algorithm is implemented in
  19 ! compiler.cfg.ssa.construction.tdmsc.
  20
  21 ! The renaming algorithm is based on "Practical Improvements to
  22 ! the Construction and Destruction of Static Single Assignment Form",
  23 ! however we construct pruned SSA, not semi-pruned SSA.
  24
  25 ! http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.49.9683
  26
  27 <PRIVATE
  28
  29 ! Maps vregs to sets of basic blocks
  30 SYMBOL: defs
  31
  32 ! Set of vregs defined in more than one basic block
  33 SYMBOL: defs-multi
  34
  35 : compute-insn-defs ( bb insn -- )
  36     defs-vreg dup [
  37         defs get [ conjoin-at ] [ drop ] [ at assoc-size 1 > ] 2tri
  38         [ defs-multi get conjoin ] [ drop ] if
  39     ] [ 2drop ] if ;
  40
  41 : compute-defs ( cfg -- )
  42     H{ } clone defs set
  43     H{ } clone defs-multi set
  44     [
  45         dup instructions>> [
  46             compute-insn-defs
  47         ] with each
  48     ] each-basic-block ;
  49
  50 ! Maps basic blocks to sequences of vregs
  51 SYMBOL: inserting-phi-nodes
  52
  53 : insert-phi-node-later ( vreg bb -- )
  54     2dup live-in key? [
  55         [ predecessors>> over '[ _ ] H{ } map>assoc \ ##phi new-insn ] keep
  56         inserting-phi-nodes get push-at
  57     ] [ 2drop ] if ;
  58
  59 : compute-phi-nodes-for ( vreg bbs -- )
  60     keys [ insert-phi-node-later ] with merge-set-each ;
  61
  62 : compute-phi-nodes ( -- )
  63     H{ } clone inserting-phi-nodes set
  64     defs-multi get defs get '[ _ at compute-phi-nodes-for ] assoc-each ;
  65
  66 : insert-phi-nodes-in ( phis bb -- )
  67     [ append ] change-instructions drop ;
  68
  69 : insert-phi-nodes ( -- )
  70     inserting-phi-nodes get [ swap insert-phi-nodes-in ] assoc-each ;
  71
  72 SYMBOLS: stacks pushed ;
  73
  74 : init-renaming ( -- )
  75     H{ } clone stacks set ;
  76
  77 : gen-name ( vreg -- vreg' )
  78     [ next-vreg dup ] dip
  79     dup pushed get 2dup key?
  80     [ 2drop stacks get at set-last ]
  81     [ conjoin stacks get push-at ]
  82     if ;
  83
  84 : top-name ( vreg -- vreg' )
  85     stacks get at last ;
  86
  87 RENAMING: ssa-rename [ gen-name ] [ top-name ] [ ]
  88
  89 GENERIC: rename-insn ( insn -- )
  90
  91 M: insn rename-insn
  92     [ ssa-rename-insn-uses ]
  93     [ ssa-rename-insn-defs ]
  94     bi ;
  95
  96 M: ##phi rename-insn
  97     ssa-rename-insn-defs ;
  98
  99 : rename-insns ( bb -- )
 100     instructions>> [ rename-insn ] each ;
 101
 102 : rename-successor-phi ( phi bb -- )
 103     swap inputs>> [ top-name ] change-at ;
 104
 105 : rename-successor-phis ( succ bb -- )
 106     [ inserting-phi-nodes get at ] dip
 107     '[ _ rename-successor-phi ] each ;
 108
 109 : rename-successors-phis ( bb -- )
 110     [ successors>> ] keep '[ _ rename-successor-phis ] each ;
 111
 112 : pop-stacks ( -- )
 113     pushed get stacks get '[ drop _ at pop* ] assoc-each ;
 114
 115 : rename-in-block ( bb -- )
 116     H{ } clone pushed set
 117     [ rename-insns ]
 118     [ rename-successors-phis ]
 119     [
 120         pushed get
 121         [ dom-children [ rename-in-block ] each ] dip
 122         pushed set
 123     ] tri
 124     pop-stacks ;
 125
 126 : rename ( cfg -- )
 127     init-renaming
 128     entry>> rename-in-block ;
 129
 130 PRIVATE>
 131
 132 : construct-ssa ( cfg -- cfg' )
 133     {
 134         [ compute-live-sets ]
 135         [ compute-merge-sets ]
 136         [ compute-defs compute-phi-nodes insert-phi-nodes ]
 137         [ rename ]
 138         [ ]
 139     } cleave ;