AMD64 fixes

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 27b1c8f1b5e799dc8aafcc71e158652e526c2e87..6b9396e4b36315d4bf8bb0b9d1dc2ae68f4df3b3 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,9 +1,6 @@
 should fix in 0.82:
 
 - another i/o bug: on factorcode eventually all i/o times out
-- update amd64 backend
-- when generating a 32-bit image on a 64-bit system, large numbers which should
-  be bignums become fixnums
 - get factor running on mac intel
 
 + io:

diff --git a/library/bootstrap/image.factor b/library/bootstrap/image.factor
index 5d6f02f2815e41005e2e90aa51b3ac256802eb84..79bfff563548b49a5911b133b111b9c83b66be19 100644 (file)
--- a/library/bootstrap/image.factor
+++ b/library/bootstrap/image.factor
@@ -101,12 +101,8 @@ GENERIC: ' ( obj -- ptr )
 : align-here ( -- )
     here 8 mod 4 = [ 0 emit ] when ;
 
-( Fixnums )
-
 : emit-fixnum ( n -- ) fixnum-tag tag-address emit ;
 
-M: fixnum ' ( n -- tagged ) fixnum-tag tag-address ;
-
 ( Bignums )
 
 : bignum-bits bootstrap-cell-bits 2 - ;
@@ -136,6 +132,17 @@ M: bignum ' ( bignum -- tagged )
     bignum-tag tag-header emit
     emit-bignum align-here r> ;
 
+( Fixnums )
+
+M: fixnum ' ( n -- tagged )
+    #! When generating a 32-bit image on a 64-bit system,
+    #! some fixnums should be bignums.
+    dup most-negative-fixnum most-positive-fixnum between? [
+        fixnum-tag tag-address
+    ] [
+        >bignum '
+    ] if ;
+
 ( Floats )
 
 M: float ' ( float -- tagged )

diff --git a/library/compiler/amd64/alien.factor b/library/compiler/amd64/alien.factor
index f737885584db50db56633340b6b5e3a630299119..6b26137a75ec5b6797789d14cf5c78b5b6ef98cb 100644 (file)
--- a/library/compiler/amd64/alien.factor
+++ b/library/compiler/amd64/alien.factor
@@ -22,15 +22,18 @@ M: stack-params %stack>freg
 M: stack-params %freg>stack
     >r stack-increment + cell + swap r> %stack>freg ;
 
-: %unbox-struct ( n reg-class size -- )
-    nip
+: struct-ptr/size ( n reg-class size func -- )
+    rot drop
     ! Load destination address
-    RDI RSP MOV
+    >r RDI RSP MOV
     RDI rot ADD
     ! Load struct size
     RSI swap MOV
     ! Copy the struct to the stack
-    "unbox_value_struct" f compile-c-call ;
+    r> f compile-c-call ;
+
+: %unbox-struct ( n reg-class size -- )
+    "unbox_value_struct" struct-ptr/size ;
 
 : %unbox ( n reg-class func -- )
     ! Call the unboxer
@@ -38,15 +41,18 @@ M: stack-params %freg>stack
     ! Store the return value on the C stack
     [ return-reg ] keep %freg>stack ;
 
+: %box-struct ( n reg-class size -- )
+    "box_value_struct" struct-ptr/size ;
+
 : load-return-value ( reg-class -- )
     dup fastcall-regs first swap return-reg
     2dup eq? [ 2drop ] [ MOV ] if ;
 
 : %box ( n reg-class func -- )
     rot [
-        swap [ fastcall-regs first ] keep %stack>freg
+        rot [ fastcall-regs first ] keep %stack>freg
     ] [
-        load-return-value
+        swap load-return-value
     ] if*
     f compile-c-call ;
 
@@ -56,7 +62,7 @@ M: stack-params %freg>stack
     reset-sse compile-c-call ;
 
 : %alien-callback ( quot -- )
