basis/compiler/cfg/stacks/finalize/finalize.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs compiler.cfg.checker compiler.cfg
   4 compiler.cfg.instructions compiler.cfg.predecessors compiler.cfg.rpo
   5 compiler.cfg.stacks.global compiler.cfg.stacks.height
   6 compiler.cfg.stacks.local compiler.cfg.utilities fry kernel
   7 locals make math sequences sets ;
   8 IN: compiler.cfg.stacks.finalize
   9
  10 :: inserting-peeks ( from to -- set )
  11     to anticip-in
  12     from anticip-out from avail-out union
  13     diff ;
  14
  15 :: inserting-replaces ( from to -- set )
  16     from pending-out to pending-in diff
  17     to dead-in to live-in to anticip-in diff diff
  18     diff ;
  19
  20 : each-insertion ( ... set bb quot: ( ... vreg loc -- ... ) -- ... )
  21     [ members ] 2dip '[ [ loc>vreg ] [ _ untranslate-loc ] bi @ ] each ; inline
  22
  23 ERROR: bad-peek dst loc ;
  24
  25 : insert-peeks ( from to -- )
  26     [ inserting-peeks ] keep
  27     [ dup n>> 0 < [ throw-bad-peek ] [ ##peek, ] if ] each-insertion ;
  28
  29 : insert-replaces ( from to -- )
  30     [ inserting-replaces ] keep
  31     [ dup n>> 0 < [ 2drop ] [ ##replace, ] if ] each-insertion ;
  32
  33 : visit-edge ( from to -- )
  34     ! If both blocks are subroutine calls, don't bother
  35     ! computing anything.
  36     2dup [ kill-block?>> ] both? [ 2drop ] [
  37         2dup [ [ insert-replaces ] [ insert-peeks ] 2bi ##branch, ] V{ } make
  38         insert-basic-block
  39     ] if ;
  40
  41 : visit-block ( bb -- )
  42     [ predecessors>> ] keep '[ _ visit-edge ] each ;
  43
  44 : finalize-stack-shuffling ( cfg -- )
  45     [ [ visit-block ] each-basic-block ] [ cfg-changed ] bi ;