{-# LANGUAGE FlexibleContexts #-}

-- | Provides a polymorphic implementation of a register file. This module is
-- intended to be used internally by interpreters for the
-- 'LibRISCV.Effects.Operations.Operations' effect. This register file
-- implementation also provides facilities for storing a concrete program
-- counter.
module LibRISCV.Effects.Operations.Default.Machine.Register where

import Control.Monad (unless)
import Data.Array.IO (
    MArray (newArray),
    getElems,
    readArray,
    writeArray,
 )
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.Word (Word32)
import LibRISCV

-- | Register file addressed by 'RegIdx'. The type is parameterized over an array
-- implementation (such as 'Data.Array.IO.IOUArray') and a generic value type
-- (used to represent instruction operands).
data RegisterFile t a = RegisterFile
    { forall (t :: * -> * -> *) a. RegisterFile t a -> IORef Word32
pc :: IORef Word32
    -- ^ The current program counter (always concrete in this implementation).
    , forall (t :: * -> * -> *) a. RegisterFile t a -> t RegIdx a
regs :: t RegIdx a
    -- ^ The underlying array to store the register values.
    }

-- | Create a new register file, initializing all registers with the given default
-- value. This value /must/ represent the zero value in the chosen value type.
mkRegFile :: (MArray t a IO) => a -> IO (RegisterFile t a)
mkRegFile :: forall (t :: * -> * -> *) a.
MArray t a IO =>
a -> IO (RegisterFile t a)
mkRegFile a
defValue = IORef Word32 -> t RegIdx a -> RegisterFile t a
forall (t :: * -> * -> *) a.
IORef Word32 -> t RegIdx a -> RegisterFile t a
RegisterFile (IORef Word32 -> t RegIdx a -> RegisterFile t a)
-> IO (IORef Word32) -> IO (t RegIdx a -> RegisterFile t a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> IO (IORef Word32)
forall a. a -> IO (IORef a)
newIORef Word32
0 IO (t RegIdx a -> RegisterFile t a)
-> IO (t RegIdx a) -> IO (RegisterFile t a)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (RegIdx, RegIdx) -> a -> IO (t RegIdx a)
forall i. Ix i => (i, i) -> a -> IO (t i a)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (RegIdx
forall a. Bounded a => a
minBound, RegIdx
forall a. Bounded a => a
maxBound) a
defValue

-- | Dump the current register file state as a 'String'.
dumpRegs :: (MArray t a IO) => (a -> ShowS) -> RegisterFile t a -> IO String
dumpRegs :: forall (t :: * -> * -> *) a.
MArray t a IO =>
(a -> ShowS) -> RegisterFile t a -> IO String
dumpRegs a -> ShowS
sh =
    ([a] -> String) -> IO [a] -> IO String
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        ( ((RegIdx, a) -> ShowS) -> String -> [(RegIdx, a)] -> String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(RegIdx
a, a
v) String
s -> RegIdx -> String
forall a. Show a => a -> String
show RegIdx
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\t= 0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> ShowS
sh a
v String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s) String
""
            ([(RegIdx, a)] -> String)
-> ([a] -> [(RegIdx, a)]) -> [a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RegIdx] -> [a] -> [(RegIdx, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(RegIdx
forall a. Bounded a => a
minBound :: RegIdx) .. RegIdx
forall a. Bounded a => a
maxBound]
        )
        (IO [a] -> IO String)
-> (RegisterFile t a -> IO [a]) -> RegisterFile t a -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t RegIdx a -> IO [a]
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m [e]
getElems
        (t RegIdx a -> IO [a])
-> (RegisterFile t a -> t RegIdx a) -> RegisterFile t a -> IO [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegisterFile t a -> t RegIdx a
forall (t :: * -> * -> *) a. RegisterFile t a -> t RegIdx a
regs

------------------------------------------------------------------------

-- | Read register value at given register index. For the 'Zero' register index, the
-- zero/default value (as passed to 'mkRegFile' is always returned.
readRegister :: (MArray t a IO) => RegisterFile t a -> RegIdx -> IO a
readRegister :: forall (t :: * -> * -> *) a.
MArray t a IO =>
RegisterFile t a -> RegIdx -> IO a
readRegister = t RegIdx a -> RegIdx -> IO a
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray (t RegIdx a -> RegIdx -> IO a)
-> (RegisterFile t a -> t RegIdx a)
-> RegisterFile t a
-> RegIdx
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegisterFile t a -> t RegIdx a
forall (t :: * -> * -> *) a. RegisterFile t a -> t RegIdx a
regs

-- | Write register at given register index. Writes to the 'Zero' register are ignored.
writeRegister :: (MArray t a IO) => RegisterFile t a -> RegIdx -> a -> IO ()
writeRegister :: forall (t :: * -> * -> *) a.
MArray t a IO =>
RegisterFile t a -> RegIdx -> a -> IO ()
writeRegister RegisterFile{regs :: forall (t :: * -> * -> *) a. RegisterFile t a -> t RegIdx a
regs = t RegIdx a
r} RegIdx
idx a
val = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RegIdx
idx RegIdx -> RegIdx -> Bool
forall a. Eq a => a -> a -> Bool
== RegIdx
Zero) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ t RegIdx a -> RegIdx -> a -> IO ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray t RegIdx a
r RegIdx
idx a
val

------------------------------------------------------------------------

-- | Returs the current program counter value.
readPC :: RegisterFile t a -> IO Word32
readPC :: forall (t :: * -> * -> *) a. RegisterFile t a -> IO Word32
readPC = IORef Word32 -> IO Word32
forall a. IORef a -> IO a
readIORef (IORef Word32 -> IO Word32)
-> (RegisterFile t a -> IORef Word32)
-> RegisterFile t a
-> IO Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegisterFile t a -> IORef Word32
forall (t :: * -> * -> *) a. RegisterFile t a -> IORef Word32
pc

-- | Write a new program counter value.
writePC :: RegisterFile t a -> Word32 -> IO ()
writePC :: forall (t :: * -> * -> *) a. RegisterFile t a -> Word32 -> IO ()
writePC = IORef Word32 -> Word32 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (IORef Word32 -> Word32 -> IO ())
-> (RegisterFile t a -> IORef Word32)
-> RegisterFile t a
-> Word32
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegisterFile t a -> IORef Word32
forall (t :: * -> * -> *) a. RegisterFile t a -> IORef Word32
pc