From ede5bb9243ad98f5156554889535e903ae21dac1 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sat, 12 Jan 2008 21:38:57 -0500
Subject: [PATCH] Updating x86.64 port

---
 core/cpu/x86/32/bootstrap.factor          |  1 +
 core/cpu/x86/64/bootstrap.factor          |  1 +
 core/cpu/x86/assembler/assembler.factor   |  2 +-
 core/cpu/x86/bootstrap.factor             | 18 +++++++------
 core/cpu/x86/intrinsics/intrinsics.factor | 32 +++++++++++++++++------
 5 files changed, 37 insertions(+), 17 deletions(-)

diff --git a/core/cpu/x86/32/bootstrap.factor b/core/cpu/x86/32/bootstrap.factor
index 423597eb01..4ce4b1684d 100755
--- a/core/cpu/x86/32/bootstrap.factor
+++ b/core/cpu/x86/32/bootstrap.factor
@@ -12,5 +12,6 @@ IN: bootstrap.x86
 : stack-reg ESP ;
 : ds-reg ESI ;
 : fixnum>slot@ arg0 1 SAR ;
+: rex-length 0 ;
 
 "resource:core/cpu/x86/bootstrap.factor" run-file
diff --git a/core/cpu/x86/64/bootstrap.factor b/core/cpu/x86/64/bootstrap.factor
index f2e84ca528..1227369ae8 100644
--- a/core/cpu/x86/64/bootstrap.factor
+++ b/core/cpu/x86/64/bootstrap.factor
@@ -12,5 +12,6 @@ IN: bootstrap.x86
 : stack-reg RSP ;
 : ds-reg R14 ;
 : fixnum>slot@ ;
+: rex-length 1 ;
 
 "resource:core/cpu/x86/bootstrap.factor" run-file
diff --git a/core/cpu/x86/assembler/assembler.factor b/core/cpu/x86/assembler/assembler.factor
index 65bf29a9b0..17aa6bbb54 100755
--- a/core/cpu/x86/assembler/assembler.factor
+++ b/core/cpu/x86/assembler/assembler.factor
@@ -81,7 +81,7 @@ SYMBOL: XMM15 \ XMM15 15 128 define-register
 : n, >le % ; inline
 : 4, 4 n, ; inline
 : 2, 2 n, ; inline
-: cell, cell n, ; inline
+: cell, bootstrap-cell n, ; inline
 
 #! Extended AMD64 registers (R8-R15) return true.
 GENERIC: extended? ( op -- ? )
diff --git a/core/cpu/x86/bootstrap.factor b/core/cpu/x86/bootstrap.factor
index 275ffe6aab..ea4cadd51b 100755
--- a/core/cpu/x86/bootstrap.factor
+++ b/core/cpu/x86/bootstrap.factor
@@ -23,25 +23,27 @@ big-endian off
     temp-reg compiled-header-size ADD
     ! Jump to XT
     temp-reg JMP
-] rc-absolute-cell rt-literal 1 jit-profiling jit-define
+] rc-absolute-cell rt-literal 1 rex-length + jit-profiling jit-define
 
 [
+    temp-reg 0 MOV                             ! load XT
     stack-frame-size PUSH                      ! save stack frame size
-    0 PUSH                                     ! push XT
+    temp-reg PUSH                              ! push XT
     arg1 PUSH                                  ! alignment
-] rc-absolute-cell rt-label 6 jit-prolog jit-define
+] rc-absolute-cell rt-label 1 rex-length + jit-prolog jit-define
 
 [
     arg0 0 MOV                                 ! load literal
     arg0 dup [] MOV
     ds-reg bootstrap-cell ADD                  ! increment datastack pointer
     ds-reg [] arg0 MOV                         ! store literal on datastack
-] rc-absolute-cell rt-literal 1 jit-push-literal jit-define
+] rc-absolute-cell rt-literal 1 rex-length + jit-push-literal jit-define
 
 [
+    arg0 0 MOV                                 ! load XT
     arg1 stack-reg MOV                         ! pass callstack pointer as arg 2
-    (JMP) drop                                 ! go
-] rc-relative rt-primitive 3 jit-primitive jit-define
+    arg0 JMP                                   ! go
+] rc-absolute-cell rt-primitive 1 rex-length + jit-primitive jit-define
 
 [
     (JMP) drop
@@ -59,7 +61,7 @@ big-endian off
     arg0 arg1 [] CMOVNE                        ! load true branch if not equal
     arg0 arg1 bootstrap-cell [+] CMOVE         ! load false branch if equal
     arg0 quot-xt@ [+] JMP                      ! jump to quotation-xt
-] rc-absolute-cell rt-literal 1 jit-if-jump jit-define
+] rc-absolute-cell rt-literal 1 rex-length + jit-if-jump jit-define
 
 [
     arg1 0 MOV                                 ! load dispatch table
@@ -70,7 +72,7 @@ big-endian off
     arg0 arg1 ADD                              ! compute quotation location
     arg0 arg0 array-start [+] MOV              ! load quotation
     arg0 quot-xt@ [+] JMP                      ! execute branch
-] rc-absolute-cell rt-literal 1 jit-dispatch jit-define
+] rc-absolute-cell rt-literal 1 rex-length + jit-dispatch jit-define
 
 [
     stack-reg stack-frame-size bootstrap-cell - ADD ! unwind stack frame
diff --git a/core/cpu/x86/intrinsics/intrinsics.factor b/core/cpu/x86/intrinsics/intrinsics.factor
index 9f6fb5d3b0..70de7a99ac 100755
--- a/core/cpu/x86/intrinsics/intrinsics.factor
+++ b/core/cpu/x86/intrinsics/intrinsics.factor
@@ -240,14 +240,30 @@ IN: cpu.x86.intrinsics
     }
 } define-intrinsics
 
-\ fixnum-shift [
-    "x" operand "y" get neg SAR
-    ! Mask off low bits
-    "x" operand %untag
-] H{
-    { +input+ { { f "x" } { [ -31 0 between? ] "y" } } }
-    { +output+ { "x" } }
-} define-intrinsic
+\ fixnum-shift-fast {
+    {
+        [
+            "y" operand NEG
+            "y" operand %untag-fixnum
+            "x" operand "y" operand SAR
+            ! Mask off low bits
+            "x" operand %untag
+        ] H{
+            { +input+ { { f "x" } { f "y" } } }
+            { +output+ { "x" } }
+            { +clobber+ { "y" } }
+        }
+    } {
+        [
+            "x" operand "y" get neg SAR
+            ! Mask off low bits
+            "x" operand %untag
+        ] H{
+            { +input+ { { f "x" } { [ ] "y" } } }
+            { +output+ { "x" } }
+        }
+    }
+} define-intrinsics
 
 : %untag-fixnums ( seq -- )
     [ %untag-fixnum ] unique-operands ;