diff --git a/basis/compiler/cfg/dce/authors.txt b/basis/compiler/cfg/dce/authors.txt index d4f5d6b3ae..a44f8d7f8d 100644 --- a/basis/compiler/cfg/dce/authors.txt +++ b/basis/compiler/cfg/dce/authors.txt @@ -1 +1,2 @@ -Slava Pestov \ No newline at end of file +Slava Pestov +Daniel Ehrenberg diff --git a/basis/compiler/cfg/dce/dce-tests.factor b/basis/compiler/cfg/dce/dce-tests.factor new file mode 100644 index 0000000000..de2ed787b7 --- /dev/null +++ b/basis/compiler/cfg/dce/dce-tests.factor @@ -0,0 +1,72 @@ +! Copyright (C) 2009 Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test compiler.cfg kernel accessors compiler.cfg.dce +compiler.cfg.instructions compiler.cfg.registers cpu.architecture ; +IN: compiler.cfg.dce.tests + +: test-dce ( insns -- insns' ) + swap >>instructions + cfg new swap >>entry + eliminate-dead-code + entry>> instructions>> ; + +[ V{ + T{ ##load-immediate { dst V int-regs 1 } { val 8 } } + T{ ##load-immediate { dst V int-regs 2 } { val 16 } } + T{ ##add { dst V int-regs 3 } { src1 V int-regs 1 } { src2 V int-regs 2 } } + T{ ##replace { src V int-regs 3 } { loc D 0 } } +} ] [ V{ + T{ ##load-immediate { dst V int-regs 1 } { val 8 } } + T{ ##load-immediate { dst V int-regs 2 } { val 16 } } + T{ ##add { dst V int-regs 3 } { src1 V int-regs 1 } { src2 V int-regs 2 } } + T{ ##replace { src V int-regs 3 } { loc D 0 } } +} test-dce ] unit-test + +[ V{ } ] [ V{ + T{ ##load-immediate { dst V int-regs 1 } { val 8 } } + T{ ##load-immediate { dst V int-regs 2 } { val 16 } } + T{ ##add { dst V int-regs 3 } { src1 V int-regs 1 } { src2 V int-regs 2 } } +} test-dce ] unit-test + +[ V{ } ] [ V{ + T{ ##load-immediate { dst V int-regs 3 } { val 8 } } + T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } } +} test-dce ] unit-test + +[ V{ } ] [ V{ + T{ ##load-immediate { dst V int-regs 3 } { val 8 } } + T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } } + T{ ##set-slot-imm { obj V int-regs 1 } { src V int-regs 3 } } +} test-dce ] unit-test + +[ V{ + T{ ##load-immediate { dst V int-regs 3 } { val 8 } } + T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } } + T{ ##set-slot-imm { obj V int-regs 1 } { src V int-regs 3 } } + T{ ##replace { src V int-regs 1 } { loc D 0 } } +} ] [ V{ + T{ ##load-immediate { dst V int-regs 3 } { val 8 } } + T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } } + T{ ##set-slot-imm { obj V int-regs 1 } { src V int-regs 3 } } + T{ ##replace { src V int-regs 1 } { loc D 0 } } +} test-dce ] unit-test + +[ V{ + T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } } + T{ ##replace { src V int-regs 1 } { loc D 0 } } +} ] [ V{ + T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } } + T{ ##replace { src V int-regs 1 } { loc D 0 } } +} test-dce ] unit-test + +[ V{ + T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } } + T{ ##replace { src V int-regs 1 } { loc D 0 } } + T{ ##load-immediate { dst V int-regs 3 } { val 8 } } + T{ ##set-slot-imm { obj V int-regs 1 } { src V int-regs 3 } } +} ] [ V{ + T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } } + T{ ##replace { src V int-regs 1 } { loc D 0 } } + T{ ##load-immediate { dst V int-regs 3 } { val 8 } } + T{ ##set-slot-imm { obj V int-regs 1 } { src V int-regs 3 } } +} test-dce ] unit-test diff --git a/basis/compiler/cfg/dce/dce.factor b/basis/compiler/cfg/dce/dce.factor index 68c89be455..ea4a1d22ab 100644 --- a/basis/compiler/cfg/dce/dce.factor +++ b/basis/compiler/cfg/dce/dce.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008, 2009 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs sets kernel namespaces sequences compiler.cfg.instructions compiler.cfg.def-use @@ -11,35 +11,93 @@ SYMBOL: liveness-graph ! vregs which participate in side effects and thus are always live SYMBOL: live-vregs +: live-vreg? ( vreg -- ? ) + live-vregs get key? ; + +! vregs which are the result of an allocation +SYMBOL: allocations + +: allocation? ( vreg -- ? ) + allocations get key? ; + : init-dead-code ( -- ) H{ } clone liveness-graph set - H{ } clone live-vregs set ; + H{ } clone live-vregs set + H{ } clone allocations set ; -GENERIC: update-liveness-graph ( insn -- ) +GENERIC: build-liveness-graph ( insn -- ) -M: ##flushable update-liveness-graph - [ uses-vregs ] [ dst>> ] bi liveness-graph get set-at ; +: add-edges ( insn register -- ) + [ uses-vregs ] dip liveness-graph get [ union ] change-at ; -: record-live ( vregs -- ) +: setter-liveness-graph ( insn vreg -- ) + dup allocation? [ add-edges ] [ 2drop ] if ; + +M: ##set-slot build-liveness-graph + dup obj>> setter-liveness-graph ; + +M: ##set-slot-imm build-liveness-graph + dup obj>> setter-liveness-graph ; + +M: ##write-barrier build-liveness-graph + dup src>> setter-liveness-graph ; + +M: ##flushable build-liveness-graph + dup dst>> add-edges ; + +M: ##allot build-liveness-graph + [ dst>> allocations get conjoin ] + [ call-next-method ] bi ; + +M: insn build-liveness-graph drop ; + +GENERIC: compute-live-vregs ( insn -- ) + +: (record-live) ( vregs -- ) [ dup live-vregs get key? [ drop ] [ [ live-vregs get conjoin ] - [ liveness-graph get at record-live ] + [ liveness-graph get at (record-live) ] bi ] if ] each ; -M: insn update-liveness-graph uses-vregs record-live ; +: record-live ( insn -- ) + uses-vregs (record-live) ; + +: setter-live-vregs ( insn vreg -- ) + allocation? [ drop ] [ record-live ] if ; + +M: ##set-slot compute-live-vregs + dup obj>> setter-live-vregs ; + +M: ##set-slot-imm compute-live-vregs + dup obj>> setter-live-vregs ; + +M: ##write-barrier compute-live-vregs + dup src>> setter-live-vregs ; + +M: ##flushable compute-live-vregs drop ; + +M: insn compute-live-vregs + record-live ; GENERIC: live-insn? ( insn -- ? ) -M: ##flushable live-insn? dst>> live-vregs get key? ; +M: ##flushable live-insn? dst>> live-vreg? ; + +M: ##set-slot live-insn? obj>> live-vreg? ; + +M: ##set-slot-imm live-insn? obj>> live-vreg? ; + +M: ##write-barrier live-insn? src>> live-vreg? ; M: insn live-insn? drop t ; : eliminate-dead-code ( cfg -- cfg' ) init-dead-code - [ [ instructions>> [ update-liveness-graph ] each ] each-basic-block ] + dup + [ [ instructions>> [ build-liveness-graph ] each ] each-basic-block ] + [ [ instructions>> [ compute-live-vregs ] each ] each-basic-block ] [ [ [ [ live-insn? ] filter ] change-instructions drop ] each-basic-block ] - [ ] - tri ; \ No newline at end of file + tri ; diff --git a/basis/compiler/cfg/dce/summary.txt b/basis/compiler/cfg/dce/summary.txt new file mode 100644 index 0000000000..82b391c2bf --- /dev/null +++ b/basis/compiler/cfg/dce/summary.txt @@ -0,0 +1 @@ +Dead code elimination diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index 17a02175d5..8e2d2ff75e 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -240,7 +240,7 @@ INSN: _compare-imm-branch label { src1 vreg } { src2 integer } cc ; INSN: _compare-float-branch < _conditional-branch ; -TUPLE: spill-slot n ; C: spill-slot +TUPLE: spill-slot { n integer } ; C: spill-slot INSN: _gc { temp1 vreg } { temp2 vreg } gc-roots gc-root-count gc-root-size ; diff --git a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor index bfae02f553..9efac9e81a 100644 --- a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor +++ b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor @@ -39,38 +39,25 @@ IN: compiler.cfg.intrinsics.fixnum :: emit-commutative-fixnum-op ( node insn imm-insn -- ) [let | infos [ node node-input-infos ] | - infos first value-info-small-tagged? - [ infos imm-insn emit-fixnum-imm-op1 ] - [ - infos second value-info-small-tagged? [ - infos imm-insn emit-fixnum-imm-op2 - ] [ - insn (emit-fixnum-op) - ] if - ] if + { + { [ infos first value-info-small-tagged? ] [ infos imm-insn emit-fixnum-imm-op1 ] } + { [ infos second value-info-small-tagged? ] [ infos imm-insn emit-fixnum-imm-op2 ] } + [ insn (emit-fixnum-op) ] + } cond ds-push ] ; inline -: (emit-fixnum-shift-fast) ( obj node -- obj ) - literal>> dup sgn { - { -1 [ neg tag-bits get + ^^sar-imm ^^tag-fixnum ] } - { 0 [ drop ] } - { 1 [ ^^shl-imm ] } - } case ; - : emit-fixnum-shift-fast ( node -- ) - dup node-input-infos dup first value-info-small-fixnum? [ + dup node-input-infos dup second value-info-small-fixnum? [ nip - [ ds-pop ds-drop ] dip first (emit-fixnum-shift-fast) ds-push - ] [ - drop - dup node-input-infos dup second value-info-small-fixnum? [ - nip - [ ds-drop ds-pop ] dip second (emit-fixnum-shift-fast) ds-push - ] [ - drop emit-primitive - ] if - ] if ; + [ ds-drop ds-pop ] dip + second literal>> dup sgn { + { -1 [ neg tag-bits get + ^^sar-imm ^^tag-fixnum ] } + { 0 [ drop ] } + { 1 [ ^^shl-imm ] } + } case + ds-push + ] [ drop emit-primitive ] if ; : emit-fixnum-bitnot ( -- ) ds-pop ^^not tag-mask get ^^xor-imm ds-push ; @@ -89,7 +76,7 @@ IN: compiler.cfg.intrinsics.fixnum : emit-fixnum*fast ( node -- ) node-input-infos - dup first value-info-small-fixnum? + dup first value-info-small-fixnum? drop f [ (emit-fixnum*fast-imm1) ] [ diff --git a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor index 8a671d4455..73d4570b02 100644 --- a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor +++ b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor @@ -26,13 +26,13 @@ ERROR: bad-live-ranges interval ; [ drop ] [ bad-live-ranges ] if ] [ drop ] if ; -: trim-before-ranges ( live-interval n -- ) +: trim-before-ranges ( live-interval -- ) [ ranges>> ] [ uses>> last ] bi [ '[ from>> _ <= ] filter-here ] [ swap last (>>to) ] 2bi ; -: trim-after-ranges ( live-interval n -- ) +: trim-after-ranges ( live-interval -- ) [ ranges>> ] [ uses>> first ] bi [ '[ to>> _ >= ] filter-here ] [ swap first (>>from) ] @@ -56,7 +56,7 @@ ERROR: bad-live-ranges interval ; over spill-to>> >>reload-from ; : split-and-spill ( new existing -- before after ) - swap start>> split-for-spill assign-spill assign-reload ; + swap start>> split-for-spill [ assign-spill ] dip assign-reload ; : reuse-register ( new existing -- ) [ nip delete-active ] diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor index 745146b56e..0956b7263f 100644 --- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor +++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor @@ -136,8 +136,8 @@ M: vreg-insn assign-registers-in-insn register-mapping ; : compute-live-spill-slots ( -- spill-slots ) - spill-slots get values [ values ] map concat - [ [ vreg>> ] [ reload-from>> ] bi ] { } map>assoc ; + spill-slots get values + [ [ vreg>> swap ] { } assoc-map-as ] map concat ; M: ##gc assign-registers-in-insn dup call-next-method diff --git a/basis/compiler/cfg/optimizer/optimizer.factor b/basis/compiler/cfg/optimizer/optimizer.factor index 529f93e9fb..84eb8a84d1 100644 --- a/basis/compiler/cfg/optimizer/optimizer.factor +++ b/basis/compiler/cfg/optimizer/optimizer.factor @@ -37,8 +37,8 @@ SYMBOL: check-optimizer? compute-liveness alias-analysis value-numbering - ! fold-branches - ! compute-predecessors + fold-branches + compute-predecessors eliminate-dead-code eliminate-write-barriers eliminate-phis diff --git a/basis/compiler/cfg/value-numbering/graph/graph.factor b/basis/compiler/cfg/value-numbering/graph/graph.factor index 7ec9eaf7ce..41e7201953 100644 --- a/basis/compiler/cfg/value-numbering/graph/graph.factor +++ b/basis/compiler/cfg/value-numbering/graph/graph.factor @@ -26,6 +26,8 @@ SYMBOL: vregs>vns : vn>constant ( vn -- constant ) vn>expr value>> ; inline +: vreg>constant ( vreg -- constant ) vreg>vn vn>constant ; inline + : init-value-graph ( -- ) 0 vn-counter set exprs>vns set diff --git a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor index 30214e3bf9..bdb906da79 100644 --- a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor +++ b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor @@ -5,16 +5,12 @@ compiler.cfg.hats compiler.cfg.instructions compiler.cfg.value-numbering.expressions compiler.cfg.value-numbering.graph compiler.cfg.value-numbering.simplify fry kernel layouts math -namespaces sequences ; +namespaces sequences cpu.architecture math.bitwise locals ; IN: compiler.cfg.value-numbering.rewrite GENERIC: rewrite ( insn -- insn' ) -M: ##mul-imm rewrite - dup src2>> dup power-of-2? [ - [ [ dst>> ] [ src1>> ] bi ] [ log2 ] bi* \ ##shl-imm new-insn - dup number-values - ] [ drop ] if ; +M: insn rewrite ; : ##branch-t? ( insn -- ? ) dup ##compare-imm-branch? [ @@ -80,7 +76,7 @@ M: ##compare-imm-branch rewrite : flip-comparison ( insn -- insn' ) [ dst>> ] [ src2>> ] - [ src1>> vreg>vn vn>constant ] tri + [ src1>> vreg>constant ] tri cc= i \ ##compare-imm new-insn ; M: ##compare rewrite @@ -117,20 +113,66 @@ M: ##compare-imm rewrite ] when ] when ; -: combine-add-imm? ( insn -- ? ) - { - [ src1>> vreg>expr op>> \ ##add-imm = ] - [ src2>> number? ] - } 1&& ; +: combine-imm? ( insn op -- ? ) + [ src1>> vreg>expr op>> ] dip = ; -: combine-add-imm ( dst src n -- insn ) - [ vreg>expr [ in1>> vn>vreg ] [ in2>> vn>constant ] bi ] dip - + \ ##add-imm new-insn ; +:: combine-imm ( insn quot op -- insn ) + insn + [ dst>> ] + [ src1>> vreg>expr [ in1>> vn>vreg ] [ in2>> vn>constant ] bi ] + [ src2>> ] tri + + quot call cell-bits bits + + dup small-enough? [ + op new-insn dup number-values + ] [ + 3drop insn + ] if ; inline M: ##add-imm rewrite - dup combine-add-imm? [ - [ dst>> ] [ src1>> ] [ src2>> ] tri combine-add-imm + { + { [ dup \ ##add-imm combine-imm? ] + [ [ + ] \ ##add-imm combine-imm ] } + { [ dup \ ##sub-imm combine-imm? ] + [ [ - ] \ ##sub-imm combine-imm ] } + [ ] + } cond ; + +M: ##sub-imm rewrite + { + { [ dup \ ##add-imm combine-imm? ] + [ [ - ] \ ##add-imm combine-imm ] } + { [ dup \ ##sub-imm combine-imm? ] + [ [ + ] \ ##sub-imm combine-imm ] } + [ ] + } cond ; + +M: ##mul-imm rewrite + dup src2>> dup power-of-2? [ + [ [ dst>> ] [ src1>> ] bi ] [ log2 ] bi* \ ##shl-imm new-insn + dup number-values + ] [ + drop dup \ ##mul-imm combine-imm? + [ [ * ] \ ##mul-imm combine-imm ] when + ] if ; + +M: ##and-imm rewrite + dup \ ##and-imm combine-imm? + [ [ bitand ] \ ##and-imm combine-imm ] when ; + +M: ##or-imm rewrite + dup \ ##or-imm combine-imm? + [ [ bitor ] \ ##or-imm combine-imm ] when ; + +M: ##xor-imm rewrite + dup \ ##xor-imm combine-imm? + [ [ bitxor ] \ ##xor-imm combine-imm ] when ; + +M: ##add rewrite + dup src2>> vreg>expr constant-expr? [ + [ dst>> ] + [ src1>> ] + [ src2>> vreg>constant ] tri \ ##add-imm new-insn dup number-values ] when ; - -M: insn rewrite ; diff --git a/basis/compiler/cfg/value-numbering/simplify/simplify.factor b/basis/compiler/cfg/value-numbering/simplify/simplify.factor index e70ba4b54b..b7526528e4 100644 --- a/basis/compiler/cfg/value-numbering/simplify/simplify.factor +++ b/basis/compiler/cfg/value-numbering/simplify/simplify.factor @@ -3,7 +3,7 @@ USING: kernel accessors combinators classes math layouts compiler.cfg.instructions compiler.cfg.value-numbering.graph -compiler.cfg.value-numbering.expressions ; +compiler.cfg.value-numbering.expressions locals ; IN: compiler.cfg.value-numbering.simplify ! Return value of f means we didn't simplify. @@ -42,6 +42,13 @@ M: unary-expr simplify* [ 2drop f ] } cond ; inline +: simplify-sub ( expr -- vn/expr/f ) + >binary-expr< { + { [ 2dup eq? ] [ 2drop T{ constant-expr f f 0 } ] } + { [ dup expr-zero? ] [ drop ] } + [ 2drop f ] + } cond ; inline + : useless-shift? ( in1 in2 -- ? ) over op>> \ ##shl-imm eq? [ [ in2>> ] [ expr>vn ] bi* = ] [ 2drop f ] if ; inline @@ -54,6 +61,8 @@ M: binary-expr simplify* dup op>> { { \ ##add [ simplify-add ] } { \ ##add-imm [ simplify-add ] } + { \ ##sub [ simplify-sub ] } + { \ ##sub-imm [ simplify-sub ] } { \ ##shr-imm [ simplify-shift ] } { \ ##sar-imm [ simplify-shift ] } [ 2drop f ] diff --git a/basis/stuff.factor b/basis/stuff.factor new file mode 100644 index 0000000000..2e5fa2dfae --- /dev/null +++ b/basis/stuff.factor @@ -0,0 +1,20 @@ + +: spill-integer-base ( -- n ) + stack-frame get spill-counts>> double-float-regs swap at + double-float-regs reg-size * ; + +: spill-integer@ ( n -- offset ) + cells spill-integer-base + param@ ; + +: spill-float@ ( n -- offset ) + double-float-regs reg-size * param@ ; + +: (stack-frame-size) ( stack-frame -- n ) + [ + { + [ spill-counts>> [ swap reg-size * ] { } assoc>map sum ] + [ gc-roots>> cells ] + [ params>> ] + [ return>> ] + } cleave + ] sum-outputs ; \ No newline at end of file