diff --git a/basis/compiler/cfg/builder/blocks/blocks.factor b/basis/compiler/cfg/builder/blocks/blocks.factor index 7935f95072..752fce6534 100644 --- a/basis/compiler/cfg/builder/blocks/blocks.factor +++ b/basis/compiler/cfg/builder/blocks/blocks.factor @@ -12,7 +12,7 @@ IN: compiler.cfg.builder.blocks begin-local-analysis ; : end-basic-block ( -- ) - basic-block get [ end-local-analysis ] when + basic-block get [ end-local-analysis ] when* building off basic-block off ; @@ -20,7 +20,7 @@ IN: compiler.cfg.builder.blocks basic-block get [ over connect-bbs ] when* set-basic-block ; : begin-basic-block ( -- ) - basic-block get [ end-local-analysis ] when + basic-block get [ end-local-analysis ] when* (begin-basic-block) ; : emit-trivial-block ( quot -- ) @@ -50,7 +50,7 @@ IN: compiler.cfg.builder.blocks ##branch, end-local-analysis height-state get clone-height-state 2array - ] when ; + ] when* ; : with-branch ( quot -- pair/f ) [ begin-branch call end-branch ] with-scope ; inline diff --git a/basis/compiler/cfg/stacks/global/global.factor b/basis/compiler/cfg/stacks/global/global.factor index d1164f871a..b1327169b9 100644 --- a/basis/compiler/cfg/stacks/global/global.factor +++ b/basis/compiler/cfg/stacks/global/global.factor @@ -1,9 +1,13 @@ ! 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 ; +compiler.cfg.stacks.local kernel namespaces ; 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 ; diff --git a/basis/compiler/cfg/stacks/local/local-tests.factor b/basis/compiler/cfg/stacks/local/local-tests.factor index c7ea737f2b..a4cb7938a5 100644 --- a/basis/compiler/cfg/stacks/local/local-tests.factor +++ b/basis/compiler/cfg/stacks/local/local-tests.factor @@ -1,9 +1,41 @@ 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 namespaces kernel tools.test ; +compiler.test cpu.architecture make namespaces kernel tools.test ; IN: compiler.cfg.stacks.local.tests +! loc>vreg +{ 1 } [ + D 0 loc>vreg +] cfg-unit-test + +! stack-changes +{ + { + T{ ##copy { dst 1 } { src 25 } { rep any-rep } } + T{ ##copy { dst 2 } { src 26 } { rep any-rep } } + } +} [ + { { D 0 25 } { R 0 26 } } stack-changes +] cfg-unit-test + +! replace-loc +{ 80 } [ + 80 D 77 replace-loc + D 77 peek-loc +] cfg-unit-test + +! end-local-analysis +{ + H{ } + H{ } + H{ } +} [ + "foo" [ "eh" , end-local-analysis ] V{ } make drop + "foo" [ peek-sets ] [ replace-sets ] [ kill-sets ] tri [ get at ] 2tri@ +] cfg-unit-test + +! height-state { { { 3 3 } { 0 0 } } } [ @@ -23,23 +55,7 @@ IN: compiler.cfg.stacks.local.tests { { 0 4 } { 0 -2 } } height-state>insns ] unit-test -{ 1 } [ - D 0 loc>vreg -] cfg-unit-test -{ - { - T{ ##copy { dst 1 } { src 25 } { rep any-rep } } - T{ ##copy { dst 2 } { src 26 } { rep any-rep } } - } -} [ - { { D 0 25 } { R 0 26 } } stack-changes -] cfg-unit-test - -{ 80 } [ - 80 D 77 replace-loc - D 77 peek-loc -] cfg-unit-test { H{ { D -1 40 } } } [ D 1 inc-stack 40 D 0 replace-loc replace-mapping get diff --git a/basis/compiler/cfg/stacks/local/local.factor b/basis/compiler/cfg/stacks/local/local.factor index 3d7e1198b5..6c38dbad69 100644 --- a/basis/compiler/cfg/stacks/local/local.factor +++ b/basis/compiler/cfg/stacks/local/local.factor @@ -84,15 +84,9 @@ SYMBOLS: local-peek-set local-replace-set replace-mapping ; replace-mapping get [ [ loc>vreg ] dip = not ] assoc-filter [ replace-mapping set ] [ keys unique local-replace-set set ] bi ; -: end-local-analysis ( -- ) +: end-local-analysis ( basic-block -- ) remove-redundant-replaces emit-changes - basic-block get { - [ [ 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 ] - } cleave ; - -: peek-set ( bb -- assoc ) peek-sets get at ; -: replace-set ( bb -- assoc ) replace-sets get at ; -: kill-set ( bb -- assoc ) kill-sets get 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 ;