cpu.x86.assembler: small cleanups
parent
4d749c9dfe
commit
655497b7b4
|
@ -2,6 +2,13 @@ USING: cpu.x86.assembler cpu.x86.assembler.operands
|
|||
kernel tools.test namespaces make layouts ;
|
||||
IN: cpu.x86.assembler.tests
|
||||
|
||||
! immediate operands
|
||||
[ { HEX: b9 HEX: 01 HEX: 00 HEX: 00 HEX: 00 } ] [ [ ECX 1 MOV ] { } make ] unit-test
|
||||
[ { HEX: 83 HEX: c1 HEX: 01 } ] [ [ ECX 1 ADD ] { } make ] unit-test
|
||||
[ { HEX: 81 HEX: c1 HEX: 96 HEX: 00 HEX: 00 HEX: 00 } ] [ [ ECX 150 ADD ] { } make ] unit-test
|
||||
[ { HEX: f7 HEX: c1 HEX: d2 HEX: 04 HEX: 00 HEX: 00 } ] [ [ ECX 1234 TEST ] { } make ] unit-test
|
||||
|
||||
! 64-bit registers
|
||||
[ { HEX: 40 HEX: 8a HEX: 2a } ] [ [ BPL RDX [] MOV ] { } make ] unit-test
|
||||
|
||||
[ { HEX: 49 HEX: 89 HEX: 04 HEX: 24 } ] [ [ R12 [] RAX MOV ] { } make ] unit-test
|
||||
|
@ -100,13 +107,6 @@ IN: cpu.x86.assembler.tests
|
|||
[ { HEX: f2 HEX: 48 HEX: 0f HEX: 2a HEX: c0 } ] [ [ XMM0 RAX CVTSI2SD ] { } make ] unit-test
|
||||
[ { HEX: f2 HEX: 49 HEX: 0f HEX: 2a HEX: c4 } ] [ [ XMM0 R12 CVTSI2SD ] { } make ] unit-test
|
||||
|
||||
! [ { HEX: f2 HEX: 49 HEX: 0f HEX: 2c HEX: c1 } ] [ [ XMM9 RAX CVTSI2SD ] { } make ] unit-test
|
||||
|
||||
! [ { HEX: f2 HEX: 0f HEX: 10 HEX: 00 } ] [ [ XMM0 RAX [] MOVSD ] { } make ] unit-test
|
||||
! [ { HEX: f2 HEX: 41 HEX: 0f HEX: 10 HEX: 04 HEX: 24 } ] [ [ XMM0 R12 [] MOVSD ] { } make ] unit-test
|
||||
! [ { HEX: f2 HEX: 0f HEX: 11 HEX: 00 } ] [ [ RAX [] XMM0 MOVSD ] { } make ] unit-test
|
||||
! [ { HEX: f2 HEX: 41 HEX: 0f HEX: 11 HEX: 04 HEX: 24 } ] [ [ R12 [] XMM0 MOVSD ] { } make ] unit-test
|
||||
|
||||
! 3-operand r-rm-imm sse instructions
|
||||
[ { HEX: 66 HEX: 0f HEX: 70 HEX: c1 HEX: 02 } ]
|
||||
[ [ XMM0 XMM1 2 PSHUFD ] { } make ] unit-test
|
||||
|
@ -167,14 +167,18 @@ IN: cpu.x86.assembler.tests
|
|||
[ { HEX: f2 HEX: 0f HEX: 38 HEX: f1 HEX: c1 } ] [ [ EAX ECX CRC32 ] { } make ] unit-test
|
||||
[ { HEX: f2 HEX: 0f HEX: 38 HEX: f1 HEX: 01 } ] [ [ EAX ECX [] CRC32 ] { } make ] unit-test
|
||||
|
||||
! various oddities
|
||||
! shifts
|
||||
[ { HEX: 48 HEX: d3 HEX: e0 } ] [ [ RAX CL SHL ] { } make ] unit-test
|
||||
[ { HEX: 48 HEX: d3 HEX: e1 } ] [ [ RCX CL SHL ] { } make ] unit-test
|
||||
[ { HEX: 48 HEX: d3 HEX: e8 } ] [ [ RAX CL SHR ] { } make ] unit-test
|
||||
[ { HEX: 48 HEX: d3 HEX: e9 } ] [ [ RCX CL SHR ] { } make ] unit-test
|
||||
|
||||
[ { HEX: f7 HEX: c1 HEX: d2 HEX: 04 HEX: 00 HEX: 00 } ] [ [ ECX 1234 TEST ] { } make ] unit-test
|
||||
[ { HEX: c1 HEX: e0 HEX: 05 } ] [ [ EAX 5 SHL ] { } make ] unit-test
|
||||
[ { HEX: c1 HEX: e1 HEX: 05 } ] [ [ ECX 5 SHL ] { } make ] unit-test
|
||||
[ { HEX: c1 HEX: e8 HEX: 05 } ] [ [ EAX 5 SHR ] { } make ] unit-test
|
||||
[ { HEX: c1 HEX: e9 HEX: 05 } ] [ [ ECX 5 SHR ] { } make ] unit-test
|
||||
|
||||
! multiplication
|
||||
[ { HEX: 4d HEX: 6b HEX: c0 HEX: 03 } ] [ [ R8 R8 3 IMUL3 ] { } make ] unit-test
|
||||
[ { HEX: 49 HEX: 6b HEX: c0 HEX: 03 } ] [ [ RAX R8 3 IMUL3 ] { } make ] unit-test
|
||||
[ { HEX: 4c HEX: 6b HEX: c0 HEX: 03 } ] [ [ R8 RAX 3 IMUL3 ] { } make ] unit-test
|
||||
|
|
|
@ -4,7 +4,6 @@ USING: arrays io.binary kernel combinators
|
|||
combinators.short-circuit math math.bitwise locals namespaces
|
||||
make sequences words system layouts math.order accessors
|
||||
cpu.x86.assembler.operands cpu.x86.assembler.operands.private ;
|
||||
QUALIFIED: sequences
|
||||
IN: cpu.x86.assembler
|
||||
|
||||
! A postfix assembler for x86-32 and x86-64.
|
||||
|
@ -71,10 +70,10 @@ M: byte n, [ value>> ] dip n, ;
|
|||
: 2, ( n -- ) 2 n, ; inline
|
||||
: cell, ( n -- ) bootstrap-cell n, ; inline
|
||||
|
||||
: mod-r/m, ( reg# indirect -- )
|
||||
: mod-r/m, ( reg operand -- )
|
||||
[ 3 shift ] [ [ modifier 6 shift ] [ r/m ] bi ] bi* bitor bitor , ;
|
||||
|
||||
: sib, ( indirect -- )
|
||||
: sib, ( operand -- )
|
||||
dup sib-present? [
|
||||
[ indirect-base* ]
|
||||
[ indirect-index* 3 shift ]
|
||||
|
@ -93,14 +92,14 @@ M: indirect displacement,
|
|||
|
||||
M: register displacement, drop ;
|
||||
|
||||
: addressing ( reg# indirect -- )
|
||||
: addressing ( reg operand -- )
|
||||
[ mod-r/m, ] [ sib, ] [ displacement, ] tri ;
|
||||
|
||||
: rex.w? ( rex.w reg r/m -- ? )
|
||||
{
|
||||
{ [ dup register-128? ] [ drop operand-64? ] }
|
||||
{ [ dup not ] [ drop operand-64? ] }
|
||||
[ nip operand-64? ]
|
||||
{ [ over register-128? ] [ nip operand-64? ] }
|
||||
{ [ over not ] [ nip operand-64? ] }
|
||||
[ drop operand-64? ]
|
||||
} cond and ;
|
||||
|
||||
: rex.r ( m op -- n )
|
||||
|
@ -119,16 +118,15 @@ M: register displacement, drop ;
|
|||
:: rex-prefix ( reg r/m rex.w -- )
|
||||
#! Compile an AMD64 REX prefix.
|
||||
rex.w reg r/m rex.w? BIN: 01001000 BIN: 01000000 ?
|
||||
r/m rex.r
|
||||
reg rex.b
|
||||
reg rex.r
|
||||
r/m rex.b
|
||||
dup reg r/m no-prefix? [ drop ] [ , ] if ;
|
||||
|
||||
: 16-prefix ( reg r/m -- )
|
||||
[ register-16? ] either? [ HEX: 66 , ] when ;
|
||||
: 16-prefix ( reg -- )
|
||||
register-16? [ HEX: 66 , ] when ;
|
||||
|
||||
: prefix ( reg r/m rex.w -- ) [ drop 16-prefix ] [ rex-prefix ] 3bi ;
|
||||
|
||||
: prefix-1 ( reg rex.w -- ) f swap prefix ;
|
||||
: prefix-1 ( reg rex.w -- )
|
||||
[ drop 16-prefix ] [ [ f ] 2dip rex-prefix ] 2bi ;
|
||||
|
||||
: short-operand ( reg rex.w n -- )
|
||||
#! Some instructions encode their single operand as part of
|
||||
|
@ -138,57 +136,57 @@ M: register displacement, drop ;
|
|||
: opcode, ( opcode -- ) dup array? [ % ] [ , ] if ;
|
||||
|
||||
: extended-opcode ( opcode -- opcode' )
|
||||
dup array? [ OCT: 17 sequences:prefix ] [ OCT: 17 swap 2array ] if ;
|
||||
dup array? [ OCT: 17 prefix ] [ OCT: 17 swap 2array ] if ;
|
||||
|
||||
: extended-opcode, ( opcode -- ) extended-opcode opcode, ;
|
||||
|
||||
: opcode-or ( opcode mask -- opcode' )
|
||||
swap dup array?
|
||||
[ unclip-last rot bitor suffix ] [ bitor ] if ;
|
||||
over array?
|
||||
[ [ unclip-last ] dip bitor suffix ] [ bitor ] if ;
|
||||
|
||||
: 1-operand ( op reg,rex.w,opcode -- )
|
||||
: 1-operand ( operand reg,rex.w,opcode -- )
|
||||
#! The 'reg' is not really a register, but a value for the
|
||||
#! 'reg' field of the mod-r/m byte.
|
||||
first3 [ [ over ] dip prefix-1 ] dip opcode, swap addressing ;
|
||||
|
||||
: immediate-operand-size-bit ( imm dst reg,rex.w,opcode -- imm dst reg,rex.w,opcode )
|
||||
pick integer? [ first3 BIN: 1 opcode-or 3array ] when ;
|
||||
: immediate-operand-size-bit ( dst imm reg,rex.w,opcode -- imm dst reg,rex.w,opcode )
|
||||
over integer? [ first3 BIN: 1 opcode-or 3array ] when ;
|
||||
|
||||
: immediate-1 ( imm dst reg,rex.w,opcode -- )
|
||||
immediate-operand-size-bit 1-operand 1, ;
|
||||
: immediate-1 ( dst imm reg,rex.w,opcode -- )
|
||||
immediate-operand-size-bit swap [ 1-operand ] dip 1, ;
|
||||
|
||||
: immediate-4 ( imm dst reg,rex.w,opcode -- )
|
||||
immediate-operand-size-bit 1-operand 4, ;
|
||||
: immediate-4 ( dst imm reg,rex.w,opcode -- )
|
||||
immediate-operand-size-bit swap [ 1-operand ] dip 4, ;
|
||||
|
||||
: immediate-fits-in-size-bit ( imm dst reg,rex.w,opcode -- imm dst reg,rex.w,opcode )
|
||||
pick integer? [ first3 BIN: 10 opcode-or 3array ] when ;
|
||||
: immediate-fits-in-size-bit ( dst imm reg,rex.w,opcode -- imm dst reg,rex.w,opcode )
|
||||
over integer? [ first3 BIN: 10 opcode-or 3array ] when ;
|
||||
|
||||
: immediate-1/4 ( imm dst reg,rex.w,opcode -- )
|
||||
: immediate-1/4 ( dst imm reg,rex.w,opcode -- )
|
||||
#! If imm is a byte, compile the opcode and the byte.
|
||||
#! Otherwise, set the 8-bit operand flag in the opcode, and
|
||||
#! compile the cell. The 'reg' is not really a register, but
|
||||
#! a value for the 'reg' field of the mod-r/m byte.
|
||||
pick fits-in-byte? [
|
||||
over fits-in-byte? [
|
||||
immediate-fits-in-size-bit immediate-1
|
||||
] [
|
||||
immediate-4
|
||||
] if ;
|
||||
|
||||
: (2-operand) ( dst src op -- )
|
||||
: (2-operand) ( reg operand op -- )
|
||||
[ 2dup t rex-prefix ] dip opcode,
|
||||
reg-code swap addressing ;
|
||||
[ reg-code ] dip addressing ;
|
||||
|
||||
: direction-bit ( dst src op -- dst' src' op' )
|
||||
: direction-bit ( dst src op -- reg operand op' )
|
||||
pick register? pick register? not and
|
||||
[ BIN: 10 opcode-or swapd ] when ;
|
||||
[ BIN: 10 opcode-or ] [ swapd ] if ;
|
||||
|
||||
: operand-size-bit ( dst src op -- dst' src' op' )
|
||||
over register-8? [ BIN: 1 opcode-or ] unless ;
|
||||
: operand-size-bit ( reg operand op -- reg operand op' )
|
||||
pick register-8? [ BIN: 1 opcode-or ] unless ;
|
||||
|
||||
: 2-operand ( dst src op -- )
|
||||
#! Sets the opcode's direction bit. It is set if the
|
||||
#! destination is a direct register operand.
|
||||
[ drop 16-prefix ] [ direction-bit operand-size-bit (2-operand) ] 3bi ;
|
||||
direction-bit operand-size-bit
|
||||
pick 16-prefix
|
||||
(2-operand) ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
@ -212,16 +210,16 @@ M: operand POP { BIN: 000 f HEX: 8f } 1-operand ;
|
|||
! MOV where the src is immediate.
|
||||
<PRIVATE
|
||||
|
||||
GENERIC: (MOV-I) ( src dst -- )
|
||||
M: register (MOV-I) t HEX: b8 short-operand cell, ;
|
||||
GENERIC# (MOV-I) 1 ( dst src -- )
|
||||
M: register (MOV-I) [ t HEX: b8 short-operand ] [ cell, ] bi* ;
|
||||
M: operand (MOV-I)
|
||||
{ BIN: 000 t HEX: c6 }
|
||||
pick byte? [ immediate-1 ] [ immediate-4 ] if ;
|
||||
over byte? [ immediate-1 ] [ immediate-4 ] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
GENERIC: MOV ( dst src -- )
|
||||
M: immediate MOV swap (MOV-I) ;
|
||||
M: immediate MOV (MOV-I) ;
|
||||
M: operand MOV HEX: 88 2-operand ;
|
||||
|
||||
: LEA ( dst src -- ) swap HEX: 8d 2-operand ;
|
||||
|
@ -267,44 +265,44 @@ PRIVATE>
|
|||
! Arithmetic
|
||||
|
||||
GENERIC: ADD ( dst src -- )
|
||||
M: immediate ADD swap { BIN: 000 t HEX: 80 } immediate-1/4 ;
|
||||
M: immediate ADD { BIN: 000 t HEX: 80 } immediate-1/4 ;
|
||||
M: operand ADD OCT: 000 2-operand ;
|
||||
|
||||
GENERIC: OR ( dst src -- )
|
||||
M: immediate OR swap { BIN: 001 t HEX: 80 } immediate-1/4 ;
|
||||
M: immediate OR { BIN: 001 t HEX: 80 } immediate-1/4 ;
|
||||
M: operand OR OCT: 010 2-operand ;
|
||||
|
||||
GENERIC: ADC ( dst src -- )
|
||||
M: immediate ADC swap { BIN: 010 t HEX: 80 } immediate-1/4 ;
|
||||
M: immediate ADC { BIN: 010 t HEX: 80 } immediate-1/4 ;
|
||||
M: operand ADC OCT: 020 2-operand ;
|
||||
|
||||
GENERIC: SBB ( dst src -- )
|
||||
M: immediate SBB swap { BIN: 011 t HEX: 80 } immediate-1/4 ;
|
||||
M: immediate SBB { BIN: 011 t HEX: 80 } immediate-1/4 ;
|
||||
M: operand SBB OCT: 030 2-operand ;
|
||||
|
||||
GENERIC: AND ( dst src -- )
|
||||
M: immediate AND swap { BIN: 100 t HEX: 80 } immediate-1/4 ;
|
||||
M: immediate AND { BIN: 100 t HEX: 80 } immediate-1/4 ;
|
||||
M: operand AND OCT: 040 2-operand ;
|
||||
|
||||
GENERIC: SUB ( dst src -- )
|
||||
M: immediate SUB swap { BIN: 101 t HEX: 80 } immediate-1/4 ;
|
||||
M: immediate SUB { BIN: 101 t HEX: 80 } immediate-1/4 ;
|
||||
M: operand SUB OCT: 050 2-operand ;
|
||||
|
||||
GENERIC: XOR ( dst src -- )
|
||||
M: immediate XOR swap { BIN: 110 t HEX: 80 } immediate-1/4 ;
|
||||
M: immediate XOR { BIN: 110 t HEX: 80 } immediate-1/4 ;
|
||||
M: operand XOR OCT: 060 2-operand ;
|
||||
|
||||
GENERIC: CMP ( dst src -- )
|
||||
M: immediate CMP swap { BIN: 111 t HEX: 80 } immediate-1/4 ;
|
||||
M: immediate CMP { BIN: 111 t HEX: 80 } immediate-1/4 ;
|
||||
M: operand CMP OCT: 070 2-operand ;
|
||||
|
||||
GENERIC: TEST ( dst src -- )
|
||||
M: immediate TEST swap { BIN: 0 t HEX: f7 } immediate-4 ;
|
||||
M: immediate TEST { BIN: 0 t HEX: f7 } immediate-4 ;
|
||||
M: operand TEST OCT: 204 2-operand ;
|
||||
|
||||
: XCHG ( dst src -- ) OCT: 207 2-operand ;
|
||||
|
||||
: BSR ( dst src -- ) swap { HEX: 0f HEX: bd } (2-operand) ;
|
||||
: BSR ( dst src -- ) { HEX: 0f HEX: bd } (2-operand) ;
|
||||
|
||||
: NOT ( dst -- ) { BIN: 010 t HEX: f7 } 1-operand ;
|
||||
: NEG ( dst -- ) { BIN: 011 t HEX: f7 } 1-operand ;
|
||||
|
@ -318,11 +316,11 @@ M: operand TEST OCT: 204 2-operand ;
|
|||
|
||||
<PRIVATE
|
||||
|
||||
: (SHIFT) ( dst src op -- )
|
||||
over CL eq? [
|
||||
nip t HEX: d3 3array 1-operand
|
||||
:: (SHIFT) ( dst src op -- )
|
||||
src CL eq? [
|
||||
dst { op t HEX: d3 } 1-operand
|
||||
] [
|
||||
swapd t HEX: c0 3array immediate-1
|
||||
dst src { op t HEX: c0 } immediate-1
|
||||
] if ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
@ -336,7 +334,7 @@ PRIVATE>
|
|||
: SAR ( dst n -- ) BIN: 111 (SHIFT) ;
|
||||
|
||||
: IMUL2 ( dst src -- )
|
||||
OCT: 257 extended-opcode (2-operand) ;
|
||||
swap OCT: 257 extended-opcode (2-operand) ;
|
||||
|
||||
: IMUL3 ( dst src imm -- )
|
||||
dup fits-in-byte? [
|
||||
|
@ -346,19 +344,17 @@ PRIVATE>
|
|||
] if ;
|
||||
|
||||
: MOVSX ( dst src -- )
|
||||
swap
|
||||
over register-32? OCT: 143 OCT: 276 extended-opcode ?
|
||||
pick register-16? [ BIN: 1 opcode-or ] when
|
||||
dup register-32? OCT: 143 OCT: 276 extended-opcode ?
|
||||
over register-16? [ BIN: 1 opcode-or ] when
|
||||
(2-operand) ;
|
||||
|
||||
: MOVZX ( dst src -- )
|
||||
swap
|
||||
OCT: 266 extended-opcode
|
||||
pick register-16? [ BIN: 1 opcode-or ] when
|
||||
over register-16? [ BIN: 1 opcode-or ] when
|
||||
(2-operand) ;
|
||||
|
||||
! Conditional move
|
||||
: MOVcc ( dst src cc -- ) extended-opcode swapd (2-operand) ;
|
||||
: MOVcc ( dst src cc -- ) extended-opcode (2-operand) ;
|
||||
|
||||
: CMOVO ( dst src -- ) HEX: 40 MOVcc ;
|
||||
: CMOVNO ( dst src -- ) HEX: 41 MOVcc ;
|
||||
|
@ -409,34 +405,34 @@ PRIVATE>
|
|||
<PRIVATE
|
||||
|
||||
: direction-bit-sse ( dst src op1 -- dst' src' op1' )
|
||||
pick register-128? [ swapd ] [ BIN: 1 bitor ] if ;
|
||||
pick register-128? [ swapd BIN: 1 bitor ] unless ;
|
||||
|
||||
: 2-operand-sse ( dst src op1 op2 -- )
|
||||
[ , ] when* direction-bit-sse extended-opcode (2-operand) ;
|
||||
|
||||
: direction-op-sse ( dst src op1s -- dst' src' op1' )
|
||||
pick register-128? [ swapd first ] [ second ] if ;
|
||||
pick register-128? [ first ] [ swapd second ] if ;
|
||||
|
||||
: 2-operand-rm-mr-sse ( dst src op1{rm,mr} op2 -- )
|
||||
[ , ] when* direction-op-sse extended-opcode (2-operand) ;
|
||||
|
||||
: 2-operand-rm-sse ( dst src op1 op2 -- )
|
||||
[ , ] when* swapd extended-opcode (2-operand) ;
|
||||
|
||||
: 2-operand-mr-sse ( dst src op1 op2 -- )
|
||||
[ , ] when* extended-opcode (2-operand) ;
|
||||
|
||||
: 2-operand-mr-sse ( dst src op1 op2 -- )
|
||||
[ , ] when* extended-opcode swapd (2-operand) ;
|
||||
|
||||
: 2-operand-int/sse ( dst src op1 op2 -- )
|
||||
[ , ] when* swapd extended-opcode (2-operand) ;
|
||||
[ , ] when* extended-opcode (2-operand) ;
|
||||
|
||||
: 3-operand-rm-sse ( dst src imm op1 op2 -- )
|
||||
rot [ 2-operand-rm-sse ] dip , ;
|
||||
:: 3-operand-rm-sse ( dst src imm op1 op2 -- )
|
||||
dst src op1 op2 2-operand-rm-sse imm , ;
|
||||
|
||||
: 3-operand-mr-sse ( dst src imm op1 op2 -- )
|
||||
rot [ 2-operand-mr-sse ] dip , ;
|
||||
:: 3-operand-mr-sse ( dst src imm op1 op2 -- )
|
||||
dst src op1 op2 2-operand-mr-sse imm , ;
|
||||
|
||||
: 3-operand-rm-mr-sse ( dst src imm op1 op2 -- )
|
||||
rot [ 2-operand-rm-mr-sse ] dip , ;
|
||||
:: 3-operand-rm-mr-sse ( dst src imm op1 op2 -- )
|
||||
dst src op1 op2 2-operand-rm-mr-sse imm , ;
|
||||
|
||||
: 2-operand-sse-cmp ( dst src cmp op1 op2 -- )
|
||||
3-operand-rm-sse ; inline
|
||||
|
@ -739,7 +735,7 @@ PRIVATE>
|
|||
: CMPNLESS ( dest src -- ) 6 HEX: c2 HEX: f3 2-operand-sse-cmp ;
|
||||
: CMPORDSS ( dest src -- ) 7 HEX: c2 HEX: f3 2-operand-sse-cmp ;
|
||||
|
||||
: MOVNTI ( dest src -- ) { HEX: 0f HEX: c3 } (2-operand) ;
|
||||
: MOVNTI ( dest src -- ) swap { HEX: 0f HEX: c3 } (2-operand) ;
|
||||
|
||||
: PINSRW ( dest src imm -- ) HEX: c4 HEX: 66 3-operand-rm-sse ;
|
||||
: SHUFPS ( dest src imm -- ) 4shuffler HEX: c6 f 3-operand-rm-sse ;
|
||||
|
@ -793,4 +789,3 @@ PRIVATE>
|
|||
|
||||
: HWNT ( -- ) HEX: 2e , ; ! Hint branch Weakly Not Taken
|
||||
: HST ( -- ) HEX: 3e , ; ! Hint branch Strongly Taken
|
||||
|
||||
|
|
Loading…
Reference in New Issue