From eac3146be6d6aaabdcf4694c70d2a4e115f67095 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Wed, 7 Dec 2005 03:39:05 +0000
Subject: [PATCH] all intrinsics tests pass (except overflow)

---
 library/compiler/amd64/architecture.factor |  2 ++
 library/compiler/ppc/generator.factor      |  6 ++--
 library/compiler/x86/architecture.factor   |  2 ++
 library/compiler/x86/assembler.factor      |  2 ++
 library/compiler/x86/fixnum.factor         | 38 ++++++++++++----------
 library/compiler/x86/generator.factor      |  8 +++--
 6 files changed, 35 insertions(+), 23 deletions(-)

diff --git a/library/compiler/amd64/architecture.factor b/library/compiler/amd64/architecture.factor
index 5e481e2422..54290292e1 100644
--- a/library/compiler/amd64/architecture.factor
+++ b/library/compiler/amd64/architecture.factor
@@ -30,3 +30,5 @@ M: float-regs fastcall-regs drop 0 ;
 : fixnum>slot@ drop ; inline
 
 : return-register RAX ; inline
+
+: remainder-reg RDX ; inline
diff --git a/library/compiler/ppc/generator.factor b/library/compiler/ppc/generator.factor
index 97fd415a0d..ec2b7c4d23 100644
--- a/library/compiler/ppc/generator.factor
+++ b/library/compiler/ppc/generator.factor
@@ -42,17 +42,19 @@ M: %call-label generate-node ( vop -- )
 
 : compile-call ( label -- )
     #! Far C call for primitives, near C call for compiled defs.
+    dup postpone-word
     dup primitive? [ word-addr  3 MTLR  BLRL ] [ BL ] if ;
 
 M: %call generate-node ( vop -- )
-    vop-label dup postpone-word compile-call ;
+    vop-label compile-call ;
 
 : compile-jump ( label -- )
     #! For tail calls. IP not saved on C stack.
+    dup postpone-word
     dup primitive? [ word-addr  3 MTCTR  BCTR ] [ B ] if ;
 
 M: %jump generate-node ( vop -- )
-    vop-label dup postpone-word  compile-epilogue compile-jump ;
+    vop-label  compile-epilogue compile-jump ;
 
 M: %jump-label generate-node ( vop -- )
     vop-label B ;
diff --git a/library/compiler/x86/architecture.factor b/library/compiler/x86/architecture.factor
index ff00dc530d..a0117cec53 100644
--- a/library/compiler/x86/architecture.factor
+++ b/library/compiler/x86/architecture.factor
@@ -30,3 +30,5 @@ M: float-regs fastcall-regs drop 0 ;
 : fixnum>slot@ 1 SHR ; inline
 
 : return-register EAX ; inline
+
+: remainder-reg EDX ; inline
diff --git a/library/compiler/x86/assembler.factor b/library/compiler/x86/assembler.factor
index ca6ceacd29..5419ad3499 100644
--- a/library/compiler/x86/assembler.factor
+++ b/library/compiler/x86/assembler.factor
@@ -152,6 +152,7 @@ UNION: operand register indirect displaced disp-only ;
 GENERIC: PUSH ( op -- )
 M: register PUSH f HEX: 50 short-operand ;
 M: integer PUSH HEX: 68 assemble-1 assemble-4 ;
+M: word PUSH 0 PUSH absolute-4 ;
 M: operand PUSH BIN: 110 f HEX: ff 1-operand ;
 
 GENERIC: POP ( op -- )
@@ -165,6 +166,7 @@ M: operand (MOV-I) BIN: 000 t HEX: c7 1-operand assemble-4 ;
 
 GENERIC: MOV ( dst src -- )
 M: integer MOV swap (MOV-I) ;
+M: word MOV 0 rot (MOV-I) absolute-cell ;
 M: operand MOV HEX: 89 2-operand ;
 
 ( Control flow                                                 )
diff --git a/library/compiler/x86/fixnum.factor b/library/compiler/x86/fixnum.factor
index b70d68ebd5..1f1d1d42ed 100644
--- a/library/compiler/x86/fixnum.factor
+++ b/library/compiler/x86/fixnum.factor
@@ -28,7 +28,7 @@ math-internals memory namespaces words ;
     0 output-operand PUSH
     "s48_long_to_bignum" f compile-c-call
     ! An untagged pointer to the bignum is now in EAX; tag it
