From d3636216256b5799d033d8a1ddb17a23f9de9637 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 15 Sep 2008 01:54:48 -0500
Subject: [PATCH 1/4] Live interval splitting and spilling

---
 unfinished/compiler/backend/x86/32/32.factor  |   3 +-
 unfinished/compiler/backend/x86/64/64.factor  |  14 ++
 .../compiler/cfg/builder/builder.factor       |   6 +-
 .../instructions/instructions.factor          |  32 ++-
 .../instructions/syntax/syntax.factor         |   2 +-
 .../linear-scan/allocation/allocation.factor  | 210 +++++++++++++-----
 .../cfg/linear-scan/debugger/debugger.factor  |  38 ++++
 .../cfg/linear-scan/linear-scan-tests.factor  | 100 +++++++++
 .../live-intervals/live-intervals.factor      |  49 ++--
 .../cfg/linearization/linearization.factor    |   7 +-
 .../{ => cfg}/registers/registers.factor      |   2 +-
 unfinished/compiler/cfg/rpo/rpo.factor        |   2 +-
 unfinished/compiler/cfg/stacks/stacks.factor  |   4 +-
 .../compiler/cfg/templates/templates.factor   |   4 +-
 14 files changed, 378 insertions(+), 95 deletions(-)
 create mode 100644 unfinished/compiler/backend/x86/64/64.factor
 rename unfinished/compiler/{ => cfg}/instructions/instructions.factor (77%)
 rename unfinished/compiler/{ => cfg}/instructions/syntax/syntax.factor (91%)
 create mode 100644 unfinished/compiler/cfg/linear-scan/debugger/debugger.factor
 create mode 100644 unfinished/compiler/cfg/linear-scan/linear-scan-tests.factor
 rename unfinished/compiler/{ => cfg}/registers/registers.factor (98%)

diff --git a/unfinished/compiler/backend/x86/32/32.factor b/unfinished/compiler/backend/x86/32/32.factor
index 85df673839..98726d7e35 100644
--- a/unfinished/compiler/backend/x86/32/32.factor
+++ b/unfinished/compiler/backend/x86/32/32.factor
@@ -1,6 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: system cpu.x86.assembler compiler.registers compiler.backend ;
+USING: system cpu.x86.assembler compiler.cfg.registers
+compiler.backend ;
 IN: compiler.backend.x86.32
 
 M: x86.32 machine-registers
diff --git a/unfinished/compiler/backend/x86/64/64.factor b/unfinished/compiler/backend/x86/64/64.factor
new file mode 100644
index 0000000000..fe21fadbd5
--- /dev/null
+++ b/unfinished/compiler/backend/x86/64/64.factor
@@ -0,0 +1,14 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: system cpu.x86.assembler compiler.cfg.registers
+compiler.backend ;
+IN: compiler.backend.x86.64
+
+M: x86.64 machine-registers
+    {
+        { int-regs { RAX RCX RDX RBP RSI RDI R8 R9 R10 R11 R12 R13 } }
+        { float-regs {
+            XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7
+            XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15
+        } }
+    } ;
diff --git a/unfinished/compiler/cfg/builder/builder.factor b/unfinished/compiler/cfg/builder/builder.factor
index 86e69a50b7..f1199183d0 100755
--- a/unfinished/compiler/cfg/builder/builder.factor
+++ b/unfinished/compiler/cfg/builder/builder.factor
@@ -10,9 +10,9 @@ compiler.cfg
 compiler.cfg.stacks
 compiler.cfg.templates
 compiler.cfg.iterator
-compiler.alien
-compiler.instructions
-compiler.registers ;
+compiler.cfg.instructions
+compiler.cfg.registers
+compiler.alien ;
 IN: compiler.cfg.builder
 
 ! Convert tree SSA IR to CFG (not quite SSA yet) IR.
diff --git a/unfinished/compiler/instructions/instructions.factor b/unfinished/compiler/cfg/instructions/instructions.factor
similarity index 77%
rename from unfinished/compiler/instructions/instructions.factor
rename to unfinished/compiler/cfg/instructions/instructions.factor
index 57b3ff51fd..83532d6038 100644
--- a/unfinished/compiler/instructions/instructions.factor
+++ b/unfinished/compiler/cfg/instructions/instructions.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs accessors arrays kernel sequences namespaces
-math compiler.instructions.syntax ;
-IN: compiler.instructions
+math compiler.cfg.instructions.syntax ;
+IN: compiler.cfg.instructions
 
 ! Virtual CPU instructions, used by CFG and machine IRs
 
@@ -46,14 +46,22 @@ INSN: %alien-invoke params ;
 INSN: %alien-indirect params ;
 INSN: %alien-callback params ;
 
+GENERIC: defs-vregs ( insn -- seq )
 GENERIC: uses-vregs ( insn -- seq )
 
+M: insn defs-vregs drop f ;
 M: insn uses-vregs drop f ;
-M: %peek uses-vregs vreg>> 1array ;
+
+M: %peek defs-vregs vreg>> 1array ;
+
 M: %replace uses-vregs vreg>> 1array ;
-M: %load-literal uses-vregs vreg>> 1array ;
-M: %unary uses-vregs [ dst>> ] [ src>> ] bi 2array ;
-M: %intrinsic uses-vregs vregs>> values ;
+
+M: %load-literal defs-vregs vreg>> 1array ;
+
+M: %unary defs-vregs dst>> 1array ;
+M: %unary uses-vregs src>> 1array ;
+
+! M: %intrinsic uses-vregs vregs>> values ;
 
 ! Instructions used by CFG IR only.
 INSN: %prologue ;
@@ -67,9 +75,13 @@ INSN: %if-intrinsic quot vregs ;
 INSN: %boolean-intrinsic quot vregs out ;
 
 M: %cond-branch uses-vregs vreg>> 1array ;
-M: %if-intrinsic uses-vregs vregs>> values ;
-M: %boolean-intrinsic uses-vregs
-    [ vregs>> values ] [ out>> ] bi suffix ;
+
+! M: %if-intrinsic uses-vregs vregs>> values ;
+
+M: %boolean-intrinsic defs-vregs out>> 1array ;
+
+! M: %boolean-intrinsic uses-vregs
+!     [ vregs>> values ] [ out>> ] bi suffix ;
 
 ! Instructions used by machine IR only.
 INSN: _prologue n ;
@@ -93,4 +105,4 @@ INSN: _branch-t < _cond-branch ;
 INSN: _if-intrinsic label quot vregs ;
 
 M: _cond-branch uses-vregs vreg>> 1array ;
-M: _if-intrinsic uses-vregs vregs>> values ;
+! M: _if-intrinsic uses-vregs vregs>> values ;
diff --git a/unfinished/compiler/instructions/syntax/syntax.factor b/unfinished/compiler/cfg/instructions/syntax/syntax.factor
similarity index 91%
rename from unfinished/compiler/instructions/syntax/syntax.factor
rename to unfinished/compiler/cfg/instructions/syntax/syntax.factor
index 0a4ffae876..30bec6ac37 100644
--- a/unfinished/compiler/instructions/syntax/syntax.factor
+++ b/unfinished/compiler/cfg/instructions/syntax/syntax.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: classes.tuple classes.tuple.parser kernel words
 make parser ;
