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
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
18 : block-number ( bb -- n ) numbers get at ;
20 : number-blocks ( bbs -- ) [ 2array ] map-index >hashtable numbers set ;
22 ! Convert CFG IR to machine IR.
23 GENERIC: linearize-insn ( basic-block insn -- )
25 : linearize-basic-block ( bb -- )
26 [ block-number _label ]
27 [ dup instructions>> [ linearize-insn ] with each ]
30 M: insn linearize-insn , drop ;
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
37 : emit-branch ( bb successor -- )
38 2dup useless-branch? [ 2drop ] [ nip block-number _branch ] if ;
40 M: ##branch linearize-insn
41 drop dup successors>> first emit-branch ;
43 : successors ( bb -- first second ) successors>> first2 ; inline
45 :: conditional ( bb insn n conditional-quot negate-cc-quot -- bb successor label ... )
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
52 : (binary-conditional) ( bb insn -- bb successor1 successor2 src1 src2 cc )
54 [ [ src1>> ] [ src2>> ] [ cc>> ] tri ] bi* ; inline
56 : binary-conditional ( bb insn -- bb successor label2 src1 src2 cc )
57 3 [ (binary-conditional) ] [ negate-cc ] conditional ;
59 : (test-vector-conditional) ( bb insn -- bb successor1 successor2 src1 temp rep vcc )
61 [ { [ src1>> ] [ temp>> ] [ rep>> ] [ vcc>> ] } cleave ] bi* ; inline
63 : test-vector-conditional ( bb insn -- bb successor label src1 temp rep vcc )
64 4 [ (test-vector-conditional) ] [ negate-vcc ] conditional ;
66 M: ##compare-branch linearize-insn
67 binary-conditional _compare-branch emit-branch ;
69 M: ##compare-imm-branch linearize-insn
70 binary-conditional _compare-imm-branch emit-branch ;
72 M: ##compare-float-ordered-branch linearize-insn
73 binary-conditional _compare-float-ordered-branch emit-branch ;
75 M: ##compare-float-unordered-branch linearize-insn
76 binary-conditional _compare-float-unordered-branch emit-branch ;
78 M: ##test-vector-branch linearize-insn
79 test-vector-conditional _test-vector-branch emit-branch ;
81 : overflow-conditional ( bb insn -- bb successor label2 dst src1 src2 )
82 [ dup successors block-number ]
83 [ [ dst>> ] [ src1>> ] [ src2>> ] tri ] bi* ; inline
85 M: ##fixnum-add linearize-insn
86 overflow-conditional _fixnum-add emit-branch ;
88 M: ##fixnum-sub linearize-insn
89 overflow-conditional _fixnum-sub emit-branch ;
91 M: ##fixnum-mul linearize-insn
92 overflow-conditional _fixnum-mul emit-branch ;
94 M: ##dispatch linearize-insn
96 [ [ src>> ] [ temp>> ] bi _dispatch ]
97 [ successors>> [ block-number _dispatch-label ] each ]
100 : gc-root-offsets ( registers -- alist )
101 ! Outputs a sequence of { offset register/spill-slot } pairs
102 [ length iota [ cell * ] map ] keep zip ;
104 M: ##gc linearize-insn
110 [ tagged-values>> gc-root-offsets ]
111 [ uninitialized-locs>> ]
115 : linearize-basic-blocks ( cfg -- insns )
120 [ [ linearize-basic-block ] each ] bi
121 ] [ spill-area-size>> _spill-area-size ] bi
126 : flatten-cfg ( cfg -- mr )
127 [ linearize-basic-blocks ] [ word>> ] [ label>> ] tri