unfinished/compiler/machine/linear-scan/allocation/allocation.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: namespaces sequences math math.order kernel assocs
   4 accessors vectors fry
   5 compiler.machine.linear-scan.live-intervals
   6 compiler.backend ;
   7 IN: compiler.machine.linear-scan.allocation
   8
   9 ! Mapping from vregs to machine registers
  10 SYMBOL: register-allocation
  11
  12 ! Mapping from vregs to spill locations
  13 SYMBOL: spill-locations
  14
  15 ! Vector of active live intervals, in order of increasing end point
  16 SYMBOL: active-intervals
  17
  18 : add-active ( live-interval -- )
  19     active-intervals get push ;
  20
  21 : delete-active ( live-interval -- )
  22     active-intervals get delete ;
  23
  24 ! Mapping from register classes to sequences of machine registers
  25 SYMBOL: free-registers
  26
  27 ! Counter of spill locations
  28 SYMBOL: spill-counter
  29
  30 : next-spill-location ( -- n )
  31     spill-counter [ dup 1+ ] change ;
  32
  33 : assign-spill ( live-interval -- )
  34     next-spill-location swap vreg>> spill-locations get set-at ;
  35
  36 : free-registers-for ( vreg -- seq )
  37     reg-class>> free-registers get at ;
  38
  39 : free-register ( vreg -- )
  40     #! Free machine register currently assigned to vreg.
  41     [ register-allocation get at ] [ free-registers-for ] bi push ;
  42
  43 : expire-old-intervals ( live-interval -- )
  44     active-intervals get
  45     swap '[ end>> _ start>> < ] partition
  46     active-intervals set
  47     [ vreg>> free-register ] each ;
  48
  49 : interval-to-spill ( -- live-interval )
  50     #! We spill the interval with the longest remaining range.
  51     active-intervals get unclip-slice [
  52         [ [ end>> ] bi@ > ] most
  53     ] reduce ;
  54
  55 : reuse-register ( live-interval to-spill -- )
  56     vreg>> swap vreg>>
  57     register-allocation get
  58     tuck [ at ] [ set-at ] 2bi* ;
  59
  60 : spill-at-interval ( live-interval -- )
  61     interval-to-spill
  62     2dup [ end>> ] bi@ > [
  63         [ reuse-register ]
  64         [ nip assign-spill ]
  65         [ [ add-active ] [ delete-active ] bi* ]
  66         2tri
  67     ] [ drop assign-spill ] if ;
  68
  69 : init-allocator ( -- )
  70     H{ } clone register-allocation set
  71     H{ } clone spill-locations set
  72     V{ } clone active-intervals set
  73     machine-registers [ >vector ] assoc-map free-registers set
  74     0 spill-counter set ;
  75
  76 : assign-register ( live-interval register -- )
  77     swap vreg>> register-allocation get set-at ;
  78
  79 : allocate-register ( live-interval -- )
  80     dup vreg>> free-registers-for [
  81         spill-at-interval
  82     ] [
  83         [ pop assign-register ]
  84         [ drop add-active ]
  85         2bi
  86     ] if-empty ;
  87
  88 : allocate-registers ( live-intervals -- )
  89     init-allocator
  90     [ [ expire-old-intervals ] [ allocate-register ] bi ] each ;