compiler.cfg.stacks.*: updated tests to match

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

@@ -1,5 +1,6 @@
-USING: compiler.cfg.instructions compiler.cfg.registers
-compiler.cfg.stacks.clearing tools.test ;
+USING: compiler.cfg.instructions compiler.cfg.linearization
+compiler.cfg.registers compiler.cfg.stacks.clearing compiler.cfg.utilities
+kernel tools.test ;
 IN: compiler.cfg.stacks.clearing.tests
 
 { { } } [
@@ -20,3 +21,15 @@ IN: compiler.cfg.stacks.clearing.tests
 } [
     { { 2 { } } { 0 { } } } state>replaces
 ] unit-test
+
+{
+    V{
+        T{ ##inc-d { n 2 } { insn# 0 } }
+        T{ ##replace-imm { src 17 } { loc T{ ds-loc } } }
+        T{ ##replace-imm { src 17 } { loc T{ ds-loc { n 1 } } } }
+        T{ ##peek { loc T{ ds-loc { n 2 } } } { insn# 1 } }
+    }
+} [
+    { T{ ##inc-d f 2 } T{ ##peek f f D 2 } } insns>cfg
+    dup clear-uninitialized cfg>insns
+] unit-test

basis/compiler/cfg/stacks/clearing/clearing.factor

@@ -12,7 +12,7 @@ IN: compiler.cfg.stacks.clearing
     { [ nip ##peek? ] [ underflowable-peek? ] } 2&& ;
 
 : clearing-replaces ( assoc insn -- insns' )
-    [ of ] keep 2dup dangerous-insn? [
+    [ insn#>> of ] keep 2dup dangerous-insn? [
         drop state>replaces
     ] [ 2drop { } ] if ;
 

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

@@ -65,15 +65,15 @@ IN: compiler.cfg.stacks.map.tests
 {
     H{
         {
-            T{ ##inc-d { n 2 } }
+            0
             { { 0 { } } { 0 { } } }
         }
         {
-            T{ ##peek { loc D 2 } }
+            1
             { { 2 { } } { 0 { } } }
         }
         {
-            T{ ##inc-d { n 0 } }
+            2
             { { 2 { 0 1 2 } } { 0 { } } }
         }
     }
@@ -86,31 +86,33 @@ IN: compiler.cfg.stacks.map.tests
 ] unit-test
 
 ! Runs the analysis and check what the resulting stack map becomes.
-
-: output-stack-map ( cfg -- map )
-    H{ } clone stack-record set
-    map-analysis run-dataflow-analysis
-    nip [ [ number>> ] dip ] assoc-map >alist natural-sort last second ;
+: following-stack-state ( insns -- state )
+    T{ ##branch } suffix insns>cfg trace-stack-state
+    >alist [ first ] sort-with last second ;
 
 ! Initially both the d and r stacks are empty.
 {
     { { 0 { } } { 0 { } } }
-} [ V{ } insns>cfg output-stack-map ] unit-test
+} [ V{ } following-stack-state ] unit-test
 
 {
-    { { 0 { } } { 0 { } } }
+    H{
+        { 0 { { 0 { } } { 0 { } } } }
+        { 1 { { 0 { } } { 0 { } } } }
+        { 2 { { 0 { } } { 0 { } } } }
+    }
 } [
     V{ T{ ##safepoint } T{ ##prologue } T{ ##branch } }
-    insns>cfg output-stack-map
+    insns>cfg trace-stack-state
 ] unit-test
 
 {
     { { 1 { } } { 0 { } } }
-} [ V{ T{ ##inc-d f 1 } } insns>cfg output-stack-map ] unit-test
+} [ V{ T{ ##inc-d f 1 } } following-stack-state ] unit-test
 
 {
     { { 0 { } } { 1 { } } }
-} [ V{ T{ ##inc-r f 1 } } insns>cfg output-stack-map ] unit-test
+} [ V{ T{ ##inc-r f 1 } } following-stack-state ] unit-test
 
 ! Here the peek refers to a parameter of the word.
 {
@@ -118,27 +120,39 @@ IN: compiler.cfg.stacks.map.tests
 } [
     V{
         T{ ##peek { loc D 25 } }
-    } insns>cfg output-stack-map
+    } following-stack-state
 ] unit-test
 
 ! The peek "causes" the vacant locations to become populated.
 {
-    { { 3 { 0 1 2 3 } } { 0 { } } }
+    H{
+        { 0 { { 0 { } } { 0 { } } } }
+        { 1 { { 3 { } } { 0 { } } } }
+        { 2 { { 3 { 0 1 2 3 } } { 0 { } } } }
+    }
 } [
     V{
         T{ ##inc-d f 3 }
         T{ ##peek { loc D 3 } }
-    } insns>cfg output-stack-map
+        T{ ##branch }
+    }
+    insns>cfg trace-stack-state
 ] unit-test
 
 ! Replace -1 then peek is ok.
 {
-    { { 0 { -1 } } { 0 { } } }
+    H{
+        { 0 { { 0 { } } { 0 { } } } }
+        { 1 { { 0 { -1 } } { 0 { } } } }
+        { 2 { { 0 { -1 } } { 0 { } } } }
+    }
 } [
     V{
         T{ ##replace { src 10 } { loc D -1 } }
         T{ ##peek { loc D -1 } }
-    } insns>cfg output-stack-map
+        T{ ##branch }
+    }
+    insns>cfg trace-stack-state
 ] unit-test
 
 ! Should be ok because the value was at 0 when the gc ran.
@@ -150,7 +164,7 @@ IN: compiler.cfg.stacks.map.tests
         T{ ##alien-invoke { gc-map T{ gc-map { scrub-d { } } } } }
         T{ ##inc-d f -1 }
         T{ ##peek { loc D -1 } }
-    } insns>cfg output-stack-map
+    } following-stack-state
 ] unit-test
 
 {
@@ -160,7 +174,7 @@ IN: compiler.cfg.stacks.map.tests
         T{ ##replace { src 10 } { loc D 0 } }
         T{ ##replace { src 10 } { loc D 1 } }
         T{ ##replace { src 10 } { loc D 2 } }
-    } insns>cfg output-stack-map
+    } following-stack-state
 ] unit-test
 
 {
@@ -170,7 +184,7 @@ IN: compiler.cfg.stacks.map.tests
         T{ ##replace { src 10 } { loc D 0 } }
         T{ ##inc-d f 1 }
         T{ ##replace { src 10 } { loc D 0 } }
-    } insns>cfg output-stack-map
+    } following-stack-state
 ] unit-test
 
 {
@@ -181,7 +195,7 @@ IN: compiler.cfg.stacks.map.tests
         T{ ##inc-d f 1 }
         T{ ##replace { src 10 } { loc D 0 } }
         T{ ##inc-d f -1 }
-    } insns>cfg output-stack-map
+    } following-stack-state
 ] unit-test
 
 {
@@ -191,7 +205,7 @@ IN: compiler.cfg.stacks.map.tests
         T{ ##inc-d f 1 }
         T{ ##replace { src 10 } { loc D 0 } }
         T{ ##inc-d f -1 }
-    } insns>cfg output-stack-map
+    } following-stack-state
 ] unit-test
 
 ! ##call clears the overinitialized slots.
@@ -202,7 +216,7 @@ IN: compiler.cfg.stacks.map.tests
         T{ ##replace { src 10 } { loc D 0 } }
         T{ ##inc-d f -1 }
         T{ ##call }
-    } insns>cfg output-stack-map
+    } following-stack-state
 ] unit-test
 
 ! Should not be ok because the value wasn't initialized when gc ran.
@@ -211,21 +225,21 @@ IN: compiler.cfg.stacks.map.tests
         T{ ##inc-d f 1 }
         T{ ##alien-invoke { gc-map T{ gc-map { scrub-d { } } } } }
         T{ ##peek { loc D 0 } }
-    } insns>cfg output-stack-map
+    } following-stack-state
 ] [ vacant-peek? ] must-fail-with
 
 [
     V{
         T{ ##inc-d f 1 }
         T{ ##peek { loc D 0 } }
-    } insns>cfg output-stack-map
+    } following-stack-state
 ] [ vacant-peek? ] must-fail-with
 
 [
     V{
         T{ ##inc-r f 1 }
         T{ ##peek { loc R 0 } }
-    } insns>cfg output-stack-map
+    } following-stack-state
 ] [ vacant-peek? ] must-fail-with
 
 : cfg1 ( -- cfg )
@@ -240,8 +254,13 @@ IN: compiler.cfg.stacks.map.tests
     1vector >>successors block>cfg ;
 
 {
-    { { 0 { -1 } } { 0 { } } }
-} [ cfg1 output-stack-map ] unit-test
+    H{
+        { 0 { { 0 { } } { 0 { } } } }
+        { 1 { { 1 { } } { 0 { } } } }
+        { 2 { { 1 { 0 } } { 0 { } } } }
+        { 3 { { 1 { 0 } } { 0 { } } } }
+    }
+} [ cfg1 trace-stack-state ] unit-test
 
 ! Same cfg structure as the bug1021:run-test word but with
 ! non-datastack instructions mostly omitted.
@@ -291,6 +310,32 @@ IN: compiler.cfg.stacks.map.tests
     } [ over insns>block ] assoc-map dup
     { { 0 1 } { 1 2 } { 2 3 } { 3 8 } { 8 10 } } make-edges 0 of block>cfg ;
 
-{ { 4 { 3 2 1 -3 0 -2 -1 } } } [
-    bug1021-cfg output-stack-map first
+{
+    H{
+        { 0 { { 0 { } } { 0 { } } } }
+        { 1 { { 0 { } } { 0 { } } } }
+        { 2 { { 0 { } } { 0 { } } } }
+        { 3 { { 0 { } } { 0 { } } } }
+        { 4 { { 2 { } } { 0 { } } } }
+        { 5 { { 2 { 1 } } { 0 { } } } }
+        { 6 { { 2 { 1 0 } } { 0 { } } } }
+        { 7 { { 2 { 1 0 } } { 0 { } } } }
+        { 8 { { 4 { 3 2 } } { 0 { } } } }
+        { 9 { { 4 { 3 2 } } { 0 { } } } }
+        { 10 { { 4 { 3 2 } } { 0 { } } } }
+        { 11 { { 4 { 3 2 } } { 0 { } } } }
+        { 12 { { 4 { 3 2 } } { 0 { } } } }
+        { 13 { { 4 { 3 2 1 } } { 0 { } } } }
+        { 14 { { 7 { 6 5 4 } } { 0 { } } } }
+        { 15 { { 7 { 6 5 4 } } { 0 { } } } }
+        { 16 { { 7 { 6 5 4 0 } } { 0 { } } } }
+        { 17 { { 7 { 6 5 4 0 3 } } { 0 { } } } }
+        { 18 { { 7 { 6 5 4 0 3 } } { 0 { } } } }
+        { 19 { { 7 { 6 5 4 0 3 1 } } { 0 { } } } }
+        { 20 { { 7 { 6 5 4 0 3 1 2 } } { 0 { } } } }
+        { 21 { { 4 { 3 2 1 -3 0 -2 -1 } } { 0 { } } } }
+        { 22 { { 4 { 3 2 1 -3 0 -2 -1 } } { 0 { } } } }
+    }
+} [
+    bug1021-cfg trace-stack-state
 ] unit-test

extra/tools/gc-decode/gc-decode-tests.factor

@@ -27,7 +27,7 @@ IN: tools.gc-decode.tests
 { t } [
     \ effects:<effect> word>gc-info scrub-bits
     {
-        ?{ t t t f t t t t } ! 64-bit
+        ?{ t t t t f t t t t } ! 64-bit
         ?{ t t t f f f f f t t t t } ! 32-bit
     } member?
 ] unit-test