]> gitweb.factorcode.org Git - factor.git/commitdiff
compiler.cfg.write-barrier: simplify a little bit. It doesn't need to do copy propaga...
authorSlava Pestov <slava@shill.local>
Fri, 24 Jul 2009 10:29:28 +0000 (05:29 -0500)
committerSlava Pestov <slava@shill.local>
Fri, 24 Jul 2009 10:29:28 +0000 (05:29 -0500)
basis/compiler/cfg/write-barrier/write-barrier.factor

index bcec54250124915922cbde8c95fd626eadc20887..2f32a4ca81a0931906656e2c2203f0ce73103263 100644 (file)
@@ -1,8 +1,7 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors namespaces assocs sets sequences locals
-compiler.cfg compiler.cfg.instructions compiler.cfg.copy-prop
-compiler.cfg.rpo ;
+USING: kernel accessors namespaces assocs sets sequences
+compiler.cfg compiler.cfg.instructions compiler.cfg.rpo ;
 IN: compiler.cfg.write-barrier
 
 ! Eliminate redundant write barrier hits.
@@ -14,33 +13,27 @@ SYMBOL: safe
 ! Objects which have been mutated
 SYMBOL: mutated
 
-GENERIC: eliminate-write-barrier ( insn -- insn' )
+GENERIC: eliminate-write-barrier ( insn -- ? )
 
 M: ##allot eliminate-write-barrier
-    dup dst>> safe get conjoin ;
+    dst>> safe get conjoin t ;
 
 M: ##write-barrier eliminate-write-barrier
-    dup src>> resolve dup
-    [ safe get key? not ]
-    [ mutated get key? ] bi and
-    [ safe get conjoin ] [ 2drop f ] if ;
-
-M: ##copy eliminate-write-barrier
-    dup record-copy ;
+    src>> dup [ safe get key? not ] [ mutated get key? ] bi and
+    [ safe get conjoin t ] [ drop f ] if ;
 
 M: ##set-slot eliminate-write-barrier
-    dup obj>> resolve mutated get conjoin ;
+    obj>> mutated get conjoin t ;
 
 M: ##set-slot-imm eliminate-write-barrier
-    dup obj>> resolve mutated get conjoin ;
+    obj>> mutated get conjoin t ;
 
-M: insn eliminate-write-barrier ;
+M: insn eliminate-write-barrier drop t ;
 
-: write-barriers-step ( insns -- insns' )
+: write-barriers-step ( bb -- )
     H{ } clone safe set
     H{ } clone mutated set
-    H{ } clone copies set
-    [ eliminate-write-barrier ] map sift ;
+    instructions>> [ eliminate-write-barrier ] filter-here ;
 
 : eliminate-write-barriers ( cfg -- cfg' )
-    [ write-barriers-step ] local-optimization ;
+    dup [ write-barriers-step ] each-basic-block ;