Better separation of concerns: cpu.{x86,ppc}.assembler no longer depends on compiler...

diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index 826fa87b739b09f34910d2b81f739b0b4b8e06f5..47593878fae2025fe67102069f3df7a09429b7b3 100755 (executable)
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -88,7 +88,7 @@ M: ##call generate-insn
     word>> dup sub-primitive>>
     [ first % ] [ [ add-call ] [ %call ] bi ] ?if ;
 
-M: ##jump generate-insn word>> [ add-call ] [ %jump-label ] bi ;
+M: ##jump generate-insn word>> [ add-call ] [ %jump ] bi ;
 
 M: ##return generate-insn drop %return ;
 

diff --git a/basis/compiler/codegen/fixup/fixup.factor b/basis/compiler/codegen/fixup/fixup.factor
index 99f258d93c618faa0f143b9f575c59a23792b144..b52bb51b264ce2069b5f1e232498ff38b27f1ff8 100755 (executable)
--- a/basis/compiler/codegen/fixup/fixup.factor
+++ b/basis/compiler/codegen/fixup/fixup.factor
@@ -56,8 +56,8 @@ SYMBOL: literal-table
 : rel-word ( word class -- )
     [ add-literal ] dip rt-xt rel-fixup ;
 
-: rel-word-direct ( word class -- )
-    [ add-literal ] dip rt-xt-direct rel-fixup ;
+: rel-word-pic ( word class -- )
+    [ add-literal ] dip rt-xt-pic rel-fixup ;
 
 : rel-primitive ( word class -- )
     [ def>> first add-literal ] dip rt-primitive rel-fixup ;

diff --git a/basis/compiler/constants/constants.factor b/basis/compiler/constants/constants.factor
index e30cc10ee248e25eb93a9bf40f5364afac4b1b9d..886933b5cd5fa85d6a7dda741737be82d06ab350 100644 (file)
--- a/basis/compiler/constants/constants.factor
+++ b/basis/compiler/constants/constants.factor
@@ -42,7 +42,7 @@ CONSTANT: rt-primitive   0
 CONSTANT: rt-dlsym       1
 CONSTANT: rt-dispatch    2
 CONSTANT: rt-xt          3
-CONSTANT: rt-xt-direct   4
+CONSTANT: rt-xt-pic      4
 CONSTANT: rt-here        5
 CONSTANT: rt-this        6
 CONSTANT: rt-immediate   7

diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index 2c9675426bc4a8ca6da82ef686b3ac8b97b90907..de5d1da4e01a0b94e04d54f469ad2dfe50f1145d 100644 (file)
--- a/basis/cpu/architecture/architecture.factor
+++ b/basis/cpu/architecture/architecture.factor
@@ -47,6 +47,7 @@ HOOK: %inc-r cpu ( n -- )
 
 HOOK: stack-frame-size cpu ( stack-frame -- n )
 HOOK: %call cpu ( word -- )
+HOOK: %jump cpu ( word -- )
 HOOK: %jump-label cpu ( label -- )
 HOOK: %return cpu ( -- )
 

diff --git a/basis/cpu/ppc/assembler/assembler.factor b/basis/cpu/ppc/assembler/assembler.factor
index fbb878a888044f01f1b178a55b18b38b98cf7083..2daf3678ce06987fb20c89980be561b24b02230e 100644 (file)
--- a/basis/cpu/ppc/assembler/assembler.factor
+++ b/basis/cpu/ppc/assembler/assembler.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: compiler.codegen.fixup kernel namespaces words
-io.binary math math.order cpu.ppc.assembler.backend ;
+USING: kernel namespaces words io.binary math math.order
+cpu.ppc.assembler.backend ;
 IN: cpu.ppc.assembler
 
 ! See the Motorola or IBM documentation for details. The opcode

