compiler.cfg.ssa.construction: use the optimization from the pruned-SSA paper to minimize stack pushing and popping

basis/compiler/cfg/renaming/functor/functor.factor

@@ -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 ;

basis/compiler/cfg/renaming/renaming.factor

@@ -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 -- )
+RENAMING: rename [ rename-value ] [ rename-value ]
-
-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 ;
 
 : fresh-vreg ( vreg -- vreg' )
     reg-class>> next-vreg ;

basis/compiler/cfg/ssa/construction/construction.factor

@@ -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
+! The phi placement algorithm is implemented in
-! we consult liveness information to build pruned SSA:
+! compiler.cfg.ssa.construction.tdmsc.
-! http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.25.8240
 
-! Eventually might be worth trying something fancier:
+! The renaming algorithm is based on "Practical Improvements to
-! http://portal.acm.org/citation.cfm?id=1065887.1065890
+! 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 stacks set ;
-    H{ } clone originals set ;
 
 : gen-name ( vreg -- vreg' )
-    [ reg-class>> next-vreg ] keep
+    [ reg-class>> next-vreg dup ] keep
-    [ stacks get push-at ]
+    dup pushed get 2dup key?
-    [ swap originals get set-at ]
+    [ 2drop stacks get at set-last ]
-    [ drop ]
+    [ conjoin stacks get push-at ]
-    2tri ;
+    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 ]
+    [ ssa-rename-insn-uses ]
-    [ dup defs-vregs [ dup gen-name ] { } map>assoc renamings set rename-insn-defs ]
+    [ 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 -- )
+: pop-stacks ( -- )
-    instructions>> [
+    pushed get stacks get '[ drop _ at pop* ] assoc-each ;
-        defs-vregs originals get stacks get
-        '[ _ at _ at pop* ] each
-    ] each ;
 
 : rename-in-block ( bb -- )
-    {
+    H{ } clone pushed set
-        [ rename-insns ]
+    [ rename-insns ]
-        [ rename-successors-phis ]
+    [ rename-successors-phis ]
-        [ dom-children [ rename-in-block ] each ]
+    [
-        [ pop-stacks ]
+        pushed get
-    } cleave ;
+        [ dom-children [ rename-in-block ] each ] dip
+        pushed set
+    ] tri
+    pop-stacks ;
 
 : rename ( cfg -- )
     init-renaming