compiler.cfg.ssa.construction: use the optimization from the pruned-SSA paper to minimize stack pushing and popping
Slava Pestov
parent
f1683f9fcf
commit
7d3b6892d5
|
|
@ -0,0 +1,116 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: functors assocs kernel accessors compiler.cfg.instructions
|
||||
lexer parser ;
|
||||
IN: compiler.cfg.renaming.functor
|
||||
|
||||
FUNCTOR: define-renaming ( NAME DEF-QUOT USE-QUOT -- )
|
||||
|
||||
rename-insn-defs DEFINES ${NAME}-insn-defs
|
||||
rename-insn-uses DEFINES ${NAME}-insn-uses
|
||||
|
||||
WHERE
|
||||
|
||||
GENERIC: rename-insn-defs ( insn -- )
|
||||
|
||||
M: ##flushable rename-insn-defs
|
||||
DEF-QUOT change-dst
|
||||
drop ;
|
||||
|
||||
M: ##fixnum-overflow rename-insn-defs
|
||||
DEF-QUOT change-dst
|
||||
drop ;
|
||||
|
||||
M: _fixnum-overflow rename-insn-defs
|
||||
DEF-QUOT change-dst
|
||||
drop ;
|
||||
|
||||
M: insn rename-insn-defs drop ;
|
||||
|
||||
GENERIC: rename-insn-uses ( insn -- )
|
||||
|
||||
M: ##effect rename-insn-uses
|
||||
USE-QUOT change-src
|
||||
drop ;
|
||||
|
||||
M: ##unary rename-insn-uses
|
||||
USE-QUOT change-src
|
||||
drop ;
|
||||
|
||||
M: ##binary rename-insn-uses
|
||||
USE-QUOT change-src1
|
||||
USE-QUOT change-src2
|
||||
drop ;
|
||||
|
||||
M: ##binary-imm rename-insn-uses
|
||||
USE-QUOT change-src1
|
||||
drop ;
|
||||
|
||||
M: ##slot rename-insn-uses
|
||||
USE-QUOT change-obj
|
||||
USE-QUOT change-slot
|
||||
drop ;
|
||||
|
||||
M: ##slot-imm rename-insn-uses
|
||||
USE-QUOT change-obj
|
||||
drop ;
|
||||
|
||||
M: ##set-slot rename-insn-uses
|
||||
dup call-next-method
|
||||
USE-QUOT change-obj
|
||||
USE-QUOT change-slot
|
||||
drop ;
|
||||
|
||||
M: ##string-nth rename-insn-uses
|
||||
USE-QUOT change-obj
|
||||
USE-QUOT change-index
|
||||
drop ;
|
||||
|
||||
M: ##set-string-nth-fast rename-insn-uses
|
||||
dup call-next-method
|
||||
USE-QUOT change-obj
|
||||
USE-QUOT change-index
|
||||
drop ;
|
||||
|
||||
M: ##set-slot-imm rename-insn-uses
|
||||
dup call-next-method
|
||||
USE-QUOT change-obj
|
||||
drop ;
|
||||
|
||||
M: ##alien-getter rename-insn-uses
|
||||
dup call-next-method
|
||||
USE-QUOT change-src
|
||||
drop ;
|
||||
|
||||
M: ##alien-setter rename-insn-uses
|
||||
dup call-next-method
|
||||
USE-QUOT change-value
|
||||
drop ;
|
||||
|
||||
M: ##conditional-branch rename-insn-uses
|
||||
USE-QUOT change-src1
|
||||
USE-QUOT change-src2
|
||||
drop ;
|
||||
|
||||
M: ##compare-imm-branch rename-insn-uses
|
||||
USE-QUOT change-src1
|
||||
drop ;
|
||||
|
||||
M: ##dispatch rename-insn-uses
|
||||
USE-QUOT change-src
|
||||
drop ;
|
||||
|
||||
M: ##fixnum-overflow rename-insn-uses
|
||||
USE-QUOT change-src1
|
||||
USE-QUOT change-src2
|
||||
drop ;
|
||||
|
||||
M: ##phi rename-insn-uses
|
||||
[ USE-QUOT assoc-map ] change-inputs
|
||||
drop ;
|
||||
|
||||
M: insn rename-insn-uses drop ;
|
||||
|
||||
;FUNCTOR
|
||||
|
||||
SYNTAX: RENAMING: scan scan-object scan-object define-renaming ;
|
||||
|
|
@ -1,112 +1,16 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs kernel namespaces sequences
|
||||
compiler.cfg.instructions compiler.cfg.registers ;
|
||||
compiler.cfg.instructions compiler.cfg.registers
|
||||
compiler.cfg.renaming.functor ;
|
||||
IN: compiler.cfg.renaming
|
||||
|
||||
SYMBOL: renamings
|
||||
|
||||
: rename-value ( vreg -- vreg' ) renamings get ?at drop ;
|
||||
: rename-value ( vreg -- vreg' )
|
||||
renamings get ?at drop ;
|
||||
|
||||
GENERIC: rename-insn-defs ( insn -- )
|
||||
|
||||
M: ##flushable rename-insn-defs
|
||||
[ rename-value ] change-dst
|
||||
drop ;
|
||||
|
||||
M: ##fixnum-overflow rename-insn-defs
|
||||
[ rename-value ] change-dst
|
||||
drop ;
|
||||
|
||||
M: _fixnum-overflow rename-insn-defs
|
||||
[ rename-value ] change-dst
|
||||
drop ;
|
||||
|
||||
M: insn rename-insn-defs drop ;
|
||||
|
||||
GENERIC: rename-insn-uses ( insn -- )
|
||||
|
||||
M: ##effect rename-insn-uses
|
||||
[ rename-value ] change-src
|
||||
drop ;
|
||||
|
||||
M: ##unary rename-insn-uses
|
||||
[ rename-value ] change-src
|
||||
drop ;
|
||||
|
||||
M: ##binary rename-insn-uses
|
||||
[ rename-value ] change-src1
|
||||
[ rename-value ] change-src2
|
||||
drop ;
|
||||
|
||||
M: ##binary-imm rename-insn-uses
|
||||
[ rename-value ] change-src1
|
||||
drop ;
|
||||
|
||||
M: ##slot rename-insn-uses
|
||||
[ rename-value ] change-obj
|
||||
[ rename-value ] change-slot
|
||||
drop ;
|
||||
|
||||
M: ##slot-imm rename-insn-uses
|
||||
[ rename-value ] change-obj
|
||||
drop ;
|
||||
|
||||
M: ##set-slot rename-insn-uses
|
||||
dup call-next-method
|
||||
[ rename-value ] change-obj
|
||||
[ rename-value ] change-slot
|
||||
drop ;
|
||||
|
||||
M: ##string-nth rename-insn-uses
|
||||
[ rename-value ] change-obj
|
||||
[ rename-value ] change-index
|
||||
drop ;
|
||||
|
||||
M: ##set-string-nth-fast rename-insn-uses
|
||||
dup call-next-method
|
||||
[ rename-value ] change-obj
|
||||
[ rename-value ] change-index
|
||||
drop ;
|
||||
|
||||
M: ##set-slot-imm rename-insn-uses
|
||||
dup call-next-method
|
||||
[ rename-value ] change-obj
|
||||
drop ;
|
||||
|
||||
M: ##alien-getter rename-insn-uses
|
||||
dup call-next-method
|
||||
[ rename-value ] change-src
|
||||
drop ;
|
||||
|
||||
M: ##alien-setter rename-insn-uses
|
||||
dup call-next-method
|
||||
[ rename-value ] change-value
|
||||
drop ;
|
||||
|
||||
M: ##conditional-branch rename-insn-uses
|
||||
[ rename-value ] change-src1
|
||||
[ rename-value ] change-src2
|
||||
drop ;
|
||||
|
||||
M: ##compare-imm-branch rename-insn-uses
|
||||
[ rename-value ] change-src1
|
||||
drop ;
|
||||
|
||||
M: ##dispatch rename-insn-uses
|
||||
[ rename-value ] change-src
|
||||
drop ;
|
||||
|
||||
M: ##fixnum-overflow rename-insn-uses
|
||||
[ rename-value ] change-src1
|
||||
[ rename-value ] change-src2
|
||||
drop ;
|
||||
|
||||
M: ##phi rename-insn-uses
|
||||
[ [ rename-value ] assoc-map ] change-inputs
|
||||
drop ;
|
||||
|
||||
M: insn rename-insn-uses drop ;
|
||||
RENAMING: rename [ rename-value ] [ rename-value ]
|
||||
|
||||
: fresh-vreg ( vreg -- vreg' )
|
||||
reg-class>> next-vreg ;
|
||||
|
|
|
|||
|
|
@ -5,22 +5,24 @@ sets math combinators
|
|||
compiler.cfg
|
||||
compiler.cfg.rpo
|
||||
compiler.cfg.def-use
|
||||
compiler.cfg.renaming
|
||||
compiler.cfg.liveness
|
||||
compiler.cfg.registers
|
||||
compiler.cfg.dominance
|
||||
compiler.cfg.instructions
|
||||
compiler.cfg.renaming.functor
|
||||
compiler.cfg.ssa.construction.tdmsc ;
|
||||
IN: compiler.cfg.ssa.construction
|
||||
|
||||
! SSA construction. Predecessors must be computed first.
|
||||
|
||||
! This is the classical algorithm based on dominance frontiers, except
|
||||
! we consult liveness information to build pruned SSA:
|
||||
! http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.25.8240
|
||||
! The phi placement algorithm is implemented in
|
||||
! compiler.cfg.ssa.construction.tdmsc.
|
||||
|
||||
! Eventually might be worth trying something fancier:
|
||||
! http://portal.acm.org/citation.cfm?id=1065887.1065890
|
||||
! The renaming algorithm is based on "Practical Improvements to
|
||||
! the Construction and Destruction of Static Single Assignment Form",
|
||||
! however we construct pruned SSA, not semi-pruned SSA.
|
||||
|
||||
! http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.49.9683
|
||||
|
||||
<PRIVATE
|
||||
|
||||
|
|
@ -50,31 +52,32 @@ SYMBOL: inserting-phi-nodes
|
|||
: insert-phi-nodes ( -- )
|
||||
inserting-phi-nodes get [ swap insert-phi-nodes-in ] assoc-each ;
|
||||
|
||||
SYMBOLS: stacks originals ;
|
||||
SYMBOLS: stacks pushed ;
|
||||
|
||||
: init-renaming ( -- )
|
||||
H{ } clone stacks set
|
||||
H{ } clone originals set ;
|
||||
H{ } clone stacks set ;
|
||||
|
||||
: gen-name ( vreg -- vreg' )
|
||||
[ reg-class>> next-vreg ] keep
|
||||
[ stacks get push-at ]
|
||||
[ swap originals get set-at ]
|
||||
[ drop ]
|
||||
2tri ;
|
||||
[ reg-class>> next-vreg dup ] keep
|
||||
dup pushed get 2dup key?
|
||||
[ 2drop stacks get at set-last ]
|
||||
[ conjoin stacks get push-at ]
|
||||
if ;
|
||||
|
||||
: top-name ( vreg -- vreg' )
|
||||
stacks get at last ;
|
||||
|
||||
RENAMING: ssa-rename [ gen-name ] [ top-name ]
|
||||
|
||||
GENERIC: rename-insn ( insn -- )
|
||||
|
||||
M: insn rename-insn
|
||||
[ dup uses-vregs [ dup top-name ] { } map>assoc renamings set rename-insn-uses ]
|
||||
[ dup defs-vregs [ dup gen-name ] { } map>assoc renamings set rename-insn-defs ]
|
||||
[ ssa-rename-insn-uses ]
|
||||
[ ssa-rename-insn-defs ]
|
||||
bi ;
|
||||
|
||||
M: ##phi rename-insn
|
||||
dup defs-vregs [ dup gen-name ] { } map>assoc renamings set rename-insn-defs ;
|
||||
ssa-rename-insn-defs ;
|
||||
|
||||
: rename-insns ( bb -- )
|
||||
instructions>> [ rename-insn ] each ;
|
||||
|
|
@ -89,19 +92,19 @@ M: ##phi rename-insn
|
|||
: rename-successors-phis ( bb -- )
|
||||
[ successors>> ] keep '[ _ rename-successor-phis ] each ;
|
||||
|
||||
: pop-stacks ( bb -- )
|
||||
instructions>> [
|
||||
defs-vregs originals get stacks get
|
||||
'[ _ at _ at pop* ] each
|
||||
] each ;
|
||||
: pop-stacks ( -- )
|
||||
pushed get stacks get '[ drop _ at pop* ] assoc-each ;
|
||||
|
||||
: rename-in-block ( bb -- )
|
||||
{
|
||||
[ rename-insns ]
|
||||
[ rename-successors-phis ]
|
||||
[ dom-children [ rename-in-block ] each ]
|
||||
[ pop-stacks ]
|
||||
} cleave ;
|
||||
H{ } clone pushed set
|
||||
[ rename-insns ]
|
||||
[ rename-successors-phis ]
|
||||
[
|
||||
pushed get
|
||||
[ dom-children [ rename-in-block ] each ] dip
|
||||
pushed set
|
||||
] tri
|
||||
pop-stacks ;
|
||||
|
||||
: rename ( cfg -- )
|
||||
init-renaming
|
||||
|
|
|
|||
Loading…
Reference in New Issue