diff --git a/basis/cpu/ppc/assembler/backend/backend.factor b/basis/cpu/ppc/assembler/backend/backend.factor
index 946aca69902c5a00d8a0c504430a6d80f247d397..1e6365b1e79c039caf9776dfbadc165b6c75fb9a 100644 (file)
--- a/basis/cpu/ppc/assembler/backend/backend.factor
+++ b/basis/cpu/ppc/assembler/backend/backend.factor
@@ -1,8 +1,7 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: compiler.codegen.fixup cpu.architecture
-compiler.constants kernel namespaces make sequences words math
-math.bitwise io.binary parser lexer ;
+USING:  kernel namespaces make sequences words math
+math.bitwise io.binary parser lexer fry ;
 IN: cpu.ppc.assembler.backend
 
 : insn ( operand opcode -- ) { 26 0 } bitfield 4 >be % ;
@@ -74,21 +73,16 @@ SYNTAX: XO1: (XO) (1) (( a s -- )) define-declared ;
 
 GENERIC# (B) 2 ( dest aa lk -- )
 M: integer (B) 18 i-insn ;
-M: word (B) [ 0 ] 2dip (B) rc-relative-ppc-3 rel-word ;
-M: label (B) [ 0 ] 2dip (B) rc-relative-ppc-3 label-fixup ;
 
 GENERIC: BC ( a b c -- )
 M: integer BC 0 0 16 b-insn ;
-M: word BC [ 0 BC ] dip rc-relative-ppc-2 rel-word ;
-M: label BC [ 0 BC ] dip rc-relative-ppc-2 label-fixup ;
 
 : CREATE-B ( -- word ) scan "B" prepend create-in ;
 
 SYNTAX: BC:
     CREATE-B scan-word scan-word
-    [ rot BC ] 2curry (( c -- )) define-declared ;
+    '[ [ _ _ ] dip BC ] (( c -- )) define-declared ;
 
 SYNTAX: B:
     CREATE-B scan-word scan-word scan-word scan-word scan-word
-    [ b-insn ] curry curry curry curry curry
-    (( bo -- )) define-declared ;
+    '[ _ _ _ _ _ b-insn ] (( bo -- )) define-declared ;

diff --git a/basis/cpu/ppc/bootstrap.factor b/basis/cpu/ppc/bootstrap.factor
index 5451cf2b7992045b084a966641786c731848e69f..8001868e0c62679ba85f58ab1a10d173d4ab5bc9 100644 (file)
--- a/basis/cpu/ppc/bootstrap.factor
+++ b/basis/cpu/ppc/bootstrap.factor
@@ -58,7 +58,7 @@ CONSTANT: rs-reg 14
     BCTR\r
 ] jit-primitive jit-define\r
 \r
-[ 0 BL rc-relative-ppc-3 rt-xt-direct jit-rel ] jit-word-call jit-define\r
+[ 0 BL rc-relative-ppc-3 rt-xt-pic jit-rel ] jit-word-call jit-define\r
 \r
 [ 0 B rc-relative-ppc-3 rt-xt jit-rel ] jit-word-jump jit-define\r
 \r

diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index a6beb42399e73a1d7c3348e49cfacfef5de9015d..c239bacbc0ae9a6ff8ff4725759c0e6c0ab09cb2 100644 (file)
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -15,10 +15,16 @@ IN: cpu.ppc
 ! f0-f29: float vregs
 ! f30: float scratch
 
+! Add some methods to the assembler that are useful to us
+M: label (B) [ 0 ] 2dip (B) rc-relative-ppc-3 label-fixup ;
+M: label BC [ 0 BC ] dip rc-relative-ppc-2 label-fixup ;
+
 enable-float-intrinsics
 
