compiler.cfg.value-numbering: branch folding

2009-07-14 19:17:12 -05:00 · 2009-07-14 19:17:12 -05:00 · 73a2222541
parent 03cd550b93
commit 73a2222541
4 changed files with 323 additions and 69 deletions
--- a/basis/compiler/cfg/local/local.factor
+++ b/basis/compiler/cfg/local/local.factor
@ -1,10 +1,14 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: fry accessors kernel assocs compiler.cfg.liveness compiler.cfg.rpo ;
+USING: locals accessors kernel assocs namespaces
+compiler.cfg compiler.cfg.liveness compiler.cfg.rpo ;
 IN: compiler.cfg.local

-: optimize-basic-block ( bb init-quot insn-quot -- )
-    [ '[ live-in keys @ ] ] [ '[ _ change-instructions drop ] ] bi* bi ; inline
+:: optimize-basic-block ( bb init-quot insn-quot -- )
+    bb basic-block set
+    bb live-in keys init-quot call
+    bb insn-quot change-instructions drop ; inline

-: local-optimization ( cfg init-quot: ( live-in -- ) insn-quot: ( insns -- insns' ) -- cfg' )
-    [ dup ] 2dip '[ _ _ optimize-basic-block ] each-basic-block ; inline
+:: local-optimization ( cfg init-quot: ( live-in -- ) insn-quot: ( insns -- insns' ) -- cfg' )
+    cfg [ init-quot insn-quot optimize-basic-block ] each-basic-block
+    cfg ; inline
--- a/basis/compiler/cfg/value-numbering/expressions/expressions.factor
+++ b/basis/compiler/cfg/value-numbering/expressions/expressions.factor
@ -1,7 +1,8 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors classes kernel math namespaces combinators
-compiler.cfg.instructions compiler.cfg.value-numbering.graph ;
+combinators.short-circuit compiler.cfg.instructions
+compiler.cfg.value-numbering.graph ;
 IN: compiler.cfg.value-numbering.expressions

 ! Referentially-transparent expressions
@ -11,15 +12,29 @@ TUPLE: binary-expr < expr in1 in2 ;
 TUPLE: commutative-expr < binary-expr ;
 TUPLE: compare-expr < binary-expr cc ;
 TUPLE: constant-expr < expr value ;
+TUPLE: reference-expr < expr value ;

 : <constant> ( constant -- expr )
    f swap constant-expr boa ; inline

 M: constant-expr equal?
    over constant-expr? [
-        [ [ value>> ] bi@ = ]
-        [ [ value>> class ] bi@ = ] 2bi
-        and
+        {
+            [ [ value>> class ] bi@ = ]
+            [ [ value>> ] bi@ = ]
+        } 2&&
+    ] [ 2drop f ] if ;
+
+: <reference> ( constant -- expr )
+    f swap reference-expr boa ; inline
+
+M: reference-expr equal?
+    over reference-expr? [
+        [ value>> ] bi@ {
+            { [ 2dup eq? ] [ 2drop t ] }
+            { [ 2dup [ float? ] both? ] [ fp-bitwise= ] }
+            [ 2drop f ]
+        } cond
    ] [ 2drop f ] if ;

 ! Expressions whose values are inputs to the basic block. We
@ -39,6 +54,8 @@ GENERIC: >expr ( insn -- expr )

 M: ##load-immediate >expr val>> <constant> ;

+M: ##load-reference >expr obj>> <reference> ;
+
 M: ##unary >expr
    [ class ] [ src>> vreg>vn ] bi unary-expr boa ;

--- a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
+++ b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
@ -1,8 +1,9 @@
 ! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors locals combinators combinators.short-circuit arrays
+USING: accessors combinators combinators.short-circuit arrays
 fry kernel layouts math namespaces sequences cpu.architecture
-math.bitwise classes
+math.bitwise math.order classes vectors
+compiler.cfg
 compiler.cfg.hats
 compiler.cfg.comparisons
 compiler.cfg.instructions
@ -11,6 +12,12 @@ compiler.cfg.value-numbering.graph
 compiler.cfg.value-numbering.simplify ;
 IN: compiler.cfg.value-numbering.rewrite

+: vreg-small-constant? ( vreg -- ? )
+    vreg>expr {
+        [ constant-expr? ]
+        [ value>> small-enough? ]
+    } 1&& ;
+
 ! Outputs f to mean no change

 GENERIC: rewrite* ( insn -- insn/f )
@ -76,48 +83,6 @@ M: ##compare-imm rewrite-tagged-comparison
    [ dst>> ] [ (rewrite-tagged-comparison) ] bi
    i \ ##compare-imm new-insn ;

-M: ##compare-imm-branch rewrite*
-    {
-        { [ dup rewrite-boolean-comparison? ] [ rewrite-boolean-comparison ] }
-        { [ dup rewrite-tagged-comparison? ] [ rewrite-tagged-comparison ] }
-        [ drop f ]
-    } cond ;
-
-:: >compare-imm ( insn swap? -- insn' )
-    insn dst>>
-    insn src1>>
-    insn src2>> swap? [ swap ] when vreg>constant
-    insn cc>> swap? [ swap-cc ] when
-    i \ ##compare-imm new-insn ; inline
-
-: vreg-small-constant? ( vreg -- ? )
-    vreg>expr {
-        [ constant-expr? ]
-        [ value>> small-enough? ]
-    } 1&& ;
-
-M: ##compare rewrite*
-    dup [ src1>> ] [ src2>> ] bi
-    [ vreg-small-constant? ] bi@ 2array {
-        { { f t } [ f >compare-imm ] }
-        { { t f } [ t >compare-imm ] }
-        [ 2drop f ]
-    } case ;
-
-:: >compare-imm-branch ( insn swap? -- insn' )
-    insn src1>>
-    insn src2>> swap? [ swap ] when vreg>constant
-    insn cc>> swap? [ swap-cc ] when
-    \ ##compare-imm-branch new-insn ; inline
-
-M: ##compare-branch rewrite*
-    dup [ src1>> ] [ src2>> ] bi
-    [ vreg-small-constant? ] bi@ 2array {
-        { { f t } [ f >compare-imm-branch ] }
-        { { t f } [ t >compare-imm-branch ] }
-        [ 2drop f ]
-    } case ;
-
 : rewrite-redundant-comparison? ( insn -- ? )
    {
        [ src1>> vreg>expr compare-expr? ]
@ -133,10 +98,80 @@ M: ##compare-branch rewrite*
    } case
    swap cc= eq? [ [ negate-cc ] change-cc ] when ;

+: (fold-compare-imm) ( insn -- ? )
+    [ [ src1>> vreg>constant ] [ src2>> ] bi ] [ cc>> ] bi
+    pick integer? [ [ <=> ] dip evaluate-cc ] [ 3drop f ] if ;
+
+: fold-compare-imm? ( insn -- ? )
+    src1>> vreg>expr [ constant-expr? ] [ reference-expr? ] bi or ;
+
+: fold-compare-imm-branch ( insn -- insn/f )
+    (fold-compare-imm) 0 1 ?
+    basic-block get [ nth 1vector ] change-successors drop
+    \ ##branch new-insn ;
+
+M: ##compare-imm-branch rewrite*
+    {
+        { [ dup rewrite-boolean-comparison? ] [ rewrite-boolean-comparison ] }
+        { [ dup rewrite-tagged-comparison? ] [ rewrite-tagged-comparison ] }
+        { [ dup fold-compare-imm? ] [ fold-compare-imm-branch ] }
+        [ drop f ]
+    } cond ;
+
+: swap-compare ( src1 src2 cc swap? -- src1 src2 cc )
+    [ [ swap ] dip swap-cc ] when ; inline
+
+: >compare-imm-branch ( insn swap? -- insn' )
+    [
+        [ src1>> ]
+        [ src2>> ]
+        [ cc>> ]
+        tri
+    ] dip
+    swap-compare
+    [ vreg>constant ] dip
+    \ ##compare-imm-branch new-insn ; inline
+
+M: ##compare-branch rewrite*
+    {
+        { [ dup src1>> vreg-small-constant? ] [ t >compare-imm-branch ] }
+        { [ dup src2>> vreg-small-constant? ] [ f >compare-imm-branch ] }
+        [ drop f ]
+    } cond ;
+
+: >compare-imm ( insn swap? -- insn' )
+    [
+        {
+            [ dst>> ]
+            [ src1>> ]
+            [ src2>> ]
+            [ cc>> ]
+        } cleave
+    ] dip
+    swap-compare
+    [ vreg>constant ] dip
+    i \ ##compare-imm new-insn ; inline
+
+M: ##compare rewrite*
+    {
+        { [ dup src1>> vreg-small-constant? ] [ t >compare-imm ] }
+        { [ dup src2>> vreg-small-constant? ] [ f >compare-imm ] }
+        [ drop f ]
+    } cond ;
+
+: fold-compare-imm ( insn -- )
+    [ dst>> ]
+    [ (fold-compare-imm) ] bi
+    {
+        { t [ t \ ##load-reference new-insn ] }
+        { f [ \ f tag-number \ ##load-immediate new-insn ] }
+    } case ;
+
 M: ##compare-imm rewrite*
    {
        { [ dup rewrite-redundant-comparison? ] [ rewrite-redundant-comparison ] }
        { [ dup rewrite-tagged-comparison? ] [ rewrite-tagged-comparison ] }
+        { [ dup fold-compare-imm? ] [ fold-compare-imm ] }
        [ drop f ]
    } cond ;

@ -160,22 +195,19 @@ M: ##shl-imm constant-fold* drop shift ;
    [ [ src1>> vreg>constant ] [ src2>> ] [ ] tri constant-fold* ] bi
    \ ##load-immediate new-insn ; inline

-:: new-imm-insn ( insn dst src1 src2 op -- new-insn/insn )
-    src2 small-enough? [ dst src1 src2 op new-insn ] [ insn ] if ; inline
-
 : reassociate? ( insn -- ? )
    [ src1>> vreg>expr op>> ] [ class ] bi = ; inline

 : reassociate ( insn op -- insn )
    [
        {
-            [ ]
            [ dst>> ]
            [ src1>> vreg>expr [ in1>> vn>vreg ] [ in2>> vn>constant ] bi ]
            [ src2>> ]
            [ ]
        } cleave constant-fold*
-    ] dip new-imm-insn ; inline
+    ] dip
+    over small-enough? [ new-insn ] [ 2drop 2drop f ] if ; inline

 M: ##add-imm rewrite*
    {
@ -185,8 +217,8 @@ M: ##add-imm rewrite*
    } cond ;

 : sub-imm>add-imm ( insn -- insn' )
-    dup [ dst>> ] [ src1>> ] [ src2>> neg ] tri dup small-enough?
-    [ \ ##add-imm new-insn nip ] [ 2drop 2drop f ] if ;
+    [ dst>> ] [ src1>> ] [ src2>> neg ] tri dup small-enough?
+    [ \ ##add-imm new-insn ] [ 3drop f ] if ;

 M: ##sub-imm rewrite*
    {
@ -247,12 +279,11 @@ M: ##sar-imm rewrite*
        [ drop f ]
    } cond ;

-:: insn>imm-insn ( insn op swap? -- )
-    insn
-    insn dst>>
-    insn src1>>
-    insn src2>> swap? [ swap ] when vreg>constant
-    op new-imm-insn ; inline
+: insn>imm-insn ( insn op swap? -- )
+    swap [
+        [ [ dst>> ] [ src1>> ] [ src2>> ] tri ] dip
+        [ swap ] when vreg>constant
+    ] dip new-insn ; inline

 : rewrite-arithmetic ( insn op -- ? )
    {
--- a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor
+++ b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor
@ -2,7 +2,7 @@ IN: compiler.cfg.value-numbering.tests
 USING: compiler.cfg.value-numbering compiler.cfg.instructions
 compiler.cfg.registers compiler.cfg.debugger compiler.cfg.comparisons
 cpu.architecture tools.test kernel math combinators.short-circuit
-accessors sequences compiler.cfg vectors arrays layouts ;
+accessors sequences compiler.cfg vectors arrays layouts namespaces ;

 : trim-temps ( insns -- insns )
    [
@ -17,6 +17,55 @@ accessors sequences compiler.cfg vectors arrays layouts ;
    { } init-value-numbering
    value-numbering-step ;

+! Folding constants together
+[
+    {
+        T{ ##load-reference f V int-regs 0 0.0 }
+        T{ ##load-reference f V int-regs 1 -0.0 }
+        T{ ##replace f V int-regs 0 D 0 }
+        T{ ##replace f V int-regs 1 D 1 }
+    }
+] [
+    {
+        T{ ##load-reference f V int-regs 0 0.0 }
+        T{ ##load-reference f V int-regs 1 -0.0 }
+        T{ ##replace f V int-regs 0 D 0 }
+        T{ ##replace f V int-regs 1 D 1 }
+    } test-value-numbering
+] unit-test
+
+[
+    {
+        T{ ##load-reference f V int-regs 0 0.0 }
+        T{ ##load-reference f V int-regs 1 0.0 }
+        T{ ##replace f V int-regs 0 D 0 }
+        T{ ##replace f V int-regs 0 D 1 }
+    }
+] [
+    {
+        T{ ##load-reference f V int-regs 0 0.0 }
+        T{ ##load-reference f V int-regs 1 0.0 }
+        T{ ##replace f V int-regs 0 D 0 }
+        T{ ##replace f V int-regs 1 D 1 }
+    } test-value-numbering
+] unit-test
+
+[
+    {
+        T{ ##load-reference f V int-regs 0 t }
+        T{ ##load-reference f V int-regs 1 t }
+        T{ ##replace f V int-regs 0 D 0 }
+        T{ ##replace f V int-regs 0 D 1 }
+    }
+] [
+    {
+        T{ ##load-reference f V int-regs 0 t }
+        T{ ##load-reference f V int-regs 1 t }
+        T{ ##replace f V int-regs 0 D 0 }
+        T{ ##replace f V int-regs 1 D 1 }
+    } test-value-numbering
+] unit-test
+
 ! Copy propagation
 [
    {
@ -805,4 +854,157 @@ cell 8 = [
            T{ ##add f V int-regs 3 V int-regs 0 V int-regs 2 }
        } test-value-numbering
    ] unit-test
-] when
+
+    [
+        {
+            T{ ##peek f V int-regs 0 D 0 }
+            T{ ##load-immediate f V int-regs 2 140737488355328 }
+            T{ ##add f V int-regs 3 V int-regs 0 V int-regs 2 }
+        }
+    ] [
+        {
+            T{ ##peek f V int-regs 0 D 0 }
+            T{ ##load-immediate f V int-regs 2 140737488355328 }
+            T{ ##add f V int-regs 3 V int-regs 0 V int-regs 2 }
+        } test-value-numbering
+    ] unit-test
+
+    [
+        {
+            T{ ##peek f V int-regs 0 D 0 }
+            T{ ##load-immediate f V int-regs 2 2147483647 }
+            T{ ##add-imm f V int-regs 3 V int-regs 0 2147483647 }
+            T{ ##add-imm f V int-regs 4 V int-regs 3 2147483647 }
+        }
+    ] [
+        {
+            T{ ##peek f V int-regs 0 D 0 }
+            T{ ##load-immediate f V int-regs 2 2147483647 }
+            T{ ##add f V int-regs 3 V int-regs 0 V int-regs 2 }
+            T{ ##add f V int-regs 4 V int-regs 3 V int-regs 2 }
+        } test-value-numbering
+    ] unit-test
+] when
+
+! Branch folding
+[
+    {
+        T{ ##load-immediate f V int-regs 1 1 }
+        T{ ##load-immediate f V int-regs 2 2 }
+        T{ ##load-immediate f V int-regs 3 5 }
+    }
+] [
+    {
+        T{ ##load-immediate f V int-regs 1 1 }
+        T{ ##load-immediate f V int-regs 2 2 }
+        T{ ##compare f V int-regs 3 V int-regs 1 V int-regs 2 cc= }
+    } test-value-numbering
+] unit-test
+
+[
+    {
+        T{ ##load-immediate f V int-regs 1 1 }
+        T{ ##load-immediate f V int-regs 2 2 }
+        T{ ##load-reference f V int-regs 3 t }
+    }
+] [
+    {
+        T{ ##load-immediate f V int-regs 1 1 }
+        T{ ##load-immediate f V int-regs 2 2 }
+        T{ ##compare f V int-regs 3 V int-regs 1 V int-regs 2 cc/= }
+    } test-value-numbering
+] unit-test
+
+[
+    {
+        T{ ##load-immediate f V int-regs 1 1 }
+        T{ ##load-immediate f V int-regs 2 2 }
+        T{ ##load-reference f V int-regs 3 t }
+    }
+] [
+    {
+        T{ ##load-immediate f V int-regs 1 1 }
+        T{ ##load-immediate f V int-regs 2 2 }
+        T{ ##compare f V int-regs 3 V int-regs 1 V int-regs 2 cc< }
+    } test-value-numbering
+] unit-test
+
+[
+    {
+        T{ ##load-immediate f V int-regs 1 1 }
+        T{ ##load-immediate f V int-regs 2 2 }
+        T{ ##load-immediate f V int-regs 3 5 }
+    }
+] [
+    {
+        T{ ##load-immediate f V int-regs 1 1 }
+        T{ ##load-immediate f V int-regs 2 2 }
+        T{ ##compare f V int-regs 3 V int-regs 2 V int-regs 1 cc< }
+    } test-value-numbering
+] unit-test
+
+: test-branch-folding ( insns -- insns' )
+    <basic-block>
+    [ V{ 0 1 } clone >>successors basic-block set test-value-numbering ] keep
+    successors>> first ;
+
+[
+    {
+        T{ ##load-immediate f V int-regs 1 1 }
+        T{ ##load-immediate f V int-regs 2 2 }
+        T{ ##branch }
+    }
+    1
+] [
+    {
+        T{ ##load-immediate f V int-regs 1 1 }
+        T{ ##load-immediate f V int-regs 2 2 }
+        T{ ##compare-branch f V int-regs 1 V int-regs 2 cc= }
+    } test-branch-folding
+] unit-test
+
+[
+    {
+        T{ ##load-immediate f V int-regs 1 1 }
+        T{ ##load-immediate f V int-regs 2 2 }
+        T{ ##branch }
+    }
+    0
+] [
+    {
+        T{ ##load-immediate f V int-regs 1 1 }
+        T{ ##load-immediate f V int-regs 2 2 }
+        T{ ##compare-branch f V int-regs 1 V int-regs 2 cc/= }
+    } test-branch-folding
+] unit-test
+
+[
+    {
+        T{ ##load-immediate f V int-regs 1 1 }
+        T{ ##load-immediate f V int-regs 2 2 }
+        T{ ##branch }
+    }
+    0
+] [
+    {
+        T{ ##load-immediate f V int-regs 1 1 }
+        T{ ##load-immediate f V int-regs 2 2 }
+        T{ ##compare-branch f V int-regs 1 V int-regs 2 cc< }
+    } test-branch-folding
+] unit-test
+
+[
+    {
+        T{ ##load-immediate f V int-regs 1 1 }
+        T{ ##load-immediate f V int-regs 2 2 }
+        T{ ##branch }
+    }
+    1
+] [
+    {
+        T{ ##load-immediate f V int-regs 1 1 }
+        T{ ##load-immediate f V int-regs 2 2 }
+        T{ ##compare-branch f V int-regs 2 V int-regs 1 cc< }
+    } test-branch-folding
+] unit-test
+