diff --git a/basis/cpu/x86/assembler/assembler-tests.factor b/basis/cpu/x86/assembler/assembler-tests.factor index 83186a7f24..7312a16f83 100644 --- a/basis/cpu/x86/assembler/assembler-tests.factor +++ b/basis/cpu/x86/assembler/assembler-tests.factor @@ -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 diff --git a/basis/cpu/x86/assembler/assembler.factor b/basis/cpu/x86/assembler/assembler.factor index b91083dad1..059be328f2 100644 --- a/basis/cpu/x86/assembler/assembler.factor +++ b/basis/cpu/x86/assembler/assembler.factor @@ -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. 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 ; @@ -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> : 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 -