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

hehe, new lenses

Browse Source
This commit is contained in:
pingu
2026-04-02 11:16:31 +02:00
parent 053bd0bbd9
commit c3985cce7f
1 changed files with 159 additions and 140 deletions
Download Patch File Download Diff File Expand all files Collapse all files

299
src/GBC/CPU.hs
View File

@@ -48,31 +48,31 @@ instance Convert Word8 FlagRegister where
FlagRegister {..} FlagRegister {..}
data Registers = Registers { _a :: Word8 data Registers = Registers { _ra :: Word8
, _b :: Word8 , _rb :: Word8
, _c :: Word8 , _rc :: Word8
, _d :: Word8 , _rd :: Word8
, _e :: Word8 , _re :: Word8
, _f :: Word8 , _rf :: Word8
, _g :: Word8 , _rg :: Word8
, _h :: Word8 , _rh :: Word8
, _l :: Word8 , _rl :: Word8
, _flags :: FlagRegister , _rflags :: FlagRegister
} }
makeLenses ''Registers makeLenses ''Registers
bc :: Lens' Registers Word16 rbc :: Lens' Registers Word16
bc = lens (\r -> (( .<<. 8) . fromIntegral $ r ^. b) + (fromIntegral $ r ^. c)) rbc = lens (\r -> (( .<<. 8) . fromIntegral $ r ^. rb) + (fromIntegral $ r ^. rc))
(\r w -> r & b %~ (const $ fromIntegral $ w .>>. 8) & c %~ (const $ fromIntegral $ w .&. 255)) (\r w -> r & rb %~ (const $ fromIntegral $ w .>>. 8) & rc %~ (const $ fromIntegral $ w .&. 255))
de :: Lens' Registers Word16 rde :: Lens' Registers Word16
de = lens (\r -> (( .<<. 8) . fromIntegral $ r ^. d) + (fromIntegral $ r ^. e)) rde = lens (\r -> (( .<<. 8) . fromIntegral $ r ^. rd) + (fromIntegral $ r ^. re))
(\r w -> r & d %~ (const $ fromIntegral $ w .>>. 8) & e %~ (const $ fromIntegral $ w .&. 255)) (\r w -> r & rd %~ (const $ fromIntegral $ w .>>. 8) & re %~ (const $ fromIntegral $ w .&. 255))
hl :: Lens' Registers Word16 rhl :: Lens' Registers Word16
hl = lens (\r -> ((.<<. 8) . fromIntegral $ r ^. h) + (fromIntegral $ r ^. l)) rhl = lens (\r -> ((.<<. 8) . fromIntegral $ r ^. rh) + (fromIntegral $ r ^. rl))
(\r w -> r & h %~ (const $ fromIntegral $ w .>>. 8) & l %~ (const $ fromIntegral $ w .&. 255)) (\r w -> r & rh %~ (const $ fromIntegral $ w .>>. 8) & rl %~ (const $ fromIntegral $ w .&. 255))
data CPU = CPU { _registers :: Registers data CPU = CPU { _registers :: Registers
, _pc :: Word16 , _pc :: Word16
@@ -80,6 +80,25 @@ data CPU = CPU { _registers :: Registers
, _bus :: (V.Vector 65536 Word8) } , _bus :: (V.Vector 65536 Word8) }
makeLenses ''CPU makeLenses ''CPU
a, b, c, d, e, f, g, h, l :: Lens' CPU Word8
a = lens (^. registers . ra) (\cpu w -> cpu & registers . ra .~ w)
b = lens (^. registers . rb) (\cpu w -> cpu & registers . rb .~ w)
c = lens (^. registers . rc) (\cpu w -> cpu & registers . rc .~ w)
d = lens (^. registers . rd) (\cpu w -> cpu & registers . rd .~ w)
e = lens (^. registers . re) (\cpu w -> cpu & registers . re .~ w)
f = lens (^. registers . rf) (\cpu w -> cpu & registers . rf .~ w)
g = lens (^. registers . rg) (\cpu w -> cpu & registers . rg .~ w)
h = lens (^. registers . rh) (\cpu w -> cpu & registers . rh .~ w)
l = lens (^. registers . rl) (\cpu w -> cpu & registers . rl .~ w)
flags :: Lens' CPU FlagRegister
flags = lens (^. registers . rflags) (\cpu _f -> cpu & registers . rflags .~ _f)
bc, de, hl :: Lens' CPU Word16
bc = lens (^. registers . rbc) (\cpu w -> cpu & registers . rbc .~ w)
de = lens (^. registers . rde) (\cpu w -> cpu & registers . rde .~ w)
hl = lens (^. registers . rhl) (\cpu w -> cpu & registers . rhl .~ w)
type ByteTarget = Lens' CPU Word8 type ByteTarget = Lens' CPU Word8
type WordTarget = Lens' CPU Word16 type WordTarget = Lens' CPU Word16
@@ -161,217 +180,217 @@ data Instruction where
execute :: CPU -> Instruction -> CPU execute :: CPU -> Instruction -> CPU
execute cpu = \case execute cpu = \case
ADDR t _c -> let value = cpu ^. t ADDR t _c -> let value = cpu ^. t
(newValue, newFlags) = add (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in (newValue, newFlags) = add (cpu ^. a) value $ _c && cpu ^. flags . carry in
cpu & registers . a .~ newValue cpu & a .~ newValue
& registers . flags .~ newFlags & flags .~ newFlags
ADDHL _c -> let value = fetch cpu $ cpu ^. registers . hl ADDHL _c -> let value = fetch cpu $ cpu ^. hl
(newValue, newFlags) = add (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in (newValue, newFlags) = add (cpu ^. a) value $ _c && cpu ^. flags . carry in
cpu & registers . a .~ newValue cpu & a .~ newValue
& registers . flags .~ newFlags & 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 ^. a) value $ _c && cpu ^. flags . carry in
cpu & registers . a .~ newValue cpu & a .~ newValue
& registers . flags .~ newFlags & flags .~ newFlags
SUBR t _c -> let value = cpu ^. t SUBR t _c -> let value = cpu ^. t
(newValue, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in (newValue, newFlags) = sub (cpu ^. a) value $ _c && cpu ^. flags . carry in
cpu & registers . a .~ newValue cpu & a .~ newValue
& registers . flags .~ newFlags & flags .~ newFlags
SUBHL _c -> let value = fetch cpu $ cpu ^. registers . hl SUBHL _c -> let value = fetch cpu $ cpu ^. hl
(newValue, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in (newValue, newFlags) = sub (cpu ^. a) value $ _c && cpu ^. flags . carry in
cpu & registers . a .~ newValue cpu & a .~ newValue
& registers . flags .~ newFlags & 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 ^. a) value $ _c && cpu ^. flags . carry in
cpu & registers . a .~ newValue cpu & a .~ newValue
& registers . flags .~ newFlags & flags .~ newFlags
CPR t -> let value = cpu ^. t CPR t -> let value = cpu ^. t
(_, newFlags) = sub (cpu ^. registers . a) value $ False in (_, newFlags) = sub (cpu ^. a) value $ False in
cpu & registers . flags .~ newFlags cpu & flags .~ newFlags
CPHL -> let value = fetch cpu $ cpu ^. registers . hl CPHL -> let value = fetch cpu $ cpu ^. hl
(_, newFlags) = sub (cpu ^. registers . a) value $ False in (_, newFlags) = sub (cpu ^. a) value $ False in
cpu & registers . flags .~ newFlags cpu & flags .~ newFlags
CPN value -> let (_, newFlags) = sub (cpu ^. registers . a) value $ False in CPN value -> let (_, newFlags) = sub (cpu ^. a) value $ False in
cpu & registers . flags .~ newFlags cpu & flags .~ newFlags
INCR t -> let (value, newFlags) = add (cpu ^. t) 1 False in INCR t -> let (value, newFlags) = add (cpu ^. t) 1 False in
cpu & t .~ value cpu & t .~ value
& registers . flags .~ newFlags & flags .~ newFlags
INCHL -> let target = cpu ^. registers . hl INCHL -> let target = cpu ^. 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 & flags .~ newFlags
DECR t -> let (value, newFlags) = sub (cpu ^. t) 1 False in DECR t -> let (value, newFlags) = sub (cpu ^. t) 1 False in
cpu & t .~ value cpu & t .~ value
& registers . flags .~ newFlags & flags .~ newFlags
DECHL -> let target = cpu ^. registers . hl DECHL -> let target = cpu ^. 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 & flags .~ newFlags
BOR t op _f -> let newValue = (cpu ^. registers . a) `op` (cpu ^. t) BOR t op _f -> let newValue = (cpu ^. a) `op` (cpu ^. t)
newFlags = _f {_zero = newValue == 0} in newFlags = _f {_zero = newValue == 0} in
cpu & registers . a .~ newValue cpu & a .~ newValue
& registers . flags .~ newFlags & flags .~ newFlags
BOHL op _f -> let target = cpu ^. registers . hl BOHL op _f -> let target = cpu ^. hl
value = fetch cpu target value = fetch cpu target
newValue = (cpu ^. registers . a) `op` value newValue = (cpu ^. a) `op` value
newFlags = _f {_zero = value == 0} in newFlags = _f {_zero = value == 0} in
cpu & registers . a .~ newValue cpu & a .~ newValue
& registers . flags .~ newFlags & flags .~ newFlags
BON value op _f -> let newValue = (cpu ^. registers . a) `op` value BON value op _f -> let newValue = (cpu ^. a) `op` value
newFlags = _f {_zero = newValue == 0} in newFlags = _f {_zero = newValue == 0} in
cpu & registers . a .~ newValue cpu & a .~ newValue
& registers . flags .~ newFlags & flags .~ newFlags
CCF -> cpu & registers . flags . negative .~ False CCF -> cpu & flags . negative .~ False
& registers . flags . halfCarry .~ False & flags . halfCarry .~ False
& registers . flags . carry %~ not & flags . carry %~ not
SCF -> cpu & registers . flags . negative .~ False SCF -> cpu & flags . negative .~ False
& registers . flags . halfCarry .~ False & flags . halfCarry .~ False
& registers . flags . carry .~ True & flags . carry .~ True
DAA -> undefined -- TODO: undefined in manual DAA -> undefined -- TODO: undefined in manual
CPL -> cpu & registers . a %~ complement CPL -> cpu & a %~ complement
& registers . flags . negative .~ True & flags . negative .~ True
& registers . flags . halfCarry .~ True & flags . halfCarry .~ True
INCRR -> cpu & registers . bc %~ (+1) INCRR -> cpu & bc %~ (+1)
DECRR -> cpu & registers . bc %~ (+1) DECRR -> cpu & bc %~ (+1)
ADDHLRR t -> let _flags = cpu ^. registers . flags ADDHLRR t -> let _flags = cpu ^. flags
_hl = cpu ^. registers . hl _hl = cpu ^. hl
val = cpu ^. t val = cpu ^. t
(newValue, newFlags) = add16 _hl val _flags in (newValue, newFlags) = add16 _hl val _flags in
cpu & registers . hl .~ newValue cpu & hl .~ newValue
& registers . flags .~ newFlags & flags .~ newFlags
ADDSP _e -> let value = cpu ^. sp ADDSP _e -> let value = cpu ^. sp
newValue :: Word16 = fromIntegral $ (fromIntegral value :: Integer) + (fromIntegral _e) in newValue :: Word16 = fromIntegral $ (fromIntegral value :: Integer) + (fromIntegral _e) in
cpu & sp .~ newValue cpu & sp .~ newValue
& registers . flags .~ & flags .~
FlagRegister { _zero = False, FlagRegister { _zero = False,
_negative = False, _negative = False,
_halfCarry = value .&. 16 + fromIntegral _e .&. 16 > 16, -- TODO: check if this still works out _halfCarry = value .&. 16 + fromIntegral _e .&. 16 > 16, -- TODO: check if this still works out
_carry = value > newValue _carry = value > newValue
} }
RLCA -> let _carry = (cpu ^. registers . a) `testBit` 8 in RLCA -> let _carry = (cpu ^. a) `testBit` 8 in
cpu & registers . a %~ (`rotateL` 1) cpu & a %~ (`rotateL` 1)
& registers . flags .~ FlagRegister {_zero = False, _negative = False, _halfCarry = False, ..} & flags .~ FlagRegister {_zero = False, _negative = False, _halfCarry = False, ..}
RRCA -> let _carry = (cpu ^. registers . a) `testBit` 1 in RRCA -> let _carry = (cpu ^. a) `testBit` 1 in
cpu & registers . a %~ (`rotateR` 1) cpu & a %~ (`rotateR` 1)
& registers . flags .~ FlagRegister {_zero = False, _negative = False, _halfCarry = False, ..} & flags .~ FlagRegister {_zero = False, _negative = False, _halfCarry = False, ..}
RLA -> let _carry = (cpu ^. registers . a) `testBit` 8 RLA -> let _carry = (cpu ^. a) `testBit` 8
_c = cpu ^. registers . flags . carry in _c = cpu ^. flags . carry in
cpu & registers . a %~ (if _c then (+1) else id) . (.<<. 1) cpu & a %~ (if _c then (+1) else id) . (.<<. 1)
& registers . flags .~ FlagRegister {_zero = False, _negative = False, _halfCarry = False, ..} & flags .~ FlagRegister {_zero = False, _negative = False, _halfCarry = False, ..}
RRA -> let _carry = (cpu ^. registers . a) `testBit` 1 RRA -> let _carry = (cpu ^. a) `testBit` 1
_c = cpu ^. registers . flags . carry in _c = cpu ^. flags . carry in
cpu & registers . a %~ (if _c then (+128) else id) . (.>>. 1) cpu & a %~ (if _c then (+128) else id) . (.>>. 1)
& registers . flags .~ FlagRegister {_zero = False, _negative = False, _halfCarry = False, ..} & flags .~ FlagRegister {_zero = False, _negative = False, _halfCarry = False, ..}
RLC t -> let _carry = (cpu ^. t) `testBit` 8 RLC t -> let _carry = (cpu ^. t) `testBit` 8
newValue = cpu ^. t `rotateL` 1 in newValue = cpu ^. t `rotateL` 1 in
cpu & t .~ newValue cpu & t .~ newValue
& registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} & flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
RLCHL -> let target = cpu ^. registers . hl RLCHL -> let target = cpu ^. hl
value = fetch cpu target value = fetch cpu target
_carry = (value) `testBit` 8 _carry = (value) `testBit` 8
newValue = value `rotateL` 1 in newValue = value `rotateL` 1 in
write cpu target newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} write cpu target newValue & flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
RRC t -> let _carry = (cpu ^. t) `testBit` 1 RRC t -> let _carry = (cpu ^. t) `testBit` 1
newValue = cpu ^. t `rotateR` 1 in newValue = cpu ^. t `rotateR` 1 in
cpu & t .~ newValue cpu & t .~ newValue
& registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} & flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
RRCHL -> let target = cpu ^. registers . hl RRCHL -> let target = cpu ^. hl
value = fetch cpu target value = fetch cpu target
_carry = value `testBit` 1 _carry = value `testBit` 1
newValue = value `rotateR` 1 in newValue = value `rotateR` 1 in
write cpu target newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} write cpu target newValue & flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
RL t -> let _carry = (cpu ^. t) `testBit` 8 RL t -> let _carry = (cpu ^. t) `testBit` 8
_c = cpu ^. registers . flags . carry _c = cpu ^. flags . carry
newValue = (if _c then (+1) else id) $ cpu ^. t .<<. 1 in newValue = (if _c then (+1) else id) $ cpu ^. t .<<. 1 in
cpu & t .~ newValue cpu & t .~ newValue
& registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} & flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
RLHL -> let target = cpu ^. registers . hl RLHL -> let target = cpu ^. hl
value = fetch cpu target value = fetch cpu target
_c = cpu ^. registers . flags . carry _c = cpu ^. flags . carry
_carry = value `testBit` 8 _carry = value `testBit` 8
newValue = (if _c then (+1) else id) $ value .<<. 1 in newValue = (if _c then (+1) else id) $ value .<<. 1 in
write cpu target newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} write cpu target newValue & flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
RR t -> let _carry = (cpu ^. t) `testBit` 1 RR t -> let _carry = (cpu ^. t) `testBit` 1
_c = cpu ^. registers . flags . carry _c = cpu ^. flags . carry
newValue = (if _c then (+128) else id) $ cpu ^. t .>>. 1 in newValue = (if _c then (+128) else id) $ cpu ^. t .>>. 1 in
cpu & t .~ newValue cpu & t .~ newValue
& registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} & flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
RRHL -> let target = cpu ^. registers . hl RRHL -> let target = cpu ^. hl
value = fetch cpu target value = fetch cpu target
_c = cpu ^. registers . flags . carry _c = cpu ^. flags . carry
_carry = value `testBit` 1 _carry = value `testBit` 1
newValue = (if _c then (+128) else id) $ value .>>. 1 in newValue = (if _c then (+128) else id) $ value .>>. 1 in
write cpu target newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} write cpu target newValue & flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
SLA t -> let _carry = (cpu ^. t) `testBit` 8 SLA t -> let _carry = (cpu ^. t) `testBit` 8
newValue = cpu ^. t .<<. 1 newValue = cpu ^. t .<<. 1
in in
cpu & t .~ newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} cpu & t .~ newValue & flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
SLAHL -> let target = cpu ^. registers . hl SLAHL -> let target = cpu ^. hl
value = fetch cpu target value = fetch cpu target
newValue = value .<<. 1 newValue = value .<<. 1
_carry = value `testBit` 8 _carry = value `testBit` 8
in in
write cpu target newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} write cpu target newValue & flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
SR t arith -> let _carry = (cpu ^. t) `testBit` 1 SR t arith -> let _carry = (cpu ^. t) `testBit` 1
value = cpu ^. t value = cpu ^. t
newValue = let temp = value .>>. 1 in if value `testBit` 8 && arith then temp `setBit` 8 else temp newValue = let temp = value .>>. 1 in if value `testBit` 8 && arith then temp `setBit` 8 else temp
in in
cpu & t .~ newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} cpu & t .~ newValue & flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
SRHL arith -> let target = cpu ^. registers . hl SRHL arith -> let target = cpu ^. hl
value = fetch cpu target value = fetch cpu target
newValue = let temp = value .>>. 1 in if value `testBit` 8 && arith then temp `setBit` 8 else temp newValue = let temp = value .>>. 1 in if value `testBit` 8 && arith then temp `setBit` 8 else temp
_carry = value `testBit` 1 in _carry = value `testBit` 1 in
write cpu target newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} write cpu target newValue & flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
SWAP t -> let newValue = cpu ^. t `rotateR` 4 in SWAP t -> let newValue = cpu ^. t `rotateR` 4 in
cpu & t .~ newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, _carry = False} cpu & t .~ newValue & flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, _carry = False}
SWAPHL -> let target = cpu ^. registers . hl SWAPHL -> let target = cpu ^. hl
value = fetch cpu target value = fetch cpu target
newValue = value `rotateR` 4 in newValue = value `rotateR` 4 in
write cpu target newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, _carry = False} write cpu target newValue & flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, _carry = False}
BIT t i -> let value = cpu ^. t in BIT t i -> let value = cpu ^. t in
cpu & registers . flags %~ (\_f -> _f { _zero = not $ value `testBit` i, _negative = False, _halfCarry = True }) cpu & flags %~ (\_f -> _f { _zero = not $ value `testBit` i, _negative = False, _halfCarry = True })
BITHL i -> let target = cpu ^. registers . hl BITHL i -> let target = cpu ^. hl
value = fetch cpu target in value = fetch cpu target in
cpu & registers . flags %~ (\_f -> _f { _zero = not $ value `testBit` i, _negative = False, _halfCarry = True }) cpu & flags %~ (\_f -> _f { _zero = not $ value `testBit` i, _negative = False, _halfCarry = True })
RES t i -> cpu & t %~ (`clearBit` i) RES t i -> cpu & t %~ (`clearBit` i)
RESHL i -> let target = cpu ^. registers . hl RESHL i -> let target = cpu ^. hl
value = fetch cpu target value = fetch cpu target
newValue = value `clearBit` i in newValue = value `clearBit` i in
write cpu target newValue write cpu target newValue
SET t i -> cpu & t %~ (`setBit` i) SET t i -> cpu & t %~ (`setBit` i)
SETHL i -> let target = cpu ^. registers . hl SETHL i -> let target = cpu ^. hl
value = fetch cpu target value = fetch cpu target
newValue = value `setBit` i in newValue = value `setBit` i in
write cpu target newValue write cpu target newValue
LDRR t _f -> cpu & t .~ cpu ^. _f LDRR t _f -> cpu & t .~ cpu ^. _f
LDRN t v -> cpu & t .~ v LDRN t v -> cpu & t .~ v
LDRHL t -> let target = cpu ^. registers . hl LDRHL t -> let target = cpu ^. hl
value = fetch cpu target in value = fetch cpu target in
cpu & t .~ value cpu & t .~ value
LDXR t _f -> let target = cpu ^. t in LDXR t _f -> let target = cpu ^. t in
write cpu target $ cpu ^. _f write cpu target $ cpu ^. _f
LDXN t v -> let target = cpu ^. t in LDXN t v -> let target = cpu ^. t in
write cpu target v write cpu target v
LDANN _f -> cpu & registers . a .~ fetch cpu _f LDANN _f -> cpu & a .~ fetch cpu _f
LDNNA _t -> write cpu _t $ cpu ^. registers . a LDNNA _t -> write cpu _t $ cpu ^. a
LDHAC -> let target = 65280 + (fromIntegral $ cpu ^. registers . c) LDHAC -> let target = 65280 + (fromIntegral $ cpu ^. c)
value = fetch cpu target in value = fetch cpu target in
cpu & registers . a .~ value cpu & a .~ value
LDHCA -> let target = 65280 + (fromIntegral $ cpu ^. registers . c) in LDHCA -> let target = 65280 + (fromIntegral $ cpu ^. c) in
write cpu target $ cpu ^. registers . a write cpu target $ cpu ^. a
LDHAN v -> let target = 65280 + (fromIntegral v) LDHAN v -> let target = 65280 + (fromIntegral v)
value = fetch cpu target in value = fetch cpu target in
cpu & registers . a .~ value cpu & a .~ value
LDHNA v -> let target = 65280 + (fromIntegral v) in LDHNA v -> let target = 65280 + (fromIntegral v) in
write cpu target $ cpu ^. registers . a write cpu target $ cpu ^. a
LDAHL op -> let target = cpu ^. registers . hl LDAHL op -> let target = cpu ^. hl
value = fetch cpu target in value = fetch cpu target in
cpu & registers . a .~ value cpu & a .~ value
& registers . hl %~ op & hl %~ op
LDHLA op -> let target = cpu ^. registers . hl in LDHLA op -> let target = cpu ^. hl in
write cpu target (cpu ^. registers . a) write cpu target (cpu ^. a)
& registers . hl %~ op & hl %~ op
LDRRNN t v -> cpu & t .~ v LDRRNN t v -> cpu & t .~ v
LDNNSP v -> write cpu v . fetch cpu $ cpu ^. sp LDNNSP v -> write cpu v . fetch cpu $ cpu ^. sp
LDSPHL -> cpu & sp .~ cpu ^. registers . hl LDSPHL -> cpu & sp .~ cpu ^. hl
PUSHRR t -> let cpu' = cpu & sp %~ subtract 1 PUSHRR t -> let cpu' = cpu & sp %~ subtract 1
msb = fromIntegral $ (cpu ^. t) .>>. 4 msb = fromIntegral $ (cpu ^. t) .>>. 4
lsb = fromIntegral $ (cpu ^. t) .&. 255 lsb = fromIntegral $ (cpu ^. t) .&. 255
@@ -386,8 +405,8 @@ execute cpu = \case
& sp %~ (+1) & sp %~ (+1)
LDHLSPE v -> let value = cpu ^. sp LDHLSPE v -> let value = cpu ^. sp
newValue :: Word16 = fromIntegral $ (fromIntegral value :: Integer) + (fromIntegral v) in newValue :: Word16 = fromIntegral $ (fromIntegral value :: Integer) + (fromIntegral v) in
cpu & registers . hl .~ value cpu & hl .~ value
& registers . flags .~ & flags .~
FlagRegister { _zero = False, FlagRegister { _zero = False,
_negative = False, _negative = False,
_halfCarry = value .&. 16 + fromIntegral v .&. 16 > 16, -- TODO: check if this still works out _halfCarry = value .&. 16 + fromIntegral v .&. 16 > 16, -- TODO: check if this still works out