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

damn

Browse Source
This commit is contained in:
pingu
2026-04-02 23:59:29 +02:00
parent c09c8d0fcb
commit 9843466b4f
1 changed files with 32 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

45
src/GBC/CPU.hs
View File

@@ -11,6 +11,12 @@ import Data.Bits
import Data.Int import Data.Int
import qualified Data.Vector.Sized as V import qualified Data.Vector.Sized as V
splitWord :: Word16 -> (Word8, Word8)
splitWord w = (fromIntegral $ w .>>. 8, fromIntegral $ w .&. 255)
combineWords :: Word8 -> Word8 -> Word16
combineWords msb lsb = (fromIntegral msb .<<. 8) + (fromIntegral lsb)
class Convert a b where class Convert a b where
convert :: a -> b convert :: a -> b
@@ -64,15 +70,15 @@ makeLenses ''Registers
rbc :: Lens' Registers Word16 rbc :: Lens' Registers Word16
rbc = lens (\r -> (( .<<. 8) . fromIntegral $ r ^. rb) + (fromIntegral $ r ^. rc)) rbc = lens (\r -> (( .<<. 8) . fromIntegral $ r ^. rb) + (fromIntegral $ r ^. rc))
(\r w -> r & rb %~ (const $ fromIntegral $ w .>>. 8) & rc %~ (const $ fromIntegral $ w .&. 255)) (\r w -> let (msb, lsb) = splitWord w in r & rb .~ msb & rc .~ lsb)
rde :: Lens' Registers Word16 rde :: Lens' Registers Word16
rde = lens (\r -> (( .<<. 8) . fromIntegral $ r ^. rd) + (fromIntegral $ r ^. re)) rde = lens (\r -> (( .<<. 8) . fromIntegral $ r ^. rd) + (fromIntegral $ r ^. re))
(\r w -> r & rd %~ (const $ fromIntegral $ w .>>. 8) & re %~ (const $ fromIntegral $ w .&. 255)) (\r w -> let (msb, lsb) = splitWord w in r & rd .~ msb & re .~ lsb)
rhl :: Lens' Registers Word16 rhl :: Lens' Registers Word16
rhl = lens (\r -> ((.<<. 8) . fromIntegral $ r ^. rh) + (fromIntegral $ r ^. rl)) rhl = lens (\r -> ((.<<. 8) . fromIntegral $ r ^. rh) + (fromIntegral $ r ^. rl))
(\r w -> r & rh %~ (const $ fromIntegral $ w .>>. 8) & rl %~ (const $ fromIntegral $ w .&. 255)) (\r w -> let (msb, lsb) = splitWord w in r & rh .~ msb & rl .~ lsb)
data CPU = CPU { _registers :: Registers data CPU = CPU { _registers :: Registers
, _ir :: Word8 , _ir :: Word8
@@ -107,6 +113,7 @@ negative = lens (^. flags . fNegative) (\cpu _f -> cpu & flags . fNegative .~
halfCarry = lens (^. flags . fHalfCarry) (\cpu _f -> cpu & flags . fHalfCarry .~ _f) halfCarry = lens (^. flags . fHalfCarry) (\cpu _f -> cpu & flags . fHalfCarry .~ _f)
carry = lens (^. flags . fCarry) (\cpu _f -> cpu & flags . fCarry .~ _f) carry = lens (^. flags . fCarry) (\cpu _f -> cpu & flags . fCarry .~ _f)
type ByteTarget = Lens' CPU Word8 type ByteTarget = Lens' CPU Word8
type WordTarget = Lens' CPU Word16 type WordTarget = Lens' CPU Word16
type FlagTarget = Lens' CPU Bool type FlagTarget = Lens' CPU Bool
@@ -419,14 +426,13 @@ execute cpu = \case
LDNNSP v -> write cpu v . fetch cpu $ cpu ^. sp LDNNSP v -> write cpu v . fetch cpu $ cpu ^. sp
LDSPHL -> cpu & sp .~ cpu ^. hl LDSPHL -> cpu & sp .~ cpu ^. hl
PUSHRR t -> let cpu' = cpu & sp %~ subtract 1 PUSHRR t -> let cpu' = cpu & sp %~ subtract 1
msb = fromIntegral $ (cpu ^. t) .>>. 4 (msb, lsb) = splitWord $ cpu ^. t
lsb = fromIntegral $ (cpu ^. t) .&. 255
cpu'' = write cpu' (cpu' ^. sp) msb & sp %~ subtract 1 in cpu'' = write cpu' (cpu' ^. sp) msb & sp %~ subtract 1 in
write cpu'' (cpu'' ^. sp) lsb write cpu'' (cpu'' ^. sp) lsb
POPRR t -> let lsb = fetch cpu (cpu ^. sp) POPRR t -> let lsb = fetch cpu (cpu ^. sp)
cpu' = cpu & sp %~ (+1) cpu' = cpu & sp %~ (+1)
msb = fetch cpu' (cpu' ^. sp) msb = fetch cpu' (cpu' ^. sp)
value = (fromIntegral msb .<<. 8) + (fromIntegral lsb) value = combineWords msb lsb
in in
cpu & t .~ value cpu & t .~ value
& sp %~ (+1) & sp %~ (+1)
@@ -450,14 +456,27 @@ execute cpu = \case
cpu cpu
CALLNN v -> undefined CALLNN v -> undefined
CALLCCNN v _f op -> undefined CALLCCNN v _f op -> undefined
RET -> undefined RET -> let lsb = fetch cpu (cpu ^. sp)
cpu' = cpu & sp %~ (+1)
msb = fetch cpu' (cpu' ^. sp)
value = combineWords msb lsb in
cpu & pc .~ value
& ie .~ 1
RETCC _f op -> undefined RETCC _f op -> undefined
RETI -> undefined RETI -> let lsb = fetch cpu (cpu ^. sp)
RSTN v -> undefined cpu' = cpu & sp %~ (+1)
msb = fetch cpu' (cpu' ^. sp)
value = combineWords msb lsb in
cpu & pc .~ value
& ie .~ 1
RSTN v -> let cpu' = cpu & sp %~ subtract 1
(msb,lsb) = splitWord $ cpu ^. pc
cpu'' = write cpu' (cpu' ^. sp) msb & sp %~ subtract 1 in
write cpu'' (cpu'' ^. sp) lsb & pc .~ v
HALT -> undefined HALT -> undefined
STOP -> undefined STOP -> undefined
DI -> undefined DI -> cpu & ie .~ 0
EI -> undefined EI -> cpu & ie .~ 1
NOP -> cpu NOP -> cpu
where where
add :: Word8 -> Word8 -> Bool -> (Word8, FlagRegister) add :: Word8 -> Word8 -> Bool -> (Word8, FlagRegister)
@@ -484,7 +503,7 @@ execute cpu = \case
(new, FlagRegister {..}) (new, FlagRegister {..})
fetch :: CPU -> Word16 -> Word8 fetch :: CPU -> Word16 -> Word8
fetch _cpu addr = (`V.index` (fromIntegral addr)) $ _cpu ^. bus fetch _cpu addr = _cpu ^. bus . V.ix (fromIntegral addr)
write :: CPU -> Word16 -> Word8 -> CPU write :: CPU -> Word16 -> Word8 -> CPU
write _cpu target value = _cpu & bus %~ (`V.update` V.singleton (fromIntegral target, value)) write _cpu target value = _cpu & bus . V.ix (fromIntegral target) .~ value