extra/compiler/cfg/gvn/gvn.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: namespaces arrays assocs hashtables kernel accessors fry
   4 grouping sorting sets sequences locals
   5 cpu.architecture
   6 sequences.deep
   7 compiler.cfg
   8 compiler.cfg.rpo
   9 compiler.cfg.def-use
  10 compiler.cfg.utilities
  11 compiler.cfg.instructions
  12 compiler.cfg.predecessors
  13 compiler.cfg.gvn.alien
  14 compiler.cfg.gvn.avail
  15 compiler.cfg.gvn.comparisons
  16 compiler.cfg.gvn.graph
  17 compiler.cfg.gvn.math
  18 compiler.cfg.gvn.rewrite
  19 compiler.cfg.gvn.slots
  20 compiler.cfg.gvn.misc
  21 compiler.cfg.gvn.expressions ;
  22 IN: compiler.cfg.gvn
  23
  24 GENERIC: process-instruction ( insn -- insn' )
  25
  26 : redundant-instruction ( insn vn -- insn' )
  27     [ dst>> ] dip [ swap set-vn ] [ <copy> ] 2bi ;
  28
  29 :: useful-instruction ( insn expr -- insn' )
  30     insn dst>> :> vn
  31     vn vn set-vn
  32     vn expr exprs>vns get set-at
  33     insn vn vns>insns get set-at
  34     insn ;
  35
  36 : check-redundancy ( insn -- insn' )
  37     dup >expr dup exprs>vns get at
  38     [ redundant-instruction ] [ useful-instruction ] ?if ;
  39
  40 M: insn process-instruction
  41     dup rewrite
  42     [ process-instruction ]
  43     [ dup defs-vregs length 1 = [ check-redundancy ] when ] ?if ;
  44
  45 UNION: don't-check-redundancy alien-call-insn ##callback-inputs ;
  46
  47 M: don't-check-redundancy process-instruction
  48     dup rewrite [ process-instruction ] [ ] ?if ;
  49
  50 M: ##copy process-instruction
  51     dup [ src>> vreg>vn ] [ dst>> ] bi set-vn ;
  52
  53 M: array process-instruction
  54     [ process-instruction ] map ;
  55
  56 : value-numbering-step ( insns -- insns' )
  57     [ process-instruction ] map flatten ;
  58
  59 : value-numbering-iteration ( cfg -- )
  60     clear-exprs
  61     [ value-numbering-step drop ] simple-analysis ;
  62
  63 : identify-redundancies ( cfg -- )
  64     final-iteration? off
  65     ! dup compute-avail-sets
  66     init-value-graph
  67     '[
  68         changed? off
  69         _ value-numbering-iteration
  70         changed? get
  71     ] loop ;
  72
  73 : eliminate-redundancies ( cfg -- )
  74     final-iteration? on
  75     ! dup compute-avail-sets
  76     clear-exprs
  77     [ value-numbering-step ] simple-optimization ;
  78
  79 USE: prettyprint
  80
  81 : value-numbering ( cfg -- cfg )
  82     needs-predecessors
  83
  84     dup compute-avail-sets
  85
  86     ! avail-ins get [ [ number>> ] [ keys ] bi* ] assoc-map .
  87
  88     dup identify-redundancies
  89     dup eliminate-redundancies
  90
  91     cfg-changed predecessors-changed ;