steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Better separation of concerns: cpu.{x86,ppc}.assembler no longer depends on compiler.codegen.fixup and cpu.architecture. Rename rt-xt-direct to rt-xt-pic to better explain its purpose

db4
Slava Pestov 2009-05-06 16:14:53 -05:00
parent 075fb1d3a6
commit c93d876075
13 changed files with 48 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/compiler/codegen/codegen.factor
View File

@ -88,7 +88,7 @@ M: ##call generate-insn
word>> dup sub-primitive>> word>> dup sub-primitive>>
[ first % ] [ [ add-call ] [ %call ] bi ] ?if ; [ 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 ; M: ##return generate-insn drop %return ;

4
basis/compiler/codegen/fixup/fixup.factor
View File

@ -56,8 +56,8 @@ SYMBOL: literal-table
: rel-word ( word class -- ) : rel-word ( word class -- )
[ add-literal ] dip rt-xt rel-fixup ; [ add-literal ] dip rt-xt rel-fixup ;
: rel-word-direct ( word class -- ) : rel-word-pic ( word class -- )
[ add-literal ] dip rt-xt-direct rel-fixup ; [ add-literal ] dip rt-xt-pic rel-fixup ;
: rel-primitive ( word class -- ) : rel-primitive ( word class -- )
[ def>> first add-literal ] dip rt-primitive rel-fixup ; [ def>> first add-literal ] dip rt-primitive rel-fixup ;

2
basis/compiler/constants/constants.factor
View File

@ -42,7 +42,7 @@ CONSTANT: rt-primitive 0
CONSTANT: rt-dlsym 1 CONSTANT: rt-dlsym 1
CONSTANT: rt-dispatch 2 CONSTANT: rt-dispatch 2
CONSTANT: rt-xt 3 CONSTANT: rt-xt 3
CONSTANT: rt-xt-direct 4 CONSTANT: rt-xt-pic 4
CONSTANT: rt-here 5 CONSTANT: rt-here 5
CONSTANT: rt-this 6 CONSTANT: rt-this 6
CONSTANT: rt-immediate 7 CONSTANT: rt-immediate 7

1
basis/cpu/architecture/architecture.factor
View File

@ -47,6 +47,7 @@ HOOK: %inc-r cpu ( n -- )
HOOK: stack-frame-size cpu ( stack-frame -- n ) HOOK: stack-frame-size cpu ( stack-frame -- n )
HOOK: %call cpu ( word -- ) HOOK: %call cpu ( word -- )
HOOK: %jump cpu ( word -- )
HOOK: %jump-label cpu ( label -- ) HOOK: %jump-label cpu ( label -- )
HOOK: %return cpu ( -- ) HOOK: %return cpu ( -- )

4
basis/cpu/ppc/assembler/assembler.factor
View File

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

14
basis/cpu/ppc/assembler/backend/backend.factor
View File

@ -1,8 +1,7 @@
! Copyright (C) 2008, 2009 Slava Pestov. ! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: compiler.codegen.fixup cpu.architecture USING: kernel namespaces make sequences words math
compiler.constants kernel namespaces make sequences words math math.bitwise io.binary parser lexer fry ;
math.bitwise io.binary parser lexer ;
IN: cpu.ppc.assembler.backend IN: cpu.ppc.assembler.backend
: insn ( operand opcode -- ) { 26 0 } bitfield 4 >be % ; : 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 -- ) GENERIC# (B) 2 ( dest aa lk -- )
M: integer (B) 18 i-insn ; 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 -- ) GENERIC: BC ( a b c -- )
M: integer BC 0 0 16 b-insn ; 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 ; : CREATE-B ( -- word ) scan "B" prepend create-in ;
SYNTAX: BC: SYNTAX: BC:
CREATE-B scan-word scan-word CREATE-B scan-word scan-word
[ rot BC ] 2curry (( c -- )) define-declared ; '[ [ _ _ ] dip BC ] (( c -- )) define-declared ;
SYNTAX: B: SYNTAX: B:
CREATE-B scan-word scan-word scan-word scan-word scan-word CREATE-B scan-word scan-word scan-word scan-word scan-word
[ b-insn ] curry curry curry curry curry '[ _ _ _ _ _ b-insn ] (( bo -- )) define-declared ;
(( bo -- )) define-declared ;

2
basis/cpu/ppc/bootstrap.factor
View File

@ -58,7 +58,7 @@ CONSTANT: rs-reg 14
BCTR BCTR
] jit-primitive jit-define ] 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 [ 0 B rc-relative-ppc-3 rt-xt jit-rel ] jit-word-jump jit-define

13
basis/cpu/ppc/ppc.factor
View File

@ -15,10 +15,16 @@ IN: cpu.ppc
! f0-f29: float vregs ! f0-f29: float vregs
! f30: float scratch ! 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 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 M: ppc machine-registers
{ {
@ -107,7 +113,8 @@ M: ppc stack-frame-size ( stack-frame -- i )
factor-area-size + factor-area-size +
4 cells align ; 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 %jump-label ( label -- ) B ;
M: ppc %return ( -- ) BLR ; M: ppc %return ( -- ) BLR ;

4
basis/cpu/x86/32/32.factor
View File

@ -44,9 +44,9 @@ M: x86.32 param-reg-2 EDX ;
M: x86.32 reserved-area-size 0 ; 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 -- ? ) M: x86.32 return-struct-in-registers? ( c-type -- ? )
c-type c-type

2
basis/cpu/x86/32/bootstrap.factor
View File

@ -29,7 +29,7 @@ IN: bootstrap.x86
] jit-save-stack jit-define ] 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 ] jit-primitive jit-define
<< "vocab:cpu/x86/bootstrap.factor" parse-file parsed >> << "vocab:cpu/x86/bootstrap.factor" parse-file parsed >>

