basis/compiler/cfg/value-numbering/comparisons/comparisons.factor

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