compiler.cfg.linear-scan.allocation.*: maybe a fix for #1227

The register allocator pops from the unhandled-intervals and
unhandled-sync-points heaps. If two live intervals share the same
start slot, then they can be popped in either order leading to
differently generated code. So instead use one
heap (unhandled-min-heap) and both the start and end slot as the heap
key to resolve tie-breakers

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

@@ -59,15 +59,10 @@ M: sync-point handle ( sync-point -- )
     [ n>> [ deactivate-intervals ] [ activate-intervals ] bi ]
     [ handle-sync-point ] bi ;
 
-: live-interval-or-sync-point ( intervals sync-points -- live-interval )
-    2array [ heap-empty? not ] filter [ heap-peek nip ] infimum-by
-    heap-pop drop ;
-
-: (allocate-registers) ( unhandled-intervals unhandled-sync-points -- )
-    2dup [ heap-empty? ] both? [ 2drop ] [
-        [ live-interval-or-sync-point handle ]
-        [ (allocate-registers) ]
-        2bi
+! TODO: use slurp-heap
+: (allocate-registers) ( unhandled-min-heap -- )
+    dup heap-empty? [ drop ] [
+        [ heap-pop drop handle ] keep (allocate-registers)
     ] if ;
 
 : finish-allocation ( -- )
@@ -76,6 +71,6 @@ M: sync-point handle ( sync-point -- )
 
 : allocate-registers ( live-intervals sync-point machine-registers -- live-intervals )
     init-allocator
-    unhandled-intervals get unhandled-sync-points get (allocate-registers)
+    unhandled-min-heap get (allocate-registers)
     finish-allocation
     handled-intervals get ;

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

@@ -1,5 +1,6 @@
 USING: combinators.extras compiler.cfg compiler.cfg.instructions
-compiler.cfg.linear-scan.allocation.state kernel namespaces tools.test ;
+compiler.cfg.linear-scan.allocation.state
+compiler.cfg.linear-scan.live-intervals heaps kernel namespaces tools.test ;
 IN: compiler.cfg.linear-scan.allocation.state.tests
 
 {
@@ -12,3 +13,46 @@ IN: compiler.cfg.linear-scan.allocation.state.tests
     [ 8 next-spill-slot ] twice
     cfg get
 ] unit-test
+
+{ { 33 1/0.0 } } [
+    T{ sync-point { n 33 } } sync-point-key
+] unit-test
+
+{
+    {
+        { { 5 1/0. } T{ sync-point { n 5 } } }
+        {
+            { 20 28 }
+            T{ live-interval-state { start 20 } { end 28 } }
+        }
+        {
+            { 20 30 }
+            T{ live-interval-state { start 20 } { end 30 } }
+        }
+        {
+            { 33 999 }
+            T{ live-interval-state { start 33 } { end 999 } }
+        }
+        { { 33 1/0. } T{ sync-point { n 33 } } }
+        { { 100 1/0. } T{ sync-point { n 100 } } }
+    }
+} [
+    {
+        T{ live-interval-state { start 20 } { end 30 } }
+        T{ live-interval-state { start 20 } { end 28 } }
+        T{ live-interval-state { start 33 } { end 999 } }
+    }
+    {
+        T{ sync-point { n 5 } }
+        T{ sync-point { n 33 } }
+        T{ sync-point { n 100 } }
+    }
+    >unhandled-min-heap heap-pop-all
+] unit-test
+
+{ 2 } [
+    {
+        T{ live-interval-state { start 20 } { end 30 } }
+        T{ live-interval-state { start 20 } { end 30 } }
+    } { } >unhandled-min-heap heap-size
+] unit-test

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

@@ -1,10 +1,10 @@
 ! Copyright (C) 2009, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs combinators compiler.cfg
+USING: arrays accessors assocs combinators cpu.architecture fry
+heaps kernel math math.order namespaces layouts sequences vectors
+ compiler.cfg compiler.cfg.registers
 compiler.cfg.instructions
-compiler.cfg.linear-scan.live-intervals compiler.cfg.registers
-cpu.architecture fry heaps kernel layouts linked-assocs math
-math.order namespaces sequences ;
+compiler.cfg.linear-scan.live-intervals linked-assocs slots.syntax ;
 FROM: assocs => change-at ;
 IN: compiler.cfg.linear-scan.allocation.state
 
@@ -22,11 +22,20 @@ SYMBOL: progress
 : check-handled ( live-interval -- )
     end>> progress get > [ "check-handled" throw ] when ; inline
 
-: live-intervals>min-heap ( live-intervals -- min-heap )
-    [ [ start>> ] map ] keep zip >min-heap ;
+SYMBOL: unhandled-min-heap
 
-: sync-points>min-heap ( sync-points -- min-heap )
-    [ [ n>> ] map ] keep zip >min-heap ;
+: live-interval-key ( live-interval -- key )
+    get{ start end } ;
+
+: sync-point-key ( sync-point -- key )
+    n>> 1/0.0 2array ;
+
+: zip-keyed ( seq quot: ( elt -- key ) -- assoc )
+    dupd map swap zip ; inline
+
+: >unhandled-min-heap ( live-intervals sync-points -- min-heap )
+    [ [ live-interval-key ] zip-keyed ]
+    [ [ sync-point-key ] zip-keyed ] bi* append >min-heap ;
 
 ! Mapping from register classes to sequences of machine registers
 SYMBOL: registers
@@ -112,12 +121,11 @@ ERROR: register-already-used live-interval ;
         [ don't-change ]
     } process-intervals ;
 
-SYMBOL: unhandled-intervals
-
 : add-unhandled ( live-interval -- )
     [ check-unhandled ]
-    [ dup start>> unhandled-intervals get heap-push ]
-    bi ;
+    [
+        dup live-interval-key unhandled-min-heap get heap-push
+    ] bi ;
 
 : reg-class-assoc ( quot -- assoc )
     [ reg-classes ] dip { } map>assoc ; inline
@@ -130,8 +138,6 @@ SYMBOL: unhandled-intervals
 : align-spill-area ( align -- )
     cfg get [ max ] change-spill-area-align drop ;
 
-SYMBOL: unhandled-sync-points
-
 SYMBOL: spill-slots
 
 : assign-spill-slot ( coalesced-vreg rep -- spill-slot )
@@ -145,9 +151,7 @@ SYMBOL: spill-slots
 
 : init-allocator ( live-intervals sync-points registers -- )
     registers set
-    [ live-intervals>min-heap unhandled-intervals set ]
-    [ sync-points>min-heap unhandled-sync-points set ] bi*
-
+    >unhandled-min-heap unhandled-min-heap set
     [ V{ } clone ] reg-class-assoc active-intervals set
     [ V{ } clone ] reg-class-assoc inactive-intervals set
     V{ } clone handled-intervals set