compiler.cfg.linear-scan: untangle add-active/delete-active/add-handled calls in spilling, replace 'sort-values last' with 'alist-max' in compiler.utilities

basis/compiler/cfg/linear-scan/allocation/allocation.factor

@@ -1,7 +1,7 @@
 ! 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
@@ -39,7 +39,7 @@ IN: compiler.cfg.linear-scan.allocation
     [ 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
@@ -56,7 +56,7 @@ IN: compiler.cfg.linear-scan.allocation
 
 : 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 ]

basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor

@@ -1,12 +1,24 @@
 ! 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
     [
@@ -17,14 +29,6 @@ IN: compiler.cfg.linear-scan.allocation.spilling
     [ ]
     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>>
@@ -39,8 +43,8 @@ IN: compiler.cfg.linear-scan.allocation.spilling
     #! 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 -- )
@@ -50,10 +54,6 @@ IN: compiler.cfg.linear-scan.allocation.spilling
     #! 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 ;

basis/compiler/cfg/linear-scan/linear-scan-tests.factor

@@ -79,7 +79,7 @@ check-allocation? on
         { end 10 }
         { uses V{ 0 1 3 7 10 } }
     }
-    4 [ >= ] find-use nip
+    4 [ >= ] find-use
 ] unit-test
 
 [ 4 ] [
@@ -89,7 +89,7 @@ check-allocation? on
         { end 10 }
         { uses V{ 0 1 3 4 10 } }
     }
-    4 [ >= ] find-use nip
+    4 [ >= ] find-use
 ] unit-test
 
 [ f ] [
@@ -99,7 +99,7 @@ check-allocation? on
         { end 10 }
         { uses V{ 0 1 3 4 10 } }
     }
-    100 [ >= ] find-use nip
+    100 [ >= ] find-use
 ] unit-test
 
 [
@@ -1324,7 +1324,7 @@ USING: math.private compiler.cfg.debugger ;
 
 ! Spill slot liveness was computed incorrectly, leading to a FEP
 ! early in bootstrap on x86-32
-[ t ] [
+[ t t ] [
     [
         H{ } clone live-ins set
         H{ } clone live-outs set
@@ -1349,7 +1349,9 @@ USING: math.private compiler.cfg.debugger ;
              }
            }
         } dup 1array { { int-regs V{ 0 1 2 3 } } } (linear-scan)
-        instructions>> first live-spill-slots>> empty?
+        instructions>> first
+        [ live-spill-slots>> empty? ]
+        [ live-registers>> empty? ] bi
     ] with-scope
 ] unit-test
 

basis/compiler/utilities/utilities.factor

@@ -1,7 +1,7 @@
 ! 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' )
@@ -25,3 +25,6 @@ IN: compiler.utilities
 SYMBOL: yield-hook
 
 yield-hook [ [ ] ] initialize
+
+: alist-max ( alist -- pair )
+    [ ] [ [ [ second ] bi@ > ] most ] map-reduce ;