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                                                                 
