compiler.cfg.*: lots of new tests

basis/compiler/cfg/builder/alien/alien-tests.factor

@@ -1,11 +1,64 @@
 USING: accessors alien alien.c-types compiler.cfg compiler.cfg.builder
-compiler.cfg.builder.alien compiler.cfg.builder.blocks
+compiler.cfg.builder.alien compiler.cfg.builder.alien.params
-compiler.cfg.instructions compiler.cfg.registers compiler.test
+compiler.cfg.builder.blocks compiler.cfg.instructions
-compiler.tree.builder compiler.tree.optimizer cpu.architecture
+compiler.cfg.registers compiler.test compiler.tree.builder
-cpu.x86.assembler cpu.x86.assembler.operands kernel make namespaces
+compiler.tree.optimizer cpu.architecture cpu.x86.assembler
-sequences system tools.test words ;
+cpu.x86.assembler.operands kernel make namespaces sequences
+stack-checker.alien system tools.test words ;
 IN: compiler.cfg.builder.alien.tests
 
+: dummy-assembly ( -- ass )
+    int { } cdecl [
+        EAX 33 MOV
+    ] alien-assembly ;
+
+{ t } [
+    <basic-block> dup set-basic-block dup
+    \ dummy-assembly build-tree optimize-tree first
+    [ emit-node ] V{ } make drop eq?
+] cfg-unit-test
+
+: dummy-callback ( -- cb )
+    void { } cdecl [ ] alien-callback ;
+
+{ 2 t } [
+    \ dummy-callback build-tree optimize-tree gensym build-cfg
+    [ length ] [ second frame-pointer?>> ] bi
+] unit-test
+
+{
+    V{
+        T{ ##load-reference { dst 1 } { obj t } }
+        T{ ##load-integer { dst 2 } { val 3 } }
+        T{ ##copy { dst 4 } { src 1 } { rep any-rep } }
+        T{ ##copy { dst 3 } { src 2 } { rep any-rep } }
+        T{ ##inc { loc D: 2 } }
+        T{ ##branch }
+    }
+} [
+    <basic-block> dup set-basic-block
+    \ dummy-callback build-tree optimize-tree 3 swap nth child>>
+    [ emit-callback-body drop ] V{ } make
+] cfg-unit-test
+
+! caller-parameters
+cpu x86.64? [
+    {
+        V{
+            { 1 int-rep RDI }
+            { 2 float-rep XMM0 }
+            { 3 double-rep XMM1 }
+            { 4 int-rep RSI }
+        }
+        V{ }
+    } [
+        void { int float double char } cdecl { } { } f "func"
+        alien-invoke-params boa caller-parameters
+    ] cfg-unit-test
+] when
+
+! unbox-parameters
+
 ! unboxing ints is only needed on 32bit archs
 cpu x86.32?
 {
@@ -29,36 +82,12 @@ cpu x86.32?
     [ { c-string int } unbox-parameters ] V{ } make
 ] cfg-unit-test
 
-: dummy-assembly ( -- ass )
+! with-param-regs*
-    int { } cdecl [
-        EAX 33 MOV
-    ] alien-assembly ;
-
-{ t } [
-    <basic-block> dup set-basic-block dup
-    \ dummy-assembly build-tree optimize-tree first
-    [ emit-node ] V{ } make drop eq?
-] unit-test
-
-: dummy-callback ( -- cb )
-    void { } cdecl [ ] alien-callback ;
-
-{ 2 t } [
-    \ dummy-callback build-tree optimize-tree gensym build-cfg
-    [ length ] [ second frame-pointer?>> ] bi
-] unit-test
-
 {
-    V{
+    V{ }
-        T{ ##load-reference { dst 1 } { obj t } }
+    V{ }
-        T{ ##load-integer { dst 2 } { val 3 } }
+    f f
-        T{ ##copy { dst 4 } { src 1 } { rep any-rep } }
-        T{ ##copy { dst 3 } { src 2 } { rep any-rep } }
-        T{ ##inc { loc D: 2 } }
-        T{ ##branch }
-    }
 } [
-    <basic-block> dup set-basic-block
+    cdecl [ ] with-param-regs*
-    \ dummy-callback build-tree optimize-tree 3 swap nth child>>
+    reg-values get stack-values get
-    [ emit-callback-body drop ] V{ } make
+] unit-test
-] cfg-unit-test

basis/compiler/cfg/builder/alien/boxing/boxing-tests.factor

@@ -1,8 +1,62 @@
-USING: alien.c-types compiler.cfg.builder.alien.boxing
+USING: alien.c-types classes.struct compiler.cfg.builder.alien.boxing
-compiler.cfg.instructions compiler.test cpu.architecture kernel make system
+compiler.cfg.instructions compiler.test cpu.architecture kernel make
-tools.test ;
+system tools.test ;
 IN: compiler.cfg.builder.alien.boxing.tests
 
+STRUCT: some-struct
+    { f1 int }
+    { f2 int }
+    { f3 int }
+    { f4 int } ;
+
+! flatten-c-type
+{
+    { { int-rep f f } }
+} [
+    int base-type flatten-c-type
+] unit-test
+
+cpu x86.64? [
+    {
+        { { int-rep f f } { int-rep f f } }
+    } [
+        some-struct base-type base-type flatten-c-type
+    ] unit-test
+] when
+
+! unbox
+{
+    { 20 }
+    { { int-rep f f } }
+} [
+    20 int base-type unbox
+] unit-test
+
+cpu x86.64? [
+    {
+        { 2 3 }
+        { { int-rep f f } { int-rep f f } }
+        V{
+            T{ ##unbox-any-c-ptr { dst 1 } { src 20 } }
+            T{ ##load-memory-imm
+               { dst 2 }
+               { base 1 }
+               { offset 0 }
+               { rep int-rep }
+             }
+            T{ ##load-memory-imm
+               { dst 3 }
+               { base 1 }
+               { offset 8 }
+               { rep int-rep }
+             }
+        }
+    } [
+        [ 20 some-struct base-type unbox ] V{ } make
+    ] cfg-unit-test
+] when
+
+! unbox-parameter
 {
     { 1 }
     { { int-rep f f } }

basis/compiler/cfg/builder/alien/params/params-tests.factor

@@ -0,0 +1,28 @@
+USING: alien compiler.cfg.builder.alien.params cpu.architecture
+cpu.x86.assembler.operands kernel system tools.test ;
+IN: compiler.cfg.builder.alien.params.tests
+
+! next-reg-param
+cpu x86.64? [
+    {
+        RDI
+        XMM0
+        XMM1
+        RSI
+    } [
+        cdecl param-regs init-regs
+        f int-rep next-reg-param
+        f double-rep next-reg-param
+        f float-rep next-reg-param
+        f int-rep next-reg-param
+    ] unit-test
+] when
+
+! reg-class-full?
+{
+    f t V{ } f
+} [
+    V{ 1 2 3 } clone f reg-class-full?
+    V{ 1 } clone [ t reg-class-full? ] keep
+    V{ 1 2 } t reg-class-full?
+] unit-test

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

@@ -6,27 +6,6 @@ tools.test ;
 QUALIFIED: sets
 IN: compiler.cfg.stacks.local.tests
 
-! loc>vreg
-{ 1 } [
-    D: 0 loc>vreg
-] cfg-unit-test
-
-! stack-changes
-{
-    {
-        T{ ##copy { dst 1 } { src 25 } { rep any-rep } }
-        T{ ##copy { dst 2 } { src 26 } { rep any-rep } }
-    }
-} [
-    { { D: 0 25 } { R: 0 26 } } replaces>copy-insns
-] cfg-unit-test
-
-! replace-loc
-{ 80 } [
-    80 D: 77 replace-loc
-    D: 77 peek-loc
-] cfg-unit-test
-
 ! end-local-analysis
 {
     HS{ }
@@ -48,6 +27,41 @@ IN: compiler.cfg.stacks.local.tests
     [ replace-sets get at ] tri
 ] cfg-unit-test
 
+! kill-locations
+{
+    { 10 11 12 13 14 15 }
+    { }
+    { }
+    { -6 -5 -4 -3 }
+} [
+    -10 -16 kill-locations
+    0 0 kill-locations
+    2 6 kill-locations
+    6 2 kill-locations
+] unit-test
+
+
+! loc>vreg
+{ 1 } [
+    D: 0 loc>vreg
+] cfg-unit-test
+
+! replace-loc
+{ 80 } [
+    80 D: 77 replace-loc
+    D: 77 peek-loc
+] cfg-unit-test
+
+! stack-changes
+{
+    {
+        T{ ##copy { dst 1 } { src 25 } { rep any-rep } }
+        T{ ##copy { dst 2 } { src 26 } { rep any-rep } }
+    }
+} [
+    { { D: 0 25 } { R: 0 26 } } replaces>copy-insns
+] cfg-unit-test
+
 ! remove-redundant-replaces
 {
     H{ { T{ ds-loc { n 3 } } 7 } }