-IN: compiler.instructions.syntax
+IN: compiler.cfg.instructions.syntax
 
 TUPLE: insn ;
 
diff --git a/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor b/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor
index 37e1d512cd..4e75957990 100644
--- a/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor
+++ b/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor
@@ -1,18 +1,30 @@
 ! 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
+accessors vectors fry heaps
 compiler.cfg.linear-scan.live-intervals
 compiler.backend ;
 IN: compiler.cfg.linear-scan.allocation
 
-! Mapping from vregs to machine registers
-SYMBOL: register-allocation
+! Vector of live intervals we have already processed
+SYMBOL: retired-intervals
 
-! Mapping from vregs to spill locations
-SYMBOL: spill-locations
+: retire-interval ( live-interval -- )
+    retired-intervals get push ;
 
-! Vector of active live intervals, in order of increasing end point
+: retire-intervals ( live-intervals -- )
+    retired-intervals get push-all ;
+
+! Mapping from register classes to sequences of machine registers
+SYMBOL: free-registers
+
+: free-registers-for ( vreg -- seq )
+    reg-class>> free-registers get at ;
+
+: deallocate-register ( live-interval -- )
+    [ reg>> ] [ vreg>> ] bi free-registers-for push ;
+
+! Vector of active live intervals
 SYMBOL: active-intervals
 
 : add-active ( live-interval -- )
@@ -21,70 +33,156 @@ SYMBOL: active-intervals
 : delete-active ( live-interval -- )
     active-intervals get delete ;
 
-! Mapping from register classes to sequences of machine registers
-SYMBOL: free-registers
+: expire-old-intervals ( n -- )
+    active-intervals get
+    swap '[ end>> _ < ] partition
+    active-intervals set
+    [ [ retire-interval ] [ deallocate-register ] bi ] each ;
 
-! Counter of spill locations
+: expire-old-uses ( n -- )
+    active-intervals get
+    swap '[ uses>> dup peek _ < [ pop* ] [ drop ] if ] 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
+
+! 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 ]
+    [ dup start>> unhandled-intervals get heap-push ]
+    bi ;
+
+: init-unhandled ( live-intervals -- )
+    [ [ start>> ] keep ] { } map>assoc
+    unhandled-intervals get heap-push-all ;
+
+: assign-free-register ( live-interval registers -- )
+    #! If the live interval does not have any uses, it means it
+    #! will be spilled immediately, so it still needs a register
+    #! to compute the new value, but we don't add the interval
+    #! to the active set and we don't remove the register from
+    #! the free list.
+    over uses>> empty?
+    [ peek >>reg drop ] [ pop >>reg add-active ] if ;
+
+! Spilling
 SYMBOL: spill-counter
 
 : next-spill-location ( -- n )
     spill-counter [ dup 1+ ] change ;
 
-: assign-spill ( live-interval -- )
-    next-spill-location swap vreg>> spill-locations get set-at ;
-
-: free-registers-for ( vreg -- seq )
-    reg-class>> free-registers get at ;
-
-: free-register ( vreg -- )
-    #! Free machine register currently assigned to vreg.
-    [ register-allocation get at ] [ free-registers-for ] bi push ;
-
-: expire-old-intervals ( live-interval -- )
-    active-intervals get
-    swap '[ end>> _ start>> < ] partition
-    active-intervals set
-    [ vreg>> free-register ] each ;
-
 : interval-to-spill ( -- live-interval )
-    #! We spill the interval with the longest remaining range.
+    #! We spill the interval with the most distant use location.
     active-intervals get unclip-slice [
-        [ [ end>> ] bi@ > ] most
+        [ [ uses>> peek ] bi@ > ] most
     ] reduce ;
 
-: reuse-register ( live-interval to-spill -- )
-    vreg>> swap vreg>>
-    register-allocation get
-    tuck [ at ] [ set-at ] 2bi* ;
+: check-split ( live-interval -- )
+    [ start>> ] [ end>> ] bi = [ "Cannot split any further" throw ] when ;
 
-: spill-at-interval ( live-interval -- )
+: 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 ;
+
+: assign-spill ( before after -- before after )
+    #! If it has been spilled already, reuse spill location.
+    over reload-from>> [ 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 ;
+
+: reuse-register ( new existing -- )
+    reg>> >>reg
+    dup uses>> empty? [
+        [ retire-interval ] [ deallocate-register ] bi
+    ] [ add-active ] if ;
+
+: 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 ]
+    [ delete-active ]
+    [
+        split-and-spill
+        [ retire-interval ]
+        [ add-unhandled ]
+        bi*
+    ] tri ;
+
+: 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 ;
+
+: spill-existing? ( new existing -- ? )
+    over uses>> empty? [ 2drop t ] [ [ uses>> peek ] bi@ < ] if ;
+
+: assign-blocked-register ( live-interval -- )
     interval-to-spill
-    2dup [ end>> ] bi@ > [
-        [ reuse-register ]
-        [ nip assign-spill ]
-        [ [ add-active ] [ delete-active ] bi* ]
-        2tri
-    ] [ drop assign-spill ] if ;
+    2dup spill-existing?
+    [ spill-existing ] [ spill-new ] if ;
 
-: init-allocator ( -- )
-    H{ } clone register-allocation set
-    H{ } clone spill-locations set
-    V{ } clone active-intervals set
-    machine-registers [ >vector ] assoc-map free-registers set
-    0 spill-counter set ;
-
-: assign-register ( live-interval register -- )
-    swap vreg>> register-allocation get set-at ;
-
-: allocate-register ( live-interval -- )
+: assign-register ( live-interval -- )
     dup vreg>> free-registers-for [
-        spill-at-interval
+        assign-blocked-register
     ] [
-        [ pop assign-register ]
-        [ drop add-active ]
-        2bi
+        assign-free-register
     ] if-empty ;
 
