PACKET z80 disassembler DEFINES hex, dez, disassemble, disass , acht :
 
LET max = 4096; (* Anzahl Bytes der ROW DIV 2 *) 
 
BOUND ROW max INT VAR row; 
 
INT VAR next byte, 
        next word, 
        byte, 
        div 8, 
        and 7, 
        and f, 
        div 10; 
TEXT VAR index; 
 
belegen (0,0,0);
 
INT PROC dez (TEXT CONST wert) : 
  TEXT VAR zahl := wert; 
  INT VAR i; 
  REAL VAR summe := 0.0; 
  IF (zahl SUB 1) = "!" THEN int(subtext(zahl, 2)) 
  ELIF (zahl SUB 1) = "%" THEN zahl := subtext(zahl, 2); 
     FOR i FROM length(zahl) DOWNTO 1 REP 
       summe INCR (2.0**(length(zahl) - i))* real(number)
     PER; 
     IF summe > 32767.0 THEN int (summe - 65536.0) 
                        ELSE int (summe) 
     FI 
  ELSE IF (zahl SUB 1) = "$" THEN zahl := subtext(zahl, 2) FI; 
     FOR i FROM length(zahl) DOWNTO 1 REP 
       summe INCR (16.0**(length(zahl) - i))* real(number) 
     PER; 
     IF summe > 32767.0 THEN int (summe - 65536.0) 
                        ELSE int (summe) 
     FI 
  FI. 
 
number : 
  IF (zahl SUB i) > "9" 
     THEN code( zahl SUB i) -55 
     ELSE int (zahl SUB i) 
  FI 
ENDPROC dez; 
 
PROC disassemble (TEXT CONST source code) : 
    row := old(source code); 
    INT VAR counter, start, pc, b1, b2, b3, b4, ende; 
    TEXT VAR addr; 
    page;
    out ("         "15"                    Z80 - DISASSEMBLER                   "14""13""10""10"");
    out ("F� r Adressangaben: $ = hex, % = bin� r, ! = dezimal."13""10""10""); 
    out ("Hexadezimale Eingaben mit den Zeichen 0 bis F."13""10""10""); 
    out ("Disassemblierung mit ESC abbrechen."13""10""10""); 
    out ("Addresse des ersten Eintrags der Liste:"); 
    addr:="$0000"; 
    editget(addr); 
    start := dez(addr); 
  REP
    REP
    out (""10""13""); 
    out ("Startaddresse f� r Disassemblierung    :"); 
    addr:="$0000"; 
    editget (addr); 
    pc := dez(addr); 
    UNTIL positive int (pc) >= positive int (start) PER;
    REP
    out (""10""13""); 
    out ("Endaddresse f� r Disassemblierung      :"); 
    addr:="$FFFF"; 
    editget (addr); 
    out (""10""13""); 
    ende := dez(addr); 
    UNTIL positive int (ende) >= positive int (pc) PER; 
    REP 
      berechne b1 bis b4; 
      put (text(hex(pc),4)); 
      put(""); 
      dump; 
      put (" ");
      disass (b1, b2, b3, b4, pc); 
      line; 
    UNTIL isincharety (""27"") OR positiveint (pc) > positive int (ende) PER 
  UNTIL no ("Noch weitere Bereiche disassemblieren") PER.
 
berechne b1 bis b4 : 
   counter := pc - start; 
   b1 := acht (counter ); 
   b2 := acht (counter + 1); 
   b3 := acht (counter + 2); 
   b4 := acht (counter + 3). 
 
dump : 
   put (                   text(hex(b1),3)+ 
                           text(hex(b2),3)+
                           text(hex(b3),3)+ 
                           text(hex(b4),3));
   put (""142"" + ascii(b1) + ascii(b2) + ascii(b3) + ascii(b4) + ""143"");
 
ENDPROC disassemble; 
 
TEXT PROC ascii (INT CONST byte) : 
   IF (byte MOD 128) < 32 OR (byte MOD 128) = 127 THEN "." 
     ELSE code(byte) 
   FI 
ENDPROC ascii; 
 
REAL PROC positive int (INT CONST wert) : 
     IF wert < 0 THEN real(wert) + 65536.0 
     ELSE real(wert) 
     FI 
