2010-07-27 23:58:41 -04:00
|
|
|
! Copyright (C) 2009 Slava Pestov.
|
2009-07-16 03:17:58 -04:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2014-12-13 19:10:21 -05:00
|
|
|
USING: accessors combinators combinators.short-circuit
|
|
|
|
compiler.cfg compiler.cfg.predecessors compiler.cfg.rpo
|
|
|
|
compiler.cfg.utilities kernel sequences ;
|
2009-07-16 03:17:58 -04:00
|
|
|
IN: compiler.cfg.block-joining
|
|
|
|
|
|
|
|
: join-block? ( bb -- ? )
|
|
|
|
{
|
2010-05-09 21:36:52 -04:00
|
|
|
[ kill-block?>> not ]
|
2009-07-16 03:17:58 -04:00
|
|
|
[ predecessors>> length 1 = ]
|
2010-05-09 21:36:52 -04:00
|
|
|
[ predecessor kill-block?>> not ]
|
2009-07-16 03:17:58 -04:00
|
|
|
[ predecessor successors>> length 1 = ]
|
|
|
|
[ [ predecessor ] keep back-edge? not ]
|
|
|
|
} 1&& ;
|
|
|
|
|
|
|
|
: join-instructions ( bb pred -- )
|
|
|
|
[ instructions>> ] bi@ dup pop* push-all ;
|
|
|
|
|
|
|
|
: update-successors ( bb pred -- )
|
2010-05-05 16:52:54 -04:00
|
|
|
[ successors>> ] dip successors<< ;
|
2009-07-16 03:17:58 -04:00
|
|
|
|
|
|
|
: join-block ( bb pred -- )
|
2010-07-27 23:58:41 -04:00
|
|
|
[ join-instructions ] [ update-successors ] 2bi ;
|
2009-07-16 03:17:58 -04:00
|
|
|
|
2014-12-07 21:36:52 -05:00
|
|
|
: join-blocks ( cfg -- )
|
2014-12-10 12:24:12 -05:00
|
|
|
{
|
|
|
|
[ needs-predecessors ]
|
|
|
|
[
|
|
|
|
post-order [
|
|
|
|
dup join-block?
|
|
|
|
[ dup predecessor join-block ] [ drop ] if
|
|
|
|
] each
|
|
|
|
]
|
|
|
|
[ cfg-changed ]
|
|
|
|
[ predecessors-changed ]
|
|
|
|
} cleave ;
|