diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor
index 8b5202dd63..e5f91d19df 100755
--- a/basis/compiler/cfg/builder/builder.factor
+++ b/basis/compiler/cfg/builder/builder.factor
@@ -329,8 +329,7 @@ M: #terminate emit-node
     stack-frame new
         swap
         [ return>> return-size >>return ]
-        [ alien-parameters parameter-sizes drop >>params ] bi
-        dup [ params>> ] [ return>> ] bi + >>size ;
+        [ alien-parameters parameter-sizes drop >>params ] bi ;
 
 : alien-stack-frame ( params -- )
     <alien-stack-frame> ##stack-frame ;
diff --git a/basis/compiler/cfg/cfg.factor b/basis/compiler/cfg/cfg.factor
index e32ad47890..8ce3260153 100644
--- a/basis/compiler/cfg/cfg.factor
+++ b/basis/compiler/cfg/cfg.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors namespaces assocs sequences sets fry ;
+USING: kernel arrays accessors namespaces assocs sequences sets fry ;
 IN: compiler.cfg
 
 TUPLE: cfg entry word label ;
@@ -19,7 +19,7 @@ successors ;
         V{ } clone >>instructions
         V{ } clone >>successors ;
 
-TUPLE: mr instructions word label ;
+TUPLE: mr { instructions array } word label spill-counts ;
 
 : <mr> ( instructions word label -- mr )
     mr new
diff --git a/basis/compiler/cfg/debugger/debugger.factor b/basis/compiler/cfg/debugger/debugger.factor
index f7591ba105..a04670ddab 100644
--- a/basis/compiler/cfg/debugger/debugger.factor
+++ b/basis/compiler/cfg/debugger/debugger.factor
@@ -4,7 +4,7 @@ USING: kernel words sequences quotations namespaces io
 accessors prettyprint prettyprint.config
 compiler.tree.builder compiler.tree.optimizer
 compiler.cfg.builder compiler.cfg.linearization
-compiler.cfg.stack-frame ;
+compiler.cfg.stack-frame compiler.cfg.linear-scan ;
 IN: compiler.cfg.debugger
 
 GENERIC: test-cfg ( quot -- cfgs )
@@ -16,7 +16,7 @@ M: word test-cfg
     [ build-tree-from-word nip optimize-tree ] keep build-cfg ;
 
 : test-mr ( quot -- mrs )
-    test-cfg [ build-mr build-stack-frame ] map ;
+    test-cfg [ build-mr ] map ;
 
 : mr. ( mrs -- )
     [
diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index 1335a082bf..689650f0a4 100644
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -19,10 +19,10 @@ INSN: ##inc-r { n integer } ;
 
 ! Subroutine calls
 TUPLE: stack-frame
-{ size integer }
 { params integer }
 { return integer }
-{ total-size integer } ;
+{ total-size integer }
+spill-counts ;
 
 INSN: ##stack-frame stack-frame ;
  : ##simple-stack-frame ( -- ) T{ stack-frame } ##stack-frame ;
@@ -125,8 +125,8 @@ M: _cond-branch uses-vregs src>> 1array ;
 M: _if-intrinsic defs-vregs intrinsic-defs-vregs ;
 M: _if-intrinsic uses-vregs intrinsic-uses-vregs ;
 
-INSN: _spill-integer { src vreg } n ;
-INSN: _reload-integer { dst vreg } n ;
-
-INSN: _spill-float { src vreg } n ;
-INSN: _reload-float { dst vreg } n ;
+! These instructions operate on machine registers and not
+! virtual registers
+INSN: _spill src class n ;
+INSN: _reload dst class n ;
+INSN: _spill-counts counts ;
diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
index 5433908768..1b49609387 100644
--- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces sequences math math.order kernel assocs
-accessors vectors fry heaps cpu.architecture
+accessors vectors fry heaps cpu.architecture combinators
 compiler.cfg.registers
 compiler.cfg.linear-scan.live-intervals ;
 IN: compiler.cfg.linear-scan.allocation
@@ -24,25 +24,11 @@ SYMBOL: active-intervals
 : delete-active ( live-interval -- )
     active-intervals get delete ;
 
-: expired-interval? ( n interval -- ? )
-    [ end>> ] [ start>> ] bi or > ;
-
 : expire-old-intervals ( n -- )
     active-intervals get
-    [ expired-interval? ] with partition
+    [ end>> > ] with partition
     [ [ deallocate-register ] each ] [ active-intervals set ] bi* ;
 
-: expire-old-uses ( n -- )
-    active-intervals get
-    swap '[
-        uses>> [
-            dup peek _ < [ pop* ] [ drop ] if
-        ] unless-empty
-    ] each ;
-
-: update-state ( live-interval -- )
-    start>> [ expire-old-intervals ] [ expire-old-uses ] bi ;
-
 ! Minheap of live intervals which still need a register allocation
 SYMBOL: unhandled-intervals
 
