basis/compiler/cfg/dce/dce.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov, Daniel Ehrenberg.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays assocs combinators compiler.cfg.def-use
   4 compiler.cfg.instructions compiler.cfg.predecessors
   5 compiler.cfg.rpo kernel namespaces sequences sets ;
   6 FROM: namespaces => set ;
   7 IN: compiler.cfg.dce
   8
   9 ! Maps vregs to sequences of vregs
  10 SYMBOL: liveness-graph
  11
  12 ! vregs which participate in side effects and thus are always live
  13 SYMBOL: live-vregs
  14
  15 : live-vreg? ( vreg -- ? )
  16     live-vregs get in? ;
  17
  18 ! vregs which are the result of an allocation
  19 SYMBOL: allocations
  20
  21 : allocation? ( vreg -- ? )
  22     allocations get in? ;
  23
  24 : init-dead-code ( -- )
  25     H{ } clone liveness-graph set
  26     HS{ } clone live-vregs set
  27     HS{ } clone allocations set ;
  28
  29 GENERIC: build-liveness-graph ( insn -- )
  30
  31 : add-edges ( uses def -- )
  32     liveness-graph get [ union ] change-at ;
  33
  34 : setter-liveness-graph ( insn vreg -- )
  35     dup allocation? [ [ uses-vregs ] dip add-edges ] [ 2drop ] if ;
  36
  37 M: ##set-slot build-liveness-graph
  38     dup obj>> setter-liveness-graph ;
  39
  40 M: ##set-slot-imm build-liveness-graph
  41     dup obj>> setter-liveness-graph ;
  42
  43 M: ##write-barrier build-liveness-graph
  44     dup src>> setter-liveness-graph ;
  45
  46 M: ##write-barrier-imm build-liveness-graph
  47     dup src>> setter-liveness-graph ;
  48
  49 M: ##allot build-liveness-graph
  50     [ dst>> allocations get adjoin ] [ call-next-method ] bi ;
  51
  52 M: vreg-insn build-liveness-graph
  53     [ uses-vregs ] [ defs-vregs ] bi [ add-edges ] with each ;
  54
  55 M: insn build-liveness-graph drop ;
  56
  57 GENERIC: compute-live-vregs ( insn -- )
  58
  59 : (record-live) ( vregs -- )
  60     [
  61         dup live-vregs get ?adjoin [
  62             liveness-graph get at (record-live)
  63         ] [ drop ] if
  64     ] each ;
  65
  66 : record-live ( insn -- )
  67     uses-vregs (record-live) ;
  68
  69 : setter-live-vregs ( insn vreg -- )
  70     allocation? [ drop ] [ record-live ] if ;
  71
  72 M: ##set-slot compute-live-vregs
  73     dup obj>> setter-live-vregs ;
  74
  75 M: ##set-slot-imm compute-live-vregs
  76     dup obj>> setter-live-vregs ;
  77
  78 M: ##write-barrier compute-live-vregs
  79     dup src>> setter-live-vregs ;
  80
  81 M: ##write-barrier-imm compute-live-vregs
  82     dup src>> setter-live-vregs ;
  83
  84 M: flushable-insn compute-live-vregs drop ;
  85
  86 M: vreg-insn compute-live-vregs record-live ;
  87
  88 M: insn compute-live-vregs drop ;
  89
  90 GENERIC: live-insn? ( insn -- ? )
  91
  92 M: ##set-slot live-insn? obj>> live-vreg? ;
  93
  94 M: ##set-slot-imm live-insn? obj>> live-vreg? ;
  95
  96 M: ##write-barrier live-insn? src>> live-vreg? ;
  97
  98 M: ##write-barrier-imm live-insn? src>> live-vreg? ;
  99
 100 : filter-alien-outputs ( outputs -- live-outputs dead-outputs )
 101     [ first live-vreg? ] partition
 102     [ first3 2array nip ] map ;
 103
 104 M: alien-call-insn live-insn?
 105     dup reg-outputs>> filter-alien-outputs [ >>reg-outputs ] [ >>dead-outputs ] bi*
 106     drop t ;
 107
 108 M: ##callback-inputs live-insn?
 109     [ filter-alien-outputs drop ] change-reg-outputs
 110     [ filter-alien-outputs drop ] change-stack-outputs
 111     drop t ;
 112
 113 M: flushable-insn live-insn? defs-vregs [ live-vreg? ] any? ;
 114
 115 M: insn live-insn? drop t ;
 116
 117 : eliminate-dead-code ( cfg -- )
 118     init-dead-code
 119     {
 120         [ needs-predecessors ]
 121         [ [ [ build-liveness-graph ] each ] simple-analysis ]
 122         [ [ [ compute-live-vregs ] each ] simple-analysis ]
 123         [ [ [ live-insn? ] filter! ] simple-optimization ]
 124     } cleave ;