compiler.cfg.dominance: fix for #1227, the dom children needs to be sorted to ensure that the same instruction sequence is generated every time

db4
Björn Lindqvist 2014-12-10 23:55:42 +01:00
parent 628c87c5b1
commit bfc0ef815b
2 changed files with 44 additions and 8 deletions

View File

@ -1,6 +1,7 @@
USING: tools.test sequences vectors namespaces kernel accessors assocs sets
math.ranges arrays compiler.cfg compiler.cfg.dominance compiler.cfg.debugger
compiler.cfg.predecessors compiler.cfg.utilities ;
USING: accessors arrays assocs compiler.cfg compiler.cfg.dominance
compiler.cfg.dominance.private compiler.cfg.debugger compiler.cfg.predecessors
compiler.cfg.utilities grouping kernel math.ranges namespaces sequences sets
tools.test vectors ;
IN: compiler.cfg.dominance.tests
: test-dominance ( -- )
@ -72,3 +73,36 @@ V{ } 5 test-bb
[ ] [ test-dominance ] unit-test
[ t ] [ 0 5 [a,b] [ get dom-parent 0 get eq? ] all? ] unit-test
: non-det-test ( -- cfg )
{
{ 0 { } }
{ 1 { } }
{ 2 { } }
{ 3 { } }
{ 4 { } }
{ 5 { } }
{ 6 { } }
{ 7 { } }
{ 8 { } }
} [ over insns>block ] assoc-map dup
{
{ 0 1 }
{ 1 2 } { 1 7 }
{ 2 3 } { 2 5 }
{ 3 4 }
{ 5 6 }
{ 7 8 }
} make-edges 0 of block>cfg ;
: dom-childrens>numbers ( -- assoc )
dom-childrens get
[ [ number>> ] [ [ number>> ] map ] bi* ] assoc-map ;
! It is essential that the same dominance map is created each time and
! that it does not differ due to hashing irregularities.
{ t } [
20 [
non-det-test needs-dominance dom-childrens>numbers
] replicate all-equal?
] unit-test

View File

@ -46,10 +46,9 @@ PRIVATE>
<PRIVATE
: compute-dom-children ( -- )
dom-parents get H{ } clone
[ '[ 2dup eq? [ 2drop ] [ _ push-at ] if ] assoc-each ] keep
dom-childrens set ;
: compute-dom-children ( dom-parents -- dom-childrens )
H{ } clone [ '[ 2dup eq? [ 2drop ] [ _ push-at ] if ] assoc-each ] keep
[ [ number>> ] sort-with ] assoc-map ;
SYMBOLS: preorder maxpreorder ;
@ -74,7 +73,10 @@ PRIVATE>
[ 0 ] dip entry>> (compute-dfs) drop ;
: compute-dominance ( cfg -- )
[ compute-dom-parents compute-dom-children ] [ compute-dfs ] bi ;
[
compute-dom-parents
dom-parents get compute-dom-children dom-childrens set
] [ compute-dfs ] bi ;
PRIVATE>