! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs heaps kernel namespaces sequences
+USING: accessors assocs heaps kernel namespaces sequences fry math
+combinators arrays sorting
compiler.cfg.linear-scan.allocation.coalescing
compiler.cfg.linear-scan.allocation.spilling
compiler.cfg.linear-scan.allocation.splitting
compiler.cfg.linear-scan.allocation.state ;
IN: compiler.cfg.linear-scan.allocation
+: relevant-ranges ( new inactive -- new' inactive' )
+ ! Slice off all ranges of 'inactive' that precede the start of 'new'
+ [ [ 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 1/0. ] }
+ { [ dup empty? ] [ 2drop 1/0. ] }
+ [
+ 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-inactive ( new inactive -- n )
+ relevant-ranges intersect-live-ranges ;
+
+: compute-free-pos ( new -- free-pos )
+ dup vreg>>
+ [ nip reg-class>> registers get at [ 1/0. ] H{ } map>assoc ]
+ [ inactive-intervals-for [ [ reg>> swap ] keep intersect-inactive ] with H{ } map>assoc ]
+ [ nip active-intervals-for [ reg>> 0 ] H{ } map>assoc ]
+ 2tri 3array assoc-combine
+ >alist sort-values ;
+
+: no-free-registers? ( new result -- ? )
+ second 0 = ; inline
+
+: register-available? ( new result -- ? )
+ [ end>> ] [ second ] bi* < ; inline
+
+: register-available ( new result -- )
+ first >>reg add-active ;
+
+: register-partially-available ( new result -- )
+ [ second split-before-use ] keep
+ '[ _ register-available ] [ add-unhandled ] bi* ;
+
: assign-register ( new -- )
dup coalesce? [ coalesce ] [
- dup vreg>> free-registers-for [
- dup intersecting-inactive
- [ assign-blocked-register ]
- [ assign-inactive-register ]
- if-empty
- ] [ assign-free-register ]
- if-empty
+ dup compute-free-pos last {
+ { [ dup no-free-registers? ] [ drop assign-blocked-register ] }
+ { [ 2dup register-available? ] [ register-available ] }
+ [ register-partially-available ]
+ } cond
] if ;
: handle-interval ( live-interval -- )
#! with the most distant use location. Spill the existing
#! interval, then process the new interval and the tail end
#! of the existing interval again.
- [ reuse-register ]
- [ nip delete-active ]
+ [ reg>> >>reg drop ]
+ [ [ add-handled ] [ delete-active ] bi* ]
[ split-and-spill [ add-handled ] [ add-unhandled ] bi* ] 2tri ;
: spill-new ( new existing -- )
'[ _ <= ] partition ;
: record-split ( live-interval before after -- )
- [ >>split-next drop ]
- [ [ >>split-before ] [ >>split-after ] bi* drop ]
- 2bi ; inline
+ [ >>split-before ] [ >>split-after ] bi* drop ; inline
ERROR: splitting-too-early ;
HINTS: split-interval live-interval object ;
-: reuse-register ( new existing -- )
- reg>> >>reg add-active ;
-
-: relevant-ranges ( new inactive -- new' inactive' )
- ! Slice off all ranges of 'inactive' that precede the start of 'new'
- [ [ 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 1/0. ] }
- { [ dup empty? ] [ 2drop 1/0. ] }
- [
- 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-inactive ( new inactive active-regs -- n/f )
- ! If the interval's register is currently in use, we cannot
- ! re-use it.
- 2dup [ reg>> ] dip key?
- [ 3drop f ] [ drop relevant-ranges intersect-live-ranges ] if ;
-
-: intersecting-inactive ( new -- live-intervals )
- dup vreg>>
- [ inactive-intervals-for ]
- [ active-intervals-for [ reg>> ] map unique ] bi
- '[ tuck _ intersect-inactive ] with { } map>assoc
- [ nip ] assoc-filter ;
+: split-between-blocks ( new n -- before after )
+ split-interval
+ 2dup [ compute-start/end ] bi@ ;
: insert-use-for-copy ( seq n -- seq' )
- [ 1array split1 ] keep [ 1 - ] keep 2array glue ;
+ dup 1 + [ nip 1array split1 ] 2keep 2array glue ;
: split-before-use ( new n -- before after )
! Find optimal split position
! Insert move instruction
- [ '[ _ insert-use-for-copy ] change-uses ] keep
- 1 - split-interval
- 2dup [ compute-start/end ] bi@ ;
-
-: assign-inactive-register ( new live-intervals -- )
- ! If there is an interval which is inactive for the entire lifetime
- ! if the new interval, reuse its vreg. Otherwise, split new so that
- ! the first half fits.
- sort-values last
- 2dup [ end>> ] [ second ] bi* < [
- first reuse-register
+ 1 -
+ 2dup swap covers? [
+ [ '[ _ insert-use-for-copy ] change-uses ] keep
+ split-between-blocks
+ 2dup >>split-next drop
] [
- [ second split-before-use ] keep
- '[ _ first reuse-register ] [ add-unhandled ] bi*
+ split-between-blocks
] if ;
\ No newline at end of file
IN: compiler.cfg.linear-scan.allocation.state
! Mapping from register classes to sequences of machine registers
-SYMBOL: free-registers
-
-: free-registers-for ( vreg -- seq )
- reg-class>> free-registers get at ;
-
-: deallocate-register ( live-interval -- )
- [ reg>> ] [ vreg>> ] bi free-registers-for push ;
+SYMBOL: registers
! Vector of active live intervals
SYMBOL: active-intervals
: finished? ( n live-interval -- ? ) end>> swap < ;
: finish ( n live-interval -- keep? )
- nip [ deallocate-register ] [ add-handled ] bi f ;
+ nip add-handled f ;
SYMBOL: check-allocation?
spill-counts get [ dup 1 + ] change-at ;
: init-allocator ( registers -- )
- [ reverse >vector ] assoc-map free-registers set
+ registers set
[ 0 ] reg-class-assoc spill-counts set
<min-heap> unhandled-intervals set
[ V{ } clone ] reg-class-assoc active-intervals set
{ uses { 5 10 } }
{ ranges V{ T{ live-range f 5 10 } } }
}
- H{ }
intersect-inactive
] unit-test
projects / factor.git / commitdiff