1 ! Copyright (C) 2009, 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs combinators compiler.cfg
4 compiler.cfg.instructions
5 compiler.cfg.linear-scan.live-intervals compiler.cfg.registers
6 cpu.architecture fry heaps kernel math math.order namespaces sequences ;
7 IN: compiler.cfg.linear-scan.allocation.state
11 : check-unhandled ( live-interval -- )
12 start>> progress get <= [ "check-unhandled" throw ] when ; inline
14 : check-handled ( live-interval -- )
15 end>> progress get > [ "check-handled" throw ] when ; inline
17 SYMBOL: unhandled-min-heap
19 GENERIC: interval/sync-point-key ( interval/sync-point -- key )
21 M: live-interval-state interval/sync-point-key
22 [ start>> ] [ end>> ] [ vreg>> ] tri 3array ;
24 M: sync-point interval/sync-point-key
25 n>> 1/0. 1/0. 3array ;
27 : >unhandled-min-heap ( intervals/sync-points -- min-heap )
28 [ [ interval/sync-point-key ] keep 2array ] map >min-heap ;
32 SYMBOL: active-intervals
34 : active-intervals-for ( live-interval -- seq )
35 reg-class>> active-intervals get at ;
37 : add-active ( live-interval -- )
38 dup active-intervals-for push ;
40 : delete-active ( live-interval -- )
41 dup active-intervals-for remove-eq! drop ;
43 : assign-free-register ( new registers -- )
44 pop >>reg add-active ;
46 SYMBOL: inactive-intervals
48 : inactive-intervals-for ( live-interval -- seq )
49 reg-class>> inactive-intervals get at ;
51 : add-inactive ( live-interval -- )
52 dup inactive-intervals-for push ;
54 : delete-inactive ( live-interval -- )
55 dup inactive-intervals-for remove-eq! drop ;
57 SYMBOL: handled-intervals
59 : add-handled ( live-interval -- )
60 [ check-handled ] [ handled-intervals get push ] bi ;
62 : finished? ( n live-interval -- ? ) end>> swap < ;
64 : finish ( n live-interval -- keep? )
67 SYMBOL: check-allocation?
69 ERROR: register-already-used live-interval ;
71 : check-activate ( live-interval -- )
72 check-allocation? get [
73 dup [ reg>> ] [ active-intervals-for [ reg>> ] map ] bi member?
74 [ throw-register-already-used ] [ drop ] if
77 : activate ( n live-interval -- keep? )
81 : deactivate ( n live-interval -- keep? )
84 : don't-change ( n live-interval -- keep? ) 2drop t ;
86 ! Moving intervals between active and inactive sets
87 : process-intervals ( n symbol quots -- )
88 ! symbol stores an alist mapping register classes to vectors
89 [ get values ] dip '[ [ _ cond ] with filter! drop ] with each ; inline
91 : deactivate-intervals ( n -- )
94 { [ 2dup finished? ] [ finish ] }
95 { [ 2dup covers? not ] [ deactivate ] }
99 : activate-intervals ( n -- )
101 { [ 2dup finished? ] [ finish ] }
102 { [ 2dup covers? ] [ activate ] }
104 } process-intervals ;
106 : add-unhandled ( live-interval -- )
108 dup interval/sync-point-key unhandled-min-heap get heap-push ;
110 : reg-class-assoc ( quot -- assoc )
111 [ reg-classes ] dip { } map>assoc ; inline
113 : next-spill-slot ( size -- spill-slot )
115 [ swap [ align dup ] [ + ] bi ] change-spill-area-size drop
118 : align-spill-area ( align cfg -- )
119 [ max ] change-spill-area-align drop ;
123 : assign-spill-slot ( coalesced-vreg rep -- spill-slot )
125 [ cfg get align-spill-area ]
126 [ spill-slots get [ nip next-spill-slot ] 2cache ]
129 : lookup-spill-slot ( coalesced-vreg rep -- spill-slot )
130 rep-size 2array spill-slots get ?at [ ] [ bad-vreg ] if ;
132 : init-allocator ( intervals/sync-points registers -- )
134 >unhandled-min-heap unhandled-min-heap set
135 [ V{ } clone ] reg-class-assoc active-intervals set
136 [ V{ } clone ] reg-class-assoc inactive-intervals set
137 V{ } clone handled-intervals set
138 H{ } clone spill-slots set
141 : add-use-position ( n reg assoc -- )
142 [ [ min ] when* ] change-at ;
144 : register-available? ( new result -- ? )
145 [ end>> ] [ second ] bi* < ; inline
147 : register-available ( new result -- )
148 first >>reg add-active ;