diff --git a/basis/compiler/cfg/block-joining/block-joining.factor b/basis/compiler/cfg/block-joining/block-joining.factor index 54cff306ed..1005e35d03 100644 --- a/basis/compiler/cfg/block-joining/block-joining.factor +++ b/basis/compiler/cfg/block-joining/block-joining.factor @@ -1,7 +1,8 @@ -! Copyright (C) 2009 Slava Pestov. +! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors combinators.short-circuit kernel sequences math -compiler.utilities compiler.cfg compiler.cfg.instructions compiler.cfg.rpo +USING: accessors combinators.short-circuit kernel namespaces +sequences math compiler.utilities compiler.cfg +compiler.cfg.instructions compiler.cfg.rpo compiler.cfg.predecessors compiler.cfg.utilities ; IN: compiler.cfg.block-joining @@ -23,15 +24,23 @@ IN: compiler.cfg.block-joining : update-successors ( bb pred -- ) [ successors>> ] dip successors<< ; +: join-unlikely ( bb pred -- ) + over unlikely?>> [ t >>unlikely? ] when 2drop ; + : join-block ( bb pred -- ) - [ join-instructions ] [ update-successors ] 2bi ; + [ join-instructions ] + [ update-successors ] + [ join-unlikely ] + 2tri ; + +SYMBOL: changed? : join-blocks ( cfg -- cfg' ) needs-predecessors dup post-order [ dup join-block? - [ dup predecessor join-block ] [ drop ] if + [ changed? on dup predecessor join-block ] [ drop ] if ] each - cfg-changed predecessors-changed ; + changed? get [ cfg-changed predecessors-changed ] when ; diff --git a/basis/compiler/cfg/finalization/finalization.factor b/basis/compiler/cfg/finalization/finalization.factor index 2b731bdd90..c07a30e5a0 100644 --- a/basis/compiler/cfg/finalization/finalization.factor +++ b/basis/compiler/cfg/finalization/finalization.factor @@ -4,7 +4,7 @@ USING: kernel compiler.cfg.representations compiler.cfg.scheduling compiler.cfg.gc-checks compiler.cfg.save-contexts compiler.cfg.ssa.destruction compiler.cfg.build-stack-frame compiler.cfg.linear-scan -compiler.cfg.stacks.uninitialized ; +compiler.cfg.stacks.uninitialized compiler.cfg.block-joining ; IN: compiler.cfg.finalization : finalize-cfg ( cfg -- cfg' ) @@ -15,4 +15,5 @@ IN: compiler.cfg.finalization insert-save-contexts destruct-ssa linear-scan + join-blocks build-stack-frame ; diff --git a/basis/compiler/cfg/linearization/linearization.factor b/basis/compiler/cfg/linearization/linearization.factor index c44b29d271..9f607de70f 100644 --- a/basis/compiler/cfg/linearization/linearization.factor +++ b/basis/compiler/cfg/linearization/linearization.factor @@ -70,8 +70,7 @@ SYMBOLS: work-list loop-heads visited ; init-linearization-order [ work-list get [ process-block ] slurp-deque ] { } make - ! [ unlikely?>> not ] partition append - ; + [ unlikely?>> not ] partition append ; PRIVATE>