basis/compiler/cfg/linearization/linearization.factor

   1 ! Copyright (C) 2008, 2009 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 ! Convert CFG IR to machine IR.
  23 GENERIC: linearize-insn ( basic-block insn -- )
  24
  25 : linearize-basic-block ( bb -- )
  26     [ block-number _label ]
  27     [ dup instructions>> [ linearize-insn ] with each ]
  28     bi ;
  29
  30 M: insn linearize-insn , drop ;
  31
  32 : useless-branch? ( basic-block successor -- ? )
  33     ! If our successor immediately follows us in linearization
  34     ! order then we don't need to branch.
  35     [ block-number ] bi@ 1 - = ; inline
  36
  37 : emit-branch ( bb successor -- )
  38     2dup useless-branch? [ 2drop ] [ nip block-number _branch ] if ;
  39
  40 M: ##branch linearize-insn
  41     drop dup successors>> first emit-branch ;
  42
  43 : successors ( bb -- first second ) successors>> first2 ; inline
  44
  45 :: conditional ( bb insn n conditional-quot negate-cc-quot -- bb successor label ... )
  46     bb insn
  47     conditional-quot
  48     [ drop dup successors>> second useless-branch? ] 2bi
  49     [ [ swap block-number ] n ndip ]
  50     [ [ block-number ] n ndip negate-cc-quot call ] if ; inline
  51
  52 : (binary-conditional) ( bb insn -- bb successor1 successor2 src1 src2 cc )
  53     [ dup successors ]
  54     [ [ src1>> ] [ src2>> ] [ cc>> ] tri ] bi* ; inline
  55
  56 : binary-conditional ( bb insn -- bb successor label2 src1 src2 cc )
  57     3 [ (binary-conditional) ] [ negate-cc ] conditional ;
  58
  59 : (test-vector-conditional) ( bb insn -- bb successor1 successor2 src1 temp rep vcc )
  60     [ dup successors ]
  61     [ { [ src1>> ] [ temp>> ] [ rep>> ] [ vcc>> ] } cleave ] bi* ; inline
  62
  63 : test-vector-conditional ( bb insn -- bb successor label src1 temp rep vcc )
  64     4 [ (test-vector-conditional) ] [ negate-vcc ] conditional ;
  65
  66 M: ##compare-branch linearize-insn
  67     binary-conditional _compare-branch emit-branch ;
  68
  69 M: ##compare-imm-branch linearize-insn
  70     binary-conditional _compare-imm-branch emit-branch ;
  71
  72 M: ##compare-float-ordered-branch linearize-insn
  73     binary-conditional _compare-float-ordered-branch emit-branch ;
  74
  75 M: ##compare-float-unordered-branch linearize-insn
  76     binary-conditional _compare-float-unordered-branch emit-branch ;
  77
  78 M: ##test-vector-branch linearize-insn
  79     test-vector-conditional _test-vector-branch emit-branch ;
  80
  81 : overflow-conditional ( bb insn -- bb successor label2 dst src1 src2 )
  82     [ dup successors block-number ]
  83     [ [ dst>> ] [ src1>> ] [ src2>> ] tri ] bi* ; inline
  84
  85 M: ##fixnum-add linearize-insn
  86     overflow-conditional _fixnum-add emit-branch ;
  87
  88 M: ##fixnum-sub linearize-insn
  89     overflow-conditional _fixnum-sub emit-branch ;
  90
  91 M: ##fixnum-mul linearize-insn
  92     overflow-conditional _fixnum-mul emit-branch ;
  93
  94 M: ##dispatch linearize-insn
  95     swap
  96     [ [ src>> ] [ temp>> ] bi _dispatch ]
  97     [ successors>> [ block-number _dispatch-label ] each ]
  98     bi* ;
  99
 100 : linearize-basic-blocks ( cfg -- insns )
 101     [
 102         [
 103             linearization-order
 104             [ number-blocks ]
 105             [ [ linearize-basic-block ] each ] bi
 106         ] [ spill-area-size>> _spill-area-size ] bi
 107     ] { } make ;
 108
 109 PRIVATE>
 110
 111 : flatten-cfg ( cfg -- mr )
 112     [ linearize-basic-blocks ] [ word>> ] [ label>> ] tri
 113     <mr> ;