From: Lucian Mogosanu Date: Tue, 23 Dec 2014 20:08:22 +0000 (+0200) Subject: Z80: ISA: Add custom Show instances X-Git-Url: https://git.mogosanu.ro/?a=commitdiff_plain;h=72ff77d1e8988a0d34946654ee90d5355d77b17a;p=z80.git Z80: ISA: Add custom Show instances --- diff --git a/src/Z80/ISA.hs b/src/Z80/ISA.hs index 4d00c23..a6de91d 100644 --- a/src/Z80/ISA.hs +++ b/src/Z80/ISA.hs @@ -1,22 +1,23 @@ 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 @@ -30,7 +31,6 @@ data ArithSpec = | AOp_PHL | AOp_PIX Int8 | AOp_PIY Int8 - deriving Show -- spec for shift and rotate instructions data SRSpec = @@ -38,7 +38,6 @@ data SRSpec = | SROp_PHL | SROp_PIX Int8 | SROp_PIY Int8 - deriving Show -- spec for bitwise instructions data BitwiseSpec = @@ -46,7 +45,6 @@ data BitwiseSpec = | BOp_PHL | BOp_PIX Int8 | BOp_PIY Int8 - deriving Show -- condition codes for jump/call instructions data Cond = @@ -58,7 +56,6 @@ data Cond = | CParityEven | CSignPositive | CSignNegative - deriving Show -- instructions data Instruction = @@ -220,4 +217,241 @@ 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