From 2b49600f4284cd6226aaba1f41102947c7272c63 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 5 Jun 2009 17:32:12 -0500
Subject: [PATCH 1/6] compiler.cfg.checker: run if a variable is set

---
 basis/compiler/cfg/checker/checker.factor     |  3 +++
 basis/compiler/cfg/optimizer/optimizer.factor | 13 ++++++++++++-
 2 files changed, 15 insertions(+), 1 deletion(-)

diff --git a/basis/compiler/cfg/checker/checker.factor b/basis/compiler/cfg/checker/checker.factor
index 4aa2088143..4f215f1dc8 100644
--- a/basis/compiler/cfg/checker/checker.factor
+++ b/basis/compiler/cfg/checker/checker.factor
@@ -16,6 +16,9 @@ ERROR: last-insn-not-a-jump insn ;
         [ ##return? ]
         [ ##callback-return? ]
         [ ##jump? ]
+        [ ##fixnum-add-tail? ]
+        [ ##fixnum-sub-tail? ]
+        [ ##fixnum-mul-tail? ]
         [ ##call? ]
     } 1|| [ drop ] [ last-insn-not-a-jump ] if ;
 
diff --git a/basis/compiler/cfg/optimizer/optimizer.factor b/basis/compiler/cfg/optimizer/optimizer.factor
index 8ceafd1693..eda55bef86 100644
--- a/basis/compiler/cfg/optimizer/optimizer.factor
+++ b/basis/compiler/cfg/optimizer/optimizer.factor
@@ -11,9 +11,19 @@ compiler.cfg.dce
 compiler.cfg.write-barrier
 compiler.cfg.liveness
 compiler.cfg.rpo
-compiler.cfg.phi-elimination ;
+compiler.cfg.phi-elimination
+compiler.cfg.checker ;
 IN: compiler.cfg.optimizer
 
+SYMBOL: check-optimizer?
+
+t check-optimizer? set-global
+
+: ?check ( cfg -- cfg' )
+    check-optimizer? get [
+        dup check-cfg
+    ] when ;
+
 : optimize-cfg ( cfg -- cfg' )
     [
         compute-predecessors
@@ -27,4 +37,5 @@ IN: compiler.cfg.optimizer
         eliminate-dead-code
         eliminate-write-barriers
         eliminate-phis
+        ?check
     ] with-scope ;

From 26152bd83cd0d75ac7e4f6d76d9f1e41dbe8e69e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 5 Jun 2009 17:32:37 -0500
Subject: [PATCH 2/6] compiler: more informative trace-compilation

---
 basis/compiler/compiler.factor | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor
index 7527f6b339..6d0f6f3ace 100644
--- a/basis/compiler/compiler.factor
+++ b/basis/compiler/compiler.factor
@@ -193,7 +193,8 @@ M: optimizing-compiler recompile ( words -- alist )
         ] each
         compile-queue get compile-loop
         compiled get >alist
-    ] with-scope ;
+    ] with-scope
+    "trace-compilation" get [ "--- compile done" print flush ] when ;
 
 : with-optimizer ( quot -- )
     [ optimizing-compiler compiler-impl ] dip with-variable ; inline

From 412438721fe849f2ebbeda77cff79387e942647d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 5 Jun 2009 17:33:00 -0500
Subject: [PATCH 3/6] vocabs.parser: if bootstrap fails to load a vocab in
 interactive use list, don't fep

---
 core/vocabs/parser/parser.factor | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor
index ca783c13e6..5f393ed65d 100644
--- a/core/vocabs/parser/parser.factor
+++ b/core/vocabs/parser/parser.factor
@@ -127,7 +127,10 @@ TUPLE: no-current-vocab ;
     ] [ drop ] if ;
 
 : only-use-vocabs ( vocabs -- )
-    clear-manifest [ vocab ] filter [ use-vocab ] each ;
+    clear-manifest
+    [ vocab ] filter
+    [ vocab source-loaded?>> +done+ eq? ] filter
+    [ use-vocab ] each ;
 
 TUPLE: qualified vocab prefix words ;
 

From ad5ef2a3cc2e1e39e95d3caa064bff4198fbdc82 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 5 Jun 2009 18:06:47 -0500
Subject: [PATCH 4/6] Linear scan: correctly compute live spill slots

---
 .../linear-scan/allocation/allocation.factor  |  2 +-
 .../linear-scan/assignment/assignment.factor  | 40 ++++++++++++++-----
 .../cfg/linear-scan/linear-scan-tests.factor  | 25 ++++++++++++
 .../cfg/linear-scan/linear-scan.factor        | 12 +++---
 4 files changed, 63 insertions(+), 16 deletions(-)

diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
index fa10ecfca4..f8258039e1 100644
--- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
@@ -264,7 +264,7 @@ SYMBOL: spill-counts
     ] if ;
 
 ! Main loop
-: reg-classes ( -- seq ) { int-regs double-float-regs } ; inline
+CONSTANT: reg-classes { int-regs double-float-regs }
 
 : reg-class-assoc ( quot -- assoc )
     [ reg-classes ] dip { } map>assoc ; inline
diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
index 4a9b0b231d..6fcd6e7570 100644
--- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor
+++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
@@ -1,11 +1,12 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel math assocs namespaces sequences heaps
-fry make combinators
+fry make combinators sets
 cpu.architecture
 compiler.cfg.def-use
 compiler.cfg.registers
 compiler.cfg.instructions
+compiler.cfg.linear-scan.allocation
 compiler.cfg.linear-scan.live-intervals ;
 IN: compiler.cfg.linear-scan.assignment
 
@@ -30,25 +31,44 @@ 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 ;
+
+: record-spill ( live-interval -- )
+    [ dup spill-to>> ] [ vreg>> spill-slots-for ] bi
+    2dup key? [ "BUG: Already spilled" throw ] [ set-at ] if ;
+
 : insert-spill ( live-interval -- )
-    [ reg>> ] [ vreg>> reg-class>> ] [ spill-to>> ] tri
-    dup [ _spill ] [ 3drop ] if ;
+    [ reg>> ] [ vreg>> reg-class>> ] [ spill-to>> ] tri _spill ;
+
+: handle-spill ( live-interval -- )
+    dup spill-to>> [ [ record-spill ] [ insert-spill ] bi ] [ drop ] if ;
 
 : expire-old-intervals ( n -- )
     active-intervals get
     [ swap '[ end>> _ = ] partition ] change-seq drop
-    [ insert-spill ] each ;
+    [ handle-spill ] each ;
+
+: record-reload ( live-interval -- )
+    [ reload-from>> ] [ vreg>> spill-slots-for ] bi
+    2dup key? [ delete-at ] [ "BUG: Already reloaded" throw ] if ;
 
 : insert-reload ( live-interval -- )
-    [ reg>> ] [ vreg>> reg-class>> ] [ reload-from>> ] tri
-    dup [ _reload ] [ 3drop ] if ;
+    [ reg>> ] [ vreg>> reg-class>> ] [ reload-from>> ] tri _reload ;
+
+: handle-reload ( live-interval -- )
+    dup reload-from>> [ [ record-reload ] [ insert-reload ] bi ] [ drop ] if ;
 
 : activate-new-intervals ( n -- )
     #! 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>> = [
-            heap-pop drop [ add-active ] [ insert-reload ] bi
+            heap-pop drop
+            [ add-active ] [ handle-reload ] bi
             activate-new-intervals
         ] [ 2drop ] if
     ] if ;
@@ -71,8 +91,7 @@ M: insn assign-before drop ;
     active-intervals get seq>> [ [ vreg>> ] [ reg>> ] bi ] { } map>assoc ;
 
 : compute-live-spill-slots ( -- spill-slots )
-    unhandled-intervals get
-    heap-values [ reload-from>> ] filter
+    spill-slots get values [ values ] map concat
     [ [ vreg>> ] [ reload-from>> ] bi ] { } map>assoc ;
 
 M: ##gc assign-after
@@ -88,6 +107,7 @@ M: insn assign-after drop ;
 : init-assignment ( live-intervals -- )
     <active-intervals> active-intervals set
     <min-heap> unhandled-intervals set
+    [ H{ } clone ] reg-class-assoc spill-slots set 
     init-unhandled ;
 
 : assign-registers-in-block ( bb -- )
diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
index cf4daa3ab0..e4510e884e 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
@@ -1290,3 +1290,28 @@ USING: math.private compiler.cfg.debugger ;
     { { int-regs { 0 1 2 3 } } }
     allocate-registers drop
 ] unit-test
+
+! Spill slot liveness was computed incorrectly, leading to a FEP
+! early in bootstrap on x86-32
+[ t ] [
+    T{ basic-block
+       { instructions
+         V{
+             T{ ##gc f V int-regs 6 V int-regs 7 }
+             T{ ##peek f V int-regs 0 D 0 }
+             T{ ##peek f V int-regs 1 D 1 }
+             T{ ##peek f V int-regs 2 D 2 }
+             T{ ##peek f V int-regs 3 D 3 }
+             T{ ##peek f V int-regs 4 D 4 }
+             T{ ##peek f V int-regs 5 D 5 }
+             T{ ##replace f V int-regs 0 D 1 }
+             T{ ##replace f V int-regs 1 D 2 }
+             T{ ##replace f V int-regs 2 D 3 }
+             T{ ##replace f V int-regs 3 D 4 }
+             T{ ##replace f V int-regs 4 D 5 }
+             T{ ##replace f V int-regs 5 D 0 }
+         }
+       }
+    } dup 1array { { int-regs V{ 0 1 2 3 } } } (linear-scan)
+    instructions>> first live-spill-slots>> empty?
+] unit-test
\ No newline at end of file
diff --git a/basis/compiler/cfg/linear-scan/linear-scan.factor b/basis/compiler/cfg/linear-scan/linear-scan.factor
index 1e6b9d02c8..ffa356bfc2 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan.factor
@@ -25,13 +25,15 @@ IN: compiler.cfg.linear-scan
 ! by Omri Traub, Glenn Holloway, Michael D. Smith
 ! http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.34.8435
 
-: (linear-scan) ( rpo -- )
-    dup number-instructions
-    dup compute-live-intervals
-    machine-registers allocate-registers assign-registers ;
+: (linear-scan) ( rpo machine-registers -- )
+    [
+        dup number-instructions
+        dup compute-live-intervals
+    ] dip
+    allocate-registers assign-registers ;
 
 : linear-scan ( cfg -- cfg' )
     [
-        dup reverse-post-order (linear-scan)
+        dup reverse-post-order machine-registers (linear-scan)
         spill-counts get >>spill-counts
     ] with-scope ;

From d830838ffa37c09b550883e36d7400be73b19323 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 5 Jun 2009 18:07:22 -0500
Subject: [PATCH 5/6] compiler.cfg.optimizer: disable CFG checker by default

---
 basis/compiler/cfg/optimizer/optimizer.factor | 2 --
 1 file changed, 2 deletions(-)

diff --git a/basis/compiler/cfg/optimizer/optimizer.factor b/basis/compiler/cfg/optimizer/optimizer.factor
index eda55bef86..9d481ef1d2 100644
--- a/basis/compiler/cfg/optimizer/optimizer.factor
+++ b/basis/compiler/cfg/optimizer/optimizer.factor
@@ -17,8 +17,6 @@ IN: compiler.cfg.optimizer
 
 SYMBOL: check-optimizer?
 
-t check-optimizer? set-global
-
 : ?check ( cfg -- cfg' )
     check-optimizer? get [
         dup check-cfg

From e1d13d8ee7436448d1f3ec0ff5e2369fa119140b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 6 Jun 2009 01:04:12 -0500
Subject: [PATCH 6/6] Linear scan: implement live range intersection

---
 .../linear-scan/allocation/allocation.factor  | 29 ++++++++-
 .../cfg/linear-scan/linear-scan-tests.factor  | 60 +++++++++++++++++++
 2 files changed, 86 insertions(+), 3 deletions(-)

diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
index f8258039e1..7b56bd6150 100644
--- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
@@ -226,18 +226,41 @@ SYMBOL: spill-counts
 : assign-free-register ( new registers -- )
     pop >>reg add-active ;
 
-: next-intersection ( new inactive -- n )
-    2drop 0 ;
+: relevant-ranges ( new inactive -- new' inactive' )
+    ! Slice off all ranges of 'inactive' that precede the start of 'new'
+    [ [ ranges>> ] bi@ ] [ nip start>> ] 2bi '[ to>> _ >= ] filter ;
+
+: intersect-live-range ( range1 range2 -- n/f )
+    2dup [ from>> ] bi@ > [ swap ] when
+    2dup [ to>> ] [ from>> ] bi* >= [ nip from>> ] [ 2drop f ] if ;
+
+: intersect-live-ranges ( ranges1 ranges2 -- n )
+    {
+        { [ over empty? ] [ 2drop 1/0. ] }
+        { [ dup empty? ] [ 2drop 1/0. ] }
+        [
+            2dup [ first ] bi@ intersect-live-range dup [ 2nip ] [
+                drop
+                2dup [ first from>> ] bi@ <
+                [ [ rest-slice ] dip ] [ rest-slice ] if
+                intersect-live-ranges
+            ] if
+        ]
+    } cond ;
+
+: intersect-inactive ( new inactive -- n )
+    relevant-ranges intersect-live-ranges ;
 
 : intersecting-inactive ( new -- live-intervals )
     dup vreg>> inactive-intervals-for
-    [ tuck next-intersection ] with { } map>assoc ;
+    [ tuck intersect-inactive ] with { } map>assoc ;
 
 : fits-in-hole ( new pair -- )
     first reuse-register ;
 
 : split-before-use ( new pair -- before after )
     ! Find optimal split position
+    ! Insert move instruction
     second split-interval ;
 
 : assign-inactive-register ( new live-intervals -- )
diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
index e4510e884e..ccfc4a1ff7 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
@@ -1314,4 +1314,64 @@ USING: math.private compiler.cfg.debugger ;
        }
     } dup 1array { { int-regs V{ 0 1 2 3 } } } (linear-scan)
     instructions>> first live-spill-slots>> empty?
+] unit-test
+
+[ f ] [
+    T{ live-range f 0 10 }
+    T{ live-range f 20 30 }
+    intersect-live-range
+] unit-test
+
+[ 10 ] [
+    T{ live-range f 0 10 }
+    T{ live-range f 10 30 }
+    intersect-live-range
+] unit-test
+
+[ 5 ] [
+    T{ live-range f 0 10 }
+    T{ live-range f 5 30 }
+    intersect-live-range
+] unit-test
+
+[ 5 ] [
+    T{ live-range f 5 30 }
+    T{ live-range f 0 10 }
+    intersect-live-range
+] unit-test
+
+[ 5 ] [
+    T{ live-range f 5 10 }
+    T{ live-range f 0 15 }
+    intersect-live-range
+] unit-test
+
+[ 50 ] [
+    {
+        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 35 }
+        T{ live-range f 50 55 }
+    }
+    intersect-live-ranges
+] unit-test
+
+[ 5 ] [
+    T{ live-interval
+       { start 0 }
+       { end 10 }
+       { uses { 0 10 } }
+       { ranges V{ T{ live-range f 0 10 } } }
+    }
+    T{ live-interval
+       { start 5 }
+       { end 10 }
+       { uses { 5 10 } }
+       { ranges V{ T{ live-range f 5 10 } } }
+    }
+    intersect-inactive
 ] unit-test
\ No newline at end of file