Tehee
This commit is contained in:
2
.gitignore
vendored
2
.gitignore
vendored
@@ -31,3 +31,5 @@ result-*
|
||||
# Ignore automatically generated direnv output
|
||||
.direnv
|
||||
|
||||
# Ignore spec
|
||||
gbctr.pdf
|
||||
|
||||
117
src/GB/CPU.hs
117
src/GB/CPU.hs
@@ -63,24 +63,43 @@ data Registers = Registers { _a :: Word8
|
||||
makeLenses ''Registers
|
||||
|
||||
getBC :: Registers -> Word16
|
||||
getBC r = (flip shiftL 8 . fromIntegral $ r ^. b) + (fromIntegral $ r ^. c)
|
||||
getBC r = (( .<<. 8) . fromIntegral $ r ^. b) + (fromIntegral $ r ^. c)
|
||||
|
||||
setBC :: Registers -> Word16 -> Registers
|
||||
setBC r w = r & b %~ (const $ fromIntegral $ shiftR w 8) & c %~ (const $ fromIntegral $ w .&. 255)
|
||||
setBC r w = r & b %~ (const $ fromIntegral $ w .>>. 8) & c %~ (const $ fromIntegral $ w .&. 255)
|
||||
|
||||
getHL :: Registers -> Word16
|
||||
getHL r = ((.<<. 8) . fromIntegral $ r ^. h) + (fromIntegral $ r ^. l)
|
||||
|
||||
setHL :: Registers -> Word16 -> Registers
|
||||
setHL r w = r & h %~ (const $ fromIntegral $ w .>>. 8) & l %~ (const $ fromIntegral $ w .&. 255)
|
||||
|
||||
data CPU = CPU { _registers :: Registers
|
||||
, _pc :: Word16
|
||||
, _sp :: Word16
|
||||
, _bus :: (V.Vector 65536 Word8) }
|
||||
makeLenses ''CPU
|
||||
|
||||
data ArithmeticTarget = A | B | C | D | E | H | L
|
||||
|
||||
data Instruction where
|
||||
Add :: ArithmeticTarget -> Instruction
|
||||
AddR :: ArithmeticTarget -> Bool -> Instruction
|
||||
AddHL :: Bool -> Instruction
|
||||
AddN :: Word8 -> Bool -> Instruction
|
||||
SubR :: ArithmeticTarget -> Bool -> Instruction
|
||||
SubHL :: Bool -> Instruction
|
||||
SubN :: Word8 -> Bool -> Instruction
|
||||
CpR :: ArithmeticTarget -> Bool -> Instruction
|
||||
CpHL :: Bool -> Instruction
|
||||
CpN :: Word8 -> Bool -> Instruction
|
||||
IncR :: ArithmeticTarget -> Instruction
|
||||
IncHL :: Instruction
|
||||
DecR :: ArithmeticTarget -> Instruction
|
||||
DecHL :: Instruction
|
||||
|
||||
execute :: CPU -> Instruction -> CPU
|
||||
execute cpu = \case
|
||||
Add t -> let value = case t of
|
||||
AddR t _c -> let value = case t of
|
||||
A -> cpu ^. registers . a
|
||||
B -> cpu ^. registers . b
|
||||
C -> cpu ^. registers . c
|
||||
@@ -88,14 +107,86 @@ execute cpu = \case
|
||||
E -> cpu ^. registers . e
|
||||
H -> cpu ^. registers . h
|
||||
L -> cpu ^. registers . l
|
||||
(newValue, newFlags) = add (cpu ^. registers . a) value in
|
||||
(newValue, newFlags) = add (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in
|
||||
cpu & registers . a %~ const newValue & registers . flags %~ const newFlags
|
||||
AddHL _c -> let value = fetch cpu . getHL $ cpu ^. registers
|
||||
(newValue, newFlags) = add (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in
|
||||
cpu & registers . a %~ const newValue & registers . flags %~ const newFlags
|
||||
AddN value _c -> let (newValue, newFlags) = add (cpu ^. registers . a) value $ _c && cpu ^. registers .flags . carry in
|
||||
cpu & registers . a %~ const newValue & registers . flags %~ const newFlags
|
||||
SubR t _c -> let value = case t of
|
||||
A -> cpu ^. registers . a
|
||||
B -> cpu ^. registers . b
|
||||
C -> cpu ^. registers . c
|
||||
D -> cpu ^. registers . d
|
||||
E -> cpu ^. registers . e
|
||||
H -> cpu ^. registers . h
|
||||
L -> cpu ^. registers . l
|
||||
(newValue, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in
|
||||
cpu & registers . a %~ const newValue & registers . flags %~ const newFlags
|
||||
SubHL _c -> let value = fetch cpu . getHL $ cpu ^. registers
|
||||
(newValue, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in
|
||||
cpu & registers . a %~ const newValue & registers . flags %~ const newFlags
|
||||
SubN value _c -> let (newValue, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers .flags . carry in
|
||||
cpu & registers . a %~ const newValue & registers . flags %~ const newFlags
|
||||
CpR t _c -> let value = case t of
|
||||
A -> cpu ^. registers . a
|
||||
B -> cpu ^. registers . b
|
||||
C -> cpu ^. registers . c
|
||||
D -> cpu ^. registers . d
|
||||
E -> cpu ^. registers . e
|
||||
H -> cpu ^. registers . h
|
||||
L -> cpu ^. registers . l
|
||||
(_, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in
|
||||
cpu & registers . flags %~ const newFlags
|
||||
CpHL _c -> let value = fetch cpu . getHL $ cpu ^. registers
|
||||
(_, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in
|
||||
cpu & registers . flags %~ const newFlags
|
||||
CpN value _c -> let (_, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers .flags . carry in
|
||||
cpu & registers . flags %~ const newFlags
|
||||
IncR t -> let (target, target') = case t of
|
||||
A -> (a,a)
|
||||
B -> (b,b)
|
||||
C -> (c,c)
|
||||
D -> (d,d)
|
||||
E -> (e,e)
|
||||
H -> (h,h)
|
||||
L -> (l,l)
|
||||
(value, newFlags) = add (cpu ^. registers . target) 1 False in
|
||||
cpu & registers . target' %~ const value & registers . flags %~ const newFlags
|
||||
IncHL -> let target = getHL $ cpu ^. registers
|
||||
value = fetch cpu target
|
||||
(newValue, newFlags) = add value 1 False in
|
||||
cpu & bus %~ (flip V.update $ V.singleton (fromIntegral target, newValue)) & registers . flags %~ const newFlags
|
||||
DecR t -> let (target, target') = case t of
|
||||
A -> (a,a)
|
||||
B -> (b,b)
|
||||
C -> (c,c)
|
||||
D -> (d,d)
|
||||
E -> (e,e)
|
||||
H -> (h,h)
|
||||
L -> (l,l)
|
||||
(value, newFlags) = sub (cpu ^. registers . target) 1 False in
|
||||
cpu & registers . target' %~ const value & registers . flags %~ const newFlags
|
||||
DecHL -> let target = getHL $ cpu ^. registers
|
||||
value = fetch cpu target
|
||||
(newValue, newFlags) = sub value 1 False in
|
||||
cpu & bus %~ (flip V.update $ V.singleton (fromIntegral target, newValue)) & registers . flags %~ const newFlags
|
||||
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
|
||||
_carry = o > new
|
||||
_halfCarry = o .&. 16 + n .&. 16 > 16 in
|
||||
(new, FlagRegister {..})
|
||||
fetch :: CPU -> Word16 -> Word8
|
||||
fetch _cpu addr = flip V.index (fromIntegral addr) $ _cpu ^. bus
|
||||
|
||||
where add :: Word8 -> Word8 -> (Word8, FlagRegister)
|
||||
add o n =
|
||||
let new = o + n
|
||||
_zero = new == 0
|
||||
_subtract = False
|
||||
_carry = o > new
|
||||
_halfCarry = o .&. 16 + n .&. 16 > 16 in
|
||||
(new, FlagRegister {..})
|
||||
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
|
||||
_carry = o > new
|
||||
_halfCarry = o .&. 16 + n .&. 16 > 16 in
|
||||
(new, FlagRegister {..})
|
||||
|
||||
Reference in New Issue
Block a user