tehee

src/GBC/CPU.hs

@@ -79,22 +79,22 @@ makeLenses ''CPU
 type ArithmeticTarget = Lens' Registers Word8
 
 data Instruction where
-  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
+  AddR :: { t :: ArithmeticTarget, withCarry :: Bool } -> Instruction
+  AddHL :: { withCarry :: Bool } -> Instruction
+  AddN :: { val :: Word8, withCarry :: Bool } -> Instruction
+  SubR :: { t :: ArithmeticTarget, withCarry :: Bool } -> Instruction
+  SubHL :: { withCarry :: Bool } -> Instruction
+  SubN :: { val :: Word8, withCarry :: Bool } -> Instruction
+  CpR :: { t :: ArithmeticTarget } -> Instruction
+  CpHL :: Instruction
+  CpN :: { val :: Word8 } -> Instruction
+  IncR :: { t :: ArithmeticTarget } -> Instruction
   IncHL :: Instruction
-  DecR :: ArithmeticTarget -> Instruction
+  DecR :: { t :: ArithmeticTarget } -> Instruction
   DecHL :: Instruction
-  BOR :: ArithmeticTarget -> (Word8 -> Word8 -> Word8) -> FlagRegister -> Instruction
-  BOHL :: (Word8 -> Word8 -> Word8) -> FlagRegister -> Instruction
-  BON :: Word8 -> (Word8 -> Word8 -> Word8) -> FlagRegister -> Instruction
+  BOR :: { t :: ArithmeticTarget, op :: (Word8 -> Word8 -> Word8), fr :: FlagRegister } -> Instruction
+  BOHL :: { op :: (Word8 -> Word8 -> Word8), fr :: FlagRegister } -> Instruction
+  BON :: { val :: Word8, op :: (Word8 -> Word8 -> Word8), fr :: FlagRegister } -> Instruction
   CCF :: Instruction
   SCF :: Instruction
   DAA :: Instruction -- TODO: What does this do?
@@ -103,25 +103,34 @@ data Instruction where
   IncRR :: Instruction
   DecRR :: Instruction
   AddHLRR :: Instruction
-  AddSP :: Int8 -> Instruction
+  AddSP :: { rel :: Int8 } -> Instruction
 
   RLCA :: Instruction
   RRCA :: Instruction
   RLA :: Instruction
   RRA :: Instruction
-  RLC :: ArithmeticTarget -> Instruction
+  RLC :: { t :: ArithmeticTarget } -> Instruction
   RLCHL :: Instruction
-  RRC :: ArithmeticTarget -> Instruction
+  RRC :: { t :: ArithmeticTarget } -> Instruction
   RRCHL :: Instruction
-  RL :: ArithmeticTarget -> Instruction
+  RL :: { t :: ArithmeticTarget } -> Instruction
   RLHL :: Instruction
-  RR :: ArithmeticTarget -> Instruction
+  RR :: { t :: ArithmeticTarget } -> Instruction
   RRHL :: Instruction
 
-  SLA :: ArithmeticTarget -> Instruction
+  SLA :: { t :: ArithmeticTarget } -> Instruction
   SLAHL :: Instruction
-  SRA :: ArithmeticTarget -> Instruction
-  SRAHL :: Instruction
+  SR :: { t :: ArithmeticTarget, arithmetic :: Bool } -> Instruction
+  SRHL :: { arithmetic :: Bool } -> Instruction
+
+  SWAP :: { t :: ArithmeticTarget } -> Instruction
+  SWAPHL :: Instruction
+  BIT :: { t :: ArithmeticTarget, bit :: Int } -> Instruction
+  BITHL :: { bit :: Int } -> Instruction
+  RES :: { t :: ArithmeticTarget, bit :: Int } -> Instruction
+  RESHL :: { bit :: Int } -> Instruction
+  SET :: { t :: ArithmeticTarget, bit :: Int } -> Instruction
+  SETHL :: { bit :: Int } -> Instruction
 
 execute :: CPU -> Instruction -> CPU
 execute cpu = \case
@@ -147,13 +156,13 @@ execute cpu = \case
   SubN value _c -> let (newValue, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers .flags . carry in
                    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
+  CpR t -> let value = cpu ^. registers . t
+               (_, newFlags) = sub (cpu ^. registers . a) value $ False in
               cpu & registers . flags .~ newFlags
-  CpHL _c -> let value = fetch cpu $ cpu ^. registers . hl
-                 (_, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers . flags . carry in
+  CpHL -> let value = fetch cpu $ cpu ^. registers . hl
+              (_, newFlags) = sub (cpu ^. registers . a) value $ False in
            cpu & registers . flags .~ newFlags
-  CpN value _c -> let (_, newFlags) = sub (cpu ^. registers . a) value $ _c && cpu ^. registers .flags . carry in
+  CpN value -> let (_, newFlags) = sub (cpu ^. registers . a) value $ False in
                 cpu & registers . flags .~ newFlags
   IncR t -> let (value, newFlags) = add (cpu ^. registers . t) 1 False in
             cpu & registers . t .~ value
@@ -275,18 +284,39 @@ execute cpu = \case
                _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 
+  SR t arith -> let _carry = (cpu ^. registers . t) `testBit` 1
+                    value = cpu ^. registers . t
+                    newValue = let temp = value .>>. 1 in if value `testBit` 8 && arith 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
+  SRHL arith -> let target = cpu ^. registers . hl
+                    value = fetch cpu target
+                    newValue = let temp = value .>>. 1 in if value `testBit` 8 && arith 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, ..}
-           
+  SWAP t -> let newValue = cpu ^. registers . t `rotateR` 4 in
+           cpu & registers . t .~ newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, _carry = False}
+  SWAPHL -> let target = cpu ^. registers . hl
+                value = fetch cpu target
+                newValue = value `rotateR` 4
+    in
+           write cpu target newValue & registers . flags .~ FlagRegister {_zero = newValue == 0, _negative = False, _halfCarry = False, _carry = False}
+  BIT t i -> let value = cpu ^. registers . t in
+    cpu & registers . flags %~ (\_f -> _f { _zero = not $ value `testBit` i, _negative = False, _halfCarry = True })
+  BITHL i -> let target = cpu ^. registers . hl
+                 value = fetch cpu target in
+    cpu & registers . flags %~ (\_f -> _f { _zero = not $ value `testBit` i, _negative = False, _halfCarry = True })
+  RES t i -> cpu & registers . t %~ (`clearBit` i)
+  RESHL i -> let target = cpu ^. registers . hl
+                 value = fetch cpu target
+                 newValue = value `clearBit` i in
+             write cpu target newValue
+  SET t i -> cpu & registers . t %~ (`setBit` i)
+  SETHL i -> let target = cpu ^. registers . hl
+                 value = fetch cpu target
+                 newValue = value `setBit` i in
+             write cpu target newValue
   where
     add :: Word8 -> Word8 -> Bool -> (Word8, FlagRegister)
     add o n _c = let new        = o + n + if _c then 1 else 0