basis/compiler/cfg/representations/rewrite/rewrite.factor

   1 ! Copyright (C) 2010 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: arrays assocs compiler.cfg.instructions
   4 compiler.cfg.registers compiler.cfg.renaming.functor
   5 compiler.cfg.representations.conversion
   6 compiler.cfg.representations.preferred compiler.cfg.rpo kernel
   7 make namespaces sequences ;
   8 IN: compiler.cfg.representations.rewrite
   9
  10 ! Insert conversions. This introduces new temporaries, so we need
  11 ! to rename opearands too.
  12
  13 SYMBOL: alternatives
  14
  15 :: (emit-def-conversion) ( dst preferred required -- new-dst' )
  16     ! If an instruction defines a register with representation 'required',
  17     ! but the register has preferred representation 'preferred', then
  18     ! we rename the instruction's definition to a new register, which
  19     ! becomes the input of a conversion instruction.
  20     dst required next-vreg-rep [ preferred required emit-conversion ] keep ;
  21
  22 :: (emit-use-conversion) ( src preferred required -- new-src' )
  23     ! If an instruction uses a register with representation 'required',
  24     ! but the register has preferred representation 'preferred', then
  25     ! we rename the instruction's input to a new register, which
  26     ! becomes the output of a conversion instruction.
  27     preferred required eq? [ src ] [
  28         src required alternatives get [
  29             required next-vreg-rep :> new-src
  30             [ new-src ] 2dip preferred emit-conversion
  31             new-src
  32         ] 2cache
  33     ] if ;
  34
  35 SYMBOLS: renaming-set needs-renaming? ;
  36
  37 : init-renaming-set ( -- )
  38     needs-renaming? off
  39     renaming-set get delete-all ;
  40
  41 : no-renaming ( vreg -- )
  42     dup 2array renaming-set get push ;
  43
  44 : record-renaming ( from to -- )
  45     2array renaming-set get push needs-renaming? on ;
  46
  47 :: (compute-renaming-set) ( vreg required quot: ( vreg preferred required -- new-vreg ) -- )
  48     vreg rep-of :> preferred
  49     preferred required eq?
  50     [ vreg no-renaming ]
  51     [ vreg vreg preferred required quot call record-renaming ] if ; inline
  52
  53 : emit-use-conversion ( insn -- )
  54     [ [ (emit-use-conversion) ] (compute-renaming-set) ] each-use-rep ;
  55
  56 : no-use-conversion ( insn -- )
  57     [ drop no-renaming ] each-use-rep ;
  58
  59 : emit-def-conversion ( insn -- )
  60     [ [ (emit-def-conversion) ] (compute-renaming-set) ] each-def-rep ;
  61
  62 : no-def-conversion ( insn -- )
  63     [ drop no-renaming ] each-def-rep ;
  64
  65 : converted-value ( vreg -- vreg' )
  66     renaming-set get pop first2 [ assert= ] dip ;
  67
  68 RENAMING: convert [ converted-value ] [ converted-value ] [ ]
  69
  70 : perform-renaming ( insn -- )
  71     needs-renaming? get [
  72         renaming-set get reverse! drop
  73         [ convert-insn-uses ] [ convert-insn-defs ] bi
  74         renaming-set get length 0 assert=
  75     ] [ drop ] if ;
  76
  77 GENERIC: conversions-for-insn ( insn -- )
  78
  79 M: ##phi conversions-for-insn , ;
  80
  81 M: ##copy conversions-for-insn , ;
  82
  83 M: insn conversions-for-insn , ;
  84
  85 : conversions-for-block ( insns -- insns )
  86     [
  87         alternatives get clear-assoc
  88         [ conversions-for-insn ] each
  89     ] V{ } make ;
  90
  91 : insert-conversions ( cfg -- )
  92     H{ } clone alternatives set
  93     V{ } clone renaming-set set
  94     [ conversions-for-block ] simple-optimization ;