compiler.cfg.predecessors compiler.cfg ;
IN: compiler.cfg.dataflow-analysis
-GENERIC: join-sets ( sets dfa -- set )
+GENERIC: join-sets ( sets bb dfa -- set )
GENERIC: transfer-set ( in-set bb dfa -- out-set )
GENERIC: block-order ( cfg dfa -- bbs )
GENERIC: successors ( bb dfa -- seq )
M: kill-block compute-in-set 3drop f ;
M:: basic-block compute-in-set ( bb out-sets dfa -- set )
- bb dfa predecessors [ out-sets at ] map dfa join-sets ;
+ bb dfa predecessors [ out-sets at ] map bb dfa join-sets ;
:: update-in-set ( bb in-sets out-sets dfa -- ? )
bb out-sets dfa compute-in-set
in-sets
out-sets ; inline
-M: dataflow-analysis join-sets drop assoc-refine ;
+M: dataflow-analysis join-sets 2drop assoc-refine ;
FUNCTOR: define-analysis ( name -- )
drop instructions>> transfer-liveness ;
M: live-analysis join-sets
- drop assoc-combine ;
\ No newline at end of file
+ 2drop assoc-combine ;
M: live-analysis transfer-set drop transfer-peeked-locs ;
-M: live-analysis join-sets drop assoc-combine ;
+M: live-analysis join-sets 2drop 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
[ compute-dead-sets ]
[ compute-avail-sets ]
[ ]
- } cleave ;
\ No newline at end of file
+ } cleave ;
drop [ prepare ] dip visit-block finish ;
M: uninitialized-analysis join-sets ( sets analysis -- pair )
- drop sift [ f ] [ [ ] [ [ (join-sets) ] 2map ] map-reduce ] if-empty ;
+ 2drop sift [ f ] [ [ ] [ [ (join-sets) ] 2map ] map-reduce ] if-empty ;
: uninitialized-locs ( bb -- locs )
uninitialized-in dup [
[ [ <ds-loc> ] (uninitialized-locs) ]
[ [ <rs-loc> ] (uninitialized-locs) ]
bi* append
- ] when ;
\ No newline at end of file
+ ] when ;
: has-allocation? ( bb -- ? )
instructions>> [ { [ ##allocation? ] [ ##call? ] } 1|| ] any? ;
-: (safe-in) ( maybe-safe-in bb -- safe-in )
- has-allocation? not swap and [ H{ } clone ] unless* ;
-
M: safe-analysis transfer-set
- drop [ (safe-in) ] keep
+ drop [ H{ } assoc-clone-like ] dip
instructions>> over '[
dup ##write-barrier? [
src>> _ conjoin
] each ;
M: safe-analysis join-sets
- ! maybe this would be better if we had access to the basic block
- ! then in this definition, it would check for has-allocation?
- ! (once rather than twice)
- drop assoc-refine ;
-
-: safe-start ( bb -- set )
- [ safe-in ] keep (safe-in) ;
+ drop has-allocation? [ drop H{ } clone ] [ assoc-refine ] if ;
: write-barriers-step ( bb -- )
- dup safe-start safe set
+ dup safe-in H{ } assoc-clone-like safe set
H{ } clone mutated set
instructions>> [ eliminate-write-barrier ] filter-here ;
: eliminate-write-barriers ( cfg -- cfg' )
- dup compute-safe-sets
+ dup compute-safe-sets
dup [ write-barriers-step ] each-basic-block ;