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

tehee

Browse Source
This commit is contained in:
pingu
2026-04-01 12:07:45 +02:00
parent a69d0c9342
commit 8876614390
1 changed files with 65 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files

100
src/GBC/CPU.hs
View File

@@ -79,22 +79,22 @@ makeLenses ''CPU
type ArithmeticTarget = Lens' Registers Word8 type ArithmeticTarget = Lens' Registers Word8
data Instruction where data Instruction where
AddR :: ArithmeticTarget -> Bool -> Instruction AddR :: { t :: ArithmeticTarget, withCarry :: Bool } -> Instruction
AddHL :: Bool -> Instruction AddHL :: { withCarry :: Bool } -> Instruction
AddN :: Word8 -> Bool -> Instruction AddN :: { val :: Word8, withCarry :: Bool } -> Instruction
SubR :: ArithmeticTarget -> Bool -> Instruction SubR :: { t :: ArithmeticTarget, withCarry :: Bool } -> Instruction
SubHL :: Bool -> Instruction SubHL :: { withCarry :: Bool } -> Instruction
SubN :: Word8 -> Bool -> Instruction SubN :: { val :: Word8, withCarry :: Bool } -> Instruction
CpR :: ArithmeticTarget -> Bool -> Instruction CpR :: { t :: ArithmeticTarget } -> Instruction
CpHL :: Bool -> Instruction CpHL :: Instruction
CpN :: Word8 -> Bool -> Instruction CpN :: { val :: Word8 } -> Instruction
IncR :: ArithmeticTarget -> Instruction IncR :: { t :: ArithmeticTarget } -> Instruction
IncHL :: Instruction IncHL :: Instruction
DecR :: ArithmeticTarget -> Instruction DecR :: { t :: ArithmeticTarget } -> Instruction
DecHL :: Instruction DecHL :: Instruction
BOR :: ArithmeticTarget -> (Word8 -> Word8 -> Word8) -> FlagRegister -> Instruction BOR :: { t :: ArithmeticTarget, op :: (Word8 -> Word8 -> Word8), fr :: FlagRegister } -> Instruction
BOHL :: (Word8 -> Word8 -> Word8) -> FlagRegister -> Instruction BOHL :: { op :: (Word8 -> Word8 -> Word8), fr :: FlagRegister } -> Instruction
BON :: Word8 -> (Word8 -> Word8 -> Word8) -> FlagRegister -> Instruction BON :: { val :: Word8, op :: (Word8 -> Word8 -> Word8), fr :: FlagRegister } -> Instruction
CCF :: Instruction CCF :: Instruction
SCF :: Instruction SCF :: Instruction
DAA :: Instruction -- TODO: What does this do? DAA :: Instruction -- TODO: What does this do?
@@ -103,25 +103,34 @@ data Instruction where
IncRR :: Instruction IncRR :: Instruction
DecRR :: Instruction DecRR :: Instruction
AddHLRR :: Instruction AddHLRR :: Instruction
AddSP :: Int8 -> Instruction AddSP :: { rel :: Int8 } -> Instruction
RLCA :: Instruction RLCA :: Instruction
RRCA :: Instruction RRCA :: Instruction
RLA :: Instruction RLA :: Instruction
RRA :: Instruction RRA :: Instruction
RLC :: ArithmeticTarget -> Instruction RLC :: { t :: ArithmeticTarget } -> Instruction
RLCHL :: Instruction RLCHL :: Instruction
RRC :: ArithmeticTarget -> Instruction RRC :: { t :: ArithmeticTarget } -> Instruction
RRCHL :: Instruction RRCHL :: Instruction
RL :: ArithmeticTarget -> Instruction RL :: { t :: ArithmeticTarget } -> Instruction
RLHL :: Instruction RLHL :: Instruction
RR :: ArithmeticTarget -> Instruction RR :: { t :: ArithmeticTarget } -> Instruction
RRHL :: Instruction RRHL :: Instruction
SLA :: ArithmeticTarget -> Instruction SLA :: { t :: ArithmeticTarget } -> Instruction
SLAHL :: Instruction SLAHL :: Instruction
SRA :: ArithmeticTarget -> Instruction SR :: { t :: ArithmeticTarget, arithmetic :: Bool } -> Instruction
SRAHL :: Instruction SRHL :: { arithmetic :: Bool } -> Instruction
SWAP :: { t :: ArithmeticTarget } -> Instruction
SWAPHL :: Instruction
BIT :: { t :: ArithmeticTarget, bit :: Int } -> Instruction
BITHL :: { bit :: Int } -> Instruction
RES :: { t :: ArithmeticTarget, bit :: Int } -> Instruction
RESHL :: { bit :: Int } -> Instruction
SET :: { t :: ArithmeticTarget, bit :: Int } -> Instruction
SETHL :: { bit :: Int } -> Instruction
execute :: CPU -> Instruction -> CPU execute :: CPU -> Instruction -> CPU
execute cpu = \case execute cpu = \case
@@ -147,13 +156,13 @@ execute cpu = \case
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 _c -> let value = cpu ^. registers . t CpR t -> let value = cpu ^. registers . t
(_, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in (_, newFlags) = sub (cpu ^. registers . a) value $ False in
cpu & registers . flags .~ newFlags cpu & registers . flags .~ newFlags
CpHL _c -> let value = fetch cpu $ cpu ^. registers . hl CpHL -> 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 $ False 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 -> 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 ^. registers . t) 1 False in
cpu & registers . t .~ value cpu & registers . t .~ value
@@ -275,18 +284,39 @@ execute cpu = \case
_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, ..}
SRA t -> let _carry = (cpu ^. registers . t) `testBit` 1 SR t arith -> let _carry = (cpu ^. registers . t) `testBit` 1
value = cpu ^. registers . t value = cpu ^. registers . t
newValue = let temp = value .>>. 1 in if value `testBit` 8 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 & registers . t .~ newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
SRAHL -> 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 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` 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, ..}
SWAP t -> let newValue = cpu ^. registers . t `rotateR` 4 in
cpu & registers . t .~ newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, _carry = False}
SWAPHL -> let target = cpu ^. registers . 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}
BIT t i -> let value = cpu ^. registers . t in
cpu & registers . flags %~ (\_f -> _f { _zero = not $ value `testBit` i, _negative = False, _halfCarry = True })
BITHL i -> let target = cpu ^. registers . hl
value = fetch cpu target in
cpu & registers . flags %~ (\_f -> _f { _zero = not $ value `testBit` i, _negative = False, _halfCarry = True })
RES t i -> cpu & registers . t %~ (`clearBit` i)
RESHL i -> let target = cpu ^. registers . hl
value = fetch cpu target
newValue = value `clearBit` i in
write cpu target newValue
SET t i -> cpu & registers . t %~ (`setBit` i)
SETHL i -> let target = cpu ^. registers . hl
value = fetch cpu target
newValue = value `setBit` i in
write cpu target 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