114 lines
3.5 KiB
Factor
114 lines
3.5 KiB
Factor
! Copyright (C) 2008, 2009 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: kernel math accessors sequences namespaces make
|
|
combinators assocs arrays locals layouts hashtables
|
|
cpu.architecture generalizations
|
|
compiler.cfg
|
|
compiler.cfg.comparisons
|
|
compiler.cfg.stack-frame
|
|
compiler.cfg.instructions
|
|
compiler.cfg.utilities
|
|
compiler.cfg.linearization.order ;
|
|
IN: compiler.cfg.linearization
|
|
|
|
<PRIVATE
|
|
|
|
SYMBOL: numbers
|
|
|
|
: block-number ( bb -- n ) numbers get at ;
|
|
|
|
: number-blocks ( bbs -- ) [ 2array ] map-index >hashtable numbers set ;
|
|
|
|
! Convert CFG IR to machine IR.
|
|
GENERIC: linearize-insn ( basic-block insn -- )
|
|
|
|
: linearize-basic-block ( bb -- )
|
|
[ block-number _label ]
|
|
[ dup instructions>> [ linearize-insn ] with each ]
|
|
bi ;
|
|
|
|
M: insn linearize-insn , drop ;
|
|
|
|
: useless-branch? ( basic-block successor -- ? )
|
|
! If our successor immediately follows us in linearization
|
|
! order then we don't need to branch.
|
|
[ block-number ] bi@ 1 - = ; inline
|
|
|
|
: emit-branch ( bb successor -- )
|
|
2dup useless-branch? [ 2drop ] [ nip block-number _branch ] if ;
|
|
|
|
M: ##branch linearize-insn
|
|
drop dup successors>> first emit-branch ;
|
|
|
|
: successors ( bb -- first second ) successors>> first2 ; inline
|
|
|
|
:: conditional ( bb insn n conditional-quot negate-cc-quot -- bb successor label etc... )
|
|
bb insn
|
|
conditional-quot
|
|
[ drop dup successors>> second useless-branch? ] 2bi
|
|
[ [ swap block-number ] n ndip ]
|
|
[ [ block-number ] n ndip negate-cc-quot call ] if ; inline
|
|
|
|
: (binary-conditional) ( bb insn -- bb successor1 successor2 src1 src2 cc )
|
|
[ dup successors ]
|
|
[ [ src1>> ] [ src2>> ] [ cc>> ] tri ] bi* ; inline
|
|
|
|
: binary-conditional ( bb insn -- bb successor label2 src1 src2 cc )
|
|
3 [ (binary-conditional) ] [ negate-cc ] conditional ;
|
|
|
|
: (test-vector-conditional) ( bb insn -- bb successor1 successor2 src1 temp rep vcc )
|
|
[ dup successors ]
|
|
[ { [ src1>> ] [ temp>> ] [ rep>> ] [ vcc>> ] } cleave ] bi* ; inline
|
|
|
|
: test-vector-conditional ( bb insn -- bb successor label src1 temp rep vcc )
|
|
4 [ (test-vector-conditional) ] [ negate-vcc ] conditional ;
|
|
|
|
M: ##compare-branch linearize-insn
|
|
binary-conditional _compare-branch emit-branch ;
|
|
|
|
M: ##compare-imm-branch linearize-insn
|
|
binary-conditional _compare-imm-branch emit-branch ;
|
|
|
|
M: ##compare-float-ordered-branch linearize-insn
|
|
binary-conditional _compare-float-ordered-branch emit-branch ;
|
|
|
|
M: ##compare-float-unordered-branch linearize-insn
|
|
binary-conditional _compare-float-unordered-branch emit-branch ;
|
|
|
|
M: ##test-vector-branch linearize-insn
|
|
test-vector-conditional _test-vector-branch emit-branch ;
|
|
|
|
: overflow-conditional ( bb insn -- bb successor label2 dst src1 src2 )
|
|
[ dup successors block-number ]
|
|
[ [ dst>> ] [ src1>> ] [ src2>> ] tri ] bi* ; inline
|
|
|
|
M: ##fixnum-add linearize-insn
|
|
overflow-conditional _fixnum-add emit-branch ;
|
|
|
|
M: ##fixnum-sub linearize-insn
|
|
overflow-conditional _fixnum-sub emit-branch ;
|
|
|
|
M: ##fixnum-mul linearize-insn
|
|
overflow-conditional _fixnum-mul emit-branch ;
|
|
|
|
M: ##dispatch linearize-insn
|
|
swap
|
|
[ [ src>> ] [ temp>> ] bi _dispatch ]
|
|
[ successors>> [ block-number _dispatch-label ] each ]
|
|
bi* ;
|
|
|
|
: linearize-basic-blocks ( cfg -- insns )
|
|
[
|
|
[
|
|
linearization-order
|
|
[ number-blocks ]
|
|
[ [ linearize-basic-block ] each ] bi
|
|
] [ spill-area-size>> _spill-area-size ] bi
|
|
] { } make ;
|
|
|
|
PRIVATE>
|
|
|
|
: flatten-cfg ( cfg -- mr )
|
|
[ linearize-basic-blocks ] [ word>> ] [ label>> ] tri
|
|
<mr> ;
|