From 54389b5e5cd4bd5bfc1785d58481630cb5cf44da Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Thu, 13 Aug 2009 20:26:44 -0500 Subject: [PATCH] Write barriers are hoisted out of loops when their target is slot-available --- .../cfg/loop-detection/loop-detection.factor | 6 +- basis/compiler/cfg/utilities/utilities.factor | 2 +- .../write-barrier/write-barrier-tests.factor | 38 +++++- .../cfg/write-barrier/write-barrier.factor | 110 ++++++++++++++---- 4 files changed, 127 insertions(+), 29 deletions(-) diff --git a/basis/compiler/cfg/loop-detection/loop-detection.factor b/basis/compiler/cfg/loop-detection/loop-detection.factor index dc70656c08..73b99ee132 100644 --- a/basis/compiler/cfg/loop-detection/loop-detection.factor +++ b/basis/compiler/cfg/loop-detection/loop-detection.factor @@ -6,10 +6,10 @@ IN: compiler.cfg.loop-detection TUPLE: natural-loop header index ends blocks ; - ( header index -- loop ) H{ } clone H{ } clone natural-loop boa ; @@ -80,4 +80,4 @@ PRIVATE> : needs-loops ( cfg -- cfg' ) needs-predecessors - dup loops-valid?>> [ detect-loops t >>loops-valid? ] unless ; \ No newline at end of file + dup loops-valid?>> [ detect-loops t >>loops-valid? ] unless ; diff --git a/basis/compiler/cfg/utilities/utilities.factor b/basis/compiler/cfg/utilities/utilities.factor index 6d68bca4b9..e205c1dc4d 100644 --- a/basis/compiler/cfg/utilities/utilities.factor +++ b/basis/compiler/cfg/utilities/utilities.factor @@ -46,7 +46,7 @@ SYMBOL: visited : add-instructions ( bb quot -- ) [ instructions>> building ] dip '[ building get pop - @ + [ @ ] dip , ] with-variable ; inline diff --git a/basis/compiler/cfg/write-barrier/write-barrier-tests.factor b/basis/compiler/cfg/write-barrier/write-barrier-tests.factor index d1f58c8bfa..a73451042d 100644 --- a/basis/compiler/cfg/write-barrier/write-barrier-tests.factor +++ b/basis/compiler/cfg/write-barrier/write-barrier-tests.factor @@ -1,9 +1,16 @@ ! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: compiler.cfg.write-barrier compiler.cfg.instructions -compiler.cfg.registers compiler.cfg.debugger cpu.architecture -arrays tools.test vectors compiler.cfg kernel accessors -compiler.cfg.utilities namespaces sequences ; +USING: accessors arrays assocs compiler.cfg +compiler.cfg.alias-analysis compiler.cfg.block-joining +compiler.cfg.branch-splitting compiler.cfg.copy-prop +compiler.cfg.dce compiler.cfg.debugger +compiler.cfg.instructions compiler.cfg.loop-detection +compiler.cfg.registers compiler.cfg.ssa.construction +compiler.cfg.tco compiler.cfg.useless-conditionals +compiler.cfg.utilities compiler.cfg.value-numbering +compiler.cfg.write-barrier cpu.architecture kernel +kernel.private math namespaces sequences sequences.private +tools.test vectors ; IN: compiler.cfg.write-barrier.tests : test-write-barrier ( insns -- insns ) @@ -158,3 +165,26 @@ cfg new 1 get >>entry 0 set T{ ##set-slot-imm f 2 1 3 4 } T{ ##write-barrier f 1 2 3 } } ] [ 3 get instructions>> ] unit-test + +: reverse-here' ( seq -- ) + { array } declare + [ length 2/ iota ] [ length ] [ ] tri + [ [ over - 1 - ] dip exchange-unsafe ] 2curry each ; + +: write-barrier-stats ( word -- cfg ) + test-cfg first [ + optimize-tail-calls + delete-useless-conditionals + split-branches + join-blocks + construct-ssa + alias-analysis + value-numbering + copy-propagation + eliminate-dead-code + eliminate-write-barriers + ] with-cfg + post-order>> write-barriers + [ [ loop-nesting-at ] [ length ] bi* ] assoc-map ; + +[ { { 0 1 } } ] [ \ reverse-here' write-barrier-stats ] unit-test diff --git a/basis/compiler/cfg/write-barrier/write-barrier.factor b/basis/compiler/cfg/write-barrier/write-barrier.factor index ef878e029a..4944ed61d8 100644 --- a/basis/compiler/cfg/write-barrier/write-barrier.factor +++ b/basis/compiler/cfg/write-barrier/write-barrier.factor @@ -1,8 +1,16 @@ ! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: kernel accessors namespaces assocs sets sequences -compiler.cfg compiler.cfg.instructions compiler.cfg.rpo -compiler.cfg.dataflow-analysis fry combinators.short-circuit ; +fry combinators.short-circuit locals +compiler.cfg +compiler.cfg.dominance +compiler.cfg.predecessors +compiler.cfg.loop-detection +compiler.cfg.rpo +compiler.cfg.instructions +compiler.cfg.registers +compiler.cfg.dataflow-analysis +compiler.cfg.utilities ; IN: compiler.cfg.write-barrier ! Eliminate redundant write barrier hits. @@ -20,41 +28,101 @@ M: ##allot eliminate-write-barrier dst>> safe get conjoin t ; M: ##write-barrier eliminate-write-barrier - src>> dup [ safe get key? not ] [ mutated get key? ] bi and + src>> dup safe get key? not [ safe get conjoin t ] [ drop f ] if ; -M: ##set-slot eliminate-write-barrier - obj>> mutated get conjoin t ; - -M: ##set-slot-imm eliminate-write-barrier - obj>> mutated get conjoin t ; - M: insn eliminate-write-barrier drop t ; +! This doesn't actually benefit from being a dataflow analysis +! might as well be dominator-based +! Dealing with phi functions would help, though FORWARD-ANALYSIS: safe : has-allocation? ( bb -- ? ) instructions>> [ { [ ##allocation? ] [ ##call? ] } 1|| ] any? ; -GENERIC: safe-slot ( insn -- slot ? ) -M: object safe-slot drop f f ; -M: ##write-barrier safe-slot src>> t ; -M: ##allot safe-slot dst>> t ; - M: safe-analysis transfer-set - drop [ H{ } assoc-clone-like ] dip - instructions>> over '[ - safe-slot [ _ conjoin ] [ drop ] if - ] each ; + drop [ H{ } assoc-clone-like safe set ] dip + instructions>> [ + eliminate-write-barrier drop + ] each safe get ; M: safe-analysis join-sets drop has-allocation? [ drop H{ } clone ] [ assoc-refine ] if ; : write-barriers-step ( bb -- ) dup safe-in H{ } assoc-clone-like safe set - H{ } clone mutated set instructions>> [ eliminate-write-barrier ] filter-here ; +GENERIC: remove-dead-barrier ( insn -- ? ) + +M: ##write-barrier remove-dead-barrier + src>> mutated get key? ; + +M: ##set-slot remove-dead-barrier + obj>> mutated get conjoin t ; + +M: ##set-slot-imm remove-dead-barrier + obj>> mutated get conjoin t ; + +M: insn remove-dead-barrier drop t ; + +: remove-dead-barriers ( bb -- ) + H{ } clone mutated set + instructions>> [ remove-dead-barrier ] filter-here ; + +! Availability of slot +! Anticipation of this and set-slot would help too, maybe later +FORWARD-ANALYSIS: slot + +M: slot-analysis transfer-set + drop [ H{ } assoc-clone-like ] dip + instructions>> over '[ + dup ##read? [ + obj>> _ conjoin + ] [ drop ] if + ] each ; + +: slot-available? ( vreg bb -- ? ) + slot-in key? ; + +: make-barriers ( vregs bb -- ) + [ [ next-vreg next-vreg ##write-barrier ] each ] add-instructions ; + +: emit-barriers ( vregs bb -- ) + predecessors>> [ make-barriers ] with each ; + +: write-barriers ( bbs -- bb=>barriers ) + [ + dup instructions>> + [ ##write-barrier? ] filter + [ src>> ] map + ] { } map>assoc + [ nip empty? not ] assoc-filter ; + +: filter-dominant ( bb=>barriers bbs -- barriers ) + '[ drop _ [ dominates? ] with all? ] assoc-filter + values concat prune ; + +: dominant-write-barriers ( loop -- vregs ) + [ blocks>> values write-barriers ] [ ends>> keys ] bi filter-dominant ; + +: insert-extra-barriers ( -- ) + loops get values [| loop | + loop dominant-write-barriers + loop header>> '[ _ slot-available? ] filter + [ loop header>> emit-barriers ] unless-empty + ] each ; + +: contains-write-barrier? ( cfg -- ? ) + post-order [ instructions>> [ ##write-barrier? ] any? ] any? ; + : eliminate-write-barriers ( cfg -- cfg' ) - dup compute-safe-sets - dup [ write-barriers-step ] each-basic-block ; + dup contains-write-barrier? [ + needs-loops needs-dominance needs-predecessors + dup [ remove-dead-barriers ] each-basic-block + dup compute-slot-sets + insert-extra-barriers + dup compute-safe-sets + dup [ write-barriers-step ] each-basic-block + ] when ;