basis/compiler/cfg/def-use/def-use.factor

   1 ! Copyright (C) 2008, 2011 Slava Pestov, Daniel Ehrenberg.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs arrays classes combinators
   4 compiler.units fry generalizations sequences.generalizations
   5 generic kernel locals namespaces quotations sequences sets slots
   6 words compiler.cfg.instructions compiler.cfg.instructions.syntax
   7 compiler.cfg.rpo compiler.cfg ;
   8 FROM: namespaces => set ;
   9 FROM: sets => members ;
  10 IN: compiler.cfg.def-use
  11
  12 ! Utilities for iterating over instruction operands
  13
  14 ! Def-use protocol
  15 GENERIC: defs-vregs ( insn -- seq )
  16 GENERIC: temp-vregs ( insn -- seq )
  17 GENERIC: uses-vregs ( insn -- seq )
  18
  19 M: insn defs-vregs drop { } ;
  20 M: insn temp-vregs drop { } ;
  21 M: insn uses-vregs drop { } ;
  22
  23 ! Instructions with unusual operands, also see these passes
  24 ! for special behavior:
  25 ! - compiler.cfg.renaming.functor
  26 ! - compiler.cfg.representations.preferred
  27 CONSTANT: special-vreg-insns {
  28     ##parallel-copy
  29     ##phi
  30     ##alien-invoke
  31     ##alien-indirect
  32     ##alien-assembly
  33     ##callback-inputs
  34     ##callback-outputs
  35 }
  36
  37 ! Special defs-vregs methods
  38 M: ##parallel-copy defs-vregs values>> [ first ] map ;
  39
  40 M: ##phi defs-vregs dst>> 1array ;
  41
  42 M: alien-call-insn defs-vregs
  43     reg-outputs>> [ first ] map ;
  44
  45 M: ##callback-inputs defs-vregs
  46     [ reg-outputs>> ] [ stack-outputs>> ] bi append [ first ] map ;
  47
  48 M: ##callback-outputs defs-vregs drop { } ;
  49
  50 ! Special uses-vregs methods
  51 M: ##parallel-copy uses-vregs values>> [ second ] map ;
  52
  53 M: ##phi uses-vregs inputs>> values ;
  54
  55 M: alien-call-insn uses-vregs
  56     [ reg-inputs>> ] [ stack-inputs>> ] bi append [ first ] map ;
  57
  58 M: ##alien-indirect uses-vregs
  59     [ call-next-method ] [ src>> ] bi prefix ;
  60
  61 M: ##callback-inputs uses-vregs
  62     drop { } ;
  63
  64 M: ##callback-outputs uses-vregs
  65     reg-inputs>> [ first ] map ;
  66
  67 ! Generate defs-vregs, uses-vregs and temp-vregs for everything
  68 ! else
  69 <PRIVATE
  70
  71 : slot-array-quot ( slots -- quot )
  72     [ reader-word 1quotation ] map dup length {
  73         { 0 [ drop [ drop f ] ] }
  74         { 1 [ first [ 1array ] compose ] }
  75         { 2 [ first2 '[ _ _ bi 2array ] ] }
  76         [ '[ _ cleave _ narray ] ]
  77     } case ;
  78
  79 : define-vregs-method ( insn slots word -- )
  80     [ [ drop ] ] dip '[
  81         [ _ create-method ]
  82         [ [ name>> ] map slot-array-quot ] bi*
  83         define
  84     ] if-empty ; inline
  85
  86 : define-defs-vregs-method ( insn -- )
  87     dup insn-def-slots \ defs-vregs define-vregs-method ;
  88
  89 : define-uses-vregs-method ( insn -- )
  90     dup insn-use-slots \ uses-vregs define-vregs-method ;
  91
  92 : define-temp-vregs-method ( insn -- )
  93     dup insn-temp-slots \ temp-vregs define-vregs-method ;
  94
  95 PRIVATE>
  96
  97 [
  98     insn-classes get
  99     [ special-vreg-insns diff [ define-defs-vregs-method ] each ]
 100     [ special-vreg-insns diff [ define-uses-vregs-method ] each ]
 101     [ [ define-temp-vregs-method ] each ]
 102     tri
 103 ] with-compilation-unit
 104
 105 ! Computing vreg -> insn -> bb mapping
 106 SYMBOLS: defs insns ;
 107
 108 : def-of ( vreg -- node ) defs get at ;
 109 : insn-of ( vreg -- insn ) insns get at ;
 110
 111 : set-def-of ( obj insn assoc -- )
 112     swap defs-vregs [ swap set-at ] 2with each ;
 113
 114 : compute-defs ( cfg -- )
 115     H{ } clone [
 116         '[
 117             [ basic-block get ] dip [
 118                 _ set-def-of
 119             ] with each
 120         ] simple-analysis
 121     ] keep defs set ;
 122
 123 : compute-insns ( cfg -- )
 124     H{ } clone [
 125         '[
 126             [
 127                 dup _ set-def-of
 128             ] each
 129         ] simple-analysis
 130     ] keep insns set ;