From e7a227ad40d261741285705154e39e2fee5efd64 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Jul 2009 19:03:21 -0500 Subject: [PATCH 1/3] add constant folding for integer ops, refactor some rewrites --- .../value-numbering/rewrite/rewrite.factor | 50 +++++++++++-------- 1 file changed, 30 insertions(+), 20 deletions(-) diff --git a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor index 418543603a..bbfeb3f8bf 100755 --- a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor +++ b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor @@ -5,7 +5,7 @@ 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 ; +namespaces sequences cpu.architecture math.bitwise locals ; IN: compiler.cfg.value-numbering.rewrite GENERIC: rewrite ( insn -- insn' ) @@ -113,12 +113,20 @@ M: ##compare-imm rewrite ] when ] when ; +: constant-fold ( insn -- insn' ) + dup dst>> vreg>expr dup constant-expr? [ + [ dst>> ] [ value>> ] bi* \ ##load-immediate new-insn + dup number-values + ] [ + drop + ] if ; + : (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 + ] if constant-fold ; inline : new-imm-insn ( insn dst src n op -- n' op' ) 2dup [ sgn ] dip 2array @@ -131,7 +139,7 @@ M: ##compare-imm rewrite : combine-imm? ( insn op -- ? ) [ src1>> vreg>expr op>> ] dip = ; -: combine-imm ( insn quot op -- insn ) +: (combine-imm) ( insn quot op -- insn ) [ { [ ] @@ -141,17 +149,24 @@ M: ##compare-imm rewrite } cleave ] [ call ] [ ] tri* new-imm-insn ; inline +:: combine-imm ( insn quot op -- insn ) + insn op combine-imm? [ + insn quot op (combine-imm) + ] [ + insn + ] if ; 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 ; @@ -160,32 +175,27 @@ M: ##mul-imm rewrite [ [ dst>> ] [ src1>> ] bi ] [ log2 ] bi* \ ##shl-imm new-insn dup number-values ] [ - drop dup \ ##mul-imm combine-imm? - [ [ * ] \ ##mul-imm combine-imm ] when + drop [ * ] \ ##mul-imm combine-imm ] if ; -M: ##and-imm rewrite - dup \ ##and-imm combine-imm? - [ [ bitand ] \ ##and-imm combine-imm ] when ; +M: ##and-imm rewrite [ bitand ] \ ##and-imm combine-imm ; -M: ##or-imm rewrite - dup \ ##or-imm combine-imm? - [ [ bitor ] \ ##or-imm combine-imm ] when ; +M: ##or-imm rewrite [ bitor ] \ ##or-imm combine-imm ; -M: ##xor-imm rewrite - dup \ ##xor-imm combine-imm? - [ [ bitxor ] \ ##xor-imm combine-imm ] when ; +M: ##xor-imm rewrite [ bitxor ] \ ##xor-imm combine-imm ; -: rewrite-add>add-imm? ( insn -- ? ) +: rewrite-add? ( insn -- ? ) src2>> { [ vreg>expr constant-expr? ] [ vreg>constant small-enough? ] } 1&& ; M: ##add rewrite - dup rewrite-add>add-imm? [ + dup rewrite-add? [ [ dst>> ] [ src1>> ] [ src2>> vreg>constant ] tri \ ##add-imm new-insn dup number-values ] when ; + +M: ##sub rewrite constant-fold ; From be26a4f63d69e2ae18747bde5c510fcd93099b91 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Thu, 2 Jul 2009 20:24:41 -0500 Subject: [PATCH 2/3] Fixing long-standing bug in wrap --- basis/wrap/wrap-tests.factor | 5 +++++ basis/wrap/wrap.factor | 10 ++++++---- 2 files changed, 11 insertions(+), 4 deletions(-) create mode 100644 basis/wrap/wrap-tests.factor diff --git a/basis/wrap/wrap-tests.factor b/basis/wrap/wrap-tests.factor new file mode 100644 index 0000000000..e597b95088 --- /dev/null +++ b/basis/wrap/wrap-tests.factor @@ -0,0 +1,5 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: wrap tools.test ; + +[ { } ] [ { } 10 10 wrap ] unit-test diff --git a/basis/wrap/wrap.factor b/basis/wrap/wrap.factor index c648f6bd61..b28b0bcbff 100644 --- a/basis/wrap/wrap.factor +++ b/basis/wrap/wrap.factor @@ -77,8 +77,10 @@ SYMBOL: line-ideal [ line-ideal set line-max set - initialize - [ wrap-step ] reduce - min-cost - post-process + [ { } ] [ + initialize + [ wrap-step ] reduce + min-cost + post-process + ] if-empty ] with-scope ; From 3abcebc36cdd0c09bc7cae8222a9b32a8f11ab82 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Thu, 2 Jul 2009 21:12:38 -0500 Subject: [PATCH 3/3] More unit tests for wrap --- basis/wrap/strings/strings-tests.factor | 3 +++ 1 file changed, 3 insertions(+) diff --git a/basis/wrap/strings/strings-tests.factor b/basis/wrap/strings/strings-tests.factor index 07f42caae3..cf01499bcb 100644 --- a/basis/wrap/strings/strings-tests.factor +++ b/basis/wrap/strings/strings-tests.factor @@ -39,3 +39,6 @@ word wrap."> [ "aaa bb\nccccccc\nddddddd" ] [ "aaa bb ccccccc ddddddd" 6 wrap-string ] unit-test [ "a b c d e f\ng h" ] [ "a b c d e f g h" 11 wrap-string ] unit-test + +[ "" ] [ "" 10 wrap-string ] unit-test +[ "Hello" ] [ "\nHello\n" 10 wrap-string ] unit-test