Update AMD64 backend and clean up other backends

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 0abc024d41bb7c262104080a04ec742b7dc972ce..36fad242afbbae41c0cbe385c33e095d16fbabf3 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,10 +1,8 @@
 should fix in 0.82:
 
+- test x86 set-slot
 - clean up fp-scratch
-- intrinsic fixnum>float float>fixnum
 - update amd64 backend
-- float= on powerpc doesn't consider nans equal
-- amd64 %box-struct
 - 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
@@ -51,6 +49,9 @@ should fix in 0.82:
 
 + compiler/ffi:
 
+- amd64 %box-struct
+- float= on powerpc doesn't consider nans equal
+- intrinsic fixnum>float float>fixnum
 - win64 port
 - amd64 %unbox-struct
 - constant branch folding

diff --git a/library/compiler/alien/compiler.factor b/library/compiler/alien/compiler.factor
index 63df3cdd23bd2d9d1ce1647cc4e0ac6a9960ebbb..76898257fe6e9e214d3a566f39f947b861d3464b 100644 (file)
--- a/library/compiler/alien/compiler.factor
+++ b/library/compiler/alien/compiler.factor
@@ -27,7 +27,8 @@ kernel-internals math namespaces sequences words ;
     #! n is a stack location, and the value of the class
     #! variable is a register number.
     c-type "reg-class" swap hash dup reg-class-full?
-    [ spill-param ] [ fastcall-param ] if ;
+    [ spill-param ] [ fastcall-param ] if
+    [ fastcall-regs nth ] keep ;
 
 : flatten-value-types ( params -- params )
     #! Convert value type structs to consecutive void*s.
@@ -43,13 +44,16 @@ kernel-internals math namespaces sequences words ;
     >r [ parameter-sizes ] keep
     [ reverse-slice ] 2apply r> 2each ; inline
 
-: move-parameters ( params vop -- )
-    #! Moves values from C stack to registers (if vop is
-    #! %stack>freg) and registers to C stack (if vop is
+: reset-freg-counts ( -- )
+    0 { int-regs float-regs stack-params } [ set ] each-with ;
+
+: move-parameters ( params word -- )
+    #! Moves values from C stack to registers (if word is
+    #! %stack>freg) and registers to C stack (if word is
     #! %freg>stack).
     swap [
         flatten-value-types
-        0 { int-regs float-regs stack-params } [ set ] each-with
+        reset-freg-counts
         [ pick >r alloc-parameter r> execute ] each-parameter
         drop
     ] with-scope ; inline

diff --git a/library/compiler/amd64/alien.factor b/library/compiler/amd64/alien.factor
index 824b31e10999cbdcbf9d92aaf56bd8c7ac32ae73..f737885584db50db56633340b6b5e3a630299119 100644 (file)
--- a/library/compiler/amd64/alien.factor
+++ b/library/compiler/amd64/alien.factor
@@ -4,89 +4,69 @@ IN: compiler
 USING: alien arrays assembler kernel kernel-internals math
 sequences ;
 
-GENERIC: freg>stack ( stack reg reg-class -- )
-
-GENERIC: stack>freg ( stack reg reg-class -- )
-
 : stack@ RSP swap [+] ;
 
-M: int-regs freg>stack drop >r stack@ r> MOV ;
+M: int-regs %freg>stack drop >r stack@ r> MOV ;
 
-M: int-regs stack>freg drop swap stack@ MOV ;
+M: int-regs %stack>freg drop swap stack@ MOV ;
 
 : MOVSS/D float-regs-size 4 = [ MOVSS ] [ MOVSD ] if ;
 
-M: float-regs freg>stack >r >r stack@ r> r> MOVSS/D ;
+M: float-regs %freg>stack >r >r stack@ r> r> MOVSS/D ;
 
-M: float-regs stack>freg >r swap stack@ r> MOVSS/D ;
+M: float-regs %stack>freg >r swap stack@ r> MOVSS/D ;
 
-M: stack-params stack>freg
+M: stack-params %stack>freg
     drop >r R11 swap stack@ MOV r> stack@ R11 MOV ;
 
-M: stack-params freg>stack
-    >r stack-increment + cell + swap r> stack>freg ;
+M: stack-params %freg>stack
+    >r stack-increment + cell + swap r> %stack>freg ;
 
