diff --git a/basis/compiler/cfg/builder/blocks/blocks-docs.factor b/basis/compiler/cfg/builder/blocks/blocks-docs.factor
index b8cb49a224..69186836a6 100644
--- a/basis/compiler/cfg/builder/blocks/blocks-docs.factor
+++ b/basis/compiler/cfg/builder/blocks/blocks-docs.factor
@@ -1,5 +1,5 @@
-USING: compiler.cfg compiler.tree help.markup help.syntax literals math
-multiline quotations ;
+USING: compiler.cfg compiler.cfg.stacks.local compiler.tree help.markup
+help.syntax literals math multiline quotations sequences ;
 IN: compiler.cfg.builder.blocks
 
 <<
@@ -48,8 +48,20 @@ HELP: emit-trivial-block
 { $description "Combinator that emits a trivial block, constructed by calling the supplied quotation." }
 { $examples { $unchecked-example $[ ex-emit-trivial-block ] } } ;
 
+HELP: end-branch
+{ $values { "pair/f" "two-tuple" } }
+{ $description "pair is { final-bb final-height }" } ;
+
 HELP: initial-basic-block
 { $description "Creates an initial empty " { $link basic-block } " and stores it in the basic-block dynamic variable." } ;
 
 HELP: make-kill-block
 { $description "Marks the current " { $link basic-block } " being processed as a kill block." } ;
+
+HELP: set-successors
+{ $values { "successor" basic-block } { "blocks" sequence } }
+{ $description "Set the successor of each block to " { $slot "successor" } "." } ;
+
+HELP: with-branch
+{ $values { "quot" quotation } { "pair/f" "a pair or f" } }
+{ $description "The pair is either " { $link f } " or a two-tuple containing a " { $link basic-block } " and a " { $link height-state } " two-tuple." } ;
diff --git a/basis/compiler/cfg/builder/blocks/blocks-tests.factor b/basis/compiler/cfg/builder/blocks/blocks-tests.factor
new file mode 100644
index 0000000000..6784796d81
--- /dev/null
+++ b/basis/compiler/cfg/builder/blocks/blocks-tests.factor
@@ -0,0 +1,11 @@
+USING: accessors compiler.cfg compiler.cfg.builder.blocks kernel sequences
+tools.test ;
+IN: compiler.cfg.builder.blocks.tests
+
+{
+    { "succ" "succ" "succ" }
+} [
+    <basic-block> "succ" >>number 3 [ <basic-block> ] replicate
+    [ set-successors ] keep
+    [ successors>> first number>> ] map
+] unit-test
diff --git a/basis/compiler/cfg/builder/blocks/blocks.factor b/basis/compiler/cfg/builder/blocks/blocks.factor
index f63eb3b6d7..f59a92cf27 100644
--- a/basis/compiler/cfg/builder/blocks/blocks.factor
+++ b/basis/compiler/cfg/builder/blocks/blocks.factor
@@ -46,29 +46,28 @@ IN: compiler.cfg.builder.blocks
         make-kill-block
     ] emit-trivial-block ;
 
-: begin-branch ( -- ) clone-current-height (begin-basic-block) ;
+: begin-branch ( -- )
+    height-state [ clone-height-state ] change
+    (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
+        height-state get clone-height-state 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 ] dip first successors>> push ] when* ] each ;
+: set-successors ( successor blocks -- )
+    [ successors>> push ] with each ;
 
 : emit-conditional ( branches -- )
     ! branches is a sequence of pairs as above
     end-basic-block
-    dup [ ] find nip dup [
-        second current-height set
+    sift [
+        dup first second height-state set
         begin-basic-block
-        set-successors
-    ] [ 2drop ] if ;
+        [ basic-block get ] dip [ first ] map set-successors
+    ] unless-empty ;
diff --git a/basis/compiler/cfg/builder/builder-docs.factor b/basis/compiler/cfg/builder/builder-docs.factor
index fd4c696921..596600743a 100644
--- a/basis/compiler/cfg/builder/builder-docs.factor
+++ b/basis/compiler/cfg/builder/builder-docs.factor
@@ -8,21 +8,23 @@ STRING: ex-emit-call
 USING: compiler.cfg.builder compiler.cfg.builder.blocks compiler.cfg.stacks
 kernel make prettyprint ;
 begin-stack-analysis initial-basic-block \ dummy 3 [ emit-call ] { } make drop
