--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
-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
{
{
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? [
{
{ 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
-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>
} representations set
[ { 0 10 } ] [
- H{ { int-regs { 0 1 } } } registers set
H{
{ int-regs
{
{ 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 } [
--- /dev/null
+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
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{ } } [
] 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{ } } }
} [
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
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 ;
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
projects / factor.git / commitdiff