From: Lucian Mogosanu Date: Tue, 23 Dec 2014 23:28:14 +0000 (+0200) Subject: ZXS: Decode a shitload of prefixed opcodes X-Git-Url: https://git.mogosanu.ro/?a=commitdiff_plain;h=41165aab4e068f76a4b8810bc9af54ff66642f9b;p=z80.git ZXS: Decode a shitload of prefixed opcodes Still a few more left, though. --- diff --git a/src/ZXS/Decode.hs b/src/ZXS/Decode.hs index 07044c3..f966dbd 100644 --- a/src/ZXS/Decode.hs +++ b/src/ZXS/Decode.hs @@ -20,11 +20,14 @@ import ZXS.Fetch 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 @@ -52,8 +55,18 @@ decode = do 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 @@ -63,7 +76,11 @@ decode = do (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 @@ -71,30 +88,67 @@ decode = do (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 @@ -116,7 +170,7 @@ decode = do 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 @@ -138,7 +192,7 @@ decode = do 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 @@ -147,21 +201,21 @@ decode = do _ -> 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 @@ -176,11 +230,11 @@ decodeED = do -- 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 @@ -235,10 +289,10 @@ decodeDDFDCB pref = do (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 @@ -248,14 +302,20 @@ relativeToInt :: Word8 -> Int 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 @@ -281,6 +341,22 @@ decodeRegPair_dd b = case b of 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