mjau

src/GB/CPU.hs

@@ -8,6 +8,7 @@ module GB.CPU where
 import Lens.Micro.Platform
 import Data.Word
 import Data.Bits
+import Data.Int
 import qualified Data.Vector.Sized as V
 
 class Convert a b where
@@ -99,24 +100,48 @@ data Instruction where
   DAA :: Instruction -- TODO: What does this do?
   CPL :: Instruction
 
+  IncRR :: Instruction
+  DecRR :: Instruction
+  AddHLRR :: Instruction
+  AddSP :: Int8 -> Instruction
+
+  RLCA :: Instruction
+  RRCA :: Instruction
+  RLA :: Instruction
+  RRA :: Instruction
+  RLC :: ArithmeticTarget -> Instruction
+  RLCHL :: Instruction
+  RRC :: ArithmeticTarget -> Instruction
+  RRCHL :: Instruction
+  RL :: ArithmeticTarget -> Instruction
+  RLHL :: Instruction
+  RR :: ArithmeticTarget -> Instruction
+  RRHL :: Instruction
+
 execute :: CPU -> Instruction -> CPU
 execute cpu = \case
   AddR t _c -> let value = cpu ^. registers . t
                    (newValue, newFlags) = add (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in
-               cpu & registers . a .~ newValue & registers . flags .~ newFlags
+               cpu & registers . a .~ newValue
+                   & registers . flags .~ newFlags
   AddHL _c -> let value = fetch cpu $ cpu ^. registers . hl
                   (newValue, newFlags) = add (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in
-              cpu & registers . a .~ newValue & registers . flags .~ newFlags
+              cpu & registers . a .~ newValue
+                  & registers . flags .~ newFlags
   AddN value _c -> let (newValue, newFlags) = add (cpu ^. registers . a) value $ _c && cpu ^. registers .flags . carry in
-                cpu & registers . a .~ newValue & registers . flags .~ newFlags
+                cpu & registers . a .~ newValue
+                    & registers . flags .~ newFlags
   SubR t _c -> let value =  cpu ^. registers . t
                    (newValue, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in
-               cpu & registers . a .~ newValue & registers . flags .~ newFlags
+               cpu & registers . a .~ newValue
+                   & registers . flags .~ newFlags
   SubHL _c -> let value = fetch cpu $ cpu ^. registers . hl
                   (newValue, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in
-              cpu & registers . a .~ newValue & registers . flags .~ newFlags
+              cpu & registers . a .~ newValue
+                  & registers . flags .~ newFlags
   SubN value _c -> let (newValue, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers .flags . carry in
-                   cpu & registers . a .~ newValue & registers . flags .~ newFlags
+                   cpu & registers . a .~ newValue
+                       & registers . flags .~ newFlags
   CpR t _c -> let value = cpu ^. registers . t
                   (_, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in
               cpu & registers . flags .~ newFlags
@@ -126,29 +151,34 @@ execute cpu = \case
   CpN value _c -> let (_, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers .flags . carry in
                 cpu & registers . flags .~ newFlags
   IncR t -> let (value, newFlags) = add (cpu ^. registers . t) 1 False in
-            cpu & registers . t .~ value & registers . flags .~ newFlags
+            cpu & registers . t .~ value
+                & registers . flags .~ newFlags
   IncHL -> let target = cpu ^. registers . hl
                value = fetch cpu target
                (newValue, newFlags) = add value 1 False in
            write cpu target newValue & registers . flags .~ newFlags
   DecR t -> let (value, newFlags) = sub (cpu ^. registers . t) 1 False in
-            cpu & registers . t .~ value & registers . flags .~ newFlags
+            cpu & registers . t .~ value
+                & registers . flags .~ newFlags
   DecHL -> let target = cpu ^. registers . hl
                value = fetch cpu target
                (newValue, newFlags) = sub value 1 False in
            write cpu target newValue & registers . flags .~ newFlags
   BOR t op _f -> let newValue = (cpu ^. registers . a) `op` (cpu ^. registers . t)
                      newFlags = _f {_zero = newValue == 0} in
-                cpu & registers . a .~ newValue & registers . flags .~ newFlags
+                cpu & registers . a .~ newValue
+                    & registers . flags .~ newFlags
   BOHL op _f -> let target = cpu ^. registers . hl
                     value = fetch cpu target
                     newValue = (cpu ^. registers . a) `op` value
                     newFlags = _f {_zero = value == 0} in
-                cpu & registers . a .~ newValue & registers . flags .~ newFlags
+                cpu & registers . a .~ newValue
+                    & registers . flags .~ newFlags
             
   BON value op _f -> let newValue = (cpu ^. registers . a) `op` value
                          newFlags = _f {_zero = newValue == 0} in
-                    cpu & registers . a .~ newValue & registers . flags .~ newFlags
+                    cpu & registers . a .~ newValue
+                        & registers . flags .~ newFlags
   CCF -> cpu & registers . flags . negative .~ False
              & registers . flags . halfCarry .~  False
              & registers . flags . carry %~ not
@@ -159,6 +189,77 @@ execute cpu = \case
   CPL -> cpu & registers . a %~ complement
              & registers . flags . negative .~ True
              & registers . flags . halfCarry .~ True
+  IncRR -> cpu & registers . bc %~ (+1)
+  DecRR -> cpu & registers . bc %~ (+1)
+  AddHLRR -> let _flags = cpu ^. registers . flags
+                 _hl = cpu ^. registers . hl
+                 _bc = cpu ^. registers . bc
+                 (newValue, newFlags) = add16 _hl _bc _flags in
+             cpu & registers . hl .~ newValue
+                 & registers . flags .~ newFlags
+  AddSP e -> let value = cpu ^. sp
+                 newValue :: Word16 = fromIntegral (fromIntegral value) + (fromIntegral e) in
+              cpu & sp .~ newValue
+                  & registers . flags .~
+                      FlagRegister { _zero = False,
+                                     _negative = False,
+                                     _halfCarry = value .&. 16 + fromIntegral e .&. 16 > 16, -- TODO: check if this still works out
+                                     _carry = value > newValue
+                                   }
+  RLCA -> let _carry = cpu ^. registers . a .&. 128 == 128 in
+    cpu & registers . a %~ (`rotateL` 1)
+        & registers . flags .~ FlagRegister {_zero = False, _negative = False, _halfCarry = False, ..}
+  RRCA -> let _carry = cpu ^. registers . a .&. 1 == 1 in
+    cpu & registers . a %~ (`rotateR` 1)
+        & registers . flags .~ FlagRegister {_zero = False, _negative = False, _halfCarry = False, ..}
+  RLA -> let _carry = cpu ^. registers . a .&. 128 == 128
+             _c = cpu ^. registers . flags . carry in
+    cpu & registers . a %~ (if _c then (+1) else id) . (`shiftL` 1)
+        & registers . flags .~ FlagRegister {_zero = False, _negative = False, _halfCarry = False, ..}
+  RRA -> let _carry = cpu ^. registers . a .&. 1 == 1
+             _c = cpu ^. registers . flags . carry in
+    cpu & registers . a %~ (if _c then (+128) else id) . (`shiftR` 1)
+        & registers . flags .~ FlagRegister {_zero = False, _negative = False, _halfCarry = False, ..}
+  RLC t -> let _carry = cpu ^. registers . t .&. 128 == 128
+               newValue = cpu ^. registers . t `rotateL` 1 in
+    cpu & registers . t .~ newValue
+        & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
+  RLCHL -> let target = cpu ^. registers . hl
+               value = fetch cpu target
+               _carry = value .&. 128 == 128
+               newValue = value `rotateL` 1 in
+    write cpu target newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
+  RRC t -> let _carry = cpu ^. registers . t .&. 1 == 1
+               newValue = cpu ^. registers . t `rotateR` 1 in
+    cpu & registers . t .~ newValue
+        & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
+  RRCHL -> let target = cpu ^. registers . hl
+               value = fetch cpu target
+               _carry = value .&. 1 == 1
+               newValue = value `rotateR` 1 in
+    write cpu target newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
+  RL t -> let _carry = cpu ^. registers . t .&. 128 == 128
+              _c = cpu ^. registers . flags . carry
+              newValue = (if _c then (+1) else id) $ cpu ^. registers . t `shiftL` 1 in
+    cpu & registers . t .~ newValue
+        & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
+  RLHL -> let target = cpu ^. registers . hl
+              value = fetch cpu target
+              _c = cpu ^. registers . flags . carry
+              _carry = value .&. 128 == 128
+              newValue = (if _c then (+1) else id) $ value `shiftL` 1 in
+    write cpu target newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
+  RR t -> let _carry = cpu ^. registers . t .&. 1 == 1
+              _c = cpu ^. registers . flags . carry
+              newValue = (if _c then (+128) else id) $ cpu ^. registers . t `shiftR` 1 in
+    cpu & registers . t .~ newValue
+        & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
+  RRHL -> let target = cpu ^. registers . hl
+              value = fetch cpu target
+              _c = cpu ^. registers . flags . carry
+              _carry = value .&. 1 == 1
+              newValue = (if _c then (+128) else id) $ value `shiftR` 1 in
+    write cpu target newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
   where
     add :: Word8 -> Word8 -> Bool -> (Word8, FlagRegister)
     add o n _c = let new        = o + n + if _c then 1 else 0
@@ -168,6 +269,13 @@ execute cpu = \case
                      _halfCarry = o .&. 16 + n .&. 16 > 16 in
                  (new, FlagRegister {..})
 
+    add16 :: Word16 -> Word16 -> FlagRegister -> (Word16, FlagRegister)
+    add16 o n _f = let new        = o + n
+                       _negative  = False
+                       _carry     = o > new
+                       _halfCarry = o .&. 16 + n .&. 16 > 16 in
+                 (new, _f {_negative, _carry, _halfCarry})
+
     sub :: Word8 -> Word8 -> Bool -> (Word8, FlagRegister)
     sub o n _c = let new        = o - n - if _c then 1 else 0
                      _zero      = new == 0