-: allocate-registers ( live-intervals -- )
-    init-allocator
-    [ [ expire-old-intervals ] [ allocate-register ] bi ] each ;
+! Main loop
+: slurp-heap ( heap quot: ( elt -- ) -- )
+    over heap-empty? [ 2drop ] [
+        [ [ heap-pop drop ] dip call ] [ slurp-heap ] 2bi
+    ] if ; inline recursive
+
+: init-allocator ( registers -- )
+    V{ } clone retired-intervals set
+    V{ } clone active-intervals set
+    <min-heap> unhandled-intervals set
+    [ >vector ] assoc-map free-registers set
+    0 spill-counter set
+    -1 progress set ;
+
+: handle-interval ( live-interval -- )
+    [ start>> progress set ] [ update-state ] [ assign-register ] tri ;
+
+: (allocate-registers) ( -- )
+    unhandled-intervals get [ handle-interval ] slurp-heap ;
+
+: finish-allocator ( -- live-intervals )
+    #! After register allocation is done, we retire all
+    #! live intervals which are still active.
+    active-intervals get retire-intervals
+    retired-intervals get ;
+
+: allocate-registers ( live-intervals machine-registers -- live-intervals' )
+    #! This destroys the input live-intervals.
+    [
+        init-allocator
+        init-unhandled
+        (allocate-registers)
+        finish-allocator
+    ] with-scope ;
diff --git a/unfinished/compiler/cfg/linear-scan/debugger/debugger.factor b/unfinished/compiler/cfg/linear-scan/debugger/debugger.factor
new file mode 100644
index 0000000000..b9bfb17cf6
--- /dev/null
+++ b/unfinished/compiler/cfg/linear-scan/debugger/debugger.factor
@@ -0,0 +1,38 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel sequences sets arrays
+compiler.cfg.linear-scan.live-intervals
+compiler.cfg.linear-scan.allocation ;
+IN: compiler.cfg.linear-scan.debugger
+
+: check-assigned ( live-intervals -- )
+    [
+        reg>>
+        [ "Not all intervals have registers" throw ] unless
+    ] each ;
+
+: check-split ( live-intervals -- )
+    [
+        split-before>>
+        [ "Split intervals returned" throw ] when
+    ] each ;
+
+: split-children ( live-interval -- seq )
+    dup split-before>> [
+        [ split-before>> ] [ split-after>> ] bi
+        [ split-children ] bi@
+        append
+    ] [
+        1array
+    ] if ;
+
+: check-retired ( original live-intervals -- )
+    #! All original live intervals should have either been
+    #! split, or ended up in the output set.
+    [ [ split-children ] map concat ] dip
+    2dup subset? [ "We lost some intervals" throw ] unless
+    swap subset? [ "We didn't record all splits" throw ] unless ;
+
+: check-linear-scan ( live-intervals machine-registers -- )
+    [ [ clone ] map dup ] dip allocate-registers
+    [ check-assigned ] [ check-split ] [ check-retired ] tri ;
diff --git a/unfinished/compiler/cfg/linear-scan/linear-scan-tests.factor b/unfinished/compiler/cfg/linear-scan/linear-scan-tests.factor
new file mode 100644
index 0000000000..00252e0c23
--- /dev/null
+++ b/unfinished/compiler/cfg/linear-scan/linear-scan-tests.factor
@@ -0,0 +1,100 @@
+IN: compiler.cfg.linear-scan.tests
+USING: tools.test random sorting sequences sets hashtables assocs
+kernel fry arrays splitting namespaces math accessors vectors
+math.order
+compiler.cfg.registers
+compiler.cfg.linear-scan.live-intervals
+compiler.cfg.linear-scan.debugger ;
+
+[ ] [
+    {
+        T{ live-interval { vreg T{ vreg { n 1 } } } { start 0 } { end 100 } { uses V{ 100 } } }
+    }
+    H{ { f { "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 } } }
+    }
+    H{ { f { "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 } } }
+    }
+    H{ { f { "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 } } }
+    }
+    H{ { f { "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 } } }
+    }
+    H{ { f { "A" } } }
+    check-linear-scan
+] must-fail
+
+SYMBOL: available
+
+SYMBOL: taken
+
+SYMBOL: max-registers
+
+SYMBOL: max-insns
+
+SYMBOL: max-uses
+
+: not-taken ( -- n )
+    available get keys dup empty? [ "Oops" throw ] when
+    random
+    dup taken get nth 1 + max-registers get = [
+        dup available get delete-at
+    ] [
+        dup taken get [ 1 + ] change-nth
+    ] if ;
+
+: random-live-intervals ( num-intervals max-uses max-registers max-insns -- seq )
+    [
+        max-insns set
+        max-registers set
+        max-uses set
+        max-insns get [ 0 ] replicate taken set
+        max-insns get [ dup ] H{ } map>assoc available set
+        [
+            live-interval new
+                swap f swap vreg boa >>vreg
+                max-uses get random 2 max [ not-taken ] replicate natural-sort
+                unclip [ >vector >>uses ] [ >>start ] bi*
+                dup uses>> first >>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 ;
+
+[ ] [ 30 2 1 60 random-test ] unit-test
+[ ] [ 60 2 2 60 random-test ] unit-test
+[ ] [ 80 2 3 200 random-test ] unit-test
+[ ] [ 70 2 5 30 random-test ] unit-test
+[ ] [ 60 2 6 30 random-test ] unit-test
+[ ] [ 1 2 10 10 random-test ] unit-test
+
+[ ] [ 10 4 2 60 random-test ] unit-test
+[ ] [ 10 20 2 400 random-test ] unit-test
+[ ] [ 10 20 4 300 random-test ] unit-test
diff --git a/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor b/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
index 6a3514c4e2..77222518fa 100644
--- a/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
+++ b/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
@@ -1,32 +1,49 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces kernel assocs accessors sequences math
-math.order sorting compiler.instructions compiler.registers ;
+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 vreg start end ;
+TUPLE: live-interval < identity-tuple
+vreg
+reg spill-to reload-from split-before split-after
+start end uses ;
 
-M: live-interval hashcode* nip [ start>> ] [ end>> 1000 * ] bi + ;
+: <live-interval> ( start vreg -- live-interval )
+    live-interval new
+        swap >>vreg
+        swap >>start
+        V{ } clone >>uses ;
+
+M: live-interval hashcode*
+    nip [ start>> ] [ end>> 1000 * ] bi + ;
+
+M: live-interval clone
+    call-next-method [ clone ] change-uses ;
 
 ! Mapping from vreg to live-interval
 SYMBOL: live-intervals
 
-: update-live-interval ( n vreg -- )
-    >vreg
+: 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
-    [ over f live-interval boa ] cache
-    (>>end) ;
+    [ [ uses-vregs ] 2dip '[ _ swap >vreg _ add-use ] each ]
+    [ [ defs-vregs ] 2dip '[ _ swap >vreg _ new-live-interval ] each ]
+    3bi ;
 
-: compute-live-intervals* ( n insn -- )
-    uses-vregs [ update-live-interval ] with each ;
-
-: sort-live-intervals ( assoc -- seq' )
-    #! Sort by increasing start location.
-    values [ [ start>> ] compare ] sort ;
+: 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 [
-            [ swap compute-live-intervals* ] each-index
+            [ compute-live-intervals* ] each-index
         ] with-variable
-    ] keep sort-live-intervals ;
+    ] keep finalize-live-intervals ;
diff --git a/unfinished/compiler/cfg/linearization/linearization.factor b/unfinished/compiler/cfg/linearization/linearization.factor
index 2aa7c66777..2c4a62d3be 100644
--- a/unfinished/compiler/cfg/linearization/linearization.factor
+++ b/unfinished/compiler/cfg/linearization/linearization.factor
@@ -1,8 +1,11 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math accessors sequences namespaces make
-combinators compiler.cfg compiler.cfg.rpo compiler.instructions
-compiler.instructions.syntax ;
+combinators
+compiler.cfg
+compiler.cfg.rpo
+compiler.cfg.instructions
+compiler.cfg.instructions.syntax ;
 IN: compiler.cfg.linearization
 
 ! Convert CFG IR to machine IR.
diff --git a/unfinished/compiler/registers/registers.factor b/unfinished/compiler/cfg/registers/registers.factor
similarity index 98%
rename from unfinished/compiler/registers/registers.factor
rename to unfinished/compiler/cfg/registers/registers.factor
index 6087064c80..5eaed92072 100644
--- a/unfinished/compiler/registers/registers.factor
+++ b/unfinished/compiler/cfg/registers/registers.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors namespaces math kernel ;
-IN: compiler.registers
+IN: compiler.cfg.registers
 
 ! Virtual CPU registers, used by CFG and machine IRs
 
diff --git a/unfinished/compiler/cfg/rpo/rpo.factor b/unfinished/compiler/cfg/rpo/rpo.factor
index d5280a8142..658bd5a29b 100644
--- a/unfinished/compiler/cfg/rpo/rpo.factor
+++ b/unfinished/compiler/cfg/rpo/rpo.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors namespaces make math sequences
-compiler.instructions ;
+compiler.cfg.instructions ;
 IN: compiler.cfg.rpo
 
 : post-order-traversal ( basic-block -- )
diff --git a/unfinished/compiler/cfg/stacks/stacks.factor b/unfinished/compiler/cfg/stacks/stacks.factor
index f2cfbb70a1..ae421f30f8 100755
--- a/unfinished/compiler/cfg/stacks/stacks.factor
+++ b/unfinished/compiler/cfg/stacks/stacks.factor
@@ -3,8 +3,8 @@
 USING: arrays assocs classes classes.private classes.algebra
 combinators hashtables kernel layouts math fry namespaces
 quotations sequences system vectors words effects alien
-byte-arrays accessors sets math.order compiler.instructions
-compiler.registers ;
+byte-arrays accessors sets math.order compiler.cfg.instructions
+compiler.cfg.registers ;
 IN: compiler.cfg.stacks
 
 ! Converting stack operations into register operations, while
diff --git a/unfinished/compiler/cfg/templates/templates.factor b/unfinished/compiler/cfg/templates/templates.factor
index 798e1fd563..1be714afa5 100644
--- a/unfinished/compiler/cfg/templates/templates.factor
+++ b/unfinished/compiler/cfg/templates/templates.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs accessors sequences kernel fry namespaces
-quotations combinators classes.algebra compiler.instructions
-compiler.registers compiler.cfg.stacks ;
+quotations combinators classes.algebra compiler.cfg.instructions
+compiler.cfg.registers compiler.cfg.stacks ;
 IN: compiler.cfg.templates
 
 USE: qualified

From 89ce8e1f3e43cf360a3c206529bde74e31e57358 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 15 Sep 2008 02:59:00 -0500
Subject: [PATCH 2/4] Add slurp-heap combinator, like slurp-deque

---
 basis/heaps/heaps.factor | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/basis/heaps/heaps.factor b/basis/heaps/heaps.factor
index 21eab2b8f1..6c387632ed 100755
--- a/basis/heaps/heaps.factor
+++ b/basis/heaps/heaps.factor
@@ -190,3 +190,8 @@ M: heap heap-pop ( heap -- value key )
     [ dup heap-empty? not ]
     [ dup heap-pop swap 2array ]
     [ ] produce nip ;
+
+: slurp-heap ( heap quot: ( elt -- ) -- )
+    over heap-empty? [ 2drop ] [
+        [ [ heap-pop drop ] dip call ] [ slurp-heap ] 2bi
+    ] if ; inline recursive

From f7cb6e3051e27ea54e1a8ade6a6e0874b43cb03e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 15 Sep 2008 02:59:24 -0500
Subject: [PATCH 3/4] Inserting spills and reloads

---
 .../cfg/instructions/instructions.factor      |  36 +++----
 .../linear-scan/allocation/allocation.factor  |  39 +------
 .../cfg/linear-scan/debugger/debugger.factor  |  19 +---
 .../live-intervals/live-intervals.factor      |  14 ++-
 .../rewriting/rewriting-tests.factor          |   4 +
 .../linear-scan/rewriting/rewriting.factor    | 100 ++++++++++++++++++
 .../cfg/linearization/linearization.factor    |   6 +-
 unfinished/compiler/cfg/stacks/stacks.factor  |   2 +-
 8 files changed, 139 insertions(+), 81 deletions(-)
 create mode 100644 unfinished/compiler/cfg/linear-scan/rewriting/rewriting-tests.factor
 create mode 100644 unfinished/compiler/cfg/linear-scan/rewriting/rewriting.factor

diff --git a/unfinished/compiler/cfg/instructions/instructions.factor b/unfinished/compiler/cfg/instructions/instructions.factor
index 83532d6038..ac3b3b75a0 100644
--- a/unfinished/compiler/cfg/instructions/instructions.factor
+++ b/unfinished/compiler/cfg/instructions/instructions.factor
@@ -6,15 +6,16 @@ IN: compiler.cfg.instructions
 
 ! Virtual CPU instructions, used by CFG and machine IRs
 
-INSN: %cond-branch vreg ;
+INSN: %cond-branch src ;
 INSN: %unary dst src ;
+INSN: %nullary dst ;
 
 ! Stack operations
-INSN: %peek vreg loc ;
-INSN: %replace vreg loc ;
+INSN: %load-literal < %nullary obj ;
+INSN: %peek < %nullary loc ;
+INSN: %replace src loc ;
 INSN: %inc-d n ;
 INSN: %inc-r n ;
-INSN: %load-literal obj vreg ;
 
 ! Calling convention
 INSN: %return ;
@@ -22,7 +23,7 @@ INSN: %return ;
 ! Subroutine calls
 INSN: %call word ;
 INSN: %jump word ;
-INSN: %intrinsic quot vregs ;
+INSN: %intrinsic quot regs ;
 
 ! Jump tables
 INSN: %dispatch-label label ;
@@ -49,17 +50,13 @@ INSN: %alien-callback params ;
 GENERIC: defs-vregs ( insn -- seq )
 GENERIC: uses-vregs ( insn -- seq )
 
-M: insn defs-vregs drop f ;
-M: insn uses-vregs drop f ;
-
-M: %peek defs-vregs vreg>> 1array ;
-
-M: %replace uses-vregs vreg>> 1array ;
-
-M: %load-literal defs-vregs vreg>> 1array ;
-
+M: %nullary defs-vregs dst>> 1array ;
 M: %unary defs-vregs dst>> 1array ;
+M: insn defs-vregs drop f ;
+
+M: %replace uses-vregs src>> 1array ;
 M: %unary uses-vregs src>> 1array ;
+M: insn uses-vregs drop f ;
 
 ! M: %intrinsic uses-vregs vregs>> values ;
 
@@ -72,9 +69,9 @@ INSN: %branch ;
 INSN: %branch-f < %cond-branch ;
 INSN: %branch-t < %cond-branch ;
 INSN: %if-intrinsic quot vregs ;
-INSN: %boolean-intrinsic quot vregs out ;
+INSN: %boolean-intrinsic quot vregs dst ;
 
-M: %cond-branch uses-vregs vreg>> 1array ;
+M: %cond-branch uses-vregs src>> 1array ;
 
 ! M: %if-intrinsic uses-vregs vregs>> values ;
 
@@ -97,12 +94,15 @@ INSN: _label label ;
 : resolve-label ( label/name -- )
     dup label? [ get ] unless _label ;
 
-TUPLE: _cond-branch vreg label ;
+TUPLE: _cond-branch src label ;
 
 INSN: _branch label ;
 INSN: _branch-f < _cond-branch ;
 INSN: _branch-t < _cond-branch ;
 INSN: _if-intrinsic label quot vregs ;
 
-M: _cond-branch uses-vregs vreg>> 1array ;
+M: _cond-branch uses-vregs src>> 1array ;
 ! M: _if-intrinsic uses-vregs vregs>> values ;
+
+INSN: _spill src n ;
+INSN: _reload dst n ;
diff --git a/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor b/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor
index 4e75957990..d0b1176c68 100644
--- a/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor
+++ b/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor
@@ -6,15 +6,6 @@ compiler.cfg.linear-scan.live-intervals
 compiler.backend ;
 IN: compiler.cfg.linear-scan.allocation
 
-! Vector of live intervals we have already processed
-SYMBOL: retired-intervals
-
-: retire-interval ( live-interval -- )
-    retired-intervals get push ;
-
-: retire-intervals ( live-intervals -- )
-    retired-intervals get push-all ;
-
 ! Mapping from register classes to sequences of machine registers
 SYMBOL: free-registers
 
@@ -37,7 +28,7 @@ SYMBOL: active-intervals
     active-intervals get
     swap '[ end>> _ < ] partition
     active-intervals set
-    [ [ retire-interval ] [ deallocate-register ] bi ] each ;
+    [ deallocate-register ] each ;
 
 : expire-old-uses ( n -- )
     active-intervals get
@@ -112,9 +103,7 @@ SYMBOL: spill-counter
 
 : reuse-register ( new existing -- )
     reg>> >>reg
-    dup uses>> empty? [
-        [ retire-interval ] [ deallocate-register ] bi
-    ] [ add-active ] if ;
+    dup uses>> empty? [ deallocate-register ] [ add-active ] if ;
 
 : spill-existing ( new existing -- )
     #! Our new interval will be used before the active interval
@@ -123,12 +112,7 @@ SYMBOL: spill-counter
     #! of the existing interval again.
     [ reuse-register ]
     [ delete-active ]
-    [
-        split-and-spill
-        [ retire-interval ]
-        [ add-unhandled ]
-        bi*
-    ] tri ;
+    [ split-and-spill [ drop ] [ add-unhandled ] bi* ] tri ;
 
 : spill-new ( new existing -- )
     #! Our new interval will be used after the active interval
@@ -153,13 +137,7 @@ SYMBOL: spill-counter
     ] if-empty ;
 
 ! Main loop
-: slurp-heap ( heap quot: ( elt -- ) -- )
-    over heap-empty? [ 2drop ] [
-        [ [ heap-pop drop ] dip call ] [ slurp-heap ] 2bi
-    ] if ; inline recursive
-
 : init-allocator ( registers -- )
-    V{ } clone retired-intervals set
     V{ } clone active-intervals set
     <min-heap> unhandled-intervals set
     [ >vector ] assoc-map free-registers set
@@ -172,17 +150,10 @@ SYMBOL: spill-counter
 : (allocate-registers) ( -- )
     unhandled-intervals get [ handle-interval ] slurp-heap ;
 
-: finish-allocator ( -- live-intervals )
-    #! After register allocation is done, we retire all
-    #! live intervals which are still active.
-    active-intervals get retire-intervals
-    retired-intervals get ;
-
-: allocate-registers ( live-intervals machine-registers -- live-intervals' )
-    #! This destroys the input live-intervals.
+: allocate-registers ( live-intervals machine-registers -- )
+    #! This modifies the input live-intervals.
     [
         init-allocator
         init-unhandled
         (allocate-registers)
-        finish-allocator
     ] with-scope ;
diff --git a/unfinished/compiler/cfg/linear-scan/debugger/debugger.factor b/unfinished/compiler/cfg/linear-scan/debugger/debugger.factor
index b9bfb17cf6..88cff9e95f 100644
--- a/unfinished/compiler/cfg/linear-scan/debugger/debugger.factor
+++ b/unfinished/compiler/cfg/linear-scan/debugger/debugger.factor
@@ -11,28 +11,13 @@ IN: compiler.cfg.linear-scan.debugger
         [ "Not all intervals have registers" throw ] unless
     ] each ;
 
-: check-split ( live-intervals -- )
-    [
-        split-before>>
-        [ "Split intervals returned" throw ] when
-    ] each ;
-
 : split-children ( live-interval -- seq )
     dup split-before>> [
         [ split-before>> ] [ split-after>> ] bi
         [ split-children ] bi@
         append
-    ] [
-        1array
-    ] if ;
-
-: check-retired ( original live-intervals -- )
-    #! All original live intervals should have either been
-    #! split, or ended up in the output set.
-    [ [ split-children ] map concat ] dip
-    2dup subset? [ "We lost some intervals" throw ] unless
-    swap subset? [ "We didn't record all splits" throw ] unless ;
+    ] [ 1array ] if ;
 
 : check-linear-scan ( live-intervals machine-registers -- )
     [ [ clone ] map dup ] dip allocate-registers
-    [ check-assigned ] [ check-split ] [ check-retired ] tri ;
+    [ split-children ] map concat check-assigned ;
diff --git a/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor b/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
index 77222518fa..f3f20680e6 100644
--- a/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
+++ b/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
@@ -37,13 +37,11 @@ SYMBOL: live-intervals
     [ [ defs-vregs ] 2dip '[ _ swap >vreg _ new-live-interval ] each ]
     3bi ;
 
-: finalize-live-intervals ( assoc -- seq' )
+: finalize-live-intervals ( -- )
     #! Reverse uses lists so that we can pop values off.
-    values dup [ uses>> reverse-here ] each ;
+    live-intervals get [ nip uses>> reverse-here ] assoc-each ;
 
-: compute-live-intervals ( instructions -- live-intervals )
-    H{ } clone [
-        live-intervals [
-            [ compute-live-intervals* ] each-index
-        ] with-variable
-    ] keep finalize-live-intervals ;
+: compute-live-intervals ( instructions -- )
+    H{ } clone live-intervals set
+    [ compute-live-intervals* ] each-index
+    finalize-live-intervals ;
diff --git a/unfinished/compiler/cfg/linear-scan/rewriting/rewriting-tests.factor b/unfinished/compiler/cfg/linear-scan/rewriting/rewriting-tests.factor
new file mode 100644
index 0000000000..63a411c777
--- /dev/null
+++ b/unfinished/compiler/cfg/linear-scan/rewriting/rewriting-tests.factor
@@ -0,0 +1,4 @@
+USING: compiler.cfg.linear-scan.rewriting tools.test ;
+IN: compiler.cfg.linear-scan.rewriting.tests
+
+\ rewrite-instructions must-infer
diff --git a/unfinished/compiler/cfg/linear-scan/rewriting/rewriting.factor b/unfinished/compiler/cfg/linear-scan/rewriting/rewriting.factor
new file mode 100644
index 0000000000..ad9e58c2ec
--- /dev/null
+++ b/unfinished/compiler/cfg/linear-scan/rewriting/rewriting.factor
@@ -0,0 +1,100 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel math assocs namespaces sequences heaps
+fry make
+compiler.cfg.registers
+compiler.cfg.instructions
+compiler.cfg.linear-scan.live-intervals ;
+IN: compiler.cfg.linear-scan.rewriting
+
+! A vector of live intervals. There is linear searching involved
+! but since we never have too many machine registers (around 30
+! at most) and we probably won't have that many live at any one
+! time anyway, it is not a problem to check each element.
+SYMBOL: active-intervals
+
+: add-active ( live-interval -- )
+    active-intervals get push ;
+
+: lookup-register ( vreg -- reg )
+    active-intervals get [ vreg>> = ] with find nip reg>> ;
+
+! Minheap of live intervals which still need a register allocation
+SYMBOL: unhandled-intervals
+
+: add-unhandled ( live-interval -- )
+    dup split-before>> [
+        [ split-before>> ] [ split-after>> ] bi
+        [ add-unhandled ] bi@
+    ] [
+        dup start>> unhandled-intervals get heap-push
+    ] if ;
+
+: init-unhandled ( live-intervals -- )
+    [ add-unhandled ] each ;
+
+: insert-spill ( live-interval -- )
+    [ reg>> ] [ spill-to>> ] bi dup [ _spill ] [ 2drop ] if ;
+
+: expire-old-intervals ( n -- )
+    active-intervals get
+    swap '[ end>> _ = ] partition
+    active-intervals set
+    [ insert-spill ] each ;
+
+: insert-reload ( live-interval -- )
+    [ reg>> ] [ reload-from>> ] bi dup [ _reload ] [ 2drop ] 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
+            activate-new-intervals
+        ] [ 2drop ] if
+    ] if ;
+
+GENERIC: rewrite-instruction ( insn -- )
+
+M: %cond-branch rewrite-instruction
+    [ lookup-register ] change-vreg
+    drop ;
+
+M: %unary rewrite-instruction
+    [ lookup-register ] change-dst
+    [ lookup-register ] change-src
+    drop ;
+
+M: %peek rewrite-instruction
+    [ lookup-register ] change-vreg
+    drop ;
+
+M: %replace rewrite-instruction
+    [ lookup-register ] change-vreg
+    drop ;
+
+M: %load-literal rewrite-instruction
+    [ lookup-register ] change-vreg
+    drop ;
+
+: lookup-registers ( assoc -- assoc' )
+    [ dup vreg? [ lookup-register ] when ] assoc-map ;
+
+M: %intrinsic rewrite-instruction
+    [ lookup-registers ] change-vregs
+    drop ;
+
+M: _if-intrinsic rewrite-instruction
+    [ lookup-registers ] change-vregs
+    drop ;
+
+: rewrite-instructions ( insns -- insns' )
+    [
+        [
+            [ activate-new-intervals ]
+            [ drop [ rewrite-instruction ] [ , ] bi ]
+            [ expire-old-intervals ]
+            tri
+        ] each-index
+    ] { } make ;
diff --git a/unfinished/compiler/cfg/linearization/linearization.factor b/unfinished/compiler/cfg/linearization/linearization.factor
index 2c4a62d3be..7c25a1b3bf 100644
--- a/unfinished/compiler/cfg/linearization/linearization.factor
+++ b/unfinished/compiler/cfg/linearization/linearization.factor
@@ -56,7 +56,7 @@ M: %branch linearize-insn
     dup successors>> first2 swap label>> ; inline
 
 : boolean-conditional ( basic-block insn -- basic-block successor vreg label2 )
-    [ conditional ] [ vreg>> ] bi* swap ; inline
+    [ conditional ] [ dst>> ] bi* swap ; inline
 
 M: %branch-f linearize-insn
     boolean-conditional _branch-f emit-branch ;
@@ -73,10 +73,10 @@ M: %boolean-intrinsic linearize-insn
         "false" define-label
         "end" define-label
         "false" get over [ quot>> ] [ vregs>> ] bi _if-intrinsic
-        t over out>> %load-literal
+        dup out>> t %load-literal
         "end" get _branch
         "false" resolve-label
-        f over out>> %load-literal
+        dup out>> f %load-literal
         "end" resolve-label
     ] with-scope
     2drop ;
diff --git a/unfinished/compiler/cfg/stacks/stacks.factor b/unfinished/compiler/cfg/stacks/stacks.factor
index ae421f30f8..3cff5da37e 100755
--- a/unfinished/compiler/cfg/stacks/stacks.factor
+++ b/unfinished/compiler/cfg/stacks/stacks.factor
@@ -127,7 +127,7 @@ M: constant move-spec class ;
         { { f unboxed-c-ptr } [ %move-bug ] }
         { { f unboxed-byte-array } [ %move-bug ] }
 
-        { { f constant } [ value>> swap %load-literal ] }
+        { { f constant } [ value>> %load-literal ] }
 
         { { f float } [ %box-float ] }
         { { f unboxed-alien } [ %box-alien ] }

From 389b04ad42af603ac72717f1b18776f6ac90a934 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 15 Sep 2008 04:22:12 -0500
Subject: [PATCH 4/4] More progress

---
 unfinished/compiler/backend/x86/32/32.factor  |  2 +-
 unfinished/compiler/backend/x86/64/64.factor  |  2 +-
 .../cfg/instructions/instructions.factor      | 22 ++++-----
 .../cfg/instructions/syntax/syntax.factor     |  6 +--
 .../linear-scan/allocation/allocation.factor  |  6 +--
 .../assignment/assignment-tests.factor        |  4 ++
 .../assignment.factor}                        | 49 ++++++-------------
 .../cfg/linear-scan/debugger/debugger.factor  |  2 +-
 .../cfg/linear-scan/linear-scan.factor        | 13 +++++
 .../live-intervals/live-intervals.factor      | 18 ++++---
 .../rewriting/rewriting-tests.factor          |  4 --
 .../cfg/linearization/linearization.factor    |  6 +--
 12 files changed, 64 insertions(+), 70 deletions(-)
 create mode 100644 unfinished/compiler/cfg/linear-scan/assignment/assignment-tests.factor
 rename unfinished/compiler/cfg/linear-scan/{rewriting/rewriting.factor => assignment/assignment.factor} (68%)
 delete mode 100644 unfinished/compiler/cfg/linear-scan/rewriting/rewriting-tests.factor

diff --git a/unfinished/compiler/backend/x86/32/32.factor b/unfinished/compiler/backend/x86/32/32.factor
index 98726d7e35..fabdaa7ff3 100644
--- a/unfinished/compiler/backend/x86/32/32.factor
+++ b/unfinished/compiler/backend/x86/32/32.factor
@@ -7,5 +7,5 @@ IN: compiler.backend.x86.32
 M: x86.32 machine-registers
     {
         { int-regs { EAX ECX EDX EBP EBX } }
-        { float-regs { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } }
+        { double-float-regs { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } }
     } ;
diff --git a/unfinished/compiler/backend/x86/64/64.factor b/unfinished/compiler/backend/x86/64/64.factor
index fe21fadbd5..9499995068 100644
--- a/unfinished/compiler/backend/x86/64/64.factor
+++ b/unfinished/compiler/backend/x86/64/64.factor
@@ -7,7 +7,7 @@ IN: compiler.backend.x86.64
 M: x86.64 machine-registers
     {
         { int-regs { RAX RCX RDX RBP RSI RDI R8 R9 R10 R11 R12 R13 } }
-        { float-regs {
+        { double-float-regs {
             XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7
             XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15
         } }
diff --git a/unfinished/compiler/cfg/instructions/instructions.factor b/unfinished/compiler/cfg/instructions/instructions.factor
index ac3b3b75a0..5fd7608a4c 100644
--- a/unfinished/compiler/cfg/instructions/instructions.factor
+++ b/unfinished/compiler/cfg/instructions/instructions.factor
@@ -1,14 +1,14 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs accessors arrays kernel sequences namespaces
-math compiler.cfg.instructions.syntax ;
+math compiler.cfg.registers compiler.cfg.instructions.syntax ;
 IN: compiler.cfg.instructions
 
 ! Virtual CPU instructions, used by CFG and machine IRs
 
-INSN: %cond-branch src ;
-INSN: %unary dst src ;
-INSN: %nullary dst ;
+TUPLE: %cond-branch < insn src ;
+TUPLE: %unary < insn dst src ;
+TUPLE: %nullary < insn dst ;
 
 ! Stack operations
 INSN: %load-literal < %nullary obj ;
@@ -50,12 +50,12 @@ INSN: %alien-callback params ;
 GENERIC: defs-vregs ( insn -- seq )
 GENERIC: uses-vregs ( insn -- seq )
 
-M: %nullary defs-vregs dst>> 1array ;
-M: %unary defs-vregs dst>> 1array ;
+M: %nullary defs-vregs dst>> >vreg 1array ;
+M: %unary defs-vregs dst>> >vreg 1array ;
 M: insn defs-vregs drop f ;
 
-M: %replace uses-vregs src>> 1array ;
-M: %unary uses-vregs src>> 1array ;
+M: %replace uses-vregs src>> >vreg 1array ;
+M: %unary uses-vregs src>> >vreg 1array ;
 M: insn uses-vregs drop f ;
 
 ! M: %intrinsic uses-vregs vregs>> values ;
@@ -75,7 +75,7 @@ M: %cond-branch uses-vregs src>> 1array ;
 
 ! M: %if-intrinsic uses-vregs vregs>> values ;
 
-M: %boolean-intrinsic defs-vregs out>> 1array ;
+M: %boolean-intrinsic defs-vregs dst>> 1array ;
 
 ! M: %boolean-intrinsic uses-vregs
 !     [ vregs>> values ] [ out>> ] bi suffix ;
@@ -94,14 +94,14 @@ INSN: _label label ;
 : resolve-label ( label/name -- )
     dup label? [ get ] unless _label ;
 
-TUPLE: _cond-branch src label ;
+TUPLE: _cond-branch < insn src label ;
 
 INSN: _branch label ;
 INSN: _branch-f < _cond-branch ;
 INSN: _branch-t < _cond-branch ;
 INSN: _if-intrinsic label quot vregs ;
 
-M: _cond-branch uses-vregs src>> 1array ;
+M: _cond-branch uses-vregs src>> >vreg 1array ;
 ! M: _if-intrinsic uses-vregs vregs>> values ;
 
 INSN: _spill src n ;
diff --git a/unfinished/compiler/cfg/instructions/syntax/syntax.factor b/unfinished/compiler/cfg/instructions/syntax/syntax.factor
index 30bec6ac37..6d533d2059 100644
--- a/unfinished/compiler/cfg/instructions/syntax/syntax.factor
+++ b/unfinished/compiler/cfg/instructions/syntax/syntax.factor
@@ -1,15 +1,15 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: classes.tuple classes.tuple.parser kernel words
-make parser ;
+make fry sequences parser ;
 IN: compiler.cfg.instructions.syntax
 
 TUPLE: insn ;
 
 : INSN:
-    parse-tuple-definition
+    parse-tuple-definition "regs" suffix
     [ dup tuple eq? [ drop insn ] when ] dip
     [ define-tuple-class ]
     [ 2drop save-location ]
-    [ 2drop dup [ boa , ] curry define-inline ]
+    [ 2drop dup '[ f _ boa , ] define-inline ]
     3tri ; parsing
diff --git a/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor b/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor
index d0b1176c68..0bfcc8bcd0 100644
--- a/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor
+++ b/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor
@@ -140,7 +140,7 @@ SYMBOL: spill-counter
 : init-allocator ( registers -- )
     V{ } clone active-intervals set
     <min-heap> unhandled-intervals set
-    [ >vector ] assoc-map free-registers set
+    [ reverse >vector ] assoc-map free-registers set
     0 spill-counter set
     -1 progress set ;
 
@@ -150,10 +150,10 @@ SYMBOL: spill-counter
 : (allocate-registers) ( -- )
     unhandled-intervals get [ handle-interval ] slurp-heap ;
 
-: allocate-registers ( live-intervals machine-registers -- )
+: allocate-registers ( live-intervals machine-registers -- live-intervals )
     #! This modifies the input live-intervals.
     [
         init-allocator
-        init-unhandled
+        dup init-unhandled
         (allocate-registers)
     ] with-scope ;
diff --git a/unfinished/compiler/cfg/linear-scan/assignment/assignment-tests.factor b/unfinished/compiler/cfg/linear-scan/assignment/assignment-tests.factor
new file mode 100644
index 0000000000..9efc23651b
--- /dev/null
+++ b/unfinished/compiler/cfg/linear-scan/assignment/assignment-tests.factor
@@ -0,0 +1,4 @@
+USING: compiler.cfg.linear-scan.assignment tools.test ;
+IN: compiler.cfg.linear-scan.assignment.tests
+
+\ assign-registers must-infer
diff --git a/unfinished/compiler/cfg/linear-scan/rewriting/rewriting.factor b/unfinished/compiler/cfg/linear-scan/assignment/assignment.factor
similarity index 68%
rename from unfinished/compiler/cfg/linear-scan/rewriting/rewriting.factor
rename to unfinished/compiler/cfg/linear-scan/assignment/assignment.factor
index ad9e58c2ec..8b53ee9531 100644
--- a/unfinished/compiler/cfg/linear-scan/rewriting/rewriting.factor
+++ b/unfinished/compiler/cfg/linear-scan/assignment/assignment.factor
@@ -5,7 +5,7 @@ fry make
 compiler.cfg.registers
 compiler.cfg.instructions
 compiler.cfg.linear-scan.live-intervals ;
-IN: compiler.cfg.linear-scan.rewriting
+IN: compiler.cfg.linear-scan.assignment
 
 ! A vector of live intervals. There is linear searching involved
 ! but since we never have too many machine registers (around 30
@@ -55,45 +55,24 @@ SYMBOL: unhandled-intervals
         ] [ 2drop ] if
     ] if ;
 
-GENERIC: rewrite-instruction ( insn -- )
+: (assign-registers) ( insn -- )
+    dup
+    [ defs-vregs ] [ uses-vregs ] bi append
+    active-intervals get swap '[ vreg>> _ member? ] filter
+    [ [ vreg>> ] [ reg>> ] bi ] { } map>assoc
+    >>regs drop ;
 
-M: %cond-branch rewrite-instruction
-    [ lookup-register ] change-vreg
-    drop ;
+: init-assignment ( live-intervals -- )
+    V{ } clone active-intervals set
+    <min-heap> unhandled-intervals set
+    init-unhandled ;
 
-M: %unary rewrite-instruction
-    [ lookup-register ] change-dst
-    [ lookup-register ] change-src
-    drop ;
-
-M: %peek rewrite-instruction
-    [ lookup-register ] change-vreg
-    drop ;
-
-M: %replace rewrite-instruction
-    [ lookup-register ] change-vreg
-    drop ;
-
-M: %load-literal rewrite-instruction
-    [ lookup-register ] change-vreg
-    drop ;
-
-: lookup-registers ( assoc -- assoc' )
-    [ dup vreg? [ lookup-register ] when ] assoc-map ;
-
-M: %intrinsic rewrite-instruction
-    [ lookup-registers ] change-vregs
-    drop ;
-
-M: _if-intrinsic rewrite-instruction
-    [ lookup-registers ] change-vregs
-    drop ;
-
-: rewrite-instructions ( insns -- insns' )
+: assign-registers ( insns live-intervals -- insns' )
     [
+        init-assignment
         [
             [ activate-new-intervals ]
-            [ drop [ rewrite-instruction ] [ , ] bi ]
+            [ drop [ (assign-registers) ] [ , ] bi ]
             [ expire-old-intervals ]
             tri
         ] each-index
diff --git a/unfinished/compiler/cfg/linear-scan/debugger/debugger.factor b/unfinished/compiler/cfg/linear-scan/debugger/debugger.factor
index 88cff9e95f..89bf81d2ba 100644
--- a/unfinished/compiler/cfg/linear-scan/debugger/debugger.factor
+++ b/unfinished/compiler/cfg/linear-scan/debugger/debugger.factor
@@ -19,5 +19,5 @@ IN: compiler.cfg.linear-scan.debugger
     ] [ 1array ] if ;
 
 : check-linear-scan ( live-intervals machine-registers -- )
-    [ [ clone ] map dup ] dip allocate-registers
+    [ [ clone ] map ] dip allocate-registers
     [ split-children ] map concat check-assigned ;
diff --git a/unfinished/compiler/cfg/linear-scan/linear-scan.factor b/unfinished/compiler/cfg/linear-scan/linear-scan.factor
index 307eecf53a..cbbb33b6c9 100644
--- a/unfinished/compiler/cfg/linear-scan/linear-scan.factor
+++ b/unfinished/compiler/cfg/linear-scan/linear-scan.factor
@@ -1,6 +1,19 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors
+compiler.backend
+compiler.cfg
+compiler.cfg.linear-scan.live-intervals
+compiler.cfg.linear-scan.allocation
+compiler.cfg.linear-scan.assignment ;
 IN: compiler.cfg.linear-scan
 
 ! See http://www.cs.ucla.edu/~palsberg/course/cs132/linearscan.pdf
+! and http://www.ssw.uni-linz.ac.at/Research/Papers/Wimmer04Master/
 
+: linear-scan ( mr -- mr' )
+    [
+        dup compute-live-intervals
+        machine-registers allocate-registers
+        assign-registers
+    ] change-instructions ;
diff --git a/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor b/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
index f3f20680e6..d6ee979fe5 100644
--- a/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
+++ b/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
@@ -33,15 +33,17 @@ SYMBOL: live-intervals
 
 : compute-live-intervals* ( insn n -- )
     live-intervals get
-    [ [ uses-vregs ] 2dip '[ _ swap >vreg _ add-use ] each ]
-    [ [ defs-vregs ] 2dip '[ _ swap >vreg _ new-live-interval ] each ]
+    [ [ uses-vregs ] 2dip '[ _ swap _ add-use ] each ]
+    [ [ defs-vregs ] 2dip '[ _ swap _ new-live-interval ] each ]
     3bi ;
 
-: finalize-live-intervals ( -- )
+: finalize-live-intervals ( assoc -- seq' )
     #! Reverse uses lists so that we can pop values off.
-    live-intervals get [ nip uses>> reverse-here ] assoc-each ;
+    values dup [ uses>> reverse-here ] each ;
 
-: compute-live-intervals ( instructions -- )
-    H{ } clone live-intervals set
-    [ compute-live-intervals* ] each-index
-    finalize-live-intervals ;
+: compute-live-intervals ( instructions -- live-intervals )
+    H{ } clone [
+        live-intervals [
+            [ compute-live-intervals* ] each-index
+        ] with-variable
+    ] keep finalize-live-intervals ;
diff --git a/unfinished/compiler/cfg/linear-scan/rewriting/rewriting-tests.factor b/unfinished/compiler/cfg/linear-scan/rewriting/rewriting-tests.factor
deleted file mode 100644
index 63a411c777..0000000000
--- a/unfinished/compiler/cfg/linear-scan/rewriting/rewriting-tests.factor
+++ /dev/null
@@ -1,4 +0,0 @@
-USING: compiler.cfg.linear-scan.rewriting tools.test ;
-IN: compiler.cfg.linear-scan.rewriting.tests
-
-\ rewrite-instructions must-infer
diff --git a/unfinished/compiler/cfg/linearization/linearization.factor b/unfinished/compiler/cfg/linearization/linearization.factor
index 7c25a1b3bf..b1288fb301 100644
--- a/unfinished/compiler/cfg/linearization/linearization.factor
+++ b/unfinished/compiler/cfg/linearization/linearization.factor
@@ -56,7 +56,7 @@ M: %branch linearize-insn
     dup successors>> first2 swap label>> ; inline
 
 : boolean-conditional ( basic-block insn -- basic-block successor vreg label2 )
-    [ conditional ] [ dst>> ] bi* swap ; inline
+    [ conditional ] [ src>> ] bi* swap ; inline
 
 M: %branch-f linearize-insn
     boolean-conditional _branch-f emit-branch ;
@@ -73,10 +73,10 @@ M: %boolean-intrinsic linearize-insn
         "false" define-label
         "end" define-label
         "false" get over [ quot>> ] [ vregs>> ] bi _if-intrinsic
-        dup out>> t %load-literal
+        dup dst>> t %load-literal
         "end" get _branch
         "false" resolve-label
-        dup out>> f %load-literal
+        dup dst>> f %load-literal
         "end" resolve-label
     ] with-scope
     2drop ;