-    RDI swap load-literal "run_callback" f compile-c-call ;
+    RDI load-indirect "run_callback" f compile-c-call ;
 
 : save-return 0 swap [ return-reg ] keep %freg>stack ;
 : load-return 0 swap [ return-reg ] keep %stack>freg ;
@@ -70,3 +76,5 @@ M: stack-params %freg>stack
     "unnest_stacks" f compile-c-call
     ! Restore return register
     load-return ;
+
+: %cleanup ( n -- ) drop ;

diff --git a/library/compiler/amd64/architecture.factor b/library/compiler/amd64/architecture.factor
index 5b4336bdadeb64733eb0d4011cb62e32fd3eebc1..632a6c3d8397a6f7bee25e06ffe42d1ab777c5aa 100644 (file)
--- a/library/compiler/amd64/architecture.factor
+++ b/library/compiler/amd64/architecture.factor
@@ -14,6 +14,7 @@ math namespaces sequences ;
 : ds-reg R14 ; inline
 : cs-reg R15 ; inline
 : remainder-reg RDX ; inline
+: alloc-tmp-reg RBX ; inline
 
 M: int-regs return-reg drop RAX ;
 M: int-regs vregs drop { RAX RCX RDX RSI RDI R8 R9 R10 R11 } ;
@@ -31,7 +32,8 @@ M: float-regs fastcall-regs vregs ;
     R11 [ swap MOV ] keep ; inline
 
 : compile-c-call ( symbol dll -- )
-    2dup dlsym address-operand rel-absolute-cell rel-dlsym CALL ;
+    2dup dlsym address-operand
+    >r rel-absolute-cell rel-dlsym r> CALL ;
 
 : compile-c-call* ( symbol dll args -- )
     T{ int-regs } fastcall-regs
@@ -41,10 +43,13 @@ M: float-regs fastcall-regs vregs ;
 
 : prepare-division CQO ; inline
 
+: load-indirect ( vreg literal -- )
+    swap add-literal from 3 - [] MOV ;
+
 M: object load-literal ( literal vreg -- )
     #! We use RIP-relative addressing. The '3' is a hardcoded
     #! instruction length.
-    v>operand swap add-literal from 3 - [] MOV ;
+    v>operand load-indirect ;
 
 : stack-increment \ stack-reserve get 16 align 8 + ;
 

diff --git a/library/compiler/amd64/intrinsics.factor b/library/compiler/amd64/intrinsics.factor
index 5c583dbdda0470b244f7ddef3b76bcd713afe1e5..b95d82f645b2fba6921501078e44cc9eba6aa77a 100644 (file)
--- a/library/compiler/amd64/intrinsics.factor
+++ b/library/compiler/amd64/intrinsics.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-IN: compiler
 USING: assembler ;
+IN: compiler
 
 : generate-write-barrier ( -- )
     #! Mark the card pointed to by vreg.

diff --git a/library/compiler/x86/architecture.factor b/library/compiler/x86/architecture.factor
index c323f8cb315594aac9511da30ee55366eaba8a75..aeb4c52030be6e782e56282eecd9116e9488f3d5 100644 (file)
--- a/library/compiler/x86/architecture.factor
+++ b/library/compiler/x86/architecture.factor
@@ -15,6 +15,7 @@ IN: compiler
 : ds-reg ESI ; inline
 : cs-reg EBX ; inline
 : remainder-reg EDX ; inline
+: alloc-tmp-reg EDI ; inline
 
 : reg-stack ( n reg -- op ) swap cells neg [+] ;
 

diff --git a/library/compiler/x86/intrinsics-sse2.factor b/library/compiler/x86/intrinsics-sse2.factor
index f3600985220c28bb75c0230e9a795d5953901164..b5b1ea06427d44fb92c6bb4e994a96862e03c05b 100644 (file)
--- a/library/compiler/x86/intrinsics-sse2.factor
+++ b/library/compiler/x86/intrinsics-sse2.factor
@@ -11,8 +11,9 @@ M: float-regs (%peek) ( vreg loc reg-class -- )
 
 : load-zone-ptr ( vreg -- )
     #! Load pointer to start of zone array
