! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs heaps kernel namespaces sequences fry math
-combinators arrays sorting
+combinators arrays sorting compiler.utilities
compiler.cfg.linear-scan.allocation.coalescing
compiler.cfg.linear-scan.allocation.spilling
compiler.cfg.linear-scan.allocation.splitting
[ 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 ;
+ >alist alist-max ;
: no-free-registers? ( result -- ? )
second 0 = ; inline
: assign-register ( new -- )
dup coalesce? [ coalesce ] [
- dup compute-free-pos last {
+ dup compute-free-pos {
{ [ dup no-free-registers? ] [ drop assign-blocked-register ] }
{ [ 2dup register-available? ] [ register-available ] }
[ register-partially-available ]
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs combinators fry hints kernel locals
-math sequences sets sorting splitting
+math sequences sets sorting splitting compiler.utilities
compiler.cfg.linear-scan.allocation.state
compiler.cfg.linear-scan.allocation.splitting
compiler.cfg.linear-scan.live-intervals ;
IN: compiler.cfg.linear-scan.allocation.spilling
+: find-use ( live-interval n quot -- elt )
+ [ uses>> ] 2dip curry find nip ; inline
+
+: spill-existing? ( new existing -- ? )
+ #! Test if 'new' will be used before 'existing'.
+ over start>> '[ _ [ > ] find-use -1 or ] bi@ < ;
+
+: interval-to-spill ( active-intervals current -- live-interval )
+ #! We spill the interval with the most distant use location.
+ start>> '[ dup _ [ >= ] find-use ] { } map>assoc
+ alist-max first ;
+
: split-for-spill ( live-interval n -- before after )
split-interval
[
[ ]
2tri ;
-: find-use ( live-interval n quot -- i elt )
- [ uses>> ] 2dip curry find ; inline
-
-: interval-to-spill ( active-intervals current -- live-interval )
- #! We spill the interval with the most distant use location.
- start>> '[ dup _ [ >= ] find-use nip ] { } map>assoc
- [ ] [ [ [ second ] bi@ > ] most ] map-reduce first ;
-
: assign-spill ( before after -- before after )
#! If it has been spilled already, reuse spill location.
over reload-from>>
#! with the most distant use location. Spill the existing
#! interval, then process the new interval and the tail end
#! of the existing interval again.
+ [ nip delete-active ]
[ reg>> >>reg add-active ]
- [ [ add-handled ] [ delete-active ] bi* ]
[ split-and-spill [ add-handled ] [ add-unhandled ] bi* ] 2tri ;
: spill-new ( new existing -- )
#! again.
[ dup split-and-spill add-unhandled ] dip spill-existing ;
-: spill-existing? ( new existing -- ? )
- #! Test if 'new' will be used before 'existing'.
- over start>> '[ _ [ > ] find-use nip -1 or ] bi@ < ;
-
: assign-blocked-register ( new -- )
[ dup vreg>> active-intervals-for ] keep interval-to-spill
2dup spill-existing? [ spill-existing ] [ spill-new ] if ;
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences sequences.private arrays vectors fry
-math.order namespaces assocs ;
+math math.order namespaces assocs ;
IN: compiler.utilities
: flattener ( seq quot -- seq vector quot' )
SYMBOL: yield-hook
yield-hook [ [ ] ] initialize
+
+: alist-max ( alist -- pair )
+ [ ] [ [ [ second ] bi@ > ] most ] map-reduce ;
\ No newline at end of file