@@ -64,8 +50,25 @@ SYMBOL: progress
     [ [ start>> ] keep ] { } map>assoc
     unhandled-intervals get heap-push-all ;
 
-: assign-free-register ( live-interval registers -- )
-    pop >>reg add-active ;
+! Splitting
+: find-use ( live-interval n quot -- i elt )
+    [ uses>> ] 2dip curry find ; inline
+
+: split-before ( live-interval i -- before )
+    [ clone dup uses>> ] dip
+    [ head >>uses ] [ 1- swap nth >>end ] 2bi ;
+
+: split-after ( live-interval i -- after )
+    [ clone dup uses>> ] dip
+    [ tail >>uses ] [ swap nth >>start ] 2bi
+    f >>reg ;
+
+: split-interval ( live-interval n -- before after )
+    [ drop ] [ [ > ] find-use drop ] 2bi
+    [ split-before ] [ split-after ] 2bi ;
+
+: record-split ( live-interval before after -- )
+    [ >>split-before ] [ >>split-after ] bi* drop ;
 
 ! Spilling
 SYMBOL: spill-counts
@@ -73,37 +76,20 @@ SYMBOL: spill-counts
 : next-spill-location ( reg-class -- n )
     spill-counts get [ dup 1+ ] change-at ;
 
-: interval-to-spill ( -- live-interval )
+: interval-to-spill ( active-intervals current -- live-interval )
     #! We spill the interval with the most distant use location.
-    active-intervals get
-    [ uses>> empty? not ] filter
-    unclip-slice [
-        [ [ uses>> peek ] bi@ > ] most
-    ] reduce ;
-
-: check-split ( live-interval -- )
-    [ start>> ] [ end>> ] bi = [ "Cannot split any further" throw ] when ;
-
-: split-interval ( live-interval -- before after )
-    #! Split the live interval at the location of its first use.
-    #! 'Before' now starts and ends on the same instruction.
-    [ check-split ]
-    [ clone [ uses>> delete-all ] [ dup start>> >>end ] bi ]
-    [ clone f >>reg dup uses>> peek >>start ]
-    tri ;
-
-: record-split ( live-interval before after -- )
-    [ >>split-before ] [ >>split-after ] bi* drop ;
+    start>> '[ dup _ [ >= ] find-use nip ] { } map>assoc
+    unclip-slice [ [ [ second ] bi@ > ] most ] reduce first ;
 
 : assign-spill ( before after -- before after )
     #! If it has been spilled already, reuse spill location.
-    USE: cpu.architecture ! XXX
     over reload-from>>
-    [ int-regs next-spill-location ] unless*
+    [ over vreg>> reg-class>> next-spill-location ] unless*
     tuck [ >>spill-to ] [ >>reload-from ] 2bi* ;
 
-: split-and-spill ( live-interval -- before after )
-    dup split-interval [ record-split ] [ assign-spill ] 2bi ;
+: split-and-spill ( new existing -- before after )
+    dup rot start>> split-interval
+    [ record-split ] [ assign-spill ] 2bi ;
 
 : reuse-register ( new existing -- )
     reg>> >>reg add-active ;
@@ -114,30 +100,30 @@ SYMBOL: spill-counts
     #! interval, then process the new interval and the tail end
     #! of the existing interval again.
     [ reuse-register ]
-    [ delete-active ]
-    [ split-and-spill [ drop ] [ add-unhandled ] bi* ] tri ;
+    [ nip delete-active ]
+    [ split-and-spill [ drop ] [ add-unhandled ] bi* ] 2tri ;
 
 : 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.
-    [ split-and-spill add-unhandled ] dip spill-existing ;
+    [ dup split-and-spill add-unhandled ] dip spill-existing ;
 
 : spill-existing? ( new existing -- ? )
