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

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays accessors assocs combinators cpu.architecture fry
   4 heaps kernel math math.order namespaces sequences vectors
   5 linked-assocs compiler.cfg compiler.cfg.registers
   6 compiler.cfg.instructions
   7 compiler.cfg.linear-scan.live-intervals ;
   8 IN: compiler.cfg.linear-scan.allocation.state
   9
  10 ! Start index of current live interval. We ensure that all
  11 ! live intervals added to the unhandled set have a start index
  12 ! strictly greater than this one. This ensures that we can catch
  13 ! infinite loop situations. We also ensure that all live
  14 ! intervals added to the handled set have an end index strictly
  15 ! smaller than this one. This helps catch bugs.
  16 SYMBOL: progress
  17
  18 : check-unhandled ( live-interval -- )
  19     start>> progress get <= [ "check-unhandled" throw ] when ; inline
  20
  21 : check-handled ( live-interval -- )
  22     end>> progress get > [ "check-handled" throw ] when ; inline
  23
  24 ! Mapping from register classes to sequences of machine registers
  25 SYMBOL: registers
  26
  27 ! Vector of active live intervals
  28 SYMBOL: active-intervals
  29
  30 : active-intervals-for ( live-interval -- seq )
  31     reg-class>> active-intervals get at ;
  32
  33 : add-active ( live-interval -- )
  34     dup active-intervals-for push ;
  35
  36 : delete-active ( live-interval -- )
  37     dup active-intervals-for remove-eq! drop ;
  38
  39 : assign-free-register ( new registers -- )
  40     pop >>reg add-active ;
  41
  42 ! Vector of inactive live intervals
  43 SYMBOL: inactive-intervals
  44
  45 : inactive-intervals-for ( live-interval -- seq )
  46     reg-class>> inactive-intervals get at ;
  47
  48 : add-inactive ( live-interval -- )
  49     dup inactive-intervals-for push ;
  50
  51 : delete-inactive ( live-interval -- )
  52     dup inactive-intervals-for remove-eq! drop ;
  53
  54 ! Vector of handled live intervals
  55 SYMBOL: handled-intervals
  56
  57 : add-handled ( live-interval -- )
  58     [ check-handled ] [ handled-intervals get push ] bi ;
  59
  60 : finished? ( n live-interval -- ? ) end>> swap < ;
  61
  62 : finish ( n live-interval -- keep? )
  63     nip add-handled f ;
  64
  65 SYMBOL: check-allocation?
  66
  67 ERROR: register-already-used live-interval ;
  68
  69 : check-activate ( live-interval -- )
  70     check-allocation? get [
  71         dup [ reg>> ] [ active-intervals-for [ reg>> ] map ] bi member?
  72         [ register-already-used ] [ drop ] if
  73     ] [ drop ] if ;
  74
  75 : activate ( n live-interval -- keep? )
  76     dup check-activate
  77     nip add-active f ;
  78
  79 : deactivate ( n live-interval -- keep? )
  80     nip add-inactive f ;
  81
  82 : don't-change ( n live-interval -- keep? ) 2drop t ;
  83
  84 ! Moving intervals between active and inactive sets
  85 : process-intervals ( n symbol quots -- )
  86     ! symbol stores an alist mapping register classes to vectors
  87     [ get values ] dip '[ [ _ cond ] with filter! drop ] with each ; inline
  88
  89 : deactivate-intervals ( n -- )
  90     ! Any active intervals which have ended are moved to handled
  91     ! Any active intervals which cover the current position
  92     ! are moved to inactive
  93     active-intervals {
  94         { [ 2dup finished? ] [ finish ] }
  95         { [ 2dup covers? not ] [ deactivate ] }
  96         [ don't-change ]
  97     } process-intervals ;
  98
  99 : activate-intervals ( n -- )
 100     ! Any inactive intervals which have ended are moved to handled
 101     ! Any inactive intervals which do not cover the current position
 102     ! are moved to active
 103     inactive-intervals {
 104         { [ 2dup finished? ] [ finish ] }
 105         { [ 2dup covers? ] [ activate ] }
 106         [ don't-change ]
 107     } process-intervals ;
 108
 109 ! Minheap of live intervals which still need a register allocation
 110 SYMBOL: unhandled-intervals
 111
 112 : add-unhandled ( live-interval -- )
 113     [ check-unhandled ]
 114     [ dup start>> unhandled-intervals get heap-push ]
 115     bi ;
 116
 117 : reg-class-assoc ( quot -- assoc )
 118     [ reg-classes ] dip { } map>assoc ; inline
 119
 120 : next-spill-slot ( size -- n )
 121     cfg get
 122     [ swap [ align dup ] [ + ] bi ] change-spill-area-size drop
 123     <spill-slot> ;
 124
 125 ! Minheap of sync points which still need to be processed
 126 SYMBOL: unhandled-sync-points
 127
 128 ! Mapping from vregs to spill slots
 129 SYMBOL: spill-slots
 130
 131 : assign-spill-slot ( coalesced-vreg rep -- spill-slot )
 132     rep-size spill-slots get [ nip next-spill-slot ] 2cache ;
 133
 134 : lookup-spill-slot ( coalesced-vreg rep -- spill-slot )
 135     rep-size 2array spill-slots get ?at [ ] [ bad-vreg ] if ;
 136
 137 : init-allocator ( registers -- )
 138     registers set
 139     <min-heap> unhandled-intervals set
 140     <min-heap> unhandled-sync-points set
 141     [ V{ } clone ] reg-class-assoc active-intervals set
 142     [ V{ } clone ] reg-class-assoc inactive-intervals set
 143     V{ } clone handled-intervals set
 144     cfg get 0 >>spill-area-size drop
 145     H{ } clone spill-slots set
 146     -1 progress set ;
 147
 148 : init-unhandled ( live-intervals sync-points -- )
 149     [ [ [ start>> ] keep ] { } map>assoc unhandled-intervals get heap-push-all ]
 150     [ [ [ n>> ] keep ] { } map>assoc unhandled-sync-points get heap-push-all ]
 151     bi* ;
 152
 153 ! A utility used by register-status and spill-status words
 154 : free-positions ( new -- assoc )
 155     reg-class>> registers get at
 156     [ 1/0. ] H{ } <linked-assoc> map>assoc ;
 157
 158 : add-use-position ( n reg assoc -- ) [ [ min ] when* ] change-at ;
 159
 160 : register-available? ( new result -- ? )
 161     [ end>> ] [ second ] bi* < ; inline
 162
 163 : register-available ( new result -- )
 164     first >>reg add-active ;