decode :: ZXS Instruction
decode = do
b <- fetch
+ prefixed <- getsCPU getPrefixed
+ modifyCPU . flip setPrefixed $ Unprefixed
let x = (b `shiftR` 6) .&. 0x03
y = (b `shiftR` 3) .&. 0x07
z = (b `shiftR` 0) .&. 0x07
p = (y `shiftR` 1) .&. 0x03
q = (y `shiftR` 0) .&. 0x01
+ rollback = modifyCPU $ flip modifyPC (\ x -> x - 1)
case x of
-- x = 0
0 -> case z of
0 -> do
lb <- fetch
hb <- fetch
- return . LD_DD_NN (decodeRegPair_dd p) $ bbToWord hb lb
- 1 -> return . ADD_HL_SS $ decodeRegPair_ss p
+ let dec = decodeRegPair_dd p
+ op = case prefixed of
+ Unprefixed -> LD_DD_NN dec
+ DDPrefixed -> if dec == R3 HL then LD_IX_NN else LD_DD_NN dec
+ FDPrefixed -> if dec == R3 HL then LD_IY_NN else LD_DD_NN dec
+ return . op $ bbToWord hb lb
+ 1 -> do
+ let op = case prefixed of
+ Unprefixed -> ADD_HL_SS $ decodeRegPair_ss p
+ DDPrefixed -> ADD_IX_PP $ decodeRegPair_pp p
+ FDPrefixed -> ADD_IY_RR $ decodeRegPair_rr p
+ in return op
-- z = 2
2 -> case (q, p) of
(0, 0) -> return LD_PBC_A
(0, 2) -> do
lb <- fetch
hb <- fetch
- return . LD_PNN_HL $ bbToWord hb lb
+ let op = case prefixed of
+ Unprefixed -> LD_PNN_HL
+ DDPrefixed -> LD_PNN_IX
+ FDPrefixed -> LD_PNN_IY
+ return . op $ bbToWord hb lb
(0, 3) -> do
lb <- fetch
hb <- fetch
(1, 2) -> do
lb <- fetch
hb <- fetch
- return . LD_HL_PNN $ bbToWord hb lb
+ let op = case prefixed of
+ Unprefixed -> LD_HL_PNN
+ DDPrefixed -> LD_IX_PNN
+ FDPrefixed -> LD_IY_PNN
+ return . op $ bbToWord hb lb
(1, 3) -> do
lb <- fetch
hb <- fetch
return . LD_A_PNN $ bbToWord hb lb
-- z = 3
- 3 -> let op = if q == 0 then INC_SS else DEC_SS
- ss = decodeRegPair_ss p
- in return $ op ss
+ 3 -> let ss = decodeRegPair_ss p
+ op = case (prefixed, ss) of
+ (DDPrefixed, R3 HL) -> if q == 0 then INC_IX else DEC_IX
+ (FDPrefixed, R3 HL) -> if q == 0 then INC_IY else DEC_IY
+ (_, _) -> if q == 0 then INC_SS ss else DEC_SS ss
+ in return op
-- z = 4, 5, 6
- 4 -> return . INC . AOp_R $ decodeReg y
- 5 -> return . DEC . AOp_R $ decodeReg y
- 6 -> fetch >>= return . LD_R_N (decodeReg y)
+ 4 -> let dr = decodeReg prefixed y
+ in if (prefixed == DDPrefixed || prefixed == FDPrefixed) && dr == PHL
+ then do
+ d <- fmap fromIntegral fetch
+ let op = if prefixed == DDPrefixed then AOp_PIX d else AOp_PIY d
+ return . INC $ op
+ else return . INC $ AOp_R dr
+ 5 -> let dr = decodeReg prefixed y
+ in if (prefixed == DDPrefixed || prefixed == FDPrefixed) && dr == PHL
+ then do
+ d <- fmap fromIntegral fetch
+ let op = if prefixed == DDPrefixed then AOp_PIX d else AOp_PIY d
+ return . DEC $ op
+ else return . DEC $ AOp_R dr
+ 6 -> let dr = decodeReg prefixed y
+ op = if prefixed == DDPrefixed then LD_PIX_N else LD_PIY_N
+ in if (prefixed == DDPrefixed || prefixed == FDPrefixed) && dr == PHL
+ then do
+ d <- fmap fromIntegral fetch
+ n <- fetch
+ return $ op d n
+ else fetch >>= return . LD_R_N (decodeReg prefixed y)
-- z = 7
7 -> if y > 7
then return . IllegalInstruction $ "decode: opcode = " ++ show b
else return $
[ RLCA, RRCA, RLA, RRA, DAA, CPL, SCF, CCF ] !! fromIntegral y
-- x = 1
- 1 -> if z /= 6 && y /= 6
- then return $ LD_R_R' (decodeReg y) (decodeReg z)
+ 1 -> if z /= 6 || y /= 6
+ -- very convoluted, need to rewrite this
+ then let dry = decodeReg prefixed y
+ drz = decodeReg prefixed z
+ in do
+ d <- fmap fromIntegral fetch
+ case (prefixed, dry, drz) of
+ (DDPrefixed, PHL, _) -> return $ LD_PIX_R d (decodeReg Unprefixed z)
+ (FDPrefixed, PHL, _) -> return $ LD_PIY_R d (decodeReg Unprefixed z)
+ (DDPrefixed, _, PHL) -> return $ LD_R_PIX (decodeReg Unprefixed y) d
+ (FDPrefixed, _, PHL) -> return $ LD_R_PIY (decodeReg Unprefixed y) d
+ (_, _, _) ->
+ rollback >> return (LD_R_R' dry drz)
else return HALT
-- x = 2
- 2 -> return . decodeALU y . AOp_R $ decodeReg z
+ 2 -> return . decodeALU y . AOp_R $ decodeReg prefixed z
-- x = 3
3 -> case z of
-- z = 0, 1
lb <- fetch
hb <- fetch
return . JP_NN $ bbToWord hb lb
- 1 -> decodeCB
+ 1 -> decodeCB prefixed
2 -> fetch >>= return . OUT_PN_A
3 -> fetch >>= return . IN_A_PN
4 -> return EX_PSP_HL
hb <- fetch
return . CALL_NN $ bbToWord hb lb
1 -> decodeDDFD 0xdd
- 2 -> decodeED
+ 2 -> decodeED prefixed
3 -> decodeDDFD 0xfd
-- z = 6
6 -> fetch >>= return . decodeALU y . AOp_N
_ -> return . IllegalInstruction $ "decode: opcode = " ++ show b
-- decode prefixed opcodes
-decodeCB, decodeED :: ZXS Instruction
+decodeCB, decodeED :: Prefixed -> ZXS Instruction
-- CB-prefixed opcodes
-decodeCB = do
+decodeCB prefixed = do
b <- fetch
let x = (b `shiftR` 6) .&. 0x03
y = (b `shiftR` 3) .&. 0x07
z = (b `shiftR` 0) .&. 0x07
case x of
- 0 -> return . decodeSR y . SROp_R $ decodeReg z
- 1 -> return . BIT y . BOp_R $ decodeReg z
- 2 -> return . RES y . BOp_R $ decodeReg z
- 3 -> return . SET y . BOp_R $ decodeReg z
+ 0 -> return . decodeSR y . SROp_R $ decodeReg prefixed z
+ 1 -> return . BIT y . BOp_R $ decodeReg prefixed z
+ 2 -> return . RES y . BOp_R $ decodeReg prefixed z
+ 3 -> return . SET y . BOp_R $ decodeReg prefixed z
-decodeED = do
+decodeED prefixed = do
b <- fetch
let x = (b `shiftR` 6) .&. 0x03
y = (b `shiftR` 3) .&. 0x07
-- z = 0
0 -> if y == 6
then return IN_PC
- else return . IN_R_PC $ decodeReg y
+ else return . IN_R_PC $ decodeReg prefixed y
-- z = 1
1 -> if y == 6
then return OUT_PC_Zero
- else return . OUT_PC_R $ decodeReg y
+ else return . OUT_PC_R $ decodeReg prefixed y
-- z = 2, 3, 4
2 -> let op = if q == 0 then SBC_HL_SS else ADC_HL_SS
in return . op $ decodeRegPair_ss p
(0, 6) -> decodeSR y srspec
(2, 6) -> RES y bwspec
(3, 6) -> SET y bwspec
- (0, _) -> decodeSR' y (decodeReg z) srspec
+ (0, _) -> decodeSR' y (decodeReg Unprefixed z) srspec
(1, _) -> BIT y bwspec
- (2, _) -> LD_R_RES (decodeReg z) y bwspec
- (3, _) -> LD_R_SET (decodeReg z) y bwspec
+ (2, _) -> LD_R_RES (decodeReg Unprefixed z) y bwspec
+ (3, _) -> LD_R_SET (decodeReg Unprefixed z) y bwspec
_ -> IllegalInstruction $ "decodeDDFDCB: opcode " ++ show b
bbToWord :: Word8 -> Word8 -> Word16
relativeToInt b = let i8 = fromIntegral b :: Int8
in fromIntegral i8
-decodeReg :: Word8 -> Reg
-decodeReg b = case b of
+decodeReg :: Prefixed -> Word8 -> Reg
+decodeReg prefixed b = case b of
0 -> B
1 -> C
2 -> D
3 -> E
- 4 -> H
- 5 -> L
+ 4 -> case prefixed of
+ Unprefixed -> H
+ DDPrefixed -> IXH
+ FDPrefixed -> IYH
+ 5 -> case prefixed of
+ Unprefixed -> L
+ DDPrefixed -> IXL
+ FDPrefixed -> IYL
6 -> PHL
7 -> A
decodeRegPair_ss :: Word8 -> RegPair_ss
decodeRegPair_ss = decodeRegPair_dd
+decodeRegPair_pp :: Word8 -> RegPair_pp
+decodeRegPair_pp b = case b of
+ 0 -> R1 BC
+ 1 -> R2 DE
+ 2 -> R3 IX
+ 3 -> R4 SP
+ _ -> error $ "decodeRegPair_pp: b = " ++ show b
+
+decodeRegPair_rr :: Word8 -> RegPair_rr
+decodeRegPair_rr b = case b of
+ 0 -> R1 BC
+ 1 -> R2 DE
+ 2 -> R3 IY
+ 3 -> R4 SP
+ _ -> error $ "decodeRegPair_rr: b = " ++ show b
+
decodeRegPair_qq :: Word8 -> RegPair_qq
decodeRegPair_qq b = case b of
0 -> R1 BC
projects / z80.git / commitdiff