basis/compiler/cfg/ssa/liveness/liveness.factor

   1 ! Copyright (C) 2009 Daniel Ehrenberg
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel sequences assocs accessors
   4 namespaces fry math sets combinators locals
   5 compiler.cfg.rpo
   6 compiler.cfg.dominance
   7 compiler.cfg.def-use
   8 compiler.cfg.instructions ;
   9 FROM: namespaces => set ;
  10 IN: compiler.cfg.ssa.liveness
  11
  12 ! Liveness checking on SSA IR, as described in
  13 ! "Fast Liveness Checking for SSA-Form Programs", Sebastian Hack et al.
  14 ! http://hal.archives-ouvertes.fr/docs/00/19/22/19/PDF/fast_liveness.pdf
  15
  16 <PRIVATE
  17
  18 ! The sets T_q and R_q are described there
  19 SYMBOL: T_q-sets
  20 SYMBOL: R_q-sets
  21
  22 ! Targets of back edges
  23 SYMBOL: back-edge-targets
  24
  25 : T_q ( q -- T_q )
  26     T_q-sets get at ;
  27
  28 : R_q ( q -- R_q )
  29     R_q-sets get at ;
  30
  31 : back-edge-target? ( block -- ? )
  32     back-edge-targets get key? ;
  33
  34 : next-R_q ( q -- R_q )
  35     [ ] [ successors>> ] [ number>> ] tri
  36     '[ number>> _ >= ] filter
  37     [ R_q ] map assoc-combine
  38     [ conjoin ] keep ;
  39
  40 : set-R_q ( q -- )
  41     [ next-R_q ] keep R_q-sets get set-at ;
  42
  43 : set-back-edges ( q -- )
  44     [ successors>> ] [ number>> ] bi '[
  45         dup number>> _ <
  46         [ back-edge-targets get conjoin ] [ drop ] if
  47     ] each ;
  48
  49 : init-R_q ( -- )
  50     H{ } clone R_q-sets set
  51     H{ } clone back-edge-targets set ;
  52
  53 : compute-R_q ( cfg -- )
  54     init-R_q
  55     post-order [
  56         [ set-R_q ] [ set-back-edges ] bi
  57     ] each ;
  58
  59 ! This algorithm for computing T_q uses equation (1)
  60 ! but not the faster algorithm described in the paper
  61
  62 : back-edges-from ( q -- edges )
  63     R_q keys [
  64         [ successors>> ] [ number>> ] bi
  65         '[ number>> _ < ] filter
  66     ] gather ;
  67
  68 : T^_q ( q -- T^_q )
  69     [ back-edges-from ] [ R_q ] bi
  70     '[ _ key? not ] filter ;
  71
  72 : next-T_q ( q -- T_q )
  73     dup dup T^_q [ next-T_q keys ] map
  74     concat unique [ conjoin ] keep
  75     [ swap T_q-sets get set-at ] keep ;
  76
  77 : compute-T_q ( cfg -- )
  78     H{ } T_q-sets set
  79     [ next-T_q drop ] each-basic-block ;
  80
  81 PRIVATE>
  82
  83 : precompute-liveness ( cfg -- )
  84     [ compute-R_q ] [ compute-T_q ] bi ;
  85
  86 <PRIVATE
  87
  88 ! This doesn't take advantage of ordering T_q,a so you
  89 ! only have to check one if the CFG is reducible.
  90 ! It should be changed to be more efficient.
  91
  92 : only? ( seq obj -- ? )
  93     '[ _ eq? ] all? ;
  94
  95 : strictly-dominates? ( bb1 bb2 -- ? )
  96     [ dominates? ] [ eq? not ] 2bi and ;
  97
  98 : T_q,a ( a q -- T_q,a )
  99     ! This could take advantage of the structure of dominance,
 100     ! but probably I'll replace it with the algorithm that works
 101     ! on reducible CFGs anyway
 102     T_q keys swap def-of
 103     [ '[ _ swap strictly-dominates? ] filter ] when* ;
 104
 105 : live? ( vreg node quot -- ? )
 106     [ [ T_q,a ] [ drop uses-of ] 2bi ] dip
 107     '[ [ R_q keys _ ] keep @ intersects? ] any? ; inline
 108
 109 PRIVATE>
 110
 111 : live-in? ( vreg node -- ? )
 112     [ drop ] live? ;
 113
 114 <PRIVATE
 115
 116 : (live-out?) ( vreg node -- ? )
 117     dup dup dup '[
 118         _ = _ back-edge-target? not and
 119         [ _ swap remove ] when
 120     ] live? ;
 121
 122 PRIVATE>
 123
 124 :: live-out? ( vreg node -- ? )
 125     vreg def-of :> def
 126     {
 127         { [ node def eq? ] [ vreg uses-of def only? not ] }
 128         { [ def node strictly-dominates? ] [ vreg node (live-out?) ] }
 129         [ f ]
 130     } cond ;