+! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg.
+! See http://factorcode.org/license.txt for BSD license.
USING: compiler.cfg.write-barrier compiler.cfg.instructions
compiler.cfg.registers compiler.cfg.debugger cpu.architecture
arrays tools.test vectors compiler.cfg kernel accessors
-compiler.cfg.utilities ;
+compiler.cfg.utilities namespaces sequences ;
IN: compiler.cfg.write-barrier.tests
: test-write-barrier ( insns -- insns )
T{ ##write-barrier f 19 30 3 }
} test-write-barrier
] unit-test
+
+V{
+ T{ ##set-slot-imm f 2 1 3 4 }
+ T{ ##write-barrier f 1 2 3 }
+} 1 test-bb
+V{
+ T{ ##set-slot-imm f 2 1 3 4 }
+ T{ ##write-barrier f 1 2 3 }
+} 2 test-bb
+1 get 2 get 1vector >>successors drop
+cfg new 1 get >>entry 0 set
+
+[ ] [ 0 [ eliminate-write-barriers ] change ] unit-test
+[ V{
+ T{ ##set-slot-imm f 2 1 3 4 }
+ T{ ##write-barrier f 1 2 3 }
+} ] [ 1 get instructions>> ] unit-test
+[ V{
+ T{ ##set-slot-imm f 2 1 3 4 }
+} ] [ 2 get instructions>> ] unit-test
+
+V{
+ T{ ##set-slot-imm f 2 1 3 4 }
+ T{ ##write-barrier f 1 2 3 }
+} 1 test-bb
+V{
+ T{ ##allot }
+ T{ ##set-slot-imm f 2 1 3 4 }
+ T{ ##write-barrier f 1 2 3 }
+} 2 test-bb
+1 get 2 get 1vector >>successors drop
+cfg new 1 get >>entry 0 set
+
+[ ] [ 0 [ eliminate-write-barriers ] change ] unit-test
+[ V{
+ T{ ##set-slot-imm f 2 1 3 4 }
+ T{ ##write-barrier f 1 2 3 }
+} ] [ 1 get instructions>> ] unit-test
+[ V{
+ T{ ##allot }
+ T{ ##set-slot-imm f 2 1 3 4 }
+ T{ ##write-barrier f 1 2 3 }
+} ] [ 2 get instructions>> ] unit-test
+
+V{
+ T{ ##set-slot-imm f 2 1 3 4 }
+ T{ ##write-barrier f 1 2 3 }
+} 1 test-bb
+V{
+ T{ ##allot }
+} 2 test-bb
+1 get 2 get 1vector >>successors drop
+V{
+ T{ ##set-slot-imm f 2 1 3 4 }
+ T{ ##write-barrier f 1 2 3 }
+} 3 test-bb
+2 get 3 get 1vector >>successors drop
+cfg new 1 get >>entry 0 set
+[ ] [ 0 [ eliminate-write-barriers ] change ] unit-test
+[ V{
+ T{ ##set-slot-imm f 2 1 3 4 }
+ T{ ##write-barrier f 1 2 3 }
+} ] [ 1 get instructions>> ] unit-test
+[ V{ T{ ##allot } } ] [ 2 get instructions>> ] unit-test
+[ V{
+ T{ ##set-slot-imm f 2 1 3 4 }
+ T{ ##write-barrier f 1 2 3 }
+} ] [ 3 get instructions>> ] unit-test
-! Copyright (C) 2008, 2009 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors namespaces assocs sets sequences
-compiler.cfg compiler.cfg.instructions compiler.cfg.rpo ;
+compiler.cfg compiler.cfg.instructions compiler.cfg.rpo
+compiler.cfg.dataflow-analysis fry combinators.short-circuit ;
IN: compiler.cfg.write-barrier
! Eliminate redundant write barrier hits.
M: insn eliminate-write-barrier drop t ;
+FORWARD-ANALYSIS: safe
+
+: 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
+ instructions>> over '[
+ dup ##write-barrier? [
+ src>> _ conjoin
+ ] [ drop ] if
+ ] 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) ;
+
: write-barriers-step ( bb -- )
- H{ } clone safe set
+ dup safe-start safe set
H{ } clone mutated set
instructions>> [ eliminate-write-barrier ] filter-here ;
: eliminate-write-barriers ( cfg -- cfg' )
+ dup compute-safe-sets
dup [ write-barriers-step ] each-basic-block ;