-<< \ ##integer>float t frame-required? set-word-prop
-\ ##float>integer t frame-required? set-word-prop >>
+<<
+\ ##integer>float t frame-required? set-word-prop
+\ ##float>integer t frame-required? set-word-prop
+>>
 
 M: ppc machine-registers
     {
@@ -107,7 +113,8 @@ M: ppc stack-frame-size ( stack-frame -- i )
     factor-area-size +
     4 cells align ;
 
-M: ppc %call ( label -- ) BL ;
+M: ppc %call ( word -- ) 0 BL rc-relative-ppc-3 rel-word-pic ;
+M: ppc %jump ( word -- ) 0 B rc-relative-ppc-3 rel-word ;
 M: ppc %jump-label ( label -- ) B ;
 M: ppc %return ( -- ) BLR ;
 

diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index 10cd9c8657e00444f420996efb57401570f18633..376edeb202fe4068a769b112c053161c84bfaea4 100755 (executable)
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -44,9 +44,9 @@ M: x86.32 param-reg-2 EDX ;
 
 M: x86.32 reserved-area-size 0 ;
 
-M: x86.32 %alien-invoke (CALL) rel-dlsym ;
+M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
 
-M: x86.32 %alien-invoke-tail (JMP) rel-dlsym ;
+M: x86.32 %alien-invoke-tail 0 JMP rc-relative rel-dlsym ;
 
 M: x86.32 return-struct-in-registers? ( c-type -- ? )
     c-type

diff --git a/basis/cpu/x86/32/bootstrap.factor b/basis/cpu/x86/32/bootstrap.factor
index be21344815ffb97fdeb862219dcf09c614d9e5b3..660a428dfb301e054f8c23ac71bb679f21e4eecc 100644 (file)
--- a/basis/cpu/x86/32/bootstrap.factor
+++ b/basis/cpu/x86/32/bootstrap.factor
@@ -29,7 +29,7 @@ IN: bootstrap.x86
 ] jit-save-stack jit-define
 
 [
-    (JMP) drop rc-relative rt-primitive jit-rel
+    0 JMP rc-relative rt-primitive jit-rel
 ] jit-primitive jit-define
 
 << "vocab:cpu/x86/bootstrap.factor" parse-file parsed >>

diff --git a/basis/cpu/x86/assembler/assembler.factor b/basis/cpu/x86/assembler/assembler.factor
index 5560d17a1e45459159b04d38ac8ce85dfe7fe0f1..2b40aa2053f0b55779c64b97056966d397cbc531 100644 (file)
--- a/basis/cpu/x86/assembler/assembler.factor
+++ b/basis/cpu/x86/assembler/assembler.factor
@@ -1,12 +1,11 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays cpu.architecture compiler.constants
-compiler.codegen.fixup io.binary kernel combinators
-kernel.private math namespaces make sequences words system
-layouts math.order accessors cpu.x86.assembler.syntax ;
+USING: arrays io.binary kernel combinators
+kernel.private math namespaces make sequences words system layouts
+math.order accessors cpu.x86.assembler.syntax ;
 IN: cpu.x86.assembler
 
-! A postfix assembler for x86 and AMD64.
+! A postfix assembler for x86-32 and x86-64.
 
 ! In 32-bit mode, { 1234 } is absolute indirect addressing.
 ! In 64-bit mode, { 1234 } is RIP-relative.
@@ -296,36 +295,23 @@ M: operand (MOV-I)
     { BIN: 000 t HEX: c6 }
     pick byte? [ immediate-1 ] [ immediate-4 ] if ;
 
-PREDICATE: callable < word register? not ;
-
 GENERIC: MOV ( dst src -- )
 M: immediate MOV swap (MOV-I) ;
-M: callable MOV [ 0 ] 2dip (MOV-I) rc-absolute-cell rel-word ;
 M: operand MOV HEX: 88 2-operand ;
 
 : LEA ( dst src -- ) swap HEX: 8d 2-operand ;
 
 ! Control flow
 GENERIC: JMP ( op -- )
-: (JMP) ( -- rel-class ) HEX: e9 , 0 4, rc-relative ;
-M: f JMP (JMP) 2drop ;
-M: callable JMP (JMP) rel-word ;
-M: label JMP (JMP) label-fixup ;
+M: integer JMP HEX: e9 , 4, ;
 M: operand JMP { BIN: 100 t HEX: ff } 1-operand ;
 
 GENERIC: CALL ( op -- )
-: (CALL) ( -- rel-class ) HEX: e8 , 0 4, rc-relative ;
-M: f CALL (CALL) 2drop ;
-M: callable CALL (CALL) rel-word-direct ;
-M: label CALL (CALL) label-fixup ;
+M: integer CALL HEX: e8 , 4, ;
 M: operand CALL { BIN: 010 t HEX: ff } 1-operand ;
 
 GENERIC# JUMPcc 1 ( addr opcode -- )
