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

   1 ! Copyright (C) 2008, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs heaps kernel namespaces sequences fry math
   4 math.order combinators arrays sorting compiler.utilities locals
   5 compiler.cfg.linear-scan.live-intervals
   6 compiler.cfg.linear-scan.allocation.spilling
   7 compiler.cfg.linear-scan.allocation.splitting
   8 compiler.cfg.linear-scan.allocation.state ;
   9 IN: compiler.cfg.linear-scan.allocation
  10
  11 : active-positions ( new assoc -- )
  12     [ vreg>> active-intervals-for ] dip
  13     '[ [ 0 ] dip reg>> _ add-use-position ] each ;
  14
  15 : inactive-positions ( new assoc -- )
  16     [ [ vreg>> inactive-intervals-for ] keep ] dip
  17     '[
  18         [ _ relevant-ranges intersect-live-ranges 1/0. or ] [ reg>> ] bi
  19         _ add-use-position
  20     ] each ;
  21
  22 : register-status ( new -- free-pos )
  23     dup free-positions
  24     [ inactive-positions ] [ active-positions ] [ nip ] 2tri
  25     >alist alist-max ;
  26
  27 : no-free-registers? ( result -- ? )
  28     second 0 = ; inline
  29
  30 : assign-register ( new -- )
  31     dup register-status {
  32         { [ dup no-free-registers? ] [ drop assign-blocked-register ] }
  33         { [ 2dup register-available? ] [ register-available ] }
  34         [ drop assign-blocked-register ]
  35     } cond ;
  36
  37 : handle-sync-point ( n -- )
  38     [ active-intervals get values ] dip
  39     [ '[ [ _ spill ] each ] each ]
  40     [ drop [ delete-all ] each ]
  41     2bi ;
  42
  43 :: handle-progress ( n sync? -- )
  44     n {
  45         [ progress set ]
  46         [ deactivate-intervals ]
  47         [ sync? [ handle-sync-point ] [ drop ] if ]
  48         [ activate-intervals ]
  49     } cleave ;
  50
  51 GENERIC: handle ( obj -- )
  52
  53 M: live-interval handle ( live-interval -- )
  54     [ start>> f handle-progress ] [ assign-register ] bi ;
  55
  56 M: sync-point handle ( sync-point -- )
  57     n>> t handle-progress ;
  58
  59 : smallest-heap ( heap1 heap2 -- heap )
  60     ! If heap1 and heap2 have the same key, favors heap1.
  61     [ [ heap-peek nip ] bi@ <= ] most ;
  62
  63 : (allocate-registers) ( -- )
  64     {
  65         { [ unhandled-intervals get heap-empty? ] [ unhandled-sync-points get ] }
  66         { [ unhandled-sync-points get heap-empty? ] [ unhandled-intervals get ] }
  67         ! If a live interval begins at the same location as a sync point,
  68         ! process the sync point before the live interval. This ensures that the
  69         ! return value of C function calls doesn't get spilled and reloaded
  70         ! unnecessarily.
  71         [ unhandled-sync-points get unhandled-intervals get smallest-heap ]
  72     } cond dup heap-empty? [ drop ] [ heap-pop drop handle (allocate-registers) ] if ;
  73
  74 : finish-allocation ( -- )
  75     active-intervals inactive-intervals
  76     [ get values [ handled-intervals get push-all ] each ] bi@ ;
  77
  78 : allocate-registers ( live-intervals sync-point machine-registers -- live-intervals )
  79     init-allocator
  80     init-unhandled
  81     (allocate-registers)
  82     finish-allocation
  83     handled-intervals get ;