mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-07-09 14:29:01 +00:00
749 lines
48 KiB
Plaintext
749 lines
48 KiB
Plaintext
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
|