From 8c6b38533c49bdd949f4ceffd167affb9f0ff97f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 28 Jul 2009 21:31:08 -0500 Subject: [PATCH] compiler.cfg.linearization: rotate loops. 2x speedup with empty times loop, 1.5x speedup on benchmark.dawes --- .../cfg/block-joining/block-joining.factor | 3 - .../cfg/linearization/linearization.factor | 26 +++---- .../cfg/linearization/order/order.factor | 70 +++++++++++++++++++ basis/compiler/cfg/utilities/utilities.factor | 4 ++ 4 files changed, 85 insertions(+), 18 deletions(-) create mode 100644 basis/compiler/cfg/linearization/order/order.factor diff --git a/basis/compiler/cfg/block-joining/block-joining.factor b/basis/compiler/cfg/block-joining/block-joining.factor index b4c7223435..08c43f203c 100644 --- a/basis/compiler/cfg/block-joining/block-joining.factor +++ b/basis/compiler/cfg/block-joining/block-joining.factor @@ -8,9 +8,6 @@ IN: compiler.cfg.block-joining ! Joining blocks that are not calls and are connected by a single CFG edge. ! Predecessors must be recomputed after this. Also this pass does not ! update ##phi nodes and should therefore only run before stack analysis. -: predecessor ( bb -- pred ) - predecessors>> first ; inline - : join-block? ( bb -- ? ) { [ kill-block? not ] diff --git a/basis/compiler/cfg/linearization/linearization.factor b/basis/compiler/cfg/linearization/linearization.factor index cc148d34d8..a1d3944956 100755 --- a/basis/compiler/cfg/linearization/linearization.factor +++ b/basis/compiler/cfg/linearization/linearization.factor @@ -3,34 +3,30 @@ USING: kernel math accessors sequences namespaces make combinators assocs arrays locals cpu.architecture compiler.cfg -compiler.cfg.rpo compiler.cfg.comparisons compiler.cfg.stack-frame compiler.cfg.instructions -compiler.cfg.utilities ; +compiler.cfg.utilities +compiler.cfg.linearization.order ; IN: compiler.cfg.linearization ! Convert CFG IR to machine IR. GENERIC: linearize-insn ( basic-block insn -- ) : linearize-basic-block ( bb -- ) - [ number>> _label ] + [ block-number _label ] [ dup instructions>> [ linearize-insn ] with each ] bi ; M: insn linearize-insn , drop ; : useless-branch? ( basic-block successor -- ? ) - #! If our successor immediately follows us in RPO, then we - #! don't need to branch. - [ number>> ] bi@ 1 - = ; inline - -: emit-loop-entry? ( bb successor -- ? ) - [ back-edge? not ] [ nip loop-entry? ] 2bi and ; + ! If our successor immediately follows us in linearization + ! order then we don't need to branch. + [ block-number ] bi@ 1 - = ; inline : emit-branch ( bb successor -- ) - 2dup emit-loop-entry? [ _loop-entry ] when - 2dup useless-branch? [ 2drop ] [ nip number>> _branch ] if ; + 2dup useless-branch? [ 2drop ] [ nip block-number _branch ] if ; M: ##branch linearize-insn drop dup successors>> first emit-branch ; @@ -44,7 +40,7 @@ M: ##branch linearize-insn : binary-conditional ( bb insn -- bb successor label2 src1 src2 cc ) [ (binary-conditional) ] [ drop dup successors>> second useless-branch? ] 2bi - [ [ swap number>> ] 3dip ] [ [ number>> ] 3dip negate-cc ] if ; + [ [ swap block-number ] 3dip ] [ [ block-number ] 3dip negate-cc ] if ; : with-regs ( insn quot -- ) over regs>> [ call ] dip building get last (>>regs) ; inline @@ -59,7 +55,7 @@ M: ##compare-float-branch linearize-insn [ binary-conditional _compare-float-branch ] with-regs emit-branch ; : overflow-conditional ( bb insn -- bb successor label2 dst src1 src2 ) - [ dup successors number>> ] + [ dup successors block-number ] [ [ dst>> ] [ src1>> ] [ src2>> ] tri ] bi* ; inline M: ##fixnum-add linearize-insn @@ -74,7 +70,7 @@ M: ##fixnum-mul linearize-insn M: ##dispatch linearize-insn swap [ [ [ src>> ] [ temp>> ] bi _dispatch ] with-regs ] - [ successors>> [ number>> _dispatch-label ] each ] + [ successors>> [ block-number _dispatch-label ] each ] bi* ; : (compute-gc-roots) ( n live-values -- n ) @@ -120,7 +116,7 @@ M: ##gc linearize-insn : linearize-basic-blocks ( cfg -- insns ) [ - [ [ linearize-basic-block ] each-basic-block ] + [ linearization-order [ linearize-basic-block ] each ] [ spill-counts>> _spill-counts ] bi ] { } make ; diff --git a/basis/compiler/cfg/linearization/order/order.factor b/basis/compiler/cfg/linearization/order/order.factor new file mode 100644 index 0000000000..daa536dd18 --- /dev/null +++ b/basis/compiler/cfg/linearization/order/order.factor @@ -0,0 +1,70 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors assocs deques dlists kernel make +namespaces sequences combinators combinators.short-circuit +fry math sets compiler.cfg.utilities ; +IN: compiler.cfg.linearization.order + +! This is RPO except loops are rotated. Based on SBCL's src/compiler/control.lisp + +> length 1 = ] + [ predecessor successors>> length 1 = ] + [ [ number>> ] [ predecessor number>> ] bi > ] + } 1&& [ predecessor (find-alternate-loop-head) ] when ; + +: find-back-edge ( bb -- pred ) + [ predecessors>> ] keep '[ _ back-edge? ] find nip ; + +: find-alternate-loop-head ( bb -- bb' ) + dup find-back-edge dup visited? [ drop ] [ + nip (find-alternate-loop-head) + ] if ; + +: predecessors-ready? ( bb -- ? ) + [ predecessors>> ] keep '[ + _ 2dup back-edge? + [ 2drop t ] [ drop visited? ] if + ] all? ; + +: process-successor ( bb -- ) + dup predecessors-ready? [ + dup loop-entry? [ find-alternate-loop-head ] when + add-to-work-list + ] [ drop ] if ; + +: assign-number ( bb -- ) + next-number [ get ] [ inc ] bi swap numbers get set-at ; + +: process-block ( bb -- ) + { + [ , ] + [ assign-number ] + [ visited get conjoin ] + [ successors>> [ process-successor ] each ] + } cleave ; + +PRIVATE> + +: linearization-order ( cfg -- bbs ) + work-list set + H{ } clone visited set + H{ } clone numbers set + 0 next-number set + entry>> add-to-work-list + [ work-list get [ process-block ] slurp-deque ] { } make ; + +: block-number ( bb -- n ) numbers get at ; diff --git a/basis/compiler/cfg/utilities/utilities.factor b/basis/compiler/cfg/utilities/utilities.factor index d242d5d90d..f01b10f6eb 100644 --- a/basis/compiler/cfg/utilities/utilities.factor +++ b/basis/compiler/cfg/utilities/utilities.factor @@ -57,3 +57,7 @@ SYMBOL: visited : if-has-phis ( bb quot: ( bb -- ) -- ) [ dup has-phis? ] dip [ drop ] if ; inline + +: predecessor ( bb -- pred ) + predecessors>> first ; inline +