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