DISASM.4TH

BYE
( 6502 DISASSEMBLER by JOHN MATTES        )
( ANTIC 3/84 W/ ERRATA FROM 4/84          )
( https://archive.org/details/1984-03-anticmagazine/page/74/mode/2up )
( https://archive.org/details/1984-08-anticmagazine/page/n5/mode/2up )
( https://archive.org/details/1984-11-anticmagazine/page/52/mode/1up )
( WORKS W/ ATARI APX FIG-FORTH REV. 2     )
( MAY WORK W/ TEAM ATARI FIG-FORTH 1.4S?  )
( DOES NOT WORK W/ VALFORTH?              )
( "TABLE OF ADDRESS MODES" - MISSING      )
( REQUIRES EDITOR TO LOAD ONTO SCREENS    )
( REQUIRES ALIRRA TO PASTE THE CODE       )
( USE "27 LOAD" in APX OR TUNE/REMOVE:    )
(   EDITOR, xx SCR !, xx P, -->           )
( BELOW USES SCRS 84-88, NOT ORIG. 30-35  )
( NOTE, REMEMBER TO "FLUSH" IF NO ERRORS  )
( TO RUN > ' SOMEWORD DIS > e.g. ' @ DIS  )
( RESULTS ARE OFTEN DOUBTFUL, PLEASE TEST )
( AND TEST IF 80/8 IS @ OR C@ - BUG?      )
( SEE ALSO: https://www.reddit.com/r/Forth/comments/18yh02m/atari_8bit_6502_disassembler/ )
( FOR SUGGESTED IMPROVEMENTS              )

EDITOR

84 SCR !
   0 P ( 1/5 FORTH DISASSEMBLER ) HEX
   1 P   0 VARIABLE POINTER 0 VARIABLE MULTIMODE 
   2 P   -2 ALLOT 1D , 1E , 3C , 3D , 3E , 5C , 
   3 P   5D , 5E , 7D , 7E , 9C , 9D ,
   4 P   9E , BC , BD , BE , DC , DD ,
   5 P   DE , FC , FD , FE ,
   6 P : SEEKD 1 + 0 DO OVER OVER I 2
   7 P   * + C@ - DUP 0= IF DROP
   8 P   DROP DROP I 1 LEAVE ELSE  
   9 P   0 < IF DROP DROP I 0 LEAVE   
  10 P   ENDIF ENDIF LOOP ;   
  11 P : STRING ( COMPILE TEXT )    
  12 P   BL BLK @ IF BLK @ BLOCK ELSE
  13 P   TIB @ ENDIF IN @ + SWAP
  14 P   ENCLOSE IN +! OVER - >R +
  15 P   HERE R CMOVE R> ALLOT ; -->

85 SCR !
   0 P ( 2/5 FORTH DISASSEMBLER )
   1 P   0 VARIABLE MULTINAME -2 ALLOT
   2 P   STRING ORAASLBITANDROLJMPEORLSR    
   3 P   STRING ADCRORSTYSTASTXLDYLDALDX    
   4 P   STRING CPYCMPDECCPXSBCINC    
   5 P : CHKMODE DROP DUP 2 * '
   6 P   MULTIMODE + @ POINTER @ C@ -
   7 P   4 /MOD SWAP IF SWAP 1+ SWAP ENDIF ; 
   8 P 0 VARIABLE ONENAME -2 ALLOT
   9 P   STRING BRKPHPASLBPLCLCJSRPLPROL
  10 P   STRING BMISECRTIPHALSRBVCCLIRTS
  11 P   STRING PLARORJMPBVSSEIDEYTXABCC
  12 P   STRING STXTYATXSLDYLDXTAYTAXBCS
  13 P   STRING LDXCLVTSXLDXINYDEXBNECLD
  14 P   STRING INXNOPBEQSED???
  15 P -->

86 SCR !
   0 P ( 3/5 FORTH DISASSEMBLER )
   1 P   0 VARIABLE ONEMODE -2 ALLOT
   2 P     2C00 , 2C08 , 280A , 3010 ,
   3 P     2C18 , 1020 , 2C28 , 282A ,
   4 P     3030 , 2C38 , 2C40 , 2C48 ,
   5 P     284A , 3050 , 2C58 , 2C60 ,
   6 P     2C68 , 286A , 246C , 3070 ,
   7 P     2C78 , 2C88 , 2C8A , 3090 ,
   8 P     2096 , 2C98 , 2C9A , 14A0 ,
   9 P     14A2 , 2CA8 , 2CAA , 30B0 ,
  10 P     20B6 , 2CB8 , 2CBA , 04BE ,
  11 P     2CC8 , 2CCA , 30D0 , 2CD8 ,
  12 P     2CE8 , 2CEA , 30F0 , 2CF8 , 00FF , 
  13 P   0 VARIABLE MODE -2 ALLOT
  14 P     STRING ,X,Y,X)Y..##0PX).Y().AIMRE
  15 P -->

87 SCR !
   0 P ( 4/5 FORTH DISASSEMBLER )
   1 P   0 VARIABLE LENGTH -2 ALLOT
   2 P     2 C, 2 C, 1 C, 1 C, 2 C, 1 C,
   3 P     1 C, 1 C, 1 C, 2 C, 0 C, 0 C,
   4 P     1 C, 0 C,
   5 P : .NAME SPACE SWAP 3 * + 3 TYPE 2 SPACES ;
   6 P : .MODE 2 * ' MODE + 2 TYPE 2 SPACES ;           
   7 P : .ADD POINTER @ C@ DUP 20
   8 P     = OVER 40 = OR OVER 4C = OR
   9 P     OVER 60 = OR SWAP 6C = OR
  10 P     SWAP ' LENGTH + C@ 1 POINTER
  11 P     +! POINTER @ OVER POINTER +!
  12 P     OVER 0= IF DROP DROP ELSE
  13 P     OVER 1 = IF C@ . DROP ELSE
  14 P     @ 0 D. DROP ENDIF ENDIF ; 
  15 P --> (  TEST: ' ASMWORD DIS )

88 SCR !
   0 P ( 5/5 FORTH DISASSEMBLER )
   1 P : DIS POINTER ! CR BEGIN CR
   2 P     POINTER @ DUP 0 D. 2 SPACES
   3 P     C@ ' ONEMODE 2D SEEKD
   4 P       IF ( FOUND ) DUP ' ONENAME
   5 P          .NAME 2 * 1+ '
   6 P          ONEMODE + C@ 4 /
   7 P       ELSE ( NOT ) DROP POINTER @
   8 P          C@ ' MULTIMODE 16 SEEKD
   9 P          CHKMODE CHKMODE CHKMODE
  10 P          SWAP ' MULTINAME
  11 P          .NAME ENDIF
  12 P     DUP .MODE .ADD
  13 P     ?TERMINAL OR
  14 P   UNTIL ; : DISASSEMBLE DIS ;
  15 P DECIMAL ;S  ( ANTIC 3/84 )


FLUSH