Machine.hs

-- |
-- Module      :  HsEmu.Core.Machine
-- Copyright   :  Konrad Kleczkowski 2019
-- License     :  BSD3
--
-- Maintainer  :  konrad.kleczkowski@gmail.com
-- Stability   :  experimental
-- Portability :  unknown
--
-- Provides the monadic stack to preform computations
-- that realizes an emulation.
--
module HsEmu.Core.Machine
( RegisterSet(..)
, Memory(..)
, Machine(..)
, unMachineM
) where

import qualified Data.Vector.Unboxed.Mutable as VM
import           Data.Word                   (Word16, Word8)

import           Control.Monad.ST
import           Control.Monad.Trans.State


-- | A structure that keeps registers' content of CPU.
data RegisterSet = RegisterSet
  { rA  :: Word8    -- ^ An accumulator.
  , rX  :: Word8    -- ^ X register.
  , rY  :: Word8    -- ^ Y register.
  , rSP :: Word8    -- ^ Stack pointer.
  , rPC :: Word16   -- ^ Program counter.
  , rP  :: Word8    -- ^ Processor flags register.
  }

-- | A memory vector type.
type Memory s = VM.MVector s Word8

-- | A machine state data type.
data Machine s = Machine
  { registers :: RegisterSet    -- ^ State of registers.
  , memory    :: Memory s       -- ^ Memory vector.
  }

-- | A machine monad. Allows to emulate the processor.
type MachineM s = StateT (Machine s) (ST s)

-- | Makes a memory array.
mkMemory :: ST s (Memory s)
mkMemory = VM.new (2^16 :: Int)

-- | Makes a register set.
mkRegisterSet :: ST s RegisterSet
mkRegisterSet = return RegisterSet
  { rA = 0
  , rX = 0
  , rY = 0
  , rSP = 0
  , rPC = 0
  , rP = 0
  }

-- | Makes an initial state of machine.
mkMachine :: ST s (Machine s)
mkMachine = do
  mem <- mkMemory
  regSet <- mkRegisterSet
  return Machine { registers = regSet, memory = mem }

-- | Creates an initial state and unwraps machine monad
--   to 'ST' monad.
unMachineM :: MachineM s a -> ST s a
unMachineM m = do
  machine <- mkMachine
  evalStateT m machine