Disassembler 6809

' 0 Inhérent    ex:$0000 $4C          INCA
' 1 Immédiat    ex:$0001 $861F        LDA     #$1F
' 2 Immédiat2   ex:$0002 $CC3000      LDD     #$3000
' 3 Direct      ex:$0003 $965C        LDA     \<$5C
' 4 Indexé      ex:$0004 $A64B        LDA     $4B,X
' 5 Etendu      ex:$0005 $B64100      LDA     $4100
' 6 Relatif     ex:$0006 $2040        BRA     $0048
CLEAR
mainmenu:
init
adr%=MALLOC(8192,0)
charger
a%=adr%
b%=&H1F0
l%=10
DO
  desassemble(a%,b%,l%)
  REPEAT
  UNTIL MOUSEK
  PRINT a$;
  b%=b2%
LOOP
b%=MFREE(adr%,4096)
END
\> PROCEDURE init
  DIM mnem$(90),mnem|(255),mnem2|(255),d|(255),o|(6)
  FOR x|=0 TO 255
    READ mnem$(x|)
    EXIT IF mnem$(x|)=""
  NEXT x|
  FOR x|=0 TO 255
    READ a$
    a|=VAL("&"+LEFT$(a$,2))
    b|=VAL("&"+RIGHT$(a$,2))
    mnem|(x|)=a|
    mnem2|(x|)=b|
  NEXT x|
  i|=0
  DO
    READ a$,b$
    EXIT IF a$="FIN"
    a|=VAL("&"+a$)
    b|=VAL("&"+b$)
    FOR i|=i| TO b|
      d|(i|)=a|
    NEXT i|
  LOOP
  FOR i%=0 TO 255
    READ a%
    EXIT IF a%=256
    o|(i%)=a%
  NEXT i%
  '
  ' MNEM ascii
  '
  DATA ?,A,AB,ADC,ADD,AND,ASL,ASR,B,BC,BG,BH,BIT,BL,BM,BN,BR,BV,C,CB,CL
  DATA CLR,CMP,COM,CP,D,DA,DE,DEC,E,EOR,EQ,I,IN,INC,J
  DATA LD,LSR,MP,MUL,N,NEG,NOP,O,OR,P,PL,PSH,PUL,ROL,ROR,RT,S,SB,SBC
  DATA SE,SR,ST,SUB,SW,T,TA,TB,TP,TS,TST,TX,V,WA,X,
  '
  ' MNEM code
  '
  '      0    1    2    3    4    5    6    7    8    9    A    B    C    D
  DATA     ,2A46,    ,    ,2519,0619,3D2D,3F01,2145,1B45,1443,3743,1412,3712,1420,3720
  DATA 3501,1301,    ,    ,    ,    ,3D08,3E01,    ,1A01,    ,0201,    ,    ,    ,
  DATA 1001,1028,0B20,0D34,0B34,0934,0F1D,081F,1112,1134,082E,0E20,0A1D,0D3C,0A3C,0D1D
  DATA 4045,2134,3001,3008,1B34,4234,2F01,2F08,3045,3334,0245,3320,2F45,2746,4420,3B20
  DATA 2901,    ,    ,1701,2501,    ,3201,0701,0601,3101,1C01,    ,2201,4101,    ,1501
  DATA 2908,    ,    ,1708,2508,    ,3208,0708,0608,3108,1C08,    ,2208,4108,    ,1508
  DATA 2946,    ,    ,1746,2546,    ,3246,0746,0646,3146,1C46,    ,2246,4146,2326,1546
  DATA 2946,    ,    ,1746,2546,    ,3246,0746,0646,3146,1C46,    ,2246,4146,2326,1546
  DATA 3A01,1601,3601,3A19,0501,0C01,2401,    ,1E01,0301,2C01,0401,1845,0838,2434,
  DATA 3A01,1601,3601,3A19,0501,0C01,2401,3901,1E01,0301,2C01,0401,1845,2338,2434,3934
  DATA 3A01,1601,3601,3A19,0501,0C01,2401,3901,1E01,0301,2C01,0401,1845,2338,2434,3934
  DATA 3A01,1601,3601,3A19,0501,0C01,2401,3901,1E01,0301,2C01,0401,1845,2338,2434,3934
  DATA 3A08,1608,3608,0419,0508,0C08,2408,    ,1E08,0308,2C08,0408,2419,    ,2445,
  DATA 3A08,1608,3608,0419,0508,0C08,2408,3908,1E08,0308,2C08,0408,2419,3919,2445,3945
  DATA 3A08,1608,3608,0419,0508,0C08,2408,3908,1E08,0308,2C08,0408,2419,3919,2445,3945
  DATA 3A08,1608,3608,0419,0508,0C08,2408,3908,1E08,0308,2C08,0408,2419,3919,2445,3945
  '
  ' Mode d'adressage pour chaque code.
  '
  DATA 0,1F,6,2F,0,5F,4,6F,5,7F,1,82,2,83,1,8B,2,8F,3,9F,4,AF,5,BF
  DATA 1,C2,2,C3,1,CB,2,CF,3,DF,4,EF,5,FF,FIN,FIN
  DATA 0,1,2,1,1,2,1,256
RETURN
\> PROCEDURE charger
  FILESELECT "Read Binary","Charger","",a$
  BLOAD a$,adr%
RETURN
\> PROCEDURE desassemble(a%,b%,l%)
  b2%=b%
  a$=""
  FOR i%=1 TO l%
    a2%=a%+b2%
    code|=PEEK(a2%)
    mnem|=mnem|(code|)
    mnem2|=mnem2|(code|)
    mnem$=mnem$(mnem|)+mnem$(mnem2|)
    a$=a$+HEX$(b2%,4)+" "
    IF mnem|\<\>0
      d|=d|(code|)
    ELSE
      d|=0
    ENDIF
    o|=o|(d|)
    FOR i2|=0 TO o|
      a$=a$+FN peek$(a2%+i2|)
    NEXT i2|
    a$=a$+SPACE$(5-2*o|)+mnem$+SPACE$(5-LEN(mnem$))
    INC a2%
    IF d|=1
      a$=a$+"#"+FN peek$(a2%)
    ELSE IF d|=2
      a$=a$+"#"+FN dpeek$(a2%)
    ELSE IF d|=3
      a$=a$+"\<"+FN peek$(a2%)
    ELSE IF d|=4
      a$=a$+FN peek$(a2%)+",X"
    ELSE IF d|=5
      a$=a$+FN dpeek$(a2%)
    ELSE IF d|=6
      v&=PEEK(a2%)
      IF v&\>127
        SUB v&,256
      ENDIF
      a$=a$+HEX$(b2%+v&+1,4)
    ENDIF
    a$=a$+CHR$(10)
    IF mnem$="RTS" OR mnem$="BRA"
      a$=a$+STRING$(22,"*")+CHR$(10)
    ENDIF
    ADD b2%,o|+1
  NEXT i%
  DEFFN peek$(a%)=HEX$(PEEK(a%),2)
  DEFFN dpeek$(a%)=HEX$(PEEK(a%),2)+HEX$(PEEK(a%+1),2)
RETURN