Menu
▾
▴
[Win32forth-cvs] win32forth/src 486ASM.F, 1.15, 1.16 586ASMCM.f, 1.10, 1.11 DIS486.F, 1.7, 1.8
|
From: Jos v.d.V. <jo...@us...> - 2015-01-19 13:29:41
|
Update of /cvsroot/win32forth/win32forth/src In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv18359 Modified Files: 486ASM.F 586ASMCM.f DIS486.F Log Message: Jos Added asm-abort for better error reporting more instructions and extended the disassembler Index: DIS486.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/DIS486.F,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** DIS486.F 2 Dec 2006 12:09:52 -0000 1.7 --- DIS486.F 19 Jan 2015 13:29:37 -0000 1.8 *************** *** 13,16 **** --- 13,17 ---- \ 06-21-95 SMuB removed redundant COUNT calls from txb, lxs. \ 04-??-97 Extended by C.L. to include P6 and MMX instructions + \ 01-19-15 Jos, Extended for XMM instructions. cr .( Loading 80486 Disassembler...) *************** *** 37,40 **** --- 38,43 ---- 0 value dis.prefix-op 0 value dis.mmx-reg? + 0 VALUE mmx-reg + 0 VALUE xmm-reg \ For a 32-bit environment 0 value dis.mem? \ for suppressing comma after memory address *************** *** 58,62 **** : parse/ModR/M ( mod-r-r/m -- 3bits=r/m 3bits=r/op 2bits=mod ) ! \ r/op includes general, special, segment, MMX registers or exteded opcode 255 and 8 /mod 8 /mod ; --- 61,65 ---- : parse/ModR/M ( mod-r-r/m -- 3bits=r/m 3bits=r/op 2bits=mod ) ! \ r/op includes general, special, segment, MMX registers or extended opcode 255 and 8 /mod 8 /mod ; *************** *** 157,160 **** --- 160,164 ---- : .reg16(XX-XXX-NNN) ( n -- ) 7 and S" axcxdxbxspbpsidi" 2 ss. ; : .reg32(XX-XXX-NNN) ( n -- ) 7 and S" eaxecxedxebxespebpesiedi" 3 ss. ; + : .xmmreg ( n -- ) 7 AND S" xmm0xmm1xmm2xmm3xmm4xmm5xmm6xmm7" 4 ss. ; \ 1 : .reg16/32(XX-XXX-NNN) ( n -- ) *************** *** 165,175 **** : .reg(XX-XXX-NNN) ( a n -- a ) ! dis.mmx-reg? ! if .mreg(XX-XXX-NNN) ! else dis.size ! if .reg16/32(XX-XXX-NNN) ! else .reg8(XX-XXX-NNN) ! then ! then ; : .[base16](XX-XXX-1NN) ( r/m -- ) --- 169,183 ---- : .reg(XX-XXX-NNN) ( a n -- a ) ! xmm-reg ! if .xmmreg ! else dis.mmx-reg? ! if .mreg(XX-XXX-NNN) ! else dis.size ! if .reg16/32(XX-XXX-NNN) ! else .reg8(XX-XXX-NNN) ! then ! then ! then ; ! : .[base16](XX-XXX-1NN) ( r/m -- ) *************** *** 291,301 **** then ; ! : r/m8(ModR/M) 0 to dis.size mod-r/m(ModR/M) ; ! : r/m16/32(ModR/M) 1 to dis.size mod-r/m(ModR/M) ; ! : r/m16(ModR/M) true to dis.16-bit-data r/m16/32(ModR/M) ; : r,r/m() ( adr -- adr' ) count dup 3 rshift ( op/reg->reg/m ) ! .reg(XX-XXX-NNN) ., mod-r/m(ModR/M) ; : r/m,r() ( adr -- adr' ) --- 299,313 ---- then ; ! : r/m8(ModR/M) ( adr modr/m -- adr' ) 0 to dis.size mod-r/m(ModR/M) ; ! : r/m16/32(ModR/M) ( adr modr/m -- adr' ) 1 to dis.size mod-r/m(ModR/M) ; ! : r/m16(ModR/M) ( adr modr/m -- adr' ) true to dis.16-bit-data r/m16/32(ModR/M) ; : r,r/m() ( adr -- adr' ) + count dup 3 rshift + .reg(XX-XXX-NNN) ., mod-r/m(ModR/M) ; + + : r,r/m ( adr -- adr' ) count dup 3 rshift ( op/reg->reg/m ) ! .reg(XX-XXX-NNN) ., mod-r/m(ModR/M) ; : r/m,r() ( adr -- adr' ) *************** *** 309,312 **** --- 321,325 ---- 2 and if r,r/m() else r/m,r() then ; + \ -------------------- Simple Opcodes -------------------- *************** *** 1170,1173 **** --- 1183,1189 ---- r,r/m() ; + + #14 constant opcfield + \ --------------------- MMX Operations ----------------- *************** *** 1272,1275 **** --- 1288,1292 ---- .s" pxor " drop r,r/m() ; + \ -------------------- Opcode Table -------------------- *************** *** 1306,1310 **** dup 0x70 and 0x50 0x80 within to dis.mmx-reg? cells op2-table2 + @ execute ! 0 to dis.mmx-reg? ; create op1-table --- 1323,1328 ---- dup 0x70 and 0x50 0x80 within to dis.mmx-reg? cells op2-table2 + @ execute ! 0 to dis.mmx-reg? ! 0 to xmm-reg ; create op1-table *************** *** 1330,1337 **** --- 1348,1573 ---- ops shf shf shf shf aam aad ??? xlt fd8 fd9 fda fdb fdc fdd fde fdf \ D ops lup lup lup lup inp inp otp otp jsr jmp cis jmp ind ind otd otd \ E + \ ops lok ??? rpz rep hlt cmc F6. F6. clc stc cli sti cld std FE. FF. \ F ops lok ??? rpz rep hlt cmc F6. F6. clc stc cli sti cld std FE. FF. \ F \ 0 1 2 3 4 5 6 7 8 9 A B C D E F + + \ -------------------------- SSE2 Operations ------------------------------- + + \ -- swap reg fields in mod-r/m byte + : swap-regs ( u1 -- u2 ) + LOCALS| mod-r/m | + mod-r/m 7 AND 3 LSHIFT + mod-r/m 3 RSHIFT 7 AND OR + mod-r/m $C0 AND OR ; + + : ?swap-regs DUP $C0 AND $C0 = IF swap-regs ENDIF ; ( u1 -- u2 ) + + : modbyte ( mod-r-r/m -- r/m r mod ) ( r including general, special, segment, MMX ) + ( mod-op-r/m -- r/m op mod ) + #255 AND 8 /MOD 8 /MOD ; + + : mod-r/m ( addr modr/m -- addr' ) + modbyte NIP ( [mod-r-r/m] -- r/m mod ) + dis.default-16bit? + if mod-r/m16(r/m,mod) + else mod-r/m32(r/m,mod) + then ; + + : ::imm8 ( addr -- addr' ) ., count h.>s ; + : stab ( pos - ) s-buf c@ - 1 max sspaces ; + : rstab ( -- ) 0x8 stab ; + : R:sse2 ( -- ) true TO xmm-reg false TO mmx-reg ; + : R:reg ( a n -- a ) 7 and .reg(XX-XXX-NNN) ; + : 0f-prefix? ( adr -- adr' flag ) dup 1+ c@ 0xF = ; + + : xm-r/m,r ( addr -- addr' ) rstab R:sse2 r/m,r() ; + + : xm-r,r/m ( addr -- addr' ) rstab R:sse2 r,r/m ; + + : r32/m,xmmr ( addr -- addr' ) \ the register is always XMM + rstab count ?swap-regs + true to xmm-reg + dup >r mod-r/m ., r> 3 rshift R:reg ; + + : xmmr,r32/m ( addr -- addr' ) \ dest register is XMM + rstab true to xmm-reg count dup 3 rshift R:reg + ., false to xmm-reg r/m16/32(ModR/M) ; + + : r,xmm ( addr -- addr' ) \ 1st=r32 2nd=XMM + rstab false to xmm-reg count dup 3 rshift + .reg32(XX-XXX-NNN) ., .xmmreg ; + + : .cmp-sse ( adr -- adr' ) + dup 1+ c@ + case + 0 of .s" cmpeq" endof + 1 of .s" cmplt" endof + 2 of .s" cmple" endof + 3 of .s" cmpunord" endof + 4 of .s" cmpneq" endof + 5 of .s" cmpnlt" endof + 6 of .s" cmpnle" endof + 7 of .s" cmpord" endof + endcase ; + + : dis-cmpps ( adr -- adr' ) .cmp-sse .s" ps" xm-r,r/m 1+ ; + : dis-cmpss ( adr -- adr' ) .cmp-sse .s" ss" xm-r,r/m 1+ ; + : dis-cmppd ( adr -- adr' ) .cmp-sse .s" pd" xm-r,r/m 1+ ; + : dis-cmpsd ( adr -- adr' ) .cmp-sse .s" sd" xm-r,r/m 1+ ; + + : save-adr ( adr flag -- flag adr adr ) true swap dup ; + : restore-adr ( true adr adr1 -- false adr adr adr ) + 2drop nip false swap dup dup ; + + : get-adrfl ( flag adr adr' -- adrfl flag ) + rot + if nip true + else drop false + then ; + + : ?dis-660f ( adr flag -- adr' flag ) + if save-adr 2 + count + case + $10 of .s" movupd" xm-r,r/m endof + $11 of .s" movupd" r32/m,xmmr endof + $12 of .s" movlpd" xm-r,r/m endof + $13 of .s" movlpd" r32/m,xmmr endof + $14 of .s" unpcklpd" xmmr,r32/m endof + $15 of .s" unpckhpd" xmmr,r32/m endof + $16 of .s" movhpd" xm-r,r/m endof + $17 of .s" movhpd" r32/m,xmmr endof + $28 of .s" movapd" xm-r,r/m endof + $29 of .s" movapd" r32/m,xmmr endof + $2e of .s" ucomisd" xm-r,r/m endof + $2f of .s" comisd" xm-r,r/m endof + $51 of .s" sqrtpd" xm-r,r/m endof + $54 of .s" sqrtpd" xm-r,r/m endof + $54 of .s" andpd" xm-r,r/m endof + $55 of .s" andnpd" xm-r,r/m endof + $56 of .s" orpd" xm-r,r/m endof + $57 of .s" xorpd" xm-r,r/m endof + $58 of .s" addpd" xm-r,r/m endof + $59 of .s" mulpd" xm-r,r/m endof + $5a of .s" cvtps2ps" xm-r,r/m endof + $5b of .s" cvtps2dq" xm-r,r/m endof + $5c of .s" subpd" xm-r,r/m endof + $5d of .s" minpd" xm-r,r/m endof + $5e of .s" divpd" xm-r,r/m endof + $5f of .s" maxpd" xm-r,r/m endof + $6e of .s" movd" xm-r,r/m endof + $7e of .s" movd" r32/m,xmmr endof + $6f of .s" movqda" xmmr,r32/m endof + $7f of .s" movqda" r32/m,xmmr endof + $c2 of dis-cmppd endof + $c6 of .s" shufpd" xm-r,r/m ::imm8 endof + $d7 of .s" pmovmskb" r,xmm endof + restore-adr + endcase get-adrfl + else false \ no 66 0f + then ; + + : ?dis-0f ( adr flag -- adr' flag ) + if true swap 1+ count + case + $10 of .s" movups" xm-r,r/m endof + $11 of .s" movups" r32/m,xmmr endof + $14 of .s" unpcklps" xmmr,r32/m endof + $15 of .s" unpckhps" xmmr,r32/m endof + $28 of .s" movaps" xm-r,r/m endof + $29 of .s" movaps" r32/m,xmmr endof + $2a of .s" movaps" xmmr,r32/m endof + $2e of .s" ucomisd" xm-r,r/m endof + $2f of .s" comiss" xm-r,r/m endof + $51 of .s" sqrtps" xm-r,r/m endof + $52 of .s" rsqrtps" xm-r,r/m endof + $53 of .s" rcpps" xm-r,r/m endof + $54 of .s" andps" xm-r,r/m endof + $55 of .s" andnps" xm-r,r/m endof + $56 of .s" orps" xm-r,r/m endof + $57 of .s" xorps" xm-r,r/m endof + $58 of .s" addps" xm-r,r/m endof + $59 of .s" mulps" xm-r,r/m endof + $5a of .s" cvtps2pd" xm-r,r/m endof + $5b of .s" cvtdq2ps" xm-r,r/m endof + $5c of .s" subps" xm-r,r/m endof + $5d of .s" minps" xm-r,r/m endof + $5e of .s" divps" xm-r,r/m endof + $5f of .s" maxps" xm-r,r/m endof + $c2 of dis-cmpps endof + $c6 of .s" shufps" xm-r,r/m ::imm8 endof + rot drop false -rot + endcase swap + else false \ no 0f + then ; + + : ?dis-f20f ( adr flag -- adr' flag ) + if save-adr 2 + count + case + $10 of .s" movsd" xm-r,r/m endof + $11 of .s" movsd" xm-r/m,r endof + $2a of .s" cvtsi2sd" xmmr,r32/m endof + $51 of .s" sqrtsd" xm-r,r/m endof + $52 of .s" rsqrtsd" xm-r,r/m endof + $58 of .s" addsd" xm-r,r/m endof + $59 of .s" mulsd" xm-r,r/m endof + $5a of .s" cvtsd2ss" xm-r,r/m endof + $5c of .s" subsd" xm-r,r/m endof + $5d of .s" minsd" xm-r,r/m endof + $5e of .s" divsd" xm-r,r/m endof + $5f of .s" maxsd" xm-r,r/m endof + $c2 of dis-cmpsd endof + $e6 of .s" cvtpd2dq" xmmr,r32/m endof + restore-adr + endcase get-adrfl + else false \ no f2 0f + then ; + + : ?dis-f30f ( adr flag -- adr' flag ) + if save-adr 2 + count \ f a0 a1 + case + $10 of .s" movss" xm-r,r/m endof + $11 of .s" movss" xm-r/m,r endof + $2a of .s" cvtsi2ss" xmmr,r32/m endof + $51 of .s" sqrtss" xm-r,r/m endof + $52 of .s" rsqrtss" xm-r,r/m endof + $53 of .s" rcpss" xm-r,r/m endof + $58 of .s" addss" xm-r,r/m endof + $59 of .s" mulss" xm-r,r/m endof + $5a of .s" cvtss2sd" xm-r,r/m endof + $5b of .s" cvttps2dq" xm-r/m,r endof + $5c of .s" subss" xm-r,r/m endof + $5d of .s" minss" xm-r,r/m endof + $5e of .s" divss" xm-r,r/m endof + $5f of .s" maxss" xm-r,r/m endof + $6f of .s" movdqu" xm-r,r/m endof + $7f of .s" movdqu" r32/m,xmmr endof + $c2 of dis-cmpss endof + $e6 of .s" cvtdq2pd" xmmr,r32/m endof + restore-adr + endcase get-adrfl + else false \ no f3 0f + then ; + + + : pf-coded? ( adr -- adr' flag ) + dup c@ + case + 0x66 of 0f-prefix? ?dis-660f endof + 0xf2 of 0f-prefix? ?dis-f20f endof + 0xf3 of 0f-prefix? ?dis-f30f endof + false swap + endcase ; + + : prefix-coded? ( adr -- adr' flag ) + pf-coded? + if true + else dup dup c@ 0xf = ?dis-0f + if rot drop true + else drop false + then + then ; + \ ----------------------------------------------------------------------- \ User interface *************** *** 1342,1356 **** false to dis.prefix-op \ SMuB false to dis.mem? \ rbs -- suppress commas after mem ! count ! dup 1 and to dis.size ! dup cells op1-table + @ execute ! dis.prefix-op 0= ! if dis.default-16bit? 0= ! if false to dis.16-bit-data ! false to dis.16-bit-addr ! else true to dis.16-bit-data ! true to dis.16-bit-addr ! then ! then ; 0 value next-inst --- 1578,1595 ---- false to dis.prefix-op \ SMuB false to dis.mem? \ rbs -- suppress commas after mem ! false to xmm-reg ! false to dis.mmx-reg? ! prefix-coded? not ! if count dup 1 and to dis.size ! dup cells op1-table + @ execute ! dis.prefix-op 0= ! if dis.default-16bit? 0= ! if false to dis.16-bit-data ! false to dis.16-bit-addr ! else true to dis.16-bit-data ! true to dis.16-bit-addr ! then ! then ! then ; 0 value next-inst *************** *** 1365,1369 **** dup r> 2dup - 0x10 u> abort" decompiler error" ! do i c@ 2 h.n loop ." ) " comment-col col s> type then dup to next-inst ; --- 1604,1608 ---- dup r> 2dup - 0x10 u> abort" decompiler error" ! do i c@ 2 h.n loop ." ) " comment-col col s> type then dup to next-inst ; Index: 586ASMCM.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/586ASMCM.f,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** 586ASMCM.f 16 Jan 2015 17:54:29 -0000 1.10 --- 586ASMCM.f 19 Jan 2015 13:29:37 -0000 1.11 *************** *** 15,20 **** : xmm-compile ( param -- | x \ param -- | x \ x \ param -- ) ! 0x0F code-c, (xmm-compile) ! ; : dxmm-compile ( param -- | x \ param -- | x \ x \ param -- ) --- 15,19 ---- : xmm-compile ( param -- | x \ param -- | x \ x \ param -- ) ! 0x0F code-c, (xmm-compile) ; : dxmm-compile ( param -- | x \ param -- | x \ x \ param -- ) *************** *** 79,82 **** --- 78,84 ---- split-imm-opcode over >r dxmm-compile-no-disp r> ?include-0-immed ; + : cmpsd-compile ( param -- ) + split-imm-opcode over >r true no-do-disp data-! F2-dxmm-compile r> ?include-0-immed ; + : cmpss-compile ( param -- ) split-imm-opcode over >r true no-do-disp data-! F3-dxmm-compile r> ?include-0-immed ; *************** *** 226,230 **** 0x6E ' dxmm-compile opcode cvttpd2dq - \ 0x6E ' 66-pf-compile1 opcode movd 0x6E ' movd-compile opcode movd 0x6F ' 66-dxmm-compile opcode movdqa --- 228,231 ---- *************** *** 259,262 **** --- 260,272 ---- 0xC207 ' cmpss-compile opcode cmpordss + 0xC200 ' cmpsd-compile opcode cmpeqsd + 0xC201 ' cmpsd-compile opcode cmpltsd + 0xC202 ' cmpsd-compile opcode cmplesd + 0xC203 ' cmpsd-compile opcode cmpunordsd + 0xC204 ' cmpsd-compile opcode cmpneqsd + 0xC205 ' cmpsd-compile opcode cmpnltsd + 0xC206 ' cmpsd-compile opcode cmpnlesd + 0xC207 ' cmpsd-compile opcode cmpordsd + 0xC6 ' xmm-compile-no-disp opcode shufps 0xC6 ' dxmm-compile-no-disp opcode shufpd Index: 486ASM.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/486ASM.F,v retrieving revision 1.15 retrieving revision 1.16 diff -C2 -d -r1.15 -r1.16 *** 486ASM.F 16 Jan 2015 17:54:29 -0000 1.15 --- 486ASM.F 19 Jan 2015 13:29:37 -0000 1.16 *************** *** 27,30 **** --- 27,47 ---- \ See also 586asmcm.f + also hidden + 0 value pfa-mnemonic + + : (asm-abort") ( f - ) + ((")) swap if + cr ." Coding: " last @ count type ." at " + pfa-mnemonic body> .name count type + ." in file " loadfile count -if + type space else 2drop + then ." at line " loadline dup decr @ dup . edit-error abort + else drop + then ; + + : asm-abort" ( -<string">- ) compile (asm-abort") ," ; immediate + + previous + ( declare the vocabularies needed ) *************** *** 161,164 **** --- 178,182 ---- default-size 16bit = if 32bit else 16bit then ; in-asm + : use16 ( generate 16 bit code by default ) 16bit to default-size ; *************** *** 179,188 **** ( x -- ) opstack data-@ opstack-end = dup ?clr-opstack ! abort" OPSTACK overflow" opstack dup data-@ dup cell+ rot data-! data-! ; : pop-op ( move an item from the operand stack to the parameter stack ) ( -- x ) opstack dup data-@ swap cell+ = dup ?clr-opstack ! abort" OPSTACK underflow" opstack dup data-@ cell- dup rot data-! data-@ ; in-hidden --- 197,206 ---- ( x -- ) opstack data-@ opstack-end = dup ?clr-opstack ! asm-abort" OPSTACK overflow" opstack dup data-@ dup cell+ rot data-! data-! ; : pop-op ( move an item from the operand stack to the parameter stack ) ( -- x ) opstack dup data-@ swap cell+ = dup ?clr-opstack ! asm-abort" OPSTACK underflow" opstack dup data-@ cell- dup rot data-! data-@ ; in-hidden *************** *** 199,203 **** frtable [ frmax 1+ ] literal 0 do frmax i = dup ?clr-opstack ! abort" too many unresolved forward references" dup data-@ if cell+ cell+ else 2dup data-! code-here over cell+ --- 217,221 ---- frtable [ frmax 1+ ] literal 0 do frmax i = dup ?clr-opstack ! asm-abort" too many unresolved forward references" dup data-@ if cell+ cell+ else 2dup data-! code-here over cell+ *************** *** 282,286 **** ( offset -- index ) macro-label-level data-@ + dup lbmax > ! abort" Too many local labels in macros" ; : +macro-ref ( reference a label offset from the macro level ) ( offset -- addr ) --- 300,304 ---- ( offset -- index ) macro-label-level data-@ + dup lbmax > ! asm-abort" Too many local labels in macros" ; : +macro-ref ( reference a label offset from the macro level ) ( offset -- addr ) *************** *** 684,713 **** : _?params ( are there parameters on the stack? ) sp@ sp-save data-@ - dup ?clr-opstack ! abort" offset or immediate operand not allowed with this instruction" ; ' _?params is ?params : _?seg ( is there a segment override? ) seg-prefix data-@ dup ?clr-opstack ! abort" segment override not allowed with this instruction" ; ' _?seg is ?seg : _?lock ( is there a LOCK prefix? ) inst-prefix data-@ 0f0 = dup ?clr-opstack ! abort" LOCK prefix not allowed with this instruction" ; ' _?lock is ?lock : _?rep ( is there a repeat prefix? ) inst-prefix data-@ 0f3 over = 0f2 rot = or dup ?clr-opstack ! abort" REP, etc. not allowed with this instruction" ; ' _?rep is ?rep : _?inst-pre ( is there any instruction prefix? ) inst-prefix data-@ dup ?clr-opstack ! abort" Instruction prefixes not allowed with this instruction" ; ' _?inst-pre is ?inst-pre : _?operands ( are there any operands? ) op-depth dup ?clr-opstack ! abort" operands not allowed with this instruction" ; ' _?operands is ?operands --- 702,731 ---- : _?params ( are there parameters on the stack? ) sp@ sp-save data-@ - dup ?clr-opstack ! asm-abort" offset or immediate operand not allowed with this instruction" ; ' _?params is ?params : _?seg ( is there a segment override? ) seg-prefix data-@ dup ?clr-opstack ! asm-abort" segment override not allowed with this instruction" ; ' _?seg is ?seg : _?lock ( is there a LOCK prefix? ) inst-prefix data-@ 0f0 = dup ?clr-opstack ! asm-abort" LOCK prefix not allowed with this instruction" ; ' _?lock is ?lock : _?rep ( is there a repeat prefix? ) inst-prefix data-@ 0f3 over = 0f2 rot = or dup ?clr-opstack ! asm-abort" REP, etc. not allowed with this instruction" ; ' _?rep is ?rep : _?inst-pre ( is there any instruction prefix? ) inst-prefix data-@ dup ?clr-opstack ! asm-abort" Instruction prefixes not allowed with this instruction" ; ' _?inst-pre is ?inst-pre : _?operands ( are there any operands? ) op-depth dup ?clr-opstack ! asm-abort" operands not allowed with this instruction" ; ' _?operands is ?operands *************** *** 715,719 **** ( n -- ) ?dup if dt-size data-@ ?dup if - dup ?clr-opstack ! abort" operand size mismatched" else dt-size data-! then then ; : _?opsize2 ( just store the operand size ) ( n -- ) --- 733,737 ---- ( n -- ) ?dup if dt-size data-@ ?dup if - dup ?clr-opstack ! asm-abort" operand size mismatched" else dt-size data-! then then ; : _?opsize2 ( just store the operand size ) ( n -- ) *************** *** 724,728 **** ( n -- ) ?dup if ad-size data-@ ?dup if - dup ?clr-opstack ! abort" address size mismatched" else ad-size data-! then then ; : _?adsize2 ( just store the address size ) ( n -- ) --- 742,746 ---- ( n -- ) ?dup if ad-size data-@ ?dup if - dup ?clr-opstack ! asm-abort" address size mismatched" else ad-size data-! then then ; : _?adsize2 ( just store the address size ) ( n -- ) *************** *** 733,737 **** ( -- ) ad-size data-@ 8bit = dup ?clr-opstack ! abort" SHORT not allowed with this instruction" ; ' _?short is ?short --- 751,755 ---- ( -- ) ad-size data-@ 8bit = dup ?clr-opstack ! asm-abort" SHORT not allowed with this instruction" ; ' _?short is ?short *************** *** 743,747 **** ( flag -- ) dup ?clr-opstack ! abort" branch offset too big to fit specified width" ; ' _?toofar is ?toofar --- 761,765 ---- ( flag -- ) dup ?clr-opstack ! asm-abort" branch offset too big to fit specified width" ; ' _?toofar is ?toofar *************** *** 749,753 **** ( -- ) frtable frmax 0 do dup data-@ dup ?clr-opstack ! abort" unresolved forward reference" cell+ cell+ loop drop ; ' _?unres is ?unres --- 767,771 ---- ( -- ) frtable frmax 0 do dup data-@ dup ?clr-opstack ! asm-abort" unresolved forward reference" cell+ cell+ loop drop ; ' _?unres is ?unres *************** *** 755,759 **** ( -- ) clr-opstack -1 ! abort" no or unknown address size" ; ' _?noadsize is ?noadsize --- 773,777 ---- ( -- ) clr-opstack -1 ! asm-abort" no or unknown address size" ; ' _?noadsize is ?noadsize *************** *** 761,765 **** ( max allowed operands -- ) op-depth < dup ?clr-opstack ! abort" too many operands" ; ' _?toomanyops is ?toomanyops --- 779,783 ---- ( max allowed operands -- ) op-depth < dup ?clr-opstack ! asm-abort" too many operands" ; ' _?toomanyops is ?toomanyops *************** *** 767,771 **** ( -- ) ad-size data-@ 32bit = dup ?clr-opstack ! abort" FAR references not allowed with this instruction" ; ' _?nofar is ?nofar --- 785,789 ---- ( -- ) ad-size data-@ 32bit = dup ?clr-opstack ! asm-abort" FAR references not allowed with this instruction" ; ' _?nofar is ?nofar *************** *** 773,777 **** ( flag -- ) dup ?clr-opstack ! abort" operand mismatch" ; : _?match ( error if the parameters match ) --- 791,795 ---- ( flag -- ) dup ?clr-opstack ! asm-abort" operand mismatch" ; : _?match ( error if the parameters match ) *************** *** 788,792 **** ( -- ) op-depth dup ?clr-opstack ! abort" unconsumed operands" ; ' _?finished is ?finished --- 806,810 ---- ( -- ) op-depth dup ?clr-opstack ! asm-abort" unconsumed operands" ; ' _?finished is ?finished *************** *** 794,798 **** ( max type allowed -- ) maxtype data-@ < dup ?clr-opstack ! abort" addressing mode not allowed" ; ' _?badtype is ?badtype --- 812,816 ---- ( max type allowed -- ) maxtype data-@ < dup ?clr-opstack ! asm-abort" addressing mode not allowed" ; ' _?badtype is ?badtype *************** *** 800,804 **** ( flag -- ) dup ?clr-opstack ! abort" illegal operand combination" ; ' _?badcombine is ?badcombine --- 818,822 ---- ( flag -- ) dup ?clr-opstack ! asm-abort" illegal operand combination" ; ' _?badcombine is ?badcombine *************** *** 806,815 **** ( n -- ) op-depth > dup ?clr-opstack ! abort" not enough operands" ; ' _?notenough is ?notenough : _?noimmed ( is there an illegal immediate operand? ) ( -- ) has-immed? dup ?clr-opstack ! abort" immediate operands not allowed with this instruction" ; ' _?noimmed is ?noimmed --- 824,833 ---- ( n -- ) op-depth > dup ?clr-opstack ! asm-abort" not enough operands" ; ' _?notenough is ?notenough : _?noimmed ( is there an illegal immediate operand? ) ( -- ) has-immed? dup ?clr-opstack ! asm-abort" immediate operands not allowed with this instruction" ; ' _?noimmed is ?noimmed *************** *** 817,821 **** ( flag -- ) dup ?clr-opstack ! abort" illegal address mode" ; ' _?badmode is ?badmode --- 835,839 ---- ( flag -- ) dup ?clr-opstack ! asm-abort" illegal address mode" ; ' _?badmode is ?badmode *************** *** 823,827 **** ( -- ) direction? 0= mod-r/m data-@ 0c0 < and dup ?clr-opstack ! abort" destination must be a register" ; ' _?reg,r/m is ?reg,r/m --- 841,845 ---- ( -- ) direction? 0= mod-r/m data-@ 0c0 < and dup ?clr-opstack ! asm-abort" destination must be a register" ; ' _?reg,r/m is ?reg,r/m *************** *** 829,833 **** ( -- ) direction? mod-r/m data-@ 0c0 < and dup ?clr-opstack ! abort" source must be a register" ; ' _?r/m,reg is ?r/m,reg --- 847,851 ---- ( -- ) direction? mod-r/m data-@ 0c0 < and dup ?clr-opstack ! asm-abort" source must be a register" ; ' _?r/m,reg is ?r/m,reg *************** *** 835,839 **** ( -- ) mod-r/m data-@ 0bf > maybe-has-offset? 0= and dup ?clr-opstack ! abort" instruction requires a memory operand" ; ' _?mem is ?mem --- 853,857 ---- ( -- ) mod-r/m data-@ 0bf > maybe-has-offset? 0= and dup ?clr-opstack ! asm-abort" instruction requires a memory operand" ; ' _?mem is ?mem *************** *** 841,845 **** ( -- ) mod-r/m data-@ 0c0 < has-offset? or dup ?clr-opstack ! abort" this instruction may only use registers" ; ' _?reg is ?reg --- 859,863 ---- ( -- ) mod-r/m data-@ 0c0 < has-offset? or dup ?clr-opstack ! asm-abort" this instruction may only use registers" ; ' _?reg is ?reg *************** *** 936,939 **** --- 954,958 ---- : inst-pre create data-, does> data-@ inst-prefix data-! ; in-asm + 2e seg-pre cs: 36 seg-pre ss: *************** *** 956,959 **** --- 975,979 ---- sp@ sp-save data-@ swap - cell/ ; + also hidden ( create an assembly mnemonic ) : compile-opcode ( compile the bytes in an opcode ) *************** *** 964,969 **** ( offset 1 -- parameter used to generate the code ) ?dup if ! dup cell+ data-@ swap data-@ register-asm execute then ; defer save-inst ( save the current instruction -- used in postfix mode ) --- 984,990 ---- ( offset 1 -- parameter used to generate the code ) ?dup if ! dup to pfa-mnemonic dup cell+ data-@ swap data-@ register-asm execute then ; + previous defer save-inst ( save the current instruction -- used in postfix mode ) *************** *** 1796,1814 **** : no-xmm-move ( opcode - opcode flag ) ! dup 29 <> over 7F <> and ! over 11 <> and over 13 <> and over 17 <> and over D7 <> and ; : xmm-to-xmm ( opcode - opcode flag ) dup C2 = over C6 = or ; \ case: cmpss shufps shufpd ! : no-xmm-to-xmm? ( - flag ) mod-r/m data-@ FC <> ; : xmm-to-m ( opcode - opcode flag ) dup 13 = over 17 = or ; \ case: movhpd movlpd ! : no-xmm-to-m ( - flag ) mod-r/m data-@ dup C0 <> over C1 <> and over 1 <> and swap 0B <> and ; : m-to-xmm ( opcode - opcode flag ) dup 12 = over 16 = or ; \ case: movhpd movlpd ! : no-m-to-xmm ( - flag ) mod-r/m data-@ dup C1 <> over 13 <> and over 1 <> and swap 0 <> and ; ! : r32? ( - flag ) mod-r/m data-@ dup D3 = over CB = or over D9 = or over DA = or swap DB = or ; ! : not-to-r32? ( - flag ) mod-r/m data-@ DA <> ; : (xmm-compile) ( param -- | x \ param -- | x \ x \ param -- ) --- 1817,1844 ---- : no-xmm-move ( opcode - opcode flag ) ! dup 29 <> over 7F <> and over 13 <> and over 17 <> and over D7 <> and ; + : xmm-to-xmm ( opcode - opcode flag ) dup C2 = over C6 = or ; \ case: cmpss shufps shufpd ! : no-xmm-to-xmm? ( - flag ) mod-r/m data-@ dup FC <> swap CA <> and ; : xmm-to-m ( opcode - opcode flag ) dup 13 = over 17 = or ; \ case: movhpd movlpd ! : no-xmm-to-m ( - flag ) mod-r/m data-@ dup C0 <> over C1 <> and ! over 1 <> and swap 0B <> and ; : m-to-xmm ( opcode - opcode flag ) dup 12 = over 16 = or ; \ case: movhpd movlpd ! : no-m-to-xmm ( - flag ) mod-r/m data-@ dup C1 <> over 13 <> and ! over 1 <> and swap 0 <> and ; ! : r32? ( - flag ) mod-r/m data-@ dup D3 = over C3 = or over C0 = or ! over C1 = or over C2 = or over CB = or over D9 = or ! over DA = or swap DB = or ; ! ! : no-r32-check ( opcode - opcode flag ) dup D7 <> over 13 <> and over 17 <> and over 57 <> and ! over 58 <> and ; ! ! : not-to-r32? ( - flag ) mod-r/m data-@ dup DA <> over C7 <> and over CF <> and ! over D7 <> and swap DF <> and ; : (xmm-compile) ( param -- | x \ param -- | x \ x \ param -- ) *************** *** 1819,1827 **** endif endif ?noimmed ! xmm-to-xmm no-xmm-to-xmm? and ABORT" Operand must be xmmreg,xmmreg" ! no-xmm-move xmm-dir? and ABORT" Operand r/m,xmmreg not allowed" ! dup D7 = not-to-r32? and ABORT" Operand must be r32,xmmreg." \ case: pmovmskb ! xmm-to-m no-xmm-to-m and ABORT" Operand must be m,xmmreg." ! m-to-xmm no-m-to-xmm and ABORT" Operand must be xmmreg,m." code-c, compile-fields ; --- 1849,1858 ---- endif endif ?noimmed ! xmm-to-xmm no-xmm-to-xmm? and asm-abort" Operand must be xmmreg,xmmreg" ! no-xmm-move xmm-dir? and asm-abort" Operand r/m,xmmreg not allowed" ! dup D7 = not-to-r32? and asm-abort" Operand must be r32,xmmreg." \ case: pmovmskb ! xmm-to-m no-xmm-to-m and asm-abort" Operand must be m,xmmreg." ! m-to-xmm no-m-to-xmm and asm-abort" Operand must be xmmreg,m." ! no-r32-check r32? and asm-abort" Operand r32 not allowed." code-c, compile-fields ; *************** *** 1832,1836 **** if 0x10 or endif ! endif ?noimmed r32? ABORT" Operand r32 not allowed." code-c, compile-fields ; --- 1863,1867 ---- if 0x10 or endif ! endif ?noimmed r32? asm-abort" Operand r32 not allowed." code-c, compile-fields ; *************** *** 2273,2275 **** --- 2304,2307 ---- only forth definitions base ! + \s |