-    over uses>> empty? [ 2drop t ] [ [ uses>> peek ] bi@ < ] if ;
+    #! Test if 'new' will be used before 'existing'.
+    over start>> '[ _ [ > ] find-use nip -1 or ] bi@ < ;
 
-: assign-blocked-register ( live-interval -- )
-    interval-to-spill
-    2dup spill-existing?
-    [ spill-existing ] [ spill-new ] if ;
+: assign-blocked-register ( new -- )
+    [ active-intervals get ] keep interval-to-spill
+    2dup spill-existing? [ spill-existing ] [ spill-new ] if ;
 
-: assign-register ( live-interval -- )
-    dup vreg>> free-registers-for [
-        assign-blocked-register
-    ] [
-        assign-free-register
-    ] if-empty ;
+: assign-free-register ( new registers -- )
+    pop >>reg add-active ;
+
+: assign-register ( new -- )
+    dup vreg>> free-registers-for
+    [ assign-blocked-register ] [ assign-free-register ] if-empty ;
 
 ! Main loop
 : init-allocator ( registers -- )
@@ -148,7 +134,10 @@ SYMBOL: spill-counts
     -1 progress set ;
 
 : handle-interval ( live-interval -- )
-    [ start>> progress set ] [ update-state ] [ assign-register ] tri ;
+    [ start>> progress set ]
+    [ start>> expire-old-intervals ]
+    [ assign-register ]
+    tri ;
 
 : (allocate-registers) ( -- )
     unhandled-intervals get [ handle-interval ] slurp-heap ;
diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
index 541ab606a2..876bb6ba6c 100644
--- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor
+++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
@@ -35,13 +35,8 @@ SYMBOL: unhandled-intervals
     [ add-unhandled ] each ;
 
 : insert-spill ( live-interval -- )
-    [ reg>> ] [ spill-to>> ] [ vreg>> reg-class>> ] tri
-    over [
-        {
-            { int-regs [ _spill-integer ] }
-            { double-float-regs [ _spill-float ] }
-        } case
-    ] [ 3drop ] if ;
+    [ reg>> ] [ vreg>> reg-class>> ] [ spill-to>> ] tri
+    dup [ _spill ] [ 3drop ] if ;
 
 : expire-old-intervals ( n -- )
     active-intervals get
@@ -50,13 +45,8 @@ SYMBOL: unhandled-intervals
     [ insert-spill ] each ;
 
 : insert-reload ( live-interval -- )
-    [ reg>> ] [ reload-from>> ] [ vreg>> reg-class>> ] tri
-    over [
-        {
-            { int-regs [ _reload-integer ] }
-            { double-float-regs [ _reload-float ] }
-        } case
-    ] [ 3drop ] if ;
+    [ reg>> ] [ vreg>> reg-class>> ] [ reload-from>> ] tri
+    dup [ _reload ] [ 3drop ] if ;
 
 : activate-new-intervals ( n -- )
     #! Any live intervals which start on the current instruction
diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
index 1784886154..88d7bcdbcf 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
@@ -7,49 +7,209 @@ compiler.cfg.instructions
 compiler.cfg.registers
 compiler.cfg.linear-scan
 compiler.cfg.linear-scan.live-intervals
+compiler.cfg.linear-scan.allocation
 compiler.cfg.linear-scan.debugger ;
 