-M: %unbox-struct generate-node ( vop -- )
-    drop
+: %unbox-struct ( n reg-class size -- )
+    nip
     ! Load destination address
     RDI RSP MOV
-    RDI 0 input ADD
+    RDI rot ADD
     ! Load struct size
-    RSI 2 input MOV
+    RSI swap MOV
     ! Copy the struct to the stack
     "unbox_value_struct" f compile-c-call ;
 
-M: %unbox generate-node ( vop -- )
-    drop
+: %unbox ( n reg-class func -- )
     ! Call the unboxer
-    2 input f compile-c-call
+    f compile-c-call
     ! Store the return value on the C stack
-    0 input 1 input [ return-reg ] keep freg>stack ;
-
-: (%move) 0 input 1 input 2 input [ fastcall-regs nth ] keep ;
-
-M: %stack>freg generate-node ( vop -- )
-    ! Move a value from the C stack into the fastcall register
-    drop (%move) stack>freg ;
-
-M: %freg>stack generate-node ( vop -- )
-    ! Move a value from a fastcall register to the C stack
-    drop (%move) freg>stack ;
-
-: reset-sse RAX RAX XOR ;
-
-M: %alien-invoke generate-node
-    reset-sse
-    drop 0 input 1 input load-library compile-c-call ;
+    [ return-reg ] keep %freg>stack ;
 
 : load-return-value ( reg-class -- )
     dup fastcall-regs first swap return-reg
     2dup eq? [ 2drop ] [ MOV ] if ;
 
