compiler.cfg: Minor optimization. Instructions can now only ever produce a single value; this eliminates 1array constructions and some iterations
Slava Pestov
parent
7d3b6892d5
commit
d913d7331f
|
|
@ -59,7 +59,7 @@ ERROR: undefined-values uses defs ;
|
|||
! 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 -- )
|
||||
|
|
|
|||
|
|
@ -4,14 +4,14 @@ 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: 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 ;
|
||||
|
|
@ -50,55 +50,48 @@ 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 ;
|
||||
! 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
|
||||
: set-def-of ( obj insn assoc -- )
|
||||
swap defs-vreg dup [ swap set-at ] [ 3drop ] if ;
|
||||
|
||||
: finish-defs ( -- )
|
||||
defs [ [ keys ] assoc-map ] change ;
|
||||
|
||||
: finish-uses ( -- )
|
||||
uses [ [ keys ] assoc-map ] change ;
|
||||
|
||||
: (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 ;
|
||||
|
|
@ -86,7 +86,9 @@ GENERIC: assign-registers-in-insn ( insn -- )
|
|||
[ [ 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?
|
||||
|
||||
|
|
|
|||
|
|
@ -98,7 +98,7 @@ M: insn compute-live-intervals* drop ;
|
|||
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 ;
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@ BACKWARD-ANALYSIS: live
|
|||
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 ;
|
||||
|
|
|
|||
|
|
@ -26,6 +26,27 @@ IN: compiler.cfg.ssa.construction
|
|||
|
||||
<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
|
||||
|
||||
|
|
@ -36,15 +57,11 @@ 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 ;
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ TUPLE: dom-forest-node vreg bb children ;
|
|||
<PRIVATE
|
||||
|
||||
: sort-vregs-by-bb ( vregs -- alist )
|
||||
defs-1 get
|
||||
defs get
|
||||
'[ dup _ at ] { } map>assoc
|
||||
[ [ second pre-of ] compare ] sort ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! 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
|
||||
|
||||
|
|
@ -11,8 +11,8 @@ 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 ;
|
||||
|
|
@ -24,9 +24,9 @@ SYMBOLS: local-def-indices local-kill-indices ;
|
|||
! 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 ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue