compiler.cfg.stacks.local: refactoring making stack-changes and height-changes take...

diff --git a/basis/compiler/cfg/parallel-copy/parallel-copy-tests.factor b/basis/compiler/cfg/parallel-copy/parallel-copy-tests.factor
index 66cc87beffb6e2032fb5c52563688d623b9e5d35..1f8537531f1b97994f334efb0ebeacb9cb4d0a6b 100644 (file)
--- a/basis/compiler/cfg/parallel-copy/parallel-copy-tests.factor
+++ b/basis/compiler/cfg/parallel-copy/parallel-copy-tests.factor
@@ -1,4 +1,4 @@
-USING: compiler.cfg.parallel-copy tools.test make arrays
+USING: compiler.cfg.parallel-copy tools.test arrays
 compiler.cfg.registers namespaces compiler.cfg.instructions
 cpu.architecture ;
 IN: compiler.cfg.parallel-copy.tests
@@ -6,8 +6,13 @@ IN: compiler.cfg.parallel-copy.tests
 SYMBOL: temp
 
 : test-parallel-copy ( mapping -- seq )
-    3 vreg-counter set-global
-    [ parallel-copy ] { } make ;
+    3 vreg-counter set-global parallel-copy ;
+
+{
+    { }
+} [
+    H{ } test-parallel-copy
+] unit-test
 
 [
     {
@@ -60,4 +65,4 @@ SYMBOL: temp
         { 1 3 }
         { 4 3 }
     } test-parallel-copy
-] unit-test
\ No newline at end of file
+] unit-test

diff --git a/basis/compiler/cfg/parallel-copy/parallel-copy.factor b/basis/compiler/cfg/parallel-copy/parallel-copy.factor
index 1961d320495896094b0bff833452599f233ea8aa..d09da24d6de27355d4c6caff278e6a4ede258a7a 100644 (file)
--- a/basis/compiler/cfg/parallel-copy/parallel-copy.factor
+++ b/basis/compiler/cfg/parallel-copy/parallel-copy.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs compiler.cfg.instructions compiler.cfg.registers
 compiler.cfg.ssa.destruction.leaders cpu.architecture deques
-dlists fry kernel locals namespaces sequences ;
+dlists fry kernel locals make namespaces sequences ;
 FROM: sets => conjoin ;
 IN: compiler.cfg.parallel-copy
 
@@ -41,7 +41,6 @@ SYMBOLS: locs preds to-do ready ;
 PRIVATE>
 
 :: parallel-mapping ( mapping temp: ( src -- dst ) quot: ( dst src -- ) -- )
-    ! mapping is a list of { dst src } pairs
     [
         mapping init
         to-do get [
@@ -52,8 +51,8 @@ PRIVATE>
         ] slurp-deque
     ] with-scope ; inline
 
-: parallel-copy ( mapping -- )
-    next-vreg '[ drop _ ] [ any-rep ##copy, ] parallel-mapping ;
+: parallel-copy ( mapping -- insns )
+    [ next-vreg '[ drop _ ] [ any-rep ##copy, ] parallel-mapping ] { } make ;
 
 <PRIVATE
 
@@ -65,7 +64,8 @@ SYMBOL: temp-vregs
 
 PRIVATE>
 
-: parallel-copy-rep ( mapping -- )
-    ! mapping is a list of { dst src } pairs
-    H{ } clone temp-vregs set
-    [ rep-of temp-vreg ] [ dup rep-of ##copy, ] parallel-mapping ;
+: parallel-copy-rep ( mapping -- insns )
+    [
+        H{ } clone temp-vregs set
+        [ rep-of temp-vreg ] [ dup rep-of ##copy, ] parallel-mapping
+    ] { } make ;

diff --git a/basis/compiler/cfg/ssa/destruction/destruction.factor b/basis/compiler/cfg/ssa/destruction/destruction.factor
index eb89e40982f910fd81258d3a1c0fed738e4dc2ab..c017578cf02755ed3cbbc8b139c170af61fe8201 100644 (file)
--- a/basis/compiler/cfg/ssa/destruction/destruction.factor
+++ b/basis/compiler/cfg/ssa/destruction/destruction.factor
@@ -130,7 +130,7 @@ M: ##copy cleanup-insn
 M: ##parallel-copy cleanup-insn
     values>>
     [ first2 leaders 2array ] map [ first2 eq? not ] filter
-    [ parallel-copy-rep ] unless-empty ;
+    [ parallel-copy-rep % ] unless-empty ;
 
 M: ##tagged>integer cleanup-insn
     dup useful-copy? [ , ] [ drop ] if ;

diff --git a/basis/compiler/cfg/stacks/local/local.factor b/basis/compiler/cfg/stacks/local/local.factor
index 5488c263c851f11e1c9eb6c2fdc368258114163e..c961817ad3631e39c891ef04500df2fc335f3ec1 100644 (file)
--- a/basis/compiler/cfg/stacks/local/local.factor
+++ b/basis/compiler/cfg/stacks/local/local.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs combinators compiler.cfg
+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 ;
@@ -26,21 +26,17 @@ 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-stack-changes ( -- )
-    replace-mapping get dup assoc-empty? [ drop ] [
-        [ [ loc>vreg ] dip ] assoc-map parallel-copy
-    ] if ;
+: stack-changes ( replace-mapping -- insns )
+    [ [ loc>vreg ] dip ] assoc-map parallel-copy ;
 
-: emit-height-changes ( -- )
-    current-height get
-    [ emit-d>> dup 0 = [ drop ] [ ##inc-d, ] if ]
-    [ emit-r>> dup 0 = [ drop ] [ ##inc-r, ] if ] bi ;
+: height-changes ( current-height -- insns )
+    [ emit-d>> ] [ emit-r>> ] bi 2array
+    { ##inc-d ##inc-r } [ new swap >>n ] 2map [ n>> 0 = not ] filter ;
 
 : emit-changes ( -- )
-    ! Insert height and stack changes prior to the last instruction
     building get pop
-    emit-stack-changes
-    emit-height-changes
+    replace-mapping get stack-changes %
+    current-height get height-changes %
     , ;
 
 ! inc-d/inc-r: these emit ##inc-d/##inc-r to change the stack height later