Start on cpu things

2026-03-29 21:29:52 +02:00
parent 80e88b57c5
commit 608a0b9f49
9 changed files with 1023 additions and 0 deletions
--- a/src/GB/CPU.hs
+++ b/src/GB/CPU.hs
@@ -0,0 +1,101 @@
+{-# LANGUAGE TemplateHaskell
+           , RecordWildCards
+           , DataKinds
+           , FlexibleContexts
+           , GADTs #-}
+module GB.CPU where
+
+import Lens.Micro.Platform
+import Data.Word
+import Data.Bits
+import qualified Data.Vector.Sized as V
+import Prelude hiding (subtract)
+
+class Convert a b where
+  convert :: a -> b
+
+data FlagRegister = FlagRegister { _zero      :: Bool
+                                 , _subtract  :: Bool
+                                 , _halfCarry :: Bool
+                                 , _carry     :: Bool
+                                 }
+                    deriving Show
+
+makeLenses ''FlagRegister
+
+zeroFlagPosition :: Int
+zeroFlagPosition = 7
+subtractFlagPosition :: Int
+subtractFlagPosition = 6
+halfCarryFlagPosition :: Int
+halfCarryFlagPosition = 5
+carryFlagPosition :: Int
+carryFlagPosition = 4
+
+instance Convert FlagRegister Word8 where
+  convert r =
+    (flip shiftL zeroFlagPosition $ if r ^. zero then 1 else 0) +
+    (flip shiftL subtractFlagPosition $ if r ^. subtract then 1 else 0) +
+    (flip shiftL halfCarryFlagPosition $ if r ^. halfCarry then 1 else 0) +
+    (flip shiftL carryFlagPosition $ if r ^. carry then 1 else 0)
+  
+instance Convert Word8 FlagRegister where
+  convert w =
+    let _zero = (shiftR w zeroFlagPosition .&. 1 /= 0)
+        _subtract = (shiftR w subtractFlagPosition .&. 1 /= 0)
+        _halfCarry = (shiftR w halfCarryFlagPosition .&. 1 /= 0)
+        _carry = (shiftR w carryFlagPosition .&. 1 /= 0) in
+      FlagRegister {..}
+      
+  
+data Registers = Registers { _a     :: Word8
+                           , _b     :: Word8
+                           , _c     :: Word8
+                           , _d     :: Word8
+                           , _e     :: Word8
+                           , _f     :: Word8
+                           , _g     :: Word8
+                           , _h     :: Word8
+                           , _l     :: Word8
+                           , _flags :: FlagRegister
+                           }
+
+makeLenses ''Registers
+
+getBC :: Registers -> Word16
+getBC r = (flip shiftL 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)
+
+data CPU = CPU { _registers :: Registers
+               , _pc :: Word16
+               , _bus :: (V.Vector 65536 Word8) }
+makeLenses ''CPU
+
+data ArithmeticTarget = A | B | C | D | E | H | L
+
+data Instruction where
+  Add :: ArithmeticTarget -> Instruction
+
+execute :: CPU -> Instruction -> CPU
+execute cpu = \case
+  Add t -> 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) = add (cpu ^. registers . a) value in
+            cpu & registers . a %~ const newValue & registers . flags %~ const newFlags
+
+  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 {..})