! See http://factorcode.org/license.txt for BSD license.
USING: kernel compiler.cfg.representations
compiler.cfg.scheduling compiler.cfg.gc-checks
-compiler.cfg.save-contexts compiler.cfg.ssa.destruction
-compiler.cfg.build-stack-frame compiler.cfg.linear-scan
-compiler.cfg.stacks.uninitialized ;
+compiler.cfg.write-barrier compiler.cfg.save-contexts
+compiler.cfg.ssa.destruction compiler.cfg.build-stack-frame
+compiler.cfg.linear-scan compiler.cfg.stacks.uninitialized ;
IN: compiler.cfg.finalization
: finalize-cfg ( cfg -- cfg' )
select-representations
schedule-instructions
insert-gc-checks
+ eliminate-write-barriers
dup compute-uninitialized-sets
insert-save-contexts
destruct-ssa
compiler.cfg.alias-analysis
compiler.cfg.value-numbering
compiler.cfg.copy-prop
-compiler.cfg.dce
-compiler.cfg.write-barrier ;
+compiler.cfg.dce ;
IN: compiler.cfg.optimizer
: optimize-cfg ( cfg -- cfg' )
alias-analysis
value-numbering
copy-propagation
- eliminate-dead-code
- eliminate-write-barriers ;
+ eliminate-dead-code ;
--- /dev/null
+USING: compiler.cfg.instructions compiler.cfg.write-barrier
+tools.test ;
+IN: compiler.cfg.write-barrier.tests
+
+! Do need a write barrier on a random store.
+[
+ V{
+ T{ ##peek f 1 }
+ T{ ##set-slot f 2 1 3 }
+ T{ ##write-barrier f 1 3 }
+ }
+] [
+ V{
+ T{ ##peek f 1 }
+ T{ ##set-slot f 2 1 3 }
+ T{ ##write-barrier f 1 3 }
+ } write-barriers-step
+] unit-test
+
+[
+ V{
+ T{ ##peek f 1 }
+ T{ ##set-slot-imm f 2 1 }
+ T{ ##write-barrier-imm f 1 }
+ }
+] [
+ V{
+ T{ ##peek f 1 }
+ T{ ##set-slot-imm f 2 1 }
+ T{ ##write-barrier-imm f 1 }
+ } write-barriers-step
+] unit-test
+
+! Don't need a write barrier on freshly allocated objects.
+[
+ V{
+ T{ ##allot f 1 }
+ T{ ##set-slot f 2 1 3 }
+ }
+] [
+ V{
+ T{ ##allot f 1 }
+ T{ ##set-slot f 2 1 3 }
+ T{ ##write-barrier f 1 3 }
+ } write-barriers-step
+] unit-test
+
+[
+ V{
+ T{ ##allot f 1 }
+ T{ ##set-slot-imm f 2 1 }
+ }
+] [
+ V{
+ T{ ##allot f 1 }
+ T{ ##set-slot-imm f 2 1 }
+ T{ ##write-barrier-imm f 1 }
+ } write-barriers-step
+] unit-test
+
+! Do need a write barrier if there's a subroutine call between
+! the allocation and the store.
+[
+ V{
+ T{ ##allot f 1 }
+ T{ ##box }
+ T{ ##set-slot f 2 1 3 }
+ T{ ##write-barrier f 1 3 }
+ }
+] [
+ V{
+ T{ ##allot f 1 }
+ T{ ##box }
+ T{ ##set-slot f 2 1 3 }
+ T{ ##write-barrier f 1 3 }
+ } write-barriers-step
+] unit-test
+
+[
+ V{
+ T{ ##allot f 1 }
+ T{ ##box }
+ T{ ##set-slot-imm f 2 1 }
+ T{ ##write-barrier-imm f 1 }
+ }
+] [
+ V{
+ T{ ##allot f 1 }
+ T{ ##box }
+ T{ ##set-slot-imm f 2 1 }
+ T{ ##write-barrier-imm f 1 }
+ } write-barriers-step
+] unit-test
FROM: namespaces => set ;
IN: compiler.cfg.write-barrier
+! This pass must run after GC check insertion and scheduling.
+
SYMBOL: fresh-allocations
SYMBOL: mutated-objects
obj>> mutated-objects get conjoin t ;
: needs-write-barrier? ( insn -- ? )
- { [ fresh-allocations get key? not ] [ mutated-objects get key? ] } 1&& ;
+ {
+ [ fresh-allocations get key? not ]
+ [ mutated-objects get key? ]
+ } 1&& ;
M: ##write-barrier eliminate-write-barrier
src>> needs-write-barrier? ;
M: ##write-barrier-imm eliminate-write-barrier
src>> needs-write-barrier? ;
+M: gc-map-insn eliminate-write-barrier
+ fresh-allocations get clear-assoc ;
+
M: ##copy eliminate-write-barrier
"Run copy propagation first" throw ;
aa-indirect-1 >>x
] compile-call
] unit-test
+
+! Write barrier elimination was being done before scheduling and
+! GC check insertion, and didn't take subroutine calls into
+! account. Oops...
+: write-barrier-elim-in-wrong-place ( -- obj )
+ ! A callback used below
+ void { } cdecl [ compact-gc ] alien-callback
+ ! Allocate an object A in the nursery
+ 1 f <array>
+ ! Subroutine call promotes the object to tenured
+ swap void { } cdecl alien-indirect
+ ! Allocate another object B in the nursery, store it into
+ ! the first
+ 1 f <array> over set-first
+ ! Now object A's card should be marked and minor GC should
+ ! promote B to aging
+ minor-gc
+ ! Do stuff
+ [ 100 [ ] times ] infer.
+ ;
+
+[ { { f } } ] [ write-barrier-elim-in-wrong-place ] unit-test