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