basis/compiler/cfg/ssa/cssa/cssa.factor

   1 ! Copyright (C) 2009, 2011 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs compiler.cfg compiler.cfg.instructions
   4 compiler.cfg.predecessors compiler.cfg.registers
   5 compiler.cfg.rpo compiler.cfg.utilities fry kernel locals make
   6 namespaces sequences ;
   7 IN: compiler.cfg.ssa.cssa
   8
   9 SYMBOLS: edge-copies phi-copies ;
  10
  11 : init-copies ( bb -- )
  12     V{ } clone phi-copies set
  13     predecessors>> [ V{ } clone ] H{ } map>assoc edge-copies set ;
  14
  15 :: convert-operand ( src pred rep -- dst )
  16     rep next-vreg-rep :> dst
  17     { dst src } pred edge-copies get at push
  18     dst ;
  19
  20 :: convert-phi ( insn preds -- )
  21     insn dst>> :> dst
  22     dst rep-of :> rep
  23     insn inputs>> :> inputs
  24     rep next-vreg-rep :> dst'
  25
  26     { dst dst' } phi-copies get push
  27     dst' insn dst<<
  28
  29     preds [| pred |
  30         pred inputs [ pred rep convert-operand ] change-at
  31     ] each ;
  32
  33 : insert-edge-copies ( from to copies -- )
  34     [ ##parallel-copy, ##branch, ] { } make insert-basic-block ;
  35
  36 : insert-all-edge-copies ( bb -- )
  37     [ edge-copies get ] dip '[
  38         [ drop ] [ [ _ ] dip insert-edge-copies ] if-empty
  39     ] assoc-each ;
  40
  41 : phi-copy-insn ( copies -- insn )
  42     f \ ##parallel-copy boa ;
  43
  44 : end-of-phis ( insns -- i )
  45     [ [ ##phi? not ] find drop ] [ length ] bi or ;
  46
  47 : insert-phi-copies ( bb -- )
  48     [
  49         [
  50             [ drop phi-copies get phi-copy-insn ]
  51             [ end-of-phis ]
  52             [ ] tri insert-nth
  53         ] change-instructions drop
  54     ] if-has-phis ;
  55
  56 : insert-copies ( bb -- )
  57     [ insert-all-edge-copies ] [ insert-phi-copies ] bi ;
  58
  59 : convert-phis ( bb -- )
  60     [ init-copies ]
  61     [ dup predecessors>> '[ _ convert-phi ] each-phi ]
  62     [ insert-copies ]
  63     tri ;
  64
  65 : construct-cssa ( cfg -- )
  66     [ needs-predecessors ]
  67     [ [ convert-phis ] each-basic-block ]
  68     [ cfg-changed ] tri ;