Better support for 8-bit instructions in x86 assembler, more efficient write barrier on x86
Slava Pestov
parent
793c58f7a2
commit
89de1282be
core/cpu/x86
intrinsics
|
|
@ -36,3 +36,6 @@ IN: cpu.x86.assembler.tests
|
|||
|
||||
[ { HEX: 0f HEX: be HEX: c3 } ] [ [ EAX BL MOVSX ] { } make ] unit-test
|
||||
[ { HEX: 0f HEX: bf HEX: c3 } ] [ [ EAX BX MOVSX ] { } make ] unit-test
|
||||
|
||||
[ { HEX: 80 HEX: 08 HEX: 05 } ] [ [ EAX [] 5 <byte> OR ] { } make ] unit-test
|
||||
[ { HEX: c6 HEX: 00 HEX: 05 } ] [ [ EAX [] 5 <byte> MOV ] { } make ] unit-test
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays generator.fixup io.binary kernel
|
||||
combinators kernel.private math namespaces parser sequences
|
||||
words system layouts math.order ;
|
||||
words system layouts math.order accessors ;
|
||||
IN: cpu.x86.assembler
|
||||
|
||||
! A postfix assembler for x86 and AMD64.
|
||||
|
|
@ -11,11 +11,6 @@ IN: cpu.x86.assembler
|
|||
! In 64-bit mode, { 1234 } is RIP-relative.
|
||||
! Beware!
|
||||
|
||||
: n, >le % ; inline
|
||||
: 4, 4 n, ; inline
|
||||
: 2, 2 n, ; inline
|
||||
: cell, bootstrap-cell n, ; inline
|
||||
|
||||
! Register operands -- eg, ECX
|
||||
<<
|
||||
|
||||
|
|
@ -45,6 +40,10 @@ 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
|
||||
|
||||
#! Extended AMD64 registers (R8-R15) return true.
|
||||
|
|
@ -75,50 +74,38 @@ M: register extended? "register" word-prop 7 > ;
|
|||
! Addressing modes
|
||||
TUPLE: indirect base index scale displacement ;
|
||||
|
||||
M: indirect extended? indirect-base extended? ;
|
||||
M: indirect extended? base>> extended? ;
|
||||
|
||||
: canonicalize-EBP
|
||||
#! { EBP } ==> { EBP 0 }
|
||||
dup indirect-base { EBP RBP R13 } memq? [
|
||||
dup indirect-displacement [
|
||||
drop
|
||||
] [
|
||||
0 swap set-indirect-displacement
|
||||
] if
|
||||
] [
|
||||
drop
|
||||
] if ;
|
||||
dup base>> { EBP RBP R13 } member? [
|
||||
dup displacement>> [ 0 >>displacement ] unless
|
||||
] when drop ;
|
||||
|
||||
: canonicalize-ESP
|
||||
#! { ESP } ==> { ESP ESP }
|
||||
dup indirect-base { ESP RSP R12 } memq? [
|
||||
ESP swap set-indirect-index
|
||||
] [
|
||||
drop
|
||||
] if ;
|
||||
dup base>> { ESP RSP R12 } member? [ ESP >>index ] when drop ;
|
||||
|
||||
: canonicalize ( indirect -- )
|
||||
#! Modify the indirect to work around certain addressing mode
|
||||
#! quirks.
|
||||
dup canonicalize-EBP
|
||||
canonicalize-ESP ;
|
||||
[ canonicalize-EBP ] [ canonicalize-ESP ] bi ;
|
||||
|
||||
: <indirect> ( base index scale displacement -- indirect )
|
||||
indirect boa dup canonicalize ;
|
||||
|
||||
: reg-code "register" word-prop 7 bitand ;
|
||||
|
||||
: indirect-base* indirect-base EBP or reg-code ;
|
||||
: indirect-base* base>> EBP or reg-code ;
|
||||
|
||||
: indirect-index* indirect-index ESP or reg-code ;
|
||||
: indirect-index* index>> ESP or reg-code ;
|
||||
|
||||
: indirect-scale* indirect-scale 0 or ;
|
||||
: indirect-scale* scale>> 0 or ;
|
||||
|
||||
GENERIC: sib-present? ( op -- ? )
|
||||
|
||||
M: indirect sib-present?
|
||||
dup indirect-base { ESP RSP } memq?
|
||||
over indirect-index rot indirect-scale or or ;
|
||||
[ base>> { ESP RSP } member? ] [ index>> ] [ scale>> ] tri or or ;
|
||||
|
||||
M: register sib-present? drop f ;
|
||||
|
||||
|
|
@ -130,16 +117,23 @@ M: indirect r/m
|
|||
|
||||
M: register r/m reg-code ;
|
||||
|
||||
: byte? -128 127 between? ;
|
||||
! Immediate operands
|
||||
UNION: immediate byte integer ;
|
||||
|
||||
GENERIC: fits-in-byte? ( value -- ? )
|
||||
|
||||
M: byte fits-in-byte? drop t ;
|
||||
|
||||
M: integer fits-in-byte? -128 127 between? ;
|
||||
|
||||
GENERIC: modifier ( op -- n )
|
||||
|
||||
M: indirect modifier
|
||||
dup indirect-base [
|
||||
indirect-displacement {
|
||||
{ [ dup not ] [ BIN: 00 ] }
|
||||
{ [ dup byte? ] [ BIN: 01 ] }
|
||||
{ [ dup integer? ] [ BIN: 10 ] }
|
||||
dup base>> [
|
||||
displacement>> {
|
||||
{ [ dup not ] [ BIN: 00 ] }
|
||||
{ [ dup fits-in-byte? ] [ BIN: 01 ] }
|
||||
{ [ dup immediate? ] [ BIN: 10 ] }
|
||||
} cond nip
|
||||
] [
|
||||
drop BIN: 00
|
||||
|
|
@ -147,14 +141,23 @@ M: indirect modifier
|
|||
|
||||
M: register modifier drop BIN: 11 ;
|
||||
|
||||
GENERIC# n, 1 ( value n -- )
|
||||
|
||||
M: integer n, >le % ;
|
||||
M: byte n, >r value>> r> n, ;
|
||||
: 1, 1 n, ; inline
|
||||
: 4, 4 n, ; inline
|
||||
: 2, 2 n, ; inline
|
||||
: cell, bootstrap-cell n, ; inline
|
||||
|
||||
: mod-r/m, ( reg# indirect -- )
|
||||
dup modifier 6 shift rot 3 shift rot r/m bitor bitor , ;
|
||||
[ 3 shift ] [ [ modifier 6 shift ] [ r/m ] bi ] bi* bitor bitor , ;
|
||||
|
||||
: sib, ( indirect -- )
|
||||
dup sib-present? [
|
||||
dup indirect-base*
|
||||
over indirect-index* 3 shift bitor
|
||||
swap indirect-scale* 6 shift bitor ,
|
||||
[ indirect-base* ]
|
||||
[ indirect-index* 3 shift ]
|
||||
[ indirect-scale* 6 shift ] tri bitor bitor ,
|
||||
] [
|
||||
drop
|
||||
] if ;
|
||||
|
|
@ -162,9 +165,9 @@ M: register modifier drop BIN: 11 ;
|
|||
GENERIC: displacement, ( op -- )
|
||||
|
||||
M: indirect displacement,
|
||||
dup indirect-displacement dup [
|
||||
swap indirect-base
|
||||
[ dup byte? [ , ] [ 4, ] if ] [ 4, ] if
|
||||
dup displacement>> dup [
|
||||
swap base>>
|
||||
[ dup fits-in-byte? [ , ] [ 4, ] if ] [ 4, ] if
|
||||
] [
|
||||
2drop
|
||||
] if ;
|
||||
|
|
@ -172,18 +175,19 @@ M: indirect displacement,
|
|||
M: register displacement, drop ;
|
||||
|
||||
: addressing ( reg# indirect -- )
|
||||
[ mod-r/m, ] keep [ sib, ] keep displacement, ;
|
||||
[ mod-r/m, ] [ sib, ] [ displacement, ] tri ;
|
||||
|
||||
! Utilities
|
||||
UNION: operand register indirect ;
|
||||
|
||||
: operand-64? ( operand -- ? )
|
||||
dup indirect? [
|
||||
dup indirect-base register-64?
|
||||
swap indirect-index register-64? or
|
||||
] [
|
||||
register-64?
|
||||
] if ;
|
||||
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 -- ? )
|
||||
{
|
||||
|
|
@ -198,8 +202,7 @@ UNION: operand register indirect ;
|
|||
: rex.b
|
||||
[ extended? [ BIN: 00000001 bitor ] when ] keep
|
||||
dup indirect? [
|
||||
indirect-index extended?
|
||||
[ BIN: 00000010 bitor ] when
|
||||
index>> extended? [ BIN: 00000010 bitor ] when
|
||||
] [
|
||||
drop
|
||||
] if ;
|
||||
|
|
@ -230,25 +233,34 @@ UNION: operand register indirect ;
|
|||
|
||||
: opcode-or ( opcode mask -- opcode' )
|
||||
swap dup array?
|
||||
[ 1 cut* first rot bitor suffix ] [ bitor ] if ;
|
||||
[ unclip-last rot bitor suffix ] [ bitor ] if ;
|
||||
|
||||
: 1-operand ( op reg rex.w opcode -- )
|
||||
: 1-operand ( op reg,rex.w,opcode -- )
|
||||
#! The 'reg' is not really a register, but a value for the
|
||||
#! 'reg' field of the mod-r/m byte.
|
||||
>r >r over r> prefix-1 r> opcode, swap addressing ;
|
||||
first3 >r >r over r> prefix-1 r> opcode, swap addressing ;
|
||||
|
||||
: immediate-1 ( imm dst reg rex.w opcode -- )
|
||||
1-operand , ;
|
||||
: immediate-operand-size-bit
|
||||
pick integer? [ first3 BIN: 1 opcode-or 3array ] when ;
|
||||
|
||||
: immediate-1/4 ( imm dst reg rex.w opcode -- )
|
||||
: immediate-1 ( imm dst reg,rex.w,opcode -- )
|
||||
immediate-operand-size-bit 1-operand 1, ;
|
||||
|
||||
: immediate-4 ( imm dst reg,rex.w,opcode -- )
|
||||
immediate-operand-size-bit 1-operand 4, ;
|
||||
|
||||
: immediate-fits-in-size-bit
|
||||
pick integer? [ first3 BIN: 10 opcode-or 3array ] when ;
|
||||
|
||||
: immediate-1/4 ( imm dst reg,rex.w,opcode -- )
|
||||
#! If imm is a byte, compile the opcode and the byte.
|
||||
#! Otherwise, set the 32-bit operand flag in the opcode, and
|
||||
#! 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.
|
||||
>r >r pick byte? [
|
||||
r> r> BIN: 10 opcode-or immediate-1
|
||||
pick fits-in-byte? [
|
||||
immediate-fits-in-size-bit immediate-1
|
||||
] [
|
||||
r> r> 1-operand 4,
|
||||
immediate-4
|
||||
] if ;
|
||||
|
||||
: (2-operand) ( dst src op -- )
|
||||
|
|
@ -283,22 +295,24 @@ PRIVATE>
|
|||
! Moving stuff
|
||||
GENERIC: PUSH ( op -- )
|
||||
M: register PUSH f HEX: 50 short-operand ;
|
||||
M: integer PUSH HEX: 68 , 4, ;
|
||||
M: operand PUSH BIN: 110 f HEX: ff 1-operand ;
|
||||
M: immediate PUSH HEX: 68 , 4, ;
|
||||
M: operand PUSH { BIN: 110 f HEX: ff } 1-operand ;
|
||||
|
||||
GENERIC: POP ( op -- )
|
||||
M: register POP f HEX: 58 short-operand ;
|
||||
M: operand POP BIN: 000 f HEX: 8f 1-operand ;
|
||||
M: operand POP { BIN: 000 f HEX: 8f } 1-operand ;
|
||||
|
||||
! MOV where the src is immediate.
|
||||
GENERIC: (MOV-I) ( src dst -- )
|
||||
M: register (MOV-I) t HEX: b8 short-operand cell, ;
|
||||
M: operand (MOV-I) BIN: 000 t HEX: c7 1-operand 4, ;
|
||||
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: integer MOV swap (MOV-I) ;
|
||||
M: immediate MOV swap (MOV-I) ;
|
||||
M: callable MOV 0 rot (MOV-I) rc-absolute-cell rel-word ;
|
||||
M: operand MOV HEX: 88 2-operand ;
|
||||
|
||||
|
|
@ -309,13 +323,13 @@ GENERIC: JMP ( op -- )
|
|||
: (JMP) HEX: e9 , 0 4, rc-relative ;
|
||||
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 -- )
|
||||
: (CALL) HEX: e8 , 0 4, rc-relative ;
|
||||
M: callable CALL (CALL) rel-word ;
|
||||
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 -- )
|
||||
: (JUMPcc) extended-opcode, 0 4, rc-relative ;
|
||||
|
|
@ -347,57 +361,57 @@ M: label JUMPcc (JUMPcc) label-fixup ;
|
|||
! Arithmetic
|
||||
|
||||
GENERIC: ADD ( dst src -- )
|
||||
M: integer ADD swap BIN: 000 t HEX: 81 immediate-1/4 ;
|
||||
M: immediate ADD swap { BIN: 000 t HEX: 80 } immediate-1/4 ;
|
||||
M: operand ADD OCT: 000 2-operand ;
|
||||
|
||||
GENERIC: OR ( dst src -- )
|
||||
M: integer OR swap BIN: 001 t HEX: 81 immediate-1/4 ;
|
||||
M: immediate OR swap { BIN: 001 t HEX: 80 } immediate-1/4 ;
|
||||
M: operand OR OCT: 010 2-operand ;
|
||||
|
||||
GENERIC: ADC ( dst src -- )
|
||||
M: integer ADC swap BIN: 010 t HEX: 81 immediate-1/4 ;
|
||||
M: immediate ADC swap { BIN: 010 t HEX: 80 } immediate-1/4 ;
|
||||
M: operand ADC OCT: 020 2-operand ;
|
||||
|
||||
GENERIC: SBB ( dst src -- )
|
||||
M: integer SBB swap BIN: 011 t HEX: 81 immediate-1/4 ;
|
||||
M: immediate SBB swap { BIN: 011 t HEX: 80 } immediate-1/4 ;
|
||||
M: operand SBB OCT: 030 2-operand ;
|
||||
|
||||
GENERIC: AND ( dst src -- )
|
||||
M: integer AND swap BIN: 100 t HEX: 81 immediate-1/4 ;
|
||||
M: immediate AND swap { BIN: 100 t HEX: 80 } immediate-1/4 ;
|
||||
M: operand AND OCT: 040 2-operand ;
|
||||
|
||||
GENERIC: SUB ( dst src -- )
|
||||
M: integer SUB swap BIN: 101 t HEX: 81 immediate-1/4 ;
|
||||
M: immediate SUB swap { BIN: 101 t HEX: 80 } immediate-1/4 ;
|
||||
M: operand SUB OCT: 050 2-operand ;
|
||||
|
||||
GENERIC: XOR ( dst src -- )
|
||||
M: integer XOR swap BIN: 110 t HEX: 81 immediate-1/4 ;
|
||||
M: immediate XOR swap { BIN: 110 t HEX: 80 } immediate-1/4 ;
|
||||
M: operand XOR OCT: 060 2-operand ;
|
||||
|
||||
GENERIC: CMP ( dst src -- )
|
||||
M: integer CMP swap BIN: 111 t HEX: 81 immediate-1/4 ;
|
||||
M: immediate CMP swap { BIN: 111 t HEX: 80 } immediate-1/4 ;
|
||||
M: operand CMP OCT: 070 2-operand ;
|
||||
|
||||
: NOT ( dst -- ) BIN: 010 t HEX: f7 1-operand ;
|
||||
: NEG ( dst -- ) BIN: 011 t HEX: f7 1-operand ;
|
||||
: MUL ( dst -- ) BIN: 100 t HEX: f7 1-operand ;
|
||||
: IMUL ( src -- ) BIN: 101 t HEX: f7 1-operand ;
|
||||
: DIV ( dst -- ) BIN: 110 t HEX: f7 1-operand ;
|
||||
: IDIV ( src -- ) BIN: 111 t HEX: f7 1-operand ;
|
||||
: NOT ( dst -- ) { BIN: 010 t HEX: f7 } 1-operand ;
|
||||
: NEG ( dst -- ) { BIN: 011 t HEX: f7 } 1-operand ;
|
||||
: MUL ( dst -- ) { BIN: 100 t HEX: f7 } 1-operand ;
|
||||
: IMUL ( src -- ) { BIN: 101 t HEX: f7 } 1-operand ;
|
||||
: DIV ( dst -- ) { BIN: 110 t HEX: f7 } 1-operand ;
|
||||
: IDIV ( src -- ) { BIN: 111 t HEX: f7 } 1-operand ;
|
||||
|
||||
: CDQ HEX: 99 , ;
|
||||
: CQO HEX: 48 , CDQ ;
|
||||
|
||||
: ROL ( dst n -- ) swap BIN: 000 t HEX: c1 immediate-1 ;
|
||||
: ROR ( dst n -- ) swap BIN: 001 t HEX: c1 immediate-1 ;
|
||||
: RCL ( dst n -- ) swap BIN: 010 t HEX: c1 immediate-1 ;
|
||||
: RCR ( dst n -- ) swap BIN: 011 t HEX: c1 immediate-1 ;
|
||||
: SHL ( dst n -- ) swap BIN: 100 t HEX: c1 immediate-1 ;
|
||||
: SHR ( dst n -- ) swap BIN: 101 t HEX: c1 immediate-1 ;
|
||||
: SAR ( dst n -- ) swap BIN: 111 t HEX: c1 immediate-1 ;
|
||||
: ROL ( dst n -- ) swap { BIN: 000 t HEX: c0 } immediate-1 ;
|
||||
: ROR ( dst n -- ) swap { BIN: 001 t HEX: c0 } immediate-1 ;
|
||||
: RCL ( dst n -- ) swap { BIN: 010 t HEX: c0 } immediate-1 ;
|
||||
: RCR ( dst n -- ) swap { BIN: 011 t HEX: c0 } immediate-1 ;
|
||||
: SHL ( dst n -- ) swap { BIN: 100 t HEX: c0 } immediate-1 ;
|
||||
: SHR ( dst n -- ) swap { BIN: 101 t HEX: c0 } immediate-1 ;
|
||||
: SAR ( dst n -- ) swap { BIN: 111 t HEX: c0 } immediate-1 ;
|
||||
|
||||
GENERIC: IMUL2 ( dst src -- )
|
||||
M: integer IMUL2 swap dup reg-code t HEX: 69 immediate-1/4 ;
|
||||
M: immediate IMUL2 swap dup reg-code t HEX: 68 3array immediate-1/4 ;
|
||||
M: operand IMUL2 OCT: 257 extended-opcode (2-operand) ;
|
||||
|
||||
: MOVSX ( dst src -- )
|
||||
|
|
@ -432,11 +446,11 @@ M: operand IMUL2 OCT: 257 extended-opcode (2-operand) ;
|
|||
|
||||
! x87 Floating Point Unit
|
||||
|
||||
: FSTPS ( operand -- ) BIN: 011 f HEX: d9 1-operand ;
|
||||
: FSTPL ( operand -- ) BIN: 011 f HEX: dd 1-operand ;
|
||||
: FSTPS ( operand -- ) { BIN: 011 f HEX: d9 } 1-operand ;
|
||||
: FSTPL ( operand -- ) { BIN: 011 f HEX: dd } 1-operand ;
|
||||
|
||||
: FLDS ( operand -- ) BIN: 000 f HEX: d9 1-operand ;
|
||||
: FLDL ( operand -- ) BIN: 000 f HEX: dd 1-operand ;
|
||||
: FLDS ( operand -- ) { BIN: 000 f HEX: d9 } 1-operand ;
|
||||
: FLDL ( operand -- ) { BIN: 000 f HEX: dd } 1-operand ;
|
||||
|
||||
! SSE multimedia instructions
|
||||
|
||||
|
|
|
|||
|
|
@ -66,12 +66,12 @@ IN: cpu.x86.intrinsics
|
|||
! Mark the card
|
||||
"obj" operand card-bits SHR
|
||||
"cards_offset" f temp-reg v>operand %alien-global
|
||||
temp-reg v>operand "obj" operand [+] card-mark OR
|
||||
temp-reg v>operand "obj" operand [+] card-mark <byte> OR
|
||||
|
||||
! Mark the card deck
|
||||
"obj" operand deck-bits card-bits - SHR
|
||||
"decks_offset" f temp-reg v>operand %alien-global
|
||||
temp-reg v>operand "obj" operand [+] card-mark MOV
|
||||
temp-reg v>operand "obj" operand [+] card-mark <byte> MOV
|
||||
] unless ;
|
||||
|
||||
\ set-slot {
|
||||
|
|
|
|||
Loading…
Reference in New Issue