From 997f95196c26371835a7fd78d336c839a9e732db Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= <bjourne@gmail.com>
Date: Mon, 20 Apr 2015 21:22:09 +0200
Subject: [PATCH] compiler.cfg.*: lots of new unit tests

---
 .../intrinsics/strings/strings-tests.factor   | 19 ++++
 .../allocation/allocation-tests.factor        | 92 +++++++++++++++++++
 .../splitting/splitting-tests.factor          | 47 ++++++++++
 .../allocation/state/state-tests.factor       | 78 +++++++++++++++-
 .../assignment/assignment-tests.factor        | 35 ++++---
 .../cfg/linear-scan/linear-scan-tests.factor  |  3 +-
 .../live-intervals-tests.factor               | 16 ++++
 .../cfg/liveness/liveness-tests.factor        | 17 +++-
 .../construction/construction-tests.factor    | 31 ++++++-
 basis/compiler/cfg/ssa/cssa/cssa-tests.factor | 25 +++++
 .../ssa/destruction/destruction-tests.factor  | 36 ++++++++
 .../cfg/stacks/finalize/finalize-tests.factor | 13 +++
 .../cfg/utilities/utilities-tests.factor      | 14 +++
 13 files changed, 399 insertions(+), 27 deletions(-)
 create mode 100644 basis/compiler/cfg/intrinsics/strings/strings-tests.factor
 create mode 100644 basis/compiler/cfg/linear-scan/allocation/allocation-tests.factor
 create mode 100644 basis/compiler/cfg/linear-scan/allocation/splitting/splitting-tests.factor
 create mode 100644 basis/compiler/cfg/linear-scan/live-intervals/live-intervals-tests.factor
 create mode 100644 basis/compiler/cfg/ssa/cssa/cssa-tests.factor
 create mode 100644 basis/compiler/cfg/ssa/destruction/destruction-tests.factor
 create mode 100644 basis/compiler/cfg/stacks/finalize/finalize-tests.factor
 create mode 100644 basis/compiler/cfg/utilities/utilities-tests.factor

