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