From 8bc2ea7a5c0a2c7b79f7f9f5f495dc062abcc6a8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 18 Sep 2010 20:26:03 -0700 Subject: [PATCH] compiler.cfg.ssa.construction: use the baller method for pruned SSA --- .../construction/construction-tests.factor | 107 ++++++++++++++-- .../cfg/ssa/construction/construction.factor | 119 ++++++++++++------ 2 files changed, 179 insertions(+), 47 deletions(-) diff --git a/basis/compiler/cfg/ssa/construction/construction-tests.factor b/basis/compiler/cfg/ssa/construction/construction-tests.factor index 54b02b7450..a011bf7bec 100644 --- a/basis/compiler/cfg/ssa/construction/construction-tests.factor +++ b/basis/compiler/cfg/ssa/construction/construction-tests.factor @@ -10,6 +10,16 @@ IN: compiler.cfg.ssa.construction.tests 0 vreg-counter set-global 0 basic-block set-global ; +: test-ssa ( -- ) + cfg new 0 get >>entry + dup cfg set + construct-ssa + drop ; + +: clean-up-phis ( insns -- insns' ) + [ dup ##phi? [ [ [ [ number>> ] dip ] assoc-map ] change-inputs ] when ] map ; + +! Test 1 reset-counters V{ @@ -38,12 +48,6 @@ V{ 1 3 edge 2 3 edge -: test-ssa ( -- ) - cfg new 0 get >>entry - dup cfg set - construct-ssa - drop ; - [ ] [ test-ssa ] unit-test [ @@ -69,9 +73,6 @@ V{ } ] [ 2 get instructions>> ] unit-test -: clean-up-phis ( insns -- insns' ) - [ dup ##phi? [ [ [ [ number>> ] dip ] assoc-map ] change-inputs ] when ] map ; - [ V{ T{ ##phi f 6 H{ { 1 4 } { 2 5 } } } @@ -83,6 +84,7 @@ V{ clean-up-phis ] unit-test +! Test 2 reset-counters V{ } 0 test-bb @@ -110,4 +112,89 @@ V{ } 6 test-bb ] [ 4 get instructions>> clean-up-phis -] unit-test \ No newline at end of file +] unit-test + +! Test 3 +reset-counters + +V{ + T{ ##branch } +} 0 test-bb + +V{ + T{ ##load-integer f 3 3 } + T{ ##branch } +} 1 test-bb + +V{ + T{ ##load-integer f 3 4 } + T{ ##branch } +} 2 test-bb + +V{ + T{ ##branch } +} 3 test-bb + +V{ + T{ ##return } +} 4 test-bb + +0 { 1 2 3 } edges +1 4 edge +2 4 edge +3 4 edge + +[ ] [ test-ssa ] unit-test + +[ V{ } ] [ 4 get instructions>> [ ##phi? ] filter ] unit-test + +! Test 4 +reset-counters + +V{ + T{ ##branch } +} 0 test-bb + +V{ + T{ ##branch } +} 1 test-bb + +V{ + T{ ##load-integer f 0 4 } + T{ ##branch } +} 2 test-bb + +V{ + T{ ##load-integer f 0 4 } + T{ ##branch } +} 3 test-bb + +V{ + T{ ##branch } +} 4 test-bb + +V{ + T{ ##branch } +} 5 test-bb + +V{ + T{ ##branch } +} 6 test-bb + +V{ + T{ ##return } +} 7 test-bb + +0 { 1 6 } edges +1 { 2 3 4 } edges +2 5 edge +3 5 edge +4 5 edge +5 7 edge +6 7 edge + +[ ] [ test-ssa ] unit-test + +[ V{ } ] [ 5 get instructions>> [ ##phi? ] filter ] unit-test + +[ V{ } ] [ 7 get instructions>> [ ##phi? ] filter ] unit-test \ No newline at end of file diff --git a/basis/compiler/cfg/ssa/construction/construction.factor b/basis/compiler/cfg/ssa/construction/construction.factor index 70e088e500..5793225349 100644 --- a/basis/compiler/cfg/ssa/construction/construction.factor +++ b/basis/compiler/cfg/ssa/construction/construction.factor @@ -1,11 +1,10 @@ ! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: namespaces kernel accessors sequences fry assocs -sets math combinators +sets math combinators deques dlists compiler.cfg compiler.cfg.rpo compiler.cfg.def-use -compiler.cfg.liveness compiler.cfg.registers compiler.cfg.dominance compiler.cfg.instructions @@ -15,12 +14,18 @@ compiler.cfg.ssa.construction.tdmsc ; FROM: namespaces => set ; IN: compiler.cfg.ssa.construction -! The phi placement algorithm is implemented in -! compiler.cfg.ssa.construction.tdmsc. +! Iterated dominance frontiers are computed using the DJ Graph +! method in compiler.cfg.ssa.construction.tdmsc. ! The renaming algorithm is based on "Practical Improvements to -! the Construction and Destruction of Static Single Assignment Form", -! however we construct pruned SSA, not semi-pruned SSA. +! the Construction and Destruction of Static Single Assignment +! Form". + +! We construct pruned SSA without computing live sets, by +! building a dependency graph for phi instructions, marking the +! transitive closure of a vertex as live if it is referenced by +! some non-phi instruction. Thanks to Cameron Zwarich for the +! trick. ! http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.49.9683 @@ -50,31 +55,32 @@ M: vreg-insn compute-insn-defs [ compute-insn-defs ] with each ] simple-analysis ; -! Maps basic blocks to sequences of vregs -SYMBOL: inserting-phi-nodes +! Maps basic blocks to sequences of ##phi instructions +SYMBOL: inserting-phis -: insert-phi-node-later ( vreg bb -- ) - 2dup live-in key? [ - [ predecessors>> over '[ _ ] H{ } map>assoc \ ##phi new-insn ] keep - inserting-phi-nodes get push-at - ] [ 2drop ] if ; +: insert-phi-later ( vreg bb -- ) + [ predecessors>> over '[ _ ] H{ } map>assoc \ ##phi new-insn ] keep + inserting-phis get push-at ; -: compute-phi-nodes-for ( vreg bbs -- ) - keys merge-set [ insert-phi-node-later ] with each ; +: compute-phis-for ( vreg bbs -- ) + keys merge-set [ insert-phi-later ] with each ; -: compute-phi-nodes ( -- ) - H{ } clone inserting-phi-nodes set - defs-multi get defs get '[ _ at compute-phi-nodes-for ] assoc-each ; +: compute-phis ( -- ) + H{ } clone inserting-phis set + defs-multi get defs get '[ _ at compute-phis-for ] assoc-each ; -: insert-phi-nodes-in ( phis bb -- ) - [ append ] change-instructions drop ; +! Maps vregs to ##phi instructions +SYMBOL: phis -: insert-phi-nodes ( -- ) - inserting-phi-nodes get [ swap insert-phi-nodes-in ] assoc-each ; +! Worklist of used vregs, to calculate used phis +SYMBOL: used-vregs +! Maps vregs to renaming stacks SYMBOLS: stacks pushed ; : init-renaming ( -- ) + H{ } clone phis set + used-vregs set H{ } clone stacks set ; : gen-name ( vreg -- vreg' ) @@ -84,8 +90,12 @@ SYMBOLS: stacks pushed ; [ conjoin stacks get push-at ] if ; +: (top-name) ( vreg -- vreg' ) + stacks get at [ f ] [ last ] if-empty ; + : top-name ( vreg -- vreg' ) - stacks get at last ; + (top-name) + dup [ dup used-vregs get push-front ] when ; RENAMING: ssa-rename [ gen-name ] [ top-name ] [ ] @@ -98,17 +108,22 @@ M: vreg-insn rename-insn [ ssa-rename-insn-defs ] bi ; -M: ##phi rename-insn - ssa-rename-insn-defs ; +: rename-phis ( bb -- ) + inserting-phis get at [ + [ + [ ssa-rename-insn-defs ] + [ dup dst>> phis get set-at ] bi + ] each + ] when* ; : rename-insns ( bb -- ) instructions>> [ rename-insn ] each ; : rename-successor-phi ( phi bb -- ) - swap inputs>> [ top-name ] change-at ; + swap inputs>> [ (top-name) ] change-at ; : rename-successor-phis ( succ bb -- ) - [ inserting-phi-nodes get at ] dip + [ inserting-phis get at ] dip '[ _ rename-successor-phi ] each ; : rename-successors-phis ( bb -- ) @@ -119,26 +134,56 @@ M: ##phi rename-insn : rename-in-block ( bb -- ) H{ } clone pushed set - [ rename-insns ] - [ rename-successors-phis ] - [ - pushed get - [ dom-children [ rename-in-block ] each ] dip - pushed set - ] tri + { + [ rename-phis ] + [ rename-insns ] + [ rename-successors-phis ] + [ + pushed get + [ dom-children [ rename-in-block ] each ] dip + pushed set + ] + } cleave pop-stacks ; : rename ( cfg -- ) init-renaming entry>> rename-in-block ; +! Live phis +SYMBOL: live-phis + +: live-phi? ( ##phi -- ? ) + dst>> live-phis get key? ; + +: compute-live-phis ( -- ) + H{ } clone live-phis set + used-vregs get [ + phis get at [ + [ + dst>> + [ live-phis get conjoin ] + [ phis get delete-at ] + bi + ] + [ inputs>> [ nip used-vregs get push-front ] assoc-each ] bi + ] when* + ] slurp-deque ; + +: insert-phis-in ( phis bb -- ) + [ [ live-phi? ] filter! ] dip + [ append ] change-instructions drop ; + +: insert-phis ( -- ) + inserting-phis get + [ swap insert-phis-in ] assoc-each ; + PRIVATE> : construct-ssa ( cfg -- cfg' ) { - [ compute-live-sets ] [ compute-merge-sets ] - [ compute-defs compute-phi-nodes insert-phi-nodes ] - [ rename ] + [ compute-defs compute-phis ] + [ rename compute-live-phis insert-phis ] [ ] } cleave ;