compiler.cfg.predecessors
compiler.cfg.builder.blocks
compiler.cfg.stacks
+compiler.cfg.stacks.local
compiler.alien ;
IN: compiler.cfg.builder
literal>> ^^load-literal ds-push ;
! #shuffle
+
+! Even though low level IR has its own dead code elimination pass,
+! we try not to introduce useless ##peeks here, since this reduces
+! the accuracy of global stack analysis.
+
+: make-input-map ( #shuffle -- assoc )
+ ! Assoc maps high-level IR values to stack locations.
+ [
+ [ in-d>> <reversed> [ <ds-loc> swap set ] each-index ]
+ [ in-r>> <reversed> [ <rs-loc> swap set ] each-index ] bi
+ ] H{ } make-assoc ;
+
+: make-output-seq ( values mapping input-map -- vregs )
+ '[ _ at _ at peek-loc ] map ;
+
+: load-shuffle ( #shuffle mapping input-map -- ds-vregs rs-vregs )
+ [ [ out-d>> ] 2dip make-output-seq ]
+ [ [ out-r>> ] 2dip make-output-seq ] 3bi ;
+
+: store-shuffle ( #shuffle ds-vregs rs-vregs -- )
+ [ [ in-d>> length neg inc-d ] dip ds-store ]
+ [ [ in-r>> length neg inc-r ] dip rs-store ]
+ bi-curry* bi ;
+
M: #shuffle emit-node
- dup
- H{ } clone
- [ [ in-d>> [ length ds-load ] keep ] dip '[ _ set-at ] 2each ]
- [ [ in-r>> [ length rs-load ] keep ] dip '[ _ set-at ] 2each ]
- [ nip ] 2tri
- [ [ [ out-d>> ] [ mapping>> ] bi ] dip '[ _ at _ at ] map ds-store ]
- [ [ [ out-r>> ] [ mapping>> ] bi ] dip '[ _ at _ at ] map rs-store ] 2bi ;
+ dup dup [ mapping>> ] [ make-input-map ] bi load-shuffle store-shuffle ;
! #return
: emit-return ( -- )
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces assocs kernel fry accessors sequences make math
+USING: namespaces assocs kernel fry accessors sequences make math locals
combinators compiler.cfg compiler.cfg.hats compiler.cfg.instructions
compiler.cfg.utilities compiler.cfg.rpo compiler.cfg.stacks.local
compiler.cfg.stacks.global compiler.cfg.stacks.height ;
! This pass inserts peeks and replaces.
-: inserting-peeks ( from to -- assoc )
- peek-in swap [ peek-out ] [ avail-out ] bi
- assoc-union assoc-diff ;
-
-: inserting-replaces ( from to -- assoc )
- [ replace-out ] [ [ kill-in ] [ replace-in ] bi ] bi*
- assoc-union assoc-diff ;
+:: inserting-peeks ( from to -- assoc )
+ ! A peek is inserted on an edge if the destination anticipates
+ ! the stack location, the source does not anticipate it and
+ ! it is not available from the source in a register.
+ to anticip-in
+ from anticip-out from avail-out assoc-union
+ assoc-diff ;
+
+:: inserting-replaces ( from to -- assoc )
+ ! A replace is inserted on an edge if two conditions hold:
+ ! - the location is not dead at the destination, OR
+ ! the location is live at the destination but not available
+ ! at the destination
+ ! - the location is pending in the source but not the destination
+ from pending-out to pending-in assoc-diff
+ to dead-in to live-in to anticip-in assoc-diff assoc-diff
+ assoc-diff ;
: each-insertion ( assoc bb quot: ( vreg loc -- ) -- )
'[ drop [ loc>vreg ] [ _ untranslate-loc ] bi @ ] assoc-each ; inline
! If both blocks are subroutine calls, don't bother
! computing anything.
2dup [ kill-block? ] both? [ 2drop ] [
- 2dup [ [ insert-peeks ] [ insert-replaces ] 2bi ] V{ } make
+ 2dup [ [ insert-replaces ] [ insert-peeks ] 2bi ] V{ } make
[ 2drop ] [ <simple-block> insert-basic-block ] if-empty
] if ;
compiler.cfg.stacks.local ;
IN: compiler.cfg.stacks.global
-! Peek analysis. Peek-in is the set of all locations anticipated at
-! the start of a basic block.
-BACKWARD-ANALYSIS: peek
+: transfer-peeked-locs ( assoc bb -- assoc' )
+ [ replace-set assoc-diff ] [ peek-set assoc-union ] bi ;
-M: peek-analysis transfer-set drop [ replace-set assoc-diff ] keep peek-set assoc-union ;
+! A stack location is anticipated at a location if every path from
+! the location to an exit block will read the stack location
+! before writing it.
+BACKWARD-ANALYSIS: anticip
-! Replace analysis. Replace-in is the set of all locations which
-! will be overwritten at some point after the start of a basic block.
-FORWARD-ANALYSIS: replace
+M: anticip-analysis transfer-set drop transfer-peeked-locs ;
-M: replace-analysis transfer-set drop replace-set assoc-union ;
+! A stack location is live at a location if some path from
+! the location to an exit block will read the stack location
+! before writing it.
+BACKWARD-ANALYSIS: live
-! Availability analysis. Avail-out is the set of all locations
-! in registers at the end of a basic block.
+M: live-analysis transfer-set drop transfer-peeked-locs ;
+
+M: live-analysis join-sets drop assoc-combine ;
+
+! A stack location is available at a location if all paths from
+! the entry block to the location load the location into a
+! register.
FORWARD-ANALYSIS: avail
-M: avail-analysis transfer-set drop [ peek-set ] [ replace-set ] bi assoc-union assoc-union ;
+M: avail-analysis transfer-set
+ drop [ peek-set assoc-union ] [ replace-set assoc-union ] bi ;
+
+! 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 ;
-! Kill analysis. Kill-in is the set of all locations
-! which are going to be overwritten.
-BACKWARD-ANALYSIS: kill
+! 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: kill-analysis transfer-set drop kill-set assoc-union ;
+M: dead-analysis transfer-set
+ drop
+ [ kill-set assoc-union ]
+ [ replace-set assoc-union ] bi ;
! Main word
: compute-global-sets ( cfg -- cfg' )
{
- [ compute-peek-sets ]
- [ compute-replace-sets ]
+ [ compute-anticip-sets ]
+ [ compute-live-sets ]
+ [ compute-pending-sets ]
+ [ compute-dead-sets ]
[ compute-avail-sets ]
- [ compute-kill-sets ]
[ ]
} cleave ;
\ No newline at end of file
compiler.cfg.parallel-copy ;
IN: compiler.cfg.stacks.local
-! Local stack analysis. We build local peek and replace sets for every basic
-! block while constructing the CFG.
+! Local stack analysis. We build three sets for every basic block
+! in the CFG:
+! - peek-set: all stack locations that the block reads before writing
+! - replace-set: all stack locations that the block writes
+! - kill-set: all stack locations which become unavailable after the
+! block ends because of the stack height being decremented
+! This is done while constructing the CFG.
SYMBOLS: peek-sets replace-sets kill-sets ;
: compute-local-kill-set ( -- assoc )
basic-block get current-height get
[ [ ds-heights get at dup ] [ d>> ] bi* [-] iota [ swap - <ds-loc> ] with map ]
- [ [ rs-heights get at dup ] [ r>> ] bi* [-] iota [ swap - <rs-loc> ] with map ]
- [ drop local-replace-set get at ] 2tri
- [ append unique dup ] dip update ;
+ [ [ rs-heights get at dup ] [ r>> ] bi* [-] iota [ swap - <rs-loc> ] with map ] 2bi
+ append unique ;
: begin-local-analysis ( -- )
H{ } clone local-peek-set set
[ 3 3 2 ] [ 4 3 "" coalescing-bug-4 ] unit-test
[ 2 3 1 ] [ 2 3 V{ } coalescing-bug-4 ] unit-test
[ 3 3 1 ] [ 4 3 V{ } coalescing-bug-4 ] unit-test
- [ 3 3 1 ] [ 4 3 V{ } coalescing-bug-4 ] unit-test
\ No newline at end of file
+ [ 3 3 1 ] [ 4 3 V{ } coalescing-bug-4 ] unit-test
+
+! Global stack analysis dataflow equations are wrong
+: some-word ( a -- b ) 2 + ;
+: global-dcn-bug-1 ( a b -- c d )
+ dup [ [ drop 1 ] dip ] [ [ some-word ] dip ] if
+ dup [ [ 1 fixnum+fast ] dip ] [ [ drop 1 ] dip ] if ;
+
+[ 2 t ] [ 0 t global-dcn-bug-1 ] unit-test
+[ 1 f ] [ 0 f global-dcn-bug-1 ] unit-test
\ No newline at end of file