Screen 0 not modified 0 \ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Screen 1 not modified 0 \ A disassembler for the 8086 by Charles Curley cas 10nov05 1 \ adapted to volksFORTH-83 by B. Molte 2 3 | : internal 1 ?head ! ; 4 | : external ?head off ; 5 6 onlyFORTH forth DEFINITIONS DECIMAL 7 8 VOCABULARY DISAM DISAM also DEFINITIONS 9 10 2 capacity 1- thru 11 onlyforth 12 13 cr .( Use DIS to disassemble word. ) 14 cr .( ESC will stop the output. ) 15 Screen 2 not modified 0 \ cas 10nov05 1 2 internal 3 4 : [and] and ; \ the forth and 5 : [or] or ; 6 7 : mask ( n maskb -- n n' ) over and ; 8 9 5 constant 5 \ save some space 10 6 constant 6 11 7 constant 7 12 8 constant 8 13 14 15 Screen 3 not modified 0 \ 1 internal 2 3 : EXEC [and] 2* R> + PERFORM ; 4 5 : STOP[ 6 0 ?pairs [compile] [ reveal ; immediate restrict 7 8 code shift> \ n ct --- n' | shift n right ct times 9 D C mov D pop D C* shr next end-code 10 \ : shift> 0 ?DO 2/ ( shift's artihm.!) $7FFF and LOOP ; 11 12 code SEXT \ n --- n' | sign extend lower half of n to upper 13 D A mov cbw A D mov next end-code 14 \ : hsext $FF and dup $80 and IF $FF00 or THEN ; 15 Screen 4 not modified 0 \ 1 external 2 VARIABLE RELOC 0 , ds@ 0 RELOC 2! \ keeps relocation factor 3 internal 4 5 VARIABLE CP 6 VARIABLE OPS \ operand count 7 8 : cp@ cp @ ; 9 : C? C@ . ; 10 11 : (T@) RELOC 2@ ROT + L@ ; \ in first word, seg in 2nd. You 12 \ dump/dis any segment w/ any 13 : (TC@) RELOC 2@ ROT + LC@ ; \ relocation you want by setting 14 \ RELOC correctly. 15 : SETSEG RELOC 2+ ! ; Screen 5 not modified 0 \ 1 external 2 3 DEFER T@ DEFER TC@ 4 5 : HOMESEG ds@ SETSEG ; HOMESEG 6 7 : SEG? RELOC 2+ @ 4 U.r ; 8 9 : .seg:off seg? ." :" cp@ 4 u.r 2 spaces ; 10 11 : MEMORY ['] (TC@) IS TC@ ['] (T@) IS T@ ; MEMORY 12 13 14 15 Screen 6 not modified 0 \ 1 internal 2 3 4 : oops ." ??? " ; 5 6 : OOPS0 oops ; 7 : OOPS1 oops drop ; 8 : OOPS2 oops 2drop ; 9 10 11 12 13 14 15 Screen 7 not modified 0 \ 1 2 : NEXTB CP@ TC@ 1 CP +! ; 3 : NEXTW CP@ T@ 2 CP +! ; 4 5 : .myself \ --- | have the current word print out its name. 6 LAST @ [COMPILE] LITERAL COMPILE .name ; IMMEDIATE 7 8 9 10 11 12 13 14 15 Screen 8 not modified 0 \ 1 internal 2 3 VARIABLE IM \ 2nd operand extension flag/ct 4 5 : ?DISP \ op ext --- op ext | does MOD operand have a disp? 6 DUP 6 shift> DUP 3 = OVER 0= [or] 0= IF IM ! exit then 7 0= IF DUP 7 [and] 6 = IF 2 IM ! THEN THEN ; 8 9 10 : .SELF \ -- | create a word which prints its name 11 CREATE LAST @ , DOES> @ .name ; \ the ultimate in self-doc! 12 13 14 15 Screen 9 not modified 0 \ register byte/word 1 internal 2 3 create wreg-tab ," ACDRSUIW" 4 create breg-tab ," A-C-D-R-A+C+D+R+" 5 6 : .16REG \ r# --- | register printed out 7 7 and wreg-tab 1+ + c@ emit space ; 8 9 : .8REG \ r# --- | register printed out 10 7 and 2* breg-tab 1+ + 2 type space ; 11 12 : .A 0 .16reg ; : .A- 0 .8reg ; 13 : .D 2 .16reg ; 14 15 Screen 10 not modified 0 \ indizierte/indirekte Adressierung cas 10nov05 1 2 internal 3 4 : ?d DUP 6 shift> 3 [and] 1 3 uwithin ; 5 6 : .D) ( disp_flag ext -- op ) \ indirect 7 ?d IF ." D" THEN ." ) " ; \ with/without Displacement 8 9 : .I) ( disp_flag ext -- op ) \ indexted indirect 10 ?d IF ." D" THEN ." I) " ; \ with/without Displacement 11 12 13 14 15 Screen 11 not modified 0 \ indexed/indirect addressing cas 10nov05 1 internal 2 3 : I) 6 .16reg .D) ; 4 : W) 7 .16reg .D) ; 5 : R) 3 .16reg .D) ; 6 : S) 4 .16reg .D) ; 7 : U) 5 .16reg .D) ; 8 9 : U+W) 5 .16reg 7 .16reg .I) ; 10 : R+I) 3 .16reg 6 .16reg .I) ; 11 : U+I) 5 .16reg 6 .16reg .I) ; 12 : R+W) 3 .16reg 7 .16reg .I) ; 13 14 : .# ." # " ; 15 Screen 12 not modified 0 \ 1 internal 2 3 : (.R/M) \ op ext --- | print a register 4 IM OFF SWAP 1 [and] IF .16REG exit then .8REG ; 5 6 : .R/M \ op ext --- op ext | print r/m as register 7 2DUP (.R/M) ; 8 9 : .REG \ op ext --- op ext | print reg as register 10 2DUP 3 shift> (.R/M) ; 11 12 13 14 15 Screen 13 not modified 0 \ 1 internal 2 3 CREATE SEGTB ," ECSD" 4 5 : (.seg ( n -- ) 6 3 shift> 3 and segtb + 1+ c@ emit ; 7 8 : .SEG \ s# --- | register printed out 9 (.seg ." : " ; 10 11 : SEG: \ op --- | print segment overrides 12 (.seg ." S:" ; 13 14 15 Screen 14 not modified 0 \ 1 internal 2 : disp@ ( ops-cnt -- ) 3 ops +! CP@ IM @ + IM off ." $" ; 4 5 : BDISP \ --- | do if displacement is byte 6 1 disp@ TC@ sext U. ; 7 8 : WDisp \ --- | do if displacement is word 9 2 disp@ T@ U. ; 10 11 : .DISP \ op ext --- op ext | print displacement 12 DUP 6 shift> 3 EXEC noop BDISP WDISP .R/M STOP[ 13 14 : BIMM \ --- | do if immed. value is byte 15 1 disp@ TC@ . ; Screen 15 not modified 0 \ 1 internal 2 3 4 : .MREG \ op ext --- op ext | register(s) printed out + disp 5 $C7 mask 6 = IF WDISP ." ) " exit then 6 $C0 mask $C0 - 0= IF .R/M exit THEN 7 .DISP DUP 7 exec 8 R+I) R+W) U+I) U+W) \ I) oder DI) 9 I) W) U) R) \ ) oder D) 10 ; 11 12 13 14 15 Screen 16 not modified 0 \ 1 internal 2 3 : .SIZE \ op --- | decodes for size; WORD is default 4 1 [and] 0= IF ." BYTE " THEN ; 5 6 create adj-tab ," DAADASAAAAASAAMAAD" 7 8 : .adj-tab 3 * adj-tab 1+ + 3 type space ; 9 10 : ADJUSTS \ op --- | the adjusts 11 3 shift> 3 [and] .adj-tab ; 12 13 : .AAM 4 .adj-tab nextb 2drop ; 14 : .AAD 5 .adj-tab nextb 2drop ; 15 Screen 17 not modified 0 \ 1 internal 2 : .POP \ op --- | print pops 3 DUP 8 = IF OOPS1 THEN .SEG ." POP " ; 4 5 : .PUSH \ op --- | print pushes 6 .SEG ." PUSH " ; 7 8 : P/P \ op --- | pushes or pops 9 1 mask IF .pop ELSE .push THEN ; 10 11 12 13 14 15 Screen 18 not modified 0 \ 1 internal 2 : P/SEG \ op --- | push or seg overrides 3 DUP 5 shift> 1 exec P/P SEG: STOP[ 4 5 : P/ADJ \ op --- | pop or adjusts 6 DUP 5 shift> 1 exec P/P ADJUSTS STOP[ 7 8 : 0GP \ op --- op | opcode decoded & printed 9 4 mask IF 1 mask 10 IF WDISP ELSE BIMM THEN .# 11 1 [and] IF .A ELSE .A- THEN ELSE 12 NEXTB OVER 2 [and] 13 IF .MREG .REG ELSE ?DISP .REG .MREG 14 THEN 2DROP THEN ; 15 Screen 19 not modified 0 \ 1 external 2 .SELF ADD .SELF ADC .SELF AND .SELF XOR 3 .SELF OR .SELF SBB .SELF SUB .SELF CMP 4 5 internal 6 7 : 0GROUP \ op --- | select 0 group to print 8 DUP 0GP 3 shift> 7 EXEC 9 ADD OR ADC SBB AND SUB XOR CMP STOP[ 10 11 : LOWS \ op --- | 0-3f opcodes printed out 12 DUP 7 EXEC 13 0GROUP 0GROUP 0GROUP 0GROUP 14 0GROUP 0GROUP P/SEG P/ADJ STOP[ 15 Screen 20 not modified 0 \ 1 internal 2 3 : .REGGP \ op --- | register group defining word 4 CREATE LAST @ , DOES> @ SWAP .16REG .name ; 5 6 external 7 8 .REGGP INC .REGGP DEC .REGGP PUSH .REGGP POP 9 10 : POPs \ op --- | handle illegal opcode for cs pop 11 $38 mask 8 = IF ." illegal" DROP ELSE POP THEN ; 12 13 : REGS \ op --- | 40-5f opcodes printed out 14 DUP 3 shift> 3 exec INC DEC PUSH POPs STOP[ 15 Screen 21 not modified 0 \ conditional branches 1 2 create branch-tab 3 ," O NO B NB E NE BE NBES NS P NP L GE LE NLE" 4 5 : .BRANCH \ op --- | branch printed out w/ dest. 6 NEXTB SEXT CP@ + u. ASCII J EMIT 7 &15 [and] 3 * branch-tab 1+ + 3 type ; 8 9 10 11 12 13 14 15 Screen 22 not modified 0 \ 1 \\ 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Screen 23 not modified 0 \ 1 internal 2 3 : MEDS \ op --- | 40-7f opcodes printed out 4 DUP 4 shift> 3 exec 5 REGS REGS OOPS1 .BRANCH STOP[ 6 7 : 80/81 \ op --- | secondary at 80 or 81 8 NEXTB ?DISP OVER 1 [and] IF WDISP ELSE BIMM THEN .# .MREG 9 SWAP .SIZE 3 shift> 7 EXEC 10 ADD OR ADC SBB AND SUB XOR CMP STOP[ 11 12 13 14 15 Screen 24 not modified 0 \ 1 internal 2 : 83S \ op --- | secondary at 83 3 NEXTB ?DISP BIMM .# .MREG 4 SWAP .SIZE 3 shift> 7 EXEC 5 ADD OOPS0 ADC SBB oops0 SUB OOPS0 CMP STOP[ 6 7 : 1GP \ op --- | r/m reg opcodes 8 CREATE LAST @ , DOES> @ >R NEXTB ?DISP .REG .MREG 2DROP 9 R> .name ; 10 11 external 1GP TEST 1GP XCHG .SELF LEA .SELF MOV internal 12 13 : MOVRM/REG NEXTB ?DISP .REG .MREG 2DROP MOV ; \ 88-89 14 : MOVD NEXTB .MREG .REG 2DROP MOV ; \ 8A-8B 15 Screen 25 not modified 0 \ 1 internal 2 : MOVS>M \ op --- | display instructions 8C-8E 3 NEXTB OVER $8D = IF .MREG .REG LEA ELSE 4 OVER $8F = IF .MREG [ ' POP >NAME ] LITERAL .name ELSE 5 SWAP 1 [or] SWAP \ 16 bit moves only, folks! 6 OVER 2 [and] IF .MREG DUP .SEG ELSE 7 DUP .SEG .MREG THEN MOV THEN THEN 2DROP ; 8 9 10 : 8MOVS \ op --- | display instructions 80-8F 11 DUP 2/ 7 exec 12 80/81 83S TEST XCHG MOVRM/REG MOVD MOVS>M MOVS>M STOP[ 13 14 15 Screen 26 not modified 0 \ 1 external 2 .SELF XCHG .SELF CBW .SELF CWD .SELF CALL .SELF NOP 3 .SELF WAIT .SELF PUSHF .SELF POPF .SELF SAHF .SELF LAHF 4 internal 5 6 : INTER \ --- | decode interseg jmp or call 7 NEXTW 4 u.r ." :" NEXTW U. ; 8 9 : CALLINTER \ --- | decode interseg call 10 INTER CALL ; 11 12 : 9HIS \ op --- | 98-9F decodes 13 7 exec 14 CBW CWD CALLINTER WAIT PUSHF POPF SAHF LAHF STOP[ 15 Screen 27 not modified 0 \ 1 internal 2 : XCHGA \ op --- | 98-9F decodes 3 dup $90 = IF drop NOP ELSE .A .16REG XCHG THEN ; 4 5 : 90S \ op --- | 90-9F decodes 6 DUP 3 shift> 1 exec XCHGA 9HIS STOP[ 7 8 : MOVSs \ op --- | A4-A5 decodes 9 .SIZE ." MOVS " ; 10 11 : CMPSs \ op --- | A6-A7 decodes 12 .SIZE ." CMPS " ; 13 14 15 Screen 28 not modified 0 \ 1 internal 2 : .AL/AX \ op --- | decodes for size 3 1 EXEC .A- .A STOP[ 4 5 : MOVS/ACC \ op --- | A0-A3 decodes 6 2 mask 7 IF .AL/AX WDISP ." ) " ELSE WDISP ." ) " .AL/AX THEN MOV ; 8 9 create ss-tab ," TESTSTOSLODSSCAS" 10 11 : .ss-tab 3 [and] 4 * ss-tab 1+ + 4 type space ; 12 13 : .TEST \ op --- | A8-A9 decodes 14 1 mask IF WDISP ELSE BIMM THEN .# .AL/AX 0 .ss-tab ; 15 Screen 29 not modified 0 \ 1 internal 2 : STOSs ( op --- ) .SIZE 1 .ss-tab ; \ STOS 3 : LODSs ( op --- ) .SIZE 2 .ss-tab ; \ LODS 4 : SCASs ( op --- ) .SIZE 3 .ss-tab ; \ SCAS 5 6 : A0S \ op --- | A0-AF decodes 7 DUP 2/ 7 exec 8 MOVS/ACC MOVS/ACC MOVSs CMPSs .TEST STOSs LODSs SCASs STOP[ 9 10 : MOVS/IMM \ op --- | B0-BF decodes 11 8 mask 12 IF WDISP .# .16REG ELSE BIMM .# .8REG THEN MOV ; 13 14 : HMEDS \ op --- | op codes 80 - C0 displayed 15 DUP 4 shift> 3 exec 8MOVS 90S A0S MOVS/IMM STOP[ Screen 30 not modified 0 \ 1 external 2 .SELF LES .SELF LDS .SELF INTO .SELF IRET 3 internal 4 5 : LES/LDS \ op --- | les/lds instruction C4-C5 6 NEXTB .MREG .REG DROP 1 exec LES LDS STOP[ 7 external 8 : RET \ op --- | return instruction C2-C3, CA-CB 9 1 mask 0= IF WDISP ." SP+" THEN 10 8 [and] IF ." FAR " THEN .myself ; 11 12 internal 13 : MOV#R/M \ op --- | return instruction C2-C3, CA-CB 14 NEXTB ?DISP OVER 1 [and] IF WDISP ELSE BIMM THEN .# 15 .MREG MOV 2DROP ; Screen 31 not modified 0 \ 1 external 2 3 : INT \ op --- | int instruction CC-CD 4 1 [and] IF NEXTB ELSE 3 THEN U. .myself ; 5 6 internal 7 : INTO/IRET \ op --- | int & iret instructions CE-CF 8 1 exec INTO IRET STOP[ 9 10 : C0S \ op --- | display instructions C0-CF 11 DUP 2/ 7 exec 12 OOPS1 RET LES/LDS MOV#R/M OOPS1 RET INT INTO/IRET STOP[ 13 14 15 Screen 32 not modified 0 \ 1 external 2 .SELF ROL .SELF ROR .SELF RCL .SELF RCR 3 .SELF SHL/SAL .SELF SHR .SELF SAR 4 internal 5 6 : SHIFTS \ op --- | secondary instructions d0-d3 7 2 mask IF 0 .8reg ( C-) THEN 8 NEXTB .MREG NIP 3 shift> 7 exec 9 ROL ROR RCL RCR SHL/SAL SHR OOPS0 SAR STOP[ 10 11 : XLAT DROP ." XLAT " ; 12 13 : ESC \ op --- | esc instructions d8-DF 14 NEXTB .MREG 3 shift> 7 [and] U. 7 [and] U. ." ESC " ; 15 Screen 33 not modified 0 \ 1 internal 2 : D0S \ op --- | display instructions D0-DF 3 8 mask IF ESC EXIT THEN 4 DUP 7 exec 5 SHIFTS SHIFTS SHIFTS SHIFTS .AAM .AAD OOPS1 XLAT STOP[ 6 7 external 8 .SELF LOOPE/Z .SELF LOOP .SELF JCXZ .SELF LOOPNE/NZ 9 internal 10 11 : LOOPS \ op --- | display instructions E0-E3 12 NEXTB SEXT CP@ + u. 3 exec 13 LOOPNE/NZ LOOPE/Z LOOP JCXZ STOP[ 14 15 external .SELF IN .SELF OUT .SELF JMP Screen 34 not modified 0 \ 1 internal 2 3 : IN/OUT \ op --- | display instructions E4-E6,EC-EF 4 8 mask 5 IF 2 mask IF .AL/AX .D OUT ELSE .D .AL/AX IN THEN 6 ELSE 2 mask 7 IF .AL/AX BIMM .# OUT ELSE BIMM .# .AL/AX IN THEN 8 THEN ; 9 10 11 12 13 14 15 Screen 35 not modified 0 \ 1 internal 2 : CALLs \ op --- | display instructions E7-EB 3 2 mask IF 1 mask IF NEXTB SEXT CP@ + u. 4 ELSE INTER THEN 5 ELSE NEXTW CP@ + u. THEN 6 3 exec CALL JMP JMP JMP STOP[ 7 8 : E0S \ op --- | display instructions E0-EF 9 DUP 2 shift> 3 EXEC LOOPS IN/OUT CALLs IN/OUT STOP[ 10 11 : FTEST \ op --- | display instructions F6,7:0 12 ?DISP OVER 1 [and] IF WDISP ELSE BIMM THEN .# 13 .MREG DROP .SIZE 0 .ss-tab ; \ TEST 14 15 Screen 36 not modified 0 \ 1 external 2 .SELF NOT .SELF NEG .SELF MUL .SELF IMUL 3 .SELF DIV .SELF IDIV .SELF REP/NZ .SELF REPZ 4 .SELF LOCK .SELF HLT .SELF CMC .SELF CLC 5 .SELF STC .SELF CLI .SELF STI .SELF CLD 6 .SELF STD .SELF INC .SELF DEC .SELF PUSH 7 internal 8 9 : MUL/DIV \ op ext --- | secondary instructions F6,7:4-7 10 .MREG .A OVER 1 [and] IF .D THEN NIP 11 3 shift> 3 exec MUL IMUL DIV IDIV STOP[ 12 13 14 15 Screen 37 not modified 0 \ 1 internal 2 : NOT/NEG \ op ext --- | secondary instructions F6,7:2,3 3 .MREG SWAP .SIZE 3 shift> 1 exec NOT NEG STOP[ 4 5 : F6-F7S \ op --- | display instructions F6,7 6 NEXTB DUP 3 shift> 7 exec FTEST OOPS2 NOT/NEG NOT/NEG 7 MUL/DIV MUL/DIV MUL/DIV MUL/DIV STOP[ 8 9 : FES \ op --- | display instructions FE 10 NEXTB .MREG ." BYTE " NIP 3 shift> 11 3 exec INC DEC oops oops STOP[ 12 13 : FCALL/JMP \ op ext --- | display call instructions FF 14 .MREG 3 shift> 1 mask IF ." FAR " THEN 15 NIP 2/ 1 exec JMP CALL STOP[ Screen 38 not modified 0 \ 1 internal 2 3 : FPUSH \ op ext --- | display push instructions FF 4 dup $FF = IF oops2 exit THEN \ FF FF gibt's nicht! 5 4 mask IF .MREG 2DROP PUSH EXIT THEN OOPS2 ; 6 7 : FINC \ op ext --- | display inc/dec instructions FF 8 .MREG NIP 3 shift> 1 exec INC DEC STOP[ 9 10 : FFS \ op --- | display instructions FF 11 NEXTB DUP 4 shift> 3 exec 12 FINC FCALL/JMP FCALL/JMP FPUSH STOP[ 13 14 15 Screen 39 not modified 0 \ 1 internal 2 3 : F0S \ op --- | display instructions F0-FF 4 &15 mask 7 mask 6 < IF NIP THEN -1 exec 5 LOCK OOPS0 REP/NZ REPZ HLT CMC F6-F7S F6-F7S 6 CLC STC CLI STI CLD STD FES FFS STOP[ 7 8 : HIGHS \ op -- | op codes C0 - FF displayed 9 DUP 4 shift> 3 exec C0S D0S E0S F0S STOP[ 10 11 : (INST) \ op --- | highest level vector table 12 &255 [and] DUP 6 shift> 13 -1 exec LOWS MEDS HMEDS HIGHS STOP[ 14 15 Screen 40 not modified 0 \ 1 internal 2 3 : INST \ --- | display opcode at ip, advancing as needed 4 [ disam ] .seg:off 5 NEXTB (INST) OPS @ CP +! OPS OFF IM OFF ; 6 7 : (DUMP) \ addr ct --- | dump as pointed to by reloc 8 [ forth ] BOUNDS ?do I TC@ u. LOOP ; 9 10 11 12 13 14 15 Screen 41 not modified 0 \ 1 internal 2 3 : steps? 4 1+ dup &10 mod 0= IF key #esc = exit THEN 0 ; 5 6 create next-code assembler next forth 7 8 : ?next ( steps-count -- steps-count ) 9 cp@ 2@ next-code 2@ D= 10 IF cr .seg:off ." NEXT Link= " cp@ 4+ @ U. 11 cp@ 6 + cp ! \ 4 bytes code, 2 byte link 12 drop 9 \ forces stop at steps? 13 THEN ; 14 15 Screen 42 not modified 0 \ ks 28 feb 89 1 forth definitions 2 3 external 4 5 : DISASM \ addr --- | disassemble until esc key 6 [ disam ] CP ! base [ forth ] push hex 0 7 BEGIN CP@ >R 8 CR INST R> CP@ OVER - &35 tab (DUMP) 9 ?next ?stack steps? 10 UNTIL drop ; 11 12 : dis ( -- ) ' @ disasm ; 13 14 15 Screen 43 not modified 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15