From 0bcf4ce535ed990c054d2f29912fb51210ed1f64 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 7 Jul 2009 03:28:55 -0500
Subject: [PATCH] compiler.cfg.linear-scan: Re-implement spilling, add some
 additional runtime assertions, simplify assignment pass since it doesn't have
 to track spill slots anymore; just assume a live value that's not in active
 or inactive is spilled

---
 .../linear-scan/allocation/allocation.factor  |  13 +-
 .../allocation/coalescing/coalescing.factor   |   6 +-
 .../allocation/spilling/spilling.factor       | 144 ++++--
 .../allocation/splitting/splitting.factor     |  13 +-
 .../linear-scan/allocation/state/state.factor |  19 +-
 .../linear-scan/assignment/assignment.factor  |  71 ++-
 .../cfg/linear-scan/debugger/debugger.factor  |   7 +-
 .../cfg/linear-scan/linear-scan-tests.factor  | 450 +++++++++++++-----
 .../live-intervals/live-intervals.factor      |  12 +-
 9 files changed, 508 insertions(+), 227 deletions(-)

diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
index 4a58064582..7dd3977605 100644
--- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
@@ -9,11 +9,6 @@ compiler.cfg.linear-scan.allocation.splitting
 compiler.cfg.linear-scan.allocation.state ;
 IN: compiler.cfg.linear-scan.allocation
 
-: free-positions ( new -- assoc )
-    vreg>> reg-class>> registers get at [ 1/0. ] H{ } map>assoc ;
-
-: add-use-position ( n reg assoc -- ) [ [ min ] when* ] change-at ;
-
 : active-positions ( new assoc -- )
     [ vreg>> active-intervals-for ] dip
     '[ [ 0 ] dip reg>> _ add-use-position ] each ;
@@ -21,7 +16,7 @@ IN: compiler.cfg.linear-scan.allocation
 : inactive-positions ( new assoc -- )
     [ [ vreg>> inactive-intervals-for ] keep ] dip
     '[
-        [ _ relevant-ranges intersect-live-ranges ] [ reg>> ] bi
+        [ _ relevant-ranges intersect-live-ranges 1/0. or ] [ reg>> ] bi
         _ add-use-position
     ] each ;
 
@@ -33,12 +28,6 @@ IN: compiler.cfg.linear-scan.allocation
 : no-free-registers? ( 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* ;
diff --git a/basis/compiler/cfg/linear-scan/allocation/coalescing/coalescing.factor b/basis/compiler/cfg/linear-scan/allocation/coalescing/coalescing.factor
index b2b9202204..e99c2ba710 100644
--- a/basis/compiler/cfg/linear-scan/allocation/coalescing/coalescing.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/coalescing/coalescing.factor
@@ -9,15 +9,15 @@ IN: compiler.cfg.linear-scan.allocation.coalescing
 : active-interval ( vreg -- live-interval )
     dup [ dup active-intervals-for [ vreg>> = ] with find nip ] when ;
 
-: intersects-inactive-intervals? ( live-interval -- ? )
+: avoids-inactive-intervals? ( live-interval -- ? )
     dup vreg>> inactive-intervals-for
-    [ relevant-ranges intersect-live-ranges 1/0. = ] with all? ;
+    [ intervals-intersect? not ] with all? ;
 
 : coalesce? ( live-interval -- ? )
     {
         [ copy-from>> active-interval ]
         [ [ start>> ] [ copy-from>> active-interval end>> ] bi = ]
-        [ intersects-inactive-intervals? ]
+        [ avoids-inactive-intervals? ]
     } 1&& ;
 
 : coalesce ( live-interval -- )
diff --git a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor
index e5c4b10021..9be80b0775 100644
--- a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor
@@ -1,23 +1,13 @@
 ! 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 compiler.utilities namespaces
+math sequences sets sorting splitting namespaces
+combinators.short-circuit 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
-
-: interval-to-spill ( active-intervals current -- live-interval )
-    #! We spill the interval with the most distant use location.
-    #! If an active interval has no more use positions, find-use
-    #! returns f. This occurs if the interval is a split. In
-    #! this case, we prefer to spill this interval always.
-    start>> '[ dup _ [ >= ] find-use 1/0. or ] { } map>assoc
-    alist-max first ;
-
 ERROR: bad-live-ranges interval ;
 
 : check-ranges ( live-interval -- )
@@ -47,52 +37,106 @@ ERROR: bad-live-ranges interval ;
         [ ]
     } 2cleave ;
 
-: assign-spill ( live-interval -- live-interval )
-    dup vreg>> assign-spill-slot >>spill-to ;
+: assign-spill ( live-interval -- )
+    dup vreg>> assign-spill-slot >>spill-to drop ;
 
-: assign-reload ( before after -- before after )
-    over spill-to>> >>reload-from ;
+: assign-reload ( live-interval -- )
+    dup vreg>> assign-spill-slot >>reload-from drop ;
 
