ZXS: Decode: Implement DDCB/FDCB decoder

diff --git a/src/Z80/CPU.hs b/src/Z80/CPU.hs
index 5034c65..97e4fcc 100644 (file)
--- a/src/Z80/CPU.hs
+++ b/src/Z80/CPU.hs
@@ -22,10 +22,6 @@ data CPU = CPU
 
 data Prefixed =
     Unprefixed
-  | CBPrefixed
-  | EDPrefixed
   | DDPrefixed
   | FDPrefixed
-  | DDCBPrefixed
-  | FDCBPrefixed
   deriving (Show, Eq)

diff --git a/src/Z80/ISA.hs b/src/Z80/ISA.hs
index 41317d4..b789f71 100644 (file)
--- a/src/Z80/ISA.hs
+++ b/src/Z80/ISA.hs
@@ -163,12 +163,22 @@ data Instruction =
   | SRA SRSpec
   | SLL SRSpec
   | SRL SRSpec
+  | LD_R_RLC Reg SRSpec
+  | LD_R_RL  Reg SRSpec
+  | LD_R_RRC Reg SRSpec
+  | LD_R_RR  Reg SRSpec
+  | LD_R_SLA Reg SRSpec
+  | LD_R_SRA Reg SRSpec
+  | LD_R_SLL Reg SRSpec
+  | LD_R_SRL Reg SRSpec
   | RLD
   | RRD
   -- bit set, reset and test group
   | BIT Word8 BitwiseSpec
   | SET Word8 BitwiseSpec
   | RES Word8 BitwiseSpec
+  | LD_R_SET Reg Word8 BitwiseSpec
+  | LD_R_RES Reg Word8 BitwiseSpec
   -- jump group
   | JP_NN Word16
   | JP_CC_NN Cond Word16

diff --git a/src/ZXS/Decode.hs b/src/ZXS/Decode.hs
index f048bc1..f73f31a 100644 (file)
--- a/src/ZXS/Decode.hs
+++ b/src/ZXS/Decode.hs
@@ -9,7 +9,9 @@ module ZXS.Decode where
 import Data.Bits
 import Data.Word
 
+import Z80.CPU
 import Z80.ISA
+import Z80.Microcode
 import ZXS.Machine
 import ZXS.Fetch
 
@@ -121,9 +123,9 @@ decode = do
             lb <- fetch
             hb <- fetch
             return . CALL_NN $ bbToWord hb lb
-          1 -> decodeDD
+          1 -> decodeDDFD 0xdd
           2 -> decodeED
-          3 -> decodeFD
+          3 -> decodeDDFD 0xfd
       -- z = 6
       6 -> fetch >>= return . decodeALU y . AOp_N
       7 -> return . RST_P $ y * 8
@@ -131,7 +133,7 @@ decode = do
     _ -> return . IllegalInstruction $ "decode: opcode = " ++ show b
 
 -- decode prefixed opcodes
-decodeCB, decodeDD, decodeED, decodeFD :: ZXS Instruction
+decodeCB, decodeED :: ZXS Instruction
 
 -- CB-prefixed opcodes
 decodeCB = do
@@ -188,8 +190,41 @@ decodeED = do
 
 -- TODO: these are trickier and will require using extra logic in the decode
 -- function above and the getPrefixed field in the CPU. To bear in mind.
-decodeDD = undefined
-decodeFD = undefined
+decodeDDFD :: Word8 -> ZXS Instruction
+decodeDDFD prevb = do
+  b <- fetch
+  let rollback = modifyCPU $ flip modifyPC (\ x -> x - 1)
+      prefixed = if prevb == 0xdd then DDPrefixed else FDPrefixed
+  if b == 0xdd || b == 0xed || b == 0xfd
+    then do
+      -- refetch this opcode at the next decode stage
+      rollback
+      return NOP -- NONI?
+    else case b of
+      0xcb  -> decodeDDFDCB prefixed
+      _     -> do
+        rollback
+        modifyCPU . flip setPrefixed $ prefixed
+        return NOP -- NONI?
+
+decodeDDFDCB :: Prefixed -> ZXS Instruction
+decodeDDFDCB pref = do
+  d <- fmap fromIntegral fetch
+  b <- fetch
+  let x = (b `shiftR` 6) .&. 0x03
+      y = (b `shiftR` 3) .&. 0x07
+      z = (b `shiftR` 0) .&. 0x07
+      srspec = (if pref == DDPrefixed then SROp_PIX else SROp_PIY) d
+      bwspec = (if pref == DDPrefixed then BOp_PIX else BOp_PIY) d
+  return $ case (x, z) of
+    (0, 6) -> decodeSR y srspec
+    (2, 6) -> RES y bwspec
+    (3, 6) -> SET y bwspec
+    (0, _) -> decodeSR' y (decodeReg z) srspec
+    (1, _) -> BIT y bwspec
+    (2, _) -> LD_R_RES (decodeReg z) y bwspec
+    (3, _) -> LD_R_SET (decodeReg z) y bwspec
+    _      -> IllegalInstruction $ "decodeDDFDCB: opcode " ++ show b
 
 bbToWord :: Word8 -> Word8 -> Word16
 bbToWord hb lb = (fromIntegral hb `shiftL` 8) .|. fromIntegral lb
@@ -256,6 +291,17 @@ decodeSR b = case b of
   6 -> SLL
   7 -> SRL
 
+decodeSR' :: Word8 -> Reg -> SRSpec -> Instruction
+decodeSR' b = case b of
+  0 -> LD_R_RLC
+  1 -> LD_R_RRC
+  2 -> LD_R_RL
+  3 -> LD_R_RR
+  4 -> LD_R_SLA
+  5 -> LD_R_SRA
+  6 -> LD_R_SLL
+  7 -> LD_R_SRL
+
 decodeBLI :: Word8 -> Word8 -> Instruction
 decodeBLI a b = [
   [ LDI, CPI, INI, OUTI ],

diff --git a/src/ZXS/Machine.hs b/src/ZXS/Machine.hs
index 1130470..c098c64 100644 (file)
--- a/src/ZXS/Machine.hs
+++ b/src/ZXS/Machine.hs
@@ -21,6 +21,9 @@ newtype ZXST m a = ZXST { unZXST :: StateT Spectrum m a }
 -- for now we "fall back" to IO as the default inner monad
 type ZXS a = ZXST IO a
 
+getsCPU :: (CPU -> a) -> ZXS a
+getsCPU f = gets zxCPU >>= return . f
+
 modifyCPU :: (CPU -> CPU) -> ZXS ()
 modifyCPU f = modify $ \ spc -> spc { zxCPU = f $ zxCPU spc }