! Check that every used register has a definition
instructions>>
[ [ uses-vregs ] map concat ]
- [ [ [ defs-vregs ] [ temp-vregs ] bi append ] map concat ] bi
+ [ [ [ temp-vregs ] [ defs-vreg ] bi [ suffix ] when* ] map concat ] bi
2dup subset? [ 2drop ] [ undefined-values ] if ;
: check-cfg ( cfg -- )
sets compiler.cfg.rpo compiler.cfg.instructions ;
IN: compiler.cfg.def-use
-GENERIC: defs-vregs ( insn -- seq )
+GENERIC: defs-vreg ( insn -- vreg/f )
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: ##flushable defs-vreg dst>> ;
+M: ##fixnum-overflow defs-vreg dst>> ;
+M: _fixnum-overflow defs-vreg dst>> ;
+M: insn defs-vreg drop f ;
M: ##write-barrier temp-vregs [ card#>> ] [ table>> ] bi 2array ;
M: ##unary/temp temp-vregs temp>> 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 ;
+! Computing def-use chains.
-: def-of ( vreg -- node ) defs-1 get at ;
-: defs-of ( vreg -- nodes ) defs get at ;
+SYMBOLS: defs insns uses ;
+
+: def-of ( vreg -- node ) 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 ;
+: set-def-of ( obj insn assoc -- )
+ swap defs-vreg dup [ swap set-at ] [ 3drop ] if ;
-: (compute-def-use) ( cfg quot -- assoc )
+: compute-defs ( cfg -- )
H{ } clone [
'[
dup instructions>> [
- @ [
- _ conjoin-at
- ] with each
+ _ set-def-of
] 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 ;
+ defs set ;
: compute-insns ( cfg -- )
H{ } clone [
'[
instructions>> [
- dup defs-vregs [
- _ set-at
- ] with each
+ dup _ set-def-of
] each
] each-basic-block
] keep insns set ;
+: compute-uses ( cfg -- )
+ H{ } clone [
+ '[
+ dup instructions>> [
+ uses-vregs [
+ _ conjoin-at
+ ] with each
+ ] with each
+ ] each-basic-block
+ ] keep
+ [ keys ] assoc-map
+ uses set ;
+
: compute-def-use ( cfg -- )
[ compute-defs ] [ compute-uses ] [ compute-insns ] tri ;
\ No newline at end of file
[ [ vreg>> ] [ reg>> ] bi ] H{ } map>assoc ;
: all-vregs ( insn -- vregs )
- [ defs-vregs ] [ temp-vregs ] [ uses-vregs ] tri 3append ;
+ [ [ temp-vregs ] [ uses-vregs ] bi append ]
+ [ defs-vreg ] bi
+ [ suffix ] when* ;
SYMBOL: check-assignment?
M: vreg-insn compute-live-intervals*
dup insn#>>
live-intervals get
- [ [ defs-vregs ] 2dip '[ [ _ ] dip _ handle-output ] each ]
+ [ [ defs-vreg ] 2dip '[ [ _ ] dip _ handle-output ] when* ]
[ [ uses-vregs ] 2dip '[ [ _ ] dip _ handle-input ] each ]
[ [ temp-vregs ] 2dip '[ [ _ ] dip _ handle-temp ] each ]
3tri ;
GENERIC: insn-liveness ( live-set insn -- )
: kill-defs ( live-set insn -- live-set )
- defs-vregs [ over delete-at ] each ;
+ defs-vreg [ over delete-at ] when* ;
: gen-uses ( live-set insn -- live-set )
dup ##phi? [ drop ] [ uses-vregs [ over conjoin ] each ] if ;
<PRIVATE
+! Maps vregs to sets of basic blocks
+SYMBOL: defs
+
+! Set of vregs defined in more than one basic block
+SYMBOL: defs-multi
+
+: compute-insn-defs ( bb insn -- )
+ defs-vreg dup [
+ defs get [ conjoin-at ] [ drop ] [ at assoc-size 1 > ] 2tri
+ [ defs-multi get conjoin ] [ drop ] if
+ ] [ 2drop ] if ;
+
+: compute-defs ( cfg -- )
+ H{ } clone defs set
+ H{ } clone defs-multi set
+ [
+ dup instructions>> [
+ compute-insn-defs
+ ] with each
+ ] each-basic-block ;
+
! Maps basic blocks to sequences of vregs
SYMBOL: inserting-phi-nodes
] [ 2drop ] if ;
: compute-phi-nodes-for ( vreg bbs -- )
- dup length 2 >= [
- [
- insert-phi-node-later
- ] with merge-set-each
- ] [ 2drop ] if ;
+ keys [ insert-phi-node-later ] with merge-set-each ;
: compute-phi-nodes ( -- )
H{ } clone inserting-phi-nodes set
- defs get [ compute-phi-nodes-for ] assoc-each ;
+ defs-multi get defs get '[ _ at compute-phi-nodes-for ] assoc-each ;
: insert-phi-nodes-in ( phis bb -- )
[ append ] change-instructions drop ;
<PRIVATE
: sort-vregs-by-bb ( vregs -- alist )
- defs-1 get
+ defs get
'[ dup _ at ] { } map>assoc
[ [ second pre-of ] compare ] sort ;
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs fry kernel namespaces sequences math
-compiler.cfg.def-use compiler.cfg.instructions
+arrays compiler.cfg.def-use compiler.cfg.instructions
compiler.cfg.liveness compiler.cfg.rpo ;
IN: compiler.cfg.ssa.destruction.live-ranges
SYMBOLS: local-def-indices local-kill-indices ;
-: record-defs ( n vregs -- )
- local-def-indices get '[ _ set-at ] with each ;
+: record-def ( n vregs -- )
+ dup [ local-def-indices get set-at ] [ 2drop ] if ;
: record-uses ( n vregs -- )
local-kill-indices get '[ _ set-at ] with each ;
! this instruction and before the next one, ensuring that outputs
! interfere with inputs.
2 *
- [ swap defs-vregs record-defs ]
+ [ swap defs-vreg record-def ]
[ swap uses-vregs record-uses ]
- [ over def-is-use-insn? [ 1 + swap defs-vregs record-uses ] [ 2drop ] if ]
+ [ over def-is-use-insn? [ 1 + swap defs-vreg 1array record-uses ] [ 2drop ] if ]
2tri ;
SYMBOLS: def-indices kill-indices ;
projects / factor.git / commitdiff