basis/compiler/cfg/block-joining/block-joining.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors combinators.short-circuit kernel sequences math
   4 compiler.utilities compiler.cfg compiler.cfg.instructions compiler.cfg.rpo
   5 compiler.cfg.utilities ;
   6 IN: compiler.cfg.block-joining
   7
   8 ! Joining blocks that are not calls and are connected by a single CFG edge.
   9 ! Predecessors must be recomputed after this. Also this pass does not
  10 ! update ##phi nodes and should therefore only run before stack analysis.
  11
  12 : kill-vreg-block? ( bb -- ? )
  13     instructions>> {
  14         [ length 2 >= ]
  15         [ penultimate kill-vreg-insn? ]
  16     } 1&& ;
  17
  18 : predecessor ( bb -- pred )
  19     predecessors>> first ; inline
  20
  21 : join-block? ( bb -- ? )
  22     {
  23         [ predecessors>> length 1 = ]
  24         [ predecessor kill-vreg-block? not ]
  25         [ predecessor successors>> length 1 = ]
  26         [ [ predecessor ] keep back-edge? not ]
  27     } 1&& ;
  28
  29 : join-instructions ( bb pred -- )
  30     [ instructions>> ] bi@ dup pop* push-all ;
  31
  32 : update-successors ( bb pred -- )
  33     [ successors>> ] dip (>>successors) ;
  34
  35 : join-block ( bb pred -- )
  36     [ join-instructions ] [ update-successors ] 2bi ;
  37
  38 : join-blocks ( cfg -- cfg' )
  39     dup post-order [
  40         dup join-block?
  41         [ dup predecessor join-block ] [ drop ] if
  42     ] each
  43     cfg-changed ;