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