Merge branch 'master' of git://factorcode.org/git/factor

basis/compiler/cfg/builder/builder-tests.factor

@@ -18,10 +18,14 @@ kernel.private math ;
     [ 3 fixnum+fast ]
     [ fixnum*fast ]
     [ 3 fixnum*fast ]
+    [ 3 swap fixnum*fast ]
     [ fixnum-shift-fast ]
     [ 10 fixnum-shift-fast ]
     [ -10 fixnum-shift-fast ]
     [ 0 fixnum-shift-fast ]
+    [ 10 swap fixnum-shift-fast ]
+    [ -10 swap fixnum-shift-fast ]
+    [ 0 swap fixnum-shift-fast ]
     [ fixnum-bitnot ]
     [ eq? ]
     [ "hi" eq? ]

basis/compiler/cfg/intrinsics/fixnum/fixnum.factor

@@ -51,17 +51,26 @@ IN: compiler.cfg.intrinsics.fixnum
         ds-push
     ] ; inline
 
-: emit-fixnum-shift-fast ( node -- )
+: (emit-fixnum-shift-fast) ( obj node -- obj )
-    dup node-input-infos dup second value-info-small-fixnum? [
+    literal>> dup sgn {
-        nip
-        [ ds-drop ds-pop ] dip
-        second literal>> dup sgn {
         { -1 [ neg tag-bits get + ^^sar-imm ^^tag-fixnum ] }
         {  0 [ drop ] }
         {  1 [ ^^shl-imm ] }
-        } case
+    } case ;
-        ds-push
+
-    ] [ drop emit-primitive ] if ;
+: emit-fixnum-shift-fast ( node -- )
+    dup node-input-infos dup first value-info-small-fixnum? [
+        nip
+        [ ds-pop ds-drop ] dip first (emit-fixnum-shift-fast) ds-push
+    ] [
+        drop
+        dup node-input-infos dup second value-info-small-fixnum? [
+            nip
+            [ ds-drop ds-pop ] dip second (emit-fixnum-shift-fast) ds-push
+        ] [
+            drop emit-primitive
+        ] if
+    ] if ;
     
 : emit-fixnum-bitnot ( -- )
     ds-pop ^^not tag-mask get ^^xor-imm ds-push ;
@@ -72,14 +81,21 @@ IN: compiler.cfg.intrinsics.fixnum
 : (emit-fixnum*fast) ( -- dst )
     2inputs ^^untag-fixnum ^^mul ;
 
-: (emit-fixnum*fast-imm) ( infos -- dst )
+: (emit-fixnum*fast-imm1) ( infos -- dst )
-    ds-drop
+    [ ds-pop ds-drop ] [ first literal>> ] bi* ^^mul-imm ;
-    [ ds-pop ] [ second literal>> ] bi* ^^mul-imm ;
+
+: (emit-fixnum*fast-imm2) ( infos -- dst )
+    [ ds-drop ds-pop ] [ second literal>> ] bi* ^^mul-imm ;
 
 : emit-fixnum*fast ( node -- )
     node-input-infos
+    dup first value-info-small-fixnum?
+    [
+        (emit-fixnum*fast-imm1)
+    ] [
         dup second value-info-small-fixnum?
-    [ (emit-fixnum*fast-imm) ] [ drop (emit-fixnum*fast) ] if
+        [ (emit-fixnum*fast-imm2) ] [ drop (emit-fixnum*fast) ] if
+    ] if
     ds-push ;
 
 : (emit-fixnum-comparison) ( cc -- quot1 quot2 )

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

@@ -1,12 +1,11 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences layouts accessors combinators namespaces
+USING: accessors combinators combinators.short-circuit
-math fry
+compiler.cfg.hats compiler.cfg.instructions
-compiler.cfg.hats
+compiler.cfg.value-numbering.expressions
-compiler.cfg.instructions
 compiler.cfg.value-numbering.graph
-compiler.cfg.value-numbering.simplify
+compiler.cfg.value-numbering.simplify fry kernel layouts math
-compiler.cfg.value-numbering.expressions ;
+namespaces sequences ;
 IN: compiler.cfg.value-numbering.rewrite
 
 GENERIC: rewrite ( insn -- insn' )
@@ -19,8 +18,10 @@ M: ##mul-imm rewrite
 
 : ##branch-t? ( insn -- ? )
     dup ##compare-imm-branch? [
+        {
             [ cc>> cc/= eq? ]
-        [ src2>> \ f tag-number eq? ] bi and
+            [ src2>> \ f tag-number eq? ]
+        } 1&&
     ] [ drop f ] if ; inline
 
 : rewrite-boolean-comparison? ( insn -- ? )
@@ -47,9 +48,10 @@ M: ##mul-imm rewrite
 
 : 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
+    } 1&& ; inline
 
 : (rewrite-tagged-comparison) ( insn -- src1 src2 cc )
     [ src1>> vreg>expr in1>> vn>vreg ]
@@ -89,10 +91,11 @@ M: ##compare rewrite
     ] when ;
 
 : rewrite-redundant-comparison? ( insn -- ? )
+    {
         [ src1>> vreg>expr compare-expr? ]
         [ src2>> \ f tag-number = ]
         [ cc>> { cc= cc/= } memq? ]
-    tri and and ; inline
+    } 1&& ; inline
 
 : rewrite-redundant-comparison ( insn -- insn' )
     [ cc>> ] [ dst>> ] [ src1>> vreg>expr dup op>> ] tri {
@@ -114,4 +117,20 @@ M: ##compare-imm rewrite
         ] when
     ] when ;
 
+: combine-add-imm? ( insn -- ? )
+    {
+        [ src1>> vreg>expr op>> \ ##add-imm = ]
+        [ src2>> number? ]
+    } 1&& ;
+
+: combine-add-imm ( dst src n -- insn )
+    [ vreg>expr [ in1>> vn>vreg ] [ in2>> vn>constant ] bi ] dip
+    + \ ##add-imm new-insn ;
+
+M: ##add-imm rewrite
+    dup combine-add-imm? [
+        [ dst>> ] [ src1>> ] [ src2>> ] tri combine-add-imm
+        dup number-values
+    ] when ;
+
 M: insn rewrite ;