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

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs fry kernel namespaces sequences math
   4 arrays compiler.cfg.def-use compiler.cfg.instructions
   5 compiler.cfg.liveness.ssa compiler.cfg.rpo compiler.cfg.dominance ;
   6 IN: compiler.cfg.ssa.interference.live-ranges
   7
   8 ! Live ranges for interference testing
   9
  10 <PRIVATE
  11
  12 SYMBOLS: local-def-indices local-kill-indices ;
  13
  14 : record-def ( n insn -- )
  15     ! We allow multiple defs of a vreg as long as they're
  16     ! all in the same basic block
  17     defs-vreg dup [
  18         local-def-indices get 2dup key?
  19         [ 3drop ] [ set-at ] if
  20     ] [ 2drop ] if ;
  21
  22 : record-uses ( n insn -- )
  23     ! Record live intervals so that all but the first input interfere
  24     ! with the output. This lets us coalesce the output with the
  25     ! first input.
  26     [ uses-vregs ] [ def-is-use-insn? ] bi over empty? [ 3drop ] [
  27         [ [ first local-kill-indices get set-at ] [ rest-slice ] 2bi ] unless
  28         [ 1 + ] dip [ local-kill-indices get set-at ] with each
  29     ] if ;
  30
  31 : visit-insn ( insn n -- )
  32     2 * swap [ record-def ] [ record-uses ] 2bi ;
  33
  34 SYMBOLS: def-indices kill-indices ;
  35
  36 : compute-local-live-ranges ( bb -- )
  37     H{ } clone local-def-indices set
  38     H{ } clone local-kill-indices set
  39     [ instructions>> [ visit-insn ] each-index ]
  40     [ [ local-def-indices get ] dip def-indices get set-at ]
  41     [ [ local-kill-indices get ] dip kill-indices get set-at ]
  42     tri ;
  43
  44 PRIVATE>
  45
  46 : compute-live-ranges ( cfg -- )
  47     needs-dominance
  48
  49     H{ } clone def-indices set
  50     H{ } clone kill-indices set
  51     [ compute-local-live-ranges ] each-basic-block ;
  52
  53 : def-index ( vreg bb -- n )
  54     def-indices get at at ;
  55
  56 ERROR: bad-kill-index vreg bb ;
  57
  58 : kill-index ( vreg bb -- n )
  59     2dup live-out? [ 2drop 1/0. ] [
  60         2dup kill-indices get at at* [ 2nip ] [
  61             drop 2dup live-in?
  62             [ bad-kill-index ] [ 2drop -1/0. ] if
  63         ] if
  64     ] if ;