mjau
This commit is contained in:
130
src/GB/CPU.hs
130
src/GB/CPU.hs
@@ -8,6 +8,7 @@ module GB.CPU where
|
||||
import Lens.Micro.Platform
|
||||
import Data.Word
|
||||
import Data.Bits
|
||||
import Data.Int
|
||||
import qualified Data.Vector.Sized as V
|
||||
|
||||
class Convert a b where
|
||||
@@ -99,24 +100,48 @@ data Instruction where
|
||||
DAA :: Instruction -- TODO: What does this do?
|
||||
CPL :: Instruction
|
||||
|
||||
IncRR :: Instruction
|
||||
DecRR :: Instruction
|
||||
AddHLRR :: Instruction
|
||||
AddSP :: Int8 -> Instruction
|
||||
|
||||
RLCA :: Instruction
|
||||
RRCA :: Instruction
|
||||
RLA :: Instruction
|
||||
RRA :: Instruction
|
||||
RLC :: ArithmeticTarget -> Instruction
|
||||
RLCHL :: Instruction
|
||||
RRC :: ArithmeticTarget -> Instruction
|
||||
RRCHL :: Instruction
|
||||
RL :: ArithmeticTarget -> Instruction
|
||||
RLHL :: Instruction
|
||||
RR :: ArithmeticTarget -> Instruction
|
||||
RRHL :: Instruction
|
||||
|
||||
execute :: CPU -> Instruction -> CPU
|
||||
execute cpu = \case
|
||||
AddR t _c -> let value = cpu ^. registers . t
|
||||
(newValue, newFlags) = add (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in
|
||||
cpu & registers . a .~ newValue & registers . flags .~ newFlags
|
||||
cpu & registers . a .~ newValue
|
||||
& registers . flags .~ newFlags
|
||||
AddHL _c -> let value = fetch cpu $ cpu ^. registers . hl
|
||||
(newValue, newFlags) = add (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in
|
||||
cpu & registers . a .~ newValue & registers . flags .~ newFlags
|
||||
cpu & registers . a .~ newValue
|
||||
& registers . flags .~ newFlags
|
||||
AddN value _c -> let (newValue, newFlags) = add (cpu ^. registers . a) value $ _c && cpu ^. registers .flags . carry in
|
||||
cpu & registers . a .~ newValue & registers . flags .~ newFlags
|
||||
cpu & registers . a .~ newValue
|
||||
& registers . flags .~ newFlags
|
||||
SubR t _c -> let value = cpu ^. registers . t
|
||||
(newValue, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in
|
||||
cpu & registers . a .~ newValue & registers . flags .~ newFlags
|
||||
cpu & registers . a .~ newValue
|
||||
& registers . flags .~ newFlags
|
||||
SubHL _c -> let value = fetch cpu $ cpu ^. registers . hl
|
||||
(newValue, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in
|
||||
cpu & registers . a .~ newValue & registers . flags .~ newFlags
|
||||
cpu & registers . a .~ newValue
|
||||
& registers . flags .~ newFlags
|
||||
SubN value _c -> let (newValue, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers .flags . carry in
|
||||
cpu & registers . a .~ newValue & registers . flags .~ newFlags
|
||||
cpu & registers . a .~ newValue
|
||||
& registers . flags .~ newFlags
|
||||
CpR t _c -> let value = cpu ^. registers . t
|
||||
(_, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in
|
||||
cpu & registers . flags .~ newFlags
|
||||
@@ -126,29 +151,34 @@ execute cpu = \case
|
||||
CpN value _c -> let (_, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers .flags . carry in
|
||||
cpu & registers . flags .~ newFlags
|
||||
IncR t -> let (value, newFlags) = add (cpu ^. registers . t) 1 False in
|
||||
cpu & registers . t .~ value & registers . flags .~ newFlags
|
||||
cpu & registers . t .~ value
|
||||
& registers . flags .~ newFlags
|
||||
IncHL -> let target = cpu ^. registers . hl
|
||||
value = fetch cpu target
|
||||
(newValue, newFlags) = add value 1 False in
|
||||
write cpu target newValue & registers . flags .~ newFlags
|
||||
DecR t -> let (value, newFlags) = sub (cpu ^. registers . t) 1 False in
|
||||
cpu & registers . t .~ value & registers . flags .~ newFlags
|
||||
cpu & registers . t .~ value
|
||||
& registers . flags .~ newFlags
|
||||
DecHL -> let target = cpu ^. registers . hl
|
||||
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
|
||||
cpu & registers . a .~ newValue
|
||||
& registers . flags .~ newFlags
|
||||
BOHL op _f -> let target = cpu ^. registers . hl
|
||||
value = fetch cpu target
|
||||
newValue = (cpu ^. registers . a) `op` value
|
||||
newFlags = _f {_zero = value == 0} in
|
||||
cpu & registers . a .~ newValue & registers . flags .~ newFlags
|
||||
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
|
||||
cpu & registers . a .~ newValue
|
||||
& registers . flags .~ newFlags
|
||||
CCF -> cpu & registers . flags . negative .~ False
|
||||
& registers . flags . halfCarry .~ False
|
||||
& registers . flags . carry %~ not
|
||||
@@ -159,6 +189,77 @@ execute cpu = \case
|
||||
CPL -> cpu & registers . a %~ complement
|
||||
& registers . flags . negative .~ True
|
||||
& registers . flags . halfCarry .~ True
|
||||
IncRR -> cpu & registers . bc %~ (+1)
|
||||
DecRR -> cpu & registers . bc %~ (+1)
|
||||
AddHLRR -> let _flags = cpu ^. registers . flags
|
||||
_hl = cpu ^. registers . hl
|
||||
_bc = cpu ^. registers . bc
|
||||
(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
|
||||
cpu & sp .~ newValue
|
||||
& registers . flags .~
|
||||
FlagRegister { _zero = False,
|
||||
_negative = False,
|
||||
_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
|
||||
cpu & registers . a %~ (`rotateL` 1)
|
||||
& registers . flags .~ FlagRegister {_zero = False, _negative = False, _halfCarry = False, ..}
|
||||
RRCA -> let _carry = cpu ^. registers . a .&. 1 == 1 in
|
||||
cpu & registers . a %~ (`rotateR` 1)
|
||||
& registers . flags .~ FlagRegister {_zero = False, _negative = False, _halfCarry = False, ..}
|
||||
RLA -> let _carry = cpu ^. registers . a .&. 128 == 128
|
||||
_c = cpu ^. registers . flags . carry in
|
||||
cpu & registers . a %~ (if _c then (+1) else id) . (`shiftL` 1)
|
||||
& registers . flags .~ FlagRegister {_zero = False, _negative = False, _halfCarry = False, ..}
|
||||
RRA -> let _carry = cpu ^. registers . a .&. 1 == 1
|
||||
_c = cpu ^. registers . flags . carry in
|
||||
cpu & registers . a %~ (if _c then (+128) else id) . (`shiftR` 1)
|
||||
& registers . flags .~ FlagRegister {_zero = False, _negative = False, _halfCarry = False, ..}
|
||||
RLC t -> let _carry = cpu ^. registers . t .&. 128 == 128
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
_c = cpu ^. registers . flags . carry
|
||||
newValue = (if _c then (+1) else id) $ cpu ^. registers . t `shiftL` 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
|
||||
write cpu target newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, ..}
|
||||
RR t -> let _carry = cpu ^. registers . t .&. 1 == 1
|
||||
_c = cpu ^. registers . flags . carry
|
||||
newValue = (if _c then (+128) else id) $ cpu ^. registers . t `shiftR` 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
|
||||
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
|
||||
@@ -168,6 +269,13 @@ execute cpu = \case
|
||||
_halfCarry = o .&. 16 + n .&. 16 > 16 in
|
||||
(new, FlagRegister {..})
|
||||
|
||||
add16 :: Word16 -> Word16 -> FlagRegister -> (Word16, FlagRegister)
|
||||
add16 o n _f = let new = o + n
|
||||
_negative = False
|
||||
_carry = o > new
|
||||
_halfCarry = o .&. 16 + n .&. 16 > 16 in
|
||||
(new, _f {_negative, _carry, _halfCarry})
|
||||
|
||||
sub :: Word8 -> Word8 -> Bool -> (Word8, FlagRegister)
|
||||
sub o n _c = let new = o - n - if _c then 1 else 0
|
||||
_zero = new == 0
|
||||
|
||||
Reference in New Issue
Block a user