extra/compiler/cfg/gvn/math/math.factor

   1 ! Copyright (C) 2010 Slava Pestov, 2011 Alex Vondrak.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors combinators combinators.short-circuit
   4 compiler.cfg.gvn.avail compiler.cfg.gvn.folding
   5 compiler.cfg.gvn.graph compiler.cfg.gvn.rewrite
   6 compiler.cfg.instructions compiler.cfg.registers
   7 compiler.cfg.utilities cpu.architecture kernel layouts make math
   8 namespaces ;
   9 IN: compiler.cfg.gvn.math
  10
  11 : f-insn? ( insn -- ? )
  12     { [ ##load-reference? ] [ obj>> not ] } 1&& ; inline
  13
  14 : zero-insn? ( insn -- ? )
  15     { [ ##load-integer? ] [ val>> 0 = ] } 1&& ; inline
  16
  17 M: ##tagged>integer rewrite
  18     [ dst>> ] [ src>> vreg>insn ] bi {
  19         { [ dup ##load-integer? ] [ val>> tag-fixnum ##load-integer new-insn ] }
  20         { [ dup f-insn? ] [ drop \ f type-number ##load-integer new-insn ] }
  21         [ 2drop f ]
  22     } cond ;
  23
  24 : self-inverse? ( insn quot -- ? )
  25     [ src>> vreg>insn ] dip with-available-uses? ; inline
  26
  27 : self-inverse ( insn -- insn' )
  28     [ dst>> ] [ src>> vreg>insn src>> ] bi <copy> ;
  29
  30 : identity ( insn -- insn' )
  31     [ dst>> ] [ src1>> ] bi <copy> ;
  32
  33 M: ##neg rewrite
  34     {
  35         { [ dup [ ##neg? ] self-inverse? ] [ self-inverse ] }
  36         { [ dup unary-constant-fold? ] [ unary-constant-fold ] }
  37         [ drop f ]
  38     } cond ;
  39
  40 M: ##not rewrite
  41     {
  42         { [ dup [ ##not? ] self-inverse? ] [ self-inverse ] }
  43         { [ dup unary-constant-fold? ] [ unary-constant-fold ] }
  44         [ drop f ]
  45     } cond ;
  46
  47 ! Reassociation converts
  48 ! ## *-imm 2 1 X
  49 ! ## *-imm 3 2 Y
  50 ! into
  51 ! ## *-imm 3 1 (X $ Y)
  52 ! If * is associative, then $ is the same operation as *.
  53 ! In the case of shifts, $ is addition.
  54 : (reassociate) ( insn -- dst src1 src2' src2'' )
  55     {
  56         [ dst>> ]
  57         [ src1>> vreg>insn [ src1>> ] [ src2>> ] bi ]
  58         [ src2>> ]
  59     } cleave ; inline
  60
  61 : reassociate ( insn -- dst src1 src2 )
  62     [ (reassociate) ] keep binary-constant-fold* ;
  63
  64 : ?new-insn ( dst src1 src2 ? class -- insn/f )
  65     '[ _ new-insn ] [ 3drop f ] if ; inline
  66
  67 : reassociate-arithmetic ( insn new-insn -- insn/f )
  68     [ reassociate dup immediate-arithmetic? ] dip ?new-insn ; inline
  69
  70 : reassociate-bitwise ( insn new-insn -- insn/f )
  71     [ reassociate dup immediate-bitwise? ] dip ?new-insn ; inline
  72
  73 : reassociate-shift ( insn new-insn -- insn/f )
  74     [ (reassociate) + dup immediate-shift-count? ] dip ?new-insn ; inline
  75
  76 M: ##add-imm rewrite
  77     {
  78         { [ dup src2>> 0 = ] [ identity ] }
  79         { [ dup binary-constant-fold? ] [ binary-constant-fold ] }
  80         { [ dup src1>> vreg>insn [ ##add-imm? ] with-available-uses? ] [ ##add-imm reassociate-arithmetic ] }
  81         [ drop f ]
  82     } cond ;
  83
  84 : sub-imm>add-imm ( insn -- insn' )
  85     [ dst>> ] [ src1>> ] [ src2>> neg ] tri
  86     dup immediate-arithmetic?
  87     ##add-imm ?new-insn ;
  88
  89 M: ##sub-imm rewrite sub-imm>add-imm ;
  90
  91 ! Convert ##mul-imm -1 => ##neg
  92 : mul-to-neg? ( insn -- ? )
  93     src2>> -1 = ;
  94
  95 : mul-to-neg ( insn -- insn' )
  96     [ dst>> ] [ src1>> ] bi ##neg new-insn ;
  97
  98 ! Convert ##mul-imm 2^X => ##shl-imm X
  99 : mul-to-shl? ( insn -- ? )
 100     src2>> power-of-2? ;
 101
 102 : mul-to-shl ( insn -- insn' )
 103     [ [ dst>> ] [ src1>> ] bi ] [ src2>> log2 ] bi ##shl-imm new-insn ;
 104
 105 ! Distribution converts
 106 ! ##+-imm 2 1 X
 107 ! ##*-imm 3 2 Y
 108 ! Into
 109 ! ##*-imm 4 1 Y
 110 ! ##+-imm 3 4 X*Y
 111 ! Where * is mul or shl, + is add or sub
 112 ! Have to make sure that X*Y fits in an immediate
 113 :: (distribute) ( outer inner imm temp add-op mul-op -- new-outers/f )
 114     imm immediate-arithmetic? [
 115         [
 116             temp inner src1>> outer src2>> mul-op execute
 117             outer dst>> temp imm add-op execute
 118         ] { } make
 119     ] [ f ] if ; inline
 120
 121 : distribute-over-add? ( insn -- ? )
 122     final-iteration? get [
 123         src1>> vreg>insn [ ##add-imm? ] with-available-uses?
 124     ] [ drop f ] if ;
 125
 126 : distribute-over-sub? ( insn -- ? )
 127     final-iteration? get [
 128         src1>> vreg>insn [ ##sub-imm? ] with-available-uses?
 129     ] [ drop f ] if ;
 130
 131 ! XXX next-vreg makes vregs>vns change on every iteration
 132 : distribute ( insn add-op mul-op -- new-insns/f )
 133     [
 134         dup src1>> vreg>insn
 135         2dup src2>> swap [ src2>> ] keep binary-constant-fold*
 136         next-vreg
 137     ] 2dip (distribute) ; inline
 138
 139 M: ##mul-imm rewrite
 140     {
 141         { [ dup binary-constant-fold? ] [ binary-constant-fold ] }
 142         { [ dup mul-to-neg? ] [ mul-to-neg ] }
 143         { [ dup mul-to-shl? ] [ mul-to-shl ] }
 144         { [ dup src1>> vreg>insn [ ##mul-imm? ] with-available-uses? ] [ ##mul-imm reassociate-arithmetic ] }
 145         { [ dup distribute-over-add? ] [ \ ##add-imm, \ ##mul-imm, distribute ] }
 146         { [ dup distribute-over-sub? ] [ \ ##sub-imm, \ ##mul-imm, distribute ] }
 147         [ drop f ]
 148     } cond ;
 149
 150 M: ##and-imm rewrite
 151     {
 152         { [ dup binary-constant-fold? ] [ binary-constant-fold ] }
 153         { [ dup src1>> vreg>insn [ ##and-imm? ] with-available-uses? ] [ ##and-imm reassociate-bitwise ] }
 154         { [ dup src2>> 0 = ] [ dst>> 0 ##load-integer new-insn ] }
 155         { [ dup src2>> -1 = ] [ identity ] }
 156         [ drop f ]
 157     } cond ;
 158
 159 M: ##or-imm rewrite
 160     {
 161         { [ dup src2>> 0 = ] [ identity ] }
 162         { [ dup src2>> -1 = ] [ dst>> -1 ##load-integer new-insn ] }
 163         { [ dup binary-constant-fold? ] [ binary-constant-fold ] }
 164         { [ dup src1>> vreg>insn [ ##or-imm? ] with-available-uses? ] [ ##or-imm reassociate-bitwise ] }
 165         [ drop f ]
 166     } cond ;
 167
 168 M: ##xor-imm rewrite
 169     {
 170         { [ dup src2>> 0 = ] [ identity ] }
 171         { [ dup src2>> -1 = ] [ [ dst>> ] [ src1>> ] bi ##not new-insn ] }
 172         { [ dup binary-constant-fold? ] [ binary-constant-fold ] }
 173         { [ dup src1>> vreg>insn [ ##xor-imm? ] with-available-uses? ] [ ##xor-imm reassociate-bitwise ] }
 174         [ drop f ]
 175     } cond ;
 176
 177 M: ##shl-imm rewrite
 178     {
 179         { [ dup src2>> 0 = ] [ identity ] }
 180         { [ dup binary-constant-fold? ] [ binary-constant-fold ] }
 181         { [ dup src1>> vreg>insn [ ##shl-imm? ] with-available-uses? ] [ ##shl-imm reassociate-shift ] }
 182         { [ dup distribute-over-add? ] [ \ ##add-imm, \ ##shl-imm, distribute ] }
 183         { [ dup distribute-over-sub? ] [ \ ##sub-imm, \ ##shl-imm, distribute ] }
 184         [ drop f ]
 185     } cond ;
 186
 187 M: ##shr-imm rewrite
 188     {
 189         { [ dup src2>> 0 = ] [ identity ] }
 190         { [ dup binary-constant-fold? ] [ binary-constant-fold ] }
 191         { [ dup src1>> vreg>insn [ ##shr-imm? ] with-available-uses? ] [ ##shr-imm reassociate-shift ] }
 192         [ drop f ]
 193     } cond ;
 194
 195 M: ##sar-imm rewrite
 196     {
 197         { [ dup src2>> 0 = ] [ identity ] }
 198         { [ dup binary-constant-fold? ] [ binary-constant-fold ] }
 199         { [ dup src1>> vreg>insn [ ##sar-imm? ] with-available-uses? ] [ ##sar-imm reassociate-shift ] }
 200         [ drop f ]
 201     } cond ;
 202
 203 ! Convert
 204 ! ##load-integer 2 X
 205 ! ##* 3 1 2
 206 ! Where * is an operation with an -imm equivalent into
 207 ! ##*-imm 3 1 X
 208 : insn>imm-insn ( insn op swap? -- new-insn )
 209     swap [
 210         [ [ dst>> ] [ src1>> ] [ src2>> ] tri ] dip
 211         [ swap ] when vreg>integer
 212     ] dip new-insn ; inline
 213
 214 M: ##add rewrite
 215     {
 216         { [ dup src2>> vreg-immediate-arithmetic? ] [ ##add-imm f insn>imm-insn ] }
 217         { [ dup src1>> vreg-immediate-arithmetic? ] [ ##add-imm t insn>imm-insn ] }
 218         [ drop f ]
 219     } cond ;
 220
 221 : diagonal? ( insn -- ? )
 222     [ src1>> vreg>vn ] [ src2>> vreg>vn ] bi = ; inline
 223
 224 ! ##sub 2 1 1 => ##load-integer 2 0
 225 : rewrite-subtraction-identity ( insn -- insn' )
 226     dst>> 0 ##load-integer new-insn ;
 227
 228 ! ##load-integer 1 0
 229 ! ##sub 3 1 2
 230 ! =>
 231 ! ##neg 3 2
 232 : sub-to-neg? ( ##sub -- ? )
 233     src1>> vreg>insn zero-insn? ;
 234
 235 : sub-to-neg ( ##sub -- insn )
 236     [ dst>> ] [ src2>> ] bi ##neg new-insn ;
 237
 238 M: ##sub rewrite
 239     {
 240         { [ dup sub-to-neg? ] [ sub-to-neg ] }
 241         { [ dup diagonal? ] [ rewrite-subtraction-identity ] }
 242         { [ dup src2>> vreg-immediate-arithmetic? ] [ ##sub-imm f insn>imm-insn ] }
 243         [ drop f ]
 244     } cond ;
 245
 246 M: ##mul rewrite
 247     {
 248         { [ dup src2>> vreg-immediate-arithmetic? ] [ ##mul-imm f insn>imm-insn ] }
 249         { [ dup src1>> vreg-immediate-arithmetic? ] [ ##mul-imm t insn>imm-insn ] }
 250         [ drop f ]
 251     } cond ;
 252
 253 M: ##and rewrite
 254     {
 255         { [ dup diagonal? ] [ identity ] }
 256         { [ dup src2>> vreg-immediate-bitwise? ] [ ##and-imm f insn>imm-insn ] }
 257         { [ dup src1>> vreg-immediate-bitwise? ] [ ##and-imm t insn>imm-insn ] }
 258         [ drop f ]
 259     } cond ;
 260
 261 M: ##or rewrite
 262     {
 263         { [ dup diagonal? ] [ identity ] }
 264         { [ dup src2>> vreg-immediate-bitwise? ] [ ##or-imm f insn>imm-insn ] }
 265         { [ dup src1>> vreg-immediate-bitwise? ] [ ##or-imm t insn>imm-insn ] }
 266         [ drop f ]
 267     } cond ;
 268
 269 M: ##xor rewrite
 270     {
 271         { [ dup diagonal? ] [ dst>> 0 ##load-integer new-insn ] }
 272         { [ dup src2>> vreg-immediate-bitwise? ] [ ##xor-imm f insn>imm-insn ] }
 273         { [ dup src1>> vreg-immediate-bitwise? ] [ ##xor-imm t insn>imm-insn ] }
 274         [ drop f ]
 275     } cond ;
 276
 277 M: ##shl rewrite
 278     {
 279         { [ dup src2>> vreg-immediate-bitwise? ] [ ##shl-imm f insn>imm-insn ] }
 280         [ drop f ]
 281     } cond ;
 282
 283 M: ##shr rewrite
 284     {
 285         { [ dup src2>> vreg-immediate-bitwise? ] [ ##shr-imm f insn>imm-insn ] }
 286         [ drop f ]
 287     } cond ;
 288
 289 M: ##sar rewrite
 290     {
 291         { [ dup src2>> vreg-immediate-bitwise? ] [ ##sar-imm f insn>imm-insn ] }
 292         [ drop f ]
 293     } cond ;