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