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.Word
import Data.Bits import Data.Bits
import qualified Data.Vector.Sized as V import qualified Data.Vector.Sized as V
import Prelude hiding (subtract)
class Convert a b where class Convert a b where
convert :: a -> b convert :: a -> b
data FlagRegister = FlagRegister { _zero :: Bool data FlagRegister = FlagRegister { _zero :: Bool
, _subtract :: Bool , _negative :: Bool
, _halfCarry :: Bool , _halfCarry :: Bool
, _carry :: Bool , _carry :: Bool
} }
@@ -25,8 +24,8 @@ makeLenses ''FlagRegister
zeroFlagPosition :: Int zeroFlagPosition :: Int
zeroFlagPosition = 7 zeroFlagPosition = 7
subtractFlagPosition :: Int negativeFlagPosition :: Int
subtractFlagPosition = 6 negativeFlagPosition = 6
halfCarryFlagPosition :: Int halfCarryFlagPosition :: Int
halfCarryFlagPosition = 5 halfCarryFlagPosition = 5
carryFlagPosition :: Int carryFlagPosition :: Int
@@ -35,14 +34,14 @@ carryFlagPosition = 4
instance Convert FlagRegister Word8 where instance Convert FlagRegister Word8 where
convert r = convert r =
((`shiftL` zeroFlagPosition) $ if r ^. zero then 1 else 0) + ((`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` halfCarryFlagPosition) $ if r ^. halfCarry then 1 else 0) +
((`shiftL` carryFlagPosition) $ if r ^. carry then 1 else 0) ((`shiftL` carryFlagPosition) $ if r ^. carry then 1 else 0)
instance Convert Word8 FlagRegister where instance Convert Word8 FlagRegister where
convert w = convert w =
let _zero = (shiftR w zeroFlagPosition .&. 1 /= 0) 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) _halfCarry = (shiftR w halfCarryFlagPosition .&. 1 /= 0)
_carry = (shiftR w carryFlagPosition .&. 1 /= 0) in _carry = (shiftR w carryFlagPosition .&. 1 /= 0) in
FlagRegister {..} FlagRegister {..}
@@ -96,6 +95,13 @@ data Instruction where
IncHL :: Instruction IncHL :: Instruction
DecR :: ArithmeticTarget -> Instruction DecR :: ArithmeticTarget -> Instruction
DecHL :: 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 -> Instruction -> CPU
execute cpu = \case execute cpu = \case
@@ -135,11 +141,33 @@ execute cpu = \case
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)
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 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
_zero = new == 0 _zero = new == 0
_subtract = False _negative = False
_carry = o > new _carry = o > new
_halfCarry = o .&. 16 + n .&. 16 > 16 in _halfCarry = o .&. 16 + n .&. 16 > 16 in
(new, FlagRegister {..}) (new, FlagRegister {..})
@@ -147,7 +175,7 @@ execute cpu = \case
sub :: Word8 -> Word8 -> Bool -> (Word8, FlagRegister) sub :: Word8 -> Word8 -> Bool -> (Word8, FlagRegister)
sub o n _c = let new = o - n - if _c then 1 else 0 sub o n _c = let new = o - n - if _c then 1 else 0
_zero = new == 0 _zero = new == 0
_subtract = True _negative = True
_carry = o > new _carry = o > new
_halfCarry = o .&. 16 + n .&. 16 > 16 in _halfCarry = o .&. 16 + n .&. 16 > 16 in
(new, FlagRegister {..}) (new, FlagRegister {..})