Mjau

README.md

@@ -1,2 +0,0 @@
-# Tia
-

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.

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:

src/GBC.hs

@@ -1,3 +1,3 @@
 {-# LANGUAGE TemplateHaskell
            , RecordWildCards #-}
-module GB where
+module GBC where

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