USING: accessors arrays assocs combinators combinators.short-circuit
compiler.cfg.linear-scan.allocation.spilling
compiler.cfg.linear-scan.allocation.state
-compiler.cfg.linear-scan.live-intervals compiler.utilities fry
-heaps kernel locals math namespaces sequences ;
+compiler.cfg.linear-scan.live-intervals compiler.cfg.linear-scan.ranges
+compiler.utilities fry heaps kernel locals math namespaces sequences ;
IN: compiler.cfg.linear-scan.allocation
: active-positions ( new assoc -- )
: inactive-positions ( new assoc -- )
[ [ inactive-intervals-for ] keep ] dip
'[
- [ _ relevant-ranges intersect-live-ranges 1/0. or ] [ reg>> ] bi
+ [ _ intersect-intervals 1/0. or ] [ reg>> ] bi
_ add-use-position
] each ;
USING: accessors assocs combinators
compiler.cfg.linear-scan.allocation.splitting
compiler.cfg.linear-scan.allocation.state
-compiler.cfg.linear-scan.live-intervals compiler.cfg.registers
-compiler.utilities fry kernel linked-assocs locals math namespaces sequences ;
+compiler.cfg.linear-scan.live-intervals compiler.cfg.linear-scan.ranges
+compiler.cfg.registers compiler.utilities fry kernel linked-assocs locals
+math namespaces sequences ;
IN: compiler.cfg.linear-scan.allocation.spilling
-ERROR: bad-live-ranges interval ;
-
-: check-ranges ( live-interval -- )
- check-allocation? get [
- dup ranges>> [ [ from>> ] [ to>> ] bi <= ] all?
- [ drop ] [ bad-live-ranges ] if
- ] [ drop ] if ;
-
: trim-before-ranges ( live-interval -- )
dup last-use n>> 1 +
[ '[ [ from>> _ >= ] trim-tail-slice ] change-ranges drop ]
assign-spill-slot >>spill-to drop
] [ 2drop ] if ;
+ERROR: bad-live-ranges interval ;
+
+: check-ranges ( ranges -- )
+ check-allocation? get [
+ ranges>> dup [ [ from>> ] [ to>> ] bi <= ] all?
+ [ drop ] [ bad-live-ranges ] if
+ ] [ drop ] if ;
+
: spill-before ( before -- before/f )
dup uses>> empty? [ drop f ] [
{
namespaces sequences ;
IN: compiler.cfg.linear-scan.allocation.splitting
-: split-range ( live-range n -- before after )
- [ [ from>> ] dip <live-range> ]
- [ 1 + swap to>> <live-range> ]
- 2bi ;
-
-: split-last-range? ( last n -- ? )
- swap to>> <= ;
-
-: split-last-range ( before after last n -- before' after' )
- split-range [ [ but-last ] dip suffix ] [ prefix ] bi-curry* bi* ;
-
-: split-ranges ( live-ranges n -- before after )
- [ '[ from>> _ <= ] partition ]
- [
- [ over last ] dip 2dup split-last-range?
- [ split-last-range ] [ 2drop ] if
- ] bi ;
-
:: split-uses ( uses n -- before after )
uses n uses [ n>> <=> ] with search
n>> n <=> {
1 live-intervals get at [ start>> ] [ end>> ] bi
] unit-test
-! Live range and interval splitting
-{
- { T{ live-range f 1 10 } T{ live-range f 15 15 } }
- { T{ live-range f 16 20 } }
-} [
- {
- T{ live-range f 1 10 }
- T{ live-range f 15 20 }
- } 15 split-ranges
-] unit-test
-
-{
- { T{ live-range f 1 10 } T{ live-range f 15 16 } }
- { T{ live-range f 17 20 } }
-} [
- {
- T{ live-range f 1 10 }
- T{ live-range f 15 20 }
- } 16 split-ranges
-] unit-test
-
-{
- { T{ live-range f 1 10 } }
- { T{ live-range f 15 20 } }
-} [
- {
- T{ live-range f 1 10 }
- T{ live-range f 15 20 }
- } 12 split-ranges
-] unit-test
-
-{
- { T{ live-range f 1 10 } T{ live-range f 15 17 } }
- { T{ live-range f 18 20 } }
-} [
- {
- T{ live-range f 1 10 }
- T{ live-range f 15 20 }
- } 17 split-ranges
-] unit-test
-
-[
- { T{ live-range f 1 10 } } 0 split-ranges
-] must-fail
-
-{
- { T{ live-range f 0 0 } }
- { T{ live-range f 1 5 } }
-} [
- { T{ live-range f 0 5 } } 0 split-ranges
-] unit-test
+! Live interval splitting
cfg new 0 >>spill-area-size 4 >>spill-area-align cfg set
H{ } spill-slots set
check-linear-scan
] unit-test
-{ f } [
- T{ live-range f 0 10 }
- T{ live-range f 20 30 }
- intersect-live-range
-] unit-test
-
-{ 10 } [
- T{ live-range f 0 10 }
- T{ live-range f 10 30 }
- intersect-live-range
-] unit-test
-
-{ 5 } [
- T{ live-range f 0 10 }
- T{ live-range f 5 30 }
- intersect-live-range
-] unit-test
-
-{ 5 } [
- T{ live-range f 5 30 }
- T{ live-range f 0 10 }
- intersect-live-range
-] unit-test
-
-{ 5 } [
- T{ live-range f 5 10 }
- T{ live-range f 0 15 }
- intersect-live-range
-] unit-test
-
-{ 50 } [
- {
- T{ live-range f 0 10 }
- T{ live-range f 20 30 }
- T{ live-range f 40 50 }
- }
- {
- T{ live-range f 11 15 }
- T{ live-range f 31 35 }
- T{ live-range f 50 55 }
- }
- intersect-live-ranges
-] unit-test
-
-{ f } [
- {
- T{ live-range f 0 10 }
- T{ live-range f 20 30 }
- T{ live-range f 40 50 }
- }
- {
- T{ live-range f 11 15 }
- T{ live-range f 31 36 }
- T{ live-range f 51 55 }
- }
- intersect-live-ranges
-] unit-test
-
-{ 5 } [
- T{ live-interval-state
- { start 0 }
- { reg-class int-regs }
- { end 10 }
- { uses { 0 10 } }
- { ranges V{ T{ live-range f 0 10 } } }
- }
- T{ live-interval-state
- { start 5 }
- { reg-class int-regs }
- { end 10 }
- { uses { 5 10 } }
- { ranges V{ T{ live-range f 5 10 } } }
- }
- relevant-ranges intersect-live-ranges
-] unit-test
-
! register-status had problems because it used map>assoc where the sequence
! had multiple keys
H{
{ { 4 20 } } <live-interval-for-ranges>
{ { 8 12 } } <live-interval-for-ranges> intervals-intersect?
{ { 9 20 } { 3 5 } } <live-interval-for-ranges>
- { { 0 1 } { 7 8 } } <live-interval-for-ranges> intervals-intersect?
+ { { 7 8 } { 0 1 } } <live-interval-for-ranges> intervals-intersect?
{ { 3 5 } } <live-interval-for-ranges>
{ { 7 8 } } <live-interval-for-ranges> intervals-intersect?
] unit-test
<basic-block> [ H{ { 4 4 } { 8 8 } { 9 9 } } 2array 1array live-outs set ]
[ handle-live-out ] bi live-intervals get
] unit-test
+
+! relevant-ranges
+{
+ V{ T{ live-range { from 0 } { to 10 } } }
+ V{ T{ live-range { from 5 } { to 10 } } }
+} [
+ T{ live-interval-state
+ { start 0 }
+ { reg-class int-regs }
+ { end 10 }
+ { uses { 0 10 } }
+ { ranges V{ T{ live-range f 0 10 } } }
+ }
+ T{ live-interval-state
+ { start 5 }
+ { reg-class int-regs }
+ { end 10 }
+ { uses { 5 10 } }
+ { ranges V{ T{ live-range f 5 10 } } }
+ }
+ relevant-ranges
+] unit-test
: relevant-ranges ( interval1 interval2 -- ranges1 ranges2 )
[ [ ranges>> ] bi@ ] [ nip start>> ] 2bi '[ to>> _ >= ] filter ;
-: intersect-live-range ( range1 range2 -- n/f )
- 2dup [ from>> ] bi@ > [ swap ] when
- 2dup [ to>> ] [ from>> ] bi* >= [ nip from>> ] [ 2drop f ] if ;
-
-: intersect-live-ranges ( ranges1 ranges2 -- n )
- {
- { [ over empty? ] [ 2drop f ] }
- { [ dup empty? ] [ 2drop f ] }
- [
- 2dup [ first ] bi@ intersect-live-range dup [ 2nip ] [
- drop
- 2dup [ first from>> ] bi@ <
- [ [ rest-slice ] dip ] [ rest-slice ] if
- intersect-live-ranges
- ] if
- ]
- } cond ;
+: intersect-intervals ( interval1 interval2 -- n/f )
+ relevant-ranges intersect-ranges ;
: intervals-intersect? ( interval1 interval2 -- ? )
- relevant-ranges intersect-live-ranges >boolean ; inline
+ intersect-intervals >boolean ; inline
-USING: compiler.cfg help.syntax help.markup ;
+USING: compiler.cfg help.syntax help.markup math ;
IN: compiler.cfg.linear-scan.ranges
+HELP: intersect-range
+{ $values
+ { "range1" live-range }
+ { "range2" live-range }
+ { "n/f" { $link number } " or " { $link f } }
+}
+{ $description "First index for the ranges intersection, or f if they don't intersect." } ;
+
HELP: live-range
{ $class-description "Represents a range in the " { $link cfg } " in which a vreg is live." } ;
-USING: compiler.cfg.linear-scan.ranges fry kernel sequences tools.test ;
+USING: arrays compiler.cfg.linear-scan.ranges fry kernel sequences
+tools.test ;
IN: compiler.cfg.linear-scan.ranges.tests
: combine-ranges ( seq -- ranges )
{ { 10 12 } { 5 10 } } combine-ranges
] unit-test
+! intersect-range
+{ f 15 f 10 5 } [
+ 10 20 <live-range> 30 40 <live-range> intersect-range
+ 10 20 <live-range> 15 16 <live-range> intersect-range
+ T{ live-range f 0 10 } T{ live-range f 20 30 } intersect-range
+ T{ live-range f 0 10 } T{ live-range f 10 30 } intersect-range
+ T{ live-range f 0 10 } T{ live-range f 5 30 } intersect-range
+] unit-test
+
+! intersect-ranges
+{ 50 f f f 11 8 f f } [
+ {
+ T{ live-range f 0 10 }
+ T{ live-range f 20 30 }
+ T{ live-range f 40 50 }
+ }
+ {
+ T{ live-range f 11 15 }
+ T{ live-range f 31 35 }
+ T{ live-range f 50 55 }
+ }
+ intersect-ranges
+ {
+ T{ live-range f 0 10 }
+ T{ live-range f 20 30 }
+ T{ live-range f 40 50 }
+ }
+ {
+ T{ live-range f 11 15 }
+ T{ live-range f 31 36 }
+ T{ live-range f 51 55 }
+ }
+ intersect-ranges
+ { } { T{ live-range f 11 15 } } intersect-ranges
+ { T{ live-range f 11 15 } } { } intersect-ranges
+ { T{ live-range f 11 15 } }
+ { T{ live-range f 10 15 } T{ live-range f 16 18 } }
+ intersect-ranges
+ { T{ live-range f 4 20 } } { T{ live-range f 8 12 } }
+ intersect-ranges
+ { T{ live-range f 9 20 } T{ live-range f 3 5 } }
+ { T{ live-range f 0 1 } T{ live-range f 7 8 } }
+ intersect-ranges
+ { T{ live-range f 3 5 } } { T{ live-range f 7 8 } } intersect-ranges
+] unit-test
+
! ranges-cover?
{
t f f t t
8 { { 4 12 } } combine-ranges [ shorten-ranges ] keep
9 { } combine-ranges [ shorten-ranges ] keep
] unit-test
+
+! split range
+{
+ T{ live-range f 10 15 }
+ T{ live-range f 16 20 }
+} [
+ 10 20 <live-range> 15 split-range
+] unit-test
+
+! split-ranges
+{
+ { T{ live-range { from 10 } { to 20 } } }
+ { T{ live-range { from 30 } { to 40 } } }
+} [
+ 10 20 <live-range> 30 40 <live-range> 2array 25 split-ranges
+] unit-test
+
+{
+ { T{ live-range f 0 0 } }
+ { T{ live-range f 1 5 } }
+} [
+ { T{ live-range f 0 5 } } 0 split-ranges
+] unit-test
+
+{
+ { T{ live-range f 1 10 } T{ live-range f 15 17 } }
+ { T{ live-range f 18 20 } }
+} [
+ {
+ T{ live-range f 1 10 }
+ T{ live-range f 15 20 }
+ } 17 split-ranges
+] unit-test
+
+{
+ { T{ live-range f 1 10 } }
+ { T{ live-range f 15 20 } }
+} [
+ {
+ T{ live-range f 1 10 }
+ T{ live-range f 15 20 }
+ } 12 split-ranges
+] unit-test
+
+{
+ { T{ live-range f 1 10 } T{ live-range f 15 16 } }
+ { T{ live-range f 17 20 } }
+} [
+ {
+ T{ live-range f 1 10 }
+ T{ live-range f 15 20 }
+ } 16 split-ranges
+] unit-test
+
+{
+ { T{ live-range f 1 10 } T{ live-range f 15 15 } }
+ { T{ live-range f 16 20 } }
+} [
+ {
+ T{ live-range f 1 10 }
+ T{ live-range f 15 20 }
+ } 15 split-ranges
+] unit-test
+
+[
+ { T{ live-range f 1 10 } } 0 split-ranges
+] must-fail
-USING: accessors kernel math math.order sequences ;
+USING: accessors compiler.cfg.linear-scan.allocation.state fry kernel
+math math.order namespaces sequences ;
IN: compiler.cfg.linear-scan.ranges
! Data definitions
C: <live-range> live-range
! Range utilities
+: intersect-range ( range1 range2 -- n/f )
+ 2dup [ from>> ] bi@ > [ swap ] when
+ 2dup [ to>> ] [ from>> ] bi* >=
+ [ nip from>> ] [ 2drop f ] if ;
+
: range-covers? ( n range -- ? )
[ from>> ] [ to>> ] bi between? ;
+: split-range ( live-range n -- before after )
+ [ [ from>> ] dip <live-range> ]
+ [ 1 + swap to>> <live-range> ] 2bi ;
+
! Range sequence utilities
: extend-ranges? ( n ranges -- ? )
[ drop f ] [ last from>> >= ] if-empty ;
: ranges-cover? ( n ranges -- ? )
[ range-covers? ] with any? ;
+: intersect-ranges ( ranges1 ranges2 -- n/f )
+ '[ _ [ intersect-range ] with map-find drop ] map-find drop ;
+
: shorten-ranges ( n ranges -- )
dup empty? [ dupd add-new-range ] [ last from<< ] if ;
+
+: split-last-range? ( last n -- ? )
+ swap to>> <= ;
+
+: split-last-range ( before after last n -- before' after' )
+ split-range [ [ but-last ] dip suffix ] [ prefix ] bi-curry* bi* ;
+
+: split-ranges ( live-ranges n -- before after )
+ [ '[ from>> _ <= ] partition ]
+ [
+ [ over last ] dip 2dup split-last-range?
+ [ split-last-range ] [ 2drop ] if
+ ] bi ;