pingu/Tia
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ooh baby

Browse Source
This commit is contained in:
pingu
2026-03-30 13:20:36 +02:00
parent e63111ea98
commit e9978e99c1
1 changed files with 16 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files

69
src/GB/CPU.hs
View File

@@ -80,7 +80,7 @@ data CPU = CPU { _registers :: Registers
, _bus :: (V.Vector 65536 Word8) } , _bus :: (V.Vector 65536 Word8) }
makeLenses ''CPU makeLenses ''CPU
data ArithmeticTarget = A | B | C | D | E | H | L type ArithmeticTarget = Lens' Registers Word8
data Instruction where data Instruction where
AddR :: ArithmeticTarget -> Bool -> Instruction AddR :: ArithmeticTarget -> Bool -> Instruction
@@ -99,79 +99,42 @@ data Instruction where
execute :: CPU -> Instruction -> CPU execute :: CPU -> Instruction -> CPU
execute cpu = \case execute cpu = \case
AddR t _c -> let value = case t of AddR t _c -> let value = cpu ^. registers . t
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
(newValue, newFlags) = add (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in (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 AddHL _c -> let value = fetch cpu . getHL $ cpu ^. registers
(newValue, newFlags) = add (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in (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 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 = case t of SubR t _c -> let value = cpu ^. registers . t
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
(newValue, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in (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 SubHL _c -> let value = fetch cpu . getHL $ cpu ^. registers
(newValue, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in (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 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 = case t of CpR t _c -> let value = cpu ^. registers . t
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
(_, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in (_, 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 CpHL _c -> let value = fetch cpu . getHL $ cpu ^. registers
(_, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in (_, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in
cpu & registers . flags .~ newFlags cpu & registers . flags .~ newFlags
CpN value _c -> let (_, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers .flags . carry in CpN value _c -> let (_, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers .flags . carry in
cpu & registers . flags .~ newFlags cpu & registers . flags .~ newFlags
IncR t -> let (target, target') = case t of IncR t -> let (value, newFlags) = add (cpu ^. registers . t) 1 False in
A -> (a,a) cpu & registers . t .~ value & registers . flags .~ newFlags
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
IncHL -> let target = getHL $ cpu ^. registers IncHL -> let target = getHL $ cpu ^. registers
value = fetch cpu target value = fetch cpu target
(newValue, newFlags) = add value 1 False in (newValue, newFlags) = add 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
DecR t -> let (target, target') = case t of DecR t -> let (value, newFlags) = sub (cpu ^. registers . t) 1 False in
A -> (a,a) cpu & registers . t .~ value & registers . flags .~ newFlags
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
DecHL -> let target = getHL $ cpu ^. registers DecHL -> let target = getHL $ cpu ^. registers
value = fetch cpu target value = fetch cpu target
(newValue, newFlags) = sub value 1 False in (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 where
add :: Word8 -> Word8 -> Bool -> (Word8, FlagRegister) add :: Word8 -> Word8 -> Bool -> (Word8, FlagRegister)
add o n _c = let new = o + n + if _c then 1 else 0 add o n _c = let new = o + n + if _c then 1 else 0