2023-09-01 23:10:52 +00:00
|
|
|
var target
|
|
|
|
0x100 target !
|
2023-09-01 23:10:52 +00:00
|
|
|
segalloc const tseg
|
|
|
|
|
|
|
|
: @t tseg @far ;
|
|
|
|
: b@t tseg b@far ;
|
|
|
|
: !t tseg !far ;
|
|
|
|
: b!t tseg b!far ;
|
|
|
|
: +target! ( bytes -- prevtarget ) target @ dup >rot + target ! ;
|
|
|
|
: >t 1 +target! b!t ;
|
|
|
|
: w>t 2 +target! !t ;
|
2023-09-01 23:10:52 +00:00
|
|
|
|
|
|
|
var op-encode
|
2023-09-01 23:10:52 +00:00
|
|
|
var lastop var lastlabel
|
2023-09-01 23:10:52 +00:00
|
|
|
|
2023-09-01 23:10:52 +00:00
|
|
|
var op-memwidth
|
2023-09-01 23:10:52 +00:00
|
|
|
: BYTE 1 op-memwidth ! ; : byteptr? op-memwidth @ 1 = ;
|
|
|
|
: FAR 4 op-memwidth ! ; : farptr? op-memwidth @ 4 = ;
|
2023-09-01 23:10:52 +00:00
|
|
|
|
2023-09-01 23:10:52 +00:00
|
|
|
var current-oparg
|
|
|
|
var opargs-remaining
|
|
|
|
array oparg1 3 cells allot
|
|
|
|
array oparg2 3 cells allot
|
|
|
|
|
2023-09-01 23:10:52 +00:00
|
|
|
: arg1 oparg1 current-oparg ! ; arg1
|
2023-09-01 23:10:52 +00:00
|
|
|
: arg2 oparg2 current-oparg ! ;
|
|
|
|
: swap-args current-oparg @ oparg1 = if arg2 else arg1 then ;
|
|
|
|
|
|
|
|
: oparg-type ( -- type ) current-oparg @ ;
|
|
|
|
: oparg-val ( -- v ) current-oparg @ cell + ;
|
|
|
|
: oparg-base ( -- v ) current-oparg @ 2 cells + ;
|
|
|
|
: set-oparg! ( val type -- ) oparg-type ! oparg-val ! 0 oparg-base ! ;
|
|
|
|
|
2023-09-01 23:10:54 +00:00
|
|
|
: oparg-unset? ( -- f ) oparg-type @ 0 = ;
|
2023-09-01 23:10:52 +00:00
|
|
|
: oparg-imm! ( val -- ) 1 set-oparg! ;
|
|
|
|
: oparg-imm? ( -- f ) oparg-type @ 1 = ;
|
|
|
|
: oparg-reg! ( reg -- ) 2 set-oparg! ;
|
|
|
|
: oparg-reg? ( -- f ) oparg-type @ 2 = ;
|
|
|
|
: oparg-regflag? ( flag -- f ) oparg-val @ 0xf0 & = oparg-reg? and ;
|
|
|
|
: oparg-breg? ( -- f ) 0x10 oparg-regflag? ;
|
|
|
|
: oparg-wreg? ( -- f ) 0x00 oparg-regflag? ;
|
|
|
|
: oparg-segreg? ( -- f ) 0x20 oparg-regflag? ;
|
|
|
|
: oparg-mem! ( disp -- ) 3 set-oparg! ;
|
2023-09-01 23:10:54 +00:00
|
|
|
: oparg-mem? ( -- f ) oparg-type @ 0x0f & 3 = ;
|
|
|
|
: oparg-mempatch? ( -- f ) oparg-type @ 0x13 = ;
|
2023-09-01 23:10:52 +00:00
|
|
|
|
2023-09-01 23:10:52 +00:00
|
|
|
: byteop? ( -- f )
|
2023-09-01 23:10:52 +00:00
|
|
|
oparg-breg? swap-args oparg-breg? or swap-args byteptr? or ;
|
2023-09-01 23:10:52 +00:00
|
|
|
: byteval? ( v -- f ) 0xff00 & dup 0xff00 = swap 0 = or ;
|
2023-09-01 23:10:52 +00:00
|
|
|
: oparg-bwreg? ( -- f ) byteop? if oparg-breg? else oparg-wreg? then ;
|
2023-09-01 23:10:52 +00:00
|
|
|
|
2023-09-01 23:10:52 +00:00
|
|
|
: operror ( err -- ) lastop @ type s" near " type lastlabel @ type s" : " type type cr ;
|
2023-09-01 23:10:54 +00:00
|
|
|
|
|
|
|
: encode-op ( -- ) op-encode @ execute 0 op-encode ! ;
|
|
|
|
: check-encoded ( -- )
|
|
|
|
target @ >r encode-op <r target @ =
|
|
|
|
if s" invalid argument types" operror then ;
|
2023-09-01 23:10:52 +00:00
|
|
|
: oparg-complete!
|
|
|
|
opargs-remaining @ dup if
|
|
|
|
1 - dup opargs-remaining !
|
|
|
|
if arg2
|
2023-09-01 23:10:54 +00:00
|
|
|
else arg1 check-encoded then
|
2023-09-01 23:10:52 +00:00
|
|
|
else s" too many arguments" operror then ;
|
|
|
|
|
|
|
|
: # oparg-imm! oparg-complete! ;
|
|
|
|
: @[ 0 oparg-mem! ;
|
2023-09-01 23:10:52 +00:00
|
|
|
: @] -1 oparg-base ! oparg-complete! ;
|
2023-09-01 23:10:52 +00:00
|
|
|
|
|
|
|
: unexpected-addr ( addr -- ) drop s" unexpected address" operror ;
|
|
|
|
: @+ ( disp -- )
|
2023-09-01 23:10:54 +00:00
|
|
|
opargs-remaining @ if
|
|
|
|
oparg-unset? if oparg-mem! @] return then
|
|
|
|
oparg-mem? if oparg-val ! return then
|
|
|
|
then drop unexpected-addr ;
|
|
|
|
|
2023-09-01 23:10:52 +00:00
|
|
|
: @FAR ( offset segment -- ) 4 set-oparg! oparg-base ! ;
|
2023-09-01 23:10:52 +00:00
|
|
|
: oparg-faraddr? oparg-type @ 4 = ;
|
2023-09-01 23:10:52 +00:00
|
|
|
|
2023-09-01 23:10:54 +00:00
|
|
|
array patchtable 10 2 cells * allot
|
|
|
|
: find-patch ( patchid -- patch ) 2 cells * patchtable + ;
|
|
|
|
: patchpoint ( type -- ) oparg-mempatch? if
|
|
|
|
oparg-val @ find-patch swap over ! cell + target @ swap !
|
|
|
|
else drop then ;
|
|
|
|
: patch-a16 ( tptr targ -- ) swap !t ;
|
|
|
|
: patch-r16 ( tptr targ -- ) over 2 + - swap !t ;
|
|
|
|
: patch-r8 ( tptr targ -- ) over 1 + - swap b!t ;
|
2023-09-01 23:10:54 +00:00
|
|
|
' patch-a16 dbg" patch-a16" drop
|
|
|
|
' patch-r16 dbg" patch-r16" drop
|
|
|
|
' patch-r8 dbg" patch-r8 " drop
|
|
|
|
: apply-patch ( tptr type -- ) target @ swap dbg" applying patch" execute ;
|
2023-09-01 23:10:54 +00:00
|
|
|
|
|
|
|
: @> ( patchid -- ) 0x13 set-oparg! @] ;
|
2023-09-01 23:10:54 +00:00
|
|
|
: <:
|
|
|
|
( patchid -- ) find-patch dup @ swap cell + @ swap apply-patch ;
|
2023-09-01 23:10:54 +00:00
|
|
|
|
2023-09-01 23:10:52 +00:00
|
|
|
: L: here create wordname lastlabel ! target @ , does> @ @+ ;
|
|
|
|
: L@ [ ' ' , ] 2 cells + @ ;
|
2023-09-01 23:10:52 +00:00
|
|
|
|
|
|
|
: memreg create , does> @ oparg-base ! oparg-complete! ;
|
2023-09-01 23:10:52 +00:00
|
|
|
0 memreg BX+SI] 1 memreg BX+DI] 2 memreg BP+SI] 3 memreg BP+DI]
|
|
|
|
4 memreg SI] 5 memreg DI] 6 memreg BP] 7 memreg BX]
|
2023-09-01 23:10:52 +00:00
|
|
|
|
|
|
|
: reg create , does> @ oparg-reg! oparg-complete! ;
|
|
|
|
( data registers: take the bottom four bits and you have the
|
|
|
|
REG and R/M encoding for the modr/m byte )
|
2023-09-01 23:10:52 +00:00
|
|
|
0x00 reg AX 0x01 reg CX 0x02 reg DX 0x03 reg BX
|
|
|
|
0x04 reg SP 0x05 reg BP 0x06 reg SI 0x07 reg DI
|
2023-09-01 23:10:52 +00:00
|
|
|
( 8-bit data registers, same scheme )
|
2023-09-01 23:10:52 +00:00
|
|
|
0x10 reg AL 0x11 reg CL 0x12 reg DL 0x13 reg BL
|
|
|
|
0x14 reg AH 0x15 reg CH 0x16 reg DH 0x17 reg BH
|
|
|
|
( segment registers; same scheme, )
|
|
|
|
0x20 reg ES 0x21 reg CS 0x22 reg SS 0x23 reg DS
|
|
|
|
|
|
|
|
: start-op ( dictentry argcount -- )
|
2023-09-01 23:10:52 +00:00
|
|
|
0 op-memwidth ! ( start unknown )
|
2023-09-01 23:10:52 +00:00
|
|
|
opargs-remaining @ if s" not enough arguments" operror then
|
2023-09-01 23:10:54 +00:00
|
|
|
opargs-remaining ! lastop ! arg2 0 0 set-oparg! arg1 0 0 set-oparg! ;
|
2023-09-01 23:10:52 +00:00
|
|
|
: prefix create , does> @ >t ;
|
2023-09-01 23:10:52 +00:00
|
|
|
: 0op here create wordname , b, does> dup @ 0 start-op cell + b@ >t ;
|
2023-09-01 23:10:52 +00:00
|
|
|
|
2023-09-01 23:10:52 +00:00
|
|
|
0x26 prefix ES: 0x36 prefix SS: 0x2e prefix CS: 0x3e prefix DS:
|
|
|
|
0xf0 prefix LOCK 0xf2 prefix REPNZ 0xf3 prefix REPZ
|
2023-09-01 23:10:52 +00:00
|
|
|
|
2023-09-01 23:10:52 +00:00
|
|
|
0x90 0op NOP 0xa4 0op MOVSB 0xa5 0op MOVSW 0xa6 0op CMPSB
|
|
|
|
0xa7 0op CMPSW 0xc3 0op RET 0xd7 0op XLAT 0xf4 0op HLT
|
|
|
|
0x98 0op CBW 0x99 0op CWD 0x9c 0op PUSHF 0x9d 0op POPF
|
|
|
|
0x9e 0op SAHF 0x9f 0op LAHF 0xaa 0op STOSB 0xab 0op STOSW
|
|
|
|
0xac 0op LODSB 0xad 0op LODSW 0xae 0op SCASB 0xaf 0op SCASW
|
|
|
|
0xcb 0op RETF 0xce 0op INTO 0xcf 0op IRET 0xf8 0op CLC
|
|
|
|
0xf9 0op STC 0xfa 0op CLI 0xfb 0op STI 0xfc 0op CLD
|
|
|
|
0xfd 0op STD 0xf5 0op CMC
|
2023-09-01 23:10:52 +00:00
|
|
|
|
2023-09-01 23:10:52 +00:00
|
|
|
: :op ( count -- ) here create wordname , , $DOCOLON , ] does>
|
|
|
|
dup @ over cell + @ start-op 2 cells + op-encode ! ;
|
2023-09-01 23:10:52 +00:00
|
|
|
|
|
|
|
: memarg>case ( -- 0|1|2 )
|
|
|
|
oparg-base @ dup -1 = if drop 1 ( D16 ) else
|
2023-09-01 23:10:52 +00:00
|
|
|
6 = oparg-val @ 0 = and if 2 ( [bp]+0 ) else 0 ( standard ) then then ;
|
2023-09-01 23:10:52 +00:00
|
|
|
: memarg>dispsize ( -- 0|1|2 )
|
|
|
|
memarg>case dup 1 = if drop 2 else 2 = if 1 else
|
2023-09-01 23:10:52 +00:00
|
|
|
oparg-val @ dup 0 = if drop 0 else byteval? if 1 else 2
|
2023-09-01 23:10:52 +00:00
|
|
|
then then then then ;
|
|
|
|
: memarg>mod+rm ( -- mod rm )
|
2023-09-01 23:10:52 +00:00
|
|
|
memarg>case dup 1 = if drop 0 6 else 2 = if 1 6 else
|
2023-09-01 23:10:52 +00:00
|
|
|
memarg>dispsize oparg-base @ then then ;
|
|
|
|
: regarg>mod+rm ( -- mod rm ) 3 oparg-val @ ;
|
|
|
|
|
2023-09-01 23:10:52 +00:00
|
|
|
: modrm>t ( reg mod rm -- ) 0x07 & swap 0x03 & 6 << | swap 0x07 & 3 << | >t ;
|
2023-09-01 23:10:54 +00:00
|
|
|
: pre-disp-write memarg>case 2 = if ' patch-a16 patchpoint then ;
|
2023-09-01 23:10:52 +00:00
|
|
|
|
|
|
|
( convention: words ending in * mean "will return if matched" )
|
2023-09-01 23:10:54 +00:00
|
|
|
: disp>t pre-disp-write oparg-val @ memarg>dispsize
|
2023-09-01 23:10:52 +00:00
|
|
|
dup 1 = if drop >t else 2 = if w>t else drop then then ;
|
2023-09-01 23:10:54 +00:00
|
|
|
defer byteimm? ' byteop? ' byteimm? redefine
|
|
|
|
var ignoreimm
|
|
|
|
: imm?>t ignoreimm @ not if
|
|
|
|
oparg-imm? if oparg-val @ byteimm? if >t else w>t then then then ;
|
2023-09-01 23:10:52 +00:00
|
|
|
|
2023-09-01 23:10:54 +00:00
|
|
|
( 2ret: return immediately from this word and calling word.
|
|
|
|
equivalent to rdrop return. )
|
|
|
|
: 2ret rdrop rdrop ;
|
|
|
|
|
2023-09-01 23:10:52 +00:00
|
|
|
: >wreg+op* ( base -- )
|
2023-09-01 23:10:54 +00:00
|
|
|
oparg-wreg? if oparg-val @ | >t 2ret then drop ;
|
2023-09-01 23:10:52 +00:00
|
|
|
: >segreg+op* ( base -- )
|
2023-09-01 23:10:54 +00:00
|
|
|
oparg-segreg? if oparg-val @ 0x0f & 3 << + >t 2ret then drop ;
|
2023-09-01 23:10:52 +00:00
|
|
|
: >mem ( reg op -- ) >t memarg>mod+rm modrm>t disp>t swap-args imm?>t ;
|
2023-09-01 23:10:52 +00:00
|
|
|
: >memreg ( op -- ) swap-args oparg-val @ swap-args swap >mem ;
|
2023-09-01 23:10:54 +00:00
|
|
|
: >extmem* oparg-mem? byteop? not and if >mem 2ret then 2drop ;
|
|
|
|
: >extbmem* oparg-mem? byteop? and if >mem 2ret then 2drop ;
|
2023-09-01 23:10:52 +00:00
|
|
|
|
2023-09-01 23:10:54 +00:00
|
|
|
: >extreg ( reg op -- ) >t regarg>mod+rm modrm>t swap-args imm?>t ;
|
2023-09-01 23:10:54 +00:00
|
|
|
: >extbreg* ( ext op -- ) oparg-breg? if >extreg 2ret then 2drop ;
|
|
|
|
: >extreg* ( ext op -- ) oparg-wreg? if >extreg 2ret then 2drop ;
|
|
|
|
|
2023-09-01 23:10:54 +00:00
|
|
|
: *? ( cp -- f ) :| execute 0 2ret |; execute 1 ;
|
2023-09-01 23:10:52 +00:00
|
|
|
|
2023-09-01 23:10:54 +00:00
|
|
|
: >extwreg|mem* ( ext op -- )
|
|
|
|
2dup ' >extreg* *? if 2drop 2ret then
|
|
|
|
' >extmem* *? if 2ret then ;
|
|
|
|
: >extbreg|mem* ( ext op -- )
|
|
|
|
2dup ' >extbreg* *? if 2drop 2ret then
|
|
|
|
' >extbmem* *? if 2ret then ;
|
|
|
|
|
|
|
|
: >grp3* ( reg -- )
|
|
|
|
dup 0xf6 ' >extbreg|mem* *? if drop 2ret then
|
|
|
|
0xf7 ' >extwreg|mem* *? if 2ret then ;
|
|
|
|
|
2023-09-01 23:10:54 +00:00
|
|
|
1 :op RET- oparg-imm? if oparg-val @ w>t then ;
|
2023-09-01 23:10:52 +00:00
|
|
|
1 :op PUSH
|
2023-09-01 23:10:52 +00:00
|
|
|
0x50 >wreg+op*
|
2023-09-01 23:10:52 +00:00
|
|
|
0x06 >segreg+op*
|
2023-09-01 23:10:54 +00:00
|
|
|
6 0xff >extmem* ;
|
2023-09-01 23:10:52 +00:00
|
|
|
1 :op POP
|
2023-09-01 23:10:52 +00:00
|
|
|
0x58 >wreg+op*
|
2023-09-01 23:10:52 +00:00
|
|
|
0x07 >segreg+op*
|
2023-09-01 23:10:54 +00:00
|
|
|
0 0x8f >extmem* ;
|
2023-09-01 23:10:52 +00:00
|
|
|
1 :op INC
|
2023-09-01 23:10:52 +00:00
|
|
|
0x40 >wreg+op*
|
2023-09-01 23:10:54 +00:00
|
|
|
0 0xfe >extbreg|mem*
|
|
|
|
0 0xff >extwreg|mem* ;
|
2023-09-01 23:10:52 +00:00
|
|
|
1 :op DEC
|
2023-09-01 23:10:52 +00:00
|
|
|
0x48 >wreg+op*
|
2023-09-01 23:10:54 +00:00
|
|
|
1 0xfe >extbreg|mem*
|
|
|
|
1 0xff >extwreg|mem* ;
|
2023-09-01 23:10:52 +00:00
|
|
|
1 :op INT
|
2023-09-01 23:10:54 +00:00
|
|
|
oparg-imm? if
|
|
|
|
oparg-val @ dup 3 = if drop 0xcc >t else 0xcd >t >t then
|
|
|
|
then ;
|
2023-09-01 23:10:52 +00:00
|
|
|
|
2023-09-01 23:10:54 +00:00
|
|
|
: diffaddr ( opsize -- diff ) oparg-val @ swap target @ + - ;
|
|
|
|
: oparg-nearaddr? ( -- f ) oparg-mem? oparg-base @ -1 = and ;
|
2023-09-01 23:10:52 +00:00
|
|
|
: >short-jmp* ( op -- ) oparg-nearaddr? if
|
2023-09-01 23:10:54 +00:00
|
|
|
2 diffaddr dup byteval? oparg-mempatch? or
|
|
|
|
if swap >t ' patch-r8 patchpoint cr >t 2ret then drop
|
|
|
|
then drop ;
|
2023-09-01 23:10:52 +00:00
|
|
|
: >near-reljmp* ( op -- ) oparg-nearaddr? if
|
2023-09-01 23:10:54 +00:00
|
|
|
3 diffaddr swap >t ' patch-r16 patchpoint w>t 2ret then drop ;
|
|
|
|
: >far-jmp* ( op -- ) oparg-faraddr?
|
|
|
|
if >t oparg-base @ w>t oparg-val @ w>t 2ret then drop ;
|
|
|
|
|
|
|
|
1 :op JO 0x70 >short-jmp* ;
|
|
|
|
1 :op JNO 0x71 >short-jmp* ;
|
|
|
|
1 :op JB 0x72 >short-jmp* ;
|
|
|
|
1 :op JNB 0x73 >short-jmp* ;
|
|
|
|
1 :op JZ 0x74 >short-jmp* ;
|
|
|
|
1 :op JNZ 0x75 >short-jmp* ;
|
|
|
|
1 :op JBE 0x76 >short-jmp* ;
|
|
|
|
1 :op JA 0x77 >short-jmp* ;
|
|
|
|
1 :op JS 0x78 >short-jmp* ;
|
|
|
|
1 :op JNS 0x79 >short-jmp* ;
|
|
|
|
1 :op JPE 0x7a >short-jmp* ;
|
|
|
|
1 :op JPO 0x7b >short-jmp* ;
|
|
|
|
1 :op JL 0x7c >short-jmp* ;
|
|
|
|
1 :op JGE 0x7d >short-jmp* ;
|
|
|
|
1 :op JLE 0x7e >short-jmp* ;
|
|
|
|
1 :op JG 0x7f >short-jmp* ;
|
|
|
|
1 :op LOOPNZ 0xe0 >short-jmp* ;
|
|
|
|
1 :op LOOPZ 0xe1 >short-jmp* ;
|
|
|
|
1 :op LOOP 0xe2 >short-jmp* ;
|
|
|
|
1 :op JCXZ 0xe3 >short-jmp* ;
|
2023-09-01 23:10:52 +00:00
|
|
|
1 :op JMP
|
2023-09-01 23:10:52 +00:00
|
|
|
0xe9 >near-reljmp*
|
2023-09-01 23:10:54 +00:00
|
|
|
0xeb >short-jmp*
|
2023-09-01 23:10:52 +00:00
|
|
|
0xea >far-jmp*
|
2023-09-01 23:10:52 +00:00
|
|
|
farptr? if 0x05 0xff >extmem* then
|
2023-09-01 23:10:54 +00:00
|
|
|
0x04 0xff >extwreg|mem* ;
|
2023-09-01 23:10:52 +00:00
|
|
|
1 :op CALL
|
2023-09-01 23:10:52 +00:00
|
|
|
0xe8 >near-reljmp*
|
2023-09-01 23:10:52 +00:00
|
|
|
farptr? if 0x03 0xff >extmem* then
|
2023-09-01 23:10:54 +00:00
|
|
|
0x02 0xff >extwreg|mem* ;
|
2023-09-01 23:10:52 +00:00
|
|
|
|
|
|
|
( four opcodes laid out next to each other:
|
|
|
|
byte mem, reg | word mem, reg | byte reg, mem | word reg, mem )
|
|
|
|
: memreg? ( -- f ) oparg-mem? swap-args oparg-bwreg? swap-args and ;
|
|
|
|
: >bmr-wmr? ( base -- f )
|
|
|
|
memreg? if byteop? not if 1 + then >memreg 1 else drop 0 then ;
|
2023-09-01 23:10:52 +00:00
|
|
|
: regreg? oparg-wreg? swap-args oparg-wreg? swap-args and ;
|
|
|
|
: bregbreg? oparg-breg? swap-args oparg-breg? swap-args and ;
|
|
|
|
: >regreg ( op -- f ) swap-args oparg-val @ swap swap-args >extreg ;
|
|
|
|
|
|
|
|
: >brr-wrr? ( base -- f )
|
|
|
|
regreg? if 1 + else bregbreg? not if drop 0 return then then >regreg 1 ;
|
|
|
|
|
2023-09-01 23:10:54 +00:00
|
|
|
( byte any, reg | word any, reg )
|
|
|
|
: >bar-war* ( base -- )
|
|
|
|
dup >brr-wrr? if drop 2ret then
|
|
|
|
>bmr-wmr? if 2ret then ;
|
|
|
|
|
2023-09-01 23:10:52 +00:00
|
|
|
: >bmr-wmr-brm-wrm* ( base -- )
|
2023-09-01 23:10:54 +00:00
|
|
|
dup >bmr-wmr? if drop 2ret then
|
|
|
|
dup >brr-wrr? if drop 2ret then
|
|
|
|
2 + swap-args >bmr-wmr? swap-args if 2ret then ;
|
2023-09-01 23:10:52 +00:00
|
|
|
: >bmr-wmr-brm-wrm? ( base -- f )
|
|
|
|
1 swap >bmr-wmr-brm-wrm* drop 0 ;
|
|
|
|
: >6group-math* ( base -- )
|
2023-09-01 23:10:54 +00:00
|
|
|
dup >bmr-wmr-brm-wrm? if drop 2ret then 4 +
|
2023-09-01 23:10:52 +00:00
|
|
|
swap-args oparg-imm? swap-args not if drop return then
|
|
|
|
oparg-reg? not if drop return then
|
2023-09-01 23:10:54 +00:00
|
|
|
oparg-val @ dup
|
|
|
|
0x10 = if drop >t swap-args imm?>t swap-args 2ret then
|
|
|
|
0x00 = if 1 + >t swap-args imm?>t swap-args 2ret then drop ;
|
2023-09-01 23:10:52 +00:00
|
|
|
|
2023-09-01 23:10:54 +00:00
|
|
|
: 'extregmem ( op -- op )
|
|
|
|
byteop? if ' >extbreg|mem* else 1 + ' >extwreg|mem* then ;
|
|
|
|
|
|
|
|
: >grp1* ( ext -- )
|
|
|
|
arg2 oparg-imm? if
|
|
|
|
oparg-val @ byteval? arg1 byteop? not and
|
|
|
|
if ' 1 ' byteimm? redefine 0x82 else 0x80 then
|
|
|
|
'extregmem *? ' byteop? ' byteimm? redefine if 2ret then
|
|
|
|
else arg1 drop then ;
|
|
|
|
|
|
|
|
: >grp2* ( ext -- )
|
|
|
|
0xd0 swap-args
|
|
|
|
oparg-imm? oparg-val @ 1 = and not if ( 1, d0/d1 )
|
|
|
|
oparg-reg? oparg-val @ 0x11 = and
|
|
|
|
if 2 + ( CL, d2/d3 ) else swap-args 2drop return then
|
|
|
|
then swap-args 'extregmem 1 ignoreimm ! *? 0 ignoreimm ! if 2ret then ;
|
|
|
|
|
2023-09-01 23:10:52 +00:00
|
|
|
2 :op XCHG
|
2023-09-01 23:10:52 +00:00
|
|
|
arg2 oparg-reg? oparg-val @ 0x00 = arg1 oparg-wreg? and
|
2023-09-01 23:10:54 +00:00
|
|
|
if 0x90 >wreg+op* then
|
|
|
|
0x86 >bar-war* ;
|
2023-09-01 23:10:52 +00:00
|
|
|
2 :op MOV
|
2023-09-01 23:10:52 +00:00
|
|
|
0x88 >bmr-wmr-brm-wrm*
|
2023-09-01 23:10:52 +00:00
|
|
|
arg2 oparg-imm? arg1 if
|
|
|
|
oparg-wreg? if oparg-val @ 0xb8 | >t arg2 oparg-val @ w>t return then
|
|
|
|
oparg-breg? if oparg-val @ 0x0f & 0xb0 | >t arg2 oparg-val @ >t return then
|
2023-09-01 23:10:52 +00:00
|
|
|
0 0xc6 >extbmem*
|
|
|
|
0 0xc7 >extmem*
|
2023-09-01 23:10:54 +00:00
|
|
|
then ;
|
2023-09-01 23:10:54 +00:00
|
|
|
2 :op ADD 0x00 >6group-math* 0 >grp1* ;
|
|
|
|
2 :op ADC 0x10 >6group-math* 2 >grp1* ;
|
|
|
|
2 :op AND 0x20 >6group-math* 4 >grp1* ;
|
|
|
|
2 :op XOR 0x30 >6group-math* 6 >grp1* ;
|
|
|
|
2 :op OR 0x08 >6group-math* 1 >grp1* ;
|
|
|
|
2 :op SBB 0x18 >6group-math* 3 >grp1* ;
|
|
|
|
2 :op SUB 0x28 >6group-math* 5 >grp1* ;
|
|
|
|
2 :op CMP 0x38 >6group-math* 7 >grp1* ;
|
|
|
|
|
|
|
|
2 :op ROL 0 >grp2* ; 2 :op ROR 1 >grp2* ; 2 :op RCL 2 >grp2* ;
|
|
|
|
2 :op RCR 3 >grp2* ; 2 :op SHL 4 >grp2* ; 2 :op SHR 5 >grp2* ;
|
|
|
|
2 :op SAR 7 >grp2* ;
|
|
|
|
|
|
|
|
1 :op NOT 2 >grp3* ; 1 :op NEG 3 >grp3* ; 1 :op MUL 4 >grp3* ;
|
|
|
|
1 :op IMUL 5 >grp3* ; 1 :op DIV 6 >grp3* ; 1 :op IDIV 7 >grp3* ;
|
|
|
|
|
|
|
|
2 :op LEA oparg-wreg? arg2 oparg-mem? and if 0x8d >memreg then ;
|
2023-09-01 23:10:52 +00:00
|
|
|
|