basis/compiler/cfg/ssa/interference/live-ranges/live-ranges.factor

   1 ! Copyright (C) 2009, 2010 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: assocs compiler.cfg compiler.cfg.def-use
   4 compiler.cfg.dominance compiler.cfg.instructions
   5 compiler.cfg.liveness compiler.cfg.rpo kernel math namespaces
   6 sequences ;
   7 IN: compiler.cfg.ssa.interference.live-ranges
   8
   9 <PRIVATE
  10
  11 SYMBOLS: local-def-indices local-kill-indices ;
  12
  13 : record-defs ( n insn -- )
  14     defs-vregs [ local-def-indices get set-at ] with each ;
  15
  16 : record-uses ( n insn -- )
  17     dup uses-vregs [ 2drop ] [
  18         swap def-is-use-insn?
  19         [ [ first local-kill-indices get set-at ] [ rest-slice ] 2bi ] unless
  20         [ 1 + ] dip [ local-kill-indices get set-at ] with each
  21     ] if-empty ;
  22
  23 GENERIC: record-insn ( n insn -- )
  24
  25 M: ##phi record-insn
  26     record-defs ;
  27
  28 M: ##parallel-copy record-insn
  29     [ 2 * ] dip
  30     [ record-defs ]
  31     [ uses-vregs [ local-kill-indices get set-at ] with each ]
  32     2bi ;
  33
  34 M: vreg-insn record-insn
  35     [ 2 * ] dip [ record-defs ] [ record-uses ] 2bi ;
  36
  37 M: insn record-insn
  38     2drop ;
  39
  40 SYMBOLS: def-indices kill-indices ;
  41
  42 : compute-local-live-ranges ( insns -- )
  43     H{ } clone local-def-indices set
  44     H{ } clone local-kill-indices set
  45     [ swap record-insn ] each-index
  46     local-def-indices get basic-block get def-indices get set-at
  47     local-kill-indices get basic-block get kill-indices get set-at ;
  48
  49 PRIVATE>
  50
  51 : compute-live-ranges ( cfg -- )
  52     H{ } clone def-indices set
  53     H{ } clone kill-indices set
  54     [ needs-dominance ]
  55     [ [ compute-local-live-ranges ] simple-analysis ] bi ;
  56
  57 : def-index ( vreg bb -- n )
  58     def-indices get at at ;
  59
  60 ERROR: bad-kill-index vreg bb ;
  61
  62 : kill-index ( vreg bb -- n )
  63     2dup live-out? [ 2drop 1/0. ] [
  64         2dup kill-indices get at at* [ 2nip ] [
  65             drop 2dup live-in?
  66             [ bad-kill-index ] [ 2drop -1/0. ] if
  67         ] if
  68     ] if ;