diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index 826fa87b73..47593878fa 100755 --- 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 99f258d93c..b52bb51b26 100755 --- 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 e30cc10ee2..886933b5cd 100644 --- 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 2c9675426b..de5d1da4e0 100644 --- 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 fbb878a888..2daf3678ce 100644 --- 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 946aca6990..1e6365b1e7 100644 --- 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 5451cf2b79..8001868e0c 100644 --- a/basis/cpu/ppc/bootstrap.factor +++ b/basis/cpu/ppc/bootstrap.factor @@ -58,7 +58,7 @@ CONSTANT: rs-reg 14 BCTR ] jit-primitive jit-define -[ 0 BL rc-relative-ppc-3 rt-xt-direct jit-rel ] jit-word-call jit-define +[ 0 BL rc-relative-ppc-3 rt-xt-pic jit-rel ] jit-word-call jit-define [ 0 B rc-relative-ppc-3 rt-xt jit-rel ] jit-word-jump jit-define diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index a6beb42399..c239bacbc0 100644 --- 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 10cd9c8657..376edeb202 100755 --- 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 be21344815..660a428dfb 100644 --- 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 5560d17a1e..2b40aa2053 100644 --- 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 fc7fbc88b9..4b409102c9 100644 --- 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 2859e71be2..d508d7740b 100644 --- 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 )