compiler.cfg.linear-scan: debugging spilling, add more assertions

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

@@ -72,7 +72,13 @@ ERROR: bad-live-ranges interval ;
     [ uses>> first ] [ second ] bi* > ;
 
 : spill-new ( new pair -- )
-    "not sure what to do yet" throw ;
+    drop
+    {
+        [ trim-after-ranges ]
+        [ compute-start/end ]
+        [ assign-reload ]
+        [ add-unhandled ]
+    } cleave ;
 
 : split-intersecting? ( live-interval new reg -- ? )
     { [ [ drop reg>> ] dip = ] [ drop intervals-intersect? ] } 3&& ;
@@ -90,7 +96,7 @@ ERROR: bad-live-ranges interval ;
         [ trim-after-ranges ]
         [ compute-start/end ]
         [ assign-reload ]
-        [ add-handled ]
+        [ add-unhandled ]
     } cleave ;
 
 : (split-intersecting) ( live-interval new -- )

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

@@ -5,6 +5,20 @@ kernel math math.order namespaces sequences vectors
 compiler.cfg.linear-scan.live-intervals ;
 IN: compiler.cfg.linear-scan.allocation.state
 
+! Start index of current live interval. We ensure that all
+! live intervals added to the unhandled set have a start index
+! strictly greater than this one. This ensures that we can catch
+! infinite loop situations. We also ensure that all live
+! intervals added to the handled set have an end index strictly
+! smaller than this one. This helps catch bugs.
+SYMBOL: progress
+
+: check-unhandled ( live-interval -- )
+    start>> progress get <= [ "check-unhandled" throw ] when ; inline
+
+: check-handled ( live-interval -- )
+    end>> progress get > [ "check-handled" throw ] when ; inline
+
 ! Mapping from register classes to sequences of machine registers
 SYMBOL: registers
 
@@ -39,7 +53,7 @@ SYMBOL: inactive-intervals
 SYMBOL: handled-intervals
 
 : add-handled ( live-interval -- )
-    handled-intervals get push ;
+    [ check-handled ] [ handled-intervals get push ] bi ;
 
 : finished? ( n live-interval -- ? ) end>> swap < ;
 
@@ -93,17 +107,8 @@ ERROR: register-already-used live-interval ;
 ! Minheap of live intervals which still need a register allocation
 SYMBOL: unhandled-intervals
 
-! Start index of current live interval. We ensure that all
-! live intervals added to the unhandled set have a start index
-! strictly greater than ths one. This ensures that we can catch
-! infinite loop situations.
-SYMBOL: progress
-
-: check-progress ( live-interval -- )
-    start>> progress get <= [ "No progress" throw ] when ; inline
-
 : add-unhandled ( live-interval -- )
-    [ check-progress ]
+    [ check-unhandled ]
     [ dup start>> unhandled-intervals get heap-push ]
     bi ;
 

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

@@ -68,8 +68,7 @@ SYMBOL: register-live-outs
     } cleave f swap \ _copy boa , ;
 
 : handle-copy ( live-interval -- )
-    dup [ spill-to>> not ] [ split-next>> ] bi and
+    dup split-next>> [ insert-copy ] [ drop ] if ;
-    [ insert-copy ] [ drop ] if ;
 
 : expire-old-intervals ( n -- )
     [ pending-intervals get ] dip '[
@@ -82,7 +81,7 @@ SYMBOL: register-live-outs
         [ reg>> ]
         [ vreg>> reg-class>> ]
         [ reload-from>> ]
-        [ end>> ]
+        [ start>> ]
     } cleave f swap \ _reload boa , ;
 
 : handle-reload ( live-interval -- )
