extra/compiler/cfg/gvn/alien/alien.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 fry
   4 kernel make math namespaces sequences
   5 cpu.architecture
   6 compiler.cfg.hats
   7 compiler.cfg.utilities
   8 compiler.cfg.registers
   9 compiler.cfg.instructions
  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.alien
  15
  16 M: ##box-displaced-alien rewrite
  17     dup displacement>> vreg>insn zero-insn?
  18     [ [ dst>> ] [ base>> ] bi <copy> ] [ drop f ] if ;
  19
  20 ! ##box-displaced-alien f 1 2 3 <class>
  21 ! ##unbox-c-ptr 4 1 <class>
  22 ! =>
  23 ! ##box-displaced-alien f 1 2 3 <class>
  24 ! ##unbox-c-ptr 5 3 <class>
  25 ! ##add 4 5 2
  26
  27 : rewrite-unbox-alien ( insn box-insn -- insn )
  28     [ dst>> ] [ src>> ] bi* <copy> ;
  29
  30 ! XXX  next-vreg makes vregs>vns change on every iteration
  31 ! (hidden in ^^unbox-c-ptr)
  32 : rewrite-unbox-displaced-alien ( insn box-insn -- insns )
  33     [
  34         [ dst>> ]
  35         [ [ base>> ] [ base-class>> ] [ displacement>> ] tri ] bi*
  36         [ ^^unbox-c-ptr ] dip
  37         ##add,
  38     ] { } make ;
  39
  40 : rewrite-unbox-any-c-ptr ( insn -- insn/f )
  41     dup src>> vreg>insn
  42     {
  43         {
  44             [ dup [ ##box-alien? ] with-available-uses? ]
  45             [ rewrite-unbox-alien ]
  46         }
  47         {
  48             ! [ dup [ ##box-displaced-alien? ] with-available-uses? ]
  49             [
  50                 final-iteration? get [
  51                     dup [ ##box-displaced-alien? ] with-available-uses?
  52                 ] [ f ] if
  53             ]
  54             [ rewrite-unbox-displaced-alien ]
  55         }
  56         [ 2drop f ]
  57     } cond ;
  58
  59 M: ##unbox-any-c-ptr rewrite rewrite-unbox-any-c-ptr ;
  60
  61 M: ##unbox-alien rewrite rewrite-unbox-any-c-ptr ;
  62
  63 ! Fuse ##add-imm into ##load-memory(-imm) and ##store-memory(-imm)
  64 ! just update the offset in the instruction
  65 : fuse-base-offset? ( insn -- ? )
  66     base>> vreg>insn [ ##add-imm? ] with-available-uses? ;
  67
  68 : fuse-base-offset ( insn -- insn' )
  69     clone dup base>> vreg>insn
  70     [ src1>> ] [ src2>> ] bi
  71     [ >>base ] [ '[ _ + ] change-offset ] bi* ;
  72
  73 ! Fuse ##add-imm into ##load-memory and ##store-memory
  74 ! just update the offset in the instruction
  75 : fuse-displacement-offset? ( insn -- ? )
  76     {
  77         [ scale>> 0 = ]
  78         [ displacement>> vreg>insn [ ##add-imm? ] with-available-uses? ]
  79     } 1&& ;
  80
  81 : fuse-displacement-offset ( insn -- insn' )
  82     clone dup displacement>> vreg>insn
  83     [ src1>> ] [ src2>> ] bi
  84     [ >>displacement ] [ '[ _ + ] change-offset ] bi* ;
  85
  86 ! Fuse ##add into ##load-memory-imm and ##store-memory-imm
  87 ! construct a new ##load-memory or ##store-memory with the
  88 ! ##add's operand as the displacement
  89 : fuse-displacement? ( insn -- ? )
  90     {
  91         [ offset>> 0 = complex-addressing? or ]
  92         [ base>> vreg>insn [ ##add? ] with-available-uses? ]
  93     } 1&& ;
  94
  95 GENERIC: alien-insn-value ( insn -- value )
  96
  97 M: ##load-memory-imm alien-insn-value dst>> ;
  98 M: ##store-memory-imm alien-insn-value src>> ;
  99
 100 GENERIC: new-alien-insn ( value base displacement scale offset rep c-type insn -- insn )
 101
 102 M: ##load-memory-imm new-alien-insn drop ##load-memory new-insn ;
 103 M: ##store-memory-imm new-alien-insn drop ##store-memory new-insn ;
 104
 105 : fuse-displacement ( insn -- insn' )
 106     {
 107         [ alien-insn-value ]
 108         [ base>> vreg>insn [ src1>> ] [ src2>> ] bi ]
 109         [ drop 0 ]
 110         [ offset>> ]
 111         [ rep>> ]
 112         [ c-type>> ]
 113         [ ]
 114     } cleave new-alien-insn ;
 115
 116 ! Fuse ##shl-imm into ##load-memory or ##store-memory
 117 : scale-insn? ( insn -- ? )
 118     { [ ##shl-imm? ] [ src2>> { 1 2 3 } member? ] } 1&& ;
 119
 120 : fuse-scale? ( insn -- ? )
 121     {
 122         [ scale>> 0 = ]
 123         [ displacement>> vreg>insn [ scale-insn? ] with-available-uses? ]
 124     } 1&& ;
 125
 126 : fuse-scale ( insn -- insn' )
 127     clone dup displacement>> vreg>insn
 128     [ src1>> ] [ src2>> ] bi
 129     [ >>displacement ] [ >>scale ] bi* ;
 130
 131 : rewrite-memory-op ( insn -- insn/f )
 132     complex-addressing? [
 133         {
 134             { [ dup fuse-base-offset? ] [ fuse-base-offset ] }
 135             { [ dup fuse-displacement-offset? ] [ fuse-displacement-offset ] }
 136             { [ dup fuse-scale? ] [ fuse-scale ] }
 137             [ drop f ]
 138         } cond
 139     ] [ drop f ] if ;
 140
 141 : rewrite-memory-imm-op ( insn -- insn/f )
 142     {
 143         { [ dup fuse-base-offset? ] [ fuse-base-offset ] }
 144         { [ dup fuse-displacement? ] [ fuse-displacement ] }
 145         [ drop f ]
 146     } cond ;
 147
 148 M: ##load-memory rewrite rewrite-memory-op ;
 149 M: ##load-memory-imm rewrite rewrite-memory-imm-op ;
 150 M: ##store-memory rewrite rewrite-memory-op ;
 151 M: ##store-memory-imm rewrite rewrite-memory-imm-op ;