From 0da0315f44a554ba0f2aad5f15e91b2c25ddf1f2 Mon Sep 17 00:00:00 2001 From: Lucian Mogosanu Date: Sat, 13 Dec 2014 17:54:52 +0200 Subject: [PATCH] Restructure tree Also makes some small modification to data structures and adds a new file, but this isn't so important at the moment. --- src/Control/Z80/Decoder.hs | 7 -- src/Data/Z80/CPU.hs | 57 ------------ src/Data/Z80/ISA.hs | 205 ------------------------------------------- src/Data/Z80/Memory.hs | 9 -- src/Z80/CPU.hs | 57 ++++++++++++ src/Z80/Decoder.hs | 7 ++ src/Z80/ISA.hs | 206 ++++++++++++++++++++++++++++++++++++++++++++ src/ZXS/Machine.hs | 4 + src/ZXS/Memory.hs | 9 ++ 9 files changed, 283 insertions(+), 278 deletions(-) delete mode 100644 src/Control/Z80/Decoder.hs delete mode 100644 src/Data/Z80/CPU.hs delete mode 100644 src/Data/Z80/ISA.hs delete mode 100644 src/Data/Z80/Memory.hs create mode 100644 src/Z80/CPU.hs create mode 100644 src/Z80/Decoder.hs create mode 100644 src/Z80/ISA.hs create mode 100644 src/ZXS/Machine.hs create mode 100644 src/ZXS/Memory.hs diff --git a/src/Control/Z80/Decoder.hs b/src/Control/Z80/Decoder.hs deleted file mode 100644 index d7b9c78..0000000 --- a/src/Control/Z80/Decoder.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Control.Z80.Decoder where - -{- - - Decodes Z80 machine code into our representation. - -} - -import Data.Z80.ISA diff --git a/src/Data/Z80/CPU.hs b/src/Data/Z80/CPU.hs deleted file mode 100644 index e40ed00..0000000 --- a/src/Data/Z80/CPU.hs +++ /dev/null @@ -1,57 +0,0 @@ -module Data.Z80.CPU where - -import Data.Word - -data CPU = CPU - { af :: Word16 - , bc :: Word16 - , de :: Word16 - , hl :: Word16 - , af' :: Word16 - , bc' :: Word16 - , de' :: Word16 - , hl' :: Word16 - , i :: Word8 - , r :: Word8 - , ix :: Word16 - , iy :: Word16 - , sp :: Word16 - , pc :: Word16 - , prefixed :: Prefixed - } deriving (Show, Eq) - -data Prefixed = - Unprefixed - | CBPrefixed - | EDPrefixed - | DDPrefixed - | FDPrefixed - | DDCBPrefixed - | FDCBPrefixed - deriving (Show, Eq) - --- not really into lenses so we're using these for now -setAF, setBC, setDE, setHL :: CPU -> Word16 -> CPU -setAF cpu w = cpu { af = w } -setBC cpu w = cpu { bc = w } -setDE cpu w = cpu { de = w } -setHL cpu w = cpu { hl = w } - -setAF', setBC', setDE', setHL' :: CPU -> Word16 -> CPU -setAF' cpu w = cpu { af' = w } -setBC' cpu w = cpu { bc' = w } -setDE' cpu w = cpu { de' = w } -setHL' cpu w = cpu { hl' = w } - -setIX, setIY, setSP, setPC :: CPU -> Word16 -> CPU -setIX cpu w = cpu { ix = w } -setIY cpu w = cpu { iy = w } -setSP cpu w = cpu { sp = w } -setPC cpu w = cpu { pc = w } - -setI, setR :: CPU -> Word8 -> CPU -setI cpu b = cpu { i = b } -setR cpu b = cpu { r = b } - -setPrefixed :: CPU -> Prefixed -> CPU -setPrefixed cpu p = cpu { prefixed = p } diff --git a/src/Data/Z80/ISA.hs b/src/Data/Z80/ISA.hs deleted file mode 100644 index 8818260..0000000 --- a/src/Data/Z80/ISA.hs +++ /dev/null @@ -1,205 +0,0 @@ -module Data.Z80.ISA where - -import Data.Word -import Data.Int - --- regs, as seen by the programmer -data Reg = A | B | C | D | E | H | L deriving (Show, Eq) - --- reg pairs specified in the z80 manual -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) -type RegPair_dd = RegPair BC DE HL SP -type RegPair_qq = RegPair BC DE HL AF -type RegPair_ss = RegPair BC DE HL SP -type RegPair_pp = RegPair BC DE IX SP -type RegPair_rr = RegPair BC DE IY SP - --- spec for arithmetic instructions -data ArithSpec = - AOp_R Reg - | AOp_N Word8 - | AOp_PHL - | AOp_PIX Int8 - | AOp_PIY Int8 - --- spec for shift and rotate instructions -data SRSpec = - SROp_R Reg - | SROp_PHL - | SROp_PIX Int8 - | SROp_PIY Int8 - --- spec for bitwise instructions -data BitwiseSpec = - BOp_R Reg - | BOp_PHL - | BOp_PIX Int8 - | BOp_PIY Int8 - --- condition codes for jump/call instructions -data Cond = - CNonZero - | CZero - | CNoCarry - | CCarry - | CParityOdd - | CParityEven - | CSignPositive - | CSignNegative - --- instructions -data Instruction = - -- 8-bit load group - LD_R_R' Reg Reg - | LD_R_N Reg Word8 - | LD_R_PHL Reg - | LD_R_PIX Reg Int8 - | LD_R_PIY Reg Int8 - | LD_PHL_R Reg - | LD_PIX_R Int8 Reg - | LD_PIY_R Int8 Reg - | LD_PHL_N Word8 - | LD_PIX_N Int8 Word8 - | LD_PIY_N Int8 Word8 - | LD_A_PBC - | LD_A_PDE - | LD_A_PNN Word16 - | LD_PBC_A - | LD_PDE_A - | LD_PNN_A Word16 - | LD_A_I - | LD_A_R - | LD_I_A - | LD_R_A - -- 16-bit load group - | LD_DD_NN RegPair_dd Word16 - | LD_IX_NN Word16 - | LD_IY_NN Word16 - | LD_HL_PNN Word16 - | LD_DD_PNN RegPair_dd Word16 - | LD_IX_PNN Word16 - | LD_IY_PNN Word16 - | LD_PNN_HL Word16 - | LD_PNN_DD Word16 RegPair_dd - | LD_PNN_IX Word16 - | LD_PNN_IY Word16 - | LD_SP_HL - | LD_SP_IX - | LD_SP_IY - | PUSH_QQ RegPair_qq - | PUSH_IX - | PUSH_IY - | POP_QQ RegPair_qq - | POP_IX - | POP_IY - -- exchange, block transfer and search group - | EX_DE_HL - | EX_AF_AF' - | EXX - | EX_PSP_HL - | EX_PSP_IX - | EX_PSP_IY - | LDI - | LDIR - | LDD - | LDDR - | CPI - | CPIR - | CPD - | CPDR - -- 8-bit arithmetic group - | ADD_A_S ArithSpec - | ADC_A_S ArithSpec - | SUB_A_S ArithSpec - | SBC_A_S ArithSpec - | AND_A_S ArithSpec - | OR_A_S ArithSpec - | XOR_A_S ArithSpec - | CP_A_S ArithSpec - | INC ArithSpec - | DEC ArithSpec - -- general purpose arithmetic and cpu control groups - | DAA - | CPL - | NEG - | CCF - | SCF - | NOP - | HALT - | DI - | EI - | IM0 - | IM1 - | IM2 - -- 16-bit arithmetic group - | ADD_HL_SS RegPair_ss - | ADC_HL_SS RegPair_ss - | SBC_HL_SS RegPair_ss - | ADD_IX_PP RegPair_pp - | ADD_IY_RR RegPair_rr - | INC_SS RegPair_ss - | INC_IX - | INC_IY - | DEC_SS RegPair_ss - | DEC_IX - | DEC_IY - -- rotate and shift group - | RLCA - | RLA - | RRCA - | RRA - | RLC SRSpec - | RL SRSpec - | RRC SRSpec - | RR SRSpec - | SLA SRSpec - | SRA SRSpec - | SRL SRSpec - | RLD - | RRD - -- bit set, reset and test group - | BIT BitwiseSpec - | SET BitwiseSpec - | RES BitwiseSpec - -- jump group - | JP_NN Word16 - | JP_CC_NN Cond Word16 - | JR_E Int8 - | JR_C_E Int8 - | JR_NC_E Int8 - | JR_Z_E Int8 - | JR_NZ_E Int8 - | JP_HL - | JP_IX - | JP_IY - | DJNZ_E Int8 - -- call and return group - | CALL_NN Word16 - | CALL_CC_NN Cond Word16 - | RET - | RET_CC Cond - | RETI - | RETN - | RST_P Word8 -- actually an offset? - -- input and output group - | IN_A_PN Word8 - | IN_R_PC Reg - | INI - | INIR - | IND - | INDR - | OUT_N_A Word8 - | OUT_PC_R Reg - | OUTI - | OUTIR - | OUTD - | OUTDR diff --git a/src/Data/Z80/Memory.hs b/src/Data/Z80/Memory.hs deleted file mode 100644 index 075a50d..0000000 --- a/src/Data/Z80/Memory.hs +++ /dev/null @@ -1,9 +0,0 @@ -module Data.Z80.Memory where - -import Data.Array -import Data.Word - -type Memory = Array Int Word16 - -romMem :: Memory -romMem = listArray (0x0000, 0x3fff) $ repeat 0 diff --git a/src/Z80/CPU.hs b/src/Z80/CPU.hs new file mode 100644 index 0000000..2d34f11 --- /dev/null +++ b/src/Z80/CPU.hs @@ -0,0 +1,57 @@ +module Z80.CPU where + +import Data.Word + +data CPU = CPU + { af :: Word16 + , bc :: Word16 + , de :: Word16 + , hl :: Word16 + , af' :: Word16 + , bc' :: Word16 + , de' :: Word16 + , hl' :: Word16 + , i :: Word8 + , r :: Word8 + , ix :: Word16 + , iy :: Word16 + , sp :: Word16 + , pc :: Word16 + , prefixed :: Prefixed + } deriving (Show, Eq) + +data Prefixed = + Unprefixed + | CBPrefixed + | EDPrefixed + | DDPrefixed + | FDPrefixed + | DDCBPrefixed + | FDCBPrefixed + deriving (Show, Eq) + +-- not really into lenses so we're using these for now +setAF, setBC, setDE, setHL :: CPU -> Word16 -> CPU +setAF cpu w = cpu { af = w } +setBC cpu w = cpu { bc = w } +setDE cpu w = cpu { de = w } +setHL cpu w = cpu { hl = w } + +setAF', setBC', setDE', setHL' :: CPU -> Word16 -> CPU +setAF' cpu w = cpu { af' = w } +setBC' cpu w = cpu { bc' = w } +setDE' cpu w = cpu { de' = w } +setHL' cpu w = cpu { hl' = w } + +setIX, setIY, setSP, setPC :: CPU -> Word16 -> CPU +setIX cpu w = cpu { ix = w } +setIY cpu w = cpu { iy = w } +setSP cpu w = cpu { sp = w } +setPC cpu w = cpu { pc = w } + +setI, setR :: CPU -> Word8 -> CPU +setI cpu b = cpu { i = b } +setR cpu b = cpu { r = b } + +setPrefixed :: CPU -> Prefixed -> CPU +setPrefixed cpu p = cpu { prefixed = p } diff --git a/src/Z80/Decoder.hs b/src/Z80/Decoder.hs new file mode 100644 index 0000000..1e44255 --- /dev/null +++ b/src/Z80/Decoder.hs @@ -0,0 +1,7 @@ +module Z80.Decoder where + +{- + - Decodes Z80 machine code into our representation. + -} + +import Z80.ISA diff --git a/src/Z80/ISA.hs b/src/Z80/ISA.hs new file mode 100644 index 0000000..f710fa1 --- /dev/null +++ b/src/Z80/ISA.hs @@ -0,0 +1,206 @@ +module Z80.ISA where + +import Data.Word +import Data.Int + +-- regs, as seen by the programmer +data Reg = A | B | C | D | E | H | L deriving (Show, Eq) + +-- reg pairs specified in the z80 manual +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) +type RegPair_dd = RegPair BC DE HL SP +type RegPair_qq = RegPair BC DE HL AF +type RegPair_ss = RegPair BC DE HL SP +type RegPair_pp = RegPair BC DE IX SP +type RegPair_rr = RegPair BC DE IY SP + +-- spec for arithmetic instructions +data ArithSpec = + AOp_R Reg + | AOp_N Word8 + | AOp_PHL + | AOp_PIX Int8 + | AOp_PIY Int8 + +-- spec for shift and rotate instructions +data SRSpec = + SROp_R Reg + | SROp_PHL + | SROp_PIX Int8 + | SROp_PIY Int8 + +-- spec for bitwise instructions +data BitwiseSpec = + BOp_R Reg + | BOp_PHL + | BOp_PIX Int8 + | BOp_PIY Int8 + +-- condition codes for jump/call instructions +data Cond = + CNonZero + | CZero + | CNoCarry + | CCarry + | CParityOdd + | CParityEven + | CSignPositive + | CSignNegative + +-- instructions +data Instruction = + -- 8-bit load group + LD_R_R' Reg Reg + | LD_R_N Reg Word8 + | LD_R_PHL Reg + | LD_R_PIX Reg Int8 + | LD_R_PIY Reg Int8 + | LD_PHL_R Reg + | LD_PIX_R Int8 Reg + | LD_PIY_R Int8 Reg + | LD_PHL_N Word8 + | LD_PIX_N Int8 Word8 + | LD_PIY_N Int8 Word8 + | LD_A_PBC + | LD_A_PDE + | LD_A_PNN Word16 + | LD_PBC_A + | LD_PDE_A + | LD_PNN_A Word16 + | LD_A_I + | LD_A_R + | LD_I_A + | LD_R_A + -- 16-bit load group + | LD_DD_NN RegPair_dd Word16 + | LD_IX_NN Word16 + | LD_IY_NN Word16 + | LD_HL_PNN Word16 + | LD_DD_PNN RegPair_dd Word16 + | LD_IX_PNN Word16 + | LD_IY_PNN Word16 + | LD_PNN_HL Word16 + | LD_PNN_DD Word16 RegPair_dd + | LD_PNN_IX Word16 + | LD_PNN_IY Word16 + | LD_SP_HL + | LD_SP_IX + | LD_SP_IY + | PUSH_QQ RegPair_qq + | PUSH_IX + | PUSH_IY + | POP_QQ RegPair_qq + | POP_IX + | POP_IY + -- exchange, block transfer and search group + | EX_DE_HL + | EX_AF_AF' + | EXX + | EX_PSP_HL + | EX_PSP_IX + | EX_PSP_IY + | LDI + | LDIR + | LDD + | LDDR + | CPI + | CPIR + | CPD + | CPDR + -- 8-bit arithmetic group + | ADD_A_S ArithSpec + | ADC_A_S ArithSpec + | SUB_A_S ArithSpec + | SBC_A_S ArithSpec + | AND_A_S ArithSpec + | OR_A_S ArithSpec + | XOR_A_S ArithSpec + | CP_A_S ArithSpec + | INC ArithSpec + | DEC ArithSpec + -- general purpose arithmetic and cpu control groups + | DAA + | CPL + | NEG + | CCF + | SCF + | NOP + | HALT + | DI + | EI + | IM0 + | IM1 + | IM2 + -- 16-bit arithmetic group + | ADD_HL_SS RegPair_ss + | ADC_HL_SS RegPair_ss + | SBC_HL_SS RegPair_ss + | ADD_IX_PP RegPair_pp + | ADD_IY_RR RegPair_rr + | INC_SS RegPair_ss + | INC_IX + | INC_IY + | DEC_SS RegPair_ss + | DEC_IX + | DEC_IY + -- rotate and shift group + | RLCA + | RLA + | RRCA + | RRA + | RLC SRSpec + | RL SRSpec + | RRC SRSpec + | RR SRSpec + | SLA SRSpec + | SRA SRSpec + | SRL SRSpec + | RLD + | RRD + -- bit set, reset and test group + | BIT BitwiseSpec + | SET BitwiseSpec + | RES BitwiseSpec + -- jump group + | JP_NN Word16 + | JP_CC_NN Cond Word16 + | JR_E Int8 + | JR_C_E Int8 + | JR_NC_E Int8 + | JR_Z_E Int8 + | JR_NZ_E Int8 + | JP_HL + | JP_IX + | JP_IY + | DJNZ_E Int8 + -- call and return group + | CALL_NN Word16 + | CALL_CC_NN Cond Word16 + | RET + | RET_CC Cond + | RETI + | RETN + | RST_P Word8 -- actually an offset? + -- input and output group + | IN_A_PN Word8 + | IN_R_PC Reg + | INI + | INIR + | IND + | INDR + | OUT_N_A Word8 + | OUT_PC_R Reg + | OUTI + | OUTIR + | OUTD + | OUTDR + | IllegalInstruction diff --git a/src/ZXS/Machine.hs b/src/ZXS/Machine.hs new file mode 100644 index 0000000..bc8b583 --- /dev/null +++ b/src/ZXS/Machine.hs @@ -0,0 +1,4 @@ +module ZXS.Machine where + +import Z80.CPU + diff --git a/src/ZXS/Memory.hs b/src/ZXS/Memory.hs new file mode 100644 index 0000000..640e155 --- /dev/null +++ b/src/ZXS/Memory.hs @@ -0,0 +1,9 @@ +module ZXS.Memory where + +import Data.Array +import Data.Word + +type Memory = Array Int Word16 + +romMem :: Memory +romMem = listArray (0x0000, 0x3fff) $ repeat 0 -- 1.7.10.4