diff --git a/basis/compiler/cfg/builder/blocks/blocks.factor b/basis/compiler/cfg/builder/blocks/blocks.factor
new file mode 100644
index 0000000000..4f4f9ad7b3
--- /dev/null
+++ b/basis/compiler/cfg/builder/blocks/blocks.factor
@@ -0,0 +1,74 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays fry kernel make math namespaces sequences
+compiler.cfg compiler.cfg.instructions compiler.cfg.stacks
+compiler.cfg.stacks.local ;
+IN: compiler.cfg.builder.blocks
+
+: set-basic-block ( basic-block -- )
+    [ basic-block set ] [ instructions>> building set ] bi
+    begin-local-analysis ;
+
+: initial-basic-block ( -- )
+    <basic-block> set-basic-block ;
+
+: end-basic-block ( -- )
+    basic-block get [ end-local-analysis ] when
+    building off
+    basic-block off ;
+
+: (begin-basic-block) ( -- )
+    <basic-block>
+    basic-block get [ dupd successors>> push ] when*
+    set-basic-block ;
+
+: begin-basic-block ( -- )
+    basic-block get [ end-local-analysis ] when
+    (begin-basic-block) ;
+
+: emit-trivial-block ( quot -- )
+    building get empty? [ ##branch begin-basic-block ] unless
+    call
+    ##branch begin-basic-block ; inline
+
+: call-height ( #call -- n )
+    [ out-d>> length ] [ in-d>> length ] bi - ;
+
+: emit-primitive ( node -- )
+    [
+        [ word>> ##call ]
+        [ call-height adjust-d ] bi
+    ] emit-trivial-block ;
+
+: begin-branch ( -- ) clone-current-height (begin-basic-block) ;
+
+: end-branch ( -- pair/f )
+    ! pair is { final-bb final-height }
+    basic-block get dup [
+        ##branch
+        end-local-analysis
+        current-height get clone 2array
+    ] when ;
+
+: with-branch ( quot -- pair/f )
+    [ begin-branch call end-branch ] with-scope ; inline
+
+: set-successors ( branches -- )
+    ! Set the successor of each branch's final basic block to the
+    ! current block.
+    basic-block get dup [
+        '[ [ [ _ ] dip first successors>> push ] when* ] each
+    ] [ 2drop ] if ;
+
+: merge-heights ( branches -- )
+    ! If all elements are f, that means every branch ended with a backward
+    ! jump so the height is irrelevant since this block is unreachable.
+    [ ] find nip [ second current-height set ] [ end-basic-block ] if* ;
+
+: emit-conditional ( branches -- )
+    ! branchies is a sequence of pairs as above
+    end-basic-block
+    [ merge-heights begin-basic-block ]
+    [ set-successors ]
+    bi ;
+
diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor
index 7381bdca55..812ef18e86 100644
--- a/basis/compiler/cfg/builder/builder-tests.factor
+++ b/basis/compiler/cfg/builder/builder-tests.factor
@@ -2,12 +2,12 @@ IN: compiler.cfg.builder.tests
 USING: tools.test kernel sequences words sequences.private fry
 prettyprint alien alien.accessors math.private compiler.tree.builder
 compiler.tree.optimizer compiler.cfg.builder compiler.cfg.debugger
-compiler.cfg.predecessors compiler.cfg.checker arrays locals
-byte-arrays kernel.private math slots.private ;
+compiler.cfg.optimizer compiler.cfg.predecessors compiler.cfg.checker
+arrays locals byte-arrays kernel.private math slots.private ;
 
 ! Just ensure that various CFGs build correctly.
 : unit-test-cfg ( quot -- )
-    '[ _ test-cfg [ compute-predecessors check-cfg ] each ] [ ] swap unit-test ;
+    '[ _ test-cfg [ optimize-cfg check-cfg ] each ] [ ] swap unit-test ;
 
 : blahblah ( nodes -- ? )
     { fixnum } declare [
diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor
index 7a7156d5c9..7a877ad49f 100755
--- a/basis/compiler/cfg/builder/builder.factor
+++ b/basis/compiler/cfg/builder/builder.factor
@@ -10,30 +10,39 @@ compiler.tree.combinators
 compiler.tree.propagation.info
 compiler.cfg
 compiler.cfg.hats
-compiler.cfg.stacks
 compiler.cfg.utilities
 compiler.cfg.registers
 compiler.cfg.intrinsics
 compiler.cfg.comparisons
 compiler.cfg.stack-frame
 compiler.cfg.instructions
+compiler.cfg.predecessors
+compiler.cfg.builder.blocks
+compiler.cfg.stacks
 compiler.alien ;
 IN: compiler.cfg.builder
 
-! Convert tree SSA IR to CFG SSA IR.
+! Convert tree SSA IR to CFG IR. The result is not in SSA form; this is
+! constructed later by calling compiler.cfg.ssa:construct-ssa.
 
 SYMBOL: procedures
 SYMBOL: loops
 
-: begin-procedure ( word label -- )
-    end-basic-block
-    begin-basic-block
+: begin-cfg ( word label -- cfg )
+    initial-basic-block
     H{ } clone loops set
-    [ basic-block get ] 2dip
-    <cfg> procedures get push ;
+    [ basic-block get ] 2dip <cfg> dup cfg set ;
+
+: begin-procedure ( word label -- )
+    begin-cfg procedures get push ;
 
 : with-cfg-builder ( nodes word label quot -- )
-    '[ begin-procedure @ ] with-scope ; inline
+    '[
+        begin-stack-analysis
+        begin-procedure
+        @
+        end-stack-analysis
+    ] with-scope ; inline
 
 GENERIC: emit-node ( node -- )
 
@@ -61,7 +70,7 @@ GENERIC: emit-node ( node -- )
 : emit-loop-call ( basic-block -- )
     ##branch
     basic-block get successors>> push
-    basic-block off ;
+    end-basic-block ;
 
 : emit-trivial-block ( quot -- )
     basic-block get instructions>> empty? [ ##branch begin-basic-block ] unless
@@ -71,7 +80,7 @@ GENERIC: emit-node ( node -- )
 : emit-call ( word height -- )
     over loops get key?
     [ drop loops get at emit-loop-call ]
-    [ [ ##call ] emit-trivial-block ]
+    [ [ [ ##call ] [ adjust-d ] bi* ] emit-trivial-block ]
     if ;
 
 ! #recursive
@@ -169,7 +178,7 @@ M: #return-recursive emit-node
     label>> id>> loops get key? [ emit-return ] unless ;
 
 ! #terminate
-M: #terminate emit-node drop ##no-tco basic-block off ;
+M: #terminate emit-node drop ##no-tco end-basic-block ;
 
 ! FFI
 : return-size ( ctype -- n )
@@ -186,9 +195,13 @@ M: #terminate emit-node drop ##no-tco basic-block off ;
         [ return>> return-size >>return ]
         [ alien-parameters parameter-sizes drop >>params ] bi ;
 
+: alien-node-height ( params -- n )
+    [ out-d>> length ] [ in-d>> length ] bi - adjust-d ;
+
 : emit-alien-node ( node quot -- )
     [
-        [ params>> dup <alien-stack-frame> ] dip call
+        [ params>> dup dup <alien-stack-frame> ] dip call
+        alien-node-height
     ] emit-trivial-block ; inline
 
 M: #alien-invoke emit-node
diff --git a/basis/compiler/cfg/checker/checker.factor b/basis/compiler/cfg/checker/checker.factor
index 53f84b1dda..22b6f03231 100644
--- a/basis/compiler/cfg/checker/checker.factor
+++ b/basis/compiler/cfg/checker/checker.factor
@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel compiler.cfg.instructions compiler.cfg.rpo
 compiler.cfg.def-use compiler.cfg.linearization compiler.cfg.utilities
-compiler.cfg.dce compiler.cfg.mr combinators.short-circuit accessors
-math sequences sets assocs ;
+compiler.cfg.mr combinators.short-circuit accessors math
+sequences sets assocs ;
 IN: compiler.cfg.checker
 
 ERROR: bad-kill-block bb ;
@@ -64,5 +64,5 @@ ERROR: undefined-values uses defs ;
 
 : check-cfg ( cfg -- )
     [ [ check-basic-block ] each-basic-block ]
-    [ eliminate-dead-code build-mr check-mr ]
+    [ build-mr check-mr ]
     bi ;
diff --git a/basis/compiler/cfg/dcn/dcn-tests.factor b/basis/compiler/cfg/dcn/dcn-tests.factor
deleted file mode 100644
index c987d9edd2..0000000000
--- a/basis/compiler/cfg/dcn/dcn-tests.factor
+++ /dev/null
@@ -1,620 +0,0 @@
-IN: compiler.cfg.dcn.tests
-USING: tools.test kernel accessors namespaces assocs math
-cpu.architecture vectors sequences classes
-compiler.cfg
-compiler.cfg.utilities
-compiler.cfg.debugger
-compiler.cfg.registers
-compiler.cfg.predecessors
-compiler.cfg.instructions
-compiler.cfg.checker
-compiler.cfg.dcn
-compiler.cfg.dcn.height
-compiler.cfg.dcn.local
-compiler.cfg.dcn.local.private
-compiler.cfg.dcn.global
-compiler.cfg.dcn.rewrite ;
-
-: test-local-dcn ( insns -- insns' )
-    <basic-block> swap >>instructions
-    [ local-analysis ] keep
-    instructions>> ;
-
-: inserting-peeks' ( from to -- assoc )
-    [ inserting-peeks ] keep untranslate-locs keys ;
-
-: inserting-replaces' ( from to -- assoc )
-    [ inserting-replaces ] keep untranslate-locs [ drop n>> 0 >= ] assoc-filter keys ;
-
-[
-    V{
-        T{ ##copy f V int-regs 1 V int-regs 0 }
-        T{ ##copy f V int-regs 3 V int-regs 2 }
-        T{ ##copy f V int-regs 5 V int-regs 4 }
-        T{ ##inc-d f -1 }
-        T{ ##branch }
-    }
-] [
-    V{
-        T{ ##peek f V int-regs 0 D 0 }
-        T{ ##peek f V int-regs 1 D 0 }
-        T{ ##inc-d f -1 }
-        T{ ##peek f V int-regs 2 D 0 }
-        T{ ##peek f V int-regs 3 D 0 }
-        T{ ##replace f V int-regs 2 D 0 }
-        T{ ##replace f V int-regs 4 D 1 }
-        T{ ##peek f V int-regs 5 D 1 }
-        T{ ##replace f V int-regs 5 D 1 }
-        T{ ##replace f V int-regs 6 D -1 }
-        T{ ##branch }
-    } test-local-dcn
-] unit-test
-
-[
-    H{
-        { V int-regs 1 V int-regs 0 }
-        { V int-regs 3 V int-regs 2 }
-        { V int-regs 5 V int-regs 4 }
-    }
-] [
-    copies get
-] unit-test
-
-[
-    H{
-        { D 0 V int-regs 0 }
-        { D 1 V int-regs 2 }
-    }
-] [ reads-locations get ] unit-test
-
-[
-    H{
-        { D 0 V int-regs 6 }
-        { D 2 V int-regs 4 }
-    }
-] [ writes-locations get ] unit-test
-
-: test-global-dcn ( -- )
-    cfg new 0 get >>entry
-    compute-predecessors
-    deconcatenatize
-    drop ;
-
-V{ T{ ##epilogue } T{ ##return } } 0 test-bb
-
-[ ] [ test-global-dcn ] unit-test
-
-V{
-    T{ ##prologue }
-    T{ ##branch }
-} 0 test-bb
-
-V{
-    T{ ##inc-d f 1 }
-    T{ ##peek f V int-regs 0 D 1 }
-    T{ ##load-immediate f V int-regs 1 100 }
-    T{ ##replace f V int-regs 1 D 2 }
-    T{ ##branch }
-} 1 test-bb
-
-V{
-    T{ ##epilogue }
-    T{ ##return }
-} 2 test-bb
-
-0 get 1 get 1vector >>successors drop
-1 get 2 get 1vector >>successors drop
-
-[ t ] [ 0 get kill-block? ] unit-test
-[ t ] [ 2 get kill-block? ] unit-test
-
-[ ] [ test-global-dcn ] unit-test
-
-[ t ] [ D 0 1 get peek-in key? ] unit-test
-
-[ f ] [ D 0 0 get peek-in key? ] unit-test
-
-[ t ] [ D 0 1 get avail-out key? ] unit-test
-
-[ f ] [ D 0 0 get avail-out key? ] unit-test
-
-[ { D 0 } ] [ 0 get 1 get inserting-peeks' ] unit-test
-
-[ { } ] [ 1 get 2 get inserting-peeks' ] unit-test
-
-[ { } ] [ 0 get 1 get inserting-replaces' ] unit-test
-
-[ { D 2 } ] [ 1 get 2 get inserting-replaces' ] unit-test
-
-V{
-    T{ ##prologue }
-    T{ ##branch }
-} 0 test-bb
-
-V{
-    T{ ##peek f V int-regs 0 D 1 }
-    T{ ##branch }
-} 1 test-bb
-
-V{
-    T{ ##inc-d f -1 }
-    T{ ##peek f V int-regs 0 D 0 }
-    T{ ##branch }
-} 2 test-bb
-
-V{
-    T{ ##epilogue }
-    T{ ##return }
-} 3 test-bb
-
-0 get 1 get 1vector >>successors drop
-1 get 2 get 1vector >>successors drop
-2 get 3 get 1vector >>successors drop
-
-[ ] [ test-global-dcn ] unit-test
-
-[ t ] [ D 1 2 get peek-in key? ] unit-test
-[ { D 1 } ] [ 0 get 1 get inserting-peeks' ] unit-test
-[ { } ] [ 1 get 2 get inserting-peeks' ] unit-test
-
-V{
-    T{ ##prologue }
-    T{ ##branch }
-} 0 test-bb
-
-V{
-    T{ ##branch }
-} 1 test-bb
-
-V{
-    T{ ##inc-d f 1 }
-    T{ ##peek f V int-regs 0 D 1 }
-    T{ ##branch }
-} 2 test-bb
-
-V{
-    T{ ##epilogue }
-    T{ ##return }
-} 3 test-bb
-
-V{
-    T{ ##peek f V int-regs 1 D 0 }
-    T{ ##peek f V int-regs 2 D 1 }
-    T{ ##inc-d f 1 }
-    T{ ##replace f V int-regs 2 D 1 }
-    T{ ##branch }
-} 4 test-bb
-
-V{
-    T{ ##epilogue }
-    T{ ##return }
-} 5 test-bb
-
-0 get 1 get 1vector >>successors drop
-1 get 2 get 4 get V{ } 2sequence >>successors drop
-2 get 3 get 1vector >>successors drop
-4 get 5 get 1vector >>successors drop
-
-[ ] [ test-global-dcn ] unit-test
-
-[ f ] [ D 0 1 get avail-out key? ] unit-test
-[ f ] [ D 1 1 get avail-out key? ] unit-test
-[ t ] [ D 0 4 get peek-in key? ] unit-test
-[ t ] [ D 1 4 get peek-in key? ] unit-test
-
-[ { D 0 } ] [ 0 get 1 get inserting-peeks' ] unit-test
-[ { } ] [ 0 get 1 get inserting-replaces' ] unit-test
-[ { } ] [ 1 get 2 get inserting-peeks' ] unit-test
-[ { } ] [ 1 get 2 get inserting-replaces' ] unit-test
-[ { } ] [ 1 get 3 get inserting-peeks' ] unit-test
-[ { } ] [ 1 get 3 get inserting-replaces' ] unit-test
-[ { D 1 } ] [ 1 get 4 get inserting-peeks' ] unit-test
-[ { } ] [ 2 get 4 get inserting-replaces' ] unit-test
-[ { } ] [ 4 get 5 get inserting-peeks' ] unit-test
-[ { D 1 } ] [ 4 get 5 get inserting-replaces' ] unit-test
-
-[ t ] [ D 0 1 get peek-out key? ] unit-test
-[ f ] [ D 1 1 get peek-out key? ] unit-test
-
-[ t ] [ D 1 4 get peek-in key? ] unit-test
-[ f ] [ D 1 4 get avail-in key? ] unit-test
-[ t ] [ D 1 4 get avail-out key? ] unit-test
-
-V{
-    T{ ##prologue }
-    T{ ##branch }
-} 0 test-bb
-
-V{
-    T{ ##peek f V int-regs 0 D 0 }
-    T{ ##branch }
-} 1 test-bb
-
-V{
-    T{ ##peek f V int-regs 1 D 1 }
-    T{ ##inc-d f -1 }
-    T{ ##branch }
-} 2 test-bb
-
-V{
-    T{ ##load-immediate f V int-regs 2 100 }
-    T{ ##replace f V int-regs 2 D 1 }
-    T{ ##inc-d f -1 }
-    T{ ##peek f V int-regs 4 D 1 }
-    T{ ##branch }
-} 3 test-bb
-
-V{
-    T{ ##load-immediate f V int-regs 3 100 }
-    T{ ##replace f V int-regs 3 D 0 }
-    T{ ##branch }
-} 4 test-bb
-
-V{
-    T{ ##epilogue }
-    T{ ##return }
-} 5 test-bb
-
-0 get 1 get 1vector >>successors drop
-1 get 2 get 3 get V{ } 2sequence >>successors drop
-2 get 4 get 1vector >>successors drop
-3 get 4 get 1vector >>successors drop
-4 get 5 get 1vector >>successors drop
-
-[ ] [ test-global-dcn ] unit-test
-
-[ t ] [ D 1 4 get avail-in key? ] unit-test
-[ f ] [ D 2 4 get avail-in key? ] unit-test
-[ t ] [ D 1 2 get peek-in key? ] unit-test
-[ f ] [ D 1 3 get peek-in key? ] unit-test
-
-[ { D 0 } ] [ 0 get 1 get inserting-peeks' ] unit-test
-[ { } ] [ 0 get 1 get inserting-replaces' ] unit-test
-[ { D 1 } ] [ 1 get 2 get inserting-peeks' ] unit-test
-[ { } ] [ 1 get 2 get inserting-replaces' ] unit-test
-[ { D 2 } ] [ 1 get 3 get inserting-peeks' ] unit-test
-[ { } ] [ 1 get 3 get inserting-replaces' ] unit-test
-[ { } ] [ 3 get 4 get inserting-peeks' ] unit-test
-[ { } ] [ 2 get 4 get inserting-replaces' ] unit-test
-[ { } ] [ 3 get 4 get inserting-replaces' ] unit-test
-[ { D 0 } ] [ 4 get 5 get inserting-replaces' ] unit-test
-
-V{
-    T{ ##prologue }
-    T{ ##branch }
-} 0 test-bb
-
-V{
-    T{ ##peek f V int-regs 0 D 1 }
-    T{ ##branch }
-} 1 test-bb
-
-V{
-    T{ ##inc-d f -1 }
-    T{ ##branch }
-} 2 test-bb
-
-V{
-    T{ ##call f drop -1 }
-    T{ ##branch }
-} 3 test-bb
-
-V{
-    T{ ##peek f V int-regs 1 D 0 }
-    T{ ##branch }
-} 4 test-bb
-
-V{
-    T{ ##epilogue }
-    T{ ##return }
-} 5 test-bb
-
-[ t ] [ 0 get kill-block? ] unit-test
-[ t ] [ 3 get kill-block? ] unit-test
-
-0 get 1 get 1vector >>successors drop
-1 get 2 get 3 get V{ } 2sequence >>successors drop
-2 get 4 get 1vector >>successors drop
-3 get 4 get 1vector >>successors drop
-4 get 5 get 1vector >>successors drop
-
-[ ] [ test-global-dcn ] unit-test
-
-[ t ] [ D 1 2 get avail-out key? ] unit-test
-[ f ] [ D 1 3 get peek-out key? ] unit-test
-[ f ] [ D 1 3 get avail-out key? ] unit-test
-[ f ] [ D 1 4 get avail-in key? ] unit-test
-
-[ { D 1 } ] [ 0 get 1 get inserting-peeks' ] unit-test
-[ { } ] [ 1 get 2 get inserting-peeks' ] unit-test
-[ { } ] [ 1 get 3 get inserting-peeks' ] unit-test
-[ { } ] [ 2 get 4 get inserting-peeks' ] unit-test
-[ { D 0 } ] [ 3 get 4 get inserting-peeks' ] unit-test
-
-V{
-    T{ ##prologue }
-    T{ ##branch }
-} 0 test-bb
-
-V{
-    T{ ##peek f V int-regs 0 D 0 }
-    T{ ##branch }
-} 1 test-bb
-
-V{ T{ ##epilogue } T{ ##return } } 2 test-bb
-
-V{ T{ ##branch } } 3 test-bb
-
-0 get 1 get 1vector >>successors drop
-1 get 2 get 3 get V{ } 2sequence >>successors drop
-3 get 1 get 1vector >>successors drop
-
-[ ] [ test-global-dcn ] unit-test
-
-[ t ] [ D 0 1 get avail-out key? ] unit-test
-
-[ { D 0 } ] [ 0 get 1 get inserting-peeks' ] unit-test
-[ { } ] [ 1 get 2 get inserting-peeks' ] unit-test
-[ { } ] [ 1 get 3 get inserting-peeks' ] unit-test
-[ { } ] [ 3 get 1 get inserting-peeks' ] unit-test
-
-V{
-    T{ ##prologue }
-    T{ ##branch }
-} 0 test-bb
-
-V{
-    T{ ##branch }
-} 1 test-bb
-
-V{
-    T{ ##call f drop }
-    T{ ##branch }
-} 2 test-bb
-
-V{
-    T{ ##branch }
-} 3 test-bb
-
-V{
-    T{ ##peek f V int-regs 0 D 0 }
-    T{ ##branch }
-} 4 test-bb
-
-V{
-    T{ ##peek f V int-regs 1 D 0 }
-    T{ ##branch }
-} 5 test-bb
-
-V{
-    T{ ##epilogue }
-    T{ ##return }
-} 6 test-bb
-
-0 get 1 get 1vector >>successors drop
-1 get 2 get 3 get V{ } 2sequence >>successors drop
-2 get 4 get 1vector >>successors drop
-3 get 4 get 1vector >>successors drop
-4 get 5 get 1vector >>successors drop
-5 get 6 get 1vector >>successors drop
-
-[ ] [ test-global-dcn ] unit-test
-
-[ { } ] [ 0 get 1 get inserting-peeks' ] unit-test
-[ { } ] [ 1 get 2 get inserting-peeks' ] unit-test
-[ { } ] [ 3 get 4 get inserting-peeks' ] unit-test
-[ { D 0 } ] [ 2 get 4 get inserting-peeks' ] unit-test
-[ { D 0 } ] [ 1 get 3 get inserting-peeks' ] unit-test
-[ { } ] [ 4 get 5 get inserting-peeks' ] unit-test
-[ { } ] [ 5 get 6 get inserting-peeks' ] unit-test
-
-V{
-    T{ ##prologue }
-    T{ ##branch }
-} 0 test-bb
-
-V{
-    T{ ##branch }
-} 1 test-bb
-
-V{
-    T{ ##load-immediate f V int-regs 1 100 }
-    T{ ##replace f V int-regs 1 D 0 }
-    T{ ##branch }
-} 2 test-bb
-
-V{
-    T{ ##peek f V int-regs 2 D 0 }
-    T{ ##branch }
-} 3 test-bb
-
-V{
-    T{ ##peek f V int-regs 0 D 0 }
-    T{ ##branch }
-} 4 test-bb
-
-V{
-    T{ ##epilogue }
-    T{ ##return }
-} 5 test-bb
-
-0 get 1 get 1vector >>successors drop
-1 get 2 get 3 get V{ } 2sequence >>successors drop
-2 get 4 get 1vector >>successors drop
-3 get 4 get 1vector >>successors drop
-4 get 5 get 1vector >>successors drop
-
-[ ] [ test-global-dcn ] unit-test
-
-[ { } ] [ 1 get 2 get inserting-peeks' ] unit-test
-[ { } ] [ 1 get 2 get inserting-replaces' ] unit-test
-[ { D 0 } ] [ 1 get 3 get inserting-peeks' ] unit-test
-[ { } ] [ 1 get 3 get inserting-replaces' ] unit-test
-[ { } ] [ 2 get 4 get inserting-peeks' ] unit-test
-[ { D 0 } ] [ 2 get 4 get inserting-replaces' ] unit-test
-[ { } ] [ 3 get 4 get inserting-peeks' ] unit-test
-[ { } ] [ 3 get 4 get inserting-replaces' ] unit-test
-[ { } ] [ 4 get 5 get inserting-peeks' ] unit-test
-[ { } ] [ 4 get 5 get inserting-replaces' ] unit-test
-
-V{
-    T{ ##prologue }
-    T{ ##branch }
-} 0 test-bb
-
-V{
-    T{ ##branch }
-} 1 test-bb
-
-V{
-    T{ ##load-immediate f V int-regs 1 100 }
-    T{ ##replace f V int-regs 1 D 0 }
-    T{ ##branch }
-} 2 test-bb
-
-V{
-    T{ ##load-immediate f V int-regs 2 100 }
-    T{ ##replace f V int-regs 2 D 0 }
-    T{ ##branch }
-} 3 test-bb
-
-V{
-    T{ ##branch }
-} 4 test-bb
-
-V{
-    T{ ##epilogue }
-    T{ ##return }
-} 5 test-bb
-
-0 get 1 get 1vector >>successors drop
-1 get 2 get 3 get V{ } 2sequence >>successors drop
-2 get 4 get 1vector >>successors drop
-3 get 4 get 1vector >>successors drop
-4 get 5 get 1vector >>successors drop
-
-[ ] [ test-global-dcn ] unit-test
-
-[ { } ] [ 2 get 4 get inserting-replaces' ] unit-test
-
-[ { } ] [ 3 get 4 get inserting-replaces' ] unit-test
-
-[ { D 0 } ] [ 4 get 5 get inserting-replaces' ] unit-test
-
-! Dead replace elimination
-V{
-    T{ ##prologue }
-    T{ ##branch }
-} 0 test-bb
-
-V{
-    T{ ##peek f V int-regs 0 D 0 }
-    T{ ##peek f V int-regs 1 D 1 }
-    T{ ##replace f V int-regs 1 D 0 }
-    T{ ##replace f V int-regs 0 D 1 }
-    T{ ##branch }
-} 1 test-bb
-
-V{
-    T{ ##inc-d f -2 }
-    T{ ##branch }
-} 2 test-bb
-
-V{
-    T{ ##epilogue }
-    T{ ##return }
-} 3 test-bb
-
-0 get 1 get 1vector >>successors drop
-1 get 2 get 1vector >>successors drop
-2 get 3 get 1vector >>successors drop
-
-[ ] [ test-global-dcn ] unit-test
-
-[ { } ] [ 0 get 1 get inserting-replaces' ] unit-test
-[ { } ] [ 1 get 2 get inserting-replaces' ] unit-test
-[ { } ] [ 2 get 3 get inserting-replaces' ] unit-test
-
-! More dead replace elimination tests
-V{
-    T{ ##prologue }
-    T{ ##branch }
-} 0 test-bb
-
-V{    
-    T{ ##peek { dst V int-regs 10 } { loc D 0 } }
-    T{ ##inc-d { n -1 } }
-    T{ ##inc-r { n 1 } }
-    T{ ##replace { src V int-regs 10 } { loc R 0 } }
-    T{ ##peek { dst V int-regs 12 } { loc R 0 } }
-    T{ ##inc-r { n -1 } }
-    T{ ##inc-d { n 1 } }
-    T{ ##replace { src V int-regs 12 } { loc D 0 } }
-    T{ ##branch }
-} 1 test-bb
-
-V{
-    T{ ##epilogue }
-    T{ ##return }
-} 2 test-bb
-
-0 get 1 get 1vector >>successors drop
-1 get 2 get 1vector >>successors drop
-
-[ ] [ test-global-dcn ] unit-test
-
-[ { } ] [ 1 get 2 get inserting-replaces' ] unit-test
-
-! Check that retain stack usage works
-V{
-    T{ ##prologue }
-    T{ ##branch }
-} 0 test-bb
-
-V{
-    T{ ##peek f V int-regs 0 D 0 }
-    T{ ##inc-d f -1 }
-    T{ ##inc-r f 1 }
-    T{ ##replace f V int-regs 0 R 0 }
-    T{ ##branch }
-} 1 test-bb
-
-V{
-    T{ ##call f + -1 }
-    T{ ##branch }
-} 2 test-bb
-
-V{
-    T{ ##peek f V int-regs 0 R 0 }
-    T{ ##inc-r f -1 }
-    T{ ##inc-d f 1 }
-    T{ ##replace f V int-regs 0 D 0 }
-    T{ ##branch }
-} 3 test-bb
-
-V{
-    T{ ##epilogue }
-    T{ ##return }
-} 4 test-bb
-
-0 get 1 get 1vector >>successors drop
-1 get 2 get 1vector >>successors drop
-2 get 3 get 1vector >>successors drop
-3 get 4 get 1vector >>successors drop
-
-[ ] [ test-global-dcn ] unit-test
-
-[ ##replace D 0 ] [
-    3 get successors>> first instructions>> first
-    [ class ] [ loc>> ] bi
-] unit-test
-
-[ ##replace R 0 ] [
-    1 get successors>> first instructions>> first
-    [ class ] [ loc>> ] bi
-] unit-test
-
-[ ##peek R 0 ] [
-    2 get successors>> first instructions>> first
-    [ class ] [ loc>> ] bi
-] unit-test
\ No newline at end of file
diff --git a/basis/compiler/cfg/dcn/dcn.factor b/basis/compiler/cfg/dcn/dcn.factor
deleted file mode 100644
index e2e52b30d5..0000000000
--- a/basis/compiler/cfg/dcn/dcn.factor
+++ /dev/null
@@ -1,44 +0,0 @@
-! Copyright (C) 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: combinators
-compiler.cfg
-compiler.cfg.dcn.height
-compiler.cfg.dcn.local
-compiler.cfg.dcn.global
-compiler.cfg.dcn.rewrite ;
-IN: compiler.cfg.dcn
-
-! "DeConcatenatizatioN" -- dataflow analysis to recover registers
-! from stack locations.
-
-! Local sets:
-! - P(b): locations that block b peeks before replacing
-! - R(b): locations that block b replaces
-! - A(b): P(b) \/ R(b) -- locations that are available in registers at the end of b
-
-! Global sets:
-! - P_out(b) = /\ P_in(sux) for sux in successors(b)
-! - P_in(b) = (P_out(b) - R(b)) \/ P(b)
-!
-! - R_in(b) = R_out(b) \/ R(b)
-! - R_out(b) = \/ R_in(sux) for sux in successors(b)
-!
-! - A_in(b) = /\ A_out(pred) for pred in predecessors(b)
-! - A_out(b) = A_in(b) \/ P(b) \/ R(b)
-
-! On every edge [b --> sux], insert a replace for each location in
-! R_out(b) - R_in(sux)
-
-! On every edge [pred --> b], insert a peek for each location in
-! P_in(b) - (P_out(pred) \/ A_out(pred))
-
-! Locations are height-normalized.
-
-: deconcatenatize ( cfg -- cfg' )
-    {
-        [ compute-heights ]
-        [ compute-local-sets ]
-        [ compute-global-sets ]
-        [ rewrite ]
-        [ cfg-changed ]
-    } cleave ;
\ No newline at end of file
diff --git a/basis/compiler/cfg/dcn/height/height.factor b/basis/compiler/cfg/dcn/height/height.factor
deleted file mode 100644
index 1a59ddcb35..0000000000
--- a/basis/compiler/cfg/dcn/height/height.factor
+++ /dev/null
@@ -1,82 +0,0 @@
-! Copyright (C) 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces assocs accessors sequences kernel math locals fry
-compiler.cfg.instructions compiler.cfg.rpo compiler.cfg.registers ;
-IN: compiler.cfg.dcn.height
-
-! Compute block in-height and out-height sets. These are relative to the
-! stack height from the start of the procedure.
-
-<PRIVATE
-
-SYMBOLS: in-ds-heights out-ds-heights in-rs-heights out-rs-heights ;
-
-GENERIC: ds-height-change ( insn -- n )
-
-M: insn ds-height-change drop 0 ;
-
-M: ##inc-d ds-height-change n>> ;
-
-M: ##call ds-height-change height>> ;
-
-: alien-node-height ( node -- n )
-    params>> [ out-d>> length ] [ in-d>> length ] bi - ;
-
-M: ##alien-invoke ds-height-change alien-node-height ;
-
-M: ##alien-indirect ds-height-change alien-node-height ;
-
-GENERIC: rs-height-change ( insn -- n )
-
-M: insn rs-height-change drop 0 ;
-
-M: ##inc-r rs-height-change n>> ;
-
-:: compute-in-height ( bb in out -- )
-    bb predecessors>> [ out at ] map-find drop 0 or
-    bb in set-at ;
-
-:: compute-out-height ( bb in out quot -- )
-    bb instructions>>
-    bb in at
-    [ quot call + ] reduce
-    bb out set-at ; inline
-
-:: compute-height ( bb in out quot -- )
-    bb in get out get
-    [ compute-in-height ]
-    [ quot compute-out-height ] 3bi ; inline
-
-: compute-ds-height ( bb -- )
-    in-ds-heights out-ds-heights [ ds-height-change ] compute-height ;
-
-: compute-rs-height ( bb -- )
-    in-rs-heights out-rs-heights [ rs-height-change ] compute-height ;
-
-PRIVATE>
-
-: compute-heights ( cfg -- )
-    H{ } clone in-ds-heights set
-    H{ } clone out-ds-heights set
-    H{ } clone in-rs-heights set
-    H{ } clone out-rs-heights set
-    [
-        [ compute-rs-height ]
-        [ compute-ds-height ] bi
-    ] each-basic-block ;
-
-GENERIC# translate-loc 1 ( loc bb -- loc' )
-
-M: ds-loc translate-loc [ n>> ] [ in-ds-heights get at ] bi* - <ds-loc> ;
-M: rs-loc translate-loc [ n>> ] [ in-rs-heights get at ] bi* - <rs-loc> ;
-
-: translate-locs ( assoc bb -- assoc' )
-    '[ [ _ translate-loc ] dip ] assoc-map ;
-
-GENERIC# untranslate-loc 1 ( loc bb -- loc' )
-
-M: ds-loc untranslate-loc [ n>> ] [ in-ds-heights get at ] bi* + <ds-loc> ;
-M: rs-loc untranslate-loc [ n>> ] [ in-rs-heights get at ] bi* + <rs-loc> ;
-
-: untranslate-locs ( assoc bb -- assoc' )
-    '[ [ _ untranslate-loc ] dip ] assoc-map ;
diff --git a/basis/compiler/cfg/dcn/local/local.factor b/basis/compiler/cfg/dcn/local/local.factor
deleted file mode 100644
index 3ed543f868..0000000000
--- a/basis/compiler/cfg/dcn/local/local.factor
+++ /dev/null
@@ -1,101 +0,0 @@
-! Copyright (C) 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs kernel make namespaces sequences math
-compiler.cfg.rpo compiler.cfg.registers compiler.cfg.instructions
-compiler.cfg.dcn.height ;
-IN: compiler.cfg.dcn.local
-
-<PRIVATE
-
-SYMBOL: copies
-
-: record-copy ( dst src -- ) swap copies get set-at ;
-
-: resolve-copy ( vreg -- vreg' ) copies get ?at drop ;
-
-SYMBOLS: reads-locations writes-locations ;
-
-: loc>vreg ( loc -- vreg )
-    dup writes-locations get at
-    [ ] [ reads-locations get at ] ?if ;
-
-SYMBOL: ds-height
-
-SYMBOL: rs-height
-
-GENERIC: translate-loc ( loc -- loc' )
-
-M: ds-loc translate-loc n>> ds-height get - <ds-loc> ;
-
-M: rs-loc translate-loc n>> rs-height get - <rs-loc> ;
-
-GENERIC: visit ( insn -- )
-
-M: insn visit , ;
-
-M: ##inc-d visit n>> ds-height [ + ] change ;
-
-M: ##inc-r visit n>> rs-height [ + ] change ;
-
-M: ##peek visit
-    ! If location is in a register already, copy existing
-    ! register to destination. Otherwise, associate the
-    ! location with the register.
-    [ dst>> ] [ loc>> translate-loc ] bi dup loc>vreg
-    [ [ record-copy ] [ ##copy ] 2bi ]
-    [ reads-locations get set-at ]
-    ?if ;
-
-M: ##replace visit
-    ! If location already contains the same value, do nothing.
-    ! Otherwise, associate the location with the register.
-    [ src>> resolve-copy ] [ loc>> translate-loc ] bi 2dup loc>vreg =
-    [ 2drop ] [ writes-locations get set-at ] if ;
-
-M: ##copy visit
-    ! Not needed at this point because IR doesn't have ##copy
-    ! on input to dcn pass, but in the future it might.
-    [ dst>> ] [ src>> resolve-copy ] bi record-copy ;
-
-: insert-height-changes ( -- )
-    ds-height get dup 0 = [ drop ] [ ##inc-d ] if
-    rs-height get dup 0 = [ drop ] [ ##inc-r ] if ;
-
-: init-local-analysis ( -- )
-    0 ds-height set
-    0 rs-height set
-    H{ } clone copies set
-    H{ } clone reads-locations set
-    H{ } clone writes-locations set ;
-
-: local-analysis ( bb -- )
-    ! Removes all ##peek and ##replace from the basic block.
-    ! Conceptually, moves all ##peeks to the start
-    ! (reads-locations assoc) and all ##replaces to the end
-    ! (writes-locations assoc).
-    init-local-analysis
-    [
-        [
-            unclip-last-slice [ [ visit ] each ] dip
-            insert-height-changes
-            ,
-        ] V{ } make
-    ] change-instructions drop ;
-
-SYMBOLS: peeks replaces ;
-
-: visit-block ( bb -- )
-    [ local-analysis ]
-    [ [ reads-locations get ] dip [ translate-locs ] keep peeks get set-at ]
-    [ [ writes-locations get ] dip [ translate-locs ] keep replaces get set-at ]
-    tri ;
-
-PRIVATE>
-
-: peek ( bb -- assoc ) peeks get at ;
-: replace ( bb -- assoc ) replaces get at ;
-
-: compute-local-sets ( cfg -- )
-    H{ } clone peeks set
-    H{ } clone replaces set
-    [ visit-block ] each-basic-block ;
\ No newline at end of file
diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index 2496b29ae2..07ebcc3ba9 100644
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -52,7 +52,7 @@ INSN: ##inc-d { n integer } ;
 INSN: ##inc-r { n integer } ;
 
 ! Subroutine calls
-INSN: ##call word { height integer } ;
+INSN: ##call word ;
 INSN: ##jump word ;
 INSN: ##return ;
 
diff --git a/basis/compiler/cfg/intrinsics/alien/alien.factor b/basis/compiler/cfg/intrinsics/alien/alien.factor
index 42e23c29c9..04d841f2d1 100644
--- a/basis/compiler/cfg/intrinsics/alien/alien.factor
+++ b/basis/compiler/cfg/intrinsics/alien/alien.factor
@@ -1,10 +1,9 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel sequences alien math classes.algebra
-fry locals combinators cpu.architecture
-compiler.tree.propagation.info
+USING: accessors kernel sequences alien math classes.algebra fry
+locals combinators cpu.architecture compiler.tree.propagation.info
 compiler.cfg.hats compiler.cfg.stacks compiler.cfg.instructions
-compiler.cfg.utilities ;
+compiler.cfg.utilities compiler.cfg.builder.blocks ;
 IN: compiler.cfg.intrinsics.alien
 
 : (prepare-alien-accessor-imm) ( class offset -- offset-vreg )
diff --git a/basis/compiler/cfg/intrinsics/allot/allot.factor b/basis/compiler/cfg/intrinsics/allot/allot.factor
index 7b407c3ee4..8afd9f80ca 100644
--- a/basis/compiler/cfg/intrinsics/allot/allot.factor
+++ b/basis/compiler/cfg/intrinsics/allot/allot.factor
@@ -1,10 +1,10 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math math.order sequences accessors arrays
 byte-arrays layouts classes.tuple.private fry locals
 compiler.tree.propagation.info compiler.cfg.hats
 compiler.cfg.instructions compiler.cfg.stacks
-compiler.cfg.utilities ;
+compiler.cfg.utilities compiler.cfg.builder.blocks ;
 IN: compiler.cfg.intrinsics.allot
 
 : ##set-slots ( regs obj class -- )
diff --git a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
index cfc07624fe..0eeeb0b12d 100644
--- a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
+++ b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
@@ -7,6 +7,7 @@ compiler.cfg.hats
 compiler.cfg.stacks
 compiler.cfg.instructions
 compiler.cfg.utilities
+compiler.cfg.builder.blocks
 compiler.cfg.registers
 compiler.cfg.comparisons ;
 IN: compiler.cfg.intrinsics.fixnum
@@ -31,7 +32,7 @@ IN: compiler.cfg.intrinsics.fixnum
     [ ^^untag-fixnum ^^neg ^^sar dup tag-mask get ^^and-imm ^^xor ] emit-fixnum-op ;
 
 : emit-fixnum-shift-general ( -- )
-    D 0 ^^peek 0 cc> ##compare-imm-branch
+    ds-peek 0 cc> ##compare-imm-branch
     [ emit-fixnum-left-shift ] with-branch
     [ emit-fixnum-right-shift ] with-branch
     2array emit-conditional ;
@@ -62,13 +63,13 @@ IN: compiler.cfg.intrinsics.fixnum
     ds-pop ^^untag-fixnum ^^integer>bignum ds-push ;
 
 : emit-no-overflow-case ( dst -- final-bb )
-    [ -2 ##inc-d ds-push ] with-branch ;
+    [ ds-drop ds-drop ds-push ] with-branch ;
 
 : emit-overflow-case ( word -- final-bb )
-    [ -1 ##call ] with-branch ;
+    [ ##call -1 adjust-d ] with-branch ;
 
 : emit-fixnum-overflow-op ( quot word -- )
-    [ [ D 1 ^^peek D 0 ^^peek ] dip call ] dip
+    [ [ (2inputs) ] dip call ] dip
     [ emit-no-overflow-case ] [ emit-overflow-case ] bi* 2array
     emit-conditional ; inline
 
diff --git a/basis/compiler/cfg/intrinsics/slots/slots.factor b/basis/compiler/cfg/intrinsics/slots/slots.factor
index 0cc6e6f5d0..93139a19a3 100644
--- a/basis/compiler/cfg/intrinsics/slots/slots.factor
+++ b/basis/compiler/cfg/intrinsics/slots/slots.factor
@@ -1,9 +1,9 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: layouts namespaces kernel accessors sequences
 classes.algebra compiler.tree.propagation.info
 compiler.cfg.stacks compiler.cfg.hats compiler.cfg.instructions
-compiler.cfg.utilities ;
+compiler.cfg.utilities compiler.cfg.builder.blocks ;
 IN: compiler.cfg.intrinsics.slots
 
 : value-tag ( info -- n ) class>> class-tag ; inline
diff --git a/basis/compiler/cfg/linearization/linearization.factor b/basis/compiler/cfg/linearization/linearization.factor
index 1f00913b1e..f9e0e54afc 100755
--- a/basis/compiler/cfg/linearization/linearization.factor
+++ b/basis/compiler/cfg/linearization/linearization.factor
@@ -25,11 +25,12 @@ M: insn linearize-insn , drop ;
     #! don't need to branch.
     [ number>> ] bi@ 1 - = ; inline
 
-: emit-loop-entry? ( bb -- ? )
-    dup predecessors>> [ swap back-edge? ] with any? ;
+: emit-loop-entry? ( bb successor -- ? )
+    [ back-edge? not ]
+    [ nip dup predecessors>> [ swap back-edge? ] with any? ] 2bi and ;
 
 : emit-branch ( bb successor -- )
-    dup emit-loop-entry? [ _loop-entry ] when
+    2dup emit-loop-entry? [ _loop-entry ] when
     2dup useless-branch? [ 2drop ] [ nip number>> _branch ] if ;
 
 M: ##branch linearize-insn
diff --git a/basis/compiler/cfg/optimizer/optimizer.factor b/basis/compiler/cfg/optimizer/optimizer.factor
index 0b37157b43..e4ad290097 100644
--- a/basis/compiler/cfg/optimizer/optimizer.factor
+++ b/basis/compiler/cfg/optimizer/optimizer.factor
@@ -4,7 +4,6 @@ USING: kernel sequences accessors combinators namespaces
 compiler.cfg.tco
 compiler.cfg.predecessors
 compiler.cfg.useless-conditionals
-compiler.cfg.dcn
 compiler.cfg.ssa
 compiler.cfg.branch-splitting
 compiler.cfg.block-joining
@@ -35,7 +34,6 @@ SYMBOL: check-optimizer?
         split-branches
         join-blocks
         compute-predecessors
-        deconcatenatize
         construct-ssa
         alias-analysis
         value-numbering
diff --git a/basis/compiler/cfg/dcn/rewrite/rewrite.factor b/basis/compiler/cfg/stacks/finalize/finalize.factor
similarity index 51%
rename from basis/compiler/cfg/dcn/rewrite/rewrite.factor
rename to basis/compiler/cfg/stacks/finalize/finalize.factor
index bbc6783f79..5c8c1343d0 100644
--- a/basis/compiler/cfg/dcn/rewrite/rewrite.factor
+++ b/basis/compiler/cfg/stacks/finalize/finalize.factor
@@ -2,13 +2,11 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces assocs kernel fry accessors sequences make math
 combinators compiler.cfg compiler.cfg.hats compiler.cfg.instructions
-compiler.cfg.utilities compiler.cfg.rpo compiler.cfg.dcn.local
-compiler.cfg.dcn.global compiler.cfg.dcn.height ;
-IN: compiler.cfg.dcn.rewrite
+compiler.cfg.utilities compiler.cfg.rpo compiler.cfg.stacks.local
+compiler.cfg.stacks.global compiler.cfg.stacks.height ;
+IN: compiler.cfg.stacks.finalize
 
-! This pass inserts peeks, replaces, and copies. All stack locations
-! are loaded to canonical vregs, with a 1-1 mapping from location to
-! vreg. SSA is reconstructed afterwards.
+! This pass inserts peeks and replaces.
 
 : inserting-peeks ( from to -- assoc )
     peek-in swap [ peek-out ] [ avail-out ] bi
@@ -18,10 +16,6 @@ IN: compiler.cfg.dcn.rewrite
     [ replace-out ] [ [ kill-in ] [ replace-in ] bi ] bi*
     assoc-union assoc-diff ;
 
-SYMBOL: locs>vregs
-
-: loc>vreg ( loc -- vreg ) locs>vregs get [ drop i ] cache ;
-
 : each-insertion ( assoc bb quot: ( vreg loc -- ) -- )
     '[ drop [ loc>vreg ] [ _ untranslate-loc ] bi @ ] assoc-each ; inline
 
@@ -39,30 +33,9 @@ ERROR: bad-peek dst loc ;
     2dup [ [ insert-peeks ] [ insert-replaces ] 2bi ] V{ } make
     [ 2drop ] [ <simple-block> insert-basic-block ] if-empty ;
 
-: visit-edges ( bb -- )
+: visit-block ( bb -- )
     [ predecessors>> ] keep '[ _ visit-edge ] each ;
 
-: insert-in-copies ( bb -- )
-    peek [ swap loc>vreg ##copy ] assoc-each ;
-
-: insert-out-copies ( bb -- )
-    replace [ swap loc>vreg swap ##copy ] assoc-each ;
-
-: rewrite-instructions ( bb -- )
-    [
-        [
-            {
-                [ insert-in-copies ]
-                [ instructions>> but-last-slice % ]
-                [ insert-out-copies ]
-                [ instructions>> last , ]
-            } cleave
-        ] V{ } make
-    ] keep (>>instructions) ;
-
-: visit-block ( bb -- )
-    [ visit-edges ] [ rewrite-instructions ] bi ;
-
-: rewrite ( cfg -- )
-    H{ } clone locs>vregs set
-    [ visit-block ] each-basic-block ;
\ No newline at end of file
+: finalize-stack-shuffling ( cfg -- cfg' )
+    dup [ visit-block ] each-basic-block
+    cfg-changed ;
\ No newline at end of file
diff --git a/basis/compiler/cfg/dcn/global/global.factor b/basis/compiler/cfg/stacks/global/global.factor
similarity index 65%
rename from basis/compiler/cfg/dcn/global/global.factor
rename to basis/compiler/cfg/stacks/global/global.factor
index 21a795151a..129d7e74cd 100644
--- a/basis/compiler/cfg/dcn/global/global.factor
+++ b/basis/compiler/cfg/stacks/global/global.factor
@@ -1,38 +1,39 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs kernel combinators compiler.cfg.dataflow-analysis
-compiler.cfg.dcn.local ;
-IN: compiler.cfg.dcn.global
+compiler.cfg.stacks.local ;
+IN: compiler.cfg.stacks.global
 
 ! Peek analysis. Peek-in is the set of all locations anticipated at
 ! the start of a basic block.
 BACKWARD-ANALYSIS: peek
 
-M: peek-analysis transfer-set drop [ replace assoc-diff ] keep peek assoc-union ;
+M: peek-analysis transfer-set drop [ replace-set assoc-diff ] keep peek-set assoc-union ;
 
 ! Replace analysis. Replace-in is the set of all locations which
 ! will be overwritten at some point after the start of a basic block.
 FORWARD-ANALYSIS: replace
 
-M: replace-analysis transfer-set drop replace assoc-union ;
+M: replace-analysis transfer-set drop replace-set assoc-union ;
 
 ! Availability analysis. Avail-out is the set of all locations
 ! in registers at the end of a basic block.
 FORWARD-ANALYSIS: avail
 
-M: avail-analysis transfer-set drop [ peek ] [ replace ] bi assoc-union assoc-union ;
+M: avail-analysis transfer-set drop [ peek-set ] [ replace-set ] bi assoc-union assoc-union ;
 
 ! Kill analysis. Kill-in is the set of all locations
 ! which are going to be overwritten.
 BACKWARD-ANALYSIS: kill
 
-M: kill-analysis transfer-set drop replace assoc-union ;
+M: kill-analysis transfer-set drop replace-set assoc-union ;
 
 ! Main word
-: compute-global-sets ( cfg -- )
+: compute-global-sets ( cfg -- cfg' )
     {
         [ compute-peek-sets ]
         [ compute-replace-sets ]
         [ compute-avail-sets ]
         [ compute-kill-sets ]
+        [ ]
     } cleave ;
\ No newline at end of file
diff --git a/basis/compiler/cfg/stacks/height/height.factor b/basis/compiler/cfg/stacks/height/height.factor
new file mode 100644
index 0000000000..4d91dc614a
--- /dev/null
+++ b/basis/compiler/cfg/stacks/height/height.factor
@@ -0,0 +1,27 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs fry kernel math
+namespaces compiler.cfg.registers ;
+IN: compiler.cfg.stacks.height
+
+! Global stack height tracking done while constructing CFG.
+SYMBOLS: ds-heights rs-heights ;
+
+: record-stack-heights ( ds-height rs-height bb -- )
+    [ ds-heights get set-at ] [ rs-heights get set-at ] bi-curry bi* ;
+
+GENERIC# translate-loc 1 ( loc bb -- loc' )
+
+M: ds-loc translate-loc [ n>> ] [ ds-heights get at ] bi* - <ds-loc> ;
+M: rs-loc translate-loc [ n>> ] [ rs-heights get at ] bi* - <rs-loc> ;
+
+: translate-locs ( assoc bb -- assoc' )
+    '[ [ _ translate-loc ] dip ] assoc-map ;
+
+GENERIC# untranslate-loc 1 ( loc bb -- loc' )
+
+M: ds-loc untranslate-loc [ n>> ] [ ds-heights get at ] bi* + <ds-loc> ;
+M: rs-loc untranslate-loc [ n>> ] [ rs-heights get at ] bi* + <rs-loc> ;
+
+: untranslate-locs ( assoc bb -- assoc' )
+    '[ [ _ untranslate-loc ] dip ] assoc-map ;
\ No newline at end of file
diff --git a/basis/compiler/cfg/stacks/local/local.factor b/basis/compiler/cfg/stacks/local/local.factor
new file mode 100644
index 0000000000..a484464a59
--- /dev/null
+++ b/basis/compiler/cfg/stacks/local/local.factor
@@ -0,0 +1,80 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs kernel math namespaces sets make sequences
+compiler.cfg compiler.cfg.hats
+compiler.cfg.instructions compiler.cfg.registers
+compiler.cfg.stacks.height ;
+IN: compiler.cfg.stacks.local
+
+! Local stack analysis. We build local peek and replace sets for every basic
+! block while constructing the CFG.
+
+SYMBOLS: peek-sets replace-sets ;
+
+SYMBOL: locs>vregs
+
+: loc>vreg ( loc -- vreg ) locs>vregs get [ drop i ] cache ;
+
+TUPLE: current-height { d initial: 0 } { r initial: 0 } { emit-d initial: 0 } { emit-r initial: 0 } ;
+
+SYMBOLS: copies local-peek-set local-replace-set ;
+
+: record-copy ( dst src -- ) swap copies get set-at ;
+: resolve-copy ( vreg -- vreg' ) copies get ?at drop ;
+
+GENERIC: translate-local-loc ( loc -- loc' )
+M: ds-loc translate-local-loc n>> current-height get d>> - <ds-loc> ;
+M: rs-loc translate-local-loc n>> current-height get r>> - <rs-loc> ;
+
+: emit-height-changes ( -- )
+    ! Insert height changes prior to the last instruction
+    building get pop
+    current-height get
+    [ emit-d>> dup 0 = [ drop ] [ ##inc-d ] if ]
+    [ emit-r>> dup 0 = [ drop ] [ ##inc-r ] if ] bi
+    , ;
+
+! inc-d/inc-r: these emit ##inc-d/##inc-r to change the stack height later
+: inc-d ( n -- )
+    current-height get
+    [ [ + ] change-emit-d drop ]
+    [ [ + ] change-d drop ]
+    2bi ;
+
+: inc-r ( n -- )
+    current-height get
+    [ [ + ] change-emit-r drop ]
+    [ [ + ] change-r drop ]
+    2bi ;
+
+: peek-loc ( loc -- vreg )
+    translate-local-loc
+    [ dup local-replace-set get key? [ drop ] [ local-peek-set get conjoin ] if ]
+    [ loc>vreg [ i ] dip [ record-copy ] [ ##copy ] [ drop ] 2tri ]
+    bi ;
+
+: replace-loc ( vreg loc -- )
+    translate-local-loc
+    2dup [ resolve-copy ] dip loc>vreg = [ 2drop ] [
+        [ local-replace-set get conjoin ]
+        [ loc>vreg swap ##copy ]
+        bi
+    ] if ;
+
+: begin-local-analysis ( -- )
+    H{ } clone copies set
+    H{ } clone local-peek-set set
+    H{ } clone local-replace-set set
+    current-height get 0 >>emit-d 0 >>emit-r drop
+    current-height get [ d>> ] [ r>> ] bi basic-block get record-stack-heights ;
+
+: end-local-analysis ( -- )
+    emit-height-changes
+    local-peek-set get basic-block get peek-sets get set-at
+    local-replace-set get basic-block get replace-sets get set-at ;
+
+: clone-current-height ( -- )
+    current-height [ clone ] change ;
+
+: peek-set ( bb -- assoc ) peek-sets get at ;
+: replace-set ( bb -- assoc ) replace-sets get at ;
diff --git a/basis/compiler/cfg/stacks/stacks.factor b/basis/compiler/cfg/stacks/stacks.factor
index c8fcae87c0..f68b70467a 100755
--- a/basis/compiler/cfg/stacks/stacks.factor
+++ b/basis/compiler/cfg/stacks/stacks.factor
@@ -1,45 +1,76 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: math sequences kernel cpu.architecture
-compiler.cfg.instructions compiler.cfg.registers
-compiler.cfg.hats ;
+USING: math sequences kernel namespaces accessors compiler.cfg
+compiler.cfg.instructions compiler.cfg.registers compiler.cfg.hats
+compiler.cfg.predecessors compiler.cfg.stacks.local
+compiler.cfg.stacks.height compiler.cfg.stacks.global
+compiler.cfg.stacks.finalize ;
 IN: compiler.cfg.stacks
 
-: ds-drop ( -- )
-    -1 ##inc-d ;
+: begin-stack-analysis ( -- )
+    H{ } clone locs>vregs set
+    H{ } clone ds-heights set
+    H{ } clone rs-heights set
+    H{ } clone peek-sets set
+    H{ } clone replace-sets set
+    current-height new current-height set ;
 
-: ds-pop ( -- vreg )
-    D 0 ^^peek -1 ##inc-d ;
+: end-stack-analysis ( -- )
+    cfg get
+    compute-predecessors
+    compute-global-sets
+    finalize-stack-shuffling
+    drop ;
 
-: ds-push ( vreg -- )
-    1 ##inc-d D 0 ##replace ;
+: ds-drop ( -- ) -1 inc-d ;
+
+: ds-peek ( -- vreg ) D 0 peek-loc ;
+
+: ds-pop ( -- vreg ) ds-peek ds-drop ;
+
+: ds-push ( vreg -- ) 1 inc-d D 0 replace-loc ;
 
 : ds-load ( n -- vregs )
     dup 0 =
     [ drop f ]
-    [ [ <reversed> [ <ds-loc> ^^peek ] map ] [ neg ##inc-d ] bi ] if ;
+    [ [ <reversed> [ <ds-loc> peek-loc ] map ] [ neg inc-d ] bi ] if ;
 
 : ds-store ( vregs -- )
     [
         <reversed>
-        [ length ##inc-d ]
-        [ [ <ds-loc> ##replace ] each-index ] bi
+        [ length inc-d ]
+        [ [ <ds-loc> replace-loc ] each-index ] bi
     ] unless-empty ;
 
+: rs-drop ( -- ) -1 inc-r ;
+
 : rs-load ( n -- vregs )
     dup 0 =
     [ drop f ]
-    [ [ <reversed> [ <rs-loc> ^^peek ] map ] [ neg ##inc-r ] bi ] if ;
+    [ [ <reversed> [ <rs-loc> peek-loc ] map ] [ neg inc-r ] bi ] if ;
 
 : rs-store ( vregs -- )
     [
         <reversed>
-        [ length ##inc-r ]
-        [ [ <rs-loc> ##replace ] each-index ] bi
+        [ length inc-r ]
+        [ [ <rs-loc> replace-loc ] each-index ] bi
     ] unless-empty ;
 
+: (2inputs) ( -- vreg1 vreg2 )
+    D 1 peek-loc D 0 peek-loc ;
+
 : 2inputs ( -- vreg1 vreg2 )
-    D 1 ^^peek D 0 ^^peek -2 ##inc-d ;
+    (2inputs) -2 inc-d ;
+
+: (3inputs) ( -- vreg1 vreg2 vreg3 )
+    D 2 peek-loc D 1 peek-loc D 0 peek-loc ;
 
 : 3inputs ( -- vreg1 vreg2 vreg3 )
-    D 2 ^^peek D 1 ^^peek D 0 ^^peek -3 ##inc-d ;
+    (3inputs) -3 inc-d ;
+
+! adjust-d/adjust-r: these are called when other instructions which
+! internally adjust the stack height are emitted, such as ##call and
+! ##alien-invoke
+: adjust-d ( n -- ) current-height get [ + ] change-d drop ;
+: adjust-r ( n -- ) current-height get [ + ] change-r drop ;
+
diff --git a/basis/compiler/cfg/utilities/utilities.factor b/basis/compiler/cfg/utilities/utilities.factor
index c3d3e47485..ad3ee9c57b 100644
--- a/basis/compiler/cfg/utilities/utilities.factor
+++ b/basis/compiler/cfg/utilities/utilities.factor
@@ -20,42 +20,6 @@ IN: compiler.cfg.utilities
         } cond
     ] [ drop f ] if ;
 
-: set-basic-block ( basic-block -- )
-    [ basic-block set ] [ instructions>> building set ] bi ;
-
-: begin-basic-block ( -- )
-    <basic-block> basic-block get [
-        dupd successors>> push
-    ] when*
-    set-basic-block ;
-
-: end-basic-block ( -- )
-    building off
-    basic-block off ;
-
-: emit-trivial-block ( quot -- )
-    basic-block get instructions>> empty? [ ##branch begin-basic-block ] unless
-    call
-    ##branch begin-basic-block ; inline
-
-: call-height ( #call -- n )
-    [ out-d>> length ] [ in-d>> length ] bi - ;
-
-: emit-primitive ( node -- )
-    [ [ word>> ] [ call-height ] bi ##call ] emit-trivial-block ;
-
-: with-branch ( quot -- final-bb )
-    [
-        begin-basic-block
-        call
-        basic-block get dup [ ##branch ] when
-    ] with-scope ; inline
-
-: emit-conditional ( branches -- )
-    end-basic-block
-    begin-basic-block
-    basic-block get '[ [ _ swap successors>> push ] when* ] each ;
-
 PREDICATE: kill-block < basic-block
     instructions>> {
         [ length 2 = ]