From: Björn Lindqvist <bjourne@gmail.com>
Date: Wed, 8 Apr 2015 06:08:17 +0000 (+0200)
Subject: compiler.cfg.stacks.*: possible fix for #1289
X-Git-Tag: unmaintained~2833
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=f9812d98743a91b852a080d71b57445f7d62249b

compiler.cfg.stacks.*: possible fix for #1289

instead of delaying outputting ##replace instructions to when they are
needed, output them directly in the block so that "holes" in the
stacks are avoided.
---

diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor
index ac91bfe987..c8c314c777 100644
--- a/basis/compiler/cfg/builder/builder-tests.factor
+++ b/basis/compiler/cfg/builder/builder-tests.factor
@@ -199,8 +199,7 @@ IN: compiler.cfg.builder.tests
 ] unit-test
 
 [ f ] [
-    [ 1000 [ ] times ]
-    [ [ ##peek? ] [ ##replace? ] bi or ] contains-insn?
+    [ 1000 [ ] times ] [ ##peek? ] contains-insn?
 ] unit-test
 
 [ f t ] [
diff --git a/basis/compiler/cfg/intrinsics/simd/simd-tests.factor b/basis/compiler/cfg/intrinsics/simd/simd-tests.factor
index 2a1cf6aad7..8d5cc8b4db 100644
--- a/basis/compiler/cfg/intrinsics/simd/simd-tests.factor
+++ b/basis/compiler/cfg/intrinsics/simd/simd-tests.factor
@@ -55,8 +55,8 @@ IN: compiler.cfg.intrinsics.simd.tests
     [ 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
+    HS{ } clone \ local-peek-set pick set-at
+    H{ } clone \ replaces pick set-at
     H{ } <biassoc> \ locs>vregs pick set-at
     H{ } clone \ peek-sets pick set-at
     H{ } clone \ replace-sets pick set-at
diff --git a/basis/compiler/cfg/stacks/finalize/finalize.factor b/basis/compiler/cfg/stacks/finalize/finalize.factor
index 210c978772..9b26728fbc 100644
--- a/basis/compiler/cfg/stacks/finalize/finalize.factor
+++ b/basis/compiler/cfg/stacks/finalize/finalize.factor
@@ -27,8 +27,7 @@ ERROR: bad-peek dst loc ;
     [ dup n>> 0 < [ bad-peek ] [ ##peek, ] if ] each-insertion ;
 
 : insert-replaces ( from to -- )
-    [ inserting-replaces ] keep
-    [ dup n>> 0 < [ 2drop ] [ ##replace, ] if ] each-insertion ;
+    2drop ;
 
 : visit-edge ( from to -- )
     ! If both blocks are subroutine calls, don't bother
diff --git a/basis/compiler/cfg/stacks/local/local-tests.factor b/basis/compiler/cfg/stacks/local/local-tests.factor
index c85f98110a..d9e5ab7ef5 100644
--- a/basis/compiler/cfg/stacks/local/local-tests.factor
+++ b/basis/compiler/cfg/stacks/local/local-tests.factor
@@ -58,7 +58,11 @@ IN: compiler.cfg.stacks.local.tests
 
 ! emit-changes
 {
-    V{ T{ ##copy { dst 1 } { src 3 } { rep any-rep } } "eh" }
+    V{
+        T{ ##copy { dst 1 } { src 3 } { rep any-rep } }
+        T{ ##replace { src 1 } { loc D 0 } }
+        "eh"
+    }
 } [
     3 D 0 replace-loc [
         "eh",
diff --git a/basis/compiler/cfg/stacks/local/local.factor b/basis/compiler/cfg/stacks/local/local.factor
index f8d9c7ec5b..f6d354dc62 100644
--- a/basis/compiler/cfg/stacks/local/local.factor
+++ b/basis/compiler/cfg/stacks/local/local.factor
@@ -3,7 +3,7 @@
 USING: accessors arrays assocs combinators compiler.cfg
 compiler.cfg.instructions compiler.cfg.parallel-copy
 compiler.cfg.registers compiler.cfg.stacks.height
-hash-sets kernel make math math.order namespaces sequences sets ;
+fry hash-sets kernel make math math.order namespaces sequences sets ;
 FROM: namespaces => set ;
 IN: compiler.cfg.stacks.local
 
@@ -29,6 +29,9 @@ IN: compiler.cfg.stacks.local
 : translate-local-loc ( loc state -- loc' )
     [ clone ] dip over >loc< 0 1 ? rot nth first - >>n ;
 
+: untranslate-local-loc ( loc state -- loc' )
+    [ clone ] dip over >loc< 0 1 ? rot nth first + >>n ;
+
 : clone-height-state ( state -- state' )
     [ clone ] map ;
 
@@ -56,8 +59,15 @@ SYMBOLS: local-peek-set replaces ;
 : replaces>copy-insns ( replaces -- insns )
     [ [ loc>vreg ] dip ] assoc-map parallel-copy ;
 
+: replaces>replace-insns ( replaces height-state -- insns )
+    [ keys ] dip
+    '[ [ loc>vreg ] [ _ untranslate-local-loc ] bi f ##replace boa ] map
+    [ loc>> n>> 0 >= ] filter ;
+
 : changes>insns ( replaces height-state -- insns )
-    [ replaces>copy-insns ] [ height-state>insns ] bi* append ;
+    [ drop replaces>copy-insns ]
+    [ nip height-state>insns ]
+    [ replaces>replace-insns ] 2tri 3append ;
 
 : emit-changes ( replaces height-state -- )
     building get pop -rot changes>insns % , ;
diff --git a/extra/tools/gc-decode/gc-decode-tests.factor b/extra/tools/gc-decode/gc-decode-tests.factor
index cb3a3df5f1..22041fca86 100644
--- a/extra/tools/gc-decode/gc-decode-tests.factor
+++ b/extra/tools/gc-decode/gc-decode-tests.factor
@@ -24,14 +24,6 @@ IN: tools.gc-decode.tests
 { ?{ t t t t t t t t } } [ B{ 255 } byte-array>bit-array ] unit-test
 
 ! scrub-bits
-{ t } [
-    \ effects:<effect> word>gc-info scrub-bits
-    {
-        ?{ t t t f t t t t } ! 64-bit
-        ?{ t t t t f f f f f t t t t } ! 32-bit TODO
-    } member?
-] unit-test
-
 {
     { }
 } [