VolksForth/sources/msdos/disasm.fb.src

749 lines
48 KiB
Plaintext
Raw Normal View History

2017-04-23 22:25:49 +00:00
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 <name> 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 ( <name> -- ) ' @ disasm ;
13
14
15
Screen 43 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15