compiler.cfg.linear-scan.assignment: utility word heap-pop-while which lets you express expire-old-intervals and activate-new-intervals more nicely + tests

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

@@ -1,6 +1,7 @@
-USING: compiler.cfg.instructions compiler.cfg.linear-scan.assignment
+USING: accessors arrays compiler.cfg.instructions
-compiler.cfg.linear-scan.live-intervals cpu.x86.assembler.operands make
+compiler.cfg.linear-scan.assignment compiler.cfg.linear-scan.live-intervals
-tools.test ;
+compiler.cfg.utilities cpu.architecture cpu.x86.assembler.operands grouping
+heaps kernel make namespaces random sequences sorting tools.test ;
 IN: compiler.cfg.linear-scan.assignment.tests
 
 { { T{ ##spill { src RAX } } } } [
@@ -8,3 +9,28 @@ IN: compiler.cfg.linear-scan.assignment.tests
         T{ live-interval-state { vreg 1234 } { reg RAX } } insert-spill
     ] { } make
 ] unit-test
+
+{ } [
+    { } init-assignment
+    V{ T{ ##inc-d { n 3 } { insn# 7 } } } 0 insns>block
+    assign-registers-in-block
+] unit-test
+
+{ V{ T{ ##spill { src RAX } { rep int-rep } } } } [
+    [
+        1234 int-regs <live-interval>
+        RAX >>reg int-rep >>spill-rep
+        insert-spill
+    ] V{ } make
+] unit-test
+
+{ { 3 56 } } [
+    { { 3 7 } { -1 56 } { -1 3 } } >min-heap [ -1 = ] heap-pop-while
+    natural-sort
+] unit-test
+
+{ 3 } [
+    { 50 90 95 120 } [ 25 int-regs <live-interval> 2array ] map >min-heap
+    pending-interval-heap set 90 expire-old-intervals
+    pending-interval-heap get heap-size
+] unit-test

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

@@ -77,6 +77,10 @@ SYMBOL: machine-live-outs
     H{ } clone machine-edge-live-ins set
     H{ } clone machine-live-outs set ;
 
+: heap-pop-while ( heap quot: ( key -- ? ) -- values )
+    '[ dup heap-empty? [ f f ] [ dup heap-peek @ ] if ]
+    [ over heap-pop* ] produce 2nip ; inline
+
 : insert-spill ( live-interval -- )
     [ reg>> ] [ spill-rep>> ] [ spill-to>> ] tri ##spill, ;
 
@@ -86,16 +90,9 @@ SYMBOL: machine-live-outs
 : expire-interval ( live-interval -- )
     [ remove-pending ] [ handle-spill ] bi ;
 
-: (expire-old-intervals) ( n heap -- )
-    dup heap-empty? [ 2drop ] [
-        2dup heap-peek nip <= [ 2drop ] [
-            dup heap-pop drop expire-interval
-            (expire-old-intervals)
-        ] if
-    ] if ;
-
 : expire-old-intervals ( n -- )
-    pending-interval-heap get (expire-old-intervals) ;
+    pending-interval-heap get swap '[ _ < ] heap-pop-while
+    [ expire-interval ] each ;
 
 : insert-reload ( live-interval -- )
     [ reg>> ] [ reload-rep>> ] [ reload-from>> ] tri ##reload, ;
@@ -106,16 +103,9 @@ SYMBOL: machine-live-outs
 : activate-interval ( live-interval -- )
     [ add-pending ] [ handle-reload ] bi ;
 
-: (activate-new-intervals) ( n heap -- )
-    dup heap-empty? [ 2drop ] [
-        2dup heap-peek nip = [
-            dup heap-pop drop activate-interval
-            (activate-new-intervals)
-        ] [ 2drop ] if
-    ] if ;
-
 : activate-new-intervals ( n -- )
-    unhandled-intervals get (activate-new-intervals) ;
+    unhandled-intervals get swap '[ _ = ] heap-pop-while
+    [ activate-interval ] each ;
 
 : prepare-insn ( n -- )
     [ expire-old-intervals ] [ activate-new-intervals ] bi ;