From 91144c0712d5eb56af0732cb75d9cdee9a0d5374 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= Date: Thu, 2 Apr 2015 04:56:40 +0200 Subject: [PATCH] compiler.cfg.stacks.*: simplify the code a little by making replace-sets, peek-sets and kill-sets contain hash-sets instead of hash-tables --- .../cfg/stacks/finalize/finalize.factor | 22 +++++------ .../compiler/cfg/stacks/global/global.factor | 25 +++++++----- .../cfg/stacks/local/local-tests.factor | 39 +++++++++++++++---- basis/compiler/cfg/stacks/local/local.factor | 34 ++++++++-------- 4 files changed, 74 insertions(+), 46 deletions(-) diff --git a/basis/compiler/cfg/stacks/finalize/finalize.factor b/basis/compiler/cfg/stacks/finalize/finalize.factor index d242e1ebf0..210c978772 100644 --- a/basis/compiler/cfg/stacks/finalize/finalize.factor +++ b/basis/compiler/cfg/stacks/finalize/finalize.factor @@ -4,21 +4,21 @@ USING: accessors assocs compiler.cfg.checker compiler.cfg compiler.cfg.instructions compiler.cfg.predecessors compiler.cfg.rpo compiler.cfg.stacks.global compiler.cfg.stacks.height compiler.cfg.stacks.local compiler.cfg.utilities fry kernel -locals make math sequences ; +locals make math sequences sets ; IN: compiler.cfg.stacks.finalize -:: inserting-peeks ( from to -- assoc ) +:: inserting-peeks ( from to -- set ) to anticip-in - from anticip-out from avail-out assoc-union - assoc-diff ; + from anticip-out from avail-out union + diff ; -:: inserting-replaces ( from to -- assoc ) - from pending-out to pending-in assoc-diff - to dead-in to live-in to anticip-in assoc-diff assoc-diff - assoc-diff ; +:: inserting-replaces ( from to -- set ) + from pending-out to pending-in diff + to dead-in to live-in to anticip-in diff diff + diff ; -: each-insertion ( ... assoc bb quot: ( ... vreg loc -- ... ) -- ... ) - '[ drop [ loc>vreg ] [ _ untranslate-loc ] bi @ ] assoc-each ; inline +: each-insertion ( ... set bb quot: ( ... vreg loc -- ... ) -- ... ) + [ members ] 2dip '[ [ loc>vreg ] [ _ untranslate-loc ] bi @ ] each ; inline ERROR: bad-peek dst loc ; @@ -35,7 +35,7 @@ ERROR: bad-peek dst loc ; ! computing anything. 2dup [ kill-block?>> ] both? [ 2drop ] [ 2dup [ [ insert-replaces ] [ insert-peeks ] 2bi ##branch, ] V{ } make - [ 2drop ] [ insert-basic-block ] if-empty + insert-basic-block ] if ; : visit-block ( bb -- ) diff --git a/basis/compiler/cfg/stacks/global/global.factor b/basis/compiler/cfg/stacks/global/global.factor index b1327169b9..86035cf7e7 100644 --- a/basis/compiler/cfg/stacks/global/global.factor +++ b/basis/compiler/cfg/stacks/global/global.factor @@ -1,15 +1,19 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: assocs combinators compiler.cfg.dataflow-analysis -compiler.cfg.stacks.local kernel namespaces ; +compiler.cfg.stacks.local kernel namespaces sequences sets ; IN: compiler.cfg.stacks.global : peek-set ( bb -- assoc ) peek-sets get at ; : replace-set ( bb -- assoc ) replace-sets get at ; : kill-set ( bb -- assoc ) kill-sets get at ; -: transfer-peeked-locs ( assoc bb -- assoc' ) - [ replace-set assoc-diff ] [ peek-set assoc-union ] bi ; +! Should exists somewhere else +: refine ( sets -- set ) + [ f ] [ [ ] [ intersect ] map-reduce ] if-empty ; + +: transfer-peeked-locs ( set bb -- set' ) + [ replace-set diff ] [ peek-set union ] bi ; ! A stack location is anticipated at a location if every path from ! the location to an exit block will read the stack location @@ -17,6 +21,7 @@ IN: compiler.cfg.stacks.global BACKWARD-ANALYSIS: anticip M: anticip-analysis transfer-set drop transfer-peeked-locs ; +M: anticip-analysis join-sets 2drop refine ; ! A stack location is live at a location if some path from ! the location to an exit block will read the stack location @@ -24,8 +29,7 @@ M: anticip-analysis transfer-set drop transfer-peeked-locs ; BACKWARD-ANALYSIS: live M: live-analysis transfer-set drop transfer-peeked-locs ; - -M: live-analysis join-sets 2drop assoc-combine ; +M: live-analysis join-sets 2drop combine ; ! A stack location is available at a location if all paths from ! the entry block to the location load the location into a @@ -33,20 +37,21 @@ M: live-analysis join-sets 2drop assoc-combine ; FORWARD-ANALYSIS: avail M: avail-analysis transfer-set - drop [ peek-set assoc-union ] [ replace-set assoc-union ] bi ; + drop [ peek-set ] [ replace-set ] bi union union ; +M: avail-analysis join-sets 2drop refine ; ! A stack location is pending at a location if all paths from ! the entry block to the location write the location. FORWARD-ANALYSIS: pending M: pending-analysis transfer-set - drop replace-set assoc-union ; + drop replace-set union ; +M: pending-analysis join-sets 2drop refine ; ! A stack location is dead at a location if no paths from the ! location to the exit block read the location before writing it. BACKWARD-ANALYSIS: dead M: dead-analysis transfer-set - drop - [ kill-set assoc-union ] - [ replace-set assoc-union ] bi ; + drop [ kill-set ] [ replace-set ] bi union union ; +M: dead-analysis join-sets 2drop refine ; diff --git a/basis/compiler/cfg/stacks/local/local-tests.factor b/basis/compiler/cfg/stacks/local/local-tests.factor index a4cb7938a5..a330ff14de 100644 --- a/basis/compiler/cfg/stacks/local/local-tests.factor +++ b/basis/compiler/cfg/stacks/local/local-tests.factor @@ -2,6 +2,7 @@ USING: accessors assocs biassocs combinators compiler.cfg compiler.cfg.instructions compiler.cfg.registers compiler.cfg.stacks compiler.cfg.stacks.height compiler.cfg.stacks.local compiler.cfg.utilities compiler.test cpu.architecture make namespaces kernel tools.test ; +QUALIFIED: sets IN: compiler.cfg.stacks.local.tests ! loc>vreg @@ -27,14 +28,40 @@ IN: compiler.cfg.stacks.local.tests ! end-local-analysis { - H{ } - H{ } - H{ } + HS{ } + { } + HS{ } } [ "foo" [ "eh" , end-local-analysis ] V{ } make drop "foo" [ peek-sets ] [ replace-sets ] [ kill-sets ] tri [ get at ] 2tri@ ] cfg-unit-test +{ + { D 3 } +} [ + "foo" [ 3 D 3 replace-loc "eh" , end-local-analysis ] V{ } make drop + replace-sets get "foo" of +] unit-test + +! remove-redundant-replaces +{ + H{ { T{ ds-loc { n 3 } } 7 } } +} [ + D 0 loc>vreg D 2 loc>vreg 2drop + 2 D 2 replace-loc 7 D 3 replace-loc + replace-mapping get remove-redundant-replaces +] cfg-unit-test + +! emit-changes +{ + V{ T{ ##copy { dst 1 } { src 3 } { rep any-rep } } "eh" } +} [ + 3 D 0 replace-loc [ + "eh", + replace-mapping get height-state get emit-changes + ] V{ } make +] cfg-unit-test + ! height-state { { { 3 3 } { 0 0 } } @@ -55,8 +82,6 @@ IN: compiler.cfg.stacks.local.tests { { 0 4 } { 0 -2 } } height-state>insns ] unit-test - - { H{ { D -1 40 } } } [ D 1 inc-stack 40 D 0 replace-loc replace-mapping get ] cfg-unit-test @@ -64,10 +89,10 @@ IN: compiler.cfg.stacks.local.tests { 0 } [ V{ } 0 insns>block basic-block set init-cfg-test - compute-local-kill-set assoc-size + compute-local-kill-set sets:cardinality ] unit-test -{ H{ { R -4 R -4 } } } [ +{ HS{ R -4 } } [ H{ { 77 4 } } [ ds-heights set ] [ rs-heights set ] bi { { 8 0 } { 3 0 } } height-state set 77 basic-block set diff --git a/basis/compiler/cfg/stacks/local/local.factor b/basis/compiler/cfg/stacks/local/local.factor index 6c38dbad69..a545ccf00c 100644 --- a/basis/compiler/cfg/stacks/local/local.factor +++ b/basis/compiler/cfg/stacks/local/local.factor @@ -3,7 +3,7 @@ USING: accessors arrays assocs combinators compiler.cfg compiler.cfg.instructions compiler.cfg.parallel-copy compiler.cfg.registers compiler.cfg.stacks.height -kernel make math math.order namespaces sequences sets ; +hash-sets kernel make math math.order namespaces sequences sets ; FROM: namespaces => set ; IN: compiler.cfg.stacks.local @@ -35,10 +35,10 @@ IN: compiler.cfg.stacks.local : kill-locations ( saved-height height -- seq ) dupd [-] iota [ swap - ] with map ; -: local-kill-set ( ds-height rs-height state -- assoc ) +: local-kill-set ( ds-height rs-height state -- set ) first2 [ first ] bi@ swapd [ kill-locations ] 2bi@ [ [ ] map ] [ [ ] map ] bi* - append unique ; + append >hash-set ; SYMBOLS: height-state peek-sets replace-sets kill-sets locs>vregs ; @@ -48,45 +48,43 @@ SYMBOLS: height-state peek-sets replace-sets kill-sets locs>vregs ; : loc>vreg ( loc -- vreg ) locs>vregs get [ drop next-vreg ] cache ; : vreg>loc ( vreg -- loc/f ) locs>vregs get value-at ; -SYMBOLS: local-peek-set local-replace-set replace-mapping ; +SYMBOLS: local-peek-set replace-mapping ; : stack-changes ( replace-mapping -- insns ) [ [ loc>vreg ] dip ] assoc-map parallel-copy ; -: emit-changes ( -- ) - building get pop - replace-mapping get stack-changes % - height-state get height-state>insns % - , ; +: emit-changes ( replace-mapping height-state -- ) + building get pop -rot [ stack-changes % ] [ height-state>insns % ] bi* , ; : peek-loc ( loc -- vreg ) height-state get swap translate-local-loc dup replace-mapping get at - [ ] [ dup local-peek-set get conjoin loc>vreg ] ?if ; + [ ] [ dup local-peek-set get adjoin loc>vreg ] ?if ; : replace-loc ( vreg loc -- ) height-state get swap translate-local-loc replace-mapping get set-at ; -: compute-local-kill-set ( -- assoc ) +: compute-local-kill-set ( -- set ) basic-block get [ rs-heights get at ] [ ds-heights get at ] bi height-state get local-kill-set ; : begin-local-analysis ( -- ) - H{ } clone local-peek-set set + HS{ } clone local-peek-set set H{ } clone replace-mapping set height-state get [ reset-emits ] [ first2 [ first ] bi@ basic-block get record-stack-heights ] bi ; -: remove-redundant-replaces ( -- ) - replace-mapping get [ [ loc>vreg ] dip = not ] assoc-filter - [ replace-mapping set ] [ keys unique local-replace-set set ] bi ; +: remove-redundant-replaces ( replace-mapping -- replace-mapping' ) + [ [ loc>vreg ] dip = not ] assoc-filter ; : end-local-analysis ( basic-block -- ) - remove-redundant-replaces - emit-changes + [ + replace-mapping get remove-redundant-replaces + dup height-state get emit-changes keys + swap replace-sets get set-at + ] [ [ local-peek-set get ] dip peek-sets get set-at ] - [ [ local-replace-set get ] dip replace-sets get set-at ] [ [ compute-local-kill-set ] dip kill-sets get set-at ] tri ;