extra/compiler/cfg/gvn/comparisons/comparisons.factor

   1 ! Copyright (C) 2010 Slava Pestov, 2011 Alex Vondrak.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors combinators kernel math math.order namespaces
   4 sequences vectors combinators.short-circuit
   5 cpu.architecture
   6 compiler.cfg
   7 compiler.cfg.comparisons
   8 compiler.cfg.instructions
   9 compiler.cfg.registers
  10 compiler.cfg.gvn.math
  11 compiler.cfg.gvn.graph
  12 compiler.cfg.gvn.avail
  13 compiler.cfg.gvn.rewrite ;
  14 IN: compiler.cfg.gvn.comparisons
  15
  16 ! Optimizations performed here:
  17 !
  18 ! 1) Eliminating intermediate boolean values when the result of
  19 ! a comparison is used by a compare-branch
  20 ! 2) Folding comparisons where both inputs are literal
  21 ! 3) Folding comparisons where both inputs are congruent
  22 ! 4) Converting compare instructions into compare-imm instructions
  23
  24 : fold-compare-imm? ( insn -- ? )
  25     src1>> vreg>insn literal-insn? ;
  26
  27 : evaluate-compare-imm ( insn -- ? )
  28     [ src1>> vreg>literal ] [ src2>> ] [ cc>> ] tri
  29     {
  30         { cc= [ eq? ] }
  31         { cc/= [ eq? not ] }
  32     } case ;
  33
  34 : fold-compare-integer-imm? ( insn -- ? )
  35     src1>> vreg>insn ##load-integer? ;
  36
  37 : evaluate-compare-integer-imm ( insn -- ? )
  38     [ src1>> vreg>integer ] [ src2>> ] [ cc>> ] tri
  39     [ <=> ] dip evaluate-cc ;
  40
  41 : fold-test-imm? ( insn -- ? )
  42     src1>> vreg>insn ##load-integer? ;
  43
  44 : evaluate-test-imm ( insn -- ? )
  45     [ src1>> vreg>integer ] [ src2>> ] [ cc>> ] tri
  46     [ bitand ] dip {
  47         { cc= [ 0 = ] }
  48         { cc/= [ 0 = not ] }
  49     } case ;
  50
  51 : rewrite-into-test? ( insn -- ? )
  52     {
  53         [ drop test-instruction? ]
  54         [ cc>> { cc= cc/= } member-eq? ]
  55         [ src2>> 0 = ]
  56     } 1&& ;
  57
  58 : >compare< ( insn -- in1 in2 cc )
  59     [ src1>> ] [ src2>> ] [ cc>> ] tri ; inline
  60
  61 : >test-vector< ( insn -- src1 temp rep vcc )
  62     {
  63         [ src1>> ]
  64         [ drop next-vreg ]
  65         [ rep>> ]
  66         [ vcc>> ]
  67     } cleave ; inline
  68
  69 UNION: scalar-compare-insn
  70     ##compare
  71     ##compare-imm
  72     ##compare-integer
  73     ##compare-integer-imm
  74     ##test
  75     ##test-imm
  76     ##compare-float-unordered
  77     ##compare-float-ordered ;
  78
  79 UNION: general-compare-insn scalar-compare-insn ##test-vector ;
  80
  81 : rewrite-boolean-comparison? ( insn -- ? )
  82     {
  83         [ src1>> vreg>insn [ general-compare-insn? ] with-available-uses? ]
  84         [ src2>> not ]
  85         [ cc>> cc/= eq? ]
  86     } 1&& ; inline
  87
  88 : rewrite-boolean-comparison ( insn -- insn )
  89     src1>> vreg>insn {
  90         { [ dup ##compare? ] [ >compare< ##compare-branch new-insn ] }
  91         { [ dup ##compare-imm? ] [ >compare< ##compare-imm-branch new-insn ] }
  92         { [ dup ##compare-integer? ] [ >compare< ##compare-integer-branch new-insn ] }
  93         { [ dup ##compare-integer-imm? ] [ >compare< ##compare-integer-imm-branch new-insn ] }
  94         { [ dup ##test? ] [ >compare< ##test-branch new-insn ] }
  95         { [ dup ##test-imm? ] [ >compare< ##test-imm-branch new-insn ] }
  96         { [ dup ##compare-float-unordered? ] [ >compare< ##compare-float-unordered-branch new-insn ] }
  97         { [ dup ##compare-float-ordered? ] [ >compare< ##compare-float-ordered-branch new-insn ] }
  98         { [ dup ##test-vector? ] [ >test-vector< ##test-vector-branch new-insn ] }
  99     } cond ;
 100
 101 : fold-branch ( ? -- insn )
 102     final-iteration? get [
 103         0 1 ?
 104         basic-block get [ nth 1vector ] change-successors drop
 105     ] [ drop ] if
 106     ##branch new-insn ;
 107
 108 : fold-compare-imm-branch ( insn -- insn/f )
 109     evaluate-compare-imm fold-branch ;
 110
 111 : >test-branch ( insn -- insn )
 112     [ src1>> ] [ src1>> ] [ cc>> ] tri ##test-branch new-insn ;
 113
 114 M: ##compare-imm-branch rewrite
 115     {
 116         { [ dup rewrite-boolean-comparison? ] [ rewrite-boolean-comparison ] }
 117         { [ dup fold-compare-imm? ] [ fold-compare-imm-branch ] }
 118         [ drop f ]
 119     } cond ;
 120
 121 : fold-compare-integer-imm-branch ( insn -- insn/f )
 122     evaluate-compare-integer-imm fold-branch ;
 123
 124 M: ##compare-integer-imm-branch rewrite
 125     {
 126         { [ dup fold-compare-integer-imm? ] [ fold-compare-integer-imm-branch ] }
 127         { [ dup rewrite-into-test? ] [ >test-branch ] }
 128         [ drop f ]
 129     } cond ;
 130
 131 : fold-test-imm-branch ( insn -- insn/f )
 132     evaluate-test-imm fold-branch ;
 133
 134 M: ##test-imm-branch rewrite
 135     {
 136         { [ dup fold-test-imm? ] [ fold-test-imm-branch ] }
 137         [ drop f ]
 138     } cond ;
 139
 140 : swap-compare ( src1 src2 cc swap? -- src1 src2 cc )
 141     [ swapd swap-cc ] when ; inline
 142
 143 : (>compare-imm-branch) ( insn swap? -- src1 src2 cc )
 144     [ [ src1>> ] [ src2>> ] [ cc>> ] tri ] dip swap-compare ; inline
 145
 146 : >compare-imm-branch ( insn swap? -- insn' )
 147     (>compare-imm-branch)
 148     [ vreg>literal ] dip
 149     ##compare-imm-branch new-insn ; inline
 150
 151 : >compare-integer-imm-branch ( insn swap? -- insn' )
 152     (>compare-imm-branch)
 153     [ vreg>integer ] dip
 154     ##compare-integer-imm-branch new-insn ; inline
 155
 156 : evaluate-self-compare ( insn -- ? )
 157     cc>> { cc= cc<= cc>= } member-eq? ;
 158
 159 : rewrite-self-compare-branch ( insn -- insn' )
 160     evaluate-self-compare fold-branch ;
 161
 162 M: ##compare-branch rewrite
 163     {
 164         { [ dup src1>> vreg-immediate-comparand? ] [ t >compare-imm-branch ] }
 165         { [ dup src2>> vreg-immediate-comparand? ] [ f >compare-imm-branch ] }
 166         { [ dup diagonal? ] [ rewrite-self-compare-branch ] }
 167         [ drop f ]
 168     } cond ;
 169
 170 M: ##compare-integer-branch rewrite
 171     {
 172         { [ dup src1>> vreg-immediate-arithmetic? ] [ t >compare-integer-imm-branch ] }
 173         { [ dup src2>> vreg-immediate-arithmetic? ] [ f >compare-integer-imm-branch ] }
 174         { [ dup diagonal? ] [ rewrite-self-compare-branch ] }
 175         [ drop f ]
 176     } cond ;
 177
 178 : (>compare-imm) ( insn swap? -- dst src1 src2 cc )
 179     [ { [ dst>> ] [ src1>> ] [ src2>> ] [ cc>> ] } cleave ] dip
 180     swap-compare ; inline
 181
 182 : >compare-imm ( insn swap? -- insn' )
 183     (>compare-imm)
 184     [ vreg>literal ] dip
 185     next-vreg ##compare-imm new-insn ; inline
 186
 187 : >compare-integer-imm ( insn swap? -- insn' )
 188     (>compare-imm)
 189     [ vreg>integer ] dip
 190     next-vreg ##compare-integer-imm new-insn ; inline
 191
 192 : >boolean-insn ( insn ? -- insn' )
 193     [ dst>> ] dip ##load-reference new-insn ;
 194
 195 : rewrite-self-compare ( insn -- insn' )
 196     dup evaluate-self-compare >boolean-insn ;
 197
 198 M: ##compare rewrite
 199     {
 200         { [ dup src1>> vreg-immediate-comparand? ] [ t >compare-imm ] }
 201         { [ dup src2>> vreg-immediate-comparand? ] [ f >compare-imm ] }
 202         { [ dup diagonal? ] [ rewrite-self-compare ] }
 203         [ drop f ]
 204     } cond ;
 205
 206 M: ##compare-integer rewrite
 207     {
 208         { [ dup src1>> vreg-immediate-arithmetic? ] [ t >compare-integer-imm ] }
 209         { [ dup src2>> vreg-immediate-arithmetic? ] [ f >compare-integer-imm ] }
 210         { [ dup diagonal? ] [ rewrite-self-compare ] }
 211         [ drop f ]
 212     } cond ;
 213
 214 : rewrite-redundant-comparison? ( insn -- ? )
 215     {
 216         [ src1>> vreg>insn [ scalar-compare-insn? ] with-available-uses? ]
 217         [ src2>> not ]
 218         [ cc>> { cc= cc/= } member? ]
 219     } 1&& ; inline
 220
 221 : rewrite-redundant-comparison ( insn -- insn' )
 222     [ cc>> ] [ dst>> ] [ src1>> vreg>insn ] tri {
 223         { [ dup ##compare? ] [ >compare< next-vreg ##compare new-insn ] }
 224         { [ dup ##compare-imm? ] [ >compare< next-vreg ##compare-imm new-insn ] }
 225         { [ dup ##compare-integer? ] [ >compare< next-vreg ##compare-integer new-insn ] }
 226         { [ dup ##compare-integer-imm? ] [ >compare< next-vreg ##compare-integer-imm new-insn ] }
 227         { [ dup ##test? ] [ >compare< next-vreg ##test new-insn ] }
 228         { [ dup ##test-imm? ] [ >compare< next-vreg ##test-imm new-insn ] }
 229         { [ dup ##compare-float-unordered? ] [ >compare< next-vreg ##compare-float-unordered new-insn ] }
 230         { [ dup ##compare-float-ordered? ] [ >compare< next-vreg ##compare-float-ordered new-insn ] }
 231     } cond
 232     swap cc= eq? [ [ negate-cc ] change-cc ] when ;
 233
 234 : fold-compare-imm ( insn -- insn' )
 235     dup evaluate-compare-imm >boolean-insn ;
 236
 237 M: ##compare-imm rewrite
 238     {
 239         { [ dup rewrite-redundant-comparison? ] [ rewrite-redundant-comparison ] }
 240         { [ dup fold-compare-imm? ] [ fold-compare-imm ] }
 241         [ drop f ]
 242     } cond ;
 243
 244 : fold-compare-integer-imm ( insn -- insn' )
 245     dup evaluate-compare-integer-imm >boolean-insn ;
 246
 247 : >test ( insn -- insn' )
 248     { [ dst>> ] [ src1>> ] [ src1>> ] [ cc>> ] [ temp>> ] } cleave
 249     ##test new-insn ;
 250
 251 M: ##compare-integer-imm rewrite
 252     {
 253         { [ dup fold-compare-integer-imm? ] [ fold-compare-integer-imm ] }
 254         { [ dup rewrite-into-test? ] [ >test ] }
 255         [ drop f ]
 256     } cond ;
 257
 258 : simplify-test? ( insn -- ? )
 259     src1>> vreg>insn [ ##and? ] with-available-uses? ;
 260
 261 : (simplify-test) ( insn -- src1 src2 cc )
 262     [ src1>> vreg>insn [ src1>> ] [ src2>> ] bi ] [ cc>> ] bi ; inline
 263
 264 : simplify-test ( insn -- insn )
 265     [ dst>> ] [ (simplify-test) ] [ temp>> ] tri ##test new-insn ; inline
 266
 267 : simplify-test-branch ( insn -- insn )
 268     (simplify-test) ##test-branch new-insn ; inline
 269
 270 : simplify-test-imm? ( insn -- ? )
 271     src1>> vreg>insn [ ##and-imm? ] with-available-uses? ;
 272
 273 : (simplify-test-imm) ( insn -- src1 src2 cc )
 274     [ src1>> vreg>insn [ src1>> ] [ src2>> ] bi ] [ cc>> ] bi ; inline
 275
 276 : simplify-test-imm ( insn -- insn )
 277     [ dst>> ] [ (simplify-test-imm) ] [ temp>> ] tri ##test-imm new-insn ; inline
 278
 279 : simplify-test-imm-branch ( insn -- insn )
 280     (simplify-test-imm) ##test-imm-branch new-insn ; inline
 281
 282 : >test-imm ( insn ? -- insn' )
 283     (>compare-imm) [ vreg>integer ] dip next-vreg
 284     ##test-imm new-insn ; inline
 285
 286 : >test-imm-branch ( insn ? -- insn' )
 287     (>compare-imm-branch) [ vreg>integer ] dip
 288     ##test-imm-branch new-insn ; inline
 289
 290 M: ##test rewrite
 291     {
 292         { [ dup src1>> vreg-immediate-comparand? ] [ t >test-imm ] }
 293         { [ dup src2>> vreg-immediate-comparand? ] [ f >test-imm ] }
 294         { [ dup diagonal? ] [
 295             {
 296                 { [ dup simplify-test? ] [ simplify-test ] }
 297                 { [ dup simplify-test-imm? ] [ simplify-test-imm ] }
 298                 [ drop f ]
 299             } cond
 300         ] }
 301         [ drop f ]
 302     } cond ;
 303
 304 M: ##test-branch rewrite
 305     {
 306         { [ dup src1>> vreg-immediate-comparand? ] [ t >test-imm-branch ] }
 307         { [ dup src2>> vreg-immediate-comparand? ] [ f >test-imm-branch ] }
 308         { [ dup diagonal? ] [
 309             {
 310                 { [ dup simplify-test? ] [ simplify-test-branch ] }
 311                 { [ dup simplify-test-imm? ] [ simplify-test-imm-branch ] }
 312                 [ drop f ]
 313             } cond
 314         ] }
 315         [ drop f ]
 316     } cond ;
 317
 318 : fold-test-imm ( insn -- insn' )
 319     dup evaluate-test-imm >boolean-insn ;
 320
 321 M: ##test-imm rewrite
 322     {
 323         { [ dup fold-test-imm? ] [ fold-test-imm ] }
 324         [ drop f ]
 325     } cond ;