optimize fixnum*fast and fixnum-shift-fast

diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor
index 58eae8181b84e7c05e12ee57b6871096a95efa8a..4a481a09d81385ab390a39d6823b4ddc91b3e5f3 100644 (file)
--- a/basis/compiler/cfg/builder/builder-tests.factor
+++ b/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? ]

diff --git a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
index a93fa5d90206972de3f81bd38354740048c064cb..8fbc1690986641b3e27e8e5ce478dd23f6236db9 100644 (file)
--- a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
+++ b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
@@ -52,18 +52,27 @@ IN: compiler.cfg.intrinsics.fixnum
         ds-push
     ] ; inline
 
+: (emit-fixnum-shift-fast) ( obj node -- obj )
+    literal>> dup sgn {
+        { -1 [ neg tag-bits get + ^^sar-imm ^^tag-fixnum ] }
+        {  0 [ drop ] }
+        {  1 [ ^^shl-imm ] }
+    } case ;
+
 : emit-fixnum-shift-fast ( node -- )
-    dup node-input-infos dup second value-info-small-fixnum? [
+    dup node-input-infos dup first value-info-small-fixnum? [
         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
-        ds-push
-    ] [ drop emit-primitive ] if ;
-
+        [ 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 ;
 
@@ -73,14 +82,21 @@ IN: compiler.cfg.intrinsics.fixnum
 : (emit-fixnum*fast) ( -- dst )
     2inputs ^^untag-fixnum ^^mul ;
 
-: (emit-fixnum*fast-imm) ( infos -- dst )
-    ds-drop
-    [ ds-pop ] [ second literal>> ] bi* ^^mul-imm ;
+: (emit-fixnum*fast-imm1) ( infos -- dst )
+    [ ds-pop ds-drop ] [ first 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 second value-info-small-fixnum?
-    [ (emit-fixnum*fast-imm) ] [ drop (emit-fixnum*fast) ] if
+    dup first value-info-small-fixnum?
+    [
+        (emit-fixnum*fast-imm1)
+    ] [
+        dup second value-info-small-fixnum?
+        [ (emit-fixnum*fast-imm2) ] [ drop (emit-fixnum*fast) ] if
+    ] if
     ds-push ;
 
 : (emit-fixnum-comparison) ( cc -- quot1 quot2 )