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

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel sequences layouts accessors combinators namespaces
   4 math fry
   5 compiler.cfg.hats
   6 compiler.cfg.instructions
   7 compiler.cfg.value-numbering.graph
   8 compiler.cfg.value-numbering.simplify
   9 compiler.cfg.value-numbering.expressions ;
  10 IN: compiler.cfg.value-numbering.rewrite
  11
  12 GENERIC: rewrite ( insn -- insn' )
  13
  14 M: ##mul-imm rewrite
  15     dup src2>> dup power-of-2? [
  16         [ [ dst>> ] [ src1>> ] bi ] [ log2 ] bi* \ ##shl-imm new-insn
  17         dup number-values
  18     ] [ drop ] if ;
  19
  20 : ##branch-t? ( insn -- ? )
  21     dup ##compare-imm-branch? [
  22         [ cc>> cc/= eq? ]
  23         [ src2>> \ f tag-number eq? ] bi and
  24     ] [ drop f ] if ; inline
  25
  26 : rewrite-boolean-comparison? ( insn -- ? )
  27     dup ##branch-t? [
  28         src1>> vreg>expr compare-expr?
  29     ] [ drop f ] if ; inline
  30
  31 : >compare-expr< ( expr -- in1 in2 cc )
  32     [ in1>> vn>vreg ] [ in2>> vn>vreg ] [ cc>> ] tri ; inline
  33
  34 : >compare-imm-expr< ( expr -- in1 in2 cc )
  35     [ in1>> vn>vreg ] [ in2>> vn>constant ] [ cc>> ] tri ; inline
  36
  37 : rewrite-boolean-comparison ( expr -- insn )
  38     src1>> vreg>expr dup op>> {
  39         { \ ##compare [ >compare-expr< \ ##compare-branch new-insn ] }
  40         { \ ##compare-imm [ >compare-imm-expr< \ ##compare-imm-branch new-insn ] }
  41         { \ ##compare-float [ >compare-expr< \ ##compare-float-branch new-insn ] }
  42     } case ;
  43
  44 : tag-fixnum-expr? ( expr -- ? )
  45     dup op>> \ ##shl-imm eq?
  46     [ in2>> vn>constant tag-bits get = ] [ drop f ] if ;
  47
  48 : rewrite-tagged-comparison? ( insn -- ? )
  49     #! Are we comparing two tagged fixnums? Then untag them.
  50     [ src1>> vreg>expr tag-fixnum-expr? ]
  51     [ src2>> tag-mask get bitand 0 = ]
  52     bi and ; inline
  53
  54 : (rewrite-tagged-comparison) ( insn -- src1 src2 cc )
  55     [ src1>> vreg>expr in1>> vn>vreg ]
  56     [ src2>> tag-bits get neg shift ]
  57     [ cc>> ]
  58     tri ; inline
  59
  60 GENERIC: rewrite-tagged-comparison ( insn -- insn' )
  61
  62 M: ##compare-imm-branch rewrite-tagged-comparison
  63     (rewrite-tagged-comparison) \ ##compare-imm-branch new-insn ;
  64
  65 M: ##compare-imm rewrite-tagged-comparison
  66     [ dst>> ] [ (rewrite-tagged-comparison) ] bi
  67     i \ ##compare-imm new-insn ;
  68
  69 M: ##compare-imm-branch rewrite
  70     dup rewrite-boolean-comparison? [ rewrite-boolean-comparison ] when
  71     dup ##compare-imm-branch? [
  72         dup rewrite-tagged-comparison? [ rewrite-tagged-comparison ] when
  73     ] when ;
  74
  75 : flip-comparison? ( insn -- ? )
  76     dup cc>> cc= eq? [ src1>> vreg>expr constant-expr? ] [ drop f ] if ;
  77
  78 : flip-comparison ( insn -- insn' )
  79     [ dst>> ]
  80     [ src2>> ]
  81     [ src1>> vreg>vn vn>constant ] tri
  82     cc= i \ ##compare-imm new-insn ;
  83
  84 M: ##compare rewrite
  85     dup flip-comparison? [
  86         flip-comparison
  87         dup number-values
  88         rewrite
  89     ] when ;
  90
  91 : rewrite-redundant-comparison? ( insn -- ? )
  92     [ src1>> vreg>expr compare-expr? ]
  93     [ src2>> \ f tag-number = ]
  94     [ cc>> { cc= cc/= } memq? ]
  95     tri and and ; inline
  96
  97 : rewrite-redundant-comparison ( insn -- insn' )
  98     [ cc>> ] [ dst>> ] [ src1>> vreg>expr dup op>> ] tri {
  99         { \ ##compare [ >compare-expr< i \ ##compare new-insn ] }
 100         { \ ##compare-imm [ >compare-imm-expr< i \ ##compare-imm new-insn ] }
 101         { \ ##compare-float [ >compare-expr< i \ ##compare-float new-insn ] }
 102     } case
 103     swap cc= eq? [ [ negate-cc ] change-cc ] when ;
 104
 105 M: ##compare-imm rewrite
 106     dup rewrite-redundant-comparison? [
 107         rewrite-redundant-comparison
 108         dup number-values rewrite
 109     ] when
 110     dup ##compare-imm? [
 111         dup rewrite-tagged-comparison? [
 112             rewrite-tagged-comparison
 113             dup number-values rewrite
 114         ] when
 115     ] when ;
 116
 117 M: insn rewrite ;