\ disassembler 6502 loadscr    06mar86re 
                                         
Onlyforth                                
                                         
\needs Tools Vocabulary Tools            
                                         
Tools also definitions hex               
                                         
| : tabelle  ( +n -- )                   
 Create     0 DO                         
 bl word number drop , LOOP              
 Does> ( 8b1 -- 8b2 +n )                 
 + count swap c@ ;                       

\ dis shortcode0               20oct87re 
                                         
base @  hex                              
                                         
$80 | tabelle shortcode0                 
0B10 0000 0000 0341 2510 0320 0000 0332  
0AC1 0000 0000 03A1 0E10 0000 0000 0362  
1D32 0000 0741 2841 2710 2820 0732 2832  
08C1 0000 0000 28A1 2D10 0000 0000 2862  
2A10 0000 0000 2141 2410 2120 1C32 2132  
0CC1 0000 0000 21A1 1010 0000 0000 2162  
2B10 0000 0000 2941 2610 2920 1CD2 2932  
0DC1 0000 0000 29A1 2F10 0000 0000 2962  
0000 0000 3241 3141 1710 3610 3232 3132  
04C1 0000 32A1 31B1 3810 3710 0000 0000  
2051 1F51 2041 1F41 3410 3310 2032 1F32  
05C1 0000 20A1 1FB1 1110 3510 2062 1F72  
1451 0000 1441 1541 1B10 1610 1432 1532  
09C1 0000 0000 15A1 0F10 0000 0000 1562  
1351 0000 1341 1941 1A10 2210 1332 1932  
06C1 0000 0000 19A1 2E10 0000 0000 1962  
                                         
base !                                   
                                         
\ dis scode adrmode            20oct87re 
                                         
| Create scode                           
 $23 c, $02 c, $18 c, $01 c,             
 $30 c, $1e c, $12 c, $2c c,             
                                         
| Create adrmode                         
 $81 c, $41 c, $51 c, $32 c,             
 $91 c, $a1 c, $72 c, $62 c,             
                                         
| : shortcode1 ( 8b1 - 8b2 +n)           
 2/ dup 1 and                            
 IF  0= 0  exit  THEN                    
 2/ dup $7 and adrmode + c@              
 swap 2/ 2/ 2/ $7 and scode + c@ ;       
                                         
| Variable mode                          
                                         
| Variable length                        
                                         
                                        
\ dis shortcode texttab        06mar86re 
                                         
| : shortcode ( 8b1 -- +n )              
 dup 1 and         ( ungerade codes)     
 IF  dup $89 =                           
  IF  drop 2  THEN  shortcode1           
 ELSE  shortcode0  ( gerade codes)       
 THEN                                    
 swap dup 3 and length !                 
 2/ 2/ 2/ 2/ mode ! ;                    
                                         
| : texttab   ( char +n 8b -- )          
 Create                                  
 dup c, swap 0 DO >r dup word            
 1+ here r@ cmove r@ allot r>            
 LOOP 2drop                              
 Does>  ( +n -- )                        
 count >r swap r@ * + r> type ;          
                                         
                                        
\ dis text-tabellen            06mar86re 
                                         
bl $39 3 | texttab .mnemonic             
*by adc and asl bcc bcs beq bit bmi bne  
bpl brk bvc bvs clc cld cli clv cmp cpx  
cpy dec dex dey eor inc inx iny jmp jsr  
lda ldx ldy lsr nop ora pha php pla plp  
rol ror rti rts sbc sec sed sei sta stx  
sty tax tay tsx txa txs tya              
( +n -- )                                
                                         
Ascii / $E 1 | texttab .vor              
   / /a/ /z/#/ / /(/(/z/z/ /(/           
                                         
Ascii / $E 3 | texttab .nach             
     /   /   /   /   /   /,x             
 /,y /,x)/),y/,x /,y /   /)  /           
                                        
\ dis 2u.r 4u.r                06mar86re 
                                         
: 4u.r ( u -)                            
  0 <# # # # # #> type ;                 
                                         
: 2u.r ( u -)                            
  0 <# # # #> type ;                     
                                         
-->                                      
                                         
\ dis                          20oct87re 
                                         
Forth definitions                        
                                         
: dis   ( adr -- ) base push hex         
BEGIN                                    
 cr dup 4u.r space dup c@ dup 2u.r space 
 shortcode >r length @ dup               
 IF over 1+ c@ 2u.r space THEN dup 2 =   
 IF over 2+ c@ 2u.r space THEN           
 2 swap - 3 * spaces                     
 r> .mnemonic space 1+                   
 mode @ dup .vor $C =                    
 IF dup c@ dup $80 and IF $100 - THEN    
  over + 1+ 4u.r                         
 ELSE length @ dup 2 swap - 2* spaces    
  ?dup                                   
  IF 2 =                                 
   IF   dup  @ 4u.r                      
   ELSE dup c@ 2u.r                      
 THEN THEN THEN mode @ .nach length @ +  
 stop?  UNTIL drop ;                     
