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 ;
<basic-block> 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 -- )
##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
! 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 ;
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 } }
} [
{ { 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
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 ;