6502 Disassembler

\ disassembler 6502 loadscr    06mar86re 
Onlyforth
\needs Tools Vocabulary Tools

Tools also definitions hex

( FWORD is WORD for Fileload )
: FWORD 
       >IN @ #TIB @ = IF 
         REFILL 
          $7F > IF 
            ABORT" FileError" 
          THEN
       THEN
       TIB #TIB @ 
       3251 EXECUTE ;
       

| : tabelle  ( +n -- )    
 Create
 0 DO  
   $20 fword 
   number drop ,
 LOOP
 Does> ( 8b1 -- 8b2 +n )
 + count swap c@ ;

\ dis shortcode0
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

| 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

| : shortcode ( 8b1 -- +n )
 dup 1 and         ( uneven codes)
 IF  dup $89 =
  IF  drop 2  THEN  shortcode1
 ELSE  shortcode0  ( even codes)
 THEN
 swap dup 3 and length !
 2/ 2/ 2/ 2/ mode ! ;

| : texttab   ( char +n 8b -- )
 Create
 dup c, swap 0 DO >r dup fword
 1+ here r@ cmove r@ allot r>
 LOOP 2drop
 Does>  ( +n -- )
 count >r swap r@ * + r> type ;

\ dis text-tabellen

$20 $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 .before
 / /a/ /z/#/ / /(/(/z/z/ /(/

Ascii / $E 3 | texttab .after
   /   /   /   /   /   /,x /,y /,x)/),y//,x /,y /   /)   /

\ dis 2u.r 4u.r

: 4u.r ( u -)
  0 <# # # # # #> type ;

: 2u.r ( u -)
  0 <# # # #> type ;

\ dis

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 .before $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 @ .after length @ +
 stop?  UNTIL drop ;
VolksForth

6502 Disassembler
