94 lines
2.7 KiB
Factor
94 lines
2.7 KiB
Factor
|
! Copyright (C) 2008 Slava Pestov.
|
||
|
|
! See http://factorcode.org/license.txt for BSD license.
|
||
|
|
USING: kernel math accessors sequences namespaces make
|
||
|
|
combinators compiler.cfg compiler.cfg.rpo compiler.instructions
|
||
|
|
compiler.instructions.syntax ;
|
||
|
|
IN: compiler.cfg.linearization
|
||
|
|
|
||
|
|
! Convert CFG IR to machine IR.
|
||
|
|
SYMBOL: frame-size
|
||
|
|
|
||
|
|
: compute-frame-size ( rpo -- )
|
||
|
|
[ instructions>> [ %frame-required? ] filter ] map concat
|
||
|
|
[ f ] [ [ n>> ] map supremum ] if-empty
|
||
|
|
frame-size set ;
|
||
|
|
|
||
|
|
GENERIC: linearize-insn ( basic-block insn -- )
|
||
|
|
|
||
|
|
: linearize-insns ( basic-block -- )
|
||
|
|
dup instructions>> [ linearize-insn ] with each ; inline
|
||
|
|
|
||
|
|
M: insn linearize-insn , drop ;
|
||
|
|
|
||
|
|
M: %frame-required linearize-insn 2drop ;
|
||
|
|
|
||
|
|
M: %prologue linearize-insn
|
||
|
|
2drop frame-size get [ _prologue ] when* ;
|
||
|
|
|
||
|
|
M: %epilogue linearize-insn
|
||
|
|
2drop frame-size get [ _epilogue ] when* ;
|
||
|
|
|
||
|
|
: useless-branch? ( basic-block successor -- ? )
|
||
|
|
#! If our successor immediately follows us in RPO, then we
|
||
|
|
#! don't need to branch.
|
||
|
|
[ number>> 1+ ] [ number>> ] bi* = ; inline
|
||
|
|
|
||
|
|
: branch-to-return? ( successor -- ? )
|
||
|
|
#! A branch to a block containing just a return is cloned.
|
||
|
|
instructions>> dup length 2 = [
|
||
|
|
[ first %epilogue? ] [ second %return? ] bi and
|
||
|
|
] [ drop f ] if ;
|
||
|
|
|
||
|
|
: emit-branch ( basic-block successor -- )
|
||
|
|
{
|
||
|
|
{ [ 2dup useless-branch? ] [ 2drop ] }
|
||
|
|
{ [ dup branch-to-return? ] [ nip linearize-insns ] }
|
||
|
|
[ nip label>> _branch ]
|
||
|
|
} cond ;
|
||
|
|
|
||
|
|
M: %branch linearize-insn
|
||
|
|
drop dup successors>> first emit-branch ;
|
||
|
|
|
||
|
|
: conditional ( basic-block -- basic-block successor1 label2 )
|
||
|
|
dup successors>> first2 swap label>> ; inline
|
||
|
|
|
||
|
|
: boolean-conditional ( basic-block insn -- basic-block successor vreg label2 )
|
||
|
|
[ conditional ] [ vreg>> ] bi* swap ; inline
|
||
|
|
|
||
|
|
M: %branch-f linearize-insn
|
||
|
|
boolean-conditional _branch-f emit-branch ;
|
||
|
|
|
||
|
|
M: %branch-t linearize-insn
|
||
|
|
boolean-conditional _branch-t emit-branch ;
|
||
|
|
|
||
|
|
M: %if-intrinsic linearize-insn
|
||
|
|
[ conditional ] [ [ quot>> ] [ vregs>> ] bi ] bi*
|
||
|
|
_if-intrinsic emit-branch ;
|
||
|
|
|
||
|
|
M: %boolean-intrinsic linearize-insn
|
||
|
|
[
|
||
|
|
"false" define-label
|
||
|
|
"end" define-label
|
||
|
|
"false" get over [ quot>> ] [ vregs>> ] bi _if-intrinsic
|
||
|
|
t over out>> %load-literal
|
||
|
|
"end" get _branch
|
||
|
|
"false" resolve-label
|
||
|
|
f over out>> %load-literal
|
||
|
|
"end" resolve-label
|
||
|
|
] with-scope
|
||
|
|
2drop ;
|
||
|
|
|
||
|
|
: linearize-basic-block ( bb -- )
|
||
|
|
[ label>> _label ] [ linearize-insns ] bi ;
|
||
|
|
|
||
|
|
: linearize-basic-blocks ( rpo -- insns )
|
||
|
|
[ [ linearize-basic-block ] each ] { } make ;
|
||
|
|
|
||
|
|
: build-mr ( cfg -- mr )
|
||
|
|
[
|
||
|
|
entry>> reverse-post-order [
|
||
|
|
[ compute-frame-size ]
|
||
|
|
[ linearize-basic-blocks ] bi
|
||
|
|
] with-scope
|
||
|
|
] [ word>> ] [ label>> ] tri <mr> ;
|