diff --git a/src/GB/CPU.hs b/src/GB/CPU.hs index eada713..a958274 100644 --- a/src/GB/CPU.hs +++ b/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