steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Revert "compiler.cfg.ssa.construction.tdmsc: pass visited set on stack." 

This reverts commit ec2834300b.
db4
John Benediktsson 2013-03-23 18:25:53 -07:00
parent 7744498ad2
commit 3f1a426210
1 changed files with 12 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
basis/compiler/cfg/ssa/construction/tdmsc/tdmsc.factor
View File

@ -14,7 +14,7 @@ IN: compiler.cfg.ssa.construction.tdmsc
<PRIVATE <PRIVATE
SYMBOLS: merge-sets levels again? ; SYMBOLS: visited merge-sets levels again? ;
: init-merge-sets ( cfg -- ) : init-merge-sets ( cfg -- )
post-order dup length '[ _ <bit-set> ] H{ } map>assoc merge-sets set ; post-order dup length '[ _ <bit-set> ] H{ } map>assoc merge-sets set ;
@ -52,22 +52,22 @@ SYMBOLS: merge-sets levels again? ;
: consistent? ( snode lnode -- ? ) : consistent? ( snode lnode -- ? )
[ merge-sets get at ] bi@ subset? ; [ merge-sets get at ] bi@ subset? ;
: (process-edge) ( from to visited -- ) : (process-edge) ( from to -- )
[ f walk ] dip '[ f walk [
2dup 2array _ ?adjoin [ 2drop ] [ 2dup 2array visited get ?adjoin
consistent? [ again? on ] unless [ 2drop ] [ consistent? [ again? on ] unless ] if
] if
] each-incoming-j-edge ; ] each-incoming-j-edge ;
: process-edge ( from to visited -- ) : process-edge ( from to -- )
[ 2over 2array swap ?adjoin ] keep 2dup 2array visited get ?adjoin
'[ _ (process-edge) ] [ 2drop ] if ; [ (process-edge) ] [ 2drop ] if ;
: process-block ( bb visited -- ) : process-block ( bb -- )
'[ _ process-edge ] each-incoming-j-edge ; [ process-edge ] each-incoming-j-edge ;
: compute-merge-set-step ( bfo -- ) : compute-merge-set-step ( bfo -- )
HS{ } clone '[ _ process-block ] each ; HS{ } clone visited set
[ process-block ] each ;
: compute-merge-set-loop ( cfg -- ) : compute-merge-set-loop ( cfg -- )
breadth-first-order breadth-first-order