fix bug in rewriting #add -- wasn't checking small-enough?, and change negative adds...

diff --git a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
old mode 100644 (file)
new mode 100755 (executable)
index bdb906d..4185436
--- 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 ;
 
-: combine-imm? ( insn op -- ? )
-    [ src1>> vreg>expr op>> ] dip = ;
+: (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
 
-:: combine-imm ( insn quot op -- insn )
-    insn
-    [ dst>> ]
-    [ src1>> vreg>expr [ in1>> vn>vreg ] [ in2>> vn>constant ] bi ]
-    [ src2>> ] tri
+: 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
 
-    quot call cell-bits bits
+: combine-imm? ( insn op -- ? )
+    [ src1>> vreg>expr op>> ] dip = ;
 
-    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