basis/compiler/cfg/representations/preferred/preferred.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel accessors sequences arrays fry namespaces generic
   4 words sets combinators generalizations cpu.architecture compiler.units
   5 compiler.cfg.utilities compiler.cfg compiler.cfg.rpo
   6 compiler.cfg.instructions compiler.cfg.def-use ;
   7 FROM: compiler.cfg.instructions.syntax => insn-def-slot insn-use-slots insn-temp-slots scalar-rep ;
   8 FROM: namespaces => set ;
   9 IN: compiler.cfg.representations.preferred
  10
  11 GENERIC: defs-vreg-rep ( insn -- rep/f )
  12 GENERIC: temp-vreg-reps ( insn -- reps )
  13 GENERIC: uses-vreg-reps ( insn -- reps )
  14
  15 M: insn defs-vreg-rep drop f ;
  16 M: insn temp-vreg-reps drop { } ;
  17 M: insn uses-vreg-reps drop { } ;
  18
  19 <PRIVATE
  20
  21 : rep-getter-quot ( rep -- quot )
  22     {
  23         { f [ [ rep>> ] ] }
  24         { scalar-rep [ [ rep>> scalar-rep-of ] ] }
  25         [ [ drop ] swap suffix ]
  26     } case ;
  27
  28 : define-defs-vreg-rep-method ( insn -- )
  29     dup insn-def-slot dup [
  30         [ \ defs-vreg-rep create-method ]
  31         [ rep>> rep-getter-quot ]
  32         bi* define
  33     ] [ 2drop ] if ;
  34
  35 : reps-getter-quot ( reps -- quot )
  36     dup [ rep>> { f scalar-rep } member-eq? not ] all? [
  37         [ rep>> ] map [ drop ] swap suffix
  38     ] [
  39         [ rep>> rep-getter-quot ] map dup length {
  40             { 0 [ drop [ drop f ] ] }
  41             { 1 [ first [ 1array ] compose ] }
  42             { 2 [ first2 '[ _ _ bi 2array ] ] }
  43             [ '[ _ cleave _ narray ] ]
  44         } case
  45     ] if ;
  46
  47 : define-uses-vreg-reps-method ( insn -- )
  48     dup insn-use-slots [ drop ] [
  49         [ \ uses-vreg-reps create-method ]
  50         [ reps-getter-quot ]
  51         bi* define
  52     ] if-empty ;
  53
  54 : define-temp-vreg-reps-method ( insn -- )
  55     dup insn-temp-slots [ drop ] [
  56         [ \ temp-vreg-reps create-method ]
  57         [ reps-getter-quot ]
  58         bi* define
  59     ] if-empty ;
  60
  61 PRIVATE>
  62
  63 [
  64     insn-classes get
  65     [ [ define-defs-vreg-rep-method ] each ]
  66     [ { ##phi } diff [ define-uses-vreg-reps-method ] each ]
  67     [ [ define-temp-vreg-reps-method ] each ]
  68     tri
  69 ] with-compilation-unit
  70
  71 : each-def-rep ( ... insn vreg-quot: ( ... vreg rep -- ... ) -- ... )
  72     [ [ defs-vreg ] [ defs-vreg-rep ] bi ] dip with when* ; inline
  73
  74 : each-use-rep ( ... insn vreg-quot: ( ... vreg rep -- ... ) -- ... )
  75     [ [ uses-vregs ] [ uses-vreg-reps ] bi ] dip 2each ; inline
  76
  77 : each-temp-rep ( ... insn vreg-quot: ( ... vreg rep -- ... ) -- ... )
  78     [ [ temp-vregs ] [ temp-vreg-reps ] bi ] dip 2each ; inline
  79
  80 : with-vreg-reps ( ..a cfg vreg-quot: ( ..a vreg rep -- ..b ) -- ..b )
  81     '[
  82         [ basic-block set ] [
  83             [
  84                 _
  85                 [ each-def-rep ]
  86                 [ each-use-rep ]
  87                 [ each-temp-rep ] 2tri
  88             ] each-non-phi
  89         ] bi
  90     ] each-basic-block ; inline