-    "generations" f [ dlsym [] MOV ] 2keep
-    rel-absolute rel-dlsym ;
+    dup "generations" f [ dlsym MOV ] 2keep
+    rel-absolute-cell rel-dlsym
+    dup [] MOV ;
 
 : load-allot-ptr ( vreg -- )
     dup load-zone-ptr dup cell [+] MOV ;
@@ -23,18 +24,18 @@ M: float-regs (%peek) ( vreg loc reg-class -- )
 : with-inline-alloc ( prequot postquot spec -- )
     #! both quotations are called with the vreg
     [
-        EBX PUSH
-        EBX load-allot-ptr
-        EBX [] \ tag-header get call tag-header MOV
-        >r call EBX \ tag get call OR
-        r> call EBX \ size get call inc-allot-ptr
-        EBX POP
+        alloc-tmp-reg PUSH
+        alloc-tmp-reg load-allot-ptr
+        alloc-tmp-reg [] \ tag-header get call tag-header MOV
+        >r call alloc-tmp-reg \ tag get call OR
+        r> call alloc-tmp-reg \ size get call inc-allot-ptr
+        alloc-tmp-reg POP
     ] bind ; inline
 
 M: float-regs (%replace) ( vreg loc reg-class -- )
     drop
-    [ EBX 8 [+] rot v>operand MOVSD ]
-    [ v>operand EBX MOV ] H{
+    [ alloc-tmp-reg 8 [+] rot v>operand MOVSD ]
+    [ v>operand alloc-tmp-reg MOV ] H{
         { tag-header [ float-tag ] }
         { tag [ float-tag ] }
         { size [ 16 ] }

diff --git a/library/compiler/x86/intrinsics.factor b/library/compiler/x86/intrinsics.factor
index d790835902c1df044944a950cebd9b143b4b8393..32edad6c852613c6c44142e15c18bc1db32713f4 100644 (file)
--- a/library/compiler/x86/intrinsics.factor
+++ b/library/compiler/x86/intrinsics.factor
@@ -245,11 +245,8 @@ IN: compiler
 } define-intrinsic
 
 : define-fixnum-jump ( word op -- )
-    [
-        [ end-basic-block "x" operand "y" operand CMP ] % ,
-    ] [ ] make H{
-        { +input { { f "x" } { f "y" } } }
-    } define-if-intrinsic ;
+    [ end-basic-block "x" operand "y" operand CMP ] swap add
+    H{ { +input { { f "x" } { f "y" } } } } define-if-intrinsic ;
 
 {
     { fixnum< JL }
@@ -265,7 +262,7 @@ IN: compiler
 : %userenv ( -- )
     "x" operand "userenv" f dlsym MOV
     0 rel-absolute-cell rel-userenv
-    "n" operand 1 SHR
+    "n" operand fixnum>slot@
     "n" operand "x" operand ADD ;
 
 \ getenv [

diff --git a/library/math/constants.factor b/library/math/constants.factor
index 0220a5f69dedab0605964fc196ed2a0ada1ddf57..518f3ccec372b663da59a3620adfb96443912d4e 100644 (file)
--- a/library/math/constants.factor
+++ b/library/math/constants.factor
@@ -20,6 +20,6 @@ IN: math
 : e 2.7182818284590452354 ; inline
 : pi 3.14159265358979323846 ; inline
 : epsilon 2.2204460492503131e-16 ; inline
-: first-bignum 1 cell-bits tag-bits - 1- shift ; inline
-: most-positive-fixnum first-bignum 1- >fixnum ; inline
-: most-negative-fixnum first-bignum neg >fixnum ; inline
+: first-bignum 1 bootstrap-cell-bits tag-bits - 1- shift ;
+: most-positive-fixnum first-bignum 1- >fixnum ;
+: most-negative-fixnum first-bignum neg >fixnum ;