diff --git a/basis/compiler/cfg/representations/peephole/peephole.factor b/basis/compiler/cfg/representations/peephole/peephole.factor index 117ce6da7e..6c6347f11c 100644 --- a/basis/compiler/cfg/representations/peephole/peephole.factor +++ b/basis/compiler/cfg/representations/peephole/peephole.factor @@ -104,8 +104,14 @@ M: ##load-reference optimize-insn [ 2drop int-rep ##copy here ] } cond ; +: inert-tag-imm? ( insn -- ? ) + src1>> rep-of tagged-rep? ; + : inert-tag/untag-imm? ( insn -- ? ) - [ dst>> ] [ src1>> ] bi [ rep-of tagged-rep? ] both? ; + { + [ dst>> rep-of tagged-rep? ] + [ inert-tag-imm? ] + } 1&& ; M: ##shl-imm optimize-insn { @@ -169,13 +175,15 @@ M: ##sar-imm optimize-insn ! ! so if all inputs and outputs of ##X or ##X-imm are tagged, ! don't have to insert any conversions -: inert-tag/untag? ( insn -- ? ) +: inert-tag? ( insn -- ? ) { - [ dst>> rep-of tagged-rep? ] [ src1>> rep-of tagged-rep? ] [ src2>> rep-of tagged-rep? ] } 1&& ; +: inert-tag/untag? ( insn -- ? ) + { [ dst>> rep-of tagged-rep? ] [ inert-tag? ] } 1&& ; + M: inert-tag-untag-insn optimize-insn { { [ dup inert-tag/untag? ] [ unchanged ] } @@ -183,16 +191,44 @@ M: inert-tag-untag-insn optimize-insn } cond ; ! -imm variant of above +: >tagged-imm ( insn -- ) + [ tag-fixnum ] change-src2 unchanged ; inline + M: inert-tag-untag-imm-insn optimize-insn { - { [ dup inert-tag/untag-imm? ] [ [ tag-fixnum ] change-src2 unchanged ] } + { [ dup inert-tag/untag-imm? ] [ >tagged-imm ] } [ call-next-method ] } cond ; M: ##mul-imm optimize-insn { { [ dup inert-tag/untag-imm? ] [ unchanged ] } - { [ dup dst>> rep-of tagged-rep? ] [ [ tag-fixnum ] change-src2 unchanged ] } + { [ dup dst>> rep-of tagged-rep? ] [ >tagged-imm ] } + [ call-next-method ] + } cond ; + +! Similar optimization for comparison operators +M: ##compare-integer-imm optimize-insn + { + { [ dup inert-tag-imm? ] [ >tagged-imm ] } + [ call-next-method ] + } cond ; + +M: ##compare-integer-imm-branch optimize-insn + { + { [ dup inert-tag-imm? ] [ >tagged-imm ] } + [ call-next-method ] + } cond ; + +M: ##compare-integer optimize-insn + { + { [ dup inert-tag? ] [ unchanged ] } + [ call-next-method ] + } cond ; + +M: ##compare-integer-branch optimize-insn + { + { [ dup inert-tag? ] [ unchanged ] } [ call-next-method ] } cond ; diff --git a/basis/compiler/cfg/representations/representations-tests.factor b/basis/compiler/cfg/representations/representations-tests.factor index dcd7fc7241..3f406660ca 100644 --- a/basis/compiler/cfg/representations/representations-tests.factor +++ b/basis/compiler/cfg/representations/representations-tests.factor @@ -605,6 +605,51 @@ cpu x86.32? [ } test-peephole ] unit-test +! Tag/untag elimination for ##compare-integer +[ + V{ + T{ ##peek f 0 D 0 } + T{ ##peek f 1 D 1 } + T{ ##compare-integer f 2 0 1 cc= } + T{ ##replace f 2 D 0 } + } +] [ + V{ + T{ ##peek f 0 D 0 } + T{ ##peek f 1 D 1 } + T{ ##compare-integer f 2 0 1 cc= } + T{ ##replace f 2 D 0 } + } test-peephole +] unit-test + +[ + V{ + T{ ##peek f 0 D 0 } + T{ ##peek f 1 D 1 } + T{ ##compare-integer-branch f 0 1 cc= } + } +] [ + V{ + T{ ##peek f 0 D 0 } + T{ ##peek f 1 D 1 } + T{ ##compare-integer-branch f 0 1 cc= } + } test-peephole +] unit-test + +[ + V{ + T{ ##peek f 0 D 0 } + T{ ##peek f 1 D 1 } + T{ ##compare-integer-imm-branch f 0 $[ 10 tag-fixnum ] cc= } + } +] [ + V{ + T{ ##peek f 0 D 0 } + T{ ##peek f 1 D 1 } + T{ ##compare-integer-imm-branch f 0 10 cc= } + } test-peephole +] unit-test + ! Tag/untag elimination for ##neg [ V{ diff --git a/basis/compiler/cfg/representations/selection/selection.factor b/basis/compiler/cfg/representations/selection/selection.factor index 23e1f78766..e5f3bfff3b 100644 --- a/basis/compiler/cfg/representations/selection/selection.factor +++ b/basis/compiler/cfg/representations/selection/selection.factor @@ -113,17 +113,21 @@ UNION: inert-tag-untag-imm-insn GENERIC: has-peephole-opts? ( insn -- ? ) -M: insn has-peephole-opts? drop f ; -M: ##load-integer has-peephole-opts? drop t ; -M: ##load-reference has-peephole-opts? drop t ; -M: inert-tag-untag-insn has-peephole-opts? drop t ; +M: insn has-peephole-opts? drop f ; +M: ##load-integer has-peephole-opts? drop t ; +M: ##load-reference has-peephole-opts? drop t ; +M: ##neg has-peephole-opts? drop t ; +M: ##not has-peephole-opts? drop t ; +M: inert-tag-untag-insn has-peephole-opts? drop t ; M: inert-tag-untag-imm-insn has-peephole-opts? drop t ; -M: ##mul-imm has-peephole-opts? drop t ; -M: ##shl-imm has-peephole-opts? drop t ; -M: ##shr-imm has-peephole-opts? drop t ; -M: ##sar-imm has-peephole-opts? drop t ; -M: ##neg has-peephole-opts? drop t ; -M: ##not has-peephole-opts? drop t ; +M: ##mul-imm has-peephole-opts? drop t ; +M: ##shl-imm has-peephole-opts? drop t ; +M: ##shr-imm has-peephole-opts? drop t ; +M: ##sar-imm has-peephole-opts? drop t ; +M: ##compare-integer-imm has-peephole-opts? drop t ; +M: ##compare-integer has-peephole-opts? drop t ; +M: ##compare-integer-imm-branch has-peephole-opts? drop t ; +M: ##compare-integer-branch has-peephole-opts? drop t ; GENERIC: compute-insn-costs ( insn -- )