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.instructions.syntax
   7 compiler.cfg.def-use ;
   8 IN: compiler.cfg.representations.preferred
   9
  10 GENERIC: defs-vreg-rep ( insn -- rep/f )
  11 GENERIC: temp-vreg-reps ( insn -- reps )
  12 GENERIC: uses-vreg-reps ( insn -- reps )
  13
  14 <PRIVATE
  15
  16 : rep-getter-quot ( rep -- quot )
  17     {
  18         { f [ [ rep>> ] ] }
  19         { scalar-rep [ [ rep>> scalar-rep-of ] ] }
  20         [ [ drop ] swap suffix ]
  21     } case ;
  22
  23 : define-defs-vreg-rep-method ( insn -- )
  24     [ \ defs-vreg-rep create-method ]
  25     [ insn-def-slot [ rep>> rep-getter-quot ] [ [ drop f ] ] if* ]
  26     bi define ;
  27
  28 : reps-getter-quot ( reps -- quot )
  29     dup [ rep>> { f scalar-rep } memq? not ] all? [
  30         [ rep>> ] map [ drop ] swap suffix
  31     ] [
  32         [ rep>> rep-getter-quot ] map dup length {
  33             { 0 [ drop [ drop f ] ] }
  34             { 1 [ first [ 1array ] compose ] }
  35             { 2 [ first2 '[ _ _ bi 2array ] ] }
  36             [ '[ _ cleave _ narray ] ]
  37         } case
  38     ] if ;
  39
  40 : define-uses-vreg-reps-method ( insn -- )
  41     [ \ uses-vreg-reps create-method ]
  42     [ insn-use-slots reps-getter-quot ]
  43     bi define ;
  44
  45 : define-temp-vreg-reps-method ( insn -- )
  46     [ \ temp-vreg-reps create-method ]
  47     [ insn-temp-slots reps-getter-quot ]
  48     bi define ;
  49
  50 PRIVATE>
  51
  52 [
  53     insn-classes get
  54     [ [ define-defs-vreg-rep-method ] each ]
  55     [ { ##phi } diff [ define-uses-vreg-reps-method ] each ]
  56     [ [ define-temp-vreg-reps-method ] each ]
  57     tri
  58 ] with-compilation-unit
  59
  60 : each-def-rep ( insn vreg-quot: ( vreg rep -- ) -- )
  61     [ [ defs-vreg ] [ defs-vreg-rep ] bi ] dip with when* ; inline
  62
  63 : each-use-rep ( insn vreg-quot: ( vreg rep -- ) -- )
  64     [ [ uses-vregs ] [ uses-vreg-reps ] bi ] dip 2each ; inline
  65
  66 : each-temp-rep ( insn vreg-quot: ( vreg rep -- ) -- )
  67     [ [ temp-vregs ] [ temp-vreg-reps ] bi ] dip 2each ; inline
  68
  69 : with-vreg-reps ( cfg vreg-quot: ( vreg rep -- ) -- )
  70     '[
  71         [ basic-block set ] [
  72             [
  73                 _
  74                 [ each-def-rep ]
  75                 [ each-use-rep ]
  76                 [ each-temp-rep ] 2tri
  77             ] each-non-phi
  78         ] bi
  79     ] each-basic-block ; inline