diff --git a/README.md b/README.md deleted file mode 100644 index e7c5d09..0000000 --- a/README.md +++ /dev/null @@ -1,2 +0,0 @@ -# Tia - diff --git a/README.org b/README.org new file mode 100644 index 0000000..dad7a1d --- /dev/null +++ b/README.org @@ -0,0 +1,5 @@ +#+title: Tia + +This aims to be an emulator for the gameboy color, made in Haskell for the memes. + +It as of right now has no particular ambitions, but rather an exploration of emulating that system, one bit at the time. diff --git a/Tia.cabal b/Tia.cabal index 1d9786f..a291065 100644 --- a/Tia.cabal +++ b/Tia.cabal @@ -58,7 +58,8 @@ library import: warnings -- Modules exported by the library. - exposed-modules: GB.CPU + exposed-modules: GBC + , GBC.CPU -- Modules included in this library but not exported. -- other-modules: diff --git a/src/GB.hs b/src/GBC.hs similarity index 78% rename from src/GB.hs rename to src/GBC.hs index 9701450..b36d7bb 100644 --- a/src/GB.hs +++ b/src/GBC.hs @@ -1,3 +1,3 @@ {-# LANGUAGE TemplateHaskell , RecordWildCards #-} -module GB where +module GBC where diff --git a/src/GB/CPU.hs b/src/GBC/CPU.hs similarity index 79% rename from src/GB/CPU.hs rename to src/GBC/CPU.hs index a958274..3ecf76c 100644 --- a/src/GB/CPU.hs +++ b/src/GBC/CPU.hs @@ -3,7 +3,7 @@ , DataKinds , FlexibleContexts , GADTs #-} -module GB.CPU where +module GBC.CPU where import Lens.Micro.Platform import Data.Word @@ -34,17 +34,17 @@ carryFlagPosition = 4 instance Convert FlagRegister Word8 where convert r = - ((`shiftL` zeroFlagPosition) $ if r ^. zero 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) + ((.<<. zeroFlagPosition) $ if r ^. zero then 1 else 0) + + ((.<<. negativeFlagPosition) $ if r ^. negative then 1 else 0) + + ((.<<. halfCarryFlagPosition) $ if r ^. halfCarry then 1 else 0) + + ((.<<. carryFlagPosition) $ if r ^. carry then 1 else 0) instance Convert Word8 FlagRegister where convert w = - let _zero = (shiftR w zeroFlagPosition .&. 1 /= 0) - _negative = (shiftR w negativeFlagPosition .&. 1 /= 0) - _halfCarry = (shiftR w halfCarryFlagPosition .&. 1 /= 0) - _carry = (shiftR w carryFlagPosition .&. 1 /= 0) in + let _zero = (w `testBit` zeroFlagPosition) + _negative = (w `testBit` negativeFlagPosition) + _halfCarry = (w `testBit` halfCarryFlagPosition) + _carry = (w `testBit` carryFlagPosition) in FlagRegister {..} @@ -118,6 +118,11 @@ data Instruction where RR :: ArithmeticTarget -> Instruction RRHL :: Instruction + SLA :: ArithmeticTarget -> Instruction + SLAHL :: Instruction + SRA :: ArithmeticTarget -> Instruction + SRAHL :: Instruction + execute :: CPU -> Instruction -> CPU execute cpu = \case AddR t _c -> let value = cpu ^. registers . t @@ -197,69 +202,91 @@ execute cpu = \case (newValue, newFlags) = add16 _hl _bc _flags in cpu & registers . hl .~ newValue & registers . flags .~ newFlags - AddSP e -> let value = cpu ^. sp - newValue :: Word16 = fromIntegral (fromIntegral value) + (fromIntegral e) in + AddSP _e -> let value = cpu ^. sp + newValue :: Word16 = fromIntegral (fromIntegral value :: Integer) + (fromIntegral _e) in cpu & sp .~ newValue & registers . flags .~ FlagRegister { _zero = False, _negative = False, - _halfCarry = value .&. 16 + fromIntegral e .&. 16 > 16, -- TODO: check if this still works out + _halfCarry = value .&. 16 + fromIntegral _e .&. 16 > 16, -- TODO: check if this still works out _carry = value > newValue } - RLCA -> let _carry = cpu ^. registers . a .&. 128 == 128 in + RLCA -> let _carry = (cpu ^. registers . a) `testBit` 8 in cpu & registers . a %~ (`rotateL` 1) & registers . flags .~ FlagRegister {_zero = False, _negative = False, _halfCarry = False, ..} - RRCA -> let _carry = cpu ^. registers . a .&. 1 == 1 in + RRCA -> let _carry = (cpu ^. registers . a) `testBit` 1 in cpu & registers . a %~ (`rotateR` 1) & registers . flags .~ FlagRegister {_zero = False, _negative = False, _halfCarry = False, ..} - RLA -> let _carry = cpu ^. registers . a .&. 128 == 128 + RLA -> let _carry = (cpu ^. registers . a) `testBit` 8 _c = cpu ^. registers . flags . carry in - cpu & registers . a %~ (if _c then (+1) else id) . (`shiftL` 1) + cpu & registers . a %~ (if _c then (+1) else id) . (.<<. 1) & registers . flags .~ FlagRegister {_zero = False, _negative = False, _halfCarry = False, ..} - RRA -> let _carry = cpu ^. registers . a .&. 1 == 1 + RRA -> let _carry = (cpu ^. registers . a) `testBit` 1 _c = cpu ^. registers . flags . carry in - cpu & registers . a %~ (if _c then (+128) else id) . (`shiftR` 1) + cpu & registers . a %~ (if _c then (+128) else id) . (.>>. 1) & registers . flags .~ FlagRegister {_zero = False, _negative = False, _halfCarry = False, ..} - RLC t -> let _carry = cpu ^. registers . t .&. 128 == 128 + RLC t -> let _carry = (cpu ^. registers . t) `testBit` 8 newValue = cpu ^. registers . t `rotateL` 1 in cpu & registers . t .~ newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} RLCHL -> let target = cpu ^. registers . hl value = fetch cpu target - _carry = value .&. 128 == 128 + _carry = (value) `testBit` 8 newValue = value `rotateL` 1 in write cpu target newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} - RRC t -> let _carry = cpu ^. registers . t .&. 1 == 1 + RRC t -> let _carry = (cpu ^. registers . t) `testBit` 1 newValue = cpu ^. registers . t `rotateR` 1 in cpu & registers . t .~ newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} RRCHL -> let target = cpu ^. registers . hl value = fetch cpu target - _carry = value .&. 1 == 1 + _carry = value `testBit` 1 newValue = value `rotateR` 1 in write cpu target newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} - RL t -> let _carry = cpu ^. registers . t .&. 128 == 128 + RL t -> let _carry = (cpu ^. registers . t) `testBit` 8 _c = cpu ^. registers . flags . carry - newValue = (if _c then (+1) else id) $ cpu ^. registers . t `shiftL` 1 in + newValue = (if _c then (+1) else id) $ cpu ^. registers . t .<<. 1 in cpu & registers . t .~ newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} RLHL -> let target = cpu ^. registers . hl value = fetch cpu target _c = cpu ^. registers . flags . carry - _carry = value .&. 128 == 128 - newValue = (if _c then (+1) else id) $ value `shiftL` 1 in + _carry = value `testBit` 8 + newValue = (if _c then (+1) else id) $ value .<<. 1 in write cpu target newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} - RR t -> let _carry = cpu ^. registers . t .&. 1 == 1 + RR t -> let _carry = (cpu ^. registers . t) `testBit` 1 _c = cpu ^. registers . flags . carry - newValue = (if _c then (+128) else id) $ cpu ^. registers . t `shiftR` 1 in + newValue = (if _c then (+128) else id) $ cpu ^. registers . t .>>. 1 in cpu & registers . t .~ newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} RRHL -> let target = cpu ^. registers . hl value = fetch cpu target _c = cpu ^. registers . flags . carry - _carry = value .&. 1 == 1 - newValue = (if _c then (+128) else id) $ value `shiftR` 1 in + _carry = value `testBit` 1 + newValue = (if _c then (+128) else id) $ value .>>. 1 in write cpu target newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} + SLA t -> let _carry = (cpu ^. registers . t) `testBit` 8 + newValue = cpu ^. registers . t .<<. 1 + in + cpu & registers . t .~ newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} + SLAHL -> let target = cpu ^. registers . hl + value = fetch cpu target + newValue = value .<<. 1 + _carry = value `testBit` 8 + in + write cpu target newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} + SRA t -> let _carry = (cpu ^. registers . t) `testBit` 1 + value = cpu ^. registers . t + newValue = let temp = value .>>. 1 in if value `testBit` 8 then temp `setBit` 8 else temp + in + cpu & registers . t .~ newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} + SRAHL -> let target = cpu ^. registers . hl + value = fetch cpu target + newValue = let temp = value .>>. 1 in if value `testBit` 8 then temp `setBit` 8 else temp + _carry = value `testBit` 8 + in + write cpu target newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..} + where add :: Word8 -> Word8 -> Bool -> (Word8, FlagRegister) add o n _c = let new = o + n + if _c then 1 else 0