diff --git a/basis/compiler/cfg/write-barrier/write-barrier.factor b/basis/compiler/cfg/write-barrier/write-barrier.factor index bcec542501..2f32a4ca81 100644 --- a/basis/compiler/cfg/write-barrier/write-barrier.factor +++ b/basis/compiler/cfg/write-barrier/write-barrier.factor @@ -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 ;