basis/compiler/cfg/write-barrier/write-barrier.factor

   1 ! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs combinators.short-circuit
   4 compiler.cfg.instructions compiler.cfg.rpo kernel namespaces
   5 sequences sets ;
   6 FROM: namespaces => set ;
   7 IN: compiler.cfg.write-barrier
   8
   9 SYMBOL: fresh-allocations
  10
  11 SYMBOL: mutated-objects
  12
  13 GENERIC: eliminate-write-barrier ( insn -- ? )
  14
  15 M: ##allot eliminate-write-barrier
  16     dst>> fresh-allocations get conjoin t ;
  17
  18 M: ##set-slot eliminate-write-barrier
  19     obj>> mutated-objects get conjoin t ;
  20
  21 M: ##set-slot-imm eliminate-write-barrier
  22     obj>> mutated-objects get conjoin t ;
  23
  24 : needs-write-barrier? ( insn -- ? )
  25     { [ fresh-allocations get key? not ] [ mutated-objects get key? ] } 1&& ;
  26
  27 M: ##write-barrier eliminate-write-barrier
  28     src>> needs-write-barrier? ;
  29
  30 M: ##write-barrier-imm eliminate-write-barrier
  31     src>> needs-write-barrier? ;
  32
  33 M: ##copy eliminate-write-barrier
  34     "Run copy propagation first" throw ;
  35
  36 M: insn eliminate-write-barrier drop t ;
  37
  38 : write-barriers-step ( bb -- )
  39     H{ } clone fresh-allocations set
  40     H{ } clone mutated-objects set
  41     instructions>> [ eliminate-write-barrier ] filter! drop ;
  42
  43 : eliminate-write-barriers ( cfg -- cfg' )
  44     dup [ write-barriers-step ] each-basic-block ;