module Z80.ISA where
+import Text.Printf
import Data.Word
import Data.Int
-- regs, as seen by the programmer
-data Reg = B | C | D | E | H | L | PHL | A deriving (Show, Eq)
+data Reg = B | C | D | E | H | L | PHL | A deriving Eq
-- reg pairs specified in the z80 manual
-data BC = BC deriving Show
-data DE = DE deriving Show
-data HL = HL deriving Show
-data SP = SP deriving Show
-data AF = AF deriving Show
-data IX = IX deriving Show
-data IY = IY deriving Show
+data BC = BC
+data DE = DE
+data HL = HL
+data SP = SP
+data AF = AF
+data IX = IX
+data IY = IY
-- sets of reg pairs used in the z80 manual
-data RegPair a b c d = R1 a | R2 b | R3 c | R4 d deriving (Show, Eq)
+data RegPair a b c d = R1 a | R2 b | R3 c | R4 d deriving Eq
type RegPair_dd = RegPair BC DE HL SP
type RegPair_qq = RegPair BC DE HL AF
type RegPair_ss = RegPair BC DE HL SP
| AOp_PHL
| AOp_PIX Int8
| AOp_PIY Int8
- deriving Show
-- spec for shift and rotate instructions
data SRSpec =
| SROp_PHL
| SROp_PIX Int8
| SROp_PIY Int8
- deriving Show
-- spec for bitwise instructions
data BitwiseSpec =
| BOp_PHL
| BOp_PIX Int8
| BOp_PIY Int8
- deriving Show
-- condition codes for jump/call instructions
data Cond =
| CParityEven
| CSignPositive
| CSignNegative
- deriving Show
-- instructions
data Instruction =
| OUTD
| OUTDR
| IllegalInstruction String
- deriving Show
+
+{-
+ - Show instances, compatible and comparable with dZ80
+ -}
+instance Show Reg where
+ show r = case r of
+ A -> "a"
+ B -> "b"
+ C -> "c"
+ D -> "d"
+ E -> "e"
+ H -> "h"
+ L -> "l"
+ PHL -> "(hl)"
+
+instance Show BC where show BC = "bc"
+instance Show DE where show DE = "de"
+instance Show HL where show HL = "hl"
+instance Show SP where show SP = "sp"
+instance Show AF where show AF = "af"
+instance Show IX where show IX = "ix"
+instance Show IY where show IY = "iy"
+
+instance (Show a, Show b, Show c, Show d)
+ => Show (RegPair a b c d) where
+ show rp = case rp of
+ R1 r1 -> show r1
+ R2 r2 -> show r2
+ R3 r3 -> show r3
+ R4 r4 -> show r4
+
+instance Show ArithSpec where
+ show as = case as of
+ AOp_R r -> show r
+ AOp_N n -> showByte n
+ AOp_PHL -> "(hl)"
+ AOp_PIX x -> showDispl "ix" x
+ AOp_PIY x -> showDispl "iy" x
+
+instance Show SRSpec where
+ show srs = case srs of
+ SROp_R r -> show r
+ SROp_PHL -> "(hl)"
+ SROp_PIX x -> showDispl "ix" x
+ SROp_PIY x -> showDispl "iy" x
+
+instance Show BitwiseSpec where
+ show bs = case bs of
+ BOp_R r -> show r
+ BOp_PHL -> "(hl)"
+ BOp_PIX x -> showDispl "ix" x
+ BOp_PIY x -> showDispl "iy" x
+
+instance Show Cond where
+ show c = case c of
+ CNonZero -> "nz"
+ CZero -> "z"
+ CNoCarry -> "nc"
+ CCarry -> "c"
+ CParityOdd ->"po"
+ CParityEven -> "pe"
+ CSignPositive -> "p"
+ CSignNegative -> "m"
+
+instance Show Instruction where
+ show instr = case instr of
+ -- 8-bit load group
+ LD_R_R' r r' -> "ld " ++ show r ++ "," ++ show r'
+ LD_R_N r n -> "ld " ++ show r ++ "," ++ showByte n
+ LD_R_PHL r -> "ld " ++ show r ++ ",(hl)"
+ LD_R_PIX r x -> "ld " ++ show r ++ "," ++ showDispl "ix" x
+ LD_R_PIY r x -> "ld " ++ show r ++ "," ++ showDispl "iy" x
+ LD_PHL_R r -> "ld " ++ "(hl)," ++ show r
+ LD_PIX_R x r -> "ld " ++ showDispl "ix" x ++ "," ++ show r
+ LD_PIY_R x r -> "ld " ++ showDispl "iy" x ++ "," ++ show r
+ LD_PHL_N n -> "ld " ++ "(hl)," ++ showByte n
+ LD_PIX_N x n -> "ld " ++ showDispl "ix" x ++ "," ++ showByte n
+ LD_PIY_N x n -> "ld " ++ showDispl "iy" x ++ "," ++ showByte n
+ LD_A_PBC -> "ld a,(bc)"
+ LD_A_PDE -> "ld a,(de)"
+ LD_A_PNN nn -> "ld a," ++ showAddrPtr nn
+ LD_PBC_A -> "ld (bc),a"
+ LD_PDE_A -> "ld (de),a"
+ LD_PNN_A nn -> "ld " ++ showAddrPtr nn ++ ",a"
+ LD_A_I -> "ld a,i"
+ LD_A_R -> "ld a,r"
+ LD_I_A -> "ld i,a"
+ LD_R_A -> "ld r,a"
+ -- 16-bit load group
+ LD_DD_NN dd nn -> "ld " ++ show dd ++ "," ++ showWord nn
+ LD_IX_NN nn -> "ld ix," ++ showWord nn
+ LD_IY_NN nn -> "ld iy," ++ showWord nn
+ LD_HL_PNN nn -> "ld hl," ++ showAddrPtr nn
+ LD_DD_PNN dd nn -> "ld " ++ show dd ++ "," ++ showAddrPtr nn
+ LD_IX_PNN nn -> "ld ix," ++ showAddrPtr nn
+ LD_IY_PNN nn -> "ld iy," ++ showAddrPtr nn
+ LD_PNN_HL nn -> "ld " ++ showAddrPtr nn ++ ",hl"
+ LD_PNN_DD nn dd -> "ld " ++ showAddrPtr nn ++ "," ++ show dd
+ LD_PNN_IX nn -> "ld " ++ showAddrPtr nn ++ ",ix"
+ LD_PNN_IY nn -> "ld " ++ showAddrPtr nn ++ ",iy"
+ LD_SP_HL -> "ld sp,hl"
+ LD_SP_IX -> "ld sp,ix"
+ LD_SP_IY -> "ld sp,iy"
+ PUSH_QQ qq -> "push " ++ show qq
+ PUSH_IX -> "push ix"
+ PUSH_IY -> "push iy"
+ POP_QQ qq -> "pop " ++ show qq
+ POP_IX -> "pop ix"
+ POP_IY -> "pop iy"
+ -- exchange, block transfer and search group
+ EX_DE_HL -> "ex de,hl"
+ EX_AF_AF' -> "ex af,af'"
+ EXX -> "exx"
+ EX_PSP_HL -> "ex (sp),hl"
+ EX_PSP_IX -> "ex (sp),ix"
+ EX_PSP_IY -> "ex (sp),iy"
+ LDI -> "ldi"
+ LDIR -> "ldir"
+ LDD -> "ldd"
+ LDDR -> "lddr"
+ CPI -> "cpi"
+ CPIR -> "cpir"
+ CPD -> "cpd"
+ CPDR -> "cpdr"
+ -- 8-bit arithmetic group
+ ADD_A_S as -> "add a," ++ show as
+ ADC_A_S as -> "adc a," ++ show as
+ SUB_A_S as -> "sub a," ++ show as
+ SBC_A_S as -> "sbc a," ++ show as
+ AND_A_S as -> "and a," ++ show as
+ OR_A_S as -> "or a," ++ show as
+ XOR_A_S as -> "xor a," ++ show as
+ CP_A_S as -> "cp a," ++ show as
+ INC as -> "inc " ++ show as
+ DEC as -> "dec " ++ show as
+ -- general purpose arithmetic and cpu control groups
+ DAA -> "daa"
+ CPL -> "cpl"
+ NEG -> "neg"
+ CCF -> "ccf"
+ SCF -> "scf"
+ NOP -> "nop"
+ HALT -> "halt"
+ DI -> "di"
+ EI -> "ei"
+ IM _ -> "im FIXME" -- must be 0, 1 or 2
+ -- 16-bit arithmetic group
+ ADD_HL_SS ss -> "add hl," ++ show ss
+ ADC_HL_SS ss -> "adc hl," ++ show ss
+ SBC_HL_SS ss -> "sbc hl," ++ show ss
+ ADD_IX_PP pp -> "add ix," ++ show pp
+ ADD_IY_RR rr -> "add iy," ++ show rr
+ INC_SS ss -> "inc " ++ show ss
+ INC_IX -> "inc ix"
+ INC_IY -> "inc iy"
+ DEC_SS ss -> "dec " ++ show ss
+ DEC_IX -> "dec ix"
+ DEC_IY -> "dec iy"
+ -- rotate and shift group
+ RLCA -> "rlca "
+ RLA -> "rla "
+ RRCA -> "rrca "
+ RRA -> "rra "
+ RLC sr -> "rlc " ++ show sr
+ RL sr -> "rl " ++ show sr
+ RRC sr -> "rrc " ++ show sr
+ RR sr -> "rr " ++ show sr
+ SLA sr -> "sla " ++ show sr
+ SRA sr -> "sra " ++ show sr
+ SLL sr -> "sll " ++ show sr
+ SRL sr -> "srl " ++ show sr
+ LD_R_RLC r sr -> "ld " ++ show r ++ "," ++ "rlc " ++ show sr
+ LD_R_RL r sr -> "ld " ++ show r ++ "," ++ "rl " ++ show sr
+ LD_R_RRC r sr -> "ld " ++ show r ++ "," ++ "rrc " ++ show sr
+ LD_R_RR r sr -> "ld " ++ show r ++ "," ++ "rr " ++ show sr
+ LD_R_SLA r sr -> "ld " ++ show r ++ "," ++ "sla " ++ show sr
+ LD_R_SRA r sr -> "ld " ++ show r ++ "," ++ "sra " ++ show sr
+ LD_R_SLL r sr -> "ld " ++ show r ++ "," ++ "sll " ++ show sr
+ LD_R_SRL r sr -> "ld " ++ show r ++ "," ++ "srl " ++ show sr
+ RLD -> "rld"
+ RRD -> "rrd"
+ -- bit set, reset and test group
+ BIT n bs -> "bit " ++ show n ++ "," ++ show bs
+ SET n bs -> "set " ++ show n ++ "," ++ show bs
+ RES n bs -> "res " ++ show n ++ "," ++ show bs
+ LD_R_SET r n bs -> "ld " ++ show r ++ "," ++ "set " ++ show n ++ "," ++ show bs
+ LD_R_RES r n bs -> "ld " ++ show r ++ "," ++ "res " ++ show n ++ "," ++ show bs
+ -- jump group
+ JP_NN nn -> "jp " ++ showWord nn
+ JP_CC_NN cc nn -> "jp " ++ show cc ++ "," ++ showWord nn
+ JR_E _ -> "jr " ++ "FIXME" -- should decode to an address
+ JR_CC_E cc _ -> "jr " ++ show cc ++ "," ++ "FIXME" -- needs address
+ JP_HL -> "jp hl"
+ JP_IX -> "jp ix"
+ JP_IY -> "jp iy"
+ DJNZ_E _ -> "djnz " ++ "FIXME" -- needs address
+ -- call and return group
+ CALL_NN nn -> "call " ++ showWord nn
+ CALL_CC_NN cc nn -> "call " ++ show cc ++ "," ++ showWord nn
+ RET -> "ret"
+ RET_CC cc -> "ret " ++ show cc
+ RETI -> "reti"
+ RETN -> "retn"
+ RST_P p -> "rst " ++ showByte p
+ -- input and output group
+ IN_A_PN n -> "in a," ++ "(" ++ showByte n ++ ")"
+ IN_R_PC r -> "in " ++ show r ++ ",(c)"
+ IN_PC -> "in (c)"
+ INI -> "ini"
+ INIR -> "inir"
+ IND -> "ind"
+ INDR -> "indr"
+ OUT_PN_A n -> "out (" ++ showByte n ++ "),a"
+ OUT_PC_R r -> "out (c)," ++ show r
+ OUT_PC_Zero -> "out (c),0"
+ OUTI -> "outi"
+ OUTIR -> "outir"
+ OUTD -> "outd"
+ OUTDR -> "outdr"
+ -- illegal
+ IllegalInstruction s -> "db " ++ s
+
+showByte :: Word8 -> String
+showByte = printf "%02xh"
+
+showWord :: Word16 -> String
+showWord = printf "%04xh"
+
+showAddrPtr :: Word16 -> String
+showAddrPtr addr = "(" ++ showWord addr ++ ")"
+
+showDispl :: String -> Int8 -> String
+showDispl regs x = "(" ++ regs ++ showInt8 x ++ ")"
+
+showInt8 :: Int8 -> String
+showInt8 x = let s = if signum x < 0 then "-" else "+"
+ ax = printf "%02xh" (abs x)
+ in s ++ ax
projects / z80.git / commitdiff