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

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