ENDPROC positive int; 
 
 
INT PROC acht (INT CONST pos) : 
   IF (pos DIV 2) + 1 > max THEN LEAVE acht WITH 0 FI; 
   INT CONST word := row (pos DIV 2 + 1); 
   TEXT VAR w := "  "; 
   replace (w, 1, word) ;
   IF  (pos MOD 2) = 1 THEN code(w SUB 1) 
                       ELSE code(w SUB 2) 
   FI 
ENDPROC acht; 
 
TEXT PROC hex (INT CONST zahl) : 
    IF zahl < 0 
       THEN digit (((zahl XOR -1) DIV 4096) XOR 15) + 
            hex   (zahl MOD 4096) 
    ELIF zahl < 16 
       THEN digit (zahl) 
       ELSE hex (zahl DIV 16) + digit (zahl MOD 16) 
   FI 
ENDPROC hex; 
 
TEXT PROC digit (INT CONST d) : 
   IF d < 10 
      THEN code(d + 48) 
      ELSE code(d + 55) 
   FI 
ENDPROC digit; 
 
PROC belegen (INT CONST b1, b2, b3) : 
    byte := b1; 
    next byte := b2; 
    next word := (code(b3)+code(b2)) ISUB 1; 
    and 7 := byte AND 7; 
    and f := byte AND 15; 
    div 10:= byte DIV 16; 
    div 8 := byte DIV 8 AND 7; 
ENDPROC belegen; 
 
PROC counter incr 1 (INT CONST b2, b3, b4) : 
    byte := b2; 
    next byte := b3; 
    next word := (code(b4)+code(b3)) ISUB 1; 
    and 7 := byte AND 7; 
    and f := byte AND 15; 
    div 10:= byte DIV 16; 
    div 8 := byte DIV 8 AND 7; 
ENDPROC counter incr 1;
 
PROC counter incr 2 (INT CONST b3, b4) : 
    byte := b3; 
    next byte := b4; 
    next word := b4;
    and 7 := byte AND 7; 
    and f := byte AND 15; 
    div 10:= byte DIV 16; 
    div 8 := byte DIV 8 AND 7; 
ENDPROC counter incr 2;
 
PROC disass (INT CONST b1, b2, b3, b4, INT VAR counter): 
   counter INCR int disass (b1, b2, b3, b4, counter) 
ENDPROC disass;

TEXT PROC arith log :
    SELECT div 8 OF 
       CASE 0 : "ADD" 
       CASE 1 : "ADC" 
       CASE 2 : "SUB" 
       CASE 3 : "SBC" 
       CASE 4 : "AND" 
       CASE 5 : "XOR" 
       CASE 6 : "OR" 
       CASE 7 : "CP"
    OTHERWISE "???" 
  ENDSELECT 
 
ENDPROC arith log; 
 
TEXT PROC reg1 : 
    SELECT div8 OF 
      CASE 0 : "B" 
      CASE 1 : "C" 
      CASE 2 : "D" 
      CASE 3 : "E" 
      CASE 4 : "H" 
      CASE 5 : "L" 
      CASE 6 : "(HL)" 
      CASE 7 : "A" 
      OTHERWISE "???" 
    ENDSELECT 
 
ENDPROC reg1; 
 
TEXT PROC reg2 : 
    SELECT and7 OF 
      CASE 0 : "B" 
      CASE 1 : "C" 
      CASE 2 : "D" 
      CASE 3 : "E" 
      CASE 4 : "H" 
      CASE 5 : "L" 
      CASE 6 : "(HL)" 
      CASE 7 : "A" 
      OTHERWISE "???" 
    ENDSELECT 
 
ENDPROC reg2; 
 
TEXT PROC rp: 
    SELECT div10 AND 3 OF 
      CASE 0 : "BC" 
      CASE 1 : "DE" 
      CASE 2 : "HL" 
      CASE 3 : "SP"
      OTHERWISE "???" 
    ENDSELECT 
 
ENDPROC rp; 
 
 
INT PROC bitmanipulation : 
   SELECT byte DIV 32 OF 
     CASE 1 : write ("BIT "+text(div8)+","+reg2);2 
     CASE 2 : write ("RES "+text(div8)+","+reg2);2 
     CASE 3 : write ("SET "+text(div8)+","+reg2);2 
     OTHERWISE write("??? $"+hex(next byte));1 
   ENDSELECT 
 
ENDPROC bitmanipulation;
 
BOOL PROC is special instruction : 
   byte > 192 AND (and 7 = 3 OR 
                   and 7 = 6 OR 
                   and f = 9 ) 
OR byte < 64  AND (and 7 = 7 OR 
                   and 7 = 0 OR 
                   and 7 = 2 ) . 
 
ENDPROC is special instruction; 
 
INT PROC int disass (INT CONST b1, b2, b3, b4, counter) : 
    belegen (b1, b2, b3); 
    IF is special instruction 
       THEN disass special instruction 
    ELIF div 10 < 4 
       THEN lower case instruction 
    ELIF div 10 < 128 
       THEN ld instruction 
    ELIF div 10 < 192 
       THEN arith log instruction 
    ELSE higher case instruction 
    FI. 
 
arith log instruction : 
    write (arith log+" "+reg 2);1 . 
 
ld instruction : 
  write ("LD "+reg 1+","+reg 2);1 . 
 
condition code : 
    SELECT div8 OF 
      CASE 0 : "NZ" 
      CASE 1 : "Z" 
      CASE 2 : "NC" 
      CASE 3 : "C" 
      CASE 4 : "PO" 
      CASE 5 : "PE" 
      CASE 6 : "P" 
      CASE 7 : "M" 
      OTHERWISE "???" 
    ENDSELECT. 
 
lower case instruction : 
   IF and f = 1 THEN write ("LD "+rp+",$"+hex(next word));3 
 ELIF and 7 = 3 THEN write ("INC "+rp);1 
 ELIF and 7 = 4 THEN write ("INC "+reg1);1 
 ELIF and 7 = 5 THEN write ("DEC "+reg1);1 
 ELIF and 7 = 6 THEN write ("LD "+reg1+",$"+hex(next byte));2 
 ELIF and f = 9 THEN write ("ADD HL,"+rp);1 
 ELIF and f =11 THEN write ("DEC "+rp);1 
 ELSE write ("??? $"+hex(next byte));1 
 FI. 
 
higher case instruction : 
   SELECT and 7 OF 
      CASE 0 : write ("RET "+condition code);1 
      CASE 1 : write ("POP "+rp);1 
      CASE 2 : write ("JP "+condition code+",$"+hex(next word));3 
      CASE 4 : write ("CALL "+condition code+",$"+hex(next word));3 
      CASE 5 : write ("PUSH "+rp);1 
      CASE 7 : write ("RST "+text(div 8));1 
      OTHERWISE write ("??? $"+hex(next byte));1 
   ENDSELECT. 
 
 
branchaddress : 
     "$" + hex(counter + displacement) . 
 
displacement : 
     IF next byte < 128 
        THEN next byte + 2
        ELSE next byte - 254 
     FI. 
 
cb instructions : 
   counter incr 1 (b2, b3, b4);
   SELECT div 8 OF 
     CASE 0 : write ("RCC "+reg2);2 
     CASE 1 : write ("RRC "+reg2);2 
     CASE 2 : write ("RL "+reg2);2 
     CASE 3 : write ("RR "+reg2);2 
     CASE 4 : write ("SLA "+reg2);2 
     CASE 5 : write ("SRA "+reg2);2 
     CASE 6 : write ("SLL "+reg2);2 
     CASE 7 : write ("SLR "+reg2);2 
     OTHERWISE bitmanipulation 
   ENDSELECT . 
 
disass special instruction : 
   SELECT byte OF 
     CASE 0  : write ("NOP");1 
     CASE 2  : write ("LD (BC),A");1 
     CASE 7  : write ("RLCA");1 
     CASE 8  : write ("EX AF,AF'");1 
     CASE 10 : write ("LD A,(BC)");1 
     CASE 15 : write ("RRCA");1 
     CASE 16 : write ("DJNZ "+branchaddress);2 
     CASE 18 : write ("LD (DE),A");1 
     CASE 23 : write ("RLA");1 
     CASE 24 : write ("JR "+branchaddress);2 
     CASE 26 : write ("LD A,(DE)");1 
     CASE 31 : write ("RRA");1 
     CASE 32 : write ("JR NZ,"+branchaddress);2 
     CASE 34 : write ("LD ($"+hex (next word)+"),HL");3 
     CASE 39 : write ("DAA");1 
     CASE 40 : write ("JR Z,"+branchaddress);2 
     CASE 42 : write ("LD HL,($"+hex(next word)+")");3 
     CASE 47 : write ("CPL");1 
     CASE 48 : write ("JR NC,"+branchaddress);2 
     CASE 50 : write ("LD ($"+hex(next word)+"),A");3 
     CASE 55 : write ("SCF");1 
     CASE 56 : write ("JR C,"+branchaddress);2 
     CASE 58 : write ("LD A,($"+hex(next word)+")");3 
     CASE 63 : write ("CCF");1 
     CASE 118: write ("HALT");1 
     CASE 195: write ("JP $"+hex(next word));3 
     CASE 198: write ("ADD A,$"+hex(next byte));2 
     CASE 201: write ("RET");1 
     CASE 203: cb instructions 
     CASE 205: write ("CALL $"+hex(next word));3 
     CASE 206: write ("ADC A,$"+hex(next byte));2 
     CASE 211: write ("OUT ($"+hex(next byte)+")");2 
     CASE 214: write ("SUB A,$"+hex(next byte));2 
     CASE 217: write ("EXX");1 
     CASE 219: write ("IN ($"+hex(next byte)+")");2
     CASE 221: index := "IX"; dd and fd instructions 
     CASE 222: write ("SBC A,$"+hex(next byte));2 
     CASE 227: write ("EX (SP),HL");1 
     CASE 230: write ("AND $"+hex(next byte));2 
     CASE 233: write ("JP (HL)");1 
     CASE 235: write ("EX DE,HL");1 
     CASE 237: ed instructions 
     CASE 238: write ("XOR $"+hex(next byte));2 
     CASE 243: write ("DI");1 
     CASE 246: write ("OR $"+hex(next byte));2 
     CASE 249: write ("LD SP,HL");2 
     CASE 251: write ("EI");1 
     CASE 253: index := "IY"; dd and fd instructions 
     CASE 254: write ("CP $"+hex(next byte));2 
   OTHERWISE write ("??? $"+hex(byte));1 
   ENDSELECT. 
 
dd and fd instructions : 
   counter incr 1 (b2, b3, b4); 
   SELECT byte OF 
     CASE 33 : write ("LD "+index+",$"+hex(next word));4 
     CASE 34 : write ("LD ($"+hex(next word)+"),"+index);4 
     CASE 35 : write ("INC "+index);2 
     CASE 42 : write ("LD "+index+",($"+hex(next word)+")");4 
     CASE 43 : write ("DEC "+index);2 
     CASE 52 : write ("INC ("+index+"+$"+hex(next byte)+")");2 
     CASE 53 : write ("DEC ("+index+"+$"+hex(next byte)+")");2 
     CASE 203: dd and fd cb instructions
     CASE 225: write ("POP "+index);2 
     CASE 227: write ("EX (SP),"+index);2 
     CASE 229: write ("PUSH "+index);2 
     CASE 233: write ("JP ("+index+")");2 
     CASE 249: write ("LD SP,"+index);2 
   OTHERWISE calculated dd and fd instructions 
   ENDSELECT. 
 
calculated dd and fd instructions : 
     IF andf = 9 THEN write ("ADD "+index+","+rp);2 
   ELIF and7 = 6 AND div 10 > 3 AND div 10 < 8
      THEN write ("LD "+reg1+",("+index+"+$"+hex(next byte)+")");3 
   ELIF div 10 = 7 AND byte <> 118 
      THEN write ("LD ("+index+"+$"+hex(next byte)+"),"+reg2);3 
   ELIF and7 = 6 AND div 10 > 7 AND div 10 < 12 
      THEN write (arith log+" ("+index+"+$"+hex(next byte)+")");3 
   ELSE write ("??? $DD/FD "+hex(byte));2 
   FI. 
 
