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