+[ 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 nip
+] 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 nip
+] 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 nip
+] unit-test
+
+[
+    T{ live-interval
+        { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+        { start 0 }
+        { end 1 }
+        { uses V{ 0 1 } }
+    }
+    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 0 }
+        { end 5 }
+        { uses V{ 0 1 5 } }
+    } 2 split-interval
+] unit-test
+
+[
+    T{ live-interval
+        { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+        { start 0 }
+        { end 0 }
+        { uses V{ 0 } }
+    }
+    T{ live-interval
+        { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+        { start 1 }
+        { end 5 }
+        { uses V{ 1 5 } }
+    }
+] [
+    T{ live-interval
+        { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+        { start 0 }
+        { end 5 }
+        { uses V{ 0 1 5 } }
+    } 0 split-interval
+] unit-test
+
+[
+    T{ live-interval
+        { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+        { start 3 }
+        { end 10 }
+        { uses V{ 3 10 } }
+    }
+] [
+    {
+        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 } }
+        }
+    }
+    T{ live-interval
+        { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+        { 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?
+] unit-test
+
 [ ] [
     {
-        T{ live-interval { vreg T{ vreg { n 1 } } } { start 0 } { end 100 } { uses V{ 100 } } }
+        T{ live-interval { vreg T{ vreg { n 1 } { reg-class int-regs } } } { start 0 } { end 100 } { uses V{ 0 100 } } }
     }
-    H{ { f { "A" } } }
+    H{ { int-regs { "A" } } }
     check-linear-scan
 ] unit-test
 
 [ ] [
     {
-        T{ live-interval { vreg T{ vreg { n 1 } } } { start 0 } { end 10 } { uses V{ 10 } } }
-        T{ live-interval { vreg T{ vreg { n 2 } } } { start 11 } { end 20 } { uses V{ 20 } } }
+        T{ live-interval { vreg T{ vreg { n 1 } { reg-class int-regs } } } { start 0 } { end 10 } { uses V{ 0 10 } } }
+        T{ live-interval { vreg T{ vreg { n 2 } { reg-class int-regs } } } { start 11 } { end 20 } { uses V{ 11 20 } } }
     }
-    H{ { f { "A" } } }
+    H{ { int-regs { "A" } } }
     check-linear-scan
 ] unit-test
 
 [ ] [
     {
-        T{ live-interval { vreg T{ vreg { n 1 } } } { start 0 } { end 100 } { uses V{ 100 } } }
-        T{ live-interval { vreg T{ vreg { n 2 } } } { start 30 } { end 60 } { uses V{ 60 } } }
+        T{ live-interval { vreg T{ vreg { n 1 } { reg-class int-regs } } } { start 0 } { end 100 } { uses V{ 0 100 } } }
+        T{ live-interval { vreg T{ vreg { n 2 } { reg-class int-regs } } } { start 30 } { end 60 } { uses V{ 30 60 } } }
     }
-    H{ { f { "A" } } }
+    H{ { int-regs { "A" } } }
     check-linear-scan
 ] unit-test
 
 [ ] [
     {
-        T{ live-interval { vreg T{ vreg { n 1 } } } { start 0 } { end 100 } { uses V{ 100 } } }
-        T{ live-interval { vreg T{ vreg { n 2 } } } { start 30 } { end 200 } { uses V{ 200 } } }
+        T{ live-interval { vreg T{ vreg { n 1 } { reg-class int-regs } } } { start 0 } { end 100 } { uses V{ 0 100 } } }
+        T{ live-interval { vreg T{ vreg { n 2 } { reg-class int-regs } } } { start 30 } { end 200 } { uses V{ 30 200 } } }
     }
-    H{ { f { "A" } } }
+    H{ { int-regs { "A" } } }
     check-linear-scan
 ] unit-test
 
 [
     {
-        T{ live-interval { vreg T{ vreg { n 1 } } } { start 0 } { end 100 } { uses V{ 100 } } }
-        T{ live-interval { vreg T{ vreg { n 2 } } } { start 30 } { end 100 } { uses V{ 100 } } }
+        T{ live-interval { vreg T{ vreg { n 1 } { reg-class int-regs } } } { start 0 } { end 100 } { uses V{ 0 100 } } }
+        T{ live-interval { vreg T{ vreg { n 2 } { reg-class int-regs } } } { start 30 } { end 100 } { uses V{ 30 100 } } }
     }
-    H{ { f { "A" } } }
+    H{ { int-regs { "A" } } }
     check-linear-scan
 ] must-fail
 
@@ -81,15 +241,15 @@ SYMBOL: max-uses
         max-insns get [ dup ] H{ } map>assoc available set
         [
             live-interval new
-                swap f swap vreg boa >>vreg
+                swap int-regs swap vreg boa >>vreg
                 max-uses get random 2 max [ not-taken ] replicate natural-sort
-                unclip [ >vector >>uses ] [ >>start ] bi*
-                dup uses>> first >>end
+                [ >>uses ] [ first >>start ] bi
+                dup uses>> peek >>end
         ] map
     ] with-scope ;
 
 : random-test ( num-intervals max-uses max-registers max-insns -- )
-    over >r random-live-intervals r> f associate check-linear-scan ;
+    over >r random-live-intervals r> int-regs associate check-linear-scan ;
 
 [ ] [ 30 2 1 60 random-test ] unit-test
 [ ] [ 60 2 2 60 random-test ] unit-test
@@ -118,3 +278,29 @@ USING: math.private compiler.cfg.debugger ;
     } clone
     1array (linear-scan) first regs>> values all-equal?
 ] unit-test
+
+[ 0 1 ] [
+    {
+        T{ live-interval
+            { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+            { start 0 }
+            { end 5 }
+            { uses V{ 0 1 5 } }
+        }
+        T{ live-interval
+            { vreg T{ vreg { reg-class int-regs } { n 2 } } }
+            { start 3 }
+            { end 4 }
+            { uses V{ 3 4 } }
+        }
+        T{ live-interval
+            { vreg T{ vreg { reg-class int-regs } { n 3 } } }
+            { start 2 }
+            { end 6 }
+            { uses V{ 2 4 6 } }
+        }
+    } [ clone ] map
+    H{ { int-regs { "A" "B" } } }
+    allocate-registers
+    first split-before>> [ start>> ] [ end>> ] bi
+] unit-test
diff --git a/basis/compiler/cfg/linear-scan/linear-scan.factor b/basis/compiler/cfg/linear-scan/linear-scan.factor
index 4628728299..855f2a6648 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan.factor
@@ -1,8 +1,9 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors namespaces
+USING: kernel accessors namespaces make
 cpu.architecture
 compiler.cfg
+compiler.cfg.instructions
 compiler.cfg.linear-scan.live-intervals
 compiler.cfg.linear-scan.allocation
 compiler.cfg.linear-scan.assignment ;
@@ -28,6 +29,10 @@ IN: compiler.cfg.linear-scan
 
 : linear-scan ( mr -- mr' )
     [
-        [ (linear-scan) ] change-instructions
-        ! spill-counts get >>spill-counts
+        [
+            [
+                (linear-scan) %
+                spill-counts get _spill-counts
+            ] { } make
+        ] change-instructions
     ] with-scope ;
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 a0699b80bd..3ab7e03783 100644
--- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
+++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
@@ -4,16 +4,20 @@ USING: namespaces kernel assocs accessors sequences math fry
 compiler.cfg.instructions compiler.cfg.registers ;
 IN: compiler.cfg.linear-scan.live-intervals
 
-TUPLE: live-interval < identity-tuple
+TUPLE: live-interval
 vreg
 reg spill-to reload-from split-before split-after
 start end uses ;
 
+: add-use ( n live-interval -- )
+    [ (>>end) ] [ uses>> push ] 2bi ;
+
 : <live-interval> ( start vreg -- live-interval )
     live-interval new
+        V{ } clone >>uses
         swap >>vreg
-        swap >>start
-        V{ } clone >>uses ;
+        over >>start
+        [ add-use ] keep ;
 
 M: live-interval hashcode*
     nip [ start>> ] [ end>> 1000 * ] bi + ;
@@ -24,25 +28,18 @@ M: live-interval clone
 ! Mapping from vreg to live-interval
 SYMBOL: live-intervals
 
-: add-use ( n vreg live-intervals -- )
-    at [ (>>end) ] [ uses>> push ] 2bi ;
-
 : new-live-interval ( n vreg live-intervals -- )
     2dup key? [ "Multiple defs" throw ] when
     [ [ <live-interval> ] keep ] dip set-at ;
 
 : compute-live-intervals* ( insn n -- )
     live-intervals get
-    [ [ uses-vregs ] 2dip '[ _ swap _ add-use ] each ]
+    [ [ uses-vregs ] 2dip '[ _ swap _ at add-use ] each ]
     [ [ defs-vregs ] 2dip '[ _ swap _ new-live-interval ] each ]
     3bi ;
 
-: finalize-live-intervals ( assoc -- seq' )
-    #! Reverse uses lists so that we can pop values off.
-    values dup [ uses>> reverse-here ] each ;
-
 : compute-live-intervals ( instructions -- live-intervals )
     H{ } clone [
         live-intervals set
         [ compute-live-intervals* ] each-index
-    ] keep finalize-live-intervals ;
+    ] keep values ;
diff --git a/basis/compiler/cfg/stack-frame/stack-frame.factor b/basis/compiler/cfg/stack-frame/stack-frame.factor
index 7a419779a3..4443ea64f7 100644
--- a/basis/compiler/cfg/stack-frame/stack-frame.factor
+++ b/basis/compiler/cfg/stack-frame/stack-frame.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces accessors math.order assocs kernel sequences
-combinators make compiler.cfg.instructions
+combinators make cpu.architecture compiler.cfg.instructions
 compiler.cfg.instructions.syntax compiler.cfg.registers ;
 IN: compiler.cfg.stack-frame
 
@@ -9,35 +9,31 @@ SYMBOL: frame-required?
 
 SYMBOL: spill-counts
 
-: init-stack-frame-builder ( -- )
-    frame-required? off
-    T{ stack-frame } clone stack-frame set ;
-
 GENERIC: compute-stack-frame* ( insn -- )
 
 : max-stack-frame ( frame1 frame2 -- frame3 )
-    {
-        [ [ size>> ] bi@ max ]
-        [ [ params>> ] bi@ max ]
-        [ [ return>> ] bi@ max ]
-        [ [ total-size>> ] bi@ max ]
-    } 2cleave
-    stack-frame boa ;
+    [ stack-frame new ] 2dip
+        [ [ params>> ] bi@ max >>params ]
+        [ [ return>> ] bi@ max >>return ]
+        2bi ;
 
 M: ##stack-frame compute-stack-frame*
     frame-required? on
     stack-frame>> stack-frame [ max-stack-frame ] change ;
 
-M: _spill-integer compute-stack-frame*
+M: _spill compute-stack-frame*
     drop frame-required? on ;
 
-M: _spill-float compute-stack-frame*
-    drop frame-required? on ;
+M: _spill-counts compute-stack-frame*
+    counts>> stack-frame get (>>spill-counts) ;
 
 M: insn compute-stack-frame* drop ;
 
 : compute-stack-frame ( insns -- )
-    [ compute-stack-frame* ] each ;
+    frame-required? off
+    T{ stack-frame } clone stack-frame set
+    [ compute-stack-frame* ] each
+    stack-frame get dup stack-frame-size >>total-size drop ;
 
 GENERIC: insert-pro/epilogues* ( insn -- )
 
@@ -56,7 +52,6 @@ M: insn insert-pro/epilogues* , ;
 
 : build-stack-frame ( mr -- mr )
     [
-        init-stack-frame-builder
         [
             [ compute-stack-frame ]
             [ insert-pro/epilogues ]
diff --git a/basis/compiler/cfg/value-numbering/expressions/expressions.factor b/basis/compiler/cfg/value-numbering/expressions/expressions.factor
new file mode 100644
index 0000000000..f8fb0aab29
--- /dev/null
+++ b/basis/compiler/cfg/value-numbering/expressions/expressions.factor
@@ -0,0 +1,23 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler.cfg.value-numbering.expressions
+
+! Referentially-transparent expressions.
+
+TUPLE: expr op ;
+
+! op is always %peek
+TUPLE: peek-expr < expr loc ;
+TUPLE: unary-expr < expr in ;
+TUPLE: load-literal-expr < expr obj ;
+
+GENERIC: >expr ( insn -- expr )
+
+M: ##peek >expr
+    [ class ] [ loc>> ] bi peek-expr boa ;
+
+M: ##load-literal >expr
+    [ class ] [ obj>> ] bi load-literal-expr boa ;
+
+M: ##unary >expr
+    [ class ] [ src>> vreg>vn ] bi unary-expr boa ;
diff --git a/basis/compiler/cfg/value-numbering/graph/graph.factor b/basis/compiler/cfg/value-numbering/graph/graph.factor
new file mode 100644
index 0000000000..b0ae044fb7
--- /dev/null
+++ b/basis/compiler/cfg/value-numbering/graph/graph.factor
@@ -0,0 +1,32 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler.cfg.value-numbering.graph
+
+SYMBOL: vn-counter
+
+: next-vn ( -- vn ) vn-counter [ dup 1 + ] change ;
+
+! biassoc mapping expressions to value numbers
+SYMBOL: exprs>vns
+
+: expr>vn ( expr -- vn ) exprs>vns get [ drop next-vn ] cache ;
+
+: vn>expr ( vn -- expr ) exprs>vns get value-at ;
+
+! biassoc mapping vregs to value numbers
+SYMBOL: vregs>vns
+
+: vreg>vn ( vreg -- vn ) vregs>vns get at ;
+
+: vn>vreg ( vn -- vreg ) vregs>vns get value-at ;
+
+: set-vn ( vn vreg -- ) vregs>vns get set-at ;
+
+: init-value-graph ( -- )
+    0 vn-counter set
+    <bihash> exprs>vns set
+    <bihash> vregs>vns set ;
+
+: reset-value-graph ( -- )
+    exprs>vns get clear-assoc
+    vregs>vns get clear-assoc ;
diff --git a/basis/compiler/cfg/value-numbering/liveness/liveness.factor b/basis/compiler/cfg/value-numbering/liveness/liveness.factor
new file mode 100644
index 0000000000..c445c0835d
--- /dev/null
+++ b/basis/compiler/cfg/value-numbering/liveness/liveness.factor
@@ -0,0 +1,38 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler.cfg.value-numbering.liveness
+
+! A set of VNs which are (transitively) used by side-effecting
+! instructions.
+SYMBOL: live-vns
+
+GENERIC: live-expr ( expr -- )
+
+: live-vn ( vn -- )
+    #! Mark a VN and all VNs used in its computation as live.
+    dup live-vns get key? [ drop ] [
+        [ live-vns get conjoin ] [ vn>expr live-expr ] bi
+    ] if ;
+
+M: peek-expr live-expr drop ;
+M: unary-expr live-expr in>> live-vn ;
+M: load-literal-expr live-expr in>> live-vn ;
+
+: live-vreg ( vreg -- ) vreg>vn live-vn ;
+
+: live? ( vreg -- ? )
+    dup vreg>vn tuck vn>vreg =
+    [ live-vns get key? ] [ drop f ] if ;
+
+: init-liveness ( -- )
+    H{ } clone live-vns set ;
+
+GENERIC: eliminate ( insn -- insn/f )
+
+: (eliminate) ( insn -- insn/f )
+    dup dst>> >vreg live? [ drop f ] unless ;
+
+M: ##peek eliminate (eliminate) ;
+M: ##unary eliminate (eliminate) ;
+M: ##load-literal eliminate (eliminate) ;
+M: insn eliminate ;
diff --git a/basis/compiler/cfg/value-numbering/propagate/propagate.factor b/basis/compiler/cfg/value-numbering/propagate/propagate.factor
new file mode 100644
index 0000000000..758d3f95e6
--- /dev/null
+++ b/basis/compiler/cfg/value-numbering/propagate/propagate.factor
@@ -0,0 +1,58 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler.cfg.value-numbering.propagate
+
+! If two vregs compute the same value, replace references to
+! the latter with the former.
+
+: resolve ( vreg -- vreg' ) vreg>vn vn>vreg ;
+
+GENERIC: propogate ( insn -- insn )
+
+M: ##cond-branch propagate [ resolve ] change-src ;
+
+M: ##unary propogate [ resolve ] change-src ;
+
+M: ##nullary propagate ;
+
+M: ##replace propagate [ resolve ] change-src ;
+
+M: ##inc-d propagate ;
+
+M: ##inc-r propagate ;
+
+M: ##stack-frame propagate ;
+
+M: ##call propagate ;
+
+M: ##jump propagate ;
+
+M: ##return propagate ;
+
+M: ##intrinsic propagate
+    [ [ resolve ] assoc-map ] change-defs-vregs
+    [ [ resolve ] assoc-map ] change-uses-vregs ;
+
+M: ##dispatch propagate [ resolve ] change-src ;
+
+M: ##dispatch-label propagate ;
+
+M: ##write-barrier propagate [ resolve ] change-src ;
+
+M: ##alien-invoke propagate ;
+
+M: ##alien-indirect propagate ;
+
+M: ##alien-callback propagate ;
+
+M: ##callback-return propagate ;
+
+M: ##prologue propagate ;
+
+M: ##epilogue propagate ;
+
+M: ##branch propagate ;
+
+M: ##if-intrinsic propagate
+    [ [ resolve ] assoc-map ] change-defs-vregs
+    [ [ resolve ] assoc-map ] change-uses-vregs ;
diff --git a/basis/compiler/cfg/value-numbering/value-numbering.factor b/basis/compiler/cfg/value-numbering/value-numbering.factor
new file mode 100644
index 0000000000..81e8c40afd
--- /dev/null
+++ b/basis/compiler/cfg/value-numbering/value-numbering.factor
@@ -0,0 +1,46 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler.cfg.value-numbering
+
+: insn>vn ( insn -- vn ) >expr simplify ; inline
+
+GENERIC: make-value-node ( insn -- )
+
+M: ##cond-branch make-value-node src>> live-vreg ;
+M: ##unary make-value-node [ insn>vn ] [ dst>> ] bi set-vn ;
+M: ##nullary make-value-node drop ;
+M: ##load-literal make-value-node [ insn>vn ] [ dst>> ] bi set-vn ;
+M: ##peek make-value-node [ insn>vn ] [ dst>> ] bi set-vn ;
+M: ##replace make-value-node reset-value-graph ;
+M: ##inc-d make-value-node reset-value-graph ;
+M: ##inc-r make-value-node reset-value-graph ;
+M: ##stack-frame make-value-node reset-value-graph ;
+M: ##call make-value-node reset-value-graph ;
+M: ##jump make-value-node reset-value-graph ;
+M: ##return make-value-node reset-value-graph ;
+M: ##intrinsic make-value-node uses-vregs [ live-vreg ] each ;
+M: ##dispatch make-value-node reset-value-graph ;
+M: ##dispatch-label make-value-node reset-value-graph ;
+M: ##allot make-value-node drop ;
+M: ##write-barrier make-value-node drop ;
+M: ##gc make-value-node reset-value-graph ;
+M: ##replace make-value-node reset-value-graph ;
+M: ##alien-invoke make-value-node reset-value-graph ;
+M: ##alien-indirect make-value-node reset-value-graph ;
+M: ##alien-callback make-value-node reset-value-graph ;
+M: ##callback-return make-value-node reset-value-graph ;
+M: ##prologue make-value-node reset-value-graph ;
+M: ##epilogue make-value-node reset-value-graph ;
+M: ##branch make-value-node reset-value-graph ;
+M: ##if-intrinsic make-value-node uses-vregs [ live-vreg ] each ;
+
+: init-value-numbering ( -- )
+    init-value-graph
+    init-expressions
+    init-liveness ;
+
+: value-numbering ( instructions -- instructions )
+    init-value-numbering
+    [ [ make-value-node ] [ propagate ] bi ] map
+    [ eliminate ] map
+    sift ;
diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index 44e2fd6bac..6c83c38355 100644
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -72,11 +72,7 @@ M: _label generate-insn
     id>> lookup-label , ;
 
 M: _prologue generate-insn
-    stack-frame>>
-    [ stack-frame set ]
-    [ dup size>> stack-frame-size >>total-size drop ]
-    [ total-size>> %prologue ]
-    tri ;
+    stack-frame>> [ stack-frame set ] [ total-size>> %prologue ] bi ;
 
 M: _epilogue generate-insn
     stack-frame>> total-size>> %epilogue ;
@@ -439,3 +435,17 @@ M: ##alien-callback generate-insn
     [ wrap-callback-quot %alien-callback ]
     [ alien-return [ %unnest-stacks ] [ %callback-value ] if-void ]
     tri ;
+
+M: _spill generate-insn
+    [ src>> ] [ n>> ] [ class>> ] tri {
+        { int-regs [ %spill-integer ] }
+        { double-float-regs [ %spill-float ] }
+    } case ;
+
+M: _reload generate-insn
+    [ dst>> ] [ n>> ] [ class>> ] tri {
+        { int-regs [ %reload-integer ] }
+        { double-float-regs [ %reload-float ] }
+    } case ;
+
+M: _spill-counts generate-insn drop ;
diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor
index c94252e7ac..c02c1e8fda 100644
--- a/basis/compiler/compiler.factor
+++ b/basis/compiler/compiler.factor
@@ -61,18 +61,6 @@ SYMBOL: +failed+
 : frontend ( word -- effect nodes )
     [ build-tree-from-word ] [ fail ] recover optimize-tree ;
 
-: finish ( effect word -- )
-    [ swap save-effect ]
-    [ compiled-unxref ]
-    [
-        dup crossref?
-        [
-            dependencies get >alist
-            generic-dependencies get >alist
-            compiled-xref
-        ] [ drop ] if
-    ] tri ;
-
 ! Only switch this off for debugging.
 SYMBOL: compile-dependencies?
 
@@ -92,6 +80,18 @@ t compile-dependencies? set-global
         save-asm
     ] each ;
 
+: finish ( effect word -- )
+    [ swap save-effect ]
+    [ compiled-unxref ]
+    [
+        dup crossref?
+        [
+            dependencies get >alist
+            generic-dependencies get >alist
+            compiled-xref
+        ] [ drop ] if
+    ] tri ;
+
 : (compile) ( word -- )
     '[
         _ {