basis/compiler/cfg/stacks/vacant/vacant.factor

   1 USING: accessors arrays assocs compiler.cfg.instructions
   2 compiler.cfg.linearization compiler.cfg.stacks.map fry kernel math sequences ;
   3 IN: compiler.cfg.stacks.vacant
   4
   5 ! ! Utils
   6 : write-slots ( tuple values slots -- )
   7     [ execute( x y -- z ) ] 2each drop ;
   8
   9 : vacant>bits ( vacant --  bits )
  10     [ { } ] [
  11         dup supremum 1 + 1 <array>
  12         [ '[ _ 0 -rot set-nth ] each ] keep
  13     ] if-empty ;
  14
  15 : stack>overinitialized ( stack -- seq )
  16     second [ 0 < ] filter ;
  17
  18 : overinitialized>bits ( overinitialized -- bits )
  19     [ neg 1 - ] map vacant>bits ;
  20
  21 : stack>scrub-and-check ( stack -- pair )
  22     [ stack>vacant vacant>bits ]
  23     [ stack>overinitialized overinitialized>bits ] bi 2array ;
  24
  25 ! Operations on the analysis state
  26 : state>gc-data ( state -- gc-data )
  27     [ stack>scrub-and-check ] map ;
  28
  29 : set-gc-map ( state gc-map -- )
  30     swap state>gc-data concat
  31     { >>scrub-d >>check-d >>scrub-r >>check-r } write-slots ;
  32
  33 : fill-gc-maps ( cfg -- )
  34     [ trace-stack-state ] [ cfg>insns [ gc-map-insn? ] filter ] bi
  35     [ [ insn#>> of ] [ gc-map>> ] bi set-gc-map ] with each ;