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

cpu.x86.assembler: move operands to operands sub-vocabulary, clean up small-reg-* code in compiler backend

db4
Slava Pestov 2009-07-29 21:44:08 -05:00
parent 91e5c05f40
commit 73862a9a03
9 changed files with 170 additions and 198 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,13 +1,12 @@
! Copyright (C) 2005, 2009 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: locals alien.c-types alien.syntax arrays kernel fry USING: locals alien.c-types alien.syntax arrays kernel fry math
math namespaces sequences system layouts io vocabs.loader namespaces sequences system layouts io vocabs.loader accessors init
accessors init combinators command-line cpu.x86.assembler combinators command-line make compiler compiler.units
cpu.x86 cpu.architecture make compiler compiler.units
compiler.constants compiler.alien compiler.codegen compiler.constants compiler.alien compiler.codegen
compiler.codegen.fixup compiler.cfg.instructions compiler.codegen.fixup compiler.cfg.instructions compiler.cfg.builder
compiler.cfg.builder compiler.cfg.intrinsics compiler.cfg.intrinsics compiler.cfg.stack-frame cpu.x86.assembler
compiler.cfg.stack-frame ; cpu.x86.assembler.operands cpu.x86 cpu.architecture ;
IN: cpu.x86.32 IN: cpu.x86.32
! We implement the FFI for Linux, OS X and Windows all at once. ! We implement the FFI for Linux, OS X and Windows all at once.

13
basis/cpu/x86/64/64.factor
View File

@ -1,12 +1,11 @@
! Copyright (C) 2005, 2009 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: accessors arrays kernel math namespaces make sequences USING: accessors arrays kernel math namespaces make sequences system
system layouts alien alien.c-types alien.accessors alien.structs layouts alien alien.c-types alien.accessors alien.structs slots
slots splitting assocs combinators locals cpu.x86.assembler splitting assocs combinators locals compiler.constants
cpu.x86 cpu.architecture compiler.constants compiler.codegen compiler.codegen.fixup compiler.cfg.instructions
compiler.codegen compiler.codegen.fixup compiler.cfg.builder compiler.cfg.intrinsics compiler.cfg.stack-frame
compiler.cfg.instructions compiler.cfg.builder cpu.x86.assembler cpu.x86.assembler.operands cpu.x86 cpu.architecture ;
compiler.cfg.intrinsics compiler.cfg.stack-frame ;
IN: cpu.x86.64 IN: cpu.x86.64
M: x86.64 machine-registers M: x86.64 machine-registers

8
basis/cpu/x86/64/unix/unix.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays sequences math splitting make assocs USING: accessors arrays sequences math splitting make assocs kernel
kernel layouts system alien.c-types alien.structs layouts system alien.c-types alien.structs cpu.architecture
cpu.architecture cpu.x86.assembler cpu.x86 cpu.x86.assembler cpu.x86.assembler.operands cpu.x86 compiler.codegen
compiler.codegen compiler.cfg.registers ; compiler.cfg.registers ;
IN: cpu.x86.64.unix IN: cpu.x86.64.unix
M: int-regs param-regs drop { RDI RSI RDX RCX R8 R9 } ; M: int-regs param-regs drop { RDI RSI RDX RCX R8 R9 } ;

3
basis/cpu/x86/assembler/assembler-tests.factor
View File

@ -1,4 +1,5 @@
USING: cpu.x86.assembler kernel tools.test namespaces make ; USING: cpu.x86.assembler cpu.x86.operands
kernel tools.test namespaces make ;
IN: cpu.x86.assembler.tests IN: cpu.x86.assembler.tests
[ { HEX: 49 HEX: 89 HEX: 04 HEX: 24 } ] [ [ R12 [] RAX MOV ] { } make ] unit-test [ { HEX: 49 HEX: 89 HEX: 04 HEX: 24 } ] [ [ R12 [] RAX MOV ] { } make ] unit-test

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

