basis/compiler/cfg/linearization/linearization.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel math accessors sequences namespaces make
   4 combinators assocs arrays locals layouts hashtables
   5 cpu.architecture generalizations
   6 compiler.cfg
   7 compiler.cfg.comparisons
   8 compiler.cfg.stack-frame
   9 compiler.cfg.instructions
  10 compiler.cfg.utilities
  11 compiler.cfg.linearization.order ;
  12 IN: compiler.cfg.linearization
  13
  14 <PRIVATE
  15
  16 SYMBOL: numbers
  17
  18 : block-number ( bb -- n ) numbers get at ;
  19
  20 : number-blocks ( bbs -- ) [ 2array ] map-index >hashtable numbers set ;
  21
  22 GENERIC: linearize-insn ( basic-block insn -- )
  23
  24 M: insn linearize-insn , drop ;
  25
  26 : useless-branch? ( basic-block successor -- ? )
  27     ! If our successor immediately follows us in linearization
  28     ! order then we don't need to branch.
  29     [ block-number ] bi@ 1 - = ; inline
  30
  31 : emit-branch ( bb successor -- )
  32     2dup useless-branch? [ 2drop ] [ nip block-number _branch ] if ;
  33
  34 M: ##branch linearize-insn
  35     drop dup successors>> first emit-branch ;
  36
  37 GENERIC: negate-insn-cc ( insn -- )
  38
  39 M: conditional-branch-insn negate-insn-cc
  40     [ negate-cc ] change-cc drop ;
  41
  42 M: ##test-vector-branch negate-insn-cc
  43     [ negate-vcc ] change-vcc drop ;
  44
  45 M:: conditional-branch-insn linearize-insn ( bb insn -- )
  46     bb successors>> first2 :> ( first second )
  47     bb second useless-branch?
  48     [ bb second first ]
  49     [ bb first second insn negate-insn-cc ] if
  50     block-number insn _conditional-branch
  51     emit-branch ;
  52
  53 M: ##dispatch linearize-insn
  54     , successors>> [ block-number _dispatch-label ] each ;
  55
  56 : linearize-basic-block ( bb -- )
  57     [ block-number _label ]
  58     [ dup instructions>> [ linearize-insn ] with each ]
  59     bi ;
  60
  61 : linearize-basic-blocks ( cfg -- insns )
  62     [
  63         [
  64             linearization-order
  65             [ number-blocks ]
  66             [ [ linearize-basic-block ] each ] bi
  67         ] [ spill-area-size>> _spill-area-size ] bi
  68     ] { } make ;
  69
  70 PRIVATE>
  71
  72 : flatten-cfg ( cfg -- mr )
  73     [ linearize-basic-blocks ] [ word>> ] [ label>> ] tri
  74     <mr> ;