Various improvements

basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor

@@ -10,52 +10,6 @@ IN: compiler.cfg.alias-analysis.tests
     } 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 }
@@ -71,42 +25,14 @@ IN: compiler.cfg.alias-analysis.tests
     } 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 }
     }
 ] [
     {

basis/compiler/cfg/alias-analysis/alias-analysis.factor

@@ -6,7 +6,7 @@ compiler.cfg.registers compiler.cfg.instructions
 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.

basis/compiler/cfg/dead-code/dead-code-tests.factor

@@ -0,0 +1,8 @@
+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

basis/compiler/cfg/dead-code/dead-code.factor

@@ -0,0 +1,62 @@
+! 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 ;

basis/compiler/cfg/height/height.factor

@@ -7,9 +7,6 @@ IN: compiler.cfg.height
 
 ! 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

basis/compiler/cfg/intrinsics/intrinsics.factor

@@ -72,6 +72,10 @@ IN: compiler.cfg.intrinsics
         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

basis/compiler/cfg/optimizer/optimizer.factor

@@ -5,6 +5,7 @@ compiler.cfg.instructions
 compiler.cfg.height
 compiler.cfg.alias-analysis
 compiler.cfg.value-numbering
+compiler.cfg.dead-code
 compiler.cfg.write-barrier ;
 IN: compiler.cfg.optimizer
 
@@ -17,6 +18,7 @@ IN: compiler.cfg.optimizer
             normalize-height
             alias-analysis
             value-numbering
+            eliminate-dead-code
             eliminate-write-barriers
         ] unless
     ] change-basic-blocks ;

basis/compiler/cfg/value-numbering/rewrite/rewrite.factor

@@ -5,13 +5,23 @@ math
 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? [
@@ -37,9 +47,11 @@ GENERIC: rewrite ( insn -- insn' )
 
 : 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 ]

basis/compiler/cfg/value-numbering/simplify/simplify.factor

@@ -10,11 +10,14 @@ IN: compiler.cfg.value-numbering.simplify
 ! 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
@@ -22,8 +25,38 @@ M: unary-expr simplify*
     [ 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 ;
 

basis/compiler/cfg/value-numbering/value-numbering-tests.factor

@@ -50,3 +50,19 @@ compiler.cfg.registers cpu.architecture tools.test kernel ;
         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