basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor

   1 ! Copyright (C) 2008, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: namespaces kernel assocs accessors sequences math math.order fry
   4 combinators binary-search compiler.cfg.instructions compiler.cfg.registers
   5 compiler.cfg.def-use compiler.cfg.liveness compiler.cfg.rpo
   6 compiler.cfg ;
   7 IN: compiler.cfg.linear-scan.live-intervals
   8
   9 TUPLE: live-range from to ;
  10
  11 C: <live-range> live-range
  12
  13 TUPLE: live-interval
  14 vreg
  15 reg spill-to reload-from
  16 split-before split-after split-next
  17 start end ranges uses
  18 copy-from ;
  19
  20 GENERIC: covers? ( insn# obj -- ? )
  21
  22 M: f covers? 2drop f ;
  23
  24 M: live-range covers? [ from>> ] [ to>> ] bi between? ;
  25
  26 M: live-interval covers? ( insn# live-interval -- ? )
  27     ranges>>
  28     dup length 4 <= [
  29         [ covers? ] with any?
  30     ] [
  31         [ drop ] [ [ from>> <=> ] with search nip ] 2bi
  32         covers?
  33     ] if ;
  34
  35 ERROR: dead-value-error vreg ;
  36
  37 : shorten-range ( n live-interval -- )
  38     dup ranges>> empty?
  39     [ vreg>> dead-value-error ] [ ranges>> last (>>from) ] if ;
  40
  41 : extend-range ( from to live-range -- )
  42     ranges>> last
  43     [ max ] change-to
  44     [ min ] change-from
  45     drop ;
  46
  47 : add-new-range ( from to live-interval -- )
  48     [ <live-range> ] dip ranges>> push ;
  49
  50 : extend-range? ( to live-interval -- ? )
  51     ranges>> [ drop f ] [ last from>> >= ] if-empty ;
  52
  53 : add-range ( from to live-interval -- )
  54     2dup extend-range?
  55     [ extend-range ] [ add-new-range ] if ;
  56
  57 : add-use ( n live-interval -- )
  58     uses>> push ;
  59
  60 : <live-interval> ( vreg -- live-interval )
  61     \ live-interval new
  62         V{ } clone >>uses
  63         V{ } clone >>ranges
  64         swap >>vreg ;
  65
  66 : block-from ( bb -- n ) instructions>> first insn#>> 1 - ;
  67
  68 : block-to ( bb -- n ) instructions>> last insn#>> ;
  69
  70 M: live-interval hashcode*
  71     nip [ start>> ] [ end>> 1000 * ] bi + ;
  72
  73 M: live-interval clone
  74     call-next-method [ clone ] change-uses ;
  75
  76 ! Mapping from vreg to live-interval
  77 SYMBOL: live-intervals
  78
  79 : live-interval ( vreg live-intervals -- live-interval )
  80     [ <live-interval> ] cache ;
  81
  82 GENERIC: compute-live-intervals* ( insn -- )
  83
  84 M: insn compute-live-intervals* drop ;
  85
  86 : handle-output ( n vreg live-intervals -- )
  87     live-interval
  88     [ add-use ] [ shorten-range ] 2bi ;
  89
  90 : handle-input ( n vreg live-intervals -- )
  91     live-interval
  92     [ [ basic-block get block-from ] 2dip add-range ] [ add-use ] 2bi ;
  93
  94 : handle-temp ( n vreg live-intervals -- )
  95     live-interval
  96     [ dupd add-range ] [ add-use ] 2bi ;
  97
  98 M: vreg-insn compute-live-intervals*
  99     dup insn#>>
 100     live-intervals get
 101     [ [ defs-vregs ] 2dip '[ [ _ ] dip _ handle-output ] each ]
 102     [ [ uses-vregs ] 2dip '[ [ _ ] dip _ handle-input ] each ]
 103     [ [ temp-vregs ] 2dip '[ [ _ ] dip _ handle-temp ] each ]
 104     3tri ;
 105
 106 : record-copy ( insn -- )
 107     [ dst>> live-intervals get at ] [ src>> ] bi >>copy-from drop ;
 108
 109 M: ##copy compute-live-intervals*
 110     [ call-next-method ] [ record-copy ] bi ;
 111
 112 M: ##copy-float compute-live-intervals*
 113     [ call-next-method ] [ record-copy ] bi ;
 114
 115 : handle-live-out ( bb -- )
 116     live-out keys
 117     basic-block get [ block-from ] [ block-to ] bi
 118     live-intervals get '[
 119         [ _ _ ] dip _ live-interval add-range
 120     ] each ;
 121
 122 : compute-live-intervals-step ( bb -- )
 123     [ basic-block set ]
 124     [ handle-live-out ]
 125     [ instructions>> <reversed> [ compute-live-intervals* ] each ] tri ;
 126
 127 : compute-start/end ( live-interval -- )
 128     dup ranges>> [ first from>> ] [ last to>> ] bi
 129     [ >>start ] [ >>end ] bi* drop ;
 130
 131 ERROR: bad-live-interval live-interval ;
 132
 133 : check-start ( live-interval -- )
 134     dup start>> -1 = [ bad-live-interval ] [ drop ] if ;
 135
 136 : finish-live-intervals ( live-intervals -- )
 137     ! Since live intervals are computed in a backward order, we have
 138     ! to reverse some sequences, and compute the start and end.
 139     [
 140         {
 141             [ ranges>> reverse-here ]
 142             [ uses>> reverse-here ]
 143             [ compute-start/end ]
 144             [ check-start ]
 145         } cleave
 146     ] each ;
 147
 148 : compute-live-intervals ( cfg -- live-intervals )
 149     H{ } clone [
 150         live-intervals set
 151         post-order [ compute-live-intervals-step ] each
 152     ] keep values dup finish-live-intervals ;
 153
 154 : relevant-ranges ( interval1 interval2 -- ranges1 ranges2 )
 155     [ [ ranges>> ] bi@ ] [ nip start>> ] 2bi '[ to>> _ >= ] filter ;
 156
 157 : intersect-live-range ( range1 range2 -- n/f )
 158     2dup [ from>> ] bi@ > [ swap ] when
 159     2dup [ to>> ] [ from>> ] bi* >= [ nip from>> ] [ 2drop f ] if ;
 160
 161 : intersect-live-ranges ( ranges1 ranges2 -- n )
 162     {
 163         { [ over empty? ] [ 2drop f ] }
 164         { [ dup empty? ] [ 2drop f ] }
 165         [
 166             2dup [ first ] bi@ intersect-live-range dup [ 2nip ] [
 167                 drop
 168                 2dup [ first from>> ] bi@ <
 169                 [ [ rest-slice ] dip ] [ rest-slice ] if
 170                 intersect-live-ranges
 171             ] if
 172         ]
 173     } cond ;
 174
 175 : intervals-intersect? ( interval1 interval2 -- ? )
 176     relevant-ranges intersect-live-ranges >boolean ; inline