-: split-and-spill ( new existing -- before after )
-    swap start>> split-for-spill [ assign-spill ] dip assign-reload ;
+: split-and-spill ( live-interval n -- before after )
+    split-for-spill
+    [ [ assign-spill ] [ assign-reload ] bi* ]
+    [ [ t >>record-spill? ] [ t >>record-reload? ] bi* ] 2bi ;
 
-: reuse-register ( new existing -- )
-    [ nip delete-active ]
-    [ reg>> >>reg add-active ] 2bi ;
+: find-use-position ( live-interval new -- n )
+    [ uses>> ] [ start>> '[ _ >= ] ] bi* find nip 1/0. or ;
 
-: spill-existing? ( new existing -- ? )
-    #! Test if 'new' will be used before 'existing'.
-    over start>> '[ _ [ > ] find-use -1 or ] bi@ < ;
+: find-use-positions ( live-intervals new assoc -- )
+    '[ [ _ find-use-position ] [ reg>> ] bi _ add-use-position ] each ;
 
-: spill-existing ( new existing -- )
-    #! Our new interval will be used before the active 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 ]
-    [ split-and-spill [ add-handled ] [ add-unhandled ] bi* ] 2bi ;
+: active-positions ( new assoc -- )
+    [ [ vreg>> active-intervals-for ] keep ] dip
+    find-use-positions ;
 
-: spill-live-out? ( new existing -- ? )
-    [ start>> ] [ uses>> last ] bi* > ;
+: inactive-positions ( new assoc -- )
+    [
+        [ vreg>> inactive-intervals-for ] keep
+        [ '[ _ intervals-intersect? ] filter ] keep
+    ] dip
+    find-use-positions ;
 
-: spill-live-out ( new existing -- )
-    #! The existing interval is never used again. Spill it and
-    #! re-use the register.
-    assign-spill
-    [ reuse-register ]
-    [ nip add-handled ] 2bi ;
+: spill-status ( new -- use-pos )
+    H{ } clone
+    [ inactive-positions ] [ active-positions ] [ nip ] 2tri
+    >alist alist-max ;
 
-: spill-new ( new existing -- )
-    #! Our new interval will be used after the active interval
-    #! with the most distant use location. Split the new
-    #! interval, then process both parts of the new interval
-    #! again.
-    [ dup split-and-spill add-unhandled ] dip spill-existing ;
+: spill-new? ( new pair -- ? )
+    [ uses>> first ] [ second ] bi* > ;
 
-: assign-blocked-register ( new -- )
-    [ dup vreg>> active-intervals-for ] keep interval-to-spill {
-        { [ 2dup spill-live-out? ] [ spill-live-out ] }
-        { [ 2dup spill-existing? ] [ spill-existing ] }
-        [ spill-new ]
+: spill-new ( new pair -- )
+    "not sure what to do yet" throw ;
+
+: split-intersecting? ( live-interval new reg -- ? )
+    { [ [ drop reg>> ] dip = ] [ drop intervals-intersect? ] } 3&& ;
+
+: split-live-out ( live-interval -- )
+    f >>record-spill?
+    {
+        [ trim-before-ranges ]
+        [ compute-start/end ]
+        [ assign-spill ]
+        [ add-handled ]
+    } cleave ;
+
+: split-live-in ( live-interval -- )
+    f >>record-reload?
+    {
+        [ trim-after-ranges ]
+        [ compute-start/end ]
+        ! [ assign-reload ]
+        [ add-handled ]
+    } cleave ;
+
+: (split-intersecting) ( live-interval new -- )
+    start>> {
+        { [ 2dup [ uses>> last ] dip < ] [ drop split-live-out ] }
+        { [ 2dup [ uses>> first ] dip > ] [ drop split-live-in ] }
+        [ split-and-spill [ add-handled ] [ add-unhandled ] bi* ]
     } cond ;
 
+: (split-intersecting-active) ( active new -- )
+    [ drop delete-active ]
+    [ (split-intersecting) ] 2bi ;
+
+: split-intersecting-active ( new reg -- )
+    [ [ vreg>> active-intervals-for ] keep ] dip
+    [ '[ _ _ split-intersecting? ] filter ] 2keep drop
+    '[ _ (split-intersecting-active) ] each ;
+
+: (split-intersecting-inactive) ( inactive new -- )
+    [ drop delete-inactive ]
+    [ (split-intersecting) ] 2bi ;
+
+: split-intersecting-inactive ( new reg -- )
+    [ [ vreg>> inactive-intervals-for ] keep ] dip
+    [ '[ _ _ split-intersecting? ] filter ] 2keep drop
+    '[ _ (split-intersecting-inactive) ] each ;
+
+: split-intersecting ( new reg -- )
+    [ split-intersecting-active ]
+    [ split-intersecting-inactive ]
+    2bi ;
+
+: spill-available ( new pair -- )
+    [ first split-intersecting ] [ register-available ] 2bi ;
+
+: spill-partially-available ( new pair -- )
+    [ second 1 - split-and-spill add-unhandled ] keep
+    spill-available ;
+
+: assign-blocked-register ( new -- )
+    dup spill-status {
+        { [ 2dup spill-new? ] [ spill-new ] }
+        { [ 2dup register-available? ] [ spill-available ] }
+        [ spill-partially-available ]
+    } cond ;
\ No newline at end of file
diff --git a/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor b/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor
index b2872ace14..71d3d56285 100644
--- a/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor
@@ -1,7 +1,7 @@
 ! 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 namespaces
 compiler.cfg.linear-scan.allocation.state
 compiler.cfg.linear-scan.live-intervals ;
 IN: compiler.cfg.linear-scan.allocation.splitting
@@ -32,12 +32,17 @@ IN: compiler.cfg.linear-scan.allocation.splitting
 
 ERROR: splitting-too-early ;
 
+ERROR: splitting-too-late ;
+
 ERROR: splitting-atomic-interval ;
 
 : check-split ( live-interval n -- )
-    [ [ start>> ] dip > [ splitting-too-early ] when ]
-    [ drop [ end>> ] [ start>> ] bi - 0 = [ splitting-atomic-interval ] when ]
-    2bi ; inline
+    check-allocation? get [
+        [ [ start>> ] dip > [ splitting-too-early ] when ]
+        [ [ end>> ] dip <= [ splitting-too-late ] when ]
+        [ drop [ end>> ] [ start>> ] bi = [ splitting-atomic-interval ] when ]
+        2tri
+    ] [ 2drop ] if ; inline
 
 : split-before ( before -- before' )
     f >>spill-to ; inline
diff --git a/basis/compiler/cfg/linear-scan/allocation/state/state.factor b/basis/compiler/cfg/linear-scan/allocation/state/state.factor
index a17a1181b5..a08e3e37bd 100644
--- a/basis/compiler/cfg/linear-scan/allocation/state/state.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/state/state.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs combinators cpu.architecture fry heaps
-kernel math namespaces sequences vectors
+kernel math math.order namespaces sequences vectors
 compiler.cfg.linear-scan.live-intervals ;
 IN: compiler.cfg.linear-scan.allocation.state
 
@@ -32,6 +32,9 @@ SYMBOL: inactive-intervals
 : add-inactive ( live-interval -- )
     dup vreg>> inactive-intervals-for push ;
 
+: delete-inactive ( live-interval -- )
+    dup vreg>> inactive-intervals-for delq ;
+
 ! Vector of handled live intervals
 SYMBOL: handled-intervals
 
@@ -133,4 +136,16 @@ SYMBOL: spill-slots
 
 : init-unhandled ( live-intervals -- )
     [ [ start>> ] keep ] { } map>assoc
-    unhandled-intervals get heap-push-all ;
\ No newline at end of file
+    unhandled-intervals get heap-push-all ;
+
+! A utility used by register-status and spill-status words
+: free-positions ( new -- assoc )
+    vreg>> reg-class>> registers get at [ 1/0. ] H{ } map>assoc ;
+
+: add-use-position ( n reg assoc -- ) [ [ min ] when* ] change-at ;
+
+: register-available? ( new result -- ? )
+    [ end>> ] [ second ] bi* < ; inline
+
+: register-available ( new result -- )
+    first >>reg add-active ;
diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
index 8a9bfa02db..bc565c6cbb 100644
--- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor
+++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
@@ -3,7 +3,9 @@
 USING: accessors kernel math assocs namespaces sequences heaps
 fry make combinators sets locals
 cpu.architecture
+compiler.cfg
 compiler.cfg.def-use
+compiler.cfg.liveness
 compiler.cfg.registers
 compiler.cfg.instructions
 compiler.cfg.linear-scan.allocation
@@ -27,12 +29,6 @@ SYMBOL: unhandled-intervals
 : init-unhandled ( live-intervals -- )
     [ add-unhandled ] each ;
 
-! Mapping spill slots to vregs
-SYMBOL: spill-slots
-
-: spill-slots-for ( vreg -- assoc )
-    reg-class>> spill-slots get at ;
-
 ! Mapping from basic blocks to values which are live at the start
 SYMBOL: register-live-ins
 
@@ -42,17 +38,10 @@ SYMBOL: register-live-outs
 : init-assignment ( live-intervals -- )
     V{ } clone pending-intervals set
     <min-heap> unhandled-intervals set
-    [ H{ } clone ] reg-class-assoc spill-slots set
     H{ } clone register-live-ins set
     H{ } clone register-live-outs set
     init-unhandled ;
 
-ERROR: already-spilled ;
-
-: record-spill ( live-interval -- )
-    [ dup spill-to>> ] [ vreg>> spill-slots-for ] bi
-    2dup key? drop set-at ; ! [ already-spilled ] [ set-at ] if ;
-
 : insert-spill ( live-interval -- )
     {
         [ reg>> ]
@@ -62,7 +51,7 @@ ERROR: already-spilled ;
     } cleave f swap \ _spill boa , ;
 
 : handle-spill ( live-interval -- )
-    dup spill-to>> [ [ record-spill ] [ insert-spill ] bi ] [ drop ] if ;
+    dup spill-to>> [ insert-spill ] [ drop ] if ;
 
 : first-split ( live-interval -- live-interval' )
     dup split-before>> [ first-split ] [ ] ?if ;
@@ -88,12 +77,6 @@ ERROR: already-spilled ;
         [ [ handle-spill ] [ handle-copy ] bi f ] [ drop t ] if
     ] filter-here ;
 
-ERROR: already-reloaded ;
-
-: record-reload ( live-interval -- )
-    [ reload-from>> ] [ vreg>> spill-slots-for ] bi
-    2dup key? [ delete-at ] [ already-reloaded ] if ;
-
 : insert-reload ( live-interval -- )
     {
         [ reg>> ]
@@ -103,7 +86,7 @@ ERROR: already-reloaded ;
     } cleave f swap \ _reload boa , ;
 
 : handle-reload ( live-interval -- )
-    dup reload-from>> [ [ record-reload ] [ insert-reload ] bi ] [ drop ] if ;
+    dup reload-from>> [ insert-reload ] [ drop ] if ;
 
 : activate-new-intervals ( n -- )
     #! Any live intervals which start on the current instruction
@@ -145,35 +128,43 @@ M: vreg-insn assign-registers-in-insn
     register-mapping
     >>regs drop ;
 
-: compute-live-registers ( n -- assoc )
-    active-intervals register-mapping ;
-
-: compute-live-spill-slots ( -- assocs )
-    spill-slots get values first2
-    [ [ vreg>> swap <spill-slot> ] H{ } assoc-map-as ] bi@
-    assoc-union ;
-
-: compute-live-values ( n -- assoc )
-    [ compute-live-spill-slots ] dip compute-live-registers
-    assoc-union ;
-
-: compute-live-gc-values ( insn -- assoc )
-    [ insn#>> compute-live-values ] [ temp-vregs ] bi
-    '[ drop _ memq? not ] assoc-filter ;
-
 M: ##gc assign-registers-in-insn
+    ! This works because ##gc is always the first instruction
+    ! in a block.
     dup call-next-method
-    dup compute-live-gc-values >>live-values
+    basic-block get register-live-ins get at >>live-values
     drop ;
 
 M: insn assign-registers-in-insn drop ;
 
+: compute-live-spill-slots ( vregs -- assoc )
+    spill-slots get '[ _ at dup [ <spill-slot> ] when ] assoc-map ;
+
+: compute-live-registers ( n -- assoc )
+    active-intervals register-mapping ;
+
+ERROR: bad-live-values live-values ;
+
+: check-live-values ( assoc -- assoc )
+    check-assignment? get [
+        dup values [ not ] any? [ bad-live-values ] when
+    ] when ;
+
+: compute-live-values ( vregs n -- assoc )
+    ! If a live vreg is not in active or inactive, then it must have been
+    ! spilled.
+    [ compute-live-spill-slots ] [ compute-live-registers ] bi*
+    assoc-union check-live-values ;
+
 : begin-block ( bb -- )
+    dup basic-block set
     dup block-from prepare-insn
-    [ block-from compute-live-values ] keep register-live-ins get set-at ;
+    [ [ live-in ] [ block-from ] bi compute-live-values ] keep
+    register-live-ins get set-at ;
 
 : end-block ( bb -- )
-    [ block-to compute-live-values ] keep register-live-outs get set-at ;
+    [ [ live-out ] [ block-to ] bi compute-live-values ] keep
+    register-live-outs get set-at ;
 
 ERROR: bad-vreg vreg ;
 
diff --git a/basis/compiler/cfg/linear-scan/debugger/debugger.factor b/basis/compiler/cfg/linear-scan/debugger/debugger.factor
index be3fb2bea8..a350ee5f43 100644
--- a/basis/compiler/cfg/linear-scan/debugger/debugger.factor
+++ b/basis/compiler/cfg/linear-scan/debugger/debugger.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel sequences sets arrays math strings fry
 namespaces prettyprint compiler.cfg.linear-scan.live-intervals
-compiler.cfg.linear-scan.allocation compiler.cfg ;
+compiler.cfg.linear-scan.allocation compiler.cfg assocs ;
 IN: compiler.cfg.linear-scan.debugger
 
 : check-assigned ( live-intervals -- )
@@ -19,7 +19,10 @@ IN: compiler.cfg.linear-scan.debugger
     ] [ 1array ] if ;
 
 : check-linear-scan ( live-intervals machine-registers -- )
-    [ [ clone ] map ] dip allocate-registers
+    [
+        [ clone ] map dup [ [ vreg>> ] keep ] H{ } map>assoc
+        live-intervals set
+    ] dip allocate-registers
     [ split-children ] map concat check-assigned ;
 
 : picture ( uses -- str )
diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
index e3cd9e105f..59e6190b63 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
@@ -76,36 +76,6 @@ check-assignment? on
     { T{ live-range f 0 5 } } 0 split-ranges
 ] unit-test
 
-[ 7 ] [
-    T{ live-interval
-        { vreg T{ vreg { reg-class int-regs } { n 2 } } }
-        { start 0 }
-        { end 10 }
-        { uses V{ 0 1 3 7 10 } }
-    }
-    4 [ >= ] find-use
-] unit-test
-
-[ 4 ] [
-    T{ live-interval
-        { vreg T{ vreg { reg-class int-regs } { n 2 } } }
-        { start 0 }
-        { end 10 }
-        { uses V{ 0 1 3 4 10 } }
-    }
-    4 [ >= ] find-use
-] unit-test
-
-[ f ] [
-    T{ live-interval
-        { vreg T{ vreg { reg-class int-regs } { n 2 } } }
-        { start 0 }
-        { end 10 }
-        { uses V{ 0 1 3 4 10 } }
-    }
-    100 [ >= ] find-use
-] unit-test
-
 [
     T{ live-interval
        { vreg T{ vreg { reg-class int-regs } { n 1 } } }
@@ -257,88 +227,82 @@ check-assignment? on
 ] unit-test
 
 [
-    T{ live-interval
-        { vreg T{ vreg { reg-class int-regs } { n 1 } } }
-        { start 3 }
-        { end 10 }
-        { uses V{ 3 10 } }
+    {
+        3
+        10
     }
 ] [
+    H{
+        { int-regs
+          V{
+              T{ live-interval
+                 { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+                 { reg 1 }
+                 { start 1 }
+                 { end 15 }
+                 { uses V{ 1 3 7 10 15 } }
+              }
+              T{ live-interval
+                 { vreg T{ vreg { reg-class int-regs } { n 2 } } }
+                 { reg 2 }
+                 { start 3 }
+                 { end 8 }
+                 { uses V{ 3 4 8 } }
+              }
+              T{ live-interval
+                 { vreg T{ vreg { reg-class int-regs } { n 3 } } }
+                 { reg 3 }
+                 { start 3 }
+                 { end 10 }
+                 { uses V{ 3 10 } }
+              }
+          }
+        }
+    } active-intervals set
+    H{ } inactive-intervals set
+    T{ live-interval
+        { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+        { start 5 }
+        { end 5 }
+        { uses V{ 5 } }
+    }
+    spill-status
+] unit-test
+
+[
     {
-        T{ live-interval
-            { vreg T{ vreg { reg-class int-regs } { n 1 } } }
-            { start 1 }
-            { end 15 }
-            { uses V{ 1 3 7 10 15 } }
-        }
-        T{ live-interval
-            { vreg T{ vreg { reg-class int-regs } { n 1 } } }
-            { start 3 }
-            { end 8 }
-            { uses V{ 3 4 8 } }
-        }
-        T{ live-interval
-            { vreg T{ vreg { reg-class int-regs } { n 1 } } }
-            { start 3 }
-            { end 10 }
-            { uses V{ 3 10 } }
-        }
+        1
+        1/0.
     }
+] [
+    H{
+        { int-regs
+          V{
+              T{ live-interval
+                 { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+                 { reg 1 }
+                 { start 1 }
+                 { end 15 }
+                 { uses V{ 1 } }
+              }
+              T{ live-interval
+                 { vreg T{ vreg { reg-class int-regs } { n 2 } } }
+                 { reg 2 }
+                 { start 3 }
+                 { end 8 }
+                 { uses V{ 3 8 } }
+              }
+          }
+        }
+    } active-intervals set
+    H{ } inactive-intervals set
     T{ live-interval
-        { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+        { vreg T{ vreg { reg-class int-regs } { n 3 } } }
         { start 5 }
         { end 5 }
         { uses V{ 5 } }
     }
-    interval-to-spill
-] unit-test
-
-[ t ] [
-    T{ live-interval
-        { vreg T{ vreg { reg-class int-regs } { n 1 } } }
-        { start 5 }
-        { end 15 }
-        { uses V{ 5 10 15 } }
-    }
-    T{ live-interval
-        { vreg T{ vreg { reg-class int-regs } { n 1 } } }
-        { start 1 }
-        { end 20 }
-        { uses V{ 1 20 } }
-    }
-    spill-existing?
-] unit-test
-
-[ f ] [
-    T{ live-interval
-        { vreg T{ vreg { reg-class int-regs } { n 1 } } }
-        { start 5 }
-        { end 15 }
-        { uses V{ 5 10 15 } }
-    }
-    T{ live-interval
-        { vreg T{ vreg { reg-class int-regs } { n 1 } } }
-        { start 1 }
-        { end 20 }
-        { uses V{ 1 7 20 } }
-    }
-    spill-existing?
-] unit-test
-
-[ t ] [
-    T{ live-interval
-        { vreg T{ vreg { reg-class int-regs } { n 1 } } }
-        { start 5 }
-        { end 5 }
-        { uses V{ 5 } }
-    }
-    T{ live-interval
-        { vreg T{ vreg { reg-class int-regs } { n 1 } } }
-        { start 1 }
-        { end 20 }
-        { uses V{ 1 7 20 } }
-    }
-    spill-existing?
+    spill-status
 ] unit-test
 
 [ ] [
@@ -1477,6 +1441,20 @@ USING: math.private ;
     intersect-live-ranges
 ] unit-test
 
+[ f ] [
+    {
+        T{ live-range f 0 10 }
+        T{ live-range f 20 30 }
+        T{ live-range f 40 50 }
+    }
+    {
+        T{ live-range f 11 15 }
+        T{ live-range f 31 36 }
+        T{ live-range f 51 55 }
+    }
+    intersect-live-ranges
+] unit-test
+
 [ 5 ] [
     T{ live-interval
        { start 0 }
@@ -1605,12 +1583,14 @@ V{
 SYMBOL: linear-scan-result
 
 :: test-linear-scan-on-cfg ( regs -- )
-    cfg new 0 get >>entry
-    compute-predecessors
-    compute-liveness
-    dup reverse-post-order
-    { { int-regs regs } } (linear-scan)
-    flatten-cfg 1array mr. ;
+    [
+        cfg new 0 get >>entry
+        compute-predecessors
+        compute-liveness
+        dup reverse-post-order
+        { { int-regs regs } } (linear-scan)
+        flatten-cfg 1array mr.
+    ] with-scope ;
 
 ! This test has a critical edge -- do we care about these?
 
@@ -2101,3 +2081,255 @@ V{
 5 get 1vector 3 get (>>successors)
 
 [ ] [ { 1 2 } test-linear-scan-on-cfg ] unit-test
+
+! Reduction of push-all regression, x86-32
+V{ T{ ##prologue } T{ ##branch } } 0 test-bb
+
+V{
+    T{ ##load-immediate { dst V int-regs 61 } }
+    T{ ##peek { dst V int-regs 62 } { loc D 0 } }
+    T{ ##peek { dst V int-regs 64 } { loc D 1 } }
+    T{ ##slot-imm
+        { dst V int-regs 69 }
+        { obj V int-regs 64 }
+        { slot 1 }
+        { tag 2 }
+    }
+    T{ ##copy { dst V int-regs 79 } { src V int-regs 69 } }
+    T{ ##slot-imm
+        { dst V int-regs 85 }
+        { obj V int-regs 62 }
+        { slot 2 }
+        { tag 7 }
+    }
+    T{ ##compare-branch
+        { src1 V int-regs 69 }
+        { src2 V int-regs 85 }
+        { cc cc> }
+    }
+} 1 test-bb
+
+V{
+    T{ ##slot-imm
+        { dst V int-regs 97 }
+        { obj V int-regs 62 }
+        { slot 2 }
+        { tag 7 }
+    }
+    T{ ##replace { src V int-regs 79 } { loc D 3 } }
+    T{ ##replace { src V int-regs 62 } { loc D 4 } }
+    T{ ##replace { src V int-regs 79 } { loc D 1 } }
+    T{ ##replace { src V int-regs 62 } { loc D 2 } }
+    T{ ##replace { src V int-regs 61 } { loc D 5 } }
+    T{ ##replace { src V int-regs 62 } { loc R 0 } }
+    T{ ##replace { src V int-regs 69 } { loc R 1 } }
+    T{ ##replace { src V int-regs 97 } { loc D 0 } }
+    T{ ##call { word resize-array } }
+    T{ ##branch }
+} 2 test-bb
+
+V{
+    T{ ##peek { dst V int-regs 98 } { loc R 0 } }
+    T{ ##peek { dst V int-regs 100 } { loc D 0 } }
+    T{ ##set-slot-imm
+        { src V int-regs 100 }
+        { obj V int-regs 98 }
+        { slot 2 }
+        { tag 7 }
+    }
+    T{ ##peek { dst V int-regs 108 } { loc D 2 } }
+    T{ ##peek { dst V int-regs 110 } { loc D 3 } }
+    T{ ##peek { dst V int-regs 112 } { loc D 0 } }
+    T{ ##peek { dst V int-regs 114 } { loc D 1 } }
+    T{ ##peek { dst V int-regs 116 } { loc D 4 } }
+    T{ ##peek { dst V int-regs 119 } { loc R 0 } }
+    T{ ##copy { dst V int-regs 109 } { src V int-regs 108 } }
+    T{ ##copy { dst V int-regs 111 } { src V int-regs 110 } }
+    T{ ##copy { dst V int-regs 113 } { src V int-regs 112 } }
+    T{ ##copy { dst V int-regs 115 } { src V int-regs 114 } }
+    T{ ##copy { dst V int-regs 117 } { src V int-regs 116 } }
+    T{ ##copy { dst V int-regs 120 } { src V int-regs 119 } }
+    T{ ##branch }
+} 3 test-bb
+
+V{
+    T{ ##copy { dst V int-regs 109 } { src V int-regs 62 } }
+    T{ ##copy { dst V int-regs 111 } { src V int-regs 61 } }
+    T{ ##copy { dst V int-regs 113 } { src V int-regs 62 } }
+    T{ ##copy { dst V int-regs 115 } { src V int-regs 79 } }
+    T{ ##copy { dst V int-regs 117 } { src V int-regs 64 } }
+    T{ ##copy { dst V int-regs 120 } { src V int-regs 69 } }
+    T{ ##branch }
+} 4 test-bb
+
+V{
+    T{ ##replace { src V int-regs 120 } { loc D 0 } }
+    T{ ##replace { src V int-regs 109 } { loc D 3 } }
+    T{ ##replace { src V int-regs 111 } { loc D 4 } }
+    T{ ##replace { src V int-regs 113 } { loc D 1 } }
+    T{ ##replace { src V int-regs 115 } { loc D 2 } }
+    T{ ##replace { src V int-regs 117 } { loc D 5 } }
+    T{ ##epilogue }
+    T{ ##return }
+} 5 test-bb
+
+0 get 1 get 1vector >>successors drop
+1 get 2 get 4 get V{ } 2sequence >>successors drop
+2 get 3 get 1vector >>successors drop
+3 get 5 get 1vector >>successors drop
+4 get 5 get 1vector >>successors drop
+
+[ ] [ { 1 2 3 4 5 } test-linear-scan-on-cfg ] unit-test
+
+! Another reduction of push-all
+V{ T{ ##prologue } T{ ##branch } } 0 test-bb
+
+V{
+    T{ ##peek { dst V int-regs 85 } { loc D 0 } }
+    T{ ##slot-imm
+        { dst V int-regs 89 }
+        { obj V int-regs 85 }
+        { slot 3 }
+        { tag 7 }
+    }
+    T{ ##peek { dst V int-regs 91 } { loc D 1 } }
+    T{ ##slot-imm
+        { dst V int-regs 96 }
+        { obj V int-regs 91 }
+        { slot 1 }
+        { tag 2 }
+    }
+    T{ ##add
+        { dst V int-regs 109 }
+        { src1 V int-regs 89 }
+        { src2 V int-regs 96 }
+    }
+    T{ ##slot-imm
+        { dst V int-regs 115 }
+        { obj V int-regs 85 }
+        { slot 2 }
+        { tag 7 }
+    }
+    T{ ##slot-imm
+        { dst V int-regs 118 }
+        { obj V int-regs 115 }
+        { slot 1 }
+        { tag 2 }
+    }
+    T{ ##compare-branch
+        { src1 V int-regs 109 }
+        { src2 V int-regs 118 }
+        { cc cc> }
+    }
+} 1 test-bb
+
+V{
+    T{ ##add-imm
+        { dst V int-regs 128 }
+        { src1 V int-regs 109 }
+        { src2 8 }
+    }
+    T{ ##load-immediate { dst V int-regs 129 } { val 24 } }
+    T{ ##inc-d { n 4 } }
+    T{ ##inc-r { n 1 } }
+    T{ ##replace { src V int-regs 109 } { loc D 2 } }
+    T{ ##replace { src V int-regs 85 } { loc D 3 } }
+    T{ ##replace { src V int-regs 128 } { loc D 0 } }
+    T{ ##replace { src V int-regs 85 } { loc D 1 } }
+    T{ ##replace { src V int-regs 89 } { loc D 4 } }
+    T{ ##replace { src V int-regs 96 } { loc R 0 } }
+    T{ ##fixnum-mul
+        { src1 V int-regs 128 }
+        { src2 V int-regs 129 }
+        { temp1 V int-regs 132 }
+        { temp2 V int-regs 133 }
+    }
+    T{ ##branch }
+} 2 test-bb
+
+V{
+    T{ ##peek { dst V int-regs 134 } { loc D 1 } }
+    T{ ##slot-imm
+        { dst V int-regs 140 }
+        { obj V int-regs 134 }
+        { slot 2 }
+        { tag 7 }
+    }
+    T{ ##inc-d { n 1 } }
+    T{ ##inc-r { n 1 } }
+    T{ ##replace { src V int-regs 140 } { loc D 0 } }
+    T{ ##replace { src V int-regs 134 } { loc R 0 } }
+    T{ ##call { word resize-array } }
+    T{ ##branch }
+} 3 test-bb
+
+V{
+    T{ ##peek { dst V int-regs 141 } { loc R 0 } }
+    T{ ##peek { dst V int-regs 143 } { loc D 0 } }
+    T{ ##set-slot-imm
+        { src V int-regs 143 }
+        { obj V int-regs 141 }
+        { slot 2 }
+        { tag 7 }
+    }
+    T{ ##write-barrier
+        { src V int-regs 141 }
+        { card# V int-regs 145 }
+        { table V int-regs 146 }
+    }
+    T{ ##inc-d { n -1 } }
+    T{ ##inc-r { n -1 } }
+    T{ ##peek { dst V int-regs 156 } { loc D 2 } }
+    T{ ##peek { dst V int-regs 158 } { loc D 3 } }
+    T{ ##peek { dst V int-regs 160 } { loc D 0 } }
+    T{ ##peek { dst V int-regs 162 } { loc D 1 } }
+    T{ ##peek { dst V int-regs 164 } { loc D 4 } }
+    T{ ##peek { dst V int-regs 167 } { loc R 0 } }
+    T{ ##copy { dst V int-regs 157 } { src V int-regs 156 } }
+    T{ ##copy { dst V int-regs 159 } { src V int-regs 158 } }
+    T{ ##copy { dst V int-regs 161 } { src V int-regs 160 } }
+    T{ ##copy { dst V int-regs 163 } { src V int-regs 162 } }
+    T{ ##copy { dst V int-regs 165 } { src V int-regs 164 } }
+    T{ ##copy { dst V int-regs 168 } { src V int-regs 167 } }
+    T{ ##branch }
+} 4 test-bb
+
+V{
+    T{ ##inc-d { n 3 } }
+    T{ ##inc-r { n 1 } }
+    T{ ##copy { dst V int-regs 157 } { src V int-regs 85 } }
+    T{ ##copy { dst V int-regs 159 } { src V int-regs 89 } }
+    T{ ##copy { dst V int-regs 161 } { src V int-regs 85 } }
+    T{ ##copy { dst V int-regs 163 } { src V int-regs 109 } }
+    T{ ##copy { dst V int-regs 165 } { src V int-regs 91 } }
+    T{ ##copy { dst V int-regs 168 } { src V int-regs 96 } }
+    T{ ##branch }
+} 5 test-bb
+
+V{
+    T{ ##set-slot-imm
+        { src V int-regs 163 }
+        { obj V int-regs 161 }
+        { slot 3 }
+        { tag 7 }
+    }
+    T{ ##inc-d { n 1 } }
+    T{ ##inc-r { n -1 } }
+    T{ ##replace { src V int-regs 168 } { loc D 0 } }
+    T{ ##replace { src V int-regs 157 } { loc D 3 } }
+    T{ ##replace { src V int-regs 159 } { loc D 4 } }
+    T{ ##replace { src V int-regs 161 } { loc D 1 } }
+    T{ ##replace { src V int-regs 163 } { loc D 2 } }
+    T{ ##replace { src V int-regs 165 } { loc D 5 } }
+    T{ ##epilogue }
+    T{ ##return }
+} 6 test-bb
+
+0 get 1 get 1vector >>successors drop
+1 get 2 get 5 get V{ } 2sequence >>successors drop
+2 get 3 get 1vector >>successors drop
+3 get 4 get 1vector >>successors drop
+4 get 6 get 1vector >>successors drop
+5 get 6 get 1vector >>successors drop
+
+[ ] [ { 1 2 3 4 5 } test-linear-scan-on-cfg ] unit-test
\ No newline at end of file
diff --git a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
index 61432eefdf..e735640b10 100644
--- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
+++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
@@ -11,7 +11,7 @@ C: <live-range> live-range
 
 TUPLE: live-interval
 vreg
-reg spill-to reload-from
+reg spill-to record-spill? reload-from record-reload?
 split-before split-after split-next
 start end ranges uses
 copy-from ;
@@ -145,8 +145,7 @@ M: ##copy-float compute-live-intervals*
         <reversed> [ compute-live-intervals-step ] each
     ] keep values dup finish-live-intervals ;
 
-: relevant-ranges ( new inactive -- new' inactive' )
-    ! Slice off all ranges of 'inactive' that precede the start of 'new'
+: relevant-ranges ( interval1 interval2 -- ranges1 ranges2 )
     [ [ ranges>> ] bi@ ] [ nip start>> ] 2bi '[ to>> _ >= ] filter ;
 
 : intersect-live-range ( range1 range2 -- n/f )
@@ -155,8 +154,8 @@ M: ##copy-float compute-live-intervals*
 
 : intersect-live-ranges ( ranges1 ranges2 -- n )
     {
-        { [ over empty? ] [ 2drop 1/0. ] }
-        { [ dup empty? ] [ 2drop 1/0. ] }
+        { [ over empty? ] [ 2drop f ] }
+        { [ dup empty? ] [ 2drop f ] }
         [
             2dup [ first ] bi@ intersect-live-range dup [ 2nip ] [
                 drop
@@ -166,3 +165,6 @@ M: ##copy-float compute-live-intervals*
             ] if
         ]
     } cond ;
+
+: intervals-intersect? ( interval1 interval2 -- ? )
+    relevant-ranges intersect-live-ranges >boolean ; inline
\ No newline at end of file