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

   1 ! Copyright (C) 2008, 2010 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 ! This pass must run after GC check insertion and scheduling.
  10
  11 SYMBOL: fresh-allocations
  12
  13 SYMBOL: mutated-objects
  14
  15 SYMBOL: copies
  16
  17 : resolve-copy ( src -- dst )
  18     copies get ?at drop ;
  19
  20 GENERIC: eliminate-write-barrier ( insn -- ? )
  21
  22 : fresh-allocation ( vreg -- )
  23     fresh-allocations get adjoin ;
  24
  25 M: ##allot eliminate-write-barrier
  26     dst>> fresh-allocation t ;
  27
  28 : mutated-object ( vreg -- )
  29     resolve-copy mutated-objects get adjoin ;
  30
  31 M: ##set-slot eliminate-write-barrier
  32     obj>> mutated-object t ;
  33
  34 M: ##set-slot-imm eliminate-write-barrier
  35     obj>> mutated-object t ;
  36
  37 : needs-write-barrier? ( insn -- ? )
  38     resolve-copy {
  39         [ fresh-allocations get in? not ]
  40         [ mutated-objects get in? ]
  41     } 1&& ;
  42
  43 M: ##write-barrier eliminate-write-barrier
  44     src>> needs-write-barrier? ;
  45
  46 M: ##write-barrier-imm eliminate-write-barrier
  47     src>> needs-write-barrier? ;
  48
  49 M: gc-map-insn eliminate-write-barrier
  50     fresh-allocations get clear-set ;
  51
  52 M: ##copy eliminate-write-barrier
  53     [ src>> resolve-copy ] [ dst>> ] bi copies get set-at t ;
  54
  55 M: insn eliminate-write-barrier drop t ;
  56
  57 : write-barriers-step ( insns -- insns' )
  58     HS{ } clone fresh-allocations set
  59     HS{ } clone mutated-objects set
  60     H{ } clone copies set
  61     [ eliminate-write-barrier ] filter! ;
  62
  63 : eliminate-write-barriers ( cfg -- )
  64     [ write-barriers-step ] simple-optimization ;