@@ -92,7 +91,7 @@ SYMBOL: register-live-outs
     #! Any live intervals which start on the current instruction
     #! are added to the active set.
     unhandled-intervals get dup heap-empty? [ 2drop ] [
-        2dup heap-peek drop start>> >= [
+        2dup heap-peek drop start>> = [
             heap-pop drop
             [ add-active ] [ handle-reload ] bi
             activate-new-intervals
@@ -179,10 +178,12 @@ ERROR: bad-vreg vreg ;
         [
             bb begin-block
             [
+                {
+                    [ insn#>> 1 - prepare-insn ]
                     [ insn#>> prepare-insn ]
                     [ assign-registers-in-insn ]
                     [ , ]
-                tri
+                } cleave
             ] each
             bb end-block
         ] V{ } make

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

@@ -1,7 +1,7 @@
 IN: compiler.cfg.linear-scan.tests
 USING: tools.test random sorting sequences sets hashtables assocs
 kernel fry arrays splitting namespaces math accessors vectors locals
-math.order grouping
+math.order grouping strings strings.private
 cpu.architecture
 compiler.cfg
 compiler.cfg.optimizer
@@ -13,6 +13,7 @@ compiler.cfg.rpo
 compiler.cfg.linearization
 compiler.cfg.debugger
 compiler.cfg.linear-scan
+compiler.cfg.linear-scan.numbering
 compiler.cfg.linear-scan.live-intervals
 compiler.cfg.linear-scan.allocation
 compiler.cfg.linear-scan.allocation.state
@@ -24,6 +25,7 @@ FROM: compiler.cfg.linear-scan.assignment => check-assignment? ;
 
 check-allocation? on
 check-assignment? on
+check-numbering? on
 
 [
     { T{ live-range f 1 10 } T{ live-range f 15 15 } }
@@ -2333,3 +2335,203 @@ V{
 5 get 6 get 1vector >>successors drop
 
 [ ] [ { 1 2 3 4 5 } test-linear-scan-on-cfg ] unit-test
+
+! Another push-all reduction to demonstrate numbering anamoly
+V{ T{ ##prologue } T{ ##branch } }
+0 test-bb
+
+V{
+    T{ ##peek { dst V int-regs 1 } { loc D 0 } }
+    T{ ##slot-imm
+        { dst V int-regs 5 }
+        { obj V int-regs 1 }
+        { slot 3 }
+        { tag 7 }
+    }
+    T{ ##peek { dst V int-regs 7 } { loc D 1 } }
+    T{ ##slot-imm
+        { dst V int-regs 12 }
+        { obj V int-regs 7 }
+        { slot 1 }
+        { tag 6 }
+    }
+    T{ ##add
+        { dst V int-regs 25 }
+        { src1 V int-regs 5 }
+        { src2 V int-regs 12 }
+    }
+    T{ ##compare-branch
+        { src1 V int-regs 25 }
+        { src2 V int-regs 5 }
+        { cc cc> }
+    }
+}
+1 test-bb
+
+V{
+    T{ ##slot-imm
+        { dst V int-regs 41 }
+        { obj V int-regs 1 }
+        { slot 2 }
+        { tag 7 }
+    }
+    T{ ##slot-imm
+        { dst V int-regs 44 }
+        { obj V int-regs 41 }
+        { slot 1 }
+        { tag 6 }
+    }
+    T{ ##compare-branch
+        { src1 V int-regs 25 }
+        { src2 V int-regs 44 }
+        { cc cc> }
+    }
+}
+2 test-bb
+
+V{
+    T{ ##add-imm
+        { dst V int-regs 54 }
+        { src1 V int-regs 25 }
+        { src2 8 }
+    }
+    T{ ##load-immediate { dst V int-regs 55 } { val 24 } }
+    T{ ##inc-d { n 4 } }
+    T{ ##inc-r { n 1 } }
+    T{ ##replace { src V int-regs 25 } { loc D 2 } }
+    T{ ##replace { src V int-regs 1 } { loc D 3 } }
+    T{ ##replace { src V int-regs 5 } { loc D 4 } }
+    T{ ##replace { src V int-regs 1 } { loc D 1 } }
+    T{ ##replace { src V int-regs 54 } { loc D 0 } }
+    T{ ##replace { src V int-regs 12 } { loc R 0 } }
+    T{ ##fixnum-mul
+        { src1 V int-regs 54 }
+        { src2 V int-regs 55 }
+        { temp1 V int-regs 58 }
+        { temp2 V int-regs 59 }
+    }
+    T{ ##branch }
+}
+3 test-bb
+
+V{
+    T{ ##peek { dst V int-regs 60 } { loc D 1 } }
+    T{ ##slot-imm
+        { dst V int-regs 66 }
+        { obj V int-regs 60 }
+        { slot 2 }
+        { tag 7 }
+    }
+    T{ ##inc-d { n 1 } }
+    T{ ##inc-r { n 1 } }
+    T{ ##replace { src V int-regs 66 } { loc D 0 } }
+    T{ ##replace { src V int-regs 60 } { loc R 0 } }
+    T{ ##call { word resize-string } }
+    T{ ##branch }
+}
+4 test-bb
+
+V{
+    T{ ##peek { dst V int-regs 67 } { loc R 0 } }
+    T{ ##peek { dst V int-regs 68 } { loc D 0 } }
+    T{ ##set-slot-imm
+        { src V int-regs 68 }
+        { obj V int-regs 67 }
+        { slot 2 }
+        { tag 7 }
+    }
+    T{ ##write-barrier
+        { src V int-regs 67 }
+        { card# V int-regs 75 }
+        { table V int-regs 76 }
+    }
+    T{ ##inc-d { n -1 } }
+    T{ ##inc-r { n -1 } }
+    T{ ##peek { dst V int-regs 94 } { loc D 0 } }
+    T{ ##peek { dst V int-regs 96 } { loc D 1 } }
+    T{ ##peek { dst V int-regs 98 } { loc D 2 } }
+    T{ ##peek { dst V int-regs 100 } { loc D 3 } }
+    T{ ##peek { dst V int-regs 102 } { loc D 4 } }
+    T{ ##peek { dst V int-regs 106 } { loc R 0 } }
+    T{ ##copy { dst V int-regs 95 } { src V int-regs 94 } }
+    T{ ##copy { dst V int-regs 97 } { src V int-regs 96 } }
+    T{ ##copy { dst V int-regs 99 } { src V int-regs 98 } }
+    T{ ##copy { dst V int-regs 101 } { src V int-regs 100 } }
+    T{ ##copy { dst V int-regs 103 } { src V int-regs 102 } }
+    T{ ##copy { dst V int-regs 107 } { src V int-regs 106 } }
+    T{ ##branch }
+}
+5 test-bb
+
+V{
+    T{ ##inc-d { n 3 } }
+    T{ ##inc-r { n 1 } }
+    T{ ##copy { dst V int-regs 95 } { src V int-regs 1 } }
+    T{ ##copy { dst V int-regs 97 } { src V int-regs 25 } }
+    T{ ##copy { dst V int-regs 99 } { src V int-regs 1 } }
+    T{ ##copy { dst V int-regs 101 } { src V int-regs 5 } }
+    T{ ##copy { dst V int-regs 103 } { src V int-regs 7 } }
+    T{ ##copy { dst V int-regs 107 } { src V int-regs 12 } }
+    T{ ##branch }
+}
+6 test-bb
+
+V{
+    T{ ##load-immediate
+        { dst V int-regs 78 }
+        { val 4611686018427387896 }
+    }
+    T{ ##and
+        { dst V int-regs 81 }
+        { src1 V int-regs 97 }
+        { src2 V int-regs 78 }
+    }
+    T{ ##set-slot-imm
+        { src V int-regs 81 }
+        { obj V int-regs 95 }
+        { slot 3 }
+        { tag 7 }
+    }
+    T{ ##inc-d { n -2 } }
+    T{ ##copy { dst V int-regs 110 } { src V int-regs 99 } }
+    T{ ##copy { dst V int-regs 111 } { src V int-regs 101 } }
+    T{ ##copy { dst V int-regs 112 } { src V int-regs 103 } }
+    T{ ##copy { dst V int-regs 117 } { src V int-regs 107 } }
+    T{ ##branch }
+}
+7 test-bb
+
+V{
+    T{ ##inc-d { n 1 } }
+    T{ ##inc-r { n 1 } }
+    T{ ##copy { dst V int-regs 110 } { src V int-regs 1 } }
+    T{ ##copy { dst V int-regs 111 } { src V int-regs 5 } }
+    T{ ##copy { dst V int-regs 112 } { src V int-regs 7 } }
+    T{ ##copy { dst V int-regs 117 } { src V int-regs 12 } }
+    T{ ##branch }
+}
+8 test-bb
+
+V{
+    T{ ##inc-d { n 1 } }
+    T{ ##inc-r { n -1 } }
+    T{ ##replace { src V int-regs 117 } { loc D 0 } }
+    T{ ##replace { src V int-regs 110 } { loc D 1 } }
+    T{ ##replace { src V int-regs 111 } { loc D 2 } }
+    T{ ##replace { src V int-regs 112 } { loc D 3 } }
+    T{ ##epilogue }
+    T{ ##return }
+}
+9 test-bb
+
+0 get 1 get 1vector >>successors drop
+1 get 2 get 8 get V{ } 2sequence >>successors drop
+2 get 3 get 6 get V{ } 2sequence >>successors drop
+3 get 4 get 1vector >>successors drop
+4 get 5 get 1vector >>successors drop
+5 get 7 get 1vector >>successors drop
+6 get 7 get 1vector >>successors drop
+7 get 9 get 1vector >>successors drop
+8 get 9 get 1vector >>successors drop
+
+[ ] [ { 1 2 3 4 5 } test-linear-scan-on-cfg ] unit-test

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

@@ -31,7 +31,8 @@ IN: compiler.cfg.linear-scan
     rpo number-instructions
     rpo compute-live-intervals machine-registers allocate-registers
     rpo assign-registers
-    rpo resolve-data-flow ;
+    rpo resolve-data-flow
+    rpo check-numbering ;
 
 : linear-scan ( cfg -- cfg' )
     [

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

@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors math sequences ;
+USING: kernel accessors math sequences grouping namespaces ;
 IN: compiler.cfg.linear-scan.numbering
 
 : number-instructions ( rpo -- )
@@ -9,3 +9,14 @@ IN: compiler.cfg.linear-scan.numbering
             [ (>>insn#) ] [ drop 2 + ] 2bi
         ] each
     ] each drop ;
+
+SYMBOL: check-numbering?
+
+ERROR: bad-numbering bb ;
+
+: check-block-numbering ( bb -- )
+    dup instructions>> [ insn#>> ] map sift [ <= ] monotonic?
+    [ drop ] [ bad-numbering ] if ;
+
+: check-numbering ( rpo -- )
+    check-numbering? get [ [ check-block-numbering ] each ] [ drop ] if ;