-M: %box generate-node ( vop -- )
-    drop
-    0 input [
-        1 input [ fastcall-regs first ] keep stack>freg
+: %box ( n reg-class func -- )
+    rot [
+        swap [ fastcall-regs first ] keep %stack>freg
     ] [
-        1 input load-return-value
+        load-return-value
     ] if*
-    2 input f compile-c-call ;
+    f compile-c-call ;
+
+: reset-sse RAX RAX XOR ;
+
+: %alien-invoke ( symbol dll -- )
+    reset-sse compile-c-call ;
 
-M: %alien-callback generate-node ( vop -- )
-    drop
-    RDI 0 input load-indirect
-    "run_callback" f compile-c-call ;
+: %alien-callback ( quot -- )
+    RDI swap load-literal "run_callback" f compile-c-call ;
 
-: save-return 0 swap [ return-reg ] keep freg>stack ;
-: load-return 0 swap [ return-reg ] keep stack>freg ;
+: save-return 0 swap [ return-reg ] keep %freg>stack ;
+: load-return 0 swap [ return-reg ] keep %stack>freg ;
 
-M: %callback-value generate-node ( vop -- )
-    drop
+: %callback-value ( reg-class func -- )
     ! Call the unboxer
-    1 input f compile-c-call
+    f compile-c-call
     ! Save return register
-    0 input save-return
+    dup save-return
     ! Restore data/callstacks
     "unnest_stacks" f compile-c-call
     ! Restore return register
-    0 input load-return ;
+    load-return ;

diff --git a/library/compiler/amd64/architecture.factor b/library/compiler/amd64/architecture.factor
index 9a48d9b57154d5fffc8c255251190f81bb683450..4147982fa68ede6138fec6f2d9f675a887663a62 100644 (file)
--- a/library/compiler/amd64/architecture.factor
+++ b/library/compiler/amd64/architecture.factor
@@ -1,11 +1,11 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: compiler
-USING: alien arrays assembler kernel
-kernel-internals math namespaces sequences ;
+USING: alien arrays assembler generic kernel kernel-internals
+math namespaces sequences ;
 
 ! AMD64 register assignments
-! RAX RCX RDX RSI RDI R8 R9 R10 R11 integer vregs
+! RAX RCX RDX RSI RDI R8 R9 R10 integer vregs
 ! XMM0 - XMM7 float vregs
 ! R13 cards_offset
 ! R14 datastack
@@ -16,21 +16,21 @@ kernel-internals math namespaces sequences ;
 : remainder-reg RDX ; inline
 
 M: int-regs return-reg drop RAX ;
-M: int-regs vregs drop { RAX RCX RDX RSI RDI R8 R9 R10 R11 } ;
+M: int-regs vregs drop { RAX RCX RDX RSI RDI R8 R9 R10 } ;
 M: int-regs fastcall-regs drop { RDI RSI RDX RCX R8 R9 } ;
 
+M: float-regs return-reg drop XMM0 ;
+M: float-regs vregs drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
+M: float-regs fastcall-regs vregs ;
+
 : compile-c-call ( symbol dll -- )
-    2dup dlsym R10 swap MOV
-    rel-absolute-cell rel-dlsym R10 CALL ;
+    2dup dlsym R10 swap MOV rel-absolute-cell rel-dlsym
+    R10 CALL ;
 
 : compile-c-call* ( symbol dll args -- )
     T{ int-regs } fastcall-regs
     swap [ MOV ] 2each compile-c-call ;
 
-M: float-regs return-reg drop XMM0 ;
-M: float-regs vregs drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
-M: float-regs fastcall-regs vregs ;
-
 : address-operand ( address -- operand )
     #! On AMD64, we have to load 64-bit addresses into a
     #! scratch register first. The usage of R11 here is a hack.
@@ -42,12 +42,15 @@ M: float-regs fastcall-regs vregs ;
 
 : prepare-division CQO ; inline
 
-: load-indirect ( dest literal -- )
+M: object load-literal ( literal vreg -- )
     #! We use RIP-relative addressing. The '3' is a hardcoded
     #! instruction length.
-    add-literal from 3 - [] MOV ; inline
+    v>operand swap add-literal from 3 - [] MOV ;
 
 : stack-increment \ stack-reserve get 16 align 8 + ;
 
-: compile-epilogue ( -- )
-    RSP stack-increment ADD ; inline
+: %prologue ( n -- )
+    \ stack-reserve set RSP stack-increment SUB ;
+
+: %epilogue ( -- )
+    RSP stack-increment ADD ;

diff --git a/library/compiler/amd64/generator.factor b/library/compiler/amd64/generator.factor
deleted file mode 100644 (file)
index 99a2d26..0000000
--- a/library/compiler/amd64/generator.factor
+++ /dev/null
@@ -1,9 +0,0 @@
-! Copyright (C) 2006 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-IN: compiler
-USING: assembler kernel math namespaces ;
-
-M: %prologue generate-node ( vop -- )
-    drop
-    0 input \ stack-reserve set
-    RSP stack-increment SUB ;

diff --git a/library/compiler/amd64/intrinsics.factor b/library/compiler/amd64/intrinsics.factor
new file mode 100644 (file)
index 0000000..5c583db
--- /dev/null
+++ b/library/compiler/amd64/intrinsics.factor
@@ -0,0 +1,9 @@
+! Copyright (C) 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler
+USING: assembler ;
+
+: generate-write-barrier ( -- )
+    #! Mark the card pointed to by vreg.
+    "obj" operand card-bits SHR
+    "obj" operand R13 [+] card-mark OR ;

diff --git a/library/compiler/amd64/slots.factor b/library/compiler/amd64/slots.factor
deleted file mode 100644 (file)
index 7f2ab2e..0000000
--- a/library/compiler/amd64/slots.factor
+++ /dev/null
@@ -1,11 +0,0 @@
-! Copyright (C) 2006 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-IN: compiler
-USING: alien arrays assembler inference kernel
-kernel-internals lists math memory namespaces sequences words ;
-
-M: %write-barrier generate-node ( vop -- )
-    #! Mark the card pointed to by vreg.
-    drop
-    0 input-operand card-bits SHR
-    0 input-operand R13 [+] card-mark OR ;

diff --git a/library/compiler/generator/architecture.factor b/library/compiler/generator/architecture.factor
index 987cd6265a7b94810f72c711a3522236806fd4e5..be0263f48a60b55607a16926942f94c19deaeeb9 100644 (file)
--- a/library/compiler/generator/architecture.factor
+++ b/library/compiler/generator/architecture.factor
@@ -94,9 +94,9 @@ DEFER: %box ( n reg-class func -- )
 
 DEFER: %box-struct ( n reg-class size -- )
 
-DEFER: %stack>freg ( n reg reg-class -- )
+GENERIC: %freg>stack ( stack reg reg-class -- )
 
-DEFER: %freg>stack ( n reg reg-class -- )
+GENERIC: %stack>freg ( stack reg reg-class -- )
 
 DEFER: %alien-invoke ( library function -- )
 

diff --git a/library/compiler/ppc/architecture.factor b/library/compiler/ppc/architecture.factor
index 88532d0299b96bf7b66eb4f98ec5606c74a3e044..adbd5a8adbee31556ee851d2572aac5058415f0a 100644 (file)
--- a/library/compiler/ppc/architecture.factor
+++ b/library/compiler/ppc/architecture.factor
@@ -135,50 +135,40 @@ M: float-regs (%replace) ( vreg loc reg-class -- )
 
 : %inc-r ( n -- ) 15 15 rot cells ADDI ;
 
-GENERIC: freg>stack ( stack reg reg-class -- )
+M: int-regs %freg>stack drop 1 rot stack@ STW ;
 
-GENERIC: stack>freg ( stack reg reg-class -- )
-
-M: int-regs freg>stack drop 1 rot stack@ STW ;
-
-M: int-regs stack>freg drop 1 rot stack@ LWZ ;
+M: int-regs %stack>freg drop 1 rot stack@ LWZ ;
 
 : STF float-regs-size 4 = [ STFS ] [ STFD ] if ;
 
-M: float-regs freg>stack >r 1 rot stack@ r> STF ;
+M: float-regs %freg>stack >r 1 rot stack@ r> STF ;
 
 : LF float-regs-size 4 = [ LFS ] [ LFD ] if ;
 
-M: float-regs stack>freg >r 1 rot stack@ r> LF ;
+M: float-regs %stack>freg >r 1 rot stack@ r> LF ;
 
-M: stack-params stack>freg
+M: stack-params %stack>freg
     drop 2dup = [
         2drop
     ] [
         >r 0 1 rot stack@ LWZ 0 1 r> stack@ STW
     ] if ;
 
-M: stack-params freg>stack
-   >r stack-increment + swap r> stack>freg ;
-
-: %stack>freg ( n reg reg-class -- )
-    [ fastcall-regs nth ] keep stack>freg ;
-
-: %freg>stack ( n reg reg-class -- )
-    [ fastcall-regs nth ] keep freg>stack ;
+M: stack-params %freg>stack
+   >r stack-increment + swap r> %stack>freg ;
 
 : %unbox ( n reg-class func -- )
     ! Call the unboxer
     f %alien-invoke
     ! Store the return value on the C stack
-    [ return-reg ] keep freg>stack ;
+    [ return-reg ] keep %freg>stack ;
 
 : %box ( n reg-class func -- )
     ! If the source is a stack location, load it into freg #0.
     ! If the source is f, then we assume the value is already in
     ! freg #0.
     pick [
-        >r [ fastcall-regs first ] keep stack>freg r>
+        >r [ fastcall-regs first ] keep %stack>freg r>
     ] [
         2nip
     ] if
@@ -204,8 +194,8 @@ M: stack-params freg>stack
 : %alien-callback ( quot -- )
     0 <int-vreg> load-literal "run_callback" f %alien-invoke ;
 
-: save-return 0 swap [ return-reg ] keep freg>stack ;
-: load-return 0 swap [ return-reg ] keep stack>freg ;
+: save-return 0 swap [ return-reg ] keep %freg>stack ;
+: load-return 0 swap [ return-reg ] keep %stack>freg ;
 
 : %callback-value ( reg-class func -- )
     ! Call the unboxer

diff --git a/library/compiler/x86/architecture.factor b/library/compiler/x86/architecture.factor
index 3460de4cc9c52fb01f2327177a15f20f5f778b26..c323f8cb315594aac9511da30ee55366eaba8a75 100644 (file)
--- a/library/compiler/x86/architecture.factor
+++ b/library/compiler/x86/architecture.factor
@@ -101,6 +101,6 @@ M: int-regs (%replace) drop swap %move-int>int ;
 
 : %inc-r ( n -- ) cs-reg (%inc) ;
 
-: %stack>freg ( n reg reg-class -- ) 3drop ;
+M: object %stack>freg ( n reg reg-class -- ) 3drop ;
 
-: %freg>stack ( n reg reg-class -- ) 3drop ;
+M: object %freg>stack ( n reg reg-class -- ) 3drop ;