@ -1,89 +1,16 @@
! Copyright (C) 2005, 2009 Slava Pestov. ! Copyright (C) 2005, 2009 Slava Pestov, Joe Groff.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays io.binary kernel combinators kernel.private math USING: arrays io.binary kernel combinators kernel.private math
namespaces make sequences words system layouts math.order accessors namespaces make sequences words system layouts math.order accessors
cpu.x86.assembler.syntax ; cpu.x86.assembler.operands cpu.x86.assembler.operands.private ;
QUALIFIED: sequences QUALIFIED: sequences
IN: cpu.x86.assembler IN: cpu.x86.assembler
! A postfix assembler for x86-32 and x86-64. ! 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.
! Beware!
! Register operands -- eg, ECX
REGISTERS: 8 AL CL DL BL SPL BPL SIL DIL R8B R9B R10B R11B R12B R13B R14B R15B ;
ALIAS: AH SPL
ALIAS: CH BPL
ALIAS: DH SIL
ALIAS: BH DIL
REGISTERS: 16 AX CX DX BX SP BP SI DI R8W R9W R10W R11W R12W R13W R14W R15W ;
REGISTERS: 32 EAX ECX EDX EBX ESP EBP ESI EDI R8D R9D R10D R11D R12D R13D R14D R15D ;
REGISTERS: 64
RAX RCX RDX RBX RSP RBP RSI RDI R8 R9 R10 R11 R12 R13 R14 R15 ;
REGISTERS: 128
XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7
XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 ;
TUPLE: byte value ;
C: <byte> byte
<PRIVATE <PRIVATE
#! Extended AMD64 registers (R8-R15) return true. #! Extended AMD64 registers (R8-R15) return true.
GENERIC: extended? ( op -- ? )
M: object extended? drop f ;
PREDICATE: register < word
"register" word-prop ;
PREDICATE: register-8 < register
"register-size" word-prop 8 = ;
PREDICATE: register-16 < register
"register-size" word-prop 16 = ;
PREDICATE: register-32 < register
"register-size" word-prop 32 = ;
PREDICATE: register-64 < register
"register-size" word-prop 64 = ;
PREDICATE: register-128 < register
"register-size" word-prop 128 = ;
M: register extended? "register" word-prop 7 > ;
! Addressing modes
TUPLE: indirect base index scale displacement ;
M: indirect extended? base>> extended? ;
: canonicalize-EBP ( indirect -- indirect )
#! { EBP } ==> { EBP 0 }
dup [ base>> { EBP RBP R13 } member? ] [ displacement>> not ] bi and
[ 0 >>displacement ] when ;
ERROR: bad-index indirect ;
: check-ESP ( indirect -- indirect )
dup index>> { ESP RSP } memq? [ bad-index ] when ;
: canonicalize ( indirect -- indirect )
#! Modify the indirect to work around certain addressing mode
#! quirks.
canonicalize-EBP check-ESP ;
: <indirect> ( base index scale displacement -- indirect )
indirect boa canonicalize ;
: reg-code ( reg -- n ) "register" word-prop 7 bitand ; : reg-code ( reg -- n ) "register" word-prop 7 bitand ;
@ -168,18 +95,6 @@ M: register displacement, drop ;
: addressing ( reg# indirect -- ) : addressing ( reg# indirect -- )
[ mod-r/m, ] [ sib, ] [ displacement, ] tri ; [ mod-r/m, ] [ sib, ] [ displacement, ] tri ;
! Utilities
UNION: operand register indirect ;
GENERIC: operand-64? ( operand -- ? )
M: indirect operand-64?
[ base>> ] [ index>> ] bi [ operand-64? ] either? ;
M: register-64 operand-64? drop t ;
M: object operand-64? drop f ;
: rex.w? ( rex.w reg r/m -- ? ) : rex.w? ( rex.w reg r/m -- ? )
{ {
{ [ dup register-128? ] [ drop operand-64? ] } { [ dup register-128? ] [ drop operand-64? ] }
@ -276,15 +191,6 @@ M: object operand-64? drop f ;
PRIVATE> PRIVATE>
: [] ( reg/displacement -- indirect )
dup integer? [ [ f f f ] dip ] [ f f f ] if <indirect> ;
: [+] ( reg displacement -- indirect )
dup integer?
[ dup zero? [ drop f ] when [ f f ] dip ]
[ f f ] if
<indirect> ;
! Moving stuff ! Moving stuff
GENERIC: PUSH ( op -- ) GENERIC: PUSH ( op -- )
M: register PUSH f HEX: 50 short-operand ; M: register PUSH f HEX: 50 short-operand ;

1
basis/cpu/x86/assembler/authors.txt
View File

@ -1 +1,2 @@
Slava Pestov Slava Pestov
Joe Groff

118
basis/cpu/x86/assembler/operands/operands.factor Normal file
View File

@ -0,0 +1,118 @@
! Copyright (C) 2008, 2009 Slava Pestov, Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel words math accessors sequences cpu.x86.assembler.syntax ;
IN: cpu.x86.assembler.operands
! In 32-bit mode, { 1234 } is absolute indirect addressing.
! In 64-bit mode, { 1234 } is RIP-relative.
! Beware!
REGISTERS: 8 AL CL DL BL SPL BPL SIL DIL R8B R9B R10B R11B R12B R13B R14B R15B ;
ALIAS: AH SPL
ALIAS: CH BPL
ALIAS: DH SIL
ALIAS: BH DIL
REGISTERS: 16 AX CX DX BX SP BP SI DI R8W R9W R10W R11W R12W R13W R14W R15W ;
REGISTERS: 32 EAX ECX EDX EBX ESP EBP ESI EDI R8D R9D R10D R11D R12D R13D R14D R15D ;
REGISTERS: 64
RAX RCX RDX RBX RSP RBP RSI RDI R8 R9 R10 R11 R12 R13 R14 R15 ;
REGISTERS: 128
XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7
XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 ;
<PRIVATE
GENERIC: extended? ( op -- ? )
M: object extended? drop f ;
PREDICATE: register < word
"register" word-prop ;
PREDICATE: register-8 < register
"register-size" word-prop 8 = ;
PREDICATE: register-16 < register
"register-size" word-prop 16 = ;
PREDICATE: register-32 < register
"register-size" word-prop 32 = ;
PREDICATE: register-64 < register
"register-size" word-prop 64 = ;
PREDICATE: register-128 < register
"register-size" word-prop 128 = ;
M: register extended? "register" word-prop 7 > ;
! Addressing modes
TUPLE: indirect base index scale displacement ;
M: indirect extended? base>> extended? ;
: canonicalize-EBP ( indirect -- indirect )
#! { EBP } ==> { EBP 0 }
dup [ base>> { EBP RBP R13 } member? ] [ displacement>> not ] bi and
[ 0 >>displacement ] when ;
ERROR: bad-index indirect ;
: check-ESP ( indirect -- indirect )
dup index>> { ESP RSP } memq? [ bad-index ] when ;
: canonicalize ( indirect -- indirect )
#! Modify the indirect to work around certain addressing mode
#! quirks.
canonicalize-EBP check-ESP ;
: <indirect> ( base index scale displacement -- indirect )
indirect boa canonicalize ;
! Utilities
UNION: operand register indirect ;
GENERIC: operand-64? ( operand -- ? )
M: indirect operand-64?
[ base>> ] [ index>> ] bi [ operand-64? ] either? ;
M: register-64 operand-64? drop t ;
M: object operand-64? drop f ;
PRIVATE>
: [] ( reg/displacement -- indirect )
dup integer? [ [ f f f ] dip ] [ f f f ] if <indirect> ;
: [+] ( reg displacement -- indirect )
dup integer?
[ dup zero? [ drop f ] when [ f f ] dip ]
[ f f ] if
<indirect> ;
TUPLE: byte value ;
C: <byte> byte
<PRIVATE
: n-bit-version-of ( register n -- register' )
! Certain 8-bit registers don't exist in 32-bit mode...
[ "register" word-prop ] dip registers get at nth
dup { SPL BPL SIL DIL } memq? cell 4 = and
[ drop f ] when ;
PRIVATE>
: 8-bit-version-of ( register -- register' ) 8 n-bit-version-of ;
: 16-bit-version-of ( register -- register' ) 16 n-bit-version-of ;
: 32-bit-version-of ( register -- register' ) 32 n-bit-version-of ;
: 64-bit-version-of ( register -- register' ) 64 n-bit-version-of ;
: native-version-of ( register -- register' ) cell-bits n-bit-version-of ;

27
basis/cpu/x86/assembler/syntax/syntax.factor
View File

@ -1,14 +1,23 @@
! Copyright (C) 2008 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: kernel words words.symbol sequences lexer parser fry ; USING: kernel words words.symbol sequences lexer parser fry
namespaces combinators assocs ;
IN: cpu.x86.assembler.syntax IN: cpu.x86.assembler.syntax
: define-register ( name num size -- ) SYMBOL: registers
[ "cpu.x86.assembler" create dup define-symbol ] 2dip
[ dupd "register" set-word-prop ] dip
"register-size" set-word-prop ;
: define-registers ( names size -- ) registers [ H{ } clone ] initialize
'[ _ define-register ] each-index ;
SYNTAX: REGISTERS: scan-word ";" parse-tokens swap define-registers ; : define-register ( name num size -- word )
[ "cpu.x86.assembler.operands" create ] 2dip {
[ 2drop ]
[ 2drop define-symbol ]
[ drop "register" set-word-prop ]
[ nip "register-size" set-word-prop ]
} 3cleave ;
: define-registers ( size names -- )
[ swap '[ _ define-register ] map-index ] [ drop ] 2bi
registers get set-at ;
SYNTAX: REGISTERS: scan-word ";" parse-tokens define-registers ;

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

@ -1,9 +1,9 @@
! 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: accessors assocs alien alien.c-types arrays strings USING: accessors assocs alien alien.c-types arrays strings
cpu.x86.assembler cpu.x86.assembler.private cpu.architecture cpu.x86.assembler cpu.x86.assembler.private cpu.x86.assembler.operands
kernel kernel.private math memory namespaces make sequences cpu.architecture kernel kernel.private math memory namespaces make
words system layouts combinators math.order fry locals sequences words system layouts combinators math.order fry locals
compiler.constants compiler.constants
compiler.cfg.registers compiler.cfg.registers
compiler.cfg.instructions compiler.cfg.instructions
@ -264,67 +264,6 @@ M:: x86 %box-alien ( dst src temp -- )
"end" resolve-label "end" resolve-label
] with-scope ; ] with-scope ;
: small-reg-8 ( reg -- reg' )
H{
{ EAX RAX }
{ ECX RCX }
{ EDX RDX }
{ EBX RBX }
{ ESP RSP }
{ EBP RBP }
{ ESI RSP }
{ EDI RDI }
{ RAX RAX }
{ RCX RCX }
{ RDX RDX }
{ RBX RBX }
{ RSP RSP }
{ RBP RBP }
{ RSI RSP }
{ RDI RDI }
} at ; inline
: small-reg-4 ( reg -- reg' )
small-reg-8 H{
{ RAX EAX }
{ RCX ECX }
{ RDX EDX }
{ RBX EBX }
{ RSP ESP }
{ RBP EBP }
{ RSI ESP }
{ RDI EDI }
} at ; inline
: small-reg-2 ( reg -- reg' )
small-reg-4 H{
{ EAX AX }
{ ECX CX }
{ EDX DX }
{ EBX BX }
{ ESP SP }
{ EBP BP }
{ ESI SI }
{ EDI DI }
} at ; inline
: small-reg-1 ( reg -- reg' )
small-reg-4 {
{ EAX AL }
{ ECX CL }
{ EDX DL }
{ EBX BL }
} at ; inline
: small-reg ( reg size -- reg' )
{
{ 1 [ small-reg-1 ] }
{ 2 [ small-reg-2 ] }
{ 4 [ small-reg-4 ] }
{ 8 [ small-reg-8 ] }
} case ;
HOOK: small-regs cpu ( -- regs ) HOOK: small-regs cpu ( -- regs )
M: x86.32 small-regs { EAX ECX EDX EBX } ; M: x86.32 small-regs { EAX ECX EDX EBX } ;
@ -336,7 +275,7 @@ M: x86.32 small-reg-native small-reg-4 ;
M: x86.64 small-reg-native small-reg-8 ; M: x86.64 small-reg-native small-reg-8 ;
: small-reg-that-isn't ( exclude -- reg' ) : small-reg-that-isn't ( exclude -- reg' )
small-regs swap [ small-reg-native ] map '[ _ memq? not ] find nip ; small-regs swap [ native-version-of ] map '[ _ memq? not ] find nip ;
: with-save/restore ( reg quot -- ) : with-save/restore ( reg quot -- )
[ drop PUSH ] [ call ] [ drop POP ] 2tri ; inline [ drop PUSH ] [ call ] [ drop POP ] 2tri ; inline
@ -346,7 +285,7 @@ M: x86.64 small-reg-native small-reg-8 ;
#! call the quot with that. Otherwise, we find a small #! call the quot with that. Otherwise, we find a small
#! register that is not in exclude, and call quot, saving #! register that is not in exclude, and call quot, saving
#! and restoring the small register. #! and restoring the small register.
dst small-reg-native small-regs memq? [ dst quot call ] [ dst small-regs memq? [ dst quot call ] [
exclude small-reg-that-isn't exclude small-reg-that-isn't
[ quot call ] with-save/restore [ quot call ] with-save/restore
] if ; inline ] if ; inline
@ -362,7 +301,7 @@ M: x86.64 small-reg-native small-reg-8 ;
src2 CL quot call src2 CL quot call
dst src2 XCHG dst src2 XCHG
] [ ] [
ECX small-reg-native [ ECX native-version-of [
CL src2 MOV CL src2 MOV
drop dst CL quot call drop dst CL quot call
] with-save/restore ] with-save/restore
@ -380,8 +319,8 @@ M:: x86 %string-nth ( dst src index temp -- )
! 8th bit indicates whether we have to load from ! 8th bit indicates whether we have to load from
! the aux vector or not. ! the aux vector or not.
temp src index [+] LEA temp src index [+] LEA
new-dst 1 small-reg temp string-offset [+] MOV new-dst 8-bit-version-of temp string-offset [+] MOV
new-dst new-dst 1 small-reg MOVZX new-dst new-dst 8-bit-version-of MOVZX
! Do we have to look at the aux vector? ! Do we have to look at the aux vector?
new-dst HEX: 80 CMP new-dst HEX: 80 CMP
"end" get JL "end" get JL
@ -392,8 +331,8 @@ M:: x86 %string-nth ( dst src index temp -- )
new-dst index ADD new-dst index ADD
new-dst index ADD new-dst index ADD
! Load high 16 bits ! Load high 16 bits
new-dst 2 small-reg new-dst byte-array-offset [+] MOV new-dst 16-bit-version-of new-dst byte-array-offset [+] MOV
new-dst new-dst 2 small-reg MOVZX new-dst new-dst 16-bit-version-of MOVZX
new-dst 7 SHL new-dst 7 SHL
! Compute code point ! Compute code point
new-dst temp XOR new-dst temp XOR
@ -405,12 +344,12 @@ M:: x86 %set-string-nth-fast ( ch str index temp -- )
ch { index str temp } [| new-ch | ch { index str temp } [| new-ch |
new-ch ch ?MOV new-ch ch ?MOV
temp str index [+] LEA temp str index [+] LEA
temp string-offset [+] new-ch 1 small-reg MOV temp string-offset [+] new-ch 8-bit-version-of MOV
] with-small-register ; ] with-small-register ;
:: %alien-integer-getter ( dst src size quot -- ) :: %alien-integer-getter ( dst src size quot -- )
dst { src } [| new-dst | dst { src } [| new-dst |
new-dst dup size small-reg dup src [] MOV new-dst dup size 8 * n-bit-version-of dup src [] MOV
quot call quot call
dst new-dst ?MOV dst new-dst ?MOV
] with-small-register ; inline ] with-small-register ; inline
@ -437,7 +376,7 @@ M: x86 %alien-double [] MOVSD ;
:: %alien-integer-setter ( ptr value size -- ) :: %alien-integer-setter ( ptr value size -- )
value { ptr } [| new-value | value { ptr } [| new-value |
new-value value ?MOV new-value value ?MOV
ptr [] new-value size small-reg MOV ptr [] new-value size 8 * n-bit-version-of MOV
] with-small-register ; inline ] with-small-register ; inline
M: x86 %set-alien-integer-1 1 %alien-integer-setter ; M: x86 %set-alien-integer-1 1 %alien-integer-setter ;