compiler.cfg.write-barrier: handle ##copy instructions

db4
Slava Pestov 2010-09-05 23:07:30 -07:00
parent 54f97557e6
commit add75411a0
1 changed files with 17 additions and 5 deletions

View File

@ -12,19 +12,30 @@ SYMBOL: fresh-allocations
SYMBOL: mutated-objects SYMBOL: mutated-objects
SYMBOL: copies
: resolve-copy ( src -- dst )
copies get ?at drop ;
GENERIC: eliminate-write-barrier ( insn -- ? ) GENERIC: eliminate-write-barrier ( insn -- ? )
: fresh-allocation ( vreg -- )
fresh-allocations get conjoin ;
M: ##allot eliminate-write-barrier M: ##allot eliminate-write-barrier
dst>> fresh-allocations get conjoin t ; dst>> fresh-allocation t ;
: mutated-object ( vreg -- )
resolve-copy mutated-objects get conjoin ;
M: ##set-slot eliminate-write-barrier M: ##set-slot eliminate-write-barrier
obj>> mutated-objects get conjoin t ; obj>> mutated-object t ;
M: ##set-slot-imm eliminate-write-barrier M: ##set-slot-imm eliminate-write-barrier
obj>> mutated-objects get conjoin t ; obj>> mutated-object t ;
: needs-write-barrier? ( insn -- ? ) : needs-write-barrier? ( insn -- ? )
{ resolve-copy {
[ fresh-allocations get key? not ] [ fresh-allocations get key? not ]
[ mutated-objects get key? ] [ mutated-objects get key? ]
} 1&& ; } 1&& ;
@ -39,13 +50,14 @@ M: gc-map-insn eliminate-write-barrier
fresh-allocations get clear-assoc ; fresh-allocations get clear-assoc ;
M: ##copy eliminate-write-barrier M: ##copy eliminate-write-barrier
"Run copy propagation first" throw ; [ src>> ] [ dst>> ] bi copies get set-at t ;
M: insn eliminate-write-barrier drop t ; M: insn eliminate-write-barrier drop t ;
: write-barriers-step ( insns -- insns' ) : write-barriers-step ( insns -- insns' )
H{ } clone fresh-allocations set H{ } clone fresh-allocations set
H{ } clone mutated-objects set H{ } clone mutated-objects set
H{ } clone copies set
[ eliminate-write-barrier ] filter! ; [ eliminate-write-barrier ] filter! ;
: eliminate-write-barriers ( cfg -- cfg ) : eliminate-write-barriers ( cfg -- cfg )