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

All the 8bit arithmetic things done

Browse Source
This commit is contained in:
pingu
2026-03-30 13:59:53 +02:00
parent d01db89fb0
commit 45339997c8
1 changed files with 36 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files

44
src/GB/CPU.hs
View File

@@ -9,13 +9,12 @@ import Lens.Micro.Platform
import Data.Word
import Data.Bits
import qualified Data.Vector.Sized as V
import Prelude hiding (subtract)
class Convert a b where
convert :: a -> b
data FlagRegister = FlagRegister { _zero :: Bool
, _subtract :: Bool
, _negative :: Bool
, _halfCarry :: Bool
, _carry :: Bool
}
@@ -25,8 +24,8 @@ makeLenses ''FlagRegister
zeroFlagPosition :: Int
zeroFlagPosition = 7
subtractFlagPosition :: Int
subtractFlagPosition = 6
negativeFlagPosition :: Int
negativeFlagPosition = 6
halfCarryFlagPosition :: Int
halfCarryFlagPosition = 5
carryFlagPosition :: Int
@@ -35,14 +34,14 @@ carryFlagPosition = 4
instance Convert FlagRegister Word8 where
convert r =
((`shiftL` zeroFlagPosition) $ if r ^. zero then 1 else 0) +
((`shiftL` subtractFlagPosition) $ if r ^. subtract then 1 else 0) +
((`shiftL` negativeFlagPosition) $ if r ^. negative then 1 else 0) +
((`shiftL` halfCarryFlagPosition) $ if r ^. halfCarry then 1 else 0) +
((`shiftL` carryFlagPosition) $ if r ^. carry then 1 else 0)
instance Convert Word8 FlagRegister where
convert w =
let _zero = (shiftR w zeroFlagPosition .&. 1 /= 0)
_subtract = (shiftR w subtractFlagPosition .&. 1 /= 0)
_negative = (shiftR w negativeFlagPosition .&. 1 /= 0)
_halfCarry = (shiftR w halfCarryFlagPosition .&. 1 /= 0)
_carry = (shiftR w carryFlagPosition .&. 1 /= 0) in
FlagRegister {..}
@@ -96,6 +95,13 @@ data Instruction where
IncHL :: Instruction
DecR :: ArithmeticTarget -> Instruction
DecHL :: Instruction
BOR :: ArithmeticTarget -> (Word8 -> Word8 -> Word8) -> FlagRegister -> Instruction
BOHL :: (Word8 -> Word8 -> Word8) -> FlagRegister -> Instruction
BON :: Word8 -> (Word8 -> Word8 -> Word8) -> FlagRegister -> Instruction
CCF :: Instruction
SCF :: Instruction
DAA :: Instruction -- TODO: What does this do?
CPL :: Instruction
execute :: CPU -> Instruction -> CPU
execute cpu = \case
@@ -135,11 +141,33 @@ execute cpu = \case
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 ^. registers . t)
newFlags = _f {_zero = newValue == 0} in
cpu & registers . a .~ newValue & registers . flags .~ newFlags
BOHL op _f -> let target = getHL $ cpu ^. registers
value = fetch cpu target
newValue = (cpu ^. registers . a) `op` value
newFlags = _f {_zero = value == 0} in
cpu & registers . a .~ newValue & registers . flags .~ newFlags
BON value op _f -> let newValue = (cpu ^. registers . 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
DAA -> undefined -- TODO: undefined in manual
CPL -> cpu & registers . a %~ complement
& registers . flags . negative .~ True
& registers . flags . halfCarry .~ True
where
add :: Word8 -> Word8 -> Bool -> (Word8, FlagRegister)
add o n _c = let new = o + n + if _c then 1 else 0
_zero = new == 0
_subtract = False
_negative = False
_carry = o > new
_halfCarry = o .&. 16 + n .&. 16 > 16 in
(new, FlagRegister {..})
@@ -147,7 +175,7 @@ execute cpu = \case
sub :: Word8 -> Word8 -> Bool -> (Word8, FlagRegister)
sub o n _c = let new = o - n - if _c then 1 else 0
_zero = new == 0
_subtract = True
_negative = True
_carry = o > new
_halfCarry = o .&. 16 + n .&. 16 > 16 in
(new, FlagRegister {..})