-    EAX bignum-tag OR
+    return-reg bignum-tag OR
     0 scratch POP
     "end" get save-xt ; inline
 
@@ -42,22 +42,24 @@ M: %fixnum* generate-node ( vop -- )
     drop
     ! both inputs are tagged, so one of them needs to have its
     ! tag removed.
-    EAX tag-bits SAR
-    ECX IMUL
+    0 input-operand tag-bits SAR
+    1 input-operand IMUL
     <label> "end" set
     "end" get JNO
-    EDX PUSH
-    EAX PUSH
+    remainder-reg PUSH
+    0 input-operand PUSH
     "s48_long_long_to_bignum" f compile-c-call
-    ESP 8 ADD
+    0 scratch POP
+    1 scratch POP
     ! now we have to shift it by three bits to remove the second
     ! tag
     tag-bits neg PUSH
-    EAX PUSH
+    0 input-operand PUSH
     "s48_bignum_arithmetic_shift" f compile-c-call
     ! an untagged pointer to the bignum is now in EAX; tag it
-    EAX bignum-tag OR
-    ESP 8 ADD
+    return-reg bignum-tag OR
+    0 scratch POP
+    1 scratch POP
     "end" get save-xt ;
 
 M: %fixnum-mod generate-node ( vop -- )
@@ -65,7 +67,7 @@ M: %fixnum-mod generate-node ( vop -- )
     #! EAX and ECX, and the result is in EDX.
     drop
     CDQ
-    ECX IDIV ;
+    1 input-operand IDIV ;
 
 : generate-fixnum/mod
     #! The same code is used for %fixnum/i and %fixnum/mod.
@@ -73,24 +75,24 @@ M: %fixnum-mod generate-node ( vop -- )
     #! EAX and ECX, and the result is in EDX.
     <label> "end" set
     CDQ
-    ECX IDIV
+    1 input-operand IDIV
     ! Make a copy since following shift is destructive
-    ECX EAX MOV
+    1 input-operand 0 input-operand MOV
     ! Tag the value, since division cancelled tags from both
     ! inputs
-    EAX tag-bits SHL
+    0 input-operand tag-bits SHL
     ! Did it overflow?
     "end" get JNO
     ! There was an overflow, so make ECX into a bignum. we must
     ! save EDX since its volatile.
-    EDX PUSH
-    ECX PUSH
+    remainder-reg PUSH
+    1 input-operand PUSH
     "s48_long_to_bignum" f compile-c-call
     ! An untagged pointer to the bignum is now in EAX; tag it
-    EAX bignum-tag OR
-    ESP cell ADD
+    return-reg bignum-tag OR
+    0 scratch POP
     ! the remainder is now in EDX
-    EDX POP
+    remainder-reg POP
     "end" get save-xt ;
 
 M: %fixnum/i generate-node drop generate-fixnum/mod ;
diff --git a/library/compiler/x86/generator.factor b/library/compiler/x86/generator.factor
index d4282bf42d..5f8e7ee844 100644
--- a/library/compiler/x86/generator.factor
+++ b/library/compiler/x86/generator.factor
@@ -13,13 +13,15 @@ M: %prologue generate-node drop ;
 : compile-c-call ( symbol dll -- ) [ CALL ] compile-dlsym ;
 
 M: %call generate-node ( vop -- )
-    drop label dup postpone-word CALL ;
+    drop label dup postpone-word
+    dup primitive? [ address-operand ] when CALL ;
 
 M: %call-label generate-node ( vop -- )
     drop label CALL ;
 
 M: %jump generate-node ( vop -- )
-    drop label dup postpone-word JMP ;
+    drop label dup postpone-word
+    dup primitive? [ address-operand ] when JMP ;
 
 M: %jump-label generate-node ( vop -- )
     drop label JMP ;
@@ -32,7 +34,7 @@ M: %jump-t generate-node ( vop -- )
     label JNE ;
 
 M: %return-to generate-node ( vop -- )
-    drop 0 PUSH label absolute-cell ;
+    drop label address-operand PUSH ;
 
 M: %return generate-node ( vop -- )
     drop RET ;