![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to disasm.fs CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [gforth] / gforth / arch / 386|
Return to disasm.fs CVS log | Up to [gforth] / gforth / arch / 386 |
1.2 anton 1: \ 80386 Disassembler
2: \ Andrew McKewan, April 1994
3: \ Tom Zimmer, 05/18/94 port to Win32f
4: \ Modified to word in decimal 08/03/94 10:04 tjz
5: \ 06-??-95 SMuB NEXT sequence defined in FKERNEL
6: \ 06-21-95 SMuB removed redundant COUNT calls from txb, lxs.
7: \ 04-??-97 Extended by C.L. to include P6 and MMX instructions
8:
9: \ cr .( Loading 80486 Disassembler...)
10:
11: \ Gforth stuff
12:
13: 260 chars constant maxstring
14:
15: 128 CONSTANT SPCS-MAX ( optimization for SPACES )
16:
17: CREATE SPCS SPCS-MAX ALLOT
18: SPCS SPCS-MAX BLANK
19:
20: 255 CONSTANT MAXCOUNTED \ maximum length of contents of a counted string
21:
22: \ : cincr ( c-addr -- )
23: \ dup c@ 1+ swap c! ;
24:
25: \ : C+PLACE ( c1 a1 -- ) \ append char c1 to the counted string at a1
26: \ dup cincr count + 1- c! ;
27:
28: : (D.) ( d -- addr len ) TUCK DABS <# #S ROT SIGN #> ;
29:
30: \ : nfa-count ( nfa -- addr u )
31: \ name>string ;
32:
1.8 ! pazsan 33: [IFUNDEF] w@
1.2 anton 34: : w@ ( addr -- w )
35: @ $ffff and ;
1.8 ! pazsan 36: [THEN]
1.2 anton 37:
38: : col ( n -- ) drop space ;
39:
40: \ original stuff
41:
42: only forth also definitions
43:
44: 0 value default-16bit?
45:
46: : default-16bit ( -- )
47: true to default-16bit? ;
48:
49: : default-32bit ( -- )
50: false to default-16bit? ;
51:
52: defer show-name ( cfa -- ) \ display nearest symbol
53: ' abort is show-name
54:
55: 0 value base-addr
56:
57: vocabulary disassembler
58: disassembler also definitions
59:
60: decimal
61:
62: create s-buf MAXSTRING allot
63:
64: : >s ( a1 n1 -- )
65: s-buf +place ;
66:
67: : 0>s ( -- ) \ reset s-buf
68: s-buf off ;
69:
70: : sspaces ( n1 -- )
1.3 anton 71: 0 max spcs swap s-buf +place ;
1.2 anton 72:
73: : sspace ( -- )
74: 1 sspaces ;
75:
76: \ : emit>s ( c1 -- )
77: \ s-buf c+place ;
78:
79: \ : s> ( -- a1 n1 )
80: \ s-buf count ;
81:
82: : .s" ( 'text' -- )
83: [char] " parse POSTPONE sliteral POSTPONE s-buf POSTPONE +place ; immediate
84:
85: : d.r>s ( d w -- )
86: >r (d.) r> over - sspaces >s ;
87:
88: : .r>s ( n w -- )
89: >r s>d r> d.r>s ;
90:
91: \ : u.r>s ( u w -- )
92: \ 0 swap d.r>s ;
93:
94: : h.>s ( u -- )
95: base @ swap hex 0 (d.) >s sspace base ! ;
96:
97: \ : h.r>s ( n1 n2 -- )
98: \ base @ >r hex >r
99: \ 0 <# #s #> r> over - sspaces >s
100: \ r> base ! ;
101:
102: \ : .id>s ( nfa -- )
103: \ nfa-count >s sspace ;
104:
105: \ : .name>s ( xt -- )
106: \ dup >name dup 0= \ if not found
107: \ if drop [char] " emit>s .s" 0x" 1 h.r>s [char] " emit>s sspace
108: \ else .id>s drop
109: \ then ;
110:
111: \ : ?.name>s ( cfa -- )
112: \ \ eliminate " 0x"
113: \ dup ?name ?dup
114: \ if .name>s
115: \ else dup 1 h.r>s sspace
116: \ then drop ;
117:
118: \ ' ?.name>s is show-name
119: ' h.>s is show-name
120:
121: 32 constant comment-col
122:
123: 0 value size
124: 0 value 16-bit-data
125: 0 value 16-bit-addr
126: 0 value prefix-op
127: 0 value mmx-reg
128:
129: : @+ ( addr -- addr n ) dup cell+ swap @ ;
130: : W@+ ( addr -- addr n ) dup 2 + swap W@ ;
131:
132: : sext ( byte -- n ) dup $80 and if $FFFFFF00 or then ;
133: : mod/sib ( mod-r-r/m -- r/m r mod ) \ r including general, special, segment, MMX
134: ( mod-op-r/m -- r/m op mod )
135: ( s-i-b -- b i s )
136: 255 and 8 /mod 8 /mod ;
137:
138: : ??? ( n1 -- )
139: .s" ??? " drop ;
140:
141: : ss. ( n adr len w ) >r drop swap r@ * + r> >s sspace ;
142:
143: : tttn ( code -- ) 15 and S" o nob aee nebea s nsp npl geleg " 2 ss. ;
144:
145: : sreg ( sreg -- ) 3 rshift 7 and S" escsssdsfsgsXXXX" 2 ss. ;
146: : creg ( eee -- ) 3 rshift 7 and S" cr0???cr2cr3cr4?????????" 3 ss. ;
147: : dreg ( eee -- ) 3 rshift 7 and S" dr0dr1dr2dr3??????dr6dr7" 3 ss. ;
148: : treg ( eee -- ) 3 rshift 7 and S" ?????????tr3tr4tr5tr6tr7" 3 ss. ; \ obsolete
149: : mreg ( n -- ) 7 and S" mm0mm1mm2mm3mm4mm5mm6mm7" 3 ss. ;
150:
151: : reg8 ( n -- ) 7 and S" alcldlblahchdhbh" 2 ss. ;
152: : reg16 ( n -- ) 7 and S" axcxdxbxspbpsidi" 2 ss. ;
153: : reg32 ( n -- ) 7 and S" eaxecxedxebxespebpesiedi" 3 ss. ;
154: : reg16/32 ( n -- )
155: 16-bit-data
156: if reg16
157: else reg32
158: then ;
159: : reg ( a n -- a )
160: mmx-reg
161: if mreg
162: else size
163: if reg16/32
164: else reg8
165: then
166: then ;
167:
168: : [base16] ( r/m -- ) 4 - S" [si][di][bp][bx]" 4 ss. ;
169: \ r/m = 4 , 5 , 6 , 7
170: : [ind16] ( r/m -- ) S" [bx+si][bx+di][bp+si][bp+di]" 7 ss. ;
171: \ r/m = 0 , 1 , 2 , 3
172: : [reg16] ( r/m -- ) dup 4 <
173: if [ind16]
174: else [base16]
175: then ;
176: : [reg32] ( n -- ) 7 and S" [eax][ecx][edx][ebx][esp][ebp][esi][edi]" 5 ss. ;
177:
178: \ : [reg] ( r/m -- ) 16-bit-addr
179: \ if [reg16]
180: \ else [reg32]
181: \ then sspace ;
182:
183: \ : [reg] ( n -- )
184: \ 7 and
185: \ 16-bit-addr
186: \ if S" [bx+si] [bx+di] [bp+si] [bp+di] [si] [di] [bp] [bx]"
187: \ rot 0
188: \ ?do bl skip bl scan
189: \ loop bl skip 2dup bl scan nip - >s 2 sspaces
190: \ else S" [eax][ecx][edx][ebx][esp][ebp][esi][edi]" 5 ss. sspace
191: \ then ;
192:
193: : [reg*2] ( i -- ) S" [eax*2][ecx*2][edx*2][ebx*2][XXX*2][ebp*2][esi*2][edi*2]" 7 ss. ;
194: : [reg*4] ( i -- ) S" [eax*4][ecx*4][edx*4][ebx*4][XXX*4][ebp*4][esi*4][edi*4]" 7 ss. ;
195: : [reg*8] ( i -- ) S" [eax*8][ecx*8][edx*8][ebx*8][XXX*8][ebp*8][esi*8][edi*8]" 7 ss. ;
196: : [index] ( sib -- ) mod/sib over 4 =
197: if 2drop \ no esp scaled index
198: else case ( s )
199: 0 of [reg32] endof
200: 1 of [reg*2] endof
201: 2 of [reg*4] endof
202: 3 of [reg*8] endof
203: endcase
204: then drop ;
205:
206: : disp8 ( adr -- adr' ) count h.>s ;
207: : disp16 ( adr -- adr' ) w@+ show-name ;
208: : disp32 ( adr -- adr' ) @+ ( body> ) show-name ;
209: : disp16/32 ( adr -- adr' )
210: 16-bit-addr
211: if disp16
212: else disp32
213: then ;
214:
215: : ., ( -- ) .s" , " ;
216:
217: : .# ., .s" # " ;
218:
219: : imm8 ( adr -- adr' ) .# count h.>s ;
220:
221: \ : imm16 ( adr -- adr' ) .# w@+ h.>s ;
222:
223: : imm16/32 ( adr -- adr' )
224: .# 16-bit-data
225: IF w@+
226: ELSE @+
227: THEN h.>s ;
228:
229: : sib ( adr mod -- adr )
230: >r count tuck 7 and 5 = r@ 0= and
231: if disp32 swap [index] r> drop \ ebp base and mod = 00
232: else r> case ( mod )
233: 1 of disp8 endof
234: 2 of disp32 endof
235: endcase
236: swap dup [reg32] [index]
237: then ;
238:
239: \ : [*] ( sib -- )
240: \ .s" sib = " h.>s ;
241:
242: \ : sib ( adr ext -- adr' )
243: \ ?? wrong version
244: \ swap count >r swap 6 rshift 3 and
245: \ ?dup if 1 = if disp8 else disp32 then then
246: \ r> dup 7 and dup 5 =
247: \ if drop [*]
248: \ else [reg]
249: \ dup $38 and $20 =
250: \ if drop
251: \ else .s" [" dup 3 rshift reg32 -1 s-buf c+!
252: \ 5 rshift 6 and
253: \ dup 6 = if 2 + then
254: \ ?dup if .s" *" 0 .r>s then .s" ] "
255: \ then
256: \ then ;
257:
258: : mod-r/m32 ( adr r/m mod -- adr' )
259: dup 3 =
260: if drop reg \ mod = 3, register case
1.5 pazsan 261: else size IF 16-bit-data 0= IF .s" d" THEN .s" word"
262: ELSE .s" byte" THEN .s" ptr "
263: over 4 =
1.2 anton 264: if nip sib \ r/m = 4, sib case
265: else 2dup 0= swap 5 = and \ mod = 0, r/m = 5,
266: if 2drop disp32 \ disp32 case
267: else rot swap
268: case ( mod )
269: 1 of disp8 endof
270: 2 of disp32 endof
271: endcase
272: swap [reg32]
273: then
274: then
275: then ;
276:
277: : mod-r/m16 ( adr r/m mod -- adr' )
278: 2dup 0= swap 6 = and
279: if 2drop disp16 \ disp16 case
280: else case ( mod )
281: 0 of [reg16] endof
282: 1 of swap disp8 swap [reg16] endof
283: 2 of swap disp16 swap [reg16] endof
284: 3 of reg endof
285: endcase
286: then ;
287:
288: : mod-r/m ( adr modr/m -- adr' )
289: mod/sib nip 16-bit-addr
290: if mod-r/m16
291: else mod-r/m32
292: then ;
293:
294: \ : mod-r/m ( adr ext -- adr' )
295: \ dup 0xC7 and 5 = \ 32bit displacement
296: \ 16-bit-addr 0= and \ and not 16bit addressing
297: \ if drop disp32 .s" [] "
298: \ EXIT
299: \ then
300: \ dup 0xC0 and 0xC0 < over 7 and 4 = and
301: \ 16-bit-addr 0= and \ and not 16bit addressing
302: \ if sib
303: \ EXIT
304: \ then
305: \ dup 0xC7 and 6 = \ 16bit displacement
306: \ 16-bit-addr and \ and 16bit addressing
307: \ if drop disp32 .s" [] "
308: \ EXIT
309: \ then
310: \ dup 6 rshift
311: \ case
312: \ 0 of .s" 0 " [reg] endof
313: \ 1 of swap disp8 swap [reg] endof
314: \ 2 of swap disp32 swap [reg] endof
315: \ 3 of reg endof
316: \ endcase ;
317:
318:
319:
320:
321: : r/m8 0 to size mod-r/m ;
322: : r/m16/32 1 to size mod-r/m ;
323: : r/m16 true to 16-bit-data r/m16/32 ;
324:
325: : r,r/m ( adr -- adr' )
326: count dup 3 rshift reg ., mod-r/m ;
327:
328: : r/m,r ( adr -- adr' )
329: count dup >r mod-r/m ., r> 3 rshift reg ;
330:
331: : r/m ( adr op -- adr' )
332: 2 and if r,r/m else r/m,r then ;
333:
334: \ -------------------- Simple Opcodes --------------------
335:
336: : inh ( -<name>- )
337: create
338: bl word count here place
339: here c@ 1+ allot
340: does> count >s sspace drop ;
341:
342: inh clc clc
343: inh stc stc
344: inh cld cld
345: inh std std
346: \ inh rpnz repnz
347: \ inh repz repz
348: inh cbw cbw
349: inh cdq cdq
350: inh daa daa
351: inh das das
352: inh aaa aaa
353: inh aas aas
354: \ inh lock lock
355: inh inb insb
356: inh osb outsb
357: inh sah sahf
358: inh lah lahf
359: \ inh aam aam
360: \ inh aad aad
361: inh hlt hlt
362: inh cmc cmc
363: inh xlt xlat
364: inh cli cli
365: inh sti sti
366:
367: inh clt clts
368: inh inv invd
369: inh wiv wbinvd
370: inh ud2 ud2
371: inh wmr wrmsr
372: inh rtc rdtsc
373: inh rmr rdmsr
374: inh rpc rdpmc
375: inh ems emms
376: inh rsm rsm
377: inh cpu cpuid
378: inh ud1 ud1
379: \ inh lss lss
380: \ inh lfs lfs
381: \ inh lgs lgs
382:
383: \ inh d16: d16:
384: \ inh a16: a16:
385: \ inh es: es:
386: \ inh cs: cs:
387: \ inh ds: ds:
388: \ inh fs: fs:
389: \ inh gs: gs:
390:
391: : aam ( adr code -- adr' )
392: .s" aam" drop count drop ;
393:
394: : aad ( adr code -- adr' )
395: .s" aad" drop count drop ;
396:
397: : d16 ( adr code -- adr' )
398: drop .s" d16:"
399: true to 16-bit-data
400: true to prefix-op
401: ;
402:
403: : a16 ( adr code -- adr' )
404: drop .s" a16:"
405: true to 16-bit-addr
406: true to prefix-op
407: ;
408:
409: : rpz ( adr code -- adr' )
410: drop .s" repnz"
411: true to prefix-op
412: ;
413:
414: : rep ( adr code -- adr' )
415: drop .s" repz"
416: true to prefix-op
417: ;
418:
419: : lok ( adr code -- adr' ) \ This should have error checking added
420: drop .s" lock"
421: true to prefix-op
422: ;
423:
424: : cs: ( adr code -- adr' )
425: drop .s" cs:"
426: true to prefix-op
427: ;
428:
429: : ds: ( adr code -- adr' )
430: drop .s" ds:"
431: true to prefix-op
432: ;
433:
434: : ss: ( adr code -- adr' )
435: drop .s" ss:"
436: true to prefix-op
437: ;
438:
439: : es: ( adr code -- adr' )
440: drop .s" es:"
441: true to prefix-op
442: ;
443:
444: : gs: ( adr code -- adr' )
445: drop .s" gs:"
446: true to prefix-op
447: ;
448:
449: : fs: ( adr code -- adr' )
450: drop .s" fs:"
451: true to prefix-op
452: ;
453:
454: : isd ( adr code -- adr' )
455: drop 16-bit-data
456: IF .s" insw "
457: ELSE .s" insd "
458: THEN ;
459:
460: : osd ( adr code -- adr' )
461: drop 16-bit-data
462: IF .s" outsw "
463: ELSE .s" outsd "
464: THEN ;
465:
466: : inp ( addr code -- addr' )
467: .s" in " 1 and
468: IF 16-bit-data
469: IF .s" ax , "
470: ELSE .s" eax , "
471: THEN
472: ELSE .s" al , "
473: THEN
474: count h.>s ;
475:
476: : otp ( addr code -- addr' )
477: .s" out " 1 and
478: IF count h.>s 16-bit-data
479: IF .s" , ax"
480: ELSE .s" , eax"
481: THEN
482: ELSE count h.>s .s" , al"
483: THEN
484: ;
485:
486: : ind ( addr code -- addr' )
487: .s" in " 1 and
488: IF 16-bit-data
489: IF .s" ax , dx"
490: ELSE .s" eax , dx"
491: THEN
492: ELSE .s" al , dx"
493: THEN
494: ;
495:
496: : otd ( addr code -- addr' )
497: .s" out " 1 and
498: IF 16-bit-data
499: IF .s" dx , ax"
500: ELSE .s" dx , eax"
501: THEN
502: ELSE .s" dx , al"
503: THEN
504: ;
505:
506: \ -------------------- ALU Opcodes --------------------
507:
508: : .alu ( n -- )
509: 7 and S" addor adcsbbandsubxorcmp" 3 ss. 4 sspaces ;
510:
511: : alu ( adr op -- adr' )
512: dup 3 rshift .alu r/m ;
513:
514: : ali ( adr op -- adr' )
515: >r count
516: dup 3 rshift .alu
517: mod-r/m
518: r> 3 and ?dup
519: if 1 =
520: if imm16/32
1.3 anton 521: else .# count sext 0 .r>s sspace
1.2 anton 522: then
523: else imm8
524: then ;
525:
526: : ala ( adr op -- adr' )
527: dup 3 rshift .alu
528: 1 and if 0 reg imm16/32 else 0 reg8 imm8 then ;
529:
530:
531: \ -------------------- Test/Xchg --------------------
532:
533: : txb ( addr op -- addr' )
534: dup 3 and S" testtestxchgxchg" 4 ss. 3 sspaces
535: 1 and
536: IF 1 to size r,r/m \ SMuB removed COUNT
537: ELSE 0 to size r,r/m \ SMuB removed COUNT
538: THEN
539: ;
540:
541: : tst ( addr op -- addr' )
542: .s" test " 1 and
543: IF 16-bit-data
544: IF .s" ax , "
545: ELSE .s" eax , "
546: THEN
547: imm16/32
548: ELSE .s" al , " imm8
549: THEN
550: ;
551:
552: \ -------------------- Inc/Dec ----------------------
553:
554: : inc ( addr op -- addr' )
555: .s" inc " reg16/32 ;
556:
557: : dec ( addr op -- addr' )
558: .s" dec " reg16/32 ;
559:
560:
561: \ -------------------- Push/Pop --------------------
562:
563: : psh ( addr op -- addr' )
564: .s" push " reg16/32 ;
565:
566: : pop ( addr op -- addr' )
567: .s" pop " reg16/32 ;
568:
569: : pss ( addr op -- addr' )
570: .s" push " sreg ;
571:
572: : pps ( addr op -- addr' )
573: .s" pop " sreg ;
574:
575: : psa ( addr op -- addr' )
576: drop 16-bit-data
577: IF .s" pusha "
578: ELSE .s" pushad "
579: THEN ;
580:
581: : ppa ( addr op -- addr' )
582: drop 16-bit-data
583: IF .s" popa "
584: ELSE .s" popad "
585: THEN ;
586:
587: : psi ( addr op -- addr' )
588: .s" push " 2 and
589: IF imm8
590: ELSE imm16/32
591: THEN ;
592:
593: : psf ( addr op -- addr' )
594: drop 16-bit-data
595: IF .s" pushf "
596: ELSE .s" pushfd "
597: THEN ;
598:
599: : ppf ( addr op -- addr' )
600: drop 16-bit-data
601: IF .s" popf "
602: ELSE .s" popfd "
603: THEN ;
604:
605: : 8F. ( addr op -- addr' )
606: drop count .s" pop " r/m16/32 ;
607:
608: \ -------------------- Move --------------------
609:
610: : mov ( addr op -- addr' )
611: .s" mov " r/m ;
612:
613: : mri ( addr op -- addr' ) ( mov register, imm )
614: .s" mov " dup 8 and
615: IF reg16/32 imm16/32
616: ELSE reg8 imm8
617: THEN ;
618:
619: : mvi ( adr op -- adr' ) ( mov mem, imm )
620: .s" mov " drop count mod-r/m
621: size
622: IF imm16/32
623: ELSE imm8
624: THEN
625: ;
626:
627: : mrs ( addr op -- addr' )
628: \ ? remove redundant >r , r>
629: 16-bit-data
630: IF .s" mov " drop
631: 1 to size
632: count dup mod-r/m .,
633: sreg
634: ELSE ???
635: THEN ;
636:
637: : msr ( addr op -- addr' )
638: 16-bit-data
639: IF .s" mov " drop
640: 1 to size
641: count dup sreg .,
642: mod-r/m
643: ELSE ???
644: THEN ;
645:
646: : mrc ( addr op -- addr' )
647: .s" mov "
648: drop count dup reg32 .s" , "
649: creg ;
650:
651: : mcr ( addr op -- addr' )
652: .s" mov "
653: drop count dup creg .s" , "
654: reg32 ;
655:
656: : mrd ( addr op -- addr' )
657: .s" mov "
658: drop count dup reg32 .s" , "
659: dreg ;
660:
661: : mdr ( addr op -- addr' )
662: .s" mov "
663: drop count dup dreg .s" , "
664: reg32 ;
665:
666: : mrt ( addr op -- addr' )
667: \ obsolete
668: .s" mov "
669: drop count dup reg32 .s" , "
670: treg ;
671:
672: : mtr ( addr op -- addr' )
673: \ obsolete
674: .s" mov "
675: drop count dup treg .s" , "
676: reg32 ;
677:
678: : mv1 ( addr op -- addr' )
679: .s" mov " 1 and
680: IF 16-bit-data
681: IF .s" ax , "
682: ELSE .s" eax , "
683: THEN
684: ELSE .s" al , "
685: THEN
686: disp16/32 ;
687:
688: : mv2 ( addr op -- addr' )
1.4 anton 689: >r .s" mov " disp16/32 .,
690: r> 1 and
1.2 anton 691: IF 16-bit-data
692: IF .s" ax"
693: ELSE .s" eax"
694: THEN
695: ELSE .s" al"
696: THEN
697: ;
698:
699: : lea ( addr op -- addr' )
700: .s" lea " drop 1 to size r,r/m ;
701:
702: : lxs ( addr op -- addr' )
703: 1 and
704: IF .s" lds "
705: ELSE .s" les "
706: THEN
707: r,r/m \ SMuB removed COUNT
708: ;
709:
710: : bnd ( addr op -- addr' )
711: .s" bound " drop 1 to size r,r/m ;
712:
713: : arp ( addr op -- addr' )
714: .s" arpl " drop
715: 1 to size
716: true to 16-bit-data
717: r,r/m
718: ;
719:
720: : mli ( addr op -- addr' )
721: 1 to size
722: .s" imul " $69 =
723: IF r,r/m imm16/32
724: ELSE r,r/m imm8
725: THEN ;
726:
727: \ -------------------- Jumps and Calls --------------------
728:
729: : rel8 ( addr op -- addr' )
730: count sext over + h.>s ;
731:
732: : rel16/32 ( addr op -- addr' )
733: 16-bit-addr
734: IF w@+
735: ELSE @+
736: THEN over + base-addr - show-name ;
737:
738: : jsr ( addr op -- addr' )
739: .s" call " drop rel16/32 ;
740:
741: : jmp ( addr op -- addr' )
742: .s" jmp " 2 and if rel8 else rel16/32 then ;
743:
744: : .jxx ( addr op -- addr' )
745: .s" j" tttn 4 sspaces ;
746:
747: : bra ( addr op -- addr' )
748: .jxx rel8 ;
749:
750: : lup ( addr op -- addr' )
751: 3 and S" loopnzloopz loop jecxz " 6 ss. 1 sspaces rel8 ;
752:
753: : lbr ( addr op -- addr' )
754: .jxx rel16/32 ;
755:
756: : rtn ( addr op -- addr' )
757: .s" ret near " 1 and 0=
758: IF w@+ h.>s
759: THEN ;
760:
761: : rtf ( addr op -- addr' )
762: .s" ret far " 1 and 0=
763: IF w@+ h.>s
764: THEN ;
765:
766: : ent ( addr op -- addr' )
1.7 anton 767: .s" enter " drop w@+ h.>s ., count h.>s ;
1.2 anton 768:
769: : cis ( addr op -- addr' )
770: $9a =
771: IF .s" call "
772: ELSE .s" jmp "
773: THEN
774: 16-bit-data
775: IF .s" ptr16:16 "
776: ELSE .s" ptr16:32 "
777: THEN
778: count mod-r/m ;
779:
780: : nt3 ( addr op -- addr' )
781: drop .s" int 3 "
782: ;
783:
784: : int ( addr op -- addr' )
785: drop .s" int "
786: count h.>s ;
787:
788: inh lev leave
789: inh irt iret
790: inh nto into
791:
792: \ -------------------- string ops --------------------
793:
794: : str inh does> count >s 1 and if .s" d" else .s" b" then ;
795:
796: str mvs movs
797: str cps cmps
798: str sts stos
799: str lds lods
800: str scs scas
801:
802: \ -------------------- Exchange --------------------
803:
804: : xga ( addr op -- addr' )
805: .s" xchg eax, " reg16/32 ;
806:
807: \ : xch ( addr op -- addr' )
808: \ .s" xchg " drop r,r/m ;
809:
810:
811: \ -------------------- Shifts & Rotates --------------------
812:
813: : .shift ( n -- )
814: 7 and S" rolrorrclrcrshlshrxxxsar" 3 ss. 4 sspaces ;
815:
816: : shf ( addr op -- addr' )
817: >r count
818: dup 3 rshift .shift
819: mod-r/m .,
820: r> $D2 and
821: case
822: $C0 of count h.>s endof
823: $D0 of 1 h.>s endof
824: $D2 of 1 reg8 endof
825: endcase ;
826:
827: \ -------------------- Extended Opcodes --------------------
828:
829: : wf1 ( addr -- addr' )
830: 1+ count dup
831: $0c0 <
832: IF dup
833: 3 rshift 7 and
834: case 6 of .s" fstenv " mod-r/m endof
835: 7 of .s" fstcw word " mod-r/m endof
836: 2drop 2 - dup .s" fwait "
837: endcase
838: ELSE drop 2 - .s" fwait "
839: THEN ;
840:
841: : wf2 ( addr -- addr' )
842: 1+ count
843: case $e2 of .s" fclex " endof
844: $e3 of .s" finit " endof
845: swap 2 - swap .s" fwait "
846: endcase ;
847:
848: : wf3 ( addr -- addr' )
849: 1+ count dup 3 rshift 7 and
850: case 6 of .s" fsave " mod-r/m endof
851: 7 of .s" fstsw word " mod-r/m endof
852: 2drop 2 - dup .s" fwait "
853: endcase ;
854:
855: : wf4 ( addr -- addr' )
856: 1+ count $e0 =
857: IF .s" fstsw ax "
858: ELSE 2 - .s" fwait "
859: THEN ;
860:
861: : fwaitops ( addr op -- addr' )
862: case $d9 of wf1 endof
863: $db of wf2 endof
864: $dd of wf3 endof
865: $df of wf4 endof
866: .s" fwait "
867: endcase ;
868:
869: : w8f ( addr op -- addr' )
870: drop dup c@ dup $f8 and $d8 =
871: IF fwaitops
872: ELSE drop .s" wait "
873: THEN ;
874:
875: : falu1 ( xopcode -- )
876: 3 rshift 7 and
877: S" fadd fmul fcom fcompfsub fsubrfdiv fdivr"
878: 5 ss. 2 sspaces ;
879:
880: : falu5 ( xopcode -- )
881: 3 rshift 7 and
882: s" fadd fmul ???? ???? fsubrfsub fdivrfdiv "
883: 5 ss. 2 sspaces ;
884:
885: : sti. ( op -- )
886: 7 and .s" ST(" 1 .r>s .s" )";
887:
888: \ : sti.st ( op -- )
889: \ 7 and
890: \ .s" ST(" 1 .r>s .s" )" .s" ST " ;
891:
892: : fd8 ( addr opcode -- addr' )
893: drop count dup falu1
894: dup $c0 <
895: IF .s" float " mod-r/m
896: ELSE dup $f0 and $d0 =
897: IF sti.
898: ELSE .s" ST , " sti.
899: THEN
900: THEN ;
901:
902: : fdc ( addr opcode -- addr' )
903: drop count
904: dup dup $c0 <
905: IF falu1 .s" double " mod-r/m
906: ELSE falu5 sti. .s" , ST"
907: THEN ;
908:
909: : fnullary-f ( op -- )
910: $0f and dup 8 <
911: IF
912: S" f2xm1 fyl2x fptan fpatan fxtractfprem1 fdecstpfincstp"
913: ELSE 8 -
914: S" fprem fyl2xp1fsqrt fsincosfrndintfscale fsin fcos "
915: THEN
916: 7 ss. ;
917:
918: : fnullary-e ( op -- )
919: $0f and dup 8 <
920: IF
921: S" fchs fabs ??? ??? ftst fxam ??? ??? "
922: ELSE 8 -
923: S" fld1 fldl2t fldl2e fldpi fldlg2 fldln2 fldz ??? "
924: THEN
925: 7 ss. ;
926:
927: : fnullary ( op -- )
928: dup $ef >
929: IF fnullary-f EXIT
930: THEN
931: dup $e0 <
932: IF $d0 =
933: IF .s" fnop"
934: ELSE dup ???
935: THEN
936: EXIT
937: THEN
938: fnullary-e ;
939:
940:
941: \ : falu2 ( op -- )
942: \ 3 rshift 7 and
943: \ S" fld ??? fst fstp fldenv fldcw fnstenvfnstcw "
944: \ 7 ss. ;
945:
946: : fd9 ( addr op -- addr' )
947: drop count dup $c0 <
948: IF dup $38 and
949: CASE
950: $00 OF .s" fld float " endof
951: $10 OF .s" fst float " endof
952: $18 OF .s" fstp float " endof
953: $20 OF .s" fldenv " endof
954: $28 OF .s" fldcw word " endof
955: $30 OF .s" fnstenv " endof
956: $38 OF .s" fnstcw word " endof
957: dup ???
958: ENDCASE
959: mod-r/m
960: ELSE
961: dup $d0 <
962: IF dup $c8 <
963: IF .s" fld "
964: ELSE .s" fxch "
965: THEN
966: sti.
967: ELSE fnullary
968: THEN
969: THEN ;
970:
971: : falu3 ( op -- )
972: 3 rshift 7 and
973: S" fiadd fimul ficom ficompfisub fisubrfidiv fidivr"
974: 6 ss. 1 sspaces ;
975:
976: : fcmova ( op -- )
977: 3 rshift 7 and
978: S" fcmovb fcmove fcmovbefcmovu ??? ??? ??? ??? "
979: 7 ss. ;
980:
1.6 anton 981: : fda ( addr op -- addr' )
982: drop count dup $c0 < IF ( addr1 op1 )
983: dup falu3 .s" dword " mod-r/m
984: ELSE
985: dup $e9 = IF ( addr1 op1 )
986: drop .s" fucompp"
987: ELSE
988: dup fcmova sti.
989: THEN
990: THEN ;
1.2 anton 991:
992: : falu7 ( op -- )
993: 3 rshift 7 and
994: S" faddp fmulp ??? ??? fsubrpfsubp fdivrpfdivp "
995: 6 ss. sspace ;
996:
997: : fde ( addr op -- addr' )
998: drop count dup $c0 <
999: IF dup falu3 .s" word " mod-r/m
1000: ELSE dup $d9 =
1001: if .s" fcompp" drop
1002: else dup falu7 sti.
1003: then
1004: THEN ;
1005:
1006: : fcmovb ( op -- )
1007: 3 rshift 7 and
1008: S" fcmovnb fcmovne fcmovnbefcmovnu ??? fucomi fcomi ??? "
1009: 8 ss. ;
1010:
1011: : fdb ( addr op -- addr' )
1012: drop count dup $c0 <
1013: IF dup $38 and
1014: CASE $00 OF .s" fild dword " endof
1015: $10 OF .s" fist dword " endof
1016: $18 OF .s" fistp dword " endof
1017: $28 OF .s" fld extended " endof
1018: $38 OF .s" fstp extended " endof
1019: dup ???
1020: ENDCASE
1021: mod-r/m
1022: ELSE
1023: CASE $e2 OF .s" fnclex" endof
1024: $e3 OF .s" fninit" endof
1025: dup dup fcmovb sti.
1026: ENDCASE
1027: THEN ;
1028:
1029: : falu6 ( op -- )
1030: 3 rshift 7 and
1031: S" ffree ??? fst fstp fucom fucomp??? ??? "
1032: 6 ss. sspace ;
1033:
1034: : fdd ( addr op -- addr' )
1035: drop count dup $c0 <
1036: IF dup $38 and
1037: CASE $00 OF .s" fld double " endof
1038: $10 OF .s" fst double " endof
1039: $18 OF .s" fstp double " endof
1040: $20 OF .s" frstor " endof
1041: $30 OF .s" fnsave " endof
1042: $38 OF .s" fnstsw word " endof
1043: dup ???
1044: ENDCASE
1045: mod-r/m
1046: ELSE dup falu6 sti.
1047: THEN ;
1048:
1049: : fdf ( addr op -- addr' )
1050: drop count dup $c0 <
1051: IF dup $38 and
1052: CASE $00 OF .s" fild word " endof
1053: $10 OF .s" fist word " endof
1054: $18 OF .s" fistp word " endof
1055: $20 OF .s" fbld tbyte " endof
1056: $28 OF .s" fild qword " endof
1057: $30 OF .s" fbstp tbyte " endof
1058: $38 OF .s" fistp qword " endof
1059: dup ???
1060: ENDCASE
1061: mod-r/m
1062: ELSE dup $e0 =
1063: IF .s" fnstsw ax " drop
1064: ELSE dup $38 and
1065: CASE $28 OF .s" fucomip " sti. endof
1066: $30 OF .s" fcomip " sti. endof
1067: ???
1068: ENDCASE
1069: THEN
1070: THEN ;
1071:
1072: : gp6 ( addr op -- addr' )
1073: drop count dup 3 rshift
1074: 7 and S" sldtstr lldtltr verrverw??? ???" 4 ss. 3 sspaces
1075: r/m16 ;
1076:
1077: : gp7 ( addr op -- addr' )
1078: drop count dup 3 rshift
1079: 7 and dup S" sgdt sidt lgdt lidt smsw ??? lmsw invlpg" 6 ss. 1 sspaces
1080: 4 and 4 =
1081: if r/m16
1082: else r/m16/32
1083: then ;
1084:
1085: : btx. ( n -- )
1086: 3 rshift
1087: 3 and S" bt btsbtrbtc" 3 ss. 4 sspaces ;
1088:
1089: : gp8 ( addr op -- addr' )
1090: drop count dup btx.
1091: r/m16/32 imm8 ;
1092:
1093: : lar ( addr op -- addr' )
1094: .s" lar " drop r,r/m ;
1095:
1096: : lsl ( addr op -- addr' )
1097: .s" lsl " drop r,r/m ;
1098:
1099: : lss ( addr op -- addr' )
1100: .s" lss " drop r,r/m ;
1101:
1102: : lfs ( addr op -- addr' )
1103: .s" lfs " drop r,r/m ;
1104:
1105: : lgs ( addr op -- addr' )
1106: .s" lgs " drop r,r/m ;
1107:
1108: : btx ( addr op -- addr' )
1109: btx. r/m,r ;
1110:
1111: : sli ( addr op -- addr' )
1112: .s" shld " drop r/m,r imm8 ;
1113:
1114: : sri ( addr op -- addr' )
1115: .s" shrd " drop r/m,r imm8 ;
1116:
1117: : slc ( addr op -- addr' )
1118: .s" shld " drop r/m,r .s" , cl" ;
1119:
1120: : src ( addr op -- addr' )
1121: .s" shrd " drop r/m,r .s" , cl" ;
1122:
1123: : iml ( addr op -- addr' )
1124: .s" imul " drop r,r/m ;
1125:
1126: : cxc ( addr op -- addr' )
1127: .s" cmpxchg " 1 and to size r/m,r ;
1128:
1129: : mvx ( addr op -- addr' )
1130: dup 8 and
1131: if .s" movsx "
1132: else .s" movzx "
1133: then
1134: 1 and >r
1135: count mod/sib r> \ size bit
1136: if swap reg32 ., \ word to dword case
1137: 3 =
1138: if reg16
1139: else .s" word ptr " mod-r/m
1140: then
1141: else swap reg16/32 ., \ byte case
1142: 3 =
1143: if reg8
1144: else .s" byte ptr " mod-r/m
1145: then
1146: then ;
1147:
1148: : xad ( addr op -- addr' )
1149: .s" xadd " 1 and to size r/m,r ;
1150:
1151: : bsf ( addr op -- addr' )
1152: .s" bsf " drop r,r/m ;
1153:
1154: : bsr ( addr op -- addr' )
1155: .s" bsr " drop r,r/m ;
1156:
1157: : cx8 ( addr op -- addr' )
1158: .s" cmpxchg8b " drop count r/m16/32 ;
1159:
1160: : bsp ( addr op -- addr' )
1161: .s" bswap " reg32 ;
1162:
1163: \ : 0F. ( addr op -- addr' )
1164: \ drop count
1165: \ case
1166: \ 0x00 of gp6 endof
1167: \ 0x01 of gp7 endof
1168: \ 0x02 of .s" lar " 1 to size r,r/m endof
1169: \ 0x03 of .s" lsl " 1 to size r,r/m endof
1170: \ 0x06 of .s" clts " endof
1171: \ 0x08 of .s" invd " endof
1172: \ 0x09 of .s" wbinvd " endof
1173: \ 0x20 of mrc endof
1174: \ 0x21 of mrd endof
1175: \ 0x22 of mcr endof
1176: \ 0x23 of mdr endof
1177: \ 0x24 of mrt endof \ obsolete
1178: \ 0x26 of mtr endof \ obsolete
1179: \ 0x30 of .s" wrmsr " endof
1180: \ 0x31 of .s" rdtsc " endof
1181: \ 0x32 of .s" rdmsr " endof
1182: \ 0x80 of .s" jo " rel16/32 endof
1183: \ 0x81 of .s" jno " rel16/32 endof
1184: \ 0x82 of .s" jc " rel16/32 endof
1185: \ 0x83 of .s" jnc " rel16/32 endof
1186: \ 0x84 of .s" jz " rel16/32 endof
1187: \ 0x85 of .s" jne " rel16/32 endof
1188: \ 0x86 of .s" jbe " rel16/32 endof
1189: \ 0x87 of .s" ja " rel16/32 endof
1190: \ 0x88 of .s" js " rel16/32 endof
1191: \ 0x89 of .s" jns " rel16/32 endof
1192: \ 0x8A of .s" jpe " rel16/32 endof
1193: \ 0x8B of .s" jpo " rel16/32 endof
1194: \ 0x8C of .s" jnge " rel16/32 endof
1195: \ 0x8D of .s" jge " rel16/32 endof
1196: \ 0x8E of .s" jng " rel16/32 endof
1197: \ 0x8F of .s" jg " rel16/32 endof
1198: \ 0x90 of .s" seto byte " r/m8 endof
1199: \ 0x91 of .s" setno byte " r/m8 endof
1200: \ 0x92 of .s" setc byte " r/m8 endof
1201: \ 0x93 of .s" setnc byte " r/m8 endof
1202: \ 0x94 of .s" setz byte " r/m8 endof
1203: \ 0x95 of .s" setnz byte " r/m8 endof
1204: \ 0x96 of .s" setbe byte " r/m8 endof
1205: \ 0x97 of .s" seta byte " r/m8 endof
1206: \ 0x98 of .s" sets byte " r/m8 endof
1207: \ 0x99 of .s" setns byte " r/m8 endof
1208: \ 0x9A of .s" setp byte " r/m8 endof
1209: \ 0x9B of .s" setnp byte " r/m8 endof
1210: \ 0x9C of .s" setl byte " r/m8 endof
1211: \ 0x9D of .s" setge byte " r/m8 endof
1212: \ 0x9E of .s" setle byte " r/m8 endof
1213: \ 0x9F of .s" setg byte " r/m8 endof
1214: \ 0xA0 of .s" push fs " endof
1215: \ 0xA1 of .s" pop fs " endof
1216: \ 0xA2 of .s" cpuid " endof
1217: \ 0xA3 of .s" bt " 1 to size r/m,r endof
1218: \ 0xA4 of .s" shld " r/m,r imm8 endof
1219: \ 0xA5 of .s" shld " r/m,r .s" , cl" endof
1220: \ 0xA8 of .s" push gs " endof
1221: \ 0xA9 of .s" pop gs " endof
1222: \ 0xAA of .s" rsm " endof
1223: \ 0xAB of .s" bts " 1 to size r/m,r endof
1224: \ 0xAC of .s" shrd " r/m,r imm8 endof
1225: \ 0xAD of .s" shrd " r/m,r .s" , cl" endof
1226: \ 0xAF of .s" imul " r,r/m endof
1227: \ 0xB0 of .s" cmpxch " 0 to size r/m,r endof
1228: \ 0xB1 of .s" cmpxch " 1 to size r/m,r endof
1229: \ 0xB2 of .s" lss " 1 to size r,r/m endof
1230: \ 0xB3 of .s" btr " 1 to size r/m,r endof
1231: \ 0xB4 of .s" lfs " 1 to size r,r/m endof
1232: \ 0xB5 of .s" lgs " 1 to size r,r/m endof
1233: \ 0xB6 of .s" movzx " 0 to size r,r/m endof
1234: \ 0xB7 of .s" movzx " 1 to size r,r/m endof
1235: \ 0xBA of gp8 endof
1236: \ 0xBB of .s" btc " 1 to size r/m,r endof
1237: \ 0xBC of .s" bsf " 1 to size r,r/m endof
1238: \ 0xBD of .s" bsr " 1 to size r,r/m endof
1239: \ 0xBE of .s" movsx " 0 to size r,r/m endof
1240: \ 0xBF of .s" movsx " 1 to size r,r/m endof
1241: \ 0xC0 of .s" xadd " 0 to size r/m,r endof
1242: \ 0xC1 of .s" xadd " 1 to size r/m,r endof
1243: \ 0xC7 of .s" cmpxchg8b " r/m16/32 endof
1244: \ 0xC8 of .s" bswap eax " endof
1245: \ 0xC9 of .s" bswap ecx " endof
1246: \ 0xCA of .s" bswap edx " endof
1247: \ 0xCB of .s" bswap ebx " endof
1248: \ 0xCC of .s" bswap esp " endof
1249: \ 0xCD of .s" bswap ebp " endof
1250: \ 0xCE of .s" bswap esi " endof
1251: \ 0xCF of .s" bswap edi " endof
1252: \ ( else ) dup ???
1253: \ endcase
1254: \ ;
1255:
1256: : F6. ( addr op -- addr' )
1257: \ ??
1258: >r count
1259: dup 3 rshift 7 and dup >r S" testXXXXnot neg mul imuldiv idiv" 4 ss. 3 sspaces
1260: mod-r/m
1261: r> 0= if
1262: r@ 1 and if imm16/32
1263: else imm8
1264: then
1265: then
1266: r> drop ;
1267:
1268: : FE. ( addr op -- addr' )
1269: drop count
1270: dup 3 rshift 7 and
1271: case
1272: 0 of .s" inc " endof
1273: 1 of .s" dec " endof
1274: ???
1275: endcase r/m8 ;
1276:
1277: : FF. ( addr op -- addr' )
1278: drop count
1279: dup 3 rshift 7 and
1280: case
1281: 0 of .s" inc " endof
1282: 1 of .s" dec " endof
1283: 2 of .s" call " endof
1284: 3 of .s" call far " endof
1285: 4 of .s" jmp " endof
1286: 5 of .s" jmp far " endof
1287: 6 of .s" push " endof
1288: ???
1289: endcase r/m16/32 ;
1290:
1291: \ --------------------- conditional move ---------------
1292:
1293: : set ( adr op -- )
1294: .s" set"
1295: tttn 2 sspaces
1296: count r/m8 ;
1297:
1298: : cmv ( adr op -- )
1299: .s" cmov"
1300: tttn 1 sspaces
1301: count r,r/m ;
1302:
1303: \ --------------------- MMX Operations -----------------
1304:
1305: : mmx-size ( op -- )
1306: 3 and S" bwdq" 1 ss. ;
1307:
1308: : upl ( adr op -- adr' )
1309: 3 and S" punpcklbwpunpcklwdpunpckldq" 9 ss. r,r/m ;
1310:
1311: : uph ( adr op -- adr' )
1312: 3 and S" punpckhbwpunpckhwdpunpckhdq" 9 ss. r,r/m ;
1313:
1314: : cgt ( adr op -- adr' )
1315: .s" pcmpgt" mmx-size r,r/m ;
1316:
1317: : ceq ( adr op -- adr' )
1318: .s" pcmpeq" mmx-size r,r/m ;
1319:
1320: : psh. ( op -- )
1321: $30 and
1322: case
1323: $10 of .s" psrl" endof
1324: $20 of .s" psra" endof
1325: $30 of .s" psll" endof
1326: endcase ;
1327:
1328: : gpa ( adr op -- adr' )
1329: >r count dup psh. r> mmx-size 2 sspaces mreg imm8 ;
1330:
1331: : puw ( adr op -- adr' )
1332: .s" packusdw " drop r,r/m ;
1333:
1334: : psb ( adr op -- adr' )
1335: .s" packsswb " drop r,r/m ;
1336:
1337: : psw ( adr op -- adr' )
1338: .s" packssdw " drop r,r/m ;
1339:
1340: : mpd ( adr op -- adr' )
1341: .s" movd " drop count mod/sib
1342: swap mreg ., 3 =
1343: if reg32
1344: else mod-r/m
1345: then ;
1346:
1347: : mdp ( adr op -- adr' )
1348: .s" movd " drop count mod/sib
1349: 3 =
1350: if swap reg32
1351: else swap mod-r/m
1352: then ., mreg ;
1353:
1354: : mpq ( adr op -- adr' )
1355: .s" movq " drop r,r/m ;
1356:
1357: : mqp ( adr op -- adr' )
1358: .s" movq " drop r/m,r ;
1359:
1360: : shx ( adr op -- adr' )
1361: dup psh. mmx-size 2 sspaces r,r/m ;
1362:
1363: : mll ( adr op -- adr' )
1364: .s" pmullw " drop r,r/m ;
1365:
1366: : mlh ( adr op -- adr' )
1367: .s" pmulhw " drop r,r/m ;
1368:
1369: : mad ( adr op -- adr' )
1370: .s" pmaddwd " drop r,r/m ;
1371:
1372: : sus ( adr op -- adr' )
1373: .s" psubus" mmx-size r,r/m ;
1374:
1375: : sbs ( adr op -- adr' )
1376: .s" psubs" mmx-size sspace r,r/m ;
1377:
1378: : sub ( adr op -- adr' )
1379: .s" psub" mmx-size 2 sspaces r,r/m ;
1380:
1381: : aus ( adr op -- adr' )
1382: .s" paddus" mmx-size r,r/m ;
1383:
1384: : ads ( adr op -- adr' )
1385: .s" padds" mmx-size sspace r,r/m ;
1386:
1387: : add ( adr op -- adr' )
1388: .s" padd" mmx-size 2 sspaces r,r/m ;
1389:
1390: : pad ( adr op -- adr' )
1391: .s" pand " drop r,r/m ;
1392:
1393: : por ( adr op -- adr' )
1394: .s" por " drop r,r/m ;
1395:
1396: : pan ( adr op -- adr' )
1397: .s" pandn " drop r,r/m ;
1398:
1399: : pxr ( adr op -- adr' )
1400: .s" pxor " drop r,r/m ;
1401:
1402: \ -------------------- Opcode Table --------------------
1403:
1404: : ops $10 0 do ' , loop ;
1405:
1406: create op-table2
1407:
1408: \ 0 1 2 3 4 5 6 7 8 9 A B C D E F
1409:
1410: ops gp6 gp7 lar lsl ??? ??? clt ??? inv wiv ??? ud2 ??? ??? ??? ??? \ 0
1411: ops ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? \ 1
1412: ops mrc mrd mcr mdr mrt ??? mtr ??? ??? ??? ??? ??? ??? ??? ??? ??? \ 2
1413: ops wmr rtc rmr rpc ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? \ 3
1414:
1415: ops cmv cmv cmv cmv cmv cmv cmv cmv cmv cmv cmv cmv cmv cmv cmv cmv \ 4
1416: ops ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? \ 5
1417: ops upl upl upl puw cgt cgt cgt psb uph uph uph psw ??? ??? mpd mpq \ 6
1418: ops ??? gpa gpa gpa ceq ceq ceq ems ??? ??? ??? ??? ??? ??? mdp mqp \ 7
1419:
1420: ops lbr lbr lbr lbr lbr lbr lbr lbr lbr lbr lbr lbr lbr lbr lbr lbr \ 8
1421: ops set set set set set set set set set set set set set set set set \ 9
1422: ops pss pps cpu btx sli slc ??? ??? pss pps rsm btx sri src ??? iml \ A
1423: ops cxc cxc lss btx lfs lgs mvx mvx ??? ud1 gp8 btx bsf bsr mvx mvx \ B
1424:
1425: ops xad xad ??? ??? ??? ??? ??? cx8 bsp bsp bsp bsp bsp bsp bsp bsp \ C
1426: ops ??? shx shx shx ??? mll ??? ??? sus sus ??? pad aus aus ??? pan \ D
1427: ops ??? shx shx ??? ??? mlh ??? ??? sbs sbs ??? por ads ads ??? pxr \ E
1428: ops ??? ??? shx shx ??? mad ??? ??? sub sub sub ??? add add add ??? \ F
1429:
1430: \ 0 1 2 3 4 5 6 7 8 9 A B C D E F
1431:
1432: : 0F. ( adr code -- )
1433: drop count dup
1434: dup $70 and $50 $80 within to mmx-reg
1435: cells op-table2 + @ execute
1436: 0 to mmx-reg ;
1437:
1438: create op-table
1439:
1440: \ 0 1 2 3 4 5 6 7 8 9 A B C D E F
1441:
1442: ops alu alu alu alu ala ala pss pps alu alu alu alu ala ala pss 0F. \ 0
1443: ops alu alu alu alu ala ala pss pps alu alu alu alu ala ala pss pps \ 1
1444: ops alu alu alu alu ala ala es: daa alu alu alu alu ala ala cs: das \ 2
1445: ops alu alu alu alu ala ala ss: aaa alu alu alu alu ala ala ds: aas \ 3
1446:
1447: ops inc inc inc inc inc inc inc inc dec dec dec dec dec dec dec dec \ 4
1448: ops psh psh psh psh psh psh psh psh pop pop pop pop pop pop pop pop \ 5
1449: ops psa ppa bnd arp fs: gs: d16 a16 psi mli psi mli inb isd osb osd \ 6
1450: ops bra bra bra bra bra bra bra bra bra bra bra bra bra bra bra bra \ 7
1451:
1452: ops ali ali ??? ali txb txb txb txb mov mov mov mov mrs lea msr 8F. \ 8
1453: ops xga xga xga xga xga xga xga xga cbw cdq cis w8f psf ppf sah lah \ 9
1454: ops mv1 mv1 mv2 mv2 mvs mvs cps cps tst tst sts sts lds lds scs scs \ A
1455: ops mri mri mri mri mri mri mri mri mri mri mri mri mri mri mri mri \ B
1456:
1457: ops shf shf rtn rtn lxs lxs mvi mvi ent lev rtf rtf nt3 int nto irt \ C
1458: ops shf shf shf shf aam aad ??? xlt fd8 fd9 fda fdb fdc fdd fde fdf \ D
1459: ops lup lup lup lup inp inp otp otp jsr jmp cis jmp ind ind otd otd \ E
1460: ops lok ??? rpz rep hlt cmc F6. F6. clc stc cli sti cld std FE. FF. \ F
1461:
1462: \ 0 1 2 3 4 5 6 7 8 9 A B C D E F
1463:
1464: : dis-op ( adr -- adr' )
1465: 0>s
1466: false to prefix-op \ SMuB
1467: count
1468: dup 1 and to size
1469: dup cells op-table + @ execute
1470: prefix-op 0=
1471: if default-16bit? 0=
1472: if false to 16-bit-data
1473: false to 16-bit-addr
1474: else true to 16-bit-data
1475: true to 16-bit-addr
1476: then
1477: then ;
1478:
1479: 0 value next-inst
1480:
1481: : inst ( adr -- adr' )
1482: dup to next-inst
1483: cols $29 <
1484: if dis-op
1485: s-buf count type
1486: else dup dis-op
1.4 anton 1487: over base-addr - ." ( " hex. ( 6 h.r ) ." ) "
1.3 anton 1488: comment-col col s-buf count type ." \ "
1489: dup rot
1.2 anton 1490: 2dup - $10 u> abort" decompiler error"
1491: do i c@ hex. ( 2 h.n ) loop
1492: then dup to next-inst ;
1493:
1494: forth definitions
1495:
1496: : disasm ( addr u -- ) \ gforth
1497: over + >r
1498: begin
1499: dup r@ u<
1500: while
1501: cr inst
1502: repeat
1.4 anton 1503: cr rdrop drop ;
1.2 anton 1504:
1505: ' disasm is discode
1506:
1507: only forth also definitions
1508: