DisassemBASIC
=============
Description: Z80 disassembler in ZX Spectrum BASIC. Decoding of the Z80 instruction is based on the document "Decoding Z80 Opcodes" by Cristian Dinu (http://z80.info/decoding.htm, accessed on 22/Jan/2023).
Author: TK Fan (cantinhotk90x@bol.com.br, http://cantinhotk90x.blogspot.com)
Date: 09/Feb/2023

ZIP Archive
-----------
Filename: DisassemBASIC.zip
CRC32: 0cf97cc1
Contents:
    DisassemBASIC.tzx
        Tape image file of the BASIC program.
    DisassemBASIC.txt
        This document.
    DisassemBASIC.bas
        Pseudo-Pascal algorithm (see below) converted to Sinclair BASIC text. Used to make the BASIC code to run in the real/emulated ZX Spectrum. Note: zmakebas has a bug that affects DEF FN instruction.

VARIABLES
=========
Ad = current address
Of = offset for multibyte instruction
Op = PEEK (Ad+Of)

Pr = prefix:
    0 (initial/no prefix);
    1 (ED)
    2 (DD)
    3 (FD)
    4 (CB)
    5 = 4+1 (DD CB)
    6 = 4+2 (FD CB)

A$ = disassembled instruction
E$ = displacement for relative jump and IX+d|IY+d
C$ = condition

Hex = boolean; true for hexadecimal output

XY = boolean; if true H|L|HL was replaced by IXh|IXl|IYh|IYl
NXY = boolean; if true, don't replace H|L in DD|FD instruction

x, y, z, p, q - opcode decoding parameters

Num = 8-bit number
N$=string representing number
E$=string representing displacement value
H$=string representing hexadecimal number

V$ = first operand
W$ = second operand

i = general use (index)
j = general use
I$ = general use

TABLES
======
Registers
+---+---+---+---+---+---+----+---+---+---+------+---+---+------+
| 0 | 1 | 2 | 3 | 4 | 5 | 6  | 7 | 8 | 9 |  10  | 11| 12|  13  |
+---+---+---+---+---+---+----+---+---+---+------+---+---+------+
| B | C | D | E | H | L |(HL)| A |IXh|IXl|(IX+d)|IYh|IYl|(IY+d)|
+---+---+---+---+---+---+----+---+---+---+------+---+---+------+
Subroutine: register - R$(i,Pr,NXY)
Note:   H=4, IXh=4+4, IYh=4+7, 
        L=5, IXl=5+4, IYl=5+7,
        (HL)=6, (IX+d)=6+4, (IY+d)=6+7.

Register pairs
+----+----+----+----+----+----+----+
|  0 |  1 |  2 |  3 |  4 |  5 |  6 |
+----+----+----+----+----+----+----+
| BC | DE | HL | SP | AF | IX | IY |
+----+----+----+----+----+----+----+
Subroutine reg_pair - P$(i,Pr)
Note:   SP=3, AF=3+1,
        HL=2, IX=2+3, IY=2+4.

Bit rotation and shift instructions
+---+---+---+---+---+---+---+---+
| 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 |
+---+---+---+---+---+---+---+---+
|RLC|RRC|RL |RR |SLA|SRA|SLL|SRL|
+---+---+---+---+---+---+---+---+

Bit instructions
+----+----+----+
|  0 |  1 |  2 |
+----+----+----+
|BIT |RES |SET |
+----+----+----+

8-bit arithmetic and logic instructions
+------+------+------+------+------+------+------+------+
|   0  |   1  |   2  |   3  |   4  |   5  |   6  |   7  |
+------+------+------+------+------+------+------+------+
|ADD A,|ADC A,|SUB   |SBC A,|AND   |XOR   |OR    |CP    |
+------+------+------+------+------+------+------+------+
Subroutine alu - L$(i)

Conditions
+---+---+---+---+---+---+---+---+
| 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 |
+---+---+---+---+---+---+---+---+
| NZ| Z | NC| C | PO| PE| P | M |
+---+---+---+---+---+---+---+---+
Subroutine condit C$(i)

PSEUDO-PASCAL ALGORITHM
=======================
MAIN ROUTINE
------------
INPUT Ad,Hex
Repeat
    A$:="NOP"; # default instruction, can be replaced during disassembling
    Of:=0; # get first byte of the opcode
    Pr:=0; # no prefix
    XY:=0; # HL is not replaced by IX|IY yet
    NXY:=0; # replace H|L if DD|FD prefixed opcode
    Repeat
        Op := PEEK (Ad+Of); # get current byte code
        If Pr = 0:
            Case Op
                # Probe prefixed instruction. If no prefix, disassemble opcode.
                = ED: Pr:=1
                = DD: Pr:=2
                = FD: Pr:=3
                = CB: Pr:=4
                elseCase: GOSUB disass_opcode
        else:
            If Pr = 1:
                # If ED prefix, disassembly opcode.
                GOSUB disass_ed
                Pr:=0; # end of instruction
            If Pr = 2 OR Pr = 3:
                Handle DD|FD prefixed instruction
                If Op = ED OR Op = DD OR Op = FD:
                    # invalid prefixed instruction, DD|FD is NOP
                    Pr:=0; # end of instruction
                    Of:=0
                else:
                    If Op = CB:
                        # double prefix, Pr:=5(DDCB)|6(FDCB)
                        Pr:=Pr+3; 
                    else:
                        GOSUB disass_opcode
                        Pr:=0; # end of instruction
                        If XY = 0:
                            # DD|FD prefix didn't change instruction, so NOP
                            A$:="NOP"
                            Of:=0
            If Pr >=4:
                # Disassemble CB|DDCB|FDCB prefixed instruction
                GOSUB disass_cb
                Pr:=0; # end of instruction
        INC Of; # get next byte
    until Pr = 0;   # repeat until disassembling is done
    GOSUB pr_line;  # print line with disassembling
    Ad:=Ad+Of;      # update pointer to the next instruction
forever

FUNCTION - Double operand - boolean, argument1$, argument2$
-----------------------------------------------------------
DEF FN D$(B,V$,W$)=(V$ AND NOT B)+(W$ AND B)+","+(V$ AND B)+(W$ AND NOT B)
Description: return string with two arguments separated by comma. Boolean: false=don't invert argument order (V$,W$)|true=invert argument order (W$,V$).

FUNCTION - Parenthesis - argument$
----------------------------------
DEF FN Q$(O$)="("+O$+")"
Description: return string with argument enclosed by parenthesis.

FUNCTION - Select item - item_list$, index, item_length
-------------------------------------------------------
DEF FN S$(V$,I,L)=V$(L*I+1 TO L*I+L)
Description: return substring with length L, starting from position I = {0 to number_of_itens-1}.

FUNCTION - hexadecimal digit G$(I)
--------------------------------
DEF FN G$(I)="0123456789ABCDEF"(I)
Description: return 1-byte string with hexadecimal digit I = {0..15}

SUBROUTINE - decode_op - (x,y,z,p,q)
------------------------------------
# Return parameters for opcode decoding
x:=INT (Op/64)
y:=INT ((Op-64*x)/8))
z:=Op-8*y-64*x
p:=INT (y/2)
q:=y-2*p

SUBROUTINE - disass_opcode
--------------------------
# Disassemble opcode with DD|FD prefix or no prefix. 
Case Op
    # some instructions doesn't fit in any group and are handled here
    = 00: # A$:="NOP" (default)
    = 76: A$:="HALT"
    = 08: A$:="EX AF,AF'"
    = EB: A$:="EX DE,HL"
    = C9: A$:="RET"
    = D9: A$:="EXX"
    = F3: A$:="DI"
    = FB: A$:="EI"
    elseCase:
        # decode remaining instructions
        GOSUB decode_op
        If x=0:
            Case z
                = 0:
                    # y=0: NOP (already done)
                    # y=1: EX AF,AF´ (already done)
                    # DJNZ d, JR d or JR cc,d
                    If y=2:
                        A$:="DJNZ "
                    else: A$:="JR "
                    If y>=4:
                        i:=y-4
                        GOSUB condit
                        LET A$=A$+C$+","
                    GOSUB getdisplac
                    LET A$=A$+E$

                = 1:
                    # LD rp,nnnn or ADD HL,rp.
                    If q=1:
                        A$:="ADD "
                        i:=2; # first operand is HL|IX|IY
                        GOSUB reg_pair
                        W$:=P$
                    else:
                        A$:="LD "
                        GOSUB getword; # second operand is nnnn
                        W$:=N$
                    I:=p
                    GOSUB reg_pair
                    A$:=A$+FN D$(q,P$,W$)

                = 2: 
                    A$:="LD "
                    If p<=1:
                        # q=0 LD (BC|DE),A or q=1 LD A,(BC|DE)
                        i:=p; # P$:=BC|DE
                        GOSUB reg_pair
                        A$:=A$+FN D$(q,FN Q$(P$),"A")
                    If p=2:
                        # q=0 LD (nnnn),HL or q=1 LD HL,(nnnn)
                        GOSUB getword
                        I:=2
                        GOSUB reg_pair; # P$:=HL|IX|IY
                        A$:=A$+FN D$(q,FN Q$(N$),P$)
                    If p=3:
                        # LD (nnnn),A or  LD A,(nnnn)
                        GOSUB getword
                        A$:=A$+FN D$(q,FN Q$(N$),"A")
                = 3:
                    # INC|DEC rp
                    If q=0: A$:="INC "
                    else: A$:="DEC "
                    I:=p
                    GOSUB reg_pair
                    A$:=A$+P$
                = 4:
                    # INC r
                    i:=y
                    GOSUB register
                    A$:="INC "+R$
                = 5:
                    # DEC r
                    i:=y
                    GOSUB register
                    A$:="DEC "+R$
                = 6:
                    # LD R,n
                    LET i=y
                    GOSUB register
                    GOSUB getbyte
                    A$:="LD "+FN D$(0,R$,N$)
                = 7:
                    # RLCA RRCA RLA RRA DAA CPL SCF CCF
                    A$:= FN S$("RLCARRCARLA RRA DAA CPL SCF CCF ",y,4)
        If x=1:
            # LD reg1,reg2
            # y=6 AND z=6: HALT (already done)
            If y=6 OR z=6: NXY:=1; # don't replace H|L if either operand is (HL)
            i:=y; # get first operand
            GOSUB register
            V$:=R$
            i:=z; # get second operand
            GOSUB register
            A$="LD "+FN D$(0,V$,R$)
        If x=2:
            # 8-bit arithmetic and logic operation with A and reg
            i:=y
            GOSUB alu
            i:=z
            GOSUB register
            A$:=L$+R$
        If x=3:
            If z=0:
                # RET condit
                i:=y
                GOSUB condit
                A$:="RET "+C$
            If z=1:
                # (q=1 and p=0) or (y=1): RET (already done).
                # (q=1 and p=1) or (y=3): EXX (already done).
                If y=5:
                    # JP (HL)|(IX)|(IY)
                    i:=2
                    GOSUB reg_pair
                    A$:="JP "+FN Q$(P$)
                If y=7
                    # LD SP,HL|IX|IY
                    i:=2
                    GOSUB reg_pair
                    A$:="LD SP,"+P$
                else
                # q=0; y=0,2,4,6 or p=0,1,2,3
                    # POP reg_pair
                    If p=3: i:=4
                    else i:=p
                    GOSUB reg_pair
                    A$:="POP "+P$
            If z=2:
                # JP condit,nnnn
                i:=y
                GOSUB condit
                GOSUB getword
                A$:="JP "+FN D$(0,C$,N$)
            If z=3:
                # JP nnnn
                If y=0:
                    GOSUB getword
                    A$:="JP "+N$
                # y=1: CB (prefix).
                If y=2:
                    # OUT (n),A
                    GOSUB getbyte
                    A$:="OUT "+FN D$(0,Q$(N$),"A")
                If y=3:
                    # IN A,(n)
                    GOSUB getbyte
                    A$:="IN A,"+FN Q$(N$)
                If y:=4:
                    # EX (SP),HL|IX|IY
                    i:=2
                    GOSUB reg_pair
                    A$:="EX (SP),"+P$
                # y=5: EX DE,HL (already done)
                # y=6: DI (already done)
                # y=7: EI (already done)
            If z=4:
                # CALL condit,nnnn
                i:=y
                GOSUB condit
                GOSUB getword
                A$:="CALL "+FN D$(0,C$,N$)
            If z=5
                If q=0:
                    # PUSH reg_pair
                    If p=3: i:=4 else i:=p
                    GOSUB reg_pair
                    A$:="PUSH "+P$
                If y=1 (q=1 and p=0):
                    # CALL nnnn
                    GOSUB getword
                    A$:="CALL "+N$
                # q=1 and p=1: DD (prefix).
                # q=1 and p=2: ED (prefix).
                # q=1 and p=3: FD (prefix).
            If z=6:
                # 8-bit arithmetic and logic operation with A and nn
                i:=y
                GOSUB alu
                GOSUB getbyte
                A$:=L$+N$
            If z=7:
                # RST addr
                Num:=y*8
                If Hex:
                    GOSUB hexstring
                Else
                    H$=STR$ Num
                A$:="RST "+H$

SUBROUTINE - disass_cb - [DD|FD] CB [d] Op
-----------------------------
A$:=""
NXY:=1; # do not replace H|L with IXh|IYh|IXl|IYl
If Pr>=5:
    # get (IX+d)|(IY+d) for DDCB|FDCB prefix
    i:=6
    GOSUB register
    W$=R$
    # Get and decode opcode
    Inc Of
    Op:=PEEK (Ad+Of)
    GOSUB decode_op
    If x<>1 AND z<>6:
        # begin with LD R$ if instruction is not BIT and R$<>"(HL)"
        i:=z
        GOSUB register
        A$:="LD "+R$+","
    R$=W$
else:
    # Get and decode opcode
    Op:=PEEK (Ad+Of)
    GOSUB decode_op
    i:=z
    GOSUB register

If x=0:
    # bit rotation and shift instruction
    I$:=FN S$("RLCRRCRL RR SLASRASLLSRL",y,3)
    If I$(3)<>" ": I$=I$+" "; # append space if needed
    A$:=A$+I$+R$
else:
    # BIT, SET, RES
    A$:=A$+FN S$("BIT RES SET ",(x-1),4)+FN D$(0,STR$ y,R$)


SUBROUTINE - disass_ed - ED Op [nn] [nn]
---------------------------------------
GOSUB decode_op
# If x=0 OR x=3: A$="NOP"
If x=1:
    Case z
        = 0:
            # IN (C) or IN r,(C)
            i:=y
            GOSUB register
            A$:="IN "+FN D$(0,R$,"(C)")
            If y=6: A$:="IN (C)"
        = 1:
            # OUT (C),0 or OUT (C),r
                i:=y
                GOSUB register
            If y=6:
                R$:="0" 
            A$:="OUT "+FN D$(0,"(C)",R$)
        = 2:
            # ADC HL,p or SBC HL,p
            If q=1: A$="ADC HL,"
            else: A$:=SBC HL,"
            i:=p
            GOSUB reg_pair
            A$:=A$+P$
        = 3:
            # LD (nnnn),p or LD p,(nnnn)
            GOSUB getword
            i:=p
            GOSUB reg_pair
            A$:="LD "+FN D$(q,FN Q$(N$),P$)
        = 4:
            A$:="NEG"
        = 5:
            # RETI or RETN
            If y=1: A$:=A$+"RETI" 
            else: A$:="RETN"
        = 6:
            # IM 0|0/1|1|2
            If y<4: i:=y-4 else i:=y
            A$:="IM "+FN S${"0  0/11  2  ",i,3)
        = 7:
            If y<4
                # LD I|R,A or LD A,I|R
                If y=0 OR y=2: V$:="I"
                else: V$:="R"
                A$:="LD "+FN D$(y>1,V$,"A").
            else se y=4: A$:="RRD"
            else se y=5: A$="RLD"
            # y=6|7 A$:="NOP"
If x=2:
    If z<=3 AND y>=4
        # block instructions (LDI LDD LDIR LDDR etc)
        # begin with: LD, CP, IN or OT
        A$:=FN S$("LDCPINOT",z,2)
        # exceptions: OUTI and OUTD
        If A$:="OT" AND y<=5: A$:="OUT"
        # Increment Decrement
        If y=4 OR y=6: A$:=A$+"I"; else: A$:=A$+"D"
        # Repeat
        If y>=6: A$:=A$+"R"
    # else A$:="NOP"

SUBROUTINE - pr_line (Ad,Of,A$)
-------------------------------
# Print address
If Hex:
    Num:=INT (Ad/256)
    GOSUB hexstring
    PRINT H$;
    Num:=Ad-256*Num
    GOSUB hexstring
    PRINT H$;" ";
else:
    PRINT TAB (5-LEN STR$ Ad);Ad;" ";
# Print hex codes
For j:=0 to Of-1
    Num:=PEEK (Ad+i)
    GOSUB hexstring
    PRINT H$;
# Print disassembled instruction
PRINT TAB 15;A$

SUBROUTINE - register R$(i,Pr,NXY)
----------------------------------
# Return "B", "C", "D", "E", "H", "L", "(HL)", "(IX+d)", "(IY+d)" or A
# i=index, Pr=prefix, NXY=boolean
# increment Of if (IX+d)|(IY+d)
# raise XY if (HL)|(IX+d)|(IY+d)
R$:="BCDEHLQA"(I+1); # "Q" is replaced by (HL)|(IX+d)|(IY+d)
If i = 6:
    # register is (HL)|(IX+d)|(IY+d)
    I$:="HL"
    If Pr = 2 (DD) OR Pr = 5 (DD CB):
        GOSUB getdisplac
        I$:="IX"+E$
        XY:=1; # DD acted on the instruction
    If Pr = 3 (FD) OR Pr = 6 (FD CB):
        GOSUB getdisplac
        I$:="IY"+E$
        XY:=1; # FD acted on the instruction
    R$:=FN Q$(I$)
If NOT NXY:
    # replace H|L with IXh|IXl|IYh|IYl
    If i = 4 OR i = 5: # register is H or L
        If Pr = 2:
            R$:="IX"
            R$=R$+"hl"(i-3)
        If Pr = 3: R$:="IY"
            R$=R$+"hl"(i-3)
        XY:=1; # DD|FD acted on the instruction

SUBROUTINE - reg_pair P$(i,Pr)
------------------------------
# Return "BC", "DE", "HL", "SP", "AF", "IX" or "IY"
# i=index, Pr=prefix
# raise XY if IX|IY
If i = 2: # HL
    se Pr = 2: # DD
        i:=5
    se Pr = 3: # FD
        i:=6
    XY:=1; # DD|FD acted on the instruction
P$=FN S$("BCDEHLSPAFIXIY",i,2)

SUBROUTINE - alu - L$(i)
------------------------
# Return "ADD A,", "ADC A,", "SUB ", "SBC A,", "AND ", "XOR ", "OR " or "CP "
# i=index
L$:=FN S$("ADDADCSUBSBCANDXOROR CP ",i,3)
If L$(3)<>" ": L$:=L$+" "; # add space if necessary
# ADD A,; ADC A,;SBC A,
If y<4 AND y<>2: L$=L$+"A,"

SUBROUTINE - condit - C$(i)
---------------------------
# Return "NZ", "Z", "NC", "C", "PO", "PE", "P", "M"
# i=index
C$:=FN S$("NZZ NCC POPEP M ",i,2)
If C$(2)=" ": C$:=C$(1); # Remove the last character if it is space

SUBROUTINE - getbyte N$(Ad,Of,Hex)
----------------------------------
# Return string with numeric value of the next byte
INC Of
Num:=PEEK (Ad+Of)
If Hex=1:
    GOSUB hexstring
else:
    N$:=STR$ Num

SUBROUTINE - getword N$ (Ad,Of,Hex)
-----------------------------------
# Return string with numeric value of the next word (16-bit number)
If Hex=1:
    Num:=PEEK (Ad+Of+2) : get MSB
    GOSUB hexstring
    I$:=N$
    Num:=PEEK (Ad+Of+1) : get LSB
    GOSUB hexstring
    N$:=N$+I$
else:
    N$:=STR$ (PEEK (Ad+Of+1)+256*PEEK (Ad+Of+2))
Of:=Of+2

SUBROUTINE - getdisplac E$(Ad,Of,Hex)
------------------------------------
# Return displacement for IX+d, IY+d or relative jumps
INC Of
Num:=PEEK (Ad+Of)
If Hex=1:
    GOSUB hexstring
    E$:="+"+H$
else:
    If Num>127: Num:=Num-256
    E$:=("+" AND Num>=0)+STR$ Num

SUBROUTINE - hexstring H$(Num)
------------------------------
# convert Num (8-bit number) to hexadecimal
# first hexadecimal digit
i:=INT (Num/16)
H$:=FN G$(i)
# second hexadecimal digit
i:=Num-16*INT i
H$:=H$+FN G$(i)