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.

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 ] [

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

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

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",

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 % , ;

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
-
 {
     { }
 } [