1 ! Copyright (C) 2009, 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs combinators
4 compiler.cfg.linear-scan.allocation.splitting
5 compiler.cfg.linear-scan.allocation.state
6 compiler.cfg.linear-scan.live-intervals compiler.cfg.registers
7 compiler.utilities fry kernel linked-assocs locals math namespaces sequences ;
8 IN: compiler.cfg.linear-scan.allocation.spilling
10 ERROR: bad-live-ranges interval ;
12 : check-ranges ( live-interval -- )
13 check-allocation? get [
14 dup ranges>> [ [ from>> ] [ to>> ] bi <= ] all?
15 [ drop ] [ throw-bad-live-ranges ] if
18 : trim-before-ranges ( live-interval -- )
20 [ '[ [ from>> _ >= ] trim-tail-slice ] change-ranges drop ]
21 [ swap ranges>> last to<< ]
24 : trim-after-ranges ( live-interval -- )
26 [ '[ [ to>> _ < ] trim-head-slice ] change-ranges drop ]
27 [ swap ranges>> first from<< ]
30 : last-use-rep ( live-interval -- rep/f )
31 last-use [ def-rep>> ] [ use-rep>> ] bi or ; inline
33 : assign-spill ( live-interval -- )
34 dup last-use-rep dup [
36 dup [ vreg>> ] [ spill-rep>> ] bi
37 assign-spill-slot >>spill-to drop
40 : spill-before ( before -- before/f )
41 dup uses>> empty? [ drop f ] [
45 [ trim-before-ranges ]
51 : first-use-rep ( live-interval -- rep/f )
52 first-use use-rep>> ; inline
54 : assign-reload ( live-interval -- )
55 dup first-use-rep dup [
57 dup [ vreg>> ] [ reload-rep>> ] bi
58 assign-spill-slot >>reload-from drop
61 : spill-after ( after -- after/f )
62 dup uses>> empty? [ drop f ] [
72 : split-for-spill ( live-interval n -- before after )
73 split-interval [ spill-before ] [ spill-after ] bi* ;
75 : find-next-use ( live-interval new -- n )
76 [ uses>> ] [ start>> ] bi*
77 '[ [ spill-slot?>> not ] [ n>> ] bi _ >= and ] find nip
78 [ n>> ] [ 1/0. ] if* ;
80 : find-use-positions ( live-intervals new assoc -- )
81 '[ [ _ find-next-use ] [ reg>> ] bi _ add-use-position ] each ;
83 : active-positions ( new assoc -- )
84 [ [ active-intervals-for ] keep ] dip
87 : inactive-positions ( new assoc -- )
89 [ inactive-intervals-for ] keep
90 [ '[ _ intervals-intersect? ] filter ] keep
94 : spill-status ( new -- use-pos )
96 [ inactive-positions ] [ active-positions ] [ nip ] 2tri
99 : spill-new? ( new pair -- ? )
100 [ first-use n>> ] [ second ] bi* > ;
102 : spill-new ( new pair -- )
103 drop spill-after add-unhandled ;
105 : spill ( live-interval n -- )
107 [ [ add-handled ] when* ]
108 [ [ add-unhandled ] when* ] bi* ;
110 :: spill-intersecting-active ( new reg -- )
111 new active-intervals-for [ [ reg>> reg = ] find swap dup ] keep
112 '[ _ remove-nth! drop new start>> spill ] [ 2drop ] if ;
114 :: spill-intersecting-inactive ( new reg -- )
115 new inactive-intervals-for [
117 dup new intervals-intersect? [
123 : spill-intersecting ( new reg -- )
124 [ spill-intersecting-active ]
125 [ spill-intersecting-inactive ]
128 : spill-available ( new pair -- )
129 [ first spill-intersecting ] [ register-available ] 2bi ;
131 : spill-partially-available ( new pair -- )
132 [ second 1 - split-for-spill [ add-unhandled ] when* ] keep
133 '[ _ spill-available ] when* ;
135 : assign-blocked-register ( live-interval -- )
137 { [ 2dup spill-new? ] [ spill-new ] }
138 { [ 2dup register-available? ] [ spill-available ] }
139 [ spill-partially-available ]