-: (JUMPcc) ( addr n -- rel-class ) extended-opcode, 4, rc-relative ;
-M: f JUMPcc [ 0 ] dip (JUMPcc) 2drop ;
-M: integer JUMPcc (JUMPcc) drop ;
-M: callable JUMPcc [ 0 ] dip (JUMPcc) rel-word ;
-M: label JUMPcc [ 0 ] dip (JUMPcc) label-fixup ;
+M: integer JUMPcc extended-opcode, 4, ;
 
 : JO  ( dst -- ) HEX: 80 JUMPcc ;
 : JNO ( dst -- ) HEX: 81 JUMPcc ;

diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor
index fc7fbc88b950a8f88ad2b14a8906b26075dabea1..4b409102c9027002fccfe61c3dc97a0be2fe2f2b 100644 (file)
--- a/basis/cpu/x86/bootstrap.factor
+++ b/basis/cpu/x86/bootstrap.factor
@@ -42,11 +42,11 @@ big-endian off
 ] jit-push-immediate jit-define
 
 [
-    f JMP rc-relative rt-xt jit-rel
+    0 JMP rc-relative rt-xt jit-rel
 ] jit-word-jump jit-define
 
 [
-    f CALL rc-relative rt-xt-direct jit-rel
+    0 CALL rc-relative rt-xt-pic jit-rel
 ] jit-word-call jit-define
 
 [
@@ -57,12 +57,12 @@ big-endian off
     ! compare boolean with f
     temp0 \ f tag-number CMP
     ! jump to true branch if not equal
-    f JNE rc-relative rt-xt jit-rel
+    0 JNE rc-relative rt-xt jit-rel
 ] jit-if-1 jit-define
 
 [
     ! jump to false branch if equal
-    f JMP rc-relative rt-xt jit-rel
+    0 JMP rc-relative rt-xt jit-rel
 ] jit-if-2 jit-define
 
 : jit->r ( -- )
@@ -115,19 +115,19 @@ big-endian off
 
 [
     jit->r
-    f CALL rc-relative rt-xt jit-rel
+    0 CALL rc-relative rt-xt jit-rel
     jit-r>
 ] jit-dip jit-define
 
 [
     jit-2>r
-    f CALL rc-relative rt-xt jit-rel
+    0 CALL rc-relative rt-xt jit-rel
     jit-2r>
 ] jit-2dip jit-define
 
 [
     jit-3>r
-    f CALL rc-relative rt-xt jit-rel
+    0 CALL rc-relative rt-xt jit-rel
     jit-3r>
 ] jit-3dip jit-define
 
@@ -211,7 +211,7 @@ big-endian off
     temp1 temp2 CMP
 ] pic-check jit-define
 
-[ f JE rc-relative rt-xt jit-rel ] pic-hit jit-define
+[ 0 JE rc-relative rt-xt jit-rel ] pic-hit jit-define
 
 ! ! ! Megamorphic caches
 

diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 2859e71be2b6e8932eff788a98f544fbf6838759..d508d7740b15cb3e795c87052b382a1bb436611f 100644 (file)
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -11,6 +11,10 @@ IN: cpu.x86
 
 << enable-fixnum-log2 >>
 
+! Add some methods to the assembler to be more useful to the backend
+M: label JMP 0 JMP rc-relative label-fixup ;
+M: label JUMPcc [ 0 ] dip JUMPcc rc-relative label-fixup ;
+
 M: x86 two-operand? t ;
 
 HOOK: temp-reg-1 cpu ( -- reg )
@@ -53,8 +57,9 @@ M: x86 stack-frame-size ( stack-frame -- i )
     reserved-area-size +
     align-stack ;
 
-M: x86 %call ( label -- ) CALL ;
-M: x86 %jump-label ( label -- ) JMP ;
+M: x86 %call ( word -- ) 0 CALL rc-relative rel-word-pic ;
+M: x86 %jump ( word -- ) 0 JMP rc-relative rel-word ;
+M: x86 %jump-label ( label -- ) 0 JMP rc-relative label-fixup ;
 M: x86 %return ( -- ) 0 RET ;
 
 : code-alignment ( align -- n )