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