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

hl and bc as lenses

Browse Source
This commit is contained in:
pingu
2026-03-30 14:18:12 +02:00
parent 45339997c8
commit 9d9fa31f6e
1 changed files with 12 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

28
src/GB/CPU.hs
View File

@@ -61,17 +61,13 @@ data Registers = Registers { _a :: Word8
makeLenses ''Registers makeLenses ''Registers
getBC :: Registers -> Word16 bc :: Lens' Registers Word16
getBC r = (( .<<. 8) . fromIntegral $ r ^. b) + (fromIntegral $ r ^. c) bc = lens (\r -> (( .<<. 8) . fromIntegral $ r ^. b) + (fromIntegral $ r ^. c))
(\r w -> r & b %~ (const $ fromIntegral $ w .>>. 8) & c %~ (const $ fromIntegral $ w .&. 255))
setBC :: Registers -> Word16 -> Registers hl :: Lens' Registers Word16
setBC r w = r & b %~ (const $ fromIntegral $ w .>>. 8) & c %~ (const $ fromIntegral $ w .&. 255) hl = lens (\r -> ((.<<. 8) . fromIntegral $ r ^. h) + (fromIntegral $ r ^. l))
(\r w -> r & h %~ (const $ fromIntegral $ w .>>. 8) & l %~ (const $ fromIntegral $ w .&. 255))
getHL :: Registers -> Word16
getHL r = ((.<<. 8) . fromIntegral $ r ^. h) + (fromIntegral $ r ^. l)
setHL :: Registers -> Word16 -> Registers
setHL r w = r & h %~ (const $ fromIntegral $ w .>>. 8) & l %~ (const $ fromIntegral $ w .&. 255)
data CPU = CPU { _registers :: Registers data CPU = CPU { _registers :: Registers
, _pc :: Word16 , _pc :: Word16
@@ -108,7 +104,7 @@ execute cpu = \case
AddR t _c -> let value = cpu ^. registers . t AddR t _c -> let value = cpu ^. registers . t
(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 $ cpu ^. registers . hl
(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
@@ -116,7 +112,7 @@ execute cpu = \case
SubR t _c -> let value = cpu ^. registers . t SubR t _c -> let value = cpu ^. registers . t
(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 $ cpu ^. registers . hl
(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
@@ -124,27 +120,27 @@ execute cpu = \case
CpR t _c -> let value = cpu ^. registers . t CpR t _c -> let value = cpu ^. registers . t
(_, 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 $ cpu ^. registers . hl
(_, 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 (value, newFlags) = add (cpu ^. registers . t) 1 False in 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 = getHL $ cpu ^. registers IncHL -> let target = cpu ^. registers . hl
value = fetch cpu target value = fetch cpu target
(newValue, newFlags) = add value 1 False in (newValue, newFlags) = add value 1 False in
write cpu target newValue & registers . flags .~ newFlags write cpu target newValue & registers . flags .~ newFlags
DecR t -> let (value, newFlags) = sub (cpu ^. registers . t) 1 False in 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 = getHL $ cpu ^. registers DecHL -> let target = cpu ^. registers . hl
value = fetch cpu target value = fetch cpu target
(newValue, newFlags) = sub value 1 False in (newValue, newFlags) = sub value 1 False in
write cpu target newValue & registers . flags .~ newFlags write cpu target newValue & registers . flags .~ newFlags
BOR t op _f -> let newValue = (cpu ^. registers . a) `op` (cpu ^. registers . t) BOR t op _f -> let newValue = (cpu ^. registers . a) `op` (cpu ^. registers . t)
newFlags = _f {_zero = newValue == 0} in 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 = getHL $ cpu ^. registers BOHL op _f -> let target = cpu ^. registers . hl
value = fetch cpu target value = fetch cpu target
newValue = (cpu ^. registers . a) `op` value newValue = (cpu ^. registers . a) `op` value
newFlags = _f {_zero = value == 0} in newFlags = _f {_zero = value == 0} in