compiler.cfg: change linear ordering to place GC call blocks at the end

db4
Slava Pestov 2010-07-27 13:00:28 -04:00
parent 355d89e8e8
commit 8adde5360a
3 changed files with 18 additions and 9 deletions

View File

@ -1,7 +1,8 @@
! Copyright (C) 2009 Slava Pestov. ! Copyright (C) 2009, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators.short-circuit kernel sequences math USING: accessors combinators.short-circuit kernel namespaces
compiler.utilities compiler.cfg compiler.cfg.instructions compiler.cfg.rpo sequences math compiler.utilities compiler.cfg
compiler.cfg.instructions compiler.cfg.rpo
compiler.cfg.predecessors compiler.cfg.utilities ; compiler.cfg.predecessors compiler.cfg.utilities ;
IN: compiler.cfg.block-joining IN: compiler.cfg.block-joining
@ -23,15 +24,23 @@ IN: compiler.cfg.block-joining
: update-successors ( bb pred -- ) : update-successors ( bb pred -- )
[ successors>> ] dip successors<< ; [ successors>> ] dip successors<< ;
: join-unlikely ( bb pred -- )
over unlikely?>> [ t >>unlikely? ] when 2drop ;
: join-block ( bb pred -- ) : join-block ( bb pred -- )
[ join-instructions ] [ update-successors ] 2bi ; [ join-instructions ]
[ update-successors ]
[ join-unlikely ]
2tri ;
SYMBOL: changed?
: join-blocks ( cfg -- cfg' ) : join-blocks ( cfg -- cfg' )
needs-predecessors needs-predecessors
dup post-order [ dup post-order [
dup join-block? dup join-block?
[ dup predecessor join-block ] [ drop ] if [ changed? on dup predecessor join-block ] [ drop ] if
] each ] each
cfg-changed predecessors-changed ; changed? get [ cfg-changed predecessors-changed ] when ;

View File

@ -4,7 +4,7 @@ USING: kernel compiler.cfg.representations
compiler.cfg.scheduling compiler.cfg.gc-checks compiler.cfg.scheduling compiler.cfg.gc-checks
compiler.cfg.save-contexts compiler.cfg.ssa.destruction compiler.cfg.save-contexts compiler.cfg.ssa.destruction
compiler.cfg.build-stack-frame compiler.cfg.linear-scan 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 IN: compiler.cfg.finalization
: finalize-cfg ( cfg -- cfg' ) : finalize-cfg ( cfg -- cfg' )
@ -15,4 +15,5 @@ IN: compiler.cfg.finalization
insert-save-contexts insert-save-contexts
destruct-ssa destruct-ssa
linear-scan linear-scan
join-blocks
build-stack-frame ; build-stack-frame ;

View File

@ -70,8 +70,7 @@ SYMBOLS: work-list loop-heads visited ;
init-linearization-order init-linearization-order
[ work-list get [ process-block ] slurp-deque ] { } make [ work-list get [ process-block ] slurp-deque ] { } make
! [ unlikely?>> not ] partition append [ unlikely?>> not ] partition append ;
;
PRIVATE> PRIVATE>