-current-height basic-block [ get . ] bi@ .
-T{ current-height { d 3 } }
+height-state basic-block [ get . ] bi@
+{ { 3 0 } { 0 0 } }
 T{ basic-block
-    { id 134 }
+    { id 1903165 }
     { successors
         V{
             T{ basic-block
-                { id 135 }
+                { id 1903166 }
                 { instructions
                     V{
                         T{ ##call { word dummy } }
                         T{ ##branch }
                     }
                 }
-                { successors V{ T{ basic-block { id 136 } } } }
+                { successors
+                    V{ T{ basic-block { id 1903167 } } }
+                }
                 { kill-block? t }
             }
         }
@@ -51,7 +53,7 @@ HELP: make-input-map
 
 HELP: emit-call
 { $values { "word" word } { "height" number } }
-{ $description "Emits a call to the given word to the " { $link cfg } " being constructed. \"height\" is the number of items being added to or removed from the data stack. Side effects of the word is that it modifies the \"basic-block\" and " { $link current-height } " variables." }
+{ $description "Emits a call to the given word to the " { $link cfg } " being constructed. \"height\" is the number of items being added to or removed from the data stack. Side effects of the word is that it modifies the \"basic-block\" and " { $link height-state } " variables." }
 { $examples
   "In this example, a call to a dummy word is emitted which pushes three items onto the stack."
   { $unchecked-example $[ ex-emit-call ] }
diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor
index 7abfb630c6..61e3f9aaca 100644
--- a/basis/compiler/cfg/builder/builder-tests.factor
+++ b/basis/compiler/cfg/builder/builder-tests.factor
@@ -2,11 +2,12 @@ USING: accessors alien alien.accessors arrays assocs byte-arrays
 combinators.short-circuit compiler.cfg compiler.cfg.builder compiler.cfg.checker
 compiler.cfg.debugger compiler.cfg.instructions compiler.cfg.optimizer
 compiler.cfg.predecessors compiler.cfg.registers compiler.cfg.rpo
-compiler.cfg.stacks.local compiler.tree compiler.tree.builder
-compiler.tree.optimizer compiler.cfg.representations fry hashtables kernel
-kernel.private locals make math math.partial-dispatch math.private namespaces
-prettyprint sbufs sequences sequences.private slots.private strings
-strings.private  tools.test vectors words ;
+compiler.cfg.stacks compiler.cfg.stacks.local compiler.cfg.utilities
+compiler.tree compiler.tree.builder compiler.tree.optimizer
+compiler.cfg.representations fry hashtables kernel kernel.private locals make
+math math.partial-dispatch math.private namespaces prettyprint sbufs sequences
+sequences.private slots.private strings strings.private tools.test vectors
+words ;
 FROM: alien.c-types => int ;
 IN: compiler.cfg.builder.tests
 
@@ -251,8 +252,8 @@ IN: compiler.cfg.builder.tests
 {
     { T{ ##load-integer { dst 78 } { val 0 } } }
 } [
+    initial-height-state height-state set
     77 vreg-counter set-global
-    current-height new current-height set
     H{ } clone replace-mapping set
     [
         T{ #push { literal 0 } { out-d { 8537399 } } } emit-node
@@ -260,11 +261,11 @@ IN: compiler.cfg.builder.tests
 ] unit-test
 
 {
-    T{ current-height { d 1 } { emit-d 1 } }
+    { { 1 1 } { 0 0 } }
     H{ { D -1 4 } { D 0 4 } }
 } [
     0 vreg-counter set-global
-    current-height new current-height set
+    initial-height-state height-state set
     H{ } clone replace-mapping set
     4 D 0 replace-loc
     T{ #shuffle
@@ -272,7 +273,13 @@ IN: compiler.cfg.builder.tests
        { in-d V{ 4 } }
        { out-d V{ 2 3 } }
     } emit-node
-
-    current-height get
+    height-state get
     replace-mapping get
 ] unit-test
+
+{ 1 } [
+    V{ } 0 insns>block basic-block set
+    begin-stack-analysis begin-local-analysis
+    V{ } 1 insns>block [ emit-loop-call ] V{ } make drop
+    basic-block get successors>> length
+] unit-test
diff --git a/basis/compiler/cfg/intrinsics/simd/simd-tests.factor b/basis/compiler/cfg/intrinsics/simd/simd-tests.factor
index 0ef1c8af9c..2a1cf6aad7 100644
--- a/basis/compiler/cfg/intrinsics/simd/simd-tests.factor
+++ b/basis/compiler/cfg/intrinsics/simd/simd-tests.factor
@@ -8,7 +8,7 @@ cpu.architecture fry hashtables kernel locals make namespaces sequences
 system tools.test words ;
 IN: compiler.cfg.intrinsics.simd.tests
 
-:: test-node ( rep -- node ) 
+:: test-node ( rep -- node )
     T{ #call
         { in-d  { 1 2 3 4 } }
         { out-d { 5 } }
@@ -50,17 +50,17 @@ IN: compiler.cfg.intrinsics.simd.tests
 
 : test-compiler-env ( -- x )
     H{ } clone
-        T{ basic-block { id 0 } }
-            [ \ basic-block pick set-at ]
-            [ 0 swap associate \ ds-heights pick set-at ]
-            [ 0 swap associate \ rs-heights pick set-at ] tri
-        T{ current-height { d 0 } { r 0 } { emit-d 0 } { emit-r 0 } } \ current-height pick set-at
-        H{ } clone \ local-peek-set pick set-at
-        H{ } clone \ replace-mapping pick set-at
-        H{ } <biassoc> \ locs>vregs pick set-at
-        H{ } clone \ peek-sets pick set-at
-        H{ } clone \ replace-sets pick set-at
-        H{ } clone \ kill-sets pick set-at ;
+    T{ basic-block { id 0 } }
+    [ \ basic-block pick set-at ]
+    [ 0 swap associate \ ds-heights pick set-at ]
+    [ 0 swap associate \ rs-heights pick set-at ] tri
+    initial-height-state \ height-state pick set-at
+    H{ } clone \ local-peek-set pick set-at
+    H{ } clone \ replace-mapping pick set-at
+    H{ } <biassoc> \ locs>vregs pick set-at
+    H{ } clone \ peek-sets pick set-at
+    H{ } clone \ replace-sets pick set-at
+    H{ } clone \ kill-sets pick set-at ;
 
 : make-classes ( quot -- seq )
     { } make [ class-of ] map ; inline
@@ -253,8 +253,8 @@ unit-test
 
 [ {
     ##mul-vector
-    ##merge-vector-head ##merge-vector-tail ##add-vector 
-    ##merge-vector-head ##merge-vector-tail ##add-vector 
+    ##merge-vector-head ##merge-vector-tail ##add-vector
+    ##merge-vector-head ##merge-vector-tail ##add-vector
     ##vector>scalar
 } ]
 [ simple-ops-cpu float-4-rep [ emit-simd-v. ] test-emit ]
@@ -534,4 +534,3 @@ unit-test
 
 [ simple-ops-cpu 3 [ emit-simd-v+ ] test-emit ]
 [ bad-simd-intrinsic? ] must-fail-with
-
diff --git a/basis/compiler/cfg/stacks/local/local-docs.factor b/basis/compiler/cfg/stacks/local/local-docs.factor
index a3c54a08bd..a2dce8a6da 100644
--- a/basis/compiler/cfg/stacks/local/local-docs.factor
+++ b/basis/compiler/cfg/stacks/local/local-docs.factor
@@ -1,20 +1,13 @@
-USING: assocs compiler.cfg compiler.cfg.registers help.markup help.syntax math
-sequences ;
+USING: assocs compiler.cfg compiler.cfg.instructions compiler.cfg.registers
+help.markup help.syntax math sequences ;
 IN: compiler.cfg.stacks.local
 
 HELP: replace-mapping
 { $var-description "An " { $link assoc } " that maps from stack locations to virtual registers that were put on the stack." }
 { $see-also replace-loc } ;
 
-HELP: current-height
-{ $class-description "A tuple used to keep track of the heights of the data and retain stacks in a " { $link basic-block } " The idea is that if the stack change instructions are tracked, then multiple changes can be folded into one. It has the following slots:"
-  { $table
-    { { $slot "d" } { "Current datastack height." } }
-    { { $slot "r" } { "Current retainstack height." } }
-    { { $slot "emit-d" } { "Queued up datastack height change." } }
-    { { $slot "emit-r" } { "Queued up retainstack height change." } }
-  }
-} ;
+HELP: height-state
+{ $var-description "A two-tuple used to keep track of the heights of the data and retain stacks in a " { $link basic-block } " The idea is that if the stack change instructions are tracked, then multiple changes can be folded into one. The first item is the datastacks current height and queued up height change. The second item is the same for the retain stack." } ;
 
 HELP: loc>vreg
 { $values { "loc" loc } { "vreg" "virtual register" } }
@@ -26,26 +19,27 @@ HELP: replace-loc
 
 HELP: peek-loc
 { $values { "loc" loc } { "vreg" "virtaul register" } }
-{ $description "Retrieves the virtual register and the given stack location." } ;
+{ $description "Retrieves the virtual register at the given stack location." } ;
 
 HELP: translate-local-loc
-{ $values { "loc" loc } { "loc'" loc } }
-{ $description "Translates an absolute stack location to one that is relative to the current stacks height as given in " { $link current-height } "." }
+{ $values { "state" "height state" } { "loc" loc } { "loc'" loc } }
+{ $description "Translates an absolute stack location to one that is relative to the given height state." }
 { $examples
   { $example
     "USING: compiler.cfg.stacks.local compiler.cfg.registers compiler.cfg.debugger namespaces prettyprint ;"
-    "T{ current-height { d 3 } } current-height set D 7 translate-local-loc ."
+    "{ { 3 0 } { 0 0 } } D 7 translate-local-loc ."
     "D 4"
   }
-} ;
+}
+{ $see-also height-state } ;
 
-HELP: height-changes
-{ $values { "current-height" current-height } { "insns" sequence } }
-{ $description "Converts a " { $link current-height } " tuple to 0-2 stack height change instructions." }
+HELP: height-state>insns
+{ $values { "state" sequence } { "insns" sequence } }
+{ $description "Converts a " { $link height-state } " tuple to 0-2 stack height change instructions." }
 { $examples
   { $example
     "USING: compiler.cfg.stacks.local prettyprint ;"
-    "T{ current-height { emit-d 4 } { emit-r -2 } } height-changes ."
+    "{ { 0 4 } { 0 -2 } } height-state>insns ."
     "{ T{ ##inc { loc D 4 } } T{ ##inc { loc R -2 } } }"
   }
 } ;
@@ -55,7 +49,11 @@ HELP: emit-changes
 
 HELP: inc-d
 { $values { "n" number } }
-{ $description "Increases or decreases the current datastacks height." } ;
+{ $description "Increases or decreases the current datastacks height. An " { $link ##inc } " instruction will later be inserted." } ;
+
+HELP: inc-r
+{ $values { "n" number } }
+{ $description "Increases or decreases the current retainstacks height. An " { $link ##inc } " instruction will later be inserted." } ;
 
 ARTICLE: "compiler.cfg.stacks.local" "Local stack analysis"
 "Local stack analysis. We build three sets for every basic block in the CFG:"
diff --git a/basis/compiler/cfg/stacks/local/local-tests.factor b/basis/compiler/cfg/stacks/local/local-tests.factor
index 559816df92..cef8641d4d 100644
--- a/basis/compiler/cfg/stacks/local/local-tests.factor
+++ b/basis/compiler/cfg/stacks/local/local-tests.factor
@@ -1,19 +1,27 @@
 USING: accessors assocs biassocs combinators compiler.cfg
 compiler.cfg.instructions compiler.cfg.registers compiler.cfg.stacks
-compiler.cfg.stacks.local compiler.cfg.utilities cpu.architecture kernel
-namespaces sequences tools.test ;
+compiler.cfg.stacks.height compiler.cfg.stacks.local compiler.cfg.utilities
+cpu.architecture namespaces kernel tools.test ;
 IN: compiler.cfg.stacks.local.tests
 
-{ T{ current-height f 3 0 3 0 } } [
-    current-height new current-height [
-        3 inc-d current-height get
-    ] with-variable
+{
+    { { 3 3 } { 0 0 } }
+} [
+    initial-height-state height-state set
+    3 inc-d height-state get
+] unit-test
+
+{
+    { { 5 3 } { 0 0 } }
+} [
+    { { 2 0 } { 0 0 } } height-state set
+    3 inc-d height-state get
 ] unit-test
 
 {
     { T{ ##inc { loc D 4 } } T{ ##inc { loc R -2 } } }
 } [
-    T{ current-height { emit-d 4 } { emit-r -2 } } height-changes
+    { { 0 4  } { 0 -2 } } height-state>insns
 ] unit-test
 
 { 30 } [
@@ -31,7 +39,7 @@ IN: compiler.cfg.stacks.local.tests
 ] unit-test
 
 { 80 } [
-    current-height new current-height set
+    initial-height-state height-state set
     H{ } clone replace-mapping set 80
     D 77 replace-loc D 77 peek-loc
 ] unit-test
@@ -41,3 +49,14 @@ IN: compiler.cfg.stacks.local.tests
     begin-stack-analysis begin-local-analysis
     compute-local-kill-set assoc-size
 ] unit-test
+
+{ H{ { R -4 R -4 } } } [
+    H{ { 77 4 } } [ ds-heights set ] [ rs-heights set ] bi
+    { { 8 0 } { 3 0 } } height-state set
+    77 basic-block set
+    compute-local-kill-set
+] unit-test
+
+{ D 2 } [
+    { { 1 2 } { 3 4 } } D 3 translate-local-loc2
+] unit-test
diff --git a/basis/compiler/cfg/stacks/local/local.factor b/basis/compiler/cfg/stacks/local/local.factor
index 92fe03fb23..96155c7662 100644
--- a/basis/compiler/cfg/stacks/local/local.factor
+++ b/basis/compiler/cfg/stacks/local/local.factor
@@ -2,76 +2,88 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs combinators compiler.cfg
 compiler.cfg.instructions compiler.cfg.parallel-copy
-compiler.cfg.registers compiler.cfg.stacks.height kernel make
-math math.order namespaces sequences sets ;
+compiler.cfg.registers compiler.cfg.stacks.height
+kernel make math math.order namespaces sequences sets ;
 FROM: namespaces => set ;
 IN: compiler.cfg.stacks.local
 
-SYMBOLS: peek-sets replace-sets kill-sets ;
+: >loc< ( loc -- n ds? )
+    [ n>> ] [ ds-loc? ] bi ;
+
+: modify-height ( state loc -- )
+    >loc< 0 1 ? rot nth [ + ] with map! drop ;
+
+: adjust ( state loc -- )
+    >loc< 0 1 ? rot nth dup first swapd + 0 rot set-nth ;
+
+: reset-emits ( state -- )
+    [ 0 1 rot set-nth ] each ;
+
+: height-state>insns ( state -- insns )
+    [ second ] map { ds-loc rs-loc } [ new swap >>n ] 2map
+    [ n>> 0 = not ] filter [ ##inc new swap >>loc ] map ;
+
+: translate-local-loc ( state loc -- loc' )
+    >loc< [ 0 1 ? rot nth first - ] keep ds-loc rs-loc ? new swap >>n ;
+
+: clone-height-state ( state -- state' )
+    [ clone ] map ;
+
+: initial-height-state ( -- state )
+    { { 0 0 } { 0 0 } } clone-height-state ;
+
+: kill-locations ( saved-height height -- seq )
+    dupd [-] iota [ swap - ] with map ;
+
+: local-kill-set ( ds-height rs-height state -- assoc )
+    first2 [ first ] bi@ swapd [ kill-locations ] 2bi@
+    [ [ <ds-loc> ] map ] [ [ <rs-loc> ] map ] bi*
+    append unique ;
+
+SYMBOLS: height-state peek-sets replace-sets kill-sets ;
 
 SYMBOL: locs>vregs
 
 : loc>vreg ( loc -- vreg ) locs>vregs get [ drop next-vreg ] cache ;
 : vreg>loc ( vreg -- loc/f ) locs>vregs get value-at ;
 
-TUPLE: current-height
-{ d initial: 0 }
-{ r initial: 0 }
-{ emit-d initial: 0 }
-{ emit-r initial: 0 } ;
-
 SYMBOLS: local-peek-set local-replace-set replace-mapping ;
 
-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> ;
-
 : stack-changes ( replace-mapping -- insns )
     [ [ loc>vreg ] dip ] assoc-map parallel-copy ;
 
-: height-changes ( current-height -- insns )
-    [ emit-d>> <ds-loc> ] [ emit-r>> <rs-loc> ] bi 2array
-    [ n>> 0 = not ] filter [ ##inc new swap >>loc ] map ;
-
 : emit-changes ( -- )
     building get pop
     replace-mapping get stack-changes %
-    current-height get height-changes %
+    height-state get height-state>insns %
     , ;
 
-! inc-d/inc-r: these emit ##inc to change the stack height later
 : inc-d ( n -- )
-    current-height get
-    [ [ + ] change-emit-d drop ]
-    [ [ + ] change-d drop ]
-    2bi ;
+    height-state get swap <ds-loc> modify-height ;
 
 : inc-r ( n -- )
-    current-height get
-    [ [ + ] change-emit-r drop ]
-    [ [ + ] change-r drop ]
-    2bi ;
+    height-state get swap <rs-loc> modify-height ;
 
 : peek-loc ( loc -- vreg )
-    translate-local-loc
+    height-state get swap translate-local-loc
     dup replace-mapping get at
     [ ] [ dup local-peek-set get conjoin loc>vreg ] ?if ;
 
 : replace-loc ( vreg loc -- )
-    translate-local-loc replace-mapping get set-at ;
+    height-state get swap translate-local-loc
+    replace-mapping get set-at ;
 
 : compute-local-kill-set ( -- assoc )
-    basic-block get current-height get
-    [ [ ds-heights get at dup ] [ d>> ] bi* [-] iota [ swap - <ds-loc> ] with map ]
-    [ [ rs-heights get at dup ] [ r>> ] bi* [-] iota [ swap - <rs-loc> ] with map ] 2bi
-    append unique ;
+    basic-block get [ rs-heights get at ] [ ds-heights get at ] bi
+    height-state get local-kill-set ;
 
 : begin-local-analysis ( -- )
     H{ } clone local-peek-set set
     H{ } clone replace-mapping set
-    current-height get
-    [ 0 >>emit-d 0 >>emit-r drop ]
-    [ [ d>> ] [ r>> ] bi basic-block get record-stack-heights ] bi ;
+    height-state get
+    [ reset-emits ] [
+        first2 [ first ] bi@ basic-block get record-stack-heights
+    ] bi ;
 
 : remove-redundant-replaces ( -- )
     replace-mapping get [ [ loc>vreg ] dip = not ] assoc-filter
@@ -86,9 +98,6 @@ M: rs-loc translate-local-loc n>> current-height get r>> - <rs-loc> ;
         [ [ compute-local-kill-set ] dip kill-sets get set-at ]
     } cleave ;
 
-: clone-current-height ( -- )
-    current-height [ clone ] change ;
-
 : peek-set ( bb -- assoc ) peek-sets get at ;
 : replace-set ( bb -- assoc ) replace-sets get at ;
 : kill-set ( bb -- assoc ) kill-sets get at ;
diff --git a/basis/compiler/cfg/stacks/map/map.factor b/basis/compiler/cfg/stacks/map/map.factor
index 9db6fa40c4..f2213c319a 100644
--- a/basis/compiler/cfg/stacks/map/map.factor
+++ b/basis/compiler/cfg/stacks/map/map.factor
@@ -1,6 +1,6 @@
 USING: accessors arrays assocs combinators compiler.cfg.dataflow-analysis
-compiler.cfg.instructions compiler.cfg.linearization compiler.cfg.registers fry
-kernel math math.order namespaces sequences ;
+compiler.cfg.instructions compiler.cfg.linearization compiler.cfg.stacks.local
+compiler.cfg.registers fry kernel math math.order namespaces sequences ;
 QUALIFIED: sets
 IN: compiler.cfg.stacks.map
 
@@ -19,11 +19,8 @@ IN: compiler.cfg.stacks.map
 
 CONSTANT: initial-state { { 0 { } } { 0 { } } }
 
-: insn>location ( insn -- n ds? )
-    loc>> [ n>> ] [ ds-loc? ] bi ;
-
 : mark-location ( state insn -- state' )
-    [ first2 ] dip insn>location
+    [ first2 ] dip loc>> >loc<
     [ rot register-write swap ] [ swap register-write ] if 2array ;
 
 : fill-vacancies ( state -- state' )
@@ -32,7 +29,7 @@ CONSTANT: initial-state { { 0 { } } { 0 { } } }
 GENERIC: visit-insn ( state insn -- state' )
 
 M: ##inc visit-insn ( state insn -- state' )
-    [ first2 ] dip insn>location
+    [ first2 ] dip loc>> >loc<
     [ rot adjust-stack swap ] [ swap adjust-stack ] if 2array
     ! Negative out-of stack locations immediately becomes garbage.
     [ first2 [ 0 >= ] filter 2array ] map ;
@@ -43,7 +40,7 @@ M: ##replace visit-insn mark-location ;
 ERROR: vacant-peek insn ;
 
 : underflowable-peek? ( state peek -- ? )
-    2dup insn>location swap [ 0 1 ? swap nth ] dip classify-read
+    2dup loc>> >loc< swap [ 0 1 ? swap nth ] dip classify-read
     dup 2 = [ drop vacant-peek ] [ 2nip 1 = ] if ;
 
 M: ##peek visit-insn ( state insn -- state' )
diff --git a/basis/compiler/cfg/stacks/stacks-docs.factor b/basis/compiler/cfg/stacks/stacks-docs.factor
index 3f04fbfc2a..309298d1ef 100644
--- a/basis/compiler/cfg/stacks/stacks-docs.factor
+++ b/basis/compiler/cfg/stacks/stacks-docs.factor
@@ -8,7 +8,7 @@ HELP: ds-push
 
 HELP: begin-stack-analysis
 { $description "Initializes a set of variables related to stack analysis of Factor words." }
-{ $see-also current-height } ;
+{ $see-also height-state } ;
 
 HELP: end-stack-analysis
 { $description "Ends the stack analysis of the current cfg." } ;
@@ -26,7 +26,7 @@ HELP: ds-store
 
 HELP: rs-store
 { $values { "vregs" "a " { $link sequence } " of vregs." } }
-{ $description "Stores one or more virtual register values on the retain stack. This modifies the " { $link current-height } " dynamic variable." } ;
+{ $description "Stores one or more virtual register values on the retain stack. This modifies the " { $link height-state } " dynamic variable." } ;
 
 HELP: 2inputs
 { $values { "vreg1" "a vreg" } { "vreg2" "a vreg" } }
diff --git a/basis/compiler/cfg/stacks/stacks-tests.factor b/basis/compiler/cfg/stacks/stacks-tests.factor
index cbd1a28cdb..d0465e0f5d 100644
--- a/basis/compiler/cfg/stacks/stacks-tests.factor
+++ b/basis/compiler/cfg/stacks/stacks-tests.factor
@@ -4,7 +4,7 @@ IN: compiler.cfg.stacks
 
 { H{ { D -2 4 } { D -1 3 } { D -3 5 } } } [
     {
-        ${ current-height current-height new }
+        ${ height-state initial-height-state }
         ${ replace-mapping H{ } clone }
     } [
         { 3 4 5 } ds-store replace-mapping get
diff --git a/basis/compiler/cfg/stacks/stacks.factor b/basis/compiler/cfg/stacks/stacks.factor
index 56adf1894e..ebc5a09664 100644
--- a/basis/compiler/cfg/stacks/stacks.factor
+++ b/basis/compiler/cfg/stacks/stacks.factor
@@ -13,7 +13,7 @@ IN: compiler.cfg.stacks
     H{ } clone peek-sets set
     H{ } clone replace-sets set
     H{ } clone kill-sets set
-    current-height new current-height set ;
+    initial-height-state height-state set ;
 
 : end-stack-analysis ( -- )
     cfg get
@@ -32,7 +32,8 @@ IN: compiler.cfg.stacks
 
 : ds-pop ( -- vreg ) ds-peek ds-drop ;
 
-: ds-push ( vreg -- ) 1 inc-d D 0 replace-loc ;
+: ds-push ( vreg -- )
+    1 inc-d D 0 replace-loc ;
 
 : ds-load ( n -- vregs )
     dup 0 =
@@ -71,4 +72,5 @@ IN: compiler.cfg.stacks
 : unary-op ( quot -- )
     [ ds-pop ] dip call ds-push ; inline
 
-: adjust-d ( n -- ) current-height get [ + ] change-d drop ;
+: adjust-d ( n -- )
+    <ds-loc> height-state get swap adjust ;