diff --git a/basis/compiler/cfg/intrinsics/strings/strings-tests.factor b/basis/compiler/cfg/intrinsics/strings/strings-tests.factor
new file mode 100644
index 0000000000..4b82de8981
--- /dev/null
+++ b/basis/compiler/cfg/intrinsics/strings/strings-tests.factor
@@ -0,0 +1,19 @@
+USING: alien.c-types compiler.cfg.instructions compiler.cfg.intrinsics.strings
+compiler.test cpu.architecture make tools.test ;
+IN: compiler.cfg.intrinsics.strings.tests
+
+{
+    V{
+        T{ ##tagged>integer { dst 4 } { src 3 } }
+        T{ ##add { dst 5 } { src1 4 } { src2 2 } }
+        T{ ##store-memory-imm
+           { src 1 }
+           { base 5 }
+           { offset 21 }
+           { rep int-rep }
+           { c-type uchar }
+        }
+    }
+} [
+    [ emit-set-string-nth-fast ] V{ } make
+] cfg-unit-test
diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation-tests.factor b/basis/compiler/cfg/linear-scan/allocation/allocation-tests.factor
new file mode 100644
index 0000000000..e1b97e3c49
--- /dev/null
+++ b/basis/compiler/cfg/linear-scan/allocation/allocation-tests.factor
@@ -0,0 +1,92 @@
+USING: accessors compiler.cfg compiler.cfg.linear-scan.allocation
+compiler.cfg.linear-scan.allocation.state
+compiler.cfg.linear-scan.live-intervals cpu.architecture
+cpu.x86.assembler.operands heaps kernel namespaces system tools.test ;
+IN: compiler.cfg.linear-scan.allocation.tests
+
+: unassigned-interval ( -- live-interval )
+    T{ live-interval-state
+       { vreg 49 }
+       { start 30 } { end 46 }
+       { ranges { T{ live-range { from 30 } { to 46 } } } }
+       { uses
+         {
+             T{ vreg-use { n 30 } { def-rep double-rep } }
+             T{ vreg-use { n 46 } { use-rep double-rep } }
+         }
+       }
+       { reg-class int-regs }
+    } clone ;
+
+cpu x86.64? [
+    ! assign-registers
+    { RCX } [
+        { { int-regs V{ } } { float-regs V{ } } } active-intervals set
+        unassigned-interval dup machine-registers assign-register reg>>
+    ] unit-test
+
+    ! register-status
+    { { RCX 1/0. } } [
+        { { int-regs V{ } } { float-regs V{ } } } active-intervals set
+        unassigned-interval machine-registers register-status
+    ] unit-test
+] when
+
+! handle-sync-point
+{ } [
+    T{ sync-point { n 30 } } { } handle-sync-point
+] unit-test
+
+: test-active-intervals ( -- assoc )
+    {
+        { int-regs V{
+            T{ live-interval-state
+               { vreg 1 }
+               { start 30 }
+               { end 40 }
+               { ranges
+                 { T{ live-range { from 30 } { to 40 } } }
+               }
+               { uses
+                 { T{ vreg-use { n 32 } { def-rep double-rep } } }
+               }
+            }
+            T{ live-interval-state
+               { vreg 50 }
+               { start 5 }
+               { end 10 }
+               { ranges
+                 { T{ live-range { from 5 } { to 10 } } }
+               }
+               { uses
+                 { T{ vreg-use { n 8 } { def-rep double-rep } } }
+               }
+            }
+        } }
+        { float-regs V{ } }
+    } ;
+
+! Why are they both spilled?
+{
+    { { int-regs V{ } } { float-regs V{ } } }
+} [
+    f f <basic-block> <cfg> cfg set
+    H{ } clone spill-slots set
+    V{ } clone handled-intervals set
+    100 progress set
+    T{ sync-point { n 35 } } test-active-intervals
+    [ handle-sync-point ] keep
+] unit-test
+
+! spill-at-sync-point
+{ f } [
+    <min-heap> unhandled-min-heap set
+    f f <basic-block> <cfg> cfg set
+    40 progress set
+    T{ sync-point { n 40 } } unassigned-interval spill-at-sync-point
+] unit-test
+
+! spill-at-sync-point?
+{ t } [
+    T{ sync-point { n 15 } } f spill-at-sync-point?
+] unit-test
diff --git a/basis/compiler/cfg/linear-scan/allocation/splitting/splitting-tests.factor b/basis/compiler/cfg/linear-scan/allocation/splitting/splitting-tests.factor
new file mode 100644
index 0000000000..9faec79d81
--- /dev/null
+++ b/basis/compiler/cfg/linear-scan/allocation/splitting/splitting-tests.factor
@@ -0,0 +1,47 @@
+USING: compiler.cfg.instructions compiler.cfg.linear-scan.allocation.splitting
+compiler.cfg.linear-scan.live-intervals cpu.architecture sequences tools.test ;
+IN: compiler.cfg.linear-scan.allocation.splitting.tests
+
+: test-interval-easy ( -- interval )
+    T{ live-interval-state
+       { ranges {
+           T{ live-range { from 5 } { to 8 } }
+           T{ live-range { from 12 } { to 20 } }
+       } }
+       { uses {
+           T{ vreg-use { n 3 } { def-rep int-rep } }
+           T{ vreg-use { n 15 } { def-rep int-rep } }
+       } }
+    } ;
+
+! split-interval
+{
+    T{ live-interval-state
+       { ranges { T{ live-range { from 5 } { to 8 } } } }
+       { uses
+         T{ slice
+            { from 0 }
+            { to 1 }
+            { seq {
+                T{ vreg-use { n 3 } { def-rep int-rep } }
+                T{ vreg-use { n 15 } { def-rep int-rep } }
+            } }
+         }
+       }
+    }
+    T{ live-interval-state
+       { ranges { T{ live-range { from 12 } { to 20 } } } }
+       { uses
+         T{ slice
+            { from 1 }
+            { to 2 }
+            { seq {
+                T{ vreg-use { n 3 } { def-rep int-rep } }
+                T{ vreg-use { n 15 } { def-rep int-rep } }
+            } }
+         }
+       }
+    }
+} [
+    test-interval-easy 10 split-interval
+] unit-test
diff --git a/basis/compiler/cfg/linear-scan/allocation/state/state-tests.factor b/basis/compiler/cfg/linear-scan/allocation/state/state-tests.factor
index 7df8cb1f62..7d2f3bf72b 100644
--- a/basis/compiler/cfg/linear-scan/allocation/state/state-tests.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/state/state-tests.factor
@@ -1,9 +1,19 @@
-USING: accessors combinators.extras compiler.cfg compiler.cfg.instructions
-compiler.cfg.linear-scan.allocation.state
+USING: accessors assocs combinators.extras compiler.cfg
+compiler.cfg.instructions compiler.cfg.linear-scan.allocation.state
 compiler.cfg.linear-scan.live-intervals compiler.cfg.utilities cpu.architecture
-cpu.x86.assembler.operands heaps kernel layouts namespaces system tools.test ;
+cpu.x86.assembler.operands heaps kernel layouts namespaces sequences system
+tools.test ;
 IN: compiler.cfg.linear-scan.allocation.state.tests
 
+! active-intervals-for
+{
+    V{ T{ live-interval-state { reg-class int-regs } { vreg 123 } } }
+} [
+    f f machine-registers init-allocator
+    T{ live-interval-state { reg-class int-regs } { vreg 123 } }
+    [ add-active ] keep active-intervals-for
+] unit-test
+
 ! add-active
 {
     {
@@ -24,6 +34,65 @@ IN: compiler.cfg.linear-scan.allocation.state.tests
     active-intervals get
 ] unit-test
 
+! add-use-position
+cpu x86.64? [
+    {
+        H{
+            { XMM0 1/0. }
+            { XMM1 25 }
+            { XMM2 1/0. }
+            { XMM3 1/0. }
+            { XMM4 1/0. }
+            { XMM5 1/0. }
+            { XMM6 1/0. }
+            { XMM7 1/0. }
+            { XMM8 1/0. }
+            { XMM9 1/0. }
+            { XMM11 1/0. }
+            { XMM10 1/0. }
+            { XMM13 1/0. }
+            { XMM12 1/0. }
+            { XMM15 1/0. }
+            { XMM14 1/0. }
+        }
+    } [
+        25 XMM1 machine-registers float-regs free-positions
+        [ add-use-position ] keep
+    ] unit-test
+] when
+
+! assign-spill-slot
+{
+    H{
+        { { 3 8 } T{ spill-slot { n 32 } } }
+        { { 1234 8 } T{ spill-slot } }
+        { { 45 16 } T{ spill-slot { n 16 } } }
+    }
+} [
+    H{ } clone spill-slots set
+    f f <basic-block> <cfg> cfg set
+    { 1234 45 3 } { int-rep double-2-rep tagged-rep }
+    [ assign-spill-slot drop ] 2each
+    spill-slots get
+] unit-test
+
+{ t } [
+    H{ } clone spill-slots set
+    f f <basic-block> <cfg> cfg set
+    55 int-rep assign-spill-slot spill-slots get values first eq?
+] unit-test
+
+! check-handled
+{ } [
+    40 progress set
+    T{ live-interval-state
+       { end 34 }
+       { reg-class int-regs }
+       { vreg 123 }
+    }
+    check-handled
+] unit-test
+
 ! free-positions
 cpu x86.64? [
     {
@@ -42,8 +111,7 @@ cpu x86.64? [
             { RBP 1/0. }
         }
     } [
-        f f machine-registers init-allocator
-        T{ live-interval-state { reg-class int-regs } } free-positions
+        machine-registers int-regs free-positions
     ] unit-test
 ] when
 
diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment-tests.factor b/basis/compiler/cfg/linear-scan/assignment/assignment-tests.factor
index 5c92db23b7..458e05c00d 100644
--- a/basis/compiler/cfg/linear-scan/assignment/assignment-tests.factor
+++ b/basis/compiler/cfg/linear-scan/assignment/assignment-tests.factor
@@ -1,24 +1,35 @@
-USING: accessors arrays compiler.cfg.instructions
+USING: accessors arrays compiler.cfg compiler.cfg.instructions
 compiler.cfg.linear-scan.assignment compiler.cfg.linear-scan.live-intervals
-compiler.cfg.registers compiler.cfg.utilities cpu.architecture
-cpu.x86.assembler.operands grouping heaps kernel make namespaces random
-sequences sorting tools.test ;
+compiler.cfg.registers compiler.cfg.ssa.destruction.leaders
+compiler.cfg.utilities cpu.architecture cpu.x86.assembler.operands grouping
+heaps kernel make namespaces random sequences sorting tools.test ;
 IN: compiler.cfg.linear-scan.assignment.tests
 
+{
+    T{ ##peek { dst RAX } { loc T{ ds-loc } } { insn# 0 } }
+} [
+    H{ { 37 RAX } } pending-interval-assoc set
+    H{ { 37 int-rep } } representations set
+    H{ { 37 37 } } leader-map set
+    T{ ##peek f 37 D 0 0 } [ assign-insn-defs ] keep
+] unit-test
+
+! assign-registers-in-block
+{
+    V{ T{ ##inc { loc T{ ds-loc { n 3 } } } { insn# 7 } } }
+} [
+    { } init-assignment
+    V{ T{ ##inc { loc D 3 } { insn# 7 } } } 0 insns>block
+    [ assign-registers-in-block ] keep instructions>>
+] unit-test
+
+! insert-spill
 { { T{ ##spill { src RAX } } } } [
     [
         T{ live-interval-state { vreg 1234 } { reg RAX } } insert-spill
     ] { } make
 ] unit-test
 
-{ } [
-    { } init-assignment
-    V{
-        T{ ##inc { loc D 3 } { insn# 7 } }
-    } 0 insns>block
-    assign-registers-in-block
-] unit-test
-
 { V{ T{ ##spill { src RAX } { rep int-rep } } } } [
     [
         1234 int-regs <live-interval>
diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
index 94a43dc28a..6efbeb3e2b 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
@@ -728,7 +728,6 @@ H{
 } representations set
 
 [ { 0 10 } ] [
-    H{ { int-regs { 0 1 } } } registers set
     H{
         { int-regs
           {
@@ -778,7 +777,7 @@ H{
         { ranges V{ T{ live-range f 8 10 } } }
         { uses V{ T{ vreg-use f 8 int-rep f } T{ vreg-use f 10 f int-rep } } }
     }
-    register-status
+    H{ { int-regs { 0 1 } } } register-status
 ] unit-test
 
 { t } [
diff --git a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals-tests.factor b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals-tests.factor
new file mode 100644
index 0000000000..7c19b5b29a
--- /dev/null
+++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals-tests.factor
@@ -0,0 +1,16 @@
+USING: compiler.cfg.linear-scan.live-intervals cpu.architecture kernel
+sequences tools.test ;
+IN: compiler.cfg.linear-scan.live-intervals.tests
+
+! add-range
+{
+    T{ live-interval-state
+       { vreg 5 }
+       { ranges V{ T{ live-range { from 5 } { to 12 } } } }
+       { uses V{ } }
+       { reg-class int-rep }
+    }
+} [
+    5 int-rep <live-interval> dup
+    { { 5 10 } { 8 12 } } [ first2 rot add-range ] with each
+] unit-test
diff --git a/basis/compiler/cfg/liveness/liveness-tests.factor b/basis/compiler/cfg/liveness/liveness-tests.factor
index 48c74bad04..b3ffd88ad0 100644
--- a/basis/compiler/cfg/liveness/liveness-tests.factor
+++ b/basis/compiler/cfg/liveness/liveness-tests.factor
@@ -5,6 +5,7 @@ compiler.cfg.ssa.destruction.leaders compiler.cfg.utilities cpu.architecture
 namespaces sequences kernel tools.test vectors alien math
 compiler.cfg.comparisons cpu.x86.assembler.operands assocs ;
 IN: compiler.cfg.liveness.tests
+QUALIFIED: sets
 
 ! compute-edge-live-in
 { H{ } } [
@@ -54,11 +55,6 @@ IN: compiler.cfg.liveness.tests
 ] unit-test
 
 ! fill-gc-map
-{ } [
-    f representations set
-    H{ } clone T{ gc-map } fill-gc-map
-] unit-test
-
 {
     T{ gc-map { gc-roots { 48 } } { derived-roots V{ } } }
 } [
@@ -67,6 +63,17 @@ IN: compiler.cfg.liveness.tests
     T{ gc-map } [ fill-gc-map ] keep
 ] unit-test
 
+! gc-roots
+! only vregs that are tagged are real gc roots
+{ V{ } { 125 } } [
+    H{
+        { 123 double-rep }
+        { 124 double-2-rep }
+        { 125 tagged-rep }
+    } representations set
+    { 123 124 125 } sets:unique gc-roots
+] unit-test
+
 ! kill-defs
 { H{ } } [
     H{ } dup T{ ##peek f 37 D 0 0 } kill-defs
diff --git a/basis/compiler/cfg/ssa/construction/construction-tests.factor b/basis/compiler/cfg/ssa/construction/construction-tests.factor
index 975ded80d2..028b9a6955 100644
--- a/basis/compiler/cfg/ssa/construction/construction-tests.factor
+++ b/basis/compiler/cfg/ssa/construction/construction-tests.factor
@@ -1,11 +1,36 @@
 USING: accessors compiler.cfg compiler.cfg.debugger
 compiler.cfg.dominance compiler.cfg.instructions
 compiler.cfg.predecessors compiler.cfg.ssa.construction assocs
-compiler.cfg.registers compiler.cfg.utilities cpu.architecture kernel
-namespaces sequences
-tools.test vectors ;
+compiler.cfg.registers compiler.cfg.ssa.construction.private
+compiler.cfg.utilities cpu.architecture kernel namespaces sequences tools.test
+vectors ;
 IN: compiler.cfg.ssa.construction.tests
 
+! insert-phi-later
+{
+    { V{ T{ ##phi { dst 789 } { inputs H{ } } } } }
+} [
+    H{ } clone inserting-phis set
+    789 { } 0 insns>block insert-phi-later
+    inserting-phis get values
+] unit-test
+
+{ 99 55 } [
+    H{ } clone inserting-phis set
+    { } 55 insns>block { } 1 insns>block [ connect-bbs ] keep
+    99 swap insert-phi-later
+    inserting-phis get values first first
+    [ dst>> ] [ inputs>> keys first number>> ] bi
+] unit-test
+
+! live-phi?
+{ f t } [
+    HS{ 68 } live-phis set
+    T{ ##phi } live-phi?
+    T{ ##phi { dst 68 } }  live-phi?
+] unit-test
+
+
 : reset-counters ( -- )
     ! Reset counters so that results are deterministic w.r.t. hash order
     reset-vreg-counter 0 basic-block set-global ;
diff --git a/basis/compiler/cfg/ssa/cssa/cssa-tests.factor b/basis/compiler/cfg/ssa/cssa/cssa-tests.factor
new file mode 100644
index 0000000000..152d40b616
--- /dev/null
+++ b/basis/compiler/cfg/ssa/cssa/cssa-tests.factor
@@ -0,0 +1,25 @@
+USING: accessors compiler.cfg compiler.cfg.instructions compiler.cfg.ssa.cssa
+compiler.cfg.utilities kernel namespaces tools.test ;
+IN: compiler.cfg.ssa.cssa.tests
+
+! insert-phi-copies
+{
+    V{
+        T{ ##phi
+           { dst 103 }
+           { inputs H{ { "bl1" 7 } { "bl2" 99 } } }
+        }
+        T{ ##parallel-copy { values V{ { 3 4 } } } }
+    }
+} [
+    V{ { 3 4 } } phi-copies set
+    V{
+        T{ ##phi { dst 103 } { inputs H{ { "bl1" 7 } { "bl2" 99 } } } }
+    } 0 insns>block
+    [ insert-phi-copies ] keep instructions>>
+] unit-test
+
+! phi-copy-insn
+{ T{ ##parallel-copy f V{ { 3 4 } } f } } [
+    V{ { 3 4 } } phi-copy-insn
+] unit-test
diff --git a/basis/compiler/cfg/ssa/destruction/destruction-tests.factor b/basis/compiler/cfg/ssa/destruction/destruction-tests.factor
new file mode 100644
index 0000000000..6757ef733c
--- /dev/null
+++ b/basis/compiler/cfg/ssa/destruction/destruction-tests.factor
@@ -0,0 +1,36 @@
+USING: compiler.cfg.instructions compiler.cfg.registers
+compiler.cfg.ssa.destruction compiler.cfg.ssa.destruction.leaders
+compiler.cfg.ssa.destruction.private cpu.architecture kernel make namespaces
+tools.test ;
+IN: compiler.cfg.ssa.destruction.tests
+
+! cleanup-insn
+{
+    V{ T{ ##copy { src 45 } { dst 47 } { rep double-2-rep } } }
+} [
+    H{ { 45 45 } { 46 45 } { 47 47 } { 100 47 } } leader-map set
+    ! how can the leader of a vreg have a different representation
+    ! than the vreg itself?
+    H{
+        { 45 double-2-rep }
+        { 46 double-rep }
+        { 47 double-rep }
+        { 100 double-rep }
+    } representations set
+    T{ ##parallel-copy { values V{ { 100 46 } } } }
+    [ cleanup-insn ] V{ } make
+] unit-test
+
+{ V{ } } [
+    T{ ##parallel-copy { values V{ } } }
+    [ cleanup-insn ] V{ } make
+] unit-test
+
+! coalesce-leaders
+{
+    H{ { 30 60 } }
+} [
+    H{ } clone leader-map set
+    30 60 coalesce-leaders
+    leader-map get
+] unit-test
diff --git a/basis/compiler/cfg/stacks/finalize/finalize-tests.factor b/basis/compiler/cfg/stacks/finalize/finalize-tests.factor
new file mode 100644
index 0000000000..7bde72221e
--- /dev/null
+++ b/basis/compiler/cfg/stacks/finalize/finalize-tests.factor
@@ -0,0 +1,13 @@
+USING: accessors compiler.cfg.instructions compiler.cfg.stacks.finalize
+compiler.cfg.utilities kernel sequences tools.test ;
+IN: compiler.cfg.stacks.finalize.tests
+
+{
+    T{ ##branch f f }
+    T{ ##branch f f }
+} [
+    V{ } clone 1 insns>block V{ } clone 2 insns>block
+    2dup connect-bbs 2dup visit-edge
+    [ successors>> first instructions>> first ]
+    [ predecessors>> first instructions>> first ] bi*
+] unit-test
diff --git a/basis/compiler/cfg/utilities/utilities-tests.factor b/basis/compiler/cfg/utilities/utilities-tests.factor
new file mode 100644
index 0000000000..60c5791c4d
--- /dev/null
+++ b/basis/compiler/cfg/utilities/utilities-tests.factor
@@ -0,0 +1,14 @@
+USING: accessors compiler.cfg.utilities kernel sequences tools.test ;
+IN: compiler.cfg.utilities.tests
+
+
+{ "eh" "eh" 1 2 } [
+    V{ } clone 1 insns>block V{ } clone 2 insns>block
+    2dup connect-bbs 2dup V{ "eh" } insert-basic-block
+    [
+        [ successors>> ] [ predecessors>> ] bi*
+        [ first instructions>> first ] bi@
+    ] keep
+    predecessors>> first [ predecessors>> ] [ successors>> ] bi
+    [ first number>> ] bi@
+] unit-test