30
basis/cpu/x86/assembler/assembler.factor
View File

@ -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. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays cpu.architecture compiler.constants USING: arrays io.binary kernel combinators
compiler.codegen.fixup io.binary kernel combinators kernel.private math namespaces make sequences words system layouts
kernel.private math namespaces make sequences words system math.order accessors cpu.x86.assembler.syntax ;
layouts math.order accessors cpu.x86.assembler.syntax ;
IN: cpu.x86.assembler 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 32-bit mode, { 1234 } is absolute indirect addressing.
! In 64-bit mode, { 1234 } is RIP-relative. ! In 64-bit mode, { 1234 } is RIP-relative.
@ -296,36 +295,23 @@ M: operand (MOV-I)
{ BIN: 000 t HEX: c6 } { BIN: 000 t HEX: c6 }
pick byte? [ immediate-1 ] [ immediate-4 ] if ; pick byte? [ immediate-1 ] [ immediate-4 ] if ;
PREDICATE: callable < word register? not ;
GENERIC: MOV ( dst src -- ) GENERIC: MOV ( dst src -- )
M: immediate MOV swap (MOV-I) ; 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 ; M: operand MOV HEX: 88 2-operand ;
: LEA ( dst src -- ) swap HEX: 8d 2-operand ; : LEA ( dst src -- ) swap HEX: 8d 2-operand ;
! Control flow ! Control flow
GENERIC: JMP ( op -- ) GENERIC: JMP ( op -- )
: (JMP) ( -- rel-class ) HEX: e9 , 0 4, rc-relative ; M: integer JMP HEX: e9 , 4, ;
M: f JMP (JMP) 2drop ;
M: callable JMP (JMP) rel-word ;
M: label JMP (JMP) label-fixup ;
M: operand JMP { BIN: 100 t HEX: ff } 1-operand ; M: operand JMP { BIN: 100 t HEX: ff } 1-operand ;
GENERIC: CALL ( op -- ) GENERIC: CALL ( op -- )
: (CALL) ( -- rel-class ) HEX: e8 , 0 4, rc-relative ; M: integer CALL HEX: e8 , 4, ;
M: f CALL (CALL) 2drop ;
M: callable CALL (CALL) rel-word-direct ;
M: label CALL (CALL) label-fixup ;
M: operand CALL { BIN: 010 t HEX: ff } 1-operand ; M: operand CALL { BIN: 010 t HEX: ff } 1-operand ;
GENERIC# JUMPcc 1 ( addr opcode -- ) GENERIC# JUMPcc 1 ( addr opcode -- )
: (JUMPcc) ( addr n -- rel-class ) extended-opcode, 4, rc-relative ; M: integer JUMPcc extended-opcode, 4, ;
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 ;
: JO ( dst -- ) HEX: 80 JUMPcc ; : JO ( dst -- ) HEX: 80 JUMPcc ;
: JNO ( dst -- ) HEX: 81 JUMPcc ; : JNO ( dst -- ) HEX: 81 JUMPcc ;

16
basis/cpu/x86/bootstrap.factor
View File

@ -42,11 +42,11 @@ big-endian off
] jit-push-immediate jit-define ] 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 ] 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 ] jit-word-call jit-define
[ [
@ -57,12 +57,12 @@ big-endian off
! compare boolean with f ! compare boolean with f
temp0 \ f tag-number CMP temp0 \ f tag-number CMP
! jump to true branch if not equal ! 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 ] jit-if-1 jit-define
[ [
! jump to false branch if equal ! 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-if-2 jit-define
: jit->r ( -- ) : jit->r ( -- )
@ -115,19 +115,19 @@ big-endian off
[ [
jit->r jit->r
f CALL rc-relative rt-xt jit-rel 0 CALL rc-relative rt-xt jit-rel
jit-r> jit-r>
] jit-dip jit-define ] jit-dip jit-define
[ [
jit-2>r jit-2>r
f CALL rc-relative rt-xt jit-rel 0 CALL rc-relative rt-xt jit-rel
jit-2r> jit-2r>
] jit-2dip jit-define ] jit-2dip jit-define
[ [
jit-3>r jit-3>r
f CALL rc-relative rt-xt jit-rel 0 CALL rc-relative rt-xt jit-rel
jit-3r> jit-3r>
] jit-3dip jit-define ] jit-3dip jit-define
@ -211,7 +211,7 @@ big-endian off
temp1 temp2 CMP temp1 temp2 CMP
] pic-check jit-define ] 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 ! ! ! Megamorphic caches

9
basis/cpu/x86/x86.factor
View File

@ -11,6 +11,10 @@ IN: cpu.x86
<< enable-fixnum-log2 >> << 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 ; M: x86 two-operand? t ;
HOOK: temp-reg-1 cpu ( -- reg ) HOOK: temp-reg-1 cpu ( -- reg )
@ -53,8 +57,9 @@ M: x86 stack-frame-size ( stack-frame -- i )
reserved-area-size + reserved-area-size +
align-stack ; align-stack ;
M: x86 %call ( label -- ) CALL ; M: x86 %call ( word -- ) 0 CALL rc-relative rel-word-pic ;
M: x86 %jump-label ( label -- ) JMP ; 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 ; M: x86 %return ( -- ) 0 RET ;
: code-alignment ( align -- n ) : code-alignment ( align -- n )