extra/compiler/cfg/gvn/alien/alien.factor

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