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

   1 ! Copyright (C) 2008, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays kernel assocs sequences namespaces fry
   4 sets compiler.cfg.rpo compiler.cfg.instructions ;
   5 IN: compiler.cfg.def-use
   6
   7 GENERIC: defs-vreg ( insn -- vreg/f )
   8 GENERIC: temp-vregs ( insn -- seq )
   9 GENERIC: uses-vregs ( insn -- seq )
  10
  11 M: ##flushable defs-vreg dst>> ;
  12 M: ##fixnum-overflow defs-vreg dst>> ;
  13 M: _fixnum-overflow defs-vreg dst>> ;
  14 M: insn defs-vreg drop f ;
  15
  16 M: ##write-barrier temp-vregs [ card#>> ] [ table>> ] bi 2array ;
  17 M: ##unary/temp temp-vregs temp>> 1array ;
  18 M: ##allot temp-vregs temp>> 1array ;
  19 M: ##dispatch temp-vregs temp>> 1array ;
  20 M: ##slot temp-vregs temp>> 1array ;
  21 M: ##set-slot temp-vregs temp>> 1array ;
  22 M: ##string-nth temp-vregs temp>> 1array ;
  23 M: ##set-string-nth-fast temp-vregs temp>> 1array ;
  24 M: ##compare temp-vregs temp>> 1array ;
  25 M: ##compare-imm temp-vregs temp>> 1array ;
  26 M: ##compare-float temp-vregs temp>> 1array ;
  27 M: ##gc temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ;
  28 M: _dispatch temp-vregs temp>> 1array ;
  29 M: insn temp-vregs drop f ;
  30
  31 M: ##unary uses-vregs src>> 1array ;
  32 M: ##binary uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
  33 M: ##binary-imm uses-vregs src1>> 1array ;
  34 M: ##effect uses-vregs src>> 1array ;
  35 M: ##slot uses-vregs [ obj>> ] [ slot>> ] bi 2array ;
  36 M: ##slot-imm uses-vregs obj>> 1array ;
  37 M: ##set-slot uses-vregs [ src>> ] [ obj>> ] [ slot>> ] tri 3array ;
  38 M: ##set-slot-imm uses-vregs [ src>> ] [ obj>> ] bi 2array ;
  39 M: ##string-nth uses-vregs [ obj>> ] [ index>> ] bi 2array ;
  40 M: ##set-string-nth-fast uses-vregs [ src>> ] [ obj>> ] [ index>> ] tri 3array ;
  41 M: ##conditional-branch uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
  42 M: ##compare-imm-branch uses-vregs src1>> 1array ;
  43 M: ##dispatch uses-vregs src>> 1array ;
  44 M: ##alien-getter uses-vregs src>> 1array ;
  45 M: ##alien-setter uses-vregs [ src>> ] [ value>> ] bi 2array ;
  46 M: ##fixnum-overflow uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
  47 M: ##phi uses-vregs inputs>> values ;
  48 M: _conditional-branch uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
  49 M: _compare-imm-branch uses-vregs src1>> 1array ;
  50 M: _dispatch uses-vregs src>> 1array ;
  51 M: insn uses-vregs drop f ;
  52
  53 ! Computing def-use chains.
  54
  55 SYMBOLS: defs insns uses ;
  56
  57 : def-of ( vreg -- node ) defs get at ;
  58 : uses-of ( vreg -- nodes ) uses get at ;
  59 : insn-of ( vreg -- insn ) insns get at ;
  60
  61 : set-def-of ( obj insn assoc -- )
  62     swap defs-vreg dup [ swap set-at ] [ 3drop ] if ;
  63
  64 : compute-defs ( cfg -- )
  65     H{ } clone [
  66         '[
  67             dup instructions>> [
  68                 _ set-def-of
  69             ] with each
  70         ] each-basic-block
  71     ] keep
  72     defs set ;
  73
  74 : compute-insns ( cfg -- )
  75     H{ } clone [
  76         '[
  77             instructions>> [
  78                 dup _ set-def-of
  79             ] each
  80         ] each-basic-block
  81     ] keep insns set ;
  82
  83 : compute-uses ( cfg -- )
  84     H{ } clone [
  85         '[
  86             dup instructions>> [
  87                 uses-vregs [
  88                     _ conjoin-at
  89                 ] with each
  90             ] with each
  91         ] each-basic-block
  92     ] keep
  93     [ keys ] assoc-map
  94     uses set ;
  95
  96 : compute-def-use ( cfg -- )
  97     [ compute-defs ] [ compute-uses ] [ compute-insns ] tri ;