compiler.cfg.stacks.*: new word local-loc>global, replacing untranslate-loc

basis/compiler/cfg/stacks/finalize/finalize-tests.factor

@@ -20,6 +20,6 @@ IN: compiler.cfg.stacks.finalize.tests
     begin-stack-analysis
     3 4 T{ basic-block }
     [ record-stack-heights ]
-    [ D: 1 swap untranslate-loc ]
-    [ R: 1 swap untranslate-loc ] tri
+    [ D: 1 swap local-loc>global ]
+    [ R: 1 swap local-loc>global ] tri
 ] unit-test

basis/compiler/cfg/stacks/finalize/finalize.factor

@@ -6,13 +6,6 @@ compiler.cfg.stacks.local compiler.cfg.utilities fry kernel locals
 make math sequences sets ;
 IN: compiler.cfg.stacks.finalize
 
-GENERIC# untranslate-loc 1 ( loc bb -- loc' )
-
-M: ds-loc untranslate-loc ( loc bb -- loc' )
-    [ n>> ] [ ds-height>> ] bi* + <ds-loc> ;
-M: rs-loc untranslate-loc ( loc bb -- loc' )
-    [ n>> ] [ rs-height>> ] bi* + <rs-loc> ;
-
 :: inserting-peeks ( from to -- set )
     to anticip-in
     from anticip-out from avail-out union
@@ -24,7 +17,8 @@ M: rs-loc untranslate-loc ( loc bb -- loc' )
     diff ;
 
 : each-insertion ( ... set bb quot: ( ... vreg loc -- ... ) -- ... )
-    [ members ] 2dip '[ [ loc>vreg ] [ _ untranslate-loc ] bi @ ] each ; inline
+    [ members ] 2dip
+    '[ [ loc>vreg ] [ _ local-loc>global ] bi @ ] each ; inline
 
 ERROR: bad-peek dst loc ;
 

basis/compiler/cfg/stacks/local/local-docs.factor

@@ -11,6 +11,18 @@ HELP: end-local-analysis
 { $values { "basic-block" basic-block } }
 { $description "Called to end the local analysis of a block. The word fills in the blocks slots " { $slot "replaces" } ", " { $slot "peeks" } " and " { $slot "kills" } " with what the blocks replaces, peeks and kill locations are." } ;
 
+HELP: global-loc>local
+{ $values { "loc" loc } { "height-state" height-state }  { "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 namespaces prettyprint ;"
+    "D: 7 T{ height-state f 3 0 0 0 } global-loc>local ."
+    "D: 4"
+  }
+}
+{ $see-also height-state local-loc>global } ;
+
 HELP: height-state
 { $description "A tuple which keeps track of the stacks heights and increments of a " { $link basic-block } " during local analysis. 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
@@ -50,6 +62,10 @@ HELP: inc-stack
 { $values { "loc" loc } }
 { $description "Increases or decreases the data or retain stack depending on if loc is a " { $link ds-loc } " or " { $link rs-loc } " instance. An " { $link ##inc } " instruction will later be inserted." } ;
 
+HELP: local-loc>global
+{ $values { "loc" loc } { "bb" basic-block } { "loc'" loc } }
+{ $description "Translates a stack location relative to a block to an absolute one. The word does the opposite to " { $link global-loc>local } "." } ;
+
 HELP: loc>vreg
 { $values { "loc" loc } { "vreg" "virtual register" } }
 { $description "Maps a stack location to a virtual register." } ;
@@ -84,18 +100,6 @@ HELP: replaces
 { $var-description "An " { $link assoc } " that maps from stack locations to virtual registers that were put on the stack during the local analysis phase. " { $link ds-push } " and similar words writes to it." }
 { $see-also replace-loc } ;
 
-HELP: global-loc>local
-{ $values { "loc" loc } { "height-state" height-state }  { "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 namespaces prettyprint ;"
-    "D: 7 T{ height-state f 3 0 0 0 } global-loc>local ."
-    "D: 4"
-  }
-}
-{ $see-also height-state } ;
-
 ARTICLE: "compiler.cfg.stacks.local" "Local stack analysis"
 "Local stack analysis. For each " { $link basic-block } " in the " { $link cfg } ", three sets containing stack locations are built:"
 { $list
@@ -109,6 +113,7 @@ $nl
 { $subsections
   peek-loc
   global-loc>local
+  local-loc>global
 }
 "Words for writing the stack state:"
 { $subsections

basis/compiler/cfg/stacks/local/local-tests.factor

@@ -1,4 +1,4 @@
-USING: accessors assocs compiler.cfg.instructions
+USING: accessors compiler.cfg compiler.cfg.instructions
 compiler.cfg.registers compiler.cfg.stacks.local
 compiler.cfg.utilities compiler.test cpu.architecture kernel
 kernel.private make math namespaces sequences.private slots.private
@@ -27,6 +27,11 @@ IN: compiler.cfg.stacks.local.tests
     [ replaces>> ] tri
 ] cfg-unit-test
 
+! local-loc>global
+{ D: 6 } [
+    D: 3 <basic-block> 3 >>ds-height local-loc>global
+] unit-test
+
 ! kill-locations
 {
     { 10 11 12 13 14 15 }

basis/compiler/cfg/stacks/local/local.factor

@@ -19,6 +19,9 @@ TUPLE: height-state ds-begin rs-begin ds-inc rs-inc ;
 : global-loc>local ( loc height-state -- loc' )
     [ clone dup >loc< ] dip swap [ ds-height ] [ rs-height ] if - >>n ;
 
+: local-loc>global ( loc bb -- loc' )
+    [ clone dup >loc< ] dip swap [ ds-height>> ] [ rs-height>> ] if + >>n ;
+
 : inc-stack ( loc -- )
     >loc< height-state get swap
     [ [ + ] change-ds-inc ] [ [ + ] change-rs-inc ] if drop ;
@@ -72,7 +75,7 @@ SYMBOLS: locs>vregs local-peek-set replaces ;
 
 : begin-local-analysis ( basic-block -- )
     height-state get reset-incs
-    height-state get [ ds-height ] [ rs-height ] bi rot record-stack-heights
+    height-state get [ ds-begin>> ] [ rs-begin>> ] bi rot record-stack-heights
     HS{ } clone local-peek-set namespaces:set
     H{ } clone replaces namespaces:set ;