VolksForth/msdos/disasm.fb

\                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               \ 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 ;