} alias-analysis drop
] unit-test
-[
- {
- T{ ##peek f V int-regs 1 D 1 }
- T{ ##replace f V int-regs 1 D 0 }
- }
-] [
- {
- T{ ##peek f V int-regs 1 D 1 }
- T{ ##replace f V int-regs 1 D 0 }
- T{ ##replace f V int-regs 1 D 1 }
- } alias-analysis
-] unit-test
-
-[
- {
- T{ ##peek f V int-regs 1 D 1 }
- T{ ##copy f V int-regs 2 V int-regs 1 }
- T{ ##replace f V int-regs 2 D 0 }
- }
-] [
- {
- T{ ##peek f V int-regs 1 D 1 }
- T{ ##copy f V int-regs 2 V int-regs 1 }
- T{ ##replace f V int-regs 2 D 0 }
- T{ ##replace f V int-regs 2 D 1 }
- } alias-analysis
-] unit-test
-
-[
- {
- T{ ##peek f V int-regs 1 D 1 }
- T{ ##peek f V int-regs 2 D 0 }
- T{ ##copy f V int-regs 3 V int-regs 2 }
- T{ ##copy f V int-regs 4 V int-regs 1 }
- }
-] [
- {
- T{ ##peek f V int-regs 1 D 1 }
- T{ ##peek f V int-regs 2 D 0 }
- T{ ##copy f V int-regs 3 V int-regs 2 }
- T{ ##copy f V int-regs 4 V int-regs 1 }
- T{ ##replace f V int-regs 3 D 0 }
- T{ ##replace f V int-regs 4 D 1 }
- } alias-analysis
-] unit-test
-
[
{
T{ ##peek f V int-regs 1 D 1 f }
} alias-analysis
] unit-test
-[
- {
- T{ ##peek f V int-regs 1 D 1 f }
- T{ ##copy f V int-regs 3 V int-regs 1 f }
- }
-] [
- {
- T{ ##peek f V int-regs 1 D 1 f }
- T{ ##replace f V int-regs 1 D 1 f }
- T{ ##peek f V int-regs 3 D 1 f }
- T{ ##replace f V int-regs 4 D 1 f }
- } alias-analysis
-] unit-test
-
-[
- {
- T{ ##peek f V int-regs 1 D 1 f }
- T{ ##peek f V int-regs 2 D 0 f }
- }
-] [
- {
- T{ ##peek f V int-regs 1 D 1 f }
- T{ ##peek f V int-regs 2 D 0 f }
- T{ ##replace f V int-regs 1 D 0 f }
- T{ ##replace f V int-regs 2 D 1 f }
- T{ ##replace f V int-regs 2 D 0 f }
- T{ ##replace f V int-regs 1 D 1 f }
- } alias-analysis
-] unit-test
-
[
{
T{ ##peek f V int-regs 1 D 1 f }
T{ ##peek f V int-regs 2 D 0 f }
T{ ##copy f V int-regs 3 V int-regs 2 f }
T{ ##copy f V int-regs 4 V int-regs 1 f }
+ T{ ##replace f V int-regs 3 D 0 f }
+ T{ ##replace f V int-regs 4 D 1 f }
}
] [
{
compiler.cfg.instructions.syntax compiler.cfg.copy-prop ;
IN: compiler.cfg.alias-analysis
-! Alias analysis -- must be run after compiler.cfg.height.
+! Alias analysis -- assumes compiler.cfg.height has already run.
!
! We try to eliminate redundant slot and stack
! traffic using some simple heuristics.
--- /dev/null
+USING: compiler.cfg.dead-code compiler.cfg.instructions
+compiler.cfg.registers cpu.architecture tools.test ;
+IN: compiler.cfg.dead-code.tests
+
+[ { } ] [
+ { T{ ##load-immediate f V int-regs 134 16 } }
+ eliminate-dead-code
+] unit-test
--- /dev/null
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs sets kernel namespaces sequences
+compiler.cfg.instructions compiler.cfg.instructions.syntax
+compiler.cfg.def-use ;
+IN: compiler.cfg.dead-code
+
+! Dead code elimination -- assumes compiler.cfg.alias-analysis
+! has already run.
+
+! Maps vregs to sequences of vregs
+SYMBOL: liveness-graph
+
+! vregs which participate in side effects and thus are always live
+SYMBOL: live-vregs
+
+! mapping vregs to stack locations
+SYMBOL: vregs>locs
+
+: init-dead-code ( -- )
+ H{ } clone liveness-graph set
+ H{ } clone live-vregs set
+ H{ } clone vregs>locs set ;
+
+GENERIC: compute-liveness ( insn -- )
+
+M: ##flushable compute-liveness
+ [ uses-vregs ] [ dst>> ] bi liveness-graph get set-at ;
+
+M: ##peek compute-liveness
+ [ [ loc>> ] [ dst>> ] bi vregs>locs get set-at ]
+ [ call-next-method ]
+ bi ;
+
+: live-replace? ( ##replace -- ? )
+ [ src>> vregs>locs get at ] [ loc>> ] bi = not ;
+
+M: ##replace compute-liveness
+ dup live-replace? [ call-next-method ] [ drop ] if ;
+
+: record-live ( vregs -- )
+ [
+ dup live-vregs get key? [ drop ] [
+ [ live-vregs get conjoin ]
+ [ liveness-graph get at record-live ]
+ bi
+ ] if
+ ] each ;
+
+M: insn compute-liveness uses-vregs record-live ;
+
+GENERIC: live-insn? ( insn -- ? )
+
+M: ##flushable live-insn? dst>> live-vregs get key? ;
+
+M: ##replace live-insn? live-replace? ;
+
+M: insn live-insn? drop t ;
+
+: eliminate-dead-code ( insns -- insns' )
+ init-dead-code
+ [ [ compute-liveness ] each ] [ [ live-insn? ] filter ] bi ;
! Combine multiple stack height changes into one at the
! start of the basic block.
-!
-! Alias analysis and value numbering assume this optimization
-! has been performed.
SYMBOL: ds-height
SYMBOL: rs-height
math.private:float/f
math.private:fixnum>float
math.private:float>fixnum
+ math.private:float<
+ math.private:float<=
+ math.private:float>
+ math.private:float>=
alien.accessors:alien-float
alien.accessors:set-alien-float
alien.accessors:alien-double
compiler.cfg.height
compiler.cfg.alias-analysis
compiler.cfg.value-numbering
+compiler.cfg.dead-code
compiler.cfg.write-barrier ;
IN: compiler.cfg.optimizer
normalize-height
alias-analysis
value-numbering
+ eliminate-dead-code
eliminate-write-barriers
] unless
] change-basic-blocks ;
compiler.cfg.instructions
compiler.cfg.instructions.syntax
compiler.cfg.value-numbering.graph
+compiler.cfg.value-numbering.simplify
compiler.cfg.value-numbering.expressions ;
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* f \ ##shl-imm boa
+ dup number-values
+ ] [ drop ] if ;
+
: ##branch-t? ( insn -- ? )
- [ cc>> cc/= eq? ] [ src2>> \ f tag-number eq? ] bi and ; inline
+ dup ##compare-imm-branch? [
+ [ cc>> cc/= eq? ]
+ [ src2>> \ f tag-number eq? ] bi and
+ ] [ drop f ] if ; inline
: rewrite-boolean-comparison? ( insn -- ? )
dup ##branch-t? [
: rewrite-tagged-comparison? ( insn -- ? )
#! Are we comparing two tagged fixnums? Then untag them.
- [ src1>> vreg>expr tag-fixnum-expr? ]
- [ src2>> tag-mask get bitand 0 = ]
- bi and ; inline
+ dup ##compare-imm-branch? [
+ [ src1>> vreg>expr tag-fixnum-expr? ]
+ [ src2>> tag-mask get bitand 0 = ]
+ bi and
+ ] [ drop f ] if ; inline
: rewrite-tagged-comparison ( insn -- insn' )
[ src1>> vreg>expr in1>> vn>vreg ]
! Return value of f means we didn't simplify.
GENERIC: simplify* ( expr -- vn/expr/f )
-: simplify-box-float ( in -- vn/expr/f )
- dup op>> \ ##unbox-float = [ in>> ] [ drop f ] if ;
+: simplify-unbox ( in boxer -- vn/expr/f )
+ over op>> eq? [ in>> ] [ drop f ] if ; inline
: simplify-unbox-float ( in -- vn/expr/f )
- dup op>> \ ##box-float = [ in>> ] [ drop f ] if ;
+ \ ##box-float simplify-unbox ; inline
+
+: simplify-unbox-alien ( in -- vn/expr/f )
+ \ ##box-alien simplify-unbox ; inline
M: unary-expr simplify*
#! Note the copy propagation: a copy always simplifies to
[ in>> vn>expr ] [ op>> ] bi {
{ \ ##copy [ ] }
{ \ ##copy-float [ ] }
- { \ ##box-float [ simplify-box-float ] }
{ \ ##unbox-float [ simplify-unbox-float ] }
+ { \ ##unbox-alien [ simplify-unbox-alien ] }
+ { \ ##unbox-any-c-ptr [ simplify-unbox-alien ] }
+ [ 2drop f ]
+ } case ;
+
+: expr-zero? ( expr -- ? ) T{ constant-expr f f 0 } = ; inline
+
+: >binary-expr< ( expr -- in1 in2 )
+ [ in1>> vn>expr ] [ in2>> vn>expr ] bi ; inline
+
+: simplify-add ( expr -- vn/expr/f )
+ >binary-expr< {
+ { [ over expr-zero? ] [ nip ] }
+ { [ 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
+
+: simplify-shift ( expr -- vn/expr/f )
+ >binary-expr<
+ 2dup useless-shift? [ drop in1>> ] [ 2drop f ] if ; inline
+
+M: binary-expr simplify*
+ dup op>> {
+ { \ ##add [ simplify-add ] }
+ { \ ##add-imm [ simplify-add ] }
+ { \ ##shr-imm [ simplify-shift ] }
+ { \ ##sar-imm [ simplify-shift ] }
[ 2drop f ]
} case ;
T{ ##replace f V int-regs 23 D 0 }
} dup value-numbering =
] unit-test
+
+[
+ {
+ T{ ##peek f V int-regs 1 D 0 }
+ T{ ##shl-imm f V int-regs 2 V int-regs 1 3 }
+ T{ ##shr-imm f V int-regs 3 V int-regs 2 3 }
+ T{ ##replace f V int-regs 1 D 0 }
+ }
+] [
+ {
+ T{ ##peek f V int-regs 1 D 0 }
+ T{ ##mul-imm f V int-regs 2 V int-regs 1 8 }
+ T{ ##shr-imm f V int-regs 3 V int-regs 2 3 }
+ T{ ##replace f V int-regs 3 D 0 }
+ } value-numbering
+] unit-test