basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor

   1 ! Copyright (C) 2009, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays assocs combinators fry hints kernel locals
   4 math sequences sets sorting splitting namespaces linked-assocs
   5 combinators.short-circuit compiler.utilities
   6 compiler.cfg.linear-scan.allocation.state
   7 compiler.cfg.linear-scan.allocation.splitting
   8 compiler.cfg.linear-scan.live-intervals ;
   9 IN: compiler.cfg.linear-scan.allocation.spilling
  10
  11 ERROR: bad-live-ranges interval ;
  12
  13 : check-ranges ( live-interval -- )
  14     check-allocation? get [
  15         dup ranges>> [ [ from>> ] [ to>> ] bi <= ] all?
  16         [ drop ] [ bad-live-ranges ] if
  17     ] [ drop ] if ;
  18
  19 : trim-before-ranges ( live-interval -- )
  20     [ ranges>> ] [ last-use n>> 1 + ] bi
  21     [ '[ from>> _ <= ] filter! drop ]
  22     [ swap last to<< ]
  23     2bi ;
  24
  25 : trim-after-ranges ( live-interval -- )
  26     [ ranges>> ] [ first-use n>> ] bi
  27     [ '[ to>> _ >= ] filter! drop ]
  28     [ swap first from<< ]
  29     2bi ;
  30
  31 : assign-spill ( live-interval -- )
  32     dup [ vreg>> ] [ last-use rep>> ] bi
  33     assign-spill-slot >>spill-to drop ;
  34
  35 : spill-before ( before -- before/f )
  36     ! If the interval does not have any usages before the spill location,
  37     ! then it is the second child of an interval that was split. We reload
  38     ! the value and let the resolve pass insert a split later.
  39     dup uses>> empty? [ drop f ] [
  40         {
  41             [ ]
  42             [ assign-spill ]
  43             [ trim-before-ranges ]
  44             [ compute-start/end ]
  45             [ check-ranges ]
  46         } cleave
  47     ] if ;
  48
  49 : assign-reload ( live-interval -- )
  50     dup [ vreg>> ] [ first-use rep>> ] bi
  51     assign-spill-slot >>reload-from drop ;
  52
  53 : spill-after ( after -- after/f )
  54     ! If the interval has no more usages after the spill location,
  55     ! then it is the first child of an interval that was split.  We
  56     ! spill the value and let the resolve pass insert a reload later.
  57     dup uses>> empty? [ drop f ] [
  58         {
  59             [ ]
  60             [ assign-reload ]
  61             [ trim-after-ranges ]
  62             [ compute-start/end ]
  63             [ check-ranges ]
  64         } cleave
  65     ] if ;
  66
  67 : split-for-spill ( live-interval n -- before after )
  68     split-interval [ spill-before ] [ spill-after ] bi* ;
  69
  70 : find-use-position ( live-interval new -- n )
  71     [ uses>> ] [ start>> '[ n>> _ >= ] ] bi* find nip
  72     [ n>> ] [ 1/0. ] if* ;
  73
  74 : find-use-positions ( live-intervals new assoc -- )
  75     '[ [ _ find-use-position ] [ reg>> ] bi _ add-use-position ] each ;
  76
  77 : active-positions ( new assoc -- )
  78     [ [ active-intervals-for ] keep ] dip
  79     find-use-positions ;
  80
  81 : inactive-positions ( new assoc -- )
  82     [
  83         [ inactive-intervals-for ] keep
  84         [ '[ _ intervals-intersect? ] filter ] keep
  85     ] dip
  86     find-use-positions ;
  87
  88 : spill-status ( new -- use-pos )
  89     H{ } <linked-assoc>
  90     [ inactive-positions ] [ active-positions ] [ nip ] 2tri
  91     >alist alist-max ;
  92
  93 : spill-new? ( new pair -- ? )
  94     [ first-use n>> ] [ second ] bi* > ;
  95
  96 : spill-new ( new pair -- )
  97     drop spill-after add-unhandled ;
  98
  99 : spill ( live-interval n -- )
 100     split-for-spill
 101     [ [ add-handled ] when* ]
 102     [ [ add-unhandled ] when* ] bi* ;
 103
 104 :: spill-intersecting-active ( new reg -- )
 105     ! If there is an active interval using 'reg' (there should be at
 106     ! most one) are split and spilled and removed from the inactive
 107     ! set.
 108     new active-intervals-for [ [ reg>> reg = ] find swap dup ] keep
 109     '[ _ remove-nth! drop  new start>> spill ] [ 2drop ] if ;
 110
 111 :: spill-intersecting-inactive ( new reg -- )
 112     ! Any inactive intervals using 'reg' are split and spilled
 113     ! and removed from the inactive set.
 114     new inactive-intervals-for [
 115         dup reg>> reg = [
 116             dup new intervals-intersect? [
 117                 new start>> spill f
 118             ] [ drop t ] if
 119         ] [ drop t ] if
 120     ] filter! drop ;
 121
 122 : spill-intersecting ( new reg -- )
 123     ! Split and spill all active and inactive intervals
 124     ! which intersect 'new' and use 'reg'.
 125     [ spill-intersecting-active ]
 126     [ spill-intersecting-inactive ]
 127     2bi ;
 128
 129 : spill-available ( new pair -- )
 130     ! A register would become fully available if all
 131     ! active and inactive intervals using it were split
 132     ! and spilled.
 133     [ first spill-intersecting ] [ register-available ] 2bi ;
 134
 135 : spill-partially-available ( new pair -- )
 136     ! A register would be available for part of the new
 137     ! interval's lifetime if all active and inactive intervals
 138     ! using that register were split and spilled.
 139     [ second 1 - split-for-spill [ add-unhandled ] when* ] keep
 140     '[ _ spill-available ] when* ;
 141
 142 : assign-blocked-register ( new -- )
 143     dup spill-status {
 144         { [ 2dup spill-new? ] [ spill-new ] }
 145         { [ 2dup register-available? ] [ spill-available ] }
 146         [ spill-partially-available ]
 147     } cond ;