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