From b1c73741754dafbb85cad6ebb840cc2543cc708f Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Tue, 30 Jun 2009 23:01:44 -0500
Subject: [PATCH] optimize fixnum*fast and fixnum-shift-fast

---
 .../compiler/cfg/builder/builder-tests.factor |  4 ++
 .../cfg/intrinsics/fixnum/fixnum.factor       | 48 ++++++++++++-------
 2 files changed, 36 insertions(+), 16 deletions(-)

diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor
index 58eae8181b..4a481a09d8 100644
--- 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 a93fa5d902..8fbc169098 100644
--- 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 ( node -- )
-    dup node-input-infos dup second 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 ;
+: (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 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 ;
 
@@ -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 )