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