Making write barrier elimination global

db4
Daniel Ehrenberg 2009-08-11 21:21:21 -05:00
parent 422dd24bad
commit 1a7ab59f56
4 changed files with 105 additions and 6 deletions

View File

@ -0,0 +1,2 @@
Slava Pestov
Daniel Ehrenberg

View File

@ -1,7 +1,9 @@
! 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 )
@ -70,3 +72,71 @@ IN: compiler.cfg.write-barrier.tests
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

View File

@ -1,7 +1,8 @@
! 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.
@ -30,10 +31,36 @@ M: ##set-slot-imm eliminate-write-barrier
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 ;

View File

@ -165,8 +165,8 @@ error-display "toolbar" f {
{ 5 5 } >>gap
error-list <error-list-toolbar> f track-add
error-list source-file-table>> <scroller> "Source files" <labeled-gadget> 1/4 track-add
error-list error-table>> <scroller> "Errors" <labeled-gadget> 1/2 track-add
error-list error-display>> "Details" <labeled-gadget> 1/4 track-add
error-list error-table>> <scroller> "Errors" <labeled-gadget> 1/4 track-add
error-list error-display>> "Details" <labeled-gadget> 1/2 track-add
{ 5 5 } <filled-border> 1 track-add ;
M: error-list-gadget focusable-child*