From e9978e99c17a9cea5156fbd7fa6ce8deb49b4c83 Mon Sep 17 00:00:00 2001 From: pingu Date: Mon, 30 Mar 2026 13:20:36 +0200 Subject: [PATCH] ooh baby --- src/GB/CPU.hs | 69 ++++++++++++--------------------------------------- 1 file changed, 16 insertions(+), 53 deletions(-) diff --git a/src/GB/CPU.hs b/src/GB/CPU.hs index 5d3d00e..fdbf17e 100644 --- a/src/GB/CPU.hs +++ b/src/GB/CPU.hs @@ -80,7 +80,7 @@ data CPU = CPU { _registers :: Registers , _bus :: (V.Vector 65536 Word8) } makeLenses ''CPU -data ArithmeticTarget = A | B | C | D | E | H | L +type ArithmeticTarget = Lens' Registers Word8 data Instruction where AddR :: ArithmeticTarget -> Bool -> Instruction @@ -99,79 +99,42 @@ data Instruction where execute :: CPU -> Instruction -> CPU execute cpu = \case - AddR t _c -> let value = case t of - A -> cpu ^. registers . a - B -> cpu ^. registers . b - C -> cpu ^. registers . c - D -> cpu ^. registers . d - E -> cpu ^. registers . e - H -> cpu ^. registers . h - L -> cpu ^. registers . l + 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 . getHL $ cpu ^. registers (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 - SubR t _c -> let value = case t of - A -> cpu ^. registers . a - B -> cpu ^. registers . b - C -> cpu ^. registers . c - D -> cpu ^. registers . d - E -> cpu ^. registers . e - H -> cpu ^. registers . h - L -> cpu ^. registers . l + 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 . getHL $ cpu ^. registers (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 - CpR t _c -> let value = case t of - A -> cpu ^. registers . a - B -> cpu ^. registers . b - C -> cpu ^. registers . c - D -> cpu ^. registers . d - E -> cpu ^. registers . e - H -> cpu ^. registers . h - L -> cpu ^. registers . l + 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 + cpu & registers . flags .~ newFlags CpHL _c -> let value = fetch cpu . getHL $ cpu ^. registers (_, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in cpu & registers . flags .~ newFlags CpN value _c -> let (_, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers .flags . carry in cpu & registers . flags .~ newFlags - IncR t -> let (target, target') = case t of - A -> (a,a) - B -> (b,b) - C -> (c,c) - D -> (d,d) - E -> (e,e) - H -> (h,h) - L -> (l,l) - (value, newFlags) = add (cpu ^. registers . target) 1 False in - cpu & registers . target' .~ value & registers . flags .~ newFlags + IncR t -> let (value, newFlags) = add (cpu ^. registers . t) 1 False in + cpu & registers . t .~ value & registers . flags .~ newFlags IncHL -> let target = getHL $ cpu ^. registers value = fetch cpu target (newValue, newFlags) = add value 1 False in - cpu & bus %~ (flip V.update $ V.singleton (fromIntegral target, newValue)) & registers . flags .~ newFlags - DecR t -> let (target, target') = case t of - A -> (a,a) - B -> (b,b) - C -> (c,c) - D -> (d,d) - E -> (e,e) - H -> (h,h) - L -> (l,l) - (value, newFlags) = sub (cpu ^. registers . target) 1 False in - cpu & registers . target' .~ value & registers . flags .~ newFlags + cpu & bus %~ (flip V.update $ V.singleton (fromIntegral target, newValue)) & registers . flags .~ newFlags + DecR t -> let (value, newFlags) = sub (cpu ^. registers . t) 1 False in + cpu & registers . t .~ value & registers . flags .~ newFlags DecHL -> let target = getHL $ cpu ^. registers value = fetch cpu target (newValue, newFlags) = sub value 1 False in - cpu & bus %~ (flip V.update $ V.singleton (fromIntegral target, newValue)) & registers . flags .~ newFlags + cpu & bus %~ (flip V.update $ V.singleton (fromIntegral target, newValue)) & registers . flags .~ newFlags where add :: Word8 -> Word8 -> Bool -> (Word8, FlagRegister) add o n _c = let new = o + n + if _c then 1 else 0