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 ;
! 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 -- )
! 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
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
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
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 ;
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
! 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 } }
{ { 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
{ 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
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
: 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@
[ [ <ds-loc> ] map ] [ [ <rs-loc> ] map ] bi*
- append unique ;
+ append >hash-set ;
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 ;
projects / factor.git / commitdiff