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

   1 ! Copyright (C) 2009, 2010 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs combinators combinators.short-circuit
   4 compiler.cfg.linear-scan.allocation.splitting
   5 compiler.cfg.linear-scan.allocation.state
   6 compiler.cfg.linear-scan.live-intervals
   7 compiler.cfg.linear-scan.ranges compiler.utilities kernel
   8 linked-assocs math namespaces sequences ;
   9 IN: compiler.cfg.linear-scan.allocation.spilling
  10
  11 : trim-before-ranges ( live-interval -- )
  12     dup last-use n>> 1 + swap [ fix-upper-bound ] change-ranges drop ;
  13
  14 : trim-after-ranges ( live-interval -- )
  15     dup first-use n>> swap [ fix-lower-bound ] change-ranges drop ;
  16
  17 : last-use-rep ( live-interval -- rep )
  18     last-use { [ def-rep>> ] [ use-rep>> ] } 1|| ; inline
  19
  20 : assign-spill ( live-interval -- )
  21     dup last-use-rep dup [
  22         >>spill-rep
  23         dup [ vreg>> ] [ spill-rep>> ] bi
  24         assign-spill-slot >>spill-to drop
  25     ] [ 2drop ] if ;
  26
  27 ERROR: bad-live-ranges interval ;
  28
  29 : check-ranges ( ranges -- )
  30     check-allocation? get [
  31         dup ranges>> valid-ranges? [ drop ] [ bad-live-ranges ] if
  32     ] [ drop ] if ;
  33
  34 : spill-before ( before -- before/f )
  35     dup uses>> empty? [ drop f ] [
  36         {
  37             [ ]
  38             [ assign-spill ]
  39             [ trim-before-ranges ]
  40             [ check-ranges ]
  41         } cleave
  42     ] if ;
  43
  44 : first-use-rep ( live-interval -- rep/f )
  45     first-use use-rep>> ; inline
  46
  47 : assign-reload ( live-interval -- )
  48     dup first-use-rep dup [
  49         >>reload-rep
  50         dup [ vreg>> ] [ reload-rep>> ] bi
  51         assign-spill-slot >>reload-from drop
  52     ] [ 2drop ] if ;
  53
  54 : spill-after ( after -- after/f )
  55     dup uses>> empty? [ drop f ] [
  56         {
  57             [ ]
  58             [ assign-reload ]
  59             [ trim-after-ranges ]
  60             [ check-ranges ]
  61         } cleave
  62     ] if ;
  63
  64 : split-for-spill ( live-interval n -- before/f after/f )
  65     split-interval [ spill-before ] [ spill-after ] bi* ;
  66
  67 : find-next-use ( live-interval new -- n )
  68     [ uses>> ] [ live-interval-start ] bi*
  69     '[ [ spill-slot?>> not ] [ n>> ] bi _ >= and ] find nip
  70     [ n>> ] [ 1/0. ] if* ;
  71
  72 : find-use-positions ( live-intervals new assoc -- )
  73     '[ [ _ find-next-use ] [ reg>> ] bi _ add-use-position ] each ;
  74
  75 : active-positions ( new assoc -- )
  76     [ [ active-intervals-for ] keep ] dip
  77     find-use-positions ;
  78
  79 : inactive-positions ( new assoc -- )
  80     [
  81         [ inactive-intervals-for ] keep
  82         [ '[ _ intervals-intersect? ] filter ] keep
  83     ] dip
  84     find-use-positions ;
  85
  86 : spill-status ( new -- use-pos )
  87     <linked-hash>
  88     [ inactive-positions ] [ active-positions ] [ nip ] 2tri
  89     >alist alist-max ;
  90
  91 : spill-new? ( new pair -- ? )
  92     [ first-use n>> ] [ second ] bi* > ;
  93
  94 : spill-new ( new pair -- )
  95     drop spill-after add-unhandled ;
  96
  97 : spill ( live-interval n -- )
  98     split-for-spill
  99     [ [ add-handled ] when* ] [ [ add-unhandled ] when* ] bi* ;
 100
 101 :: spill-intersecting-active ( new reg -- )
 102     new active-intervals-for [ [ reg>> reg = ] find swap dup ] keep
 103     '[ _ remove-nth! drop new live-interval-start spill ] [ 2drop ] if ;
 104
 105 :: spill-intersecting-inactive ( new reg -- )
 106     new inactive-intervals-for [
 107         dup reg>> reg = [
 108             dup new intervals-intersect? [
 109                 new live-interval-start spill f
 110             ] [ drop t ] if
 111         ] [ drop t ] if
 112     ] filter! drop ;
 113
 114 : spill-intersecting ( new reg -- )
 115     [ spill-intersecting-active ]
 116     [ spill-intersecting-inactive ]
 117     2bi ;
 118
 119 : spill-available ( new pair -- )
 120     [ first spill-intersecting ] [ register-available ] 2bi ;
 121
 122 : spill-partially-available ( new pair -- )
 123     [ second 1 - split-for-spill [ add-unhandled ] when* ] keep
 124     '[ _ spill-available ] when* ;
 125
 126 : assign-blocked-register ( live-interval -- )
 127     dup spill-status {
 128         { [ 2dup spill-new? ] [ spill-new ] }
 129         { [ 2dup register-available? ] [ spill-available ] }
 130         [ spill-partially-available ]
 131     } cond ;