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

I breaka the thingies

Browse Source
This commit is contained in:
pingu
2026-04-02 11:04:49 +02:00
parent 1fbabc80d3
commit 053bd0bbd9
1 changed files with 157 additions and 80 deletions
Download Patch File Download Diff File Expand all files Collapse all files

237
src/GBC/CPU.hs
View File

@@ -66,6 +66,10 @@ bc :: Lens' Registers Word16
bc = lens (\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)) (\r w -> r & b %~ (const $ fromIntegral $ w .>>. 8) & c %~ (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))
hl :: Lens' Registers Word16 hl :: Lens' Registers Word16
hl = lens (\r -> ((.<<. 8) . fromIntegral $ r ^. h) + (fromIntegral $ r ^. l)) hl = lens (\r -> ((.<<. 8) . fromIntegral $ r ^. h) + (fromIntegral $ r ^. l))
(\r w -> r & h %~ (const $ fromIntegral $ w .>>. 8) & l %~ (const $ fromIntegral $ w .&. 255)) (\r w -> r & h %~ (const $ fromIntegral $ w .>>. 8) & l %~ (const $ fromIntegral $ w .&. 255))
@@ -76,23 +80,24 @@ data CPU = CPU { _registers :: Registers
, _bus :: (V.Vector 65536 Word8) } , _bus :: (V.Vector 65536 Word8) }
makeLenses ''CPU makeLenses ''CPU
type ArithmeticTarget = Lens' Registers Word8 type ByteTarget = Lens' CPU Word8
type WordTarget = Lens' CPU Word16
data Instruction where data Instruction where
AddR :: { t :: ArithmeticTarget, withCarry :: Bool } -> Instruction ADDR :: { t :: ByteTarget, withCarry :: Bool } -> Instruction
AddHL :: { withCarry :: Bool } -> Instruction ADDHL :: { withCarry :: Bool } -> Instruction
AddN :: { val :: Word8, withCarry :: Bool } -> Instruction ADDN :: { val :: Word8, withCarry :: Bool } -> Instruction
SubR :: { t :: ArithmeticTarget, withCarry :: Bool } -> Instruction SUBR :: { t :: ByteTarget, withCarry :: Bool } -> Instruction
SubHL :: { withCarry :: Bool } -> Instruction SUBHL :: { withCarry :: Bool } -> Instruction
SubN :: { val :: Word8, withCarry :: Bool } -> Instruction SUBN :: { val :: Word8, withCarry :: Bool } -> Instruction
CpR :: { t :: ArithmeticTarget } -> Instruction CPR :: { t :: ByteTarget } -> Instruction
CpHL :: Instruction CPHL :: Instruction
CpN :: { val :: Word8 } -> Instruction CPN :: { val :: Word8 } -> Instruction
IncR :: { t :: ArithmeticTarget } -> Instruction INCR :: { t :: ByteTarget } -> Instruction
IncHL :: Instruction INCHL :: Instruction
DecR :: { t :: ArithmeticTarget } -> Instruction DECR :: { t :: ByteTarget } -> Instruction
DecHL :: Instruction DECHL :: Instruction
BOR :: { t :: ArithmeticTarget, op :: (Word8 -> Word8 -> Word8), fr :: FlagRegister } -> Instruction BOR :: { t :: ByteTarget, op :: (Word8 -> Word8 -> Word8), fr :: FlagRegister } -> Instruction
BOHL :: { op :: (Word8 -> Word8 -> Word8), fr :: FlagRegister } -> Instruction BOHL :: { op :: (Word8 -> Word8 -> Word8), fr :: FlagRegister } -> Instruction
BON :: { val :: Word8, op :: (Word8 -> Word8 -> Word8), fr :: FlagRegister } -> Instruction BON :: { val :: Word8, op :: (Word8 -> Word8 -> Word8), fr :: FlagRegister } -> Instruction
CCF :: Instruction CCF :: Instruction
@@ -100,85 +105,106 @@ data Instruction where
DAA :: Instruction -- TODO: What does this do? DAA :: Instruction -- TODO: What does this do?
CPL :: Instruction CPL :: Instruction
IncRR :: Instruction INCRR :: Instruction
DecRR :: Instruction DECRR :: Instruction
AddHLRR :: Instruction ADDHLRR :: { from' :: WordTarget } -> Instruction
AddSP :: { rel :: Int8 } -> Instruction ADDSP :: { rel :: Int8 } -> Instruction
RLCA :: Instruction RLCA :: Instruction
RRCA :: Instruction RRCA :: Instruction
RLA :: Instruction RLA :: Instruction
RRA :: Instruction RRA :: Instruction
RLC :: { t :: ArithmeticTarget } -> Instruction RLC :: { t :: ByteTarget } -> Instruction
RLCHL :: Instruction RLCHL :: Instruction
RRC :: { t :: ArithmeticTarget } -> Instruction RRC :: { t :: ByteTarget } -> Instruction
RRCHL :: Instruction RRCHL :: Instruction
RL :: { t :: ArithmeticTarget } -> Instruction RL :: { t :: ByteTarget } -> Instruction
RLHL :: Instruction RLHL :: Instruction
RR :: { t :: ArithmeticTarget } -> Instruction RR :: { t :: ByteTarget } -> Instruction
RRHL :: Instruction RRHL :: Instruction
SLA :: { t :: ArithmeticTarget } -> Instruction SLA :: { t :: ByteTarget } -> Instruction
SLAHL :: Instruction SLAHL :: Instruction
SR :: { t :: ArithmeticTarget, arithmetic :: Bool } -> Instruction SR :: { t :: ByteTarget, arithmetic :: Bool } -> Instruction
SRHL :: { arithmetic :: Bool } -> Instruction SRHL :: { arithmetic :: Bool } -> Instruction
SWAP :: { t :: ArithmeticTarget } -> Instruction SWAP :: { t :: ByteTarget } -> Instruction
SWAPHL :: Instruction SWAPHL :: Instruction
BIT :: { t :: ArithmeticTarget, bit :: Int } -> Instruction BIT :: { t :: ByteTarget, bit :: Int } -> Instruction
BITHL :: { bit :: Int } -> Instruction BITHL :: { bit :: Int } -> Instruction
RES :: { t :: ArithmeticTarget, bit :: Int } -> Instruction RES :: { t :: ByteTarget, bit :: Int } -> Instruction
RESHL :: { bit :: Int } -> Instruction RESHL :: { bit :: Int } -> Instruction
SET :: { t :: ArithmeticTarget, bit :: Int } -> Instruction SET :: { t :: ByteTarget, bit :: Int } -> Instruction
SETHL :: { bit :: Int } -> Instruction SETHL :: { bit :: Int } -> Instruction
LDRR :: { to :: ByteTarget, from :: ByteTarget } -> Instruction
LDRN :: { to :: ByteTarget, val :: Word8 } -> Instruction
LDRHL :: { to :: ByteTarget } -> Instruction
LDXR :: { to' :: WordTarget, from :: ByteTarget } -> Instruction
LDXN :: { to' :: WordTarget, val :: Word8 } -> Instruction
LDANN :: { from'' :: Word16 } -> Instruction
LDNNA :: { to'' :: Word16 } -> Instruction
LDHAC :: Instruction
LDHCA :: Instruction
LDHAN :: { val :: Word8 } -> Instruction
LDHNA :: { val :: Word8 } -> Instruction
LDAHL :: { op' :: (Word16 -> Word16) } -> Instruction
LDHLA :: { op' :: (Word16 -> Word16) } -> Instruction
LDRRNN :: { to' :: WordTarget, val' :: Word16} -> Instruction
LDNNSP :: { val' :: Word16 } -> Instruction
LDSPHL :: Instruction
PUSHRR :: { from' :: WordTarget } -> Instruction
POPRR :: { to' :: WordTarget } -> Instruction
LDHLSPE :: { rel :: Int8 } -> Instruction
execute :: CPU -> Instruction -> CPU execute :: CPU -> Instruction -> CPU
execute cpu = \case execute cpu = \case
AddR t _c -> let value = cpu ^. registers . 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 ^. registers . a) value $ _c && cpu ^. registers . flags . carry in
cpu & registers . a .~ newValue cpu & registers . a .~ newValue
& registers . flags .~ newFlags & registers . flags .~ newFlags
AddHL _c -> let value = fetch cpu $ cpu ^. registers . hl 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 cpu & registers . a .~ newValue
& registers . flags .~ newFlags & 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 cpu & registers . a .~ newValue
& registers . flags .~ newFlags & registers . flags .~ newFlags
SubR t _c -> let value = cpu ^. registers . 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 ^. registers . a) value $ _c && cpu ^. registers . flags . carry in
cpu & registers . a .~ newValue cpu & registers . a .~ newValue
& registers . flags .~ newFlags & registers . flags .~ newFlags
SubHL _c -> let value = fetch cpu $ cpu ^. registers . hl 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 cpu & registers . a .~ newValue
& registers . flags .~ newFlags & 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 cpu & registers . a .~ newValue
& registers . flags .~ newFlags & registers . flags .~ newFlags
CpR t -> let value = cpu ^. registers . t CPR t -> let value = cpu ^. t
(_, newFlags) = sub (cpu ^. registers . a) value $ False in (_, newFlags) = sub (cpu ^. registers . a) value $ False in
cpu & registers . flags .~ newFlags cpu & registers . flags .~ newFlags
CpHL -> let value = fetch cpu $ cpu ^. registers . hl CPHL -> let value = fetch cpu $ cpu ^. registers . hl
(_, newFlags) = sub (cpu ^. registers . a) value $ False in (_, newFlags) = sub (cpu ^. registers . a) value $ False in
cpu & registers . flags .~ newFlags cpu & registers . flags .~ newFlags
CpN value -> let (_, newFlags) = sub (cpu ^. registers . a) value $ False in CPN value -> let (_, newFlags) = sub (cpu ^. registers . a) value $ False 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 ^. t) 1 False in
cpu & registers . t .~ value cpu & t .~ value
& registers . flags .~ newFlags & registers . flags .~ newFlags
IncHL -> let target = cpu ^. registers . hl 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 ^. t) 1 False in
cpu & registers . t .~ value cpu & t .~ value
& registers . flags .~ newFlags & registers . flags .~ newFlags
DecHL -> let target = cpu ^. registers . hl 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 ^. t)
newFlags = _f {_zero = newValue == 0} in newFlags = _f {_zero = newValue == 0} in
cpu & registers . a .~ newValue cpu & registers . a .~ newValue
& registers . flags .~ newFlags & registers . flags .~ newFlags
@@ -203,16 +229,16 @@ execute cpu = \case
CPL -> cpu & registers . a %~ complement CPL -> cpu & registers . a %~ complement
& registers . flags . negative .~ True & registers . flags . negative .~ True
& registers . flags . halfCarry .~ True & registers . flags . halfCarry .~ True
IncRR -> cpu & registers . bc %~ (+1) INCRR -> cpu & registers . bc %~ (+1)
DecRR -> cpu & registers . bc %~ (+1) DECRR -> cpu & registers . bc %~ (+1)
AddHLRR -> let _flags = cpu ^. registers . flags ADDHLRR t -> let _flags = cpu ^. registers . flags
_hl = cpu ^. registers . hl _hl = cpu ^. registers . hl
_bc = cpu ^. registers . bc val = cpu ^. t
(newValue, newFlags) = add16 _hl _bc _flags in (newValue, newFlags) = add16 _hl val _flags in
cpu & registers . hl .~ newValue cpu & registers . hl .~ newValue
& registers . flags .~ newFlags & registers . 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 .~ & registers . flags .~
FlagRegister { _zero = False, FlagRegister { _zero = False,
@@ -234,28 +260,28 @@ execute cpu = \case
_c = cpu ^. registers . flags . carry in _c = cpu ^. registers . flags . carry in
cpu & registers . a %~ (if _c then (+128) else id) . (.>>. 1) cpu & registers . a %~ (if _c then (+128) else id) . (.>>. 1)
& registers . flags .~ FlagRegister {_zero = False, _negative = False, _halfCarry = False, ..} & registers . flags .~ FlagRegister {_zero = False, _negative = False, _halfCarry = False, ..}
RLC t -> let _carry = (cpu ^. registers . t) `testBit` 8 RLC t -> let _carry = (cpu ^. t) `testBit` 8
newValue = cpu ^. registers . t `rotateL` 1 in newValue = cpu ^. t `rotateL` 1 in
cpu & registers . t .~ newValue cpu & t .~ newValue
& registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
RLCHL -> let target = cpu ^. registers . hl RLCHL -> let target = cpu ^. registers . 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 & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
RRC t -> let _carry = (cpu ^. registers . t) `testBit` 1 RRC t -> let _carry = (cpu ^. t) `testBit` 1
newValue = cpu ^. registers . t `rotateR` 1 in newValue = cpu ^. t `rotateR` 1 in
cpu & registers . t .~ newValue cpu & t .~ newValue
& registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
RRCHL -> let target = cpu ^. registers . hl RRCHL -> let target = cpu ^. registers . 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 & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
RL t -> let _carry = (cpu ^. registers . t) `testBit` 8 RL t -> let _carry = (cpu ^. t) `testBit` 8
_c = cpu ^. registers . flags . carry _c = cpu ^. registers . flags . carry
newValue = (if _c then (+1) else id) $ cpu ^. registers . t .<<. 1 in newValue = (if _c then (+1) else id) $ cpu ^. t .<<. 1 in
cpu & registers . t .~ newValue cpu & t .~ newValue
& registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
RLHL -> let target = cpu ^. registers . hl RLHL -> let target = cpu ^. registers . hl
value = fetch cpu target value = fetch cpu target
@@ -263,10 +289,10 @@ execute cpu = \case
_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 & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
RR t -> let _carry = (cpu ^. registers . t) `testBit` 1 RR t -> let _carry = (cpu ^. t) `testBit` 1
_c = cpu ^. registers . flags . carry _c = cpu ^. registers . flags . carry
newValue = (if _c then (+128) else id) $ cpu ^. registers . t .>>. 1 in newValue = (if _c then (+128) else id) $ cpu ^. t .>>. 1 in
cpu & registers . t .~ newValue cpu & t .~ newValue
& registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
RRHL -> let target = cpu ^. registers . hl RRHL -> let target = cpu ^. registers . hl
value = fetch cpu target value = fetch cpu target
@@ -274,49 +300,100 @@ execute cpu = \case
_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 & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
SLA t -> let _carry = (cpu ^. registers . t) `testBit` 8 SLA t -> let _carry = (cpu ^. t) `testBit` 8
newValue = cpu ^. registers . t .<<. 1 newValue = cpu ^. t .<<. 1
in in
cpu & registers . t .~ newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} cpu & t .~ newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
SLAHL -> let target = cpu ^. registers . hl SLAHL -> let target = cpu ^. registers . 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 & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
SR t arith -> let _carry = (cpu ^. registers . t) `testBit` 1 SR t arith -> let _carry = (cpu ^. t) `testBit` 1
value = cpu ^. registers . 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 & registers . t .~ newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} cpu & t .~ newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
SRHL arith -> let target = cpu ^. registers . hl SRHL arith -> let target = cpu ^. registers . 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` 8 _carry = value `testBit` 1 in
in
write cpu target newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} write cpu target newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
SWAP t -> let newValue = cpu ^. registers . t `rotateR` 4 in SWAP t -> let newValue = cpu ^. t `rotateR` 4 in
cpu & registers . t .~ newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, _carry = False} cpu & t .~ newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, _carry = False}
SWAPHL -> let target = cpu ^. registers . hl SWAPHL -> let target = cpu ^. registers . hl
value = fetch cpu target value = fetch cpu target
newValue = value `rotateR` 4 newValue = value `rotateR` 4 in
in
write cpu target newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, _carry = False} write cpu target newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, _carry = False}
BIT t i -> let value = cpu ^. registers . 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 & registers . flags %~ (\_f -> _f { _zero = not $ value `testBit` i, _negative = False, _halfCarry = True })
BITHL i -> let target = cpu ^. registers . hl BITHL i -> let target = cpu ^. registers . 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 & registers . flags %~ (\_f -> _f { _zero = not $ value `testBit` i, _negative = False, _halfCarry = True })
RES t i -> cpu & registers . t %~ (`clearBit` i) RES t i -> cpu & t %~ (`clearBit` i)
RESHL i -> let target = cpu ^. registers . hl RESHL i -> let target = cpu ^. registers . 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 & registers . t %~ (`setBit` i) SET t i -> cpu & t %~ (`setBit` i)
SETHL i -> let target = cpu ^. registers . hl SETHL i -> let target = cpu ^. registers . 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
LDRN t v -> cpu & t .~ v
LDRHL t -> let target = cpu ^. registers . 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)
value = fetch cpu target in
cpu & registers . a .~ value
LDHCA -> let target = 65280 + (fromIntegral $ cpu ^. registers . c) in
write cpu target $ cpu ^. registers . a
LDHAN v -> let target = 65280 + (fromIntegral v)
value = fetch cpu target in
cpu & registers . a .~ value
LDHNA v -> let target = 65280 + (fromIntegral v) in
write cpu target $ cpu ^. registers . a
LDAHL op -> let target = cpu ^. registers . 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
LDRRNN t v -> cpu & t .~ v
LDNNSP v -> write cpu v . fetch cpu $ cpu ^. sp
LDSPHL -> cpu & sp .~ cpu ^. registers . hl
PUSHRR t -> let cpu' = cpu & sp %~ subtract 1
msb = fromIntegral $ (cpu ^. t) .>>. 4
lsb = fromIntegral $ (cpu ^. t) .&. 255
cpu'' = write cpu' (cpu' ^. sp) msb & sp %~ subtract 1 in
write cpu'' (cpu'' ^. sp) lsb
POPRR t -> let lsb = fetch cpu (cpu ^. sp)
cpu' = cpu & sp %~ (+1)
msb = fetch cpu' (cpu' ^. sp)
value = (fromIntegral msb .<<. 8) + (fromIntegral lsb)
in
cpu & t .~ value
& sp %~ (+1)
LDHLSPE v -> let value = cpu ^. sp
newValue :: Word16 = fromIntegral $ (fromIntegral value :: Integer) + (fromIntegral v) in
cpu & registers . hl .~ value
& registers . flags .~
FlagRegister { _zero = False,
_negative = False,
_halfCarry = value .&. 16 + fromIntegral v .&. 16 > 16, -- TODO: check if this still works out
_carry = value > newValue
}
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