dd and fd cb instructions : 
   counter incr 2 (b4, b3); 
   IF and7 <> 6 THEN write ("??? $DD/FD "+hex(byte));3 
   ELSE SELECT div 8 OF 
          CASE 0 : write ("RLC ("+index+"+$"+hex(next byte)+")");4 
          CASE 1 : write ("RRC ("+index+"+$"+hex(next byte)+")");4 
          CASE 2 : write ("RL ("+index+"+$"+hex(next byte)+")");4 
          CASE 3 : write ("RR ("+index+"+$"+hex(next byte)+")");4 
          CASE 4 : write ("SLA ("+index+"+$"+hex(next byte)+")");4 
          CASE 5 : write ("SRA ("+index+"+$"+hex(next byte)+")");4 
          CASE 6 : write ("SLL ("+index+"+$"+hex(next byte)+")");4 
          CASE 7 : write ("SRL ("+index+"+$"+hex(next byte)+")");4 
        OTHERWISE dd and fd bitmanipulation 
        ENDSELECT 
   FI. 
 
dd and fd bitmanipulation : 
   SELECT byte DIV 32 OF 
     CASE 1 : write ("BIT "+text(div8)+",("+index+"+$"+hex(next byte)+")");4 
     CASE 2 : write ("RES "+text(div8)+",("+index+"+$"+hex(next byte)+")");4 
     CASE 3 : write ("SET "+text(div8)+",("+index+"+$"+hex(next byte)+")");4 
     OTHERWISE write ("??? $DD/FD CB "+hex(next byte)+" "+hex(byte));4 
   ENDSELECT. 
 
ed instructions : 
   counter incr 1 (b2, b3, b4);
   SELECT byte OF 
     CASE 68 : write ("NEG");2 
     CASE 69 : write ("RETN");2 
     CASE 70 : write ("IM 0");2 
     CASE 71 : write ("LD I,A");2 
     CASE 77 : write ("RETI");2 
     CASE 79 : write ("LD R,A");2 
     CASE 86 : write ("IM 1");2 
     CASE 87 : write ("LD A,I");2 
     CASE 94 : write ("IM 2");2 
     CASE 95 : write ("LD A,R");2 
     CASE 103: write ("RRD");2 
     CASE 111: write ("RLD");2 
     CASE 171: write ("OUTD");2 
     CASE 163: write ("OUTI");2 
     CASE 179: write ("OTIR");2 
     CASE 187: write ("OTDR");2 
   OTHERWISE calculate ed instruction 
   ENDSELECT. 
 
 
ENDPROC int disass ; 
 
INT PROC calculate ed instruction : 
     IF and7 = 0 AND is 40 to 7f THEN write ("IN "+reg1+",(C)");2 
   ELIF and7 = 1 AND is 40 to 7f THEN write ("OUT "+reg1+",(C)");2 
   ELIF andf = 2 AND is 40 to 7f THEN write ("SBC HL,"+rp);2 
   ELIF andf = 3 AND is 40 to 7f THEN write ("LD ($"+hex(nextword)+"),"+rp);4
   ELIF andf =11 AND is 40 to 7f THEN write ("LD "+rp+",($"+hex(nextword)+")");4 
   ELIF andf =10 AND is 40 to 7f THEN write ("ADC HL,"+rp);2 
   ELIF div10 = 10 OR div10 = 11 THEN
          IF and7 = 0 THEN write ("LD"+modification);2 
        ELIF and7 = 1 THEN write ("CP"+modification);2 
        ELIF and7 = 2 THEN write ("IN"+modification);2 
        ELSE write ("??? $ED "+hex(next byte));2 
        FI 
   ELSE write ("??? $ED "+hex(next byte));2 
   FI. 
 
is 40 to 7f : 
   div 10 < 8 AND div 10 > 3. 
 
modification : 
   SELECT div8 OF 
     CASE 0 : "I" 
     CASE 1 : "D" 
     CASE 2 : "IR" 
     CASE 3 : "DR" 
   OTHERWISE "???" 
   ENDSELECT. 
 
ENDPROC calculate ed instruction; 
 
ENDPACKET z80 disassembler