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: namespaces assocs kernel fry accessors sequences make math locals
   4 combinators compiler.cfg compiler.cfg.hats compiler.cfg.instructions
   5 compiler.cfg.utilities compiler.cfg.rpo compiler.cfg.stacks.local
   6 compiler.cfg.stacks.global compiler.cfg.stacks.height
   7 compiler.cfg.predecessors ;
   8 IN: compiler.cfg.stacks.finalize
   9
  10 ! This pass inserts peeks and replaces.
  11
  12 :: inserting-peeks ( from to -- assoc )
  13     ! A peek is inserted on an edge if the destination anticipates
  14     ! the stack location, the source does not anticipate it and
  15     ! it is not available from the source in a register.
  16     to anticip-in
  17     from anticip-out from avail-out assoc-union
  18     assoc-diff ;
  19
  20 :: inserting-replaces ( from to -- assoc )
  21     ! A replace is inserted on an edge if two conditions hold:
  22     ! - the location is not dead at the destination, OR
  23     !   the location is live at the destination but not available
  24     !   at the destination
  25     ! - the location is pending in the source but not the destination
  26     from pending-out to pending-in assoc-diff
  27     to dead-in to live-in to anticip-in assoc-diff assoc-diff
  28     assoc-diff ;
  29
  30 : each-insertion ( ... assoc bb quot: ( ... vreg loc -- ... ) -- ... )
  31     '[ drop [ loc>vreg ] [ _ untranslate-loc ] bi @ ] assoc-each ; inline
  32
  33 ERROR: bad-peek dst loc ;
  34
  35 : insert-peeks ( from to -- )
  36     [ inserting-peeks ] keep
  37     [ dup n>> 0 < [ bad-peek ] [ ##peek ] if ] each-insertion ;
  38
  39 : insert-replaces ( from to -- )
  40     [ inserting-replaces ] keep
  41     [ dup n>> 0 < [ 2drop ] [ ##replace ] if ] each-insertion ;
  42
  43 : visit-edge ( from to -- )
  44     ! If both blocks are subroutine calls, don't bother
  45     ! computing anything.
  46     2dup [ kill-block? ] both? [ 2drop ] [
  47         2dup [ [ insert-replaces ] [ insert-peeks ] 2bi ] V{ } make
  48         [ 2drop ] [ insert-simple-basic-block ] if-empty
  49     ] if ;
  50
  51 : visit-block ( bb -- )
  52     [ predecessors>> ] keep '[ _ visit-edge ] each ;
  53
  54 : finalize-stack-shuffling ( cfg -- cfg' )
  55     needs-predecessors
  56
  57     dup [ visit-block ] each-basic-block
  58
  59     cfg-changed ;