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

! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays kernel assocs sequences namespaces fry
sets compiler.cfg.rpo compiler.cfg.instructions ;
IN: compiler.cfg.def-use

GENERIC: defs-vregs ( insn -- seq )
GENERIC: temp-vregs ( insn -- seq )
GENERIC: uses-vregs ( insn -- seq )

M: ##flushable defs-vregs dst>> 1array ;
M: ##fixnum-overflow defs-vregs dst>> 1array ;
M: _fixnum-overflow defs-vregs dst>> 1array ;
M: insn defs-vregs drop f ;

M: ##write-barrier temp-vregs [ card#>> ] [ table>> ] bi 2array ;
M: ##unary/temp temp-vregs temp>> 1array ;
M: ##allot temp-vregs temp>> 1array ;
M: ##dispatch temp-vregs temp>> 1array ;
M: ##slot temp-vregs temp>> 1array ;
M: ##set-slot temp-vregs temp>> 1array ;
M: ##string-nth temp-vregs temp>> 1array ;
M: ##set-string-nth-fast temp-vregs temp>> 1array ;
M: ##compare temp-vregs temp>> 1array ;
M: ##compare-imm temp-vregs temp>> 1array ;
M: ##compare-float temp-vregs temp>> 1array ;
M: ##gc temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ;
M: _dispatch temp-vregs temp>> 1array ;
M: insn temp-vregs drop f ;

M: ##unary uses-vregs src>> 1array ;
M: ##binary uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
M: ##binary-imm uses-vregs src1>> 1array ;
M: ##effect uses-vregs src>> 1array ;
M: ##slot uses-vregs [ obj>> ] [ slot>> ] bi 2array ;
M: ##slot-imm uses-vregs obj>> 1array ;
M: ##set-slot uses-vregs [ src>> ] [ obj>> ] [ slot>> ] tri 3array ;
M: ##set-slot-imm uses-vregs [ src>> ] [ obj>> ] bi 2array ;
M: ##string-nth uses-vregs [ obj>> ] [ index>> ] bi 2array ;
M: ##set-string-nth-fast uses-vregs [ src>> ] [ obj>> ] [ index>> ] tri 3array ;
M: ##conditional-branch uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
M: ##compare-imm-branch uses-vregs src1>> 1array ;
M: ##dispatch uses-vregs src>> 1array ;
M: ##alien-getter uses-vregs src>> 1array ;
M: ##alien-setter uses-vregs [ src>> ] [ value>> ] bi 2array ;
M: ##fixnum-overflow uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
M: ##phi uses-vregs inputs>> values ;
M: _conditional-branch uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
M: _compare-imm-branch uses-vregs src1>> 1array ;
M: _dispatch uses-vregs src>> 1array ;
M: insn uses-vregs drop f ;

! Computing def-use chains. We don't assume a program is in SSA form,
! since SSA construction itself needs def-use information. defs-1
! is only useful if the program is SSA.
SYMBOLS: defs defs-1 insns uses ;

: def-of ( vreg -- node ) defs-1 get at ;
: defs-of ( vreg -- nodes ) defs get at ;
: uses-of ( vreg -- nodes ) uses get at ;
: insn-of ( vreg -- insn ) insns get at ;

<PRIVATE

: finish-defs ( -- )
    defs [ [ keys ] assoc-map ] change ;

: finish-uses ( -- )
    uses [ [ keys ] assoc-map ] change ;

: (compute-def-use) ( cfg quot -- assoc )
    H{ } clone [
        '[
            dup instructions>> [
                @ [
                    _ conjoin-at
                ] with each
            ] with each
        ] each-basic-block
    ] keep
    [ keys ] assoc-map ; inline

PRIVATE>

: compute-defs ( cfg -- )
    [ defs-vregs ] (compute-def-use)
    [ defs set ] [ [ first ] assoc-map defs-1 set ] bi ;

: compute-uses ( cfg -- )
    [ uses-vregs ] (compute-def-use) uses set ;

: compute-insns ( cfg -- )
    H{ } clone [
        '[
            instructions>> [
                dup defs-vregs [
                    _ set-at
                ] with each
            ] each
        ] each-basic-block
    ] keep insns set ;

: compute-def-use ( cfg -- )
    [ compute-defs ] [ compute-uses ] [ compute-insns ] tri ;