diff --git a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor old mode 100644 new mode 100755 index bdb906da79..418543603a --- a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor +++ b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor @@ -1,11 +1,11 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors combinators combinators.short-circuit -compiler.cfg.hats compiler.cfg.instructions +arrays 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 cpu.architecture math.bitwise locals ; +namespaces sequences cpu.architecture math.bitwise ; IN: compiler.cfg.value-numbering.rewrite GENERIC: rewrite ( insn -- insn' ) @@ -113,38 +113,45 @@ M: ##compare-imm rewrite ] when ] when ; +: (new-imm-insn) ( insn dst src1 n op -- new-insn/insn ) + [ cell-bits bits ] dip over small-enough? [ + new-insn dup number-values nip + ] [ + 2drop 2drop + ] if ; inline + +: new-imm-insn ( insn dst src n op -- n' op' ) + 2dup [ sgn ] dip 2array + { + { { -1 ##add-imm } [ drop neg \ ##sub-imm (new-imm-insn) ] } + { { -1 ##sub-imm } [ drop neg \ ##add-imm (new-imm-insn) ] } + [ drop (new-imm-insn) ] + } case ; inline + : combine-imm? ( insn op -- ? ) [ src1>> vreg>expr op>> ] dip = ; -:: 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 +: combine-imm ( insn quot op -- insn ) + [ + { + [ ] + [ dst>> ] + [ src1>> vreg>expr [ in1>> vn>vreg ] [ in2>> vn>constant ] bi ] + [ src2>> ] + } cleave + ] [ call ] [ ] tri* new-imm-insn ; inline M: ##add-imm rewrite { - { [ dup \ ##add-imm combine-imm? ] - [ [ + ] \ ##add-imm combine-imm ] } - { [ dup \ ##sub-imm combine-imm? ] - [ [ - ] \ ##sub-imm combine-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 ] } + { [ dup \ ##add-imm combine-imm? ] [ [ - ] \ ##add-imm combine-imm ] } + { [ dup \ ##sub-imm combine-imm? ] [ [ + ] \ ##sub-imm combine-imm ] } [ ] } cond ; @@ -169,8 +176,14 @@ M: ##xor-imm rewrite dup \ ##xor-imm combine-imm? [ [ bitxor ] \ ##xor-imm combine-imm ] when ; +: rewrite-add>add-imm? ( insn -- ? ) + src2>> { + [ vreg>expr constant-expr? ] + [ vreg>constant small-enough? ] + } 1&& ; + M: ##add rewrite - dup src2>> vreg>expr constant-expr? [ + dup rewrite-add>add-imm? [ [ dst>> ] [ src1>> ] [ src2>> vreg>constant ] tri \ ##add-imm new-insn