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

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