{-|
Module      : Lion.Pipe
Description : RISC-V 5-stage pipeline
Copyright   : (c) David Cox, 2021
License     : BSD-3-Clause
Maintainer  : standardsemiconductor@gmail.com
-}

module Lion.Pipe where

import Clash.Prelude
import Control.Lens hiding ( op )
import Control.Monad.RWS
import Data.Maybe ( isJust )
import Data.Monoid.Generic
import Lion.Instruction
import Lion.Rvfi

-- | Pipeline configuration
data PipeConfig (startPC :: Nat) = PipeConfig
  deriving stock ((forall x. PipeConfig startPC -> Rep (PipeConfig startPC) x)
-> (forall x. Rep (PipeConfig startPC) x -> PipeConfig startPC)
-> Generic (PipeConfig startPC)
forall x. Rep (PipeConfig startPC) x -> PipeConfig startPC
forall x. PipeConfig startPC -> Rep (PipeConfig startPC) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (startPC :: Nat) x.
Rep (PipeConfig startPC) x -> PipeConfig startPC
forall (startPC :: Nat) x.
PipeConfig startPC -> Rep (PipeConfig startPC) x
$cto :: forall (startPC :: Nat) x.
Rep (PipeConfig startPC) x -> PipeConfig startPC
$cfrom :: forall (startPC :: Nat) x.
PipeConfig startPC -> Rep (PipeConfig startPC) x
Generic, Int -> PipeConfig startPC -> ShowS
[PipeConfig startPC] -> ShowS
PipeConfig startPC -> String
(Int -> PipeConfig startPC -> ShowS)
-> (PipeConfig startPC -> String)
-> ([PipeConfig startPC] -> ShowS)
-> Show (PipeConfig startPC)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (startPC :: Nat). Int -> PipeConfig startPC -> ShowS
forall (startPC :: Nat). [PipeConfig startPC] -> ShowS
forall (startPC :: Nat). PipeConfig startPC -> String
showList :: [PipeConfig startPC] -> ShowS
$cshowList :: forall (startPC :: Nat). [PipeConfig startPC] -> ShowS
show :: PipeConfig startPC -> String
$cshow :: forall (startPC :: Nat). PipeConfig startPC -> String
showsPrec :: Int -> PipeConfig startPC -> ShowS
$cshowsPrec :: forall (startPC :: Nat). Int -> PipeConfig startPC -> ShowS
Show, PipeConfig startPC -> PipeConfig startPC -> Bool
(PipeConfig startPC -> PipeConfig startPC -> Bool)
-> (PipeConfig startPC -> PipeConfig startPC -> Bool)
-> Eq (PipeConfig startPC)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (startPC :: Nat).
PipeConfig startPC -> PipeConfig startPC -> Bool
/= :: PipeConfig startPC -> PipeConfig startPC -> Bool
$c/= :: forall (startPC :: Nat).
PipeConfig startPC -> PipeConfig startPC -> Bool
== :: PipeConfig startPC -> PipeConfig startPC -> Bool
$c== :: forall (startPC :: Nat).
PipeConfig startPC -> PipeConfig startPC -> Bool
Eq)

-- | Default pipeline configuration
-- 
-- `startPC` = 0
defaultPipeConfig :: PipeConfig 0
defaultPipeConfig :: PipeConfig 0
defaultPipeConfig = PipeConfig 0
forall (startPC :: Nat). PipeConfig startPC
PipeConfig

-- | Pipeline inputs
data ToPipe = ToPipe
  { ToPipe -> BitVector 32
_fromRs1 :: BitVector 32
  , ToPipe -> BitVector 32
_fromRs2 :: BitVector 32
  , ToPipe -> BitVector 32
_fromAlu :: BitVector 32
  , ToPipe -> BitVector 32
_fromMem :: BitVector 32
  }
  deriving stock ((forall x. ToPipe -> Rep ToPipe x)
-> (forall x. Rep ToPipe x -> ToPipe) -> Generic ToPipe
forall x. Rep ToPipe x -> ToPipe
forall x. ToPipe -> Rep ToPipe x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ToPipe x -> ToPipe
$cfrom :: forall x. ToPipe -> Rep ToPipe x
Generic, Int -> ToPipe -> ShowS
[ToPipe] -> ShowS
ToPipe -> String
(Int -> ToPipe -> ShowS)
-> (ToPipe -> String) -> ([ToPipe] -> ShowS) -> Show ToPipe
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ToPipe] -> ShowS
$cshowList :: [ToPipe] -> ShowS
show :: ToPipe -> String
$cshow :: ToPipe -> String
showsPrec :: Int -> ToPipe -> ShowS
$cshowsPrec :: Int -> ToPipe -> ShowS
Show, ToPipe -> ToPipe -> Bool
(ToPipe -> ToPipe -> Bool)
-> (ToPipe -> ToPipe -> Bool) -> Eq ToPipe
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ToPipe -> ToPipe -> Bool
$c/= :: ToPipe -> ToPipe -> Bool
== :: ToPipe -> ToPipe -> Bool
$c== :: ToPipe -> ToPipe -> Bool
Eq)
  deriving anyclass HasCallStack => String -> ToPipe
ToPipe -> Bool
ToPipe -> ()
ToPipe -> ToPipe
(HasCallStack => String -> ToPipe)
-> (ToPipe -> Bool)
-> (ToPipe -> ToPipe)
-> (ToPipe -> ())
-> NFDataX ToPipe
forall a.
(HasCallStack => String -> a)
-> (a -> Bool) -> (a -> a) -> (a -> ()) -> NFDataX a
rnfX :: ToPipe -> ()
$crnfX :: ToPipe -> ()
ensureSpine :: ToPipe -> ToPipe
$censureSpine :: ToPipe -> ToPipe
hasUndefined :: ToPipe -> Bool
$chasUndefined :: ToPipe -> Bool
deepErrorX :: String -> ToPipe
$cdeepErrorX :: HasCallStack => String -> ToPipe
NFDataX
makeLenses ''ToPipe

-- | Memory access - Lion has a shared instruction/memory bus
data MemoryAccess = InstrMem -- ^ instruction access
                  | DataMem  -- ^ data access
  deriving stock ((forall x. MemoryAccess -> Rep MemoryAccess x)
-> (forall x. Rep MemoryAccess x -> MemoryAccess)
-> Generic MemoryAccess
forall x. Rep MemoryAccess x -> MemoryAccess
forall x. MemoryAccess -> Rep MemoryAccess x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MemoryAccess x -> MemoryAccess
$cfrom :: forall x. MemoryAccess -> Rep MemoryAccess x
Generic, Int -> MemoryAccess -> ShowS
[MemoryAccess] -> ShowS
MemoryAccess -> String
(Int -> MemoryAccess -> ShowS)
-> (MemoryAccess -> String)
-> ([MemoryAccess] -> ShowS)
-> Show MemoryAccess
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MemoryAccess] -> ShowS
$cshowList :: [MemoryAccess] -> ShowS
show :: MemoryAccess -> String
$cshow :: MemoryAccess -> String
showsPrec :: Int -> MemoryAccess -> ShowS
$cshowsPrec :: Int -> MemoryAccess -> ShowS
Show, MemoryAccess -> MemoryAccess -> Bool
(MemoryAccess -> MemoryAccess -> Bool)
-> (MemoryAccess -> MemoryAccess -> Bool) -> Eq MemoryAccess
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemoryAccess -> MemoryAccess -> Bool
$c/= :: MemoryAccess -> MemoryAccess -> Bool
== :: MemoryAccess -> MemoryAccess -> Bool
$c== :: MemoryAccess -> MemoryAccess -> Bool
Eq)
  deriving anyclass HasCallStack => String -> MemoryAccess
MemoryAccess -> Bool
MemoryAccess -> ()
MemoryAccess -> MemoryAccess
(HasCallStack => String -> MemoryAccess)
-> (MemoryAccess -> Bool)
-> (MemoryAccess -> MemoryAccess)
-> (MemoryAccess -> ())
-> NFDataX MemoryAccess
forall a.
(HasCallStack => String -> a)
-> (a -> Bool) -> (a -> a) -> (a -> ()) -> NFDataX a
rnfX :: MemoryAccess -> ()
$crnfX :: MemoryAccess -> ()
ensureSpine :: MemoryAccess -> MemoryAccess
$censureSpine :: MemoryAccess -> MemoryAccess
hasUndefined :: MemoryAccess -> Bool
$chasUndefined :: MemoryAccess -> Bool
deepErrorX :: String -> MemoryAccess
$cdeepErrorX :: HasCallStack => String -> MemoryAccess
NFDataX

-- | Memory bus
data ToMem = ToMem
  { ToMem -> MemoryAccess
memAccess   :: MemoryAccess         -- ^ memory access type
  , ToMem -> BitVector 32
memAddress  :: BitVector 32         -- ^ memory address
  , ToMem -> BitVector 4
memByteMask :: BitVector 4          -- ^ memory byte mask
  , ToMem -> Maybe (BitVector 32)
memWrite    :: Maybe (BitVector 32) -- ^ read=Nothing write=Just wr
  }
  deriving stock ((forall x. ToMem -> Rep ToMem x)
-> (forall x. Rep ToMem x -> ToMem) -> Generic ToMem
forall x. Rep ToMem x -> ToMem
forall x. ToMem -> Rep ToMem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ToMem x -> ToMem
$cfrom :: forall x. ToMem -> Rep ToMem x
Generic, Int -> ToMem -> ShowS
[ToMem] -> ShowS
ToMem -> String
(Int -> ToMem -> ShowS)
-> (ToMem -> String) -> ([ToMem] -> ShowS) -> Show ToMem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ToMem] -> ShowS
$cshowList :: [ToMem] -> ShowS
show :: ToMem -> String
$cshow :: ToMem -> String
showsPrec :: Int -> ToMem -> ShowS
$cshowsPrec :: Int -> ToMem -> ShowS
Show, ToMem -> ToMem -> Bool
(ToMem -> ToMem -> Bool) -> (ToMem -> ToMem -> Bool) -> Eq ToMem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ToMem -> ToMem -> Bool
$c/= :: ToMem -> ToMem -> Bool
== :: ToMem -> ToMem -> Bool
$c== :: ToMem -> ToMem -> Bool
Eq)
  deriving anyclass HasCallStack => String -> ToMem
ToMem -> Bool
ToMem -> ()
ToMem -> ToMem
(HasCallStack => String -> ToMem)
-> (ToMem -> Bool)
-> (ToMem -> ToMem)
-> (ToMem -> ())
-> NFDataX ToMem
forall a.
(HasCallStack => String -> a)
-> (a -> Bool) -> (a -> a) -> (a -> ()) -> NFDataX a
rnfX :: ToMem -> ()
$crnfX :: ToMem -> ()
ensureSpine :: ToMem -> ToMem
$censureSpine :: ToMem -> ToMem
hasUndefined :: ToMem -> Bool
$chasUndefined :: ToMem -> Bool
deepErrorX :: String -> ToMem
$cdeepErrorX :: HasCallStack => String -> ToMem
NFDataX

-- | Construct instruction memory access
instrMem 
  :: BitVector 32 -- ^ instruction address
  -> ToMem
instrMem :: BitVector 32 -> ToMem
instrMem BitVector 32
addr = ToMem :: MemoryAccess
-> BitVector 32 -> BitVector 4 -> Maybe (BitVector 32) -> ToMem
ToMem
  { memAccess :: MemoryAccess
memAccess   = MemoryAccess
InstrMem
  , memAddress :: BitVector 32
memAddress  = BitVector 32
addr
  , memByteMask :: BitVector 4
memByteMask = BitVector 4
0xF
  , memWrite :: Maybe (BitVector 32)
memWrite    = Maybe (BitVector 32)
forall a. Maybe a
Nothing
  }

-- | Construct data memory access
dataMem 
  :: BitVector 32         -- ^ memory address
  -> BitVector 4          -- ^ byte mask
  -> Maybe (BitVector 32) -- ^ write
  -> ToMem
dataMem :: BitVector 32 -> BitVector 4 -> Maybe (BitVector 32) -> ToMem
dataMem BitVector 32
addr BitVector 4
mask Maybe (BitVector 32)
wrM = ToMem :: MemoryAccess
-> BitVector 32 -> BitVector 4 -> Maybe (BitVector 32) -> ToMem
ToMem
  { memAccess :: MemoryAccess
memAccess   = MemoryAccess
DataMem
  , memAddress :: BitVector 32
memAddress  = BitVector 32
addr
  , memByteMask :: BitVector 4
memByteMask = BitVector 4
mask
  , memWrite :: Maybe (BitVector 32)
memWrite    = Maybe (BitVector 32)
wrM
  }

-- | Pipeline outputs
data FromPipe = FromPipe
  { FromPipe -> First ToMem
_toMem       :: First ToMem
  , FromPipe -> First (Unsigned 5)
_toRs1Addr   :: First (Unsigned 5)
  , FromPipe -> First (Unsigned 5)
_toRs2Addr   :: First (Unsigned 5)
  , FromPipe -> First (Unsigned 5, BitVector 32)
_toRd        :: First (Unsigned 5, BitVector 32)
  , FromPipe -> First Op
_toAluOp     :: First Op
  , FromPipe -> First (BitVector 32)
_toAluInput1 :: First (BitVector 32)
  , FromPipe -> First (BitVector 32)
_toAluInput2 :: First (BitVector 32)
  , FromPipe -> First Rvfi
_toRvfi      :: First Rvfi
  }
  deriving stock ((forall x. FromPipe -> Rep FromPipe x)
-> (forall x. Rep FromPipe x -> FromPipe) -> Generic FromPipe
forall x. Rep FromPipe x -> FromPipe
forall x. FromPipe -> Rep FromPipe x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FromPipe x -> FromPipe
$cfrom :: forall x. FromPipe -> Rep FromPipe x
Generic, Int -> FromPipe -> ShowS
[FromPipe] -> ShowS
FromPipe -> String
(Int -> FromPipe -> ShowS)
-> (FromPipe -> String) -> ([FromPipe] -> ShowS) -> Show FromPipe
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FromPipe] -> ShowS
$cshowList :: [FromPipe] -> ShowS
show :: FromPipe -> String
$cshow :: FromPipe -> String
showsPrec :: Int -> FromPipe -> ShowS
$cshowsPrec :: Int -> FromPipe -> ShowS
Show, FromPipe -> FromPipe -> Bool
(FromPipe -> FromPipe -> Bool)
-> (FromPipe -> FromPipe -> Bool) -> Eq FromPipe
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FromPipe -> FromPipe -> Bool
$c/= :: FromPipe -> FromPipe -> Bool
== :: FromPipe -> FromPipe -> Bool
$c== :: FromPipe -> FromPipe -> Bool
Eq)
  deriving anyclass HasCallStack => String -> FromPipe
FromPipe -> Bool
FromPipe -> ()
FromPipe -> FromPipe
(HasCallStack => String -> FromPipe)
-> (FromPipe -> Bool)
-> (FromPipe -> FromPipe)
-> (FromPipe -> ())
-> NFDataX FromPipe
forall a.
(HasCallStack => String -> a)
-> (a -> Bool) -> (a -> a) -> (a -> ()) -> NFDataX a
rnfX :: FromPipe -> ()
$crnfX :: FromPipe -> ()
ensureSpine :: FromPipe -> FromPipe
$censureSpine :: FromPipe -> FromPipe
hasUndefined :: FromPipe -> Bool
$chasUndefined :: FromPipe -> Bool
deepErrorX :: String -> FromPipe
$cdeepErrorX :: HasCallStack => String -> FromPipe
NFDataX
  deriving b -> FromPipe -> FromPipe
NonEmpty FromPipe -> FromPipe
FromPipe -> FromPipe -> FromPipe
(FromPipe -> FromPipe -> FromPipe)
-> (NonEmpty FromPipe -> FromPipe)
-> (forall b. Integral b => b -> FromPipe -> FromPipe)
-> Semigroup FromPipe
forall b. Integral b => b -> FromPipe -> FromPipe
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> FromPipe -> FromPipe
$cstimes :: forall b. Integral b => b -> FromPipe -> FromPipe
sconcat :: NonEmpty FromPipe -> FromPipe
$csconcat :: NonEmpty FromPipe -> FromPipe
<> :: FromPipe -> FromPipe -> FromPipe
$c<> :: FromPipe -> FromPipe -> FromPipe
Semigroup via GenericSemigroup FromPipe
  deriving Semigroup FromPipe
FromPipe
Semigroup FromPipe
-> FromPipe
-> (FromPipe -> FromPipe -> FromPipe)
-> ([FromPipe] -> FromPipe)
-> Monoid FromPipe
[FromPipe] -> FromPipe
FromPipe -> FromPipe -> FromPipe
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [FromPipe] -> FromPipe
$cmconcat :: [FromPipe] -> FromPipe
mappend :: FromPipe -> FromPipe -> FromPipe
$cmappend :: FromPipe -> FromPipe -> FromPipe
mempty :: FromPipe
$cmempty :: FromPipe
$cp1Monoid :: Semigroup FromPipe
Monoid via GenericMonoid FromPipe
makeLenses ''FromPipe

data Control = Control
  { Control -> Bool
_firstCycle  :: Bool                             -- ^ First cycle True, then always False
  , Control -> Maybe (BitVector 32)
_exBranching :: Maybe (BitVector 32)             -- ^ execute stage branch/jump
  , Control -> Bool
_meBranching :: Bool                             -- ^ memory stage branch/jump
  , Control -> Bool
_deLoad      :: Bool                             -- ^ decode stage load
  , Control -> Bool
_exLoad      :: Bool                             -- ^ execute stage load
  , Control -> Bool
_meMemory    :: Bool                             -- ^ memory stage load/store
  , Control -> Bool
_wbMemory    :: Bool                             -- ^ writeback stage load/store
  , Control -> Maybe (Unsigned 5, BitVector 32)
_meRegFwd    :: Maybe (Unsigned 5, BitVector 32) -- ^ memory stage register forwarding
  , Control -> Maybe (Unsigned 5, BitVector 32)
_wbRegFwd    :: Maybe (Unsigned 5, BitVector 32) -- ^ writeback stage register forwading
  }
  deriving stock ((forall x. Control -> Rep Control x)
-> (forall x. Rep Control x -> Control) -> Generic Control
forall x. Rep Control x -> Control
forall x. Control -> Rep Control x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Control x -> Control
$cfrom :: forall x. Control -> Rep Control x
Generic, Int -> Control -> ShowS
[Control] -> ShowS
Control -> String
(Int -> Control -> ShowS)
-> (Control -> String) -> ([Control] -> ShowS) -> Show Control
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Control] -> ShowS
$cshowList :: [Control] -> ShowS
show :: Control -> String
$cshow :: Control -> String
showsPrec :: Int -> Control -> ShowS
$cshowsPrec :: Int -> Control -> ShowS
Show, Control -> Control -> Bool
(Control -> Control -> Bool)
-> (Control -> Control -> Bool) -> Eq Control
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Control -> Control -> Bool
$c/= :: Control -> Control -> Bool
== :: Control -> Control -> Bool
$c== :: Control -> Control -> Bool
Eq)
  deriving anyclass HasCallStack => String -> Control
Control -> Bool
Control -> ()
Control -> Control
(HasCallStack => String -> Control)
-> (Control -> Bool)
-> (Control -> Control)
-> (Control -> ())
-> NFDataX Control
forall a.
(HasCallStack => String -> a)
-> (a -> Bool) -> (a -> a) -> (a -> ()) -> NFDataX a
rnfX :: Control -> ()
$crnfX :: Control -> ()
ensureSpine :: Control -> Control
$censureSpine :: Control -> Control
hasUndefined :: Control -> Bool
$chasUndefined :: Control -> Bool
deepErrorX :: String -> Control
$cdeepErrorX :: HasCallStack => String -> Control
NFDataX
makeLenses ''Control

mkControl :: Control
mkControl :: Control
mkControl = Control :: Bool
-> Maybe (BitVector 32)
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe (Unsigned 5, BitVector 32)
-> Maybe (Unsigned 5, BitVector 32)
-> Control
Control 
  { _firstCycle :: Bool
_firstCycle  = Bool
True   
  , _exBranching :: Maybe (BitVector 32)
_exBranching = Maybe (BitVector 32)
forall a. Maybe a
Nothing
  , _meBranching :: Bool
_meBranching = Bool
False
  , _deLoad :: Bool
_deLoad      = Bool
False
  , _exLoad :: Bool
_exLoad      = Bool
False
  , _meMemory :: Bool
_meMemory    = Bool
False
  , _wbMemory :: Bool
_wbMemory    = Bool
False
  , _meRegFwd :: Maybe (Unsigned 5, BitVector 32)
_meRegFwd    = Maybe (Unsigned 5, BitVector 32)
forall a. Maybe a
Nothing
  , _wbRegFwd :: Maybe (Unsigned 5, BitVector 32)
_wbRegFwd    = Maybe (Unsigned 5, BitVector 32)
forall a. Maybe a
Nothing
  }

data Pipe = Pipe
  { Pipe -> BitVector 32
_fetchPC :: BitVector 32

  -- decode stage
  , Pipe -> BitVector 32
_dePC    :: BitVector 32

  -- execute stage
  , Pipe -> Maybe ExInstr
_exIR    :: Maybe ExInstr
  , Pipe -> BitVector 32
_exPC    :: BitVector 32
  , Pipe -> Unsigned 5
_exRs1   :: Unsigned 5
  , Pipe -> Unsigned 5
_exRs2   :: Unsigned 5
  , Pipe -> Rvfi
_exRvfi  :: Rvfi

  -- memory stage
  , Pipe -> Maybe MeInstr
_meIR    :: Maybe MeInstr
  , Pipe -> Rvfi
_meRvfi  :: Rvfi

  -- writeback stage
  , Pipe -> Maybe WbInstr
_wbIR    :: Maybe WbInstr
  , Pipe -> BitVector 64
_wbNRet  :: BitVector 64
  , Pipe -> Rvfi
_wbRvfi  :: Rvfi

  -- pipeline control
  , Pipe -> Control
_control :: Control
  }
  deriving stock ((forall x. Pipe -> Rep Pipe x)
-> (forall x. Rep Pipe x -> Pipe) -> Generic Pipe
forall x. Rep Pipe x -> Pipe
forall x. Pipe -> Rep Pipe x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Pipe x -> Pipe
$cfrom :: forall x. Pipe -> Rep Pipe x
Generic, Int -> Pipe -> ShowS
[Pipe] -> ShowS
Pipe -> String
(Int -> Pipe -> ShowS)
-> (Pipe -> String) -> ([Pipe] -> ShowS) -> Show Pipe
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pipe] -> ShowS
$cshowList :: [Pipe] -> ShowS
show :: Pipe -> String
$cshow :: Pipe -> String
showsPrec :: Int -> Pipe -> ShowS
$cshowsPrec :: Int -> Pipe -> ShowS
Show, Pipe -> Pipe -> Bool
(Pipe -> Pipe -> Bool) -> (Pipe -> Pipe -> Bool) -> Eq Pipe
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pipe -> Pipe -> Bool
$c/= :: Pipe -> Pipe -> Bool
== :: Pipe -> Pipe -> Bool
$c== :: Pipe -> Pipe -> Bool
Eq)
  deriving anyclass HasCallStack => String -> Pipe
Pipe -> Bool
Pipe -> ()
Pipe -> Pipe
(HasCallStack => String -> Pipe)
-> (Pipe -> Bool) -> (Pipe -> Pipe) -> (Pipe -> ()) -> NFDataX Pipe
forall a.
(HasCallStack => String -> a)
-> (a -> Bool) -> (a -> a) -> (a -> ()) -> NFDataX a
rnfX :: Pipe -> ()
$crnfX :: Pipe -> ()
ensureSpine :: Pipe -> Pipe
$censureSpine :: Pipe -> Pipe
hasUndefined :: Pipe -> Bool
$chasUndefined :: Pipe -> Bool
deepErrorX :: String -> Pipe
$cdeepErrorX :: HasCallStack => String -> Pipe
NFDataX
makeLenses ''Pipe

mkPipe 
  :: forall startPC
   . (KnownNat startPC, startPC <= 0xFFFFFFFF)
  => PipeConfig (startPC :: Nat) 
  -> Pipe
mkPipe :: PipeConfig startPC -> Pipe
mkPipe PipeConfig startPC
_ = Pipe :: BitVector 32
-> BitVector 32
-> Maybe ExInstr
-> BitVector 32
-> Unsigned 5
-> Unsigned 5
-> Rvfi
-> Maybe MeInstr
-> Rvfi
-> Maybe WbInstr
-> BitVector 64
-> Rvfi
-> Control
-> Pipe
Pipe
  { _fetchPC :: BitVector 32
_fetchPC = forall a. (Num a, KnownNat startPC) => a
forall (n :: Nat) a. (Num a, KnownNat n) => a
natToNum @startPC

  -- decode stage 
  , _dePC :: BitVector 32
_dePC    = BitVector 32
0
  
  -- execute stage
  , _exIR :: Maybe ExInstr
_exIR    = Maybe ExInstr
forall a. Maybe a
Nothing
  , _exPC :: BitVector 32
_exPC    = BitVector 32
0
  , _exRs1 :: Unsigned 5
_exRs1   = Unsigned 5
0
  , _exRs2 :: Unsigned 5
_exRs2   = Unsigned 5
0
  , _exRvfi :: Rvfi
_exRvfi  = Rvfi
mkRvfi

  -- memory stage
  , _meIR :: Maybe MeInstr
_meIR    = Maybe MeInstr
forall a. Maybe a
Nothing
  , _meRvfi :: Rvfi
_meRvfi  = Rvfi
mkRvfi
 
  -- writeback stage
  , _wbIR :: Maybe WbInstr
_wbIR    = Maybe WbInstr
forall a. Maybe a
Nothing
  , _wbNRet :: BitVector 64
_wbNRet  = BitVector 64
0
  , _wbRvfi :: Rvfi
_wbRvfi  = Rvfi
mkRvfi
  
  -- pipeline control
  , _control :: Control
_control = Control
mkControl
  }

-- | 5-Stage RISC-V pipeline
pipe 
  :: HiddenClockResetEnable dom
  => (KnownNat startPC, startPC <= 0xFFFFFFFF)
  => PipeConfig (startPC :: Nat)
  -> Signal dom ToPipe
  -> Signal dom FromPipe
pipe :: PipeConfig startPC -> Signal dom ToPipe -> Signal dom FromPipe
pipe PipeConfig startPC
config = (Pipe -> ToPipe -> (Pipe, FromPipe))
-> Pipe -> Signal dom ToPipe -> Signal dom FromPipe
forall (dom :: Domain) s i o.
(HiddenClockResetEnable dom, NFDataX s) =>
(s -> i -> (s, o)) -> s -> Signal dom i -> Signal dom o
mealy Pipe -> ToPipe -> (Pipe, FromPipe)
pipeMealy (PipeConfig startPC -> Pipe
forall (startPC :: Nat).
(KnownNat startPC, startPC <= 4294967295) =>
PipeConfig startPC -> Pipe
mkPipe PipeConfig startPC
config)
  where
    pipeMealy :: Pipe -> ToPipe -> (Pipe, FromPipe)
pipeMealy Pipe
s ToPipe
i = let ((), Pipe
s', FromPipe
o) = RWS ToPipe FromPipe Pipe ()
-> ToPipe -> Pipe -> ((), Pipe, FromPipe)
forall r w s a. RWS r w s a -> r -> s -> (a, s, w)
runRWS RWS ToPipe FromPipe Pipe ()
pipeM ToPipe
i Pipe
s
                    in (Pipe
s', FromPipe
o) 

-- | Monadic pipeline
pipeM :: RWS ToPipe FromPipe Pipe ()
pipeM :: RWS ToPipe FromPipe Pipe ()
pipeM = do
  RWS ToPipe FromPipe Pipe ()
writeback
  RWS ToPipe FromPipe Pipe ()
memory
  RWS ToPipe FromPipe Pipe ()
execute
  RWS ToPipe FromPipe Pipe ()
decode
  RWS ToPipe FromPipe Pipe ()
fetch
  (Control -> Identity Control) -> Pipe -> Identity Pipe
Lens' Pipe Control
control ((Control -> Identity Control) -> Pipe -> Identity Pipe)
-> Control -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Control
mkControl{ _firstCycle :: Bool
_firstCycle = Bool
False } -- reset control

-- | Writeback stage
writeback :: RWS ToPipe FromPipe Pipe ()
writeback :: RWS ToPipe FromPipe Pipe ()
writeback = Lens' Pipe (Maybe WbInstr)
-> (WbInstr -> RWS ToPipe FromPipe Pipe ())
-> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a.
MonadState s m =>
Lens' s (Maybe a) -> (a -> m ()) -> m ()
withInstr Lens' Pipe (Maybe WbInstr)
wbIR ((WbInstr -> RWS ToPipe FromPipe Pipe ())
 -> RWS ToPipe FromPipe Pipe ())
-> (WbInstr -> RWS ToPipe FromPipe Pipe ())
-> RWS ToPipe FromPipe Pipe ()
forall a b. (a -> b) -> a -> b
$ \WbInstr
instr -> do
  (Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe
Lens' Pipe Rvfi
wbRvfi((Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe)
-> ((Bool -> Identity Bool) -> Rvfi -> Identity Rvfi)
-> (Bool -> Identity Bool)
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Rvfi -> Identity Rvfi
Lens' Rvfi Bool
rvfiValid ((Bool -> Identity Bool) -> Pipe -> Identity Pipe)
-> Bool -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
  (Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe
Lens' Pipe Rvfi
wbRvfi((Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe)
-> ((BitVector 64 -> Identity (BitVector 64))
    -> Rvfi -> Identity Rvfi)
-> (BitVector 64 -> Identity (BitVector 64))
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BitVector 64 -> Identity (BitVector 64)) -> Rvfi -> Identity Rvfi
Lens' Rvfi (BitVector 64)
rvfiOrder ((BitVector 64 -> Identity (BitVector 64))
 -> Pipe -> Identity Pipe)
-> RWST ToPipe FromPipe Pipe Identity (BitVector 64)
-> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> m b -> m ()
<~ (BitVector 64 -> (BitVector 64, BitVector 64))
-> Pipe -> (BitVector 64, Pipe)
Lens' Pipe (BitVector 64)
wbNRet ((BitVector 64 -> (BitVector 64, BitVector 64))
 -> Pipe -> (BitVector 64, Pipe))
-> BitVector 64
-> RWST ToPipe FromPipe Pipe Identity (BitVector 64)
forall s (m :: Type -> Type) a.
(MonadState s m, Num a) =>
LensLike' ((,) a) s a -> a -> m a
<<+= BitVector 64
1
  case WbInstr
instr of
    WbRegWr Unsigned 5
rdAddr BitVector 32
wr -> do
      (Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe
Lens' Pipe Rvfi
wbRvfi((Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe)
-> ((Unsigned 5 -> Identity (Unsigned 5)) -> Rvfi -> Identity Rvfi)
-> (Unsigned 5 -> Identity (Unsigned 5))
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Unsigned 5 -> Identity (Unsigned 5)) -> Rvfi -> Identity Rvfi
Lens' Rvfi (Unsigned 5)
rvfiRdAddr ((Unsigned 5 -> Identity (Unsigned 5)) -> Pipe -> Identity Pipe)
-> Unsigned 5 -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Unsigned 5
rdAddr
      BitVector 32
rdData <- (Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe
Lens' Pipe Rvfi
wbRvfi((Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe)
-> ((BitVector 32 -> Identity (BitVector 32))
    -> Rvfi -> Identity Rvfi)
-> (BitVector 32 -> Identity (BitVector 32))
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BitVector 32 -> Identity (BitVector 32)) -> Rvfi -> Identity Rvfi
Lens' Rvfi (BitVector 32)
rvfiRdWData ((BitVector 32 -> Identity (BitVector 32))
 -> Pipe -> Identity Pipe)
-> BitVector 32
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m b
<.= Unsigned 5 -> BitVector 32 -> BitVector 32
forall a a. (Eq a, Num a, Num a) => a -> a -> a
guardZero Unsigned 5
rdAddr BitVector 32
wr
      ASetter
  FromPipe
  FromPipe
  (First (Unsigned 5, BitVector 32))
  (First (Unsigned 5, BitVector 32))
-> First (Unsigned 5, BitVector 32) -> RWS ToPipe FromPipe Pipe ()
forall t (m :: Type -> Type) s a b.
(MonadWriter t m, Monoid s) =>
ASetter s t a b -> b -> m ()
scribe ASetter
  FromPipe
  FromPipe
  (First (Unsigned 5, BitVector 32))
  (First (Unsigned 5, BitVector 32))
Lens' FromPipe (First (Unsigned 5, BitVector 32))
toRd (First (Unsigned 5, BitVector 32) -> RWS ToPipe FromPipe Pipe ())
-> (Maybe (Unsigned 5, BitVector 32)
    -> First (Unsigned 5, BitVector 32))
-> Maybe (Unsigned 5, BitVector 32)
-> RWS ToPipe FromPipe Pipe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Unsigned 5, BitVector 32)
-> First (Unsigned 5, BitVector 32)
forall a. Maybe a -> First a
First (Maybe (Unsigned 5, BitVector 32) -> RWS ToPipe FromPipe Pipe ())
-> RWST
     ToPipe FromPipe Pipe Identity (Maybe (Unsigned 5, BitVector 32))
-> RWS ToPipe FromPipe Pipe ()
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Control -> Identity Control) -> Pipe -> Identity Pipe
Lens' Pipe Control
control((Control -> Identity Control) -> Pipe -> Identity Pipe)
-> ((Maybe (Unsigned 5, BitVector 32)
     -> Identity (Maybe (Unsigned 5, BitVector 32)))
    -> Control -> Identity Control)
-> (Maybe (Unsigned 5, BitVector 32)
    -> Identity (Maybe (Unsigned 5, BitVector 32)))
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (Unsigned 5, BitVector 32)
 -> Identity (Maybe (Unsigned 5, BitVector 32)))
-> Control -> Identity Control
Lens' Control (Maybe (Unsigned 5, BitVector 32))
wbRegFwd ((Maybe (Unsigned 5, BitVector 32)
  -> Identity (Maybe (Unsigned 5, BitVector 32)))
 -> Pipe -> Identity Pipe)
-> Maybe (Unsigned 5, BitVector 32)
-> RWST
     ToPipe FromPipe Pipe Identity (Maybe (Unsigned 5, BitVector 32))
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m b
<.= (Unsigned 5, BitVector 32) -> Maybe (Unsigned 5, BitVector 32)
forall a. a -> Maybe a
Just (Unsigned 5
rdAddr, BitVector 32
rdData)
    WbLoad Load
op Unsigned 5
rdAddr BitVector 4
mask -> do
      (Control -> Identity Control) -> Pipe -> Identity Pipe
Lens' Pipe Control
control((Control -> Identity Control) -> Pipe -> Identity Pipe)
-> ((Bool -> Identity Bool) -> Control -> Identity Control)
-> (Bool -> Identity Bool)
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Control -> Identity Control
Lens' Control Bool
wbMemory ((Bool -> Identity Bool) -> Pipe -> Identity Pipe)
-> Bool -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
      (Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe
Lens' Pipe Rvfi
wbRvfi((Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe)
-> ((Unsigned 5 -> Identity (Unsigned 5)) -> Rvfi -> Identity Rvfi)
-> (Unsigned 5 -> Identity (Unsigned 5))
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Unsigned 5 -> Identity (Unsigned 5)) -> Rvfi -> Identity Rvfi
Lens' Rvfi (Unsigned 5)
rvfiRdAddr ((Unsigned 5 -> Identity (Unsigned 5)) -> Pipe -> Identity Pipe)
-> Unsigned 5 -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Unsigned 5
rdAddr
      BitVector 32
mem <- (Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi)
-> Pipe -> Pretext (->) (BitVector 32) (BitVector 32) Pipe
Lens' Pipe Rvfi
wbRvfi((Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi)
 -> Pipe -> Pretext (->) (BitVector 32) (BitVector 32) Pipe)
-> ((BitVector 32
     -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
    -> Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi)
-> (BitVector 32
    -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
-> Pipe
-> Pretext (->) (BitVector 32) (BitVector 32) Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BitVector 32
 -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
-> Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi
Lens' Rvfi (BitVector 32)
rvfiMemRData ((BitVector 32
  -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
 -> Pipe -> Pretext (->) (BitVector 32) (BitVector 32) Pipe)
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
forall s (m :: Type -> Type) a b.
MonadState s m =>
ALens s s a b -> m b -> m b
<<~ Getting (BitVector 32) ToPipe (BitVector 32)
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting (BitVector 32) ToPipe (BitVector 32)
Lens' ToPipe (BitVector 32)
fromMem
      let byte :: BitVector 8
byte = BitVector 4 -> BitVector 32 -> BitVector 8
sliceByte BitVector 4
mask BitVector 32
mem
          half :: BitVector 16
half = BitVector 4 -> BitVector 32 -> BitVector 16
sliceHalf BitVector 4
mask BitVector 32
mem
          wr :: BitVector 32
wr = case Load
op of
            Load
Lb  -> BitVector 8 -> BitVector (24 + 8)
forall (f :: Nat -> Type) (a :: Nat) (b :: Nat).
(Resize f, KnownNat a, KnownNat b) =>
f a -> f (b + a)
signExtend BitVector 8
byte
            Load
Lh  -> BitVector 16 -> BitVector (16 + 16)
forall (f :: Nat -> Type) (a :: Nat) (b :: Nat).
(Resize f, KnownNat a, KnownNat b) =>
f a -> f (b + a)
signExtend BitVector 16
half
            Load
Lw  -> BitVector 32
mem
            Load
Lbu -> BitVector 8 -> BitVector (24 + 8)
forall (f :: Nat -> Type) (a :: Nat) (b :: Nat).
(Resize f, KnownNat a, KnownNat b) =>
f a -> f (b + a)
zeroExtend BitVector 8
byte
            Load
Lhu -> BitVector 16 -> BitVector (16 + 16)
forall (f :: Nat -> Type) (a :: Nat) (b :: Nat).
(Resize f, KnownNat a, KnownNat b) =>
f a -> f (b + a)
zeroExtend BitVector 16
half
      BitVector 32
rdData <- (Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe
Lens' Pipe Rvfi
wbRvfi((Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe)
-> ((BitVector 32 -> Identity (BitVector 32))
    -> Rvfi -> Identity Rvfi)
-> (BitVector 32 -> Identity (BitVector 32))
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BitVector 32 -> Identity (BitVector 32)) -> Rvfi -> Identity Rvfi
Lens' Rvfi (BitVector 32)
rvfiRdWData ((BitVector 32 -> Identity (BitVector 32))
 -> Pipe -> Identity Pipe)
-> BitVector 32
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m b
<.= Unsigned 5 -> BitVector 32 -> BitVector 32
forall a a. (Eq a, Num a, Num a) => a -> a -> a
guardZero Unsigned 5
rdAddr BitVector 32
wr
      ASetter
  FromPipe
  FromPipe
  (First (Unsigned 5, BitVector 32))
  (First (Unsigned 5, BitVector 32))
-> First (Unsigned 5, BitVector 32) -> RWS ToPipe FromPipe Pipe ()
forall t (m :: Type -> Type) s a b.
(MonadWriter t m, Monoid s) =>
ASetter s t a b -> b -> m ()
scribe ASetter
  FromPipe
  FromPipe
  (First (Unsigned 5, BitVector 32))
  (First (Unsigned 5, BitVector 32))
Lens' FromPipe (First (Unsigned 5, BitVector 32))
toRd (First (Unsigned 5, BitVector 32) -> RWS ToPipe FromPipe Pipe ())
-> (Maybe (Unsigned 5, BitVector 32)
    -> First (Unsigned 5, BitVector 32))
-> Maybe (Unsigned 5, BitVector 32)
-> RWS ToPipe FromPipe Pipe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Unsigned 5, BitVector 32)
-> First (Unsigned 5, BitVector 32)
forall a. Maybe a -> First a
First (Maybe (Unsigned 5, BitVector 32) -> RWS ToPipe FromPipe Pipe ())
-> RWST
     ToPipe FromPipe Pipe Identity (Maybe (Unsigned 5, BitVector 32))
-> RWS ToPipe FromPipe Pipe ()
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Control -> Identity Control) -> Pipe -> Identity Pipe
Lens' Pipe Control
control((Control -> Identity Control) -> Pipe -> Identity Pipe)
-> ((Maybe (Unsigned 5, BitVector 32)
     -> Identity (Maybe (Unsigned 5, BitVector 32)))
    -> Control -> Identity Control)
-> (Maybe (Unsigned 5, BitVector 32)
    -> Identity (Maybe (Unsigned 5, BitVector 32)))
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (Unsigned 5, BitVector 32)
 -> Identity (Maybe (Unsigned 5, BitVector 32)))
-> Control -> Identity Control
Lens' Control (Maybe (Unsigned 5, BitVector 32))
wbRegFwd ((Maybe (Unsigned 5, BitVector 32)
  -> Identity (Maybe (Unsigned 5, BitVector 32)))
 -> Pipe -> Identity Pipe)
-> Maybe (Unsigned 5, BitVector 32)
-> RWST
     ToPipe FromPipe Pipe Identity (Maybe (Unsigned 5, BitVector 32))
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m b
<.= (Unsigned 5, BitVector 32) -> Maybe (Unsigned 5, BitVector 32)
forall a. a -> Maybe a
Just (Unsigned 5
rdAddr, BitVector 32
rdData)
    WbInstr
WbStore -> (Control -> Identity Control) -> Pipe -> Identity Pipe
Lens' Pipe Control
control((Control -> Identity Control) -> Pipe -> Identity Pipe)
-> ((Bool -> Identity Bool) -> Control -> Identity Control)
-> (Bool -> Identity Bool)
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Control -> Identity Control
Lens' Control Bool
wbMemory ((Bool -> Identity Bool) -> Pipe -> Identity Pipe)
-> Bool -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
    WbInstr
WbNop -> () -> RWS ToPipe FromPipe Pipe ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
  ASetter FromPipe FromPipe (First Rvfi) (First Rvfi)
-> First Rvfi -> RWS ToPipe FromPipe Pipe ()
forall t (m :: Type -> Type) s a b.
(MonadWriter t m, Monoid s) =>
ASetter s t a b -> b -> m ()
scribe ASetter FromPipe FromPipe (First Rvfi) (First Rvfi)
Lens' FromPipe (First Rvfi)
toRvfi (First Rvfi -> RWS ToPipe FromPipe Pipe ())
-> (Rvfi -> First Rvfi) -> Rvfi -> RWS ToPipe FromPipe Pipe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Rvfi -> First Rvfi
forall a. Maybe a -> First a
First (Maybe Rvfi -> First Rvfi)
-> (Rvfi -> Maybe Rvfi) -> Rvfi -> First Rvfi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rvfi -> Maybe Rvfi
forall a. a -> Maybe a
Just (Rvfi -> RWS ToPipe FromPipe Pipe ())
-> RWST ToPipe FromPipe Pipe Identity Rvfi
-> RWS ToPipe FromPipe Pipe ()
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< Getting Rvfi Pipe Rvfi -> RWST ToPipe FromPipe Pipe Identity Rvfi
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Rvfi Pipe Rvfi
Lens' Pipe Rvfi
wbRvfi
  where
    guardZero :: a -> a -> a
guardZero a
0 = a -> a -> a
forall a b. a -> b -> a
const a
0
    guardZero a
_ = a -> a
forall a. a -> a
id

-- | Memory stage
memory :: RWS ToPipe FromPipe Pipe ()
memory :: RWS ToPipe FromPipe Pipe ()
memory = do
  (Maybe WbInstr -> Identity (Maybe WbInstr))
-> Pipe -> Identity Pipe
Lens' Pipe (Maybe WbInstr)
wbIR   ((Maybe WbInstr -> Identity (Maybe WbInstr))
 -> Pipe -> Identity Pipe)
-> Maybe WbInstr -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe WbInstr
forall a. Maybe a
Nothing
  (Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe
Lens' Pipe Rvfi
wbRvfi ((Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe)
-> RWST ToPipe FromPipe Pipe Identity Rvfi
-> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> m b -> m ()
<~ Getting Rvfi Pipe Rvfi -> RWST ToPipe FromPipe Pipe Identity Rvfi
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Rvfi Pipe Rvfi
Lens' Pipe Rvfi
meRvfi
  Lens' Pipe (Maybe MeInstr)
-> (MeInstr -> RWS ToPipe FromPipe Pipe ())
-> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a.
MonadState s m =>
Lens' s (Maybe a) -> (a -> m ()) -> m ()
withInstr Lens' Pipe (Maybe MeInstr)
meIR ((MeInstr -> RWS ToPipe FromPipe Pipe ())
 -> RWS ToPipe FromPipe Pipe ())
-> (MeInstr -> RWS ToPipe FromPipe Pipe ())
-> RWS ToPipe FromPipe Pipe ()
forall a b. (a -> b) -> a -> b
$ \case
    MeInstr
MeNop -> (Maybe WbInstr -> Identity (Maybe WbInstr))
-> Pipe -> Identity Pipe
Lens' Pipe (Maybe WbInstr)
wbIR ((Maybe WbInstr -> Identity (Maybe WbInstr))
 -> Pipe -> Identity Pipe)
-> WbInstr -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= WbInstr
WbNop
    MeRegWr Unsigned 5
rd -> do
      BitVector 32
wr <- Getting (BitVector 32) ToPipe (BitVector 32)
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting (BitVector 32) ToPipe (BitVector 32)
Lens' ToPipe (BitVector 32)
fromAlu
      (Control -> Identity Control) -> Pipe -> Identity Pipe
Lens' Pipe Control
control((Control -> Identity Control) -> Pipe -> Identity Pipe)
-> ((Maybe (Unsigned 5, BitVector 32)
     -> Identity (Maybe (Unsigned 5, BitVector 32)))
    -> Control -> Identity Control)
-> (Maybe (Unsigned 5, BitVector 32)
    -> Identity (Maybe (Unsigned 5, BitVector 32)))
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (Unsigned 5, BitVector 32)
 -> Identity (Maybe (Unsigned 5, BitVector 32)))
-> Control -> Identity Control
Lens' Control (Maybe (Unsigned 5, BitVector 32))
meRegFwd ((Maybe (Unsigned 5, BitVector 32)
  -> Identity (Maybe (Unsigned 5, BitVector 32)))
 -> Pipe -> Identity Pipe)
-> (Unsigned 5, BitVector 32) -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= (Unsigned 5
rd, BitVector 32
wr)
      (Maybe WbInstr -> Identity (Maybe WbInstr))
-> Pipe -> Identity Pipe
Lens' Pipe (Maybe WbInstr)
wbIR ((Maybe WbInstr -> Identity (Maybe WbInstr))
 -> Pipe -> Identity Pipe)
-> WbInstr -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Unsigned 5 -> BitVector 32 -> WbInstr
WbRegWr Unsigned 5
rd BitVector 32
wr
    MeJump Unsigned 5
rd BitVector 32
pc4 -> do
      (Control -> Identity Control) -> Pipe -> Identity Pipe
Lens' Pipe Control
control((Control -> Identity Control) -> Pipe -> Identity Pipe)
-> ((Bool -> Identity Bool) -> Control -> Identity Control)
-> (Bool -> Identity Bool)
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Control -> Identity Control
Lens' Control Bool
meBranching ((Bool -> Identity Bool) -> Pipe -> Identity Pipe)
-> Bool -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
      (Control -> Identity Control) -> Pipe -> Identity Pipe
Lens' Pipe Control
control((Control -> Identity Control) -> Pipe -> Identity Pipe)
-> ((Maybe (Unsigned 5, BitVector 32)
     -> Identity (Maybe (Unsigned 5, BitVector 32)))
    -> Control -> Identity Control)
-> (Maybe (Unsigned 5, BitVector 32)
    -> Identity (Maybe (Unsigned 5, BitVector 32)))
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (Unsigned 5, BitVector 32)
 -> Identity (Maybe (Unsigned 5, BitVector 32)))
-> Control -> Identity Control
Lens' Control (Maybe (Unsigned 5, BitVector 32))
meRegFwd ((Maybe (Unsigned 5, BitVector 32)
  -> Identity (Maybe (Unsigned 5, BitVector 32)))
 -> Pipe -> Identity Pipe)
-> (Unsigned 5, BitVector 32) -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= (Unsigned 5
rd, BitVector 32
pc4)
      (Maybe WbInstr -> Identity (Maybe WbInstr))
-> Pipe -> Identity Pipe
Lens' Pipe (Maybe WbInstr)
wbIR ((Maybe WbInstr -> Identity (Maybe WbInstr))
 -> Pipe -> Identity Pipe)
-> WbInstr -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Unsigned 5 -> BitVector 32 -> WbInstr
WbRegWr Unsigned 5
rd BitVector 32
pc4
    MeInstr
MeBranch -> do
      (Control -> Identity Control) -> Pipe -> Identity Pipe
Lens' Pipe Control
control((Control -> Identity Control) -> Pipe -> Identity Pipe)
-> ((Bool -> Identity Bool) -> Control -> Identity Control)
-> (Bool -> Identity Bool)
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Control -> Identity Control
Lens' Control Bool
meBranching ((Bool -> Identity Bool) -> Pipe -> Identity Pipe)
-> Bool -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
      (Maybe WbInstr -> Identity (Maybe WbInstr))
-> Pipe -> Identity Pipe
Lens' Pipe (Maybe WbInstr)
wbIR ((Maybe WbInstr -> Identity (Maybe WbInstr))
 -> Pipe -> Identity Pipe)
-> WbInstr -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= WbInstr
WbNop
    MeStore BitVector 32
addr BitVector 4
mask BitVector 32
value -> do
      (Control -> Identity Control) -> Pipe -> Identity Pipe
Lens' Pipe Control
control((Control -> Identity Control) -> Pipe -> Identity Pipe)
-> ((Bool -> Identity Bool) -> Control -> Identity Control)
-> (Bool -> Identity Bool)
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Control -> Identity Control
Lens' Control Bool
meMemory ((Bool -> Identity Bool) -> Pipe -> Identity Pipe)
-> Bool -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
      ASetter FromPipe FromPipe (First ToMem) (First ToMem)
-> First ToMem -> RWS ToPipe FromPipe Pipe ()
forall t (m :: Type -> Type) s a b.
(MonadWriter t m, Monoid s) =>
ASetter s t a b -> b -> m ()
scribe ASetter FromPipe FromPipe (First ToMem) (First ToMem)
Lens' FromPipe (First ToMem)
toMem (First ToMem -> RWS ToPipe FromPipe Pipe ())
-> First ToMem -> RWS ToPipe FromPipe Pipe ()
forall a b. (a -> b) -> a -> b
$ Maybe ToMem -> First ToMem
forall a. Maybe a -> First a
First (Maybe ToMem -> First ToMem) -> Maybe ToMem -> First ToMem
forall a b. (a -> b) -> a -> b
$ ToMem -> Maybe ToMem
forall a. a -> Maybe a
Just (ToMem -> Maybe ToMem) -> ToMem -> Maybe ToMem
forall a b. (a -> b) -> a -> b
$ BitVector 32 -> BitVector 4 -> Maybe (BitVector 32) -> ToMem
dataMem BitVector 32
addr BitVector 4
mask (Maybe (BitVector 32) -> ToMem) -> Maybe (BitVector 32) -> ToMem
forall a b. (a -> b) -> a -> b
$ BitVector 32 -> Maybe (BitVector 32)
forall a. a -> Maybe a
Just BitVector 32
value
      (Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe
Lens' Pipe Rvfi
wbRvfi((Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe)
-> ((BitVector 32 -> Identity (BitVector 32))
    -> Rvfi -> Identity Rvfi)
-> (BitVector 32 -> Identity (BitVector 32))
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BitVector 32 -> Identity (BitVector 32)) -> Rvfi -> Identity Rvfi
Lens' Rvfi (BitVector 32)
rvfiMemAddr  ((BitVector 32 -> Identity (BitVector 32))
 -> Pipe -> Identity Pipe)
-> BitVector 32 -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= BitVector 32
addr
      (Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe
Lens' Pipe Rvfi
wbRvfi((Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe)
-> ((BitVector 4 -> Identity (BitVector 4))
    -> Rvfi -> Identity Rvfi)
-> (BitVector 4 -> Identity (BitVector 4))
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BitVector 4 -> Identity (BitVector 4)) -> Rvfi -> Identity Rvfi
Lens' Rvfi (BitVector 4)
rvfiMemWMask ((BitVector 4 -> Identity (BitVector 4)) -> Pipe -> Identity Pipe)
-> BitVector 4 -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= BitVector 4
mask
      (Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe
Lens' Pipe Rvfi
wbRvfi((Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe)
-> ((BitVector 32 -> Identity (BitVector 32))
    -> Rvfi -> Identity Rvfi)
-> (BitVector 32 -> Identity (BitVector 32))
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BitVector 32 -> Identity (BitVector 32)) -> Rvfi -> Identity Rvfi
Lens' Rvfi (BitVector 32)
rvfiMemWData ((BitVector 32 -> Identity (BitVector 32))
 -> Pipe -> Identity Pipe)
-> BitVector 32 -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= BitVector 32
value
      (Maybe WbInstr -> Identity (Maybe WbInstr))
-> Pipe -> Identity Pipe
Lens' Pipe (Maybe WbInstr)
wbIR ((Maybe WbInstr -> Identity (Maybe WbInstr))
 -> Pipe -> Identity Pipe)
-> WbInstr -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= WbInstr
WbStore
    MeLoad Load
op Unsigned 5
rdAddr BitVector 32
addr BitVector 4
mask -> do
      (Control -> Identity Control) -> Pipe -> Identity Pipe
Lens' Pipe Control
control((Control -> Identity Control) -> Pipe -> Identity Pipe)
-> ((Bool -> Identity Bool) -> Control -> Identity Control)
-> (Bool -> Identity Bool)
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Control -> Identity Control
Lens' Control Bool
meMemory ((Bool -> Identity Bool) -> Pipe -> Identity Pipe)
-> Bool -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
      ASetter FromPipe FromPipe (First ToMem) (First ToMem)
-> First ToMem -> RWS ToPipe FromPipe Pipe ()
forall t (m :: Type -> Type) s a b.
(MonadWriter t m, Monoid s) =>
ASetter s t a b -> b -> m ()
scribe ASetter FromPipe FromPipe (First ToMem) (First ToMem)
Lens' FromPipe (First ToMem)
toMem (First ToMem -> RWS ToPipe FromPipe Pipe ())
-> First ToMem -> RWS ToPipe FromPipe Pipe ()
forall a b. (a -> b) -> a -> b
$ Maybe ToMem -> First ToMem
forall a. Maybe a -> First a
First (Maybe ToMem -> First ToMem) -> Maybe ToMem -> First ToMem
forall a b. (a -> b) -> a -> b
$ ToMem -> Maybe ToMem
forall a. a -> Maybe a
Just (ToMem -> Maybe ToMem) -> ToMem -> Maybe ToMem
forall a b. (a -> b) -> a -> b
$ BitVector 32 -> BitVector 4 -> Maybe (BitVector 32) -> ToMem
dataMem BitVector 32
addr BitVector 4
mask Maybe (BitVector 32)
forall a. Maybe a
Nothing
      (Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe
Lens' Pipe Rvfi
wbRvfi((Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe)
-> ((BitVector 32 -> Identity (BitVector 32))
    -> Rvfi -> Identity Rvfi)
-> (BitVector 32 -> Identity (BitVector 32))
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BitVector 32 -> Identity (BitVector 32)) -> Rvfi -> Identity Rvfi
Lens' Rvfi (BitVector 32)
rvfiMemAddr  ((BitVector 32 -> Identity (BitVector 32))
 -> Pipe -> Identity Pipe)
-> BitVector 32 -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= BitVector 32
addr
      (Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe
Lens' Pipe Rvfi
wbRvfi((Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe)
-> ((BitVector 4 -> Identity (BitVector 4))
    -> Rvfi -> Identity Rvfi)
-> (BitVector 4 -> Identity (BitVector 4))
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BitVector 4 -> Identity (BitVector 4)) -> Rvfi -> Identity Rvfi
Lens' Rvfi (BitVector 4)
rvfiMemRMask ((BitVector 4 -> Identity (BitVector 4)) -> Pipe -> Identity Pipe)
-> BitVector 4 -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= BitVector 4
mask
      (Maybe WbInstr -> Identity (Maybe WbInstr))
-> Pipe -> Identity Pipe
Lens' Pipe (Maybe WbInstr)
wbIR ((Maybe WbInstr -> Identity (Maybe WbInstr))
 -> Pipe -> Identity Pipe)
-> WbInstr -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Load -> Unsigned 5 -> BitVector 4 -> WbInstr
WbLoad Load
op Unsigned 5
rdAddr BitVector 4
mask

-- | Execute stage
execute :: RWS ToPipe FromPipe Pipe ()
execute :: RWS ToPipe FromPipe Pipe ()
execute = do
  (Maybe MeInstr -> Identity (Maybe MeInstr))
-> Pipe -> Identity Pipe
Lens' Pipe (Maybe MeInstr)
meIR ((Maybe MeInstr -> Identity (Maybe MeInstr))
 -> Pipe -> Identity Pipe)
-> Maybe MeInstr -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MeInstr
forall a. Maybe a
Nothing
  (Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe
Lens' Pipe Rvfi
meRvfi ((Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe)
-> RWST ToPipe FromPipe Pipe Identity Rvfi
-> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> m b -> m ()
<~ Getting Rvfi Pipe Rvfi -> RWST ToPipe FromPipe Pipe Identity Rvfi
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Rvfi Pipe Rvfi
Lens' Pipe Rvfi
exRvfi
  BitVector 32
pc  <- (Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi)
-> Pipe -> Pretext (->) (BitVector 32) (BitVector 32) Pipe
Lens' Pipe Rvfi
meRvfi((Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi)
 -> Pipe -> Pretext (->) (BitVector 32) (BitVector 32) Pipe)
-> ((BitVector 32
     -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
    -> Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi)
-> (BitVector 32
    -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
-> Pipe
-> Pretext (->) (BitVector 32) (BitVector 32) Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BitVector 32
 -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
-> Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi
Lens' Rvfi (BitVector 32)
rvfiPcRData ((BitVector 32
  -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
 -> Pipe -> Pretext (->) (BitVector 32) (BitVector 32) Pipe)
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
forall s (m :: Type -> Type) a b.
MonadState s m =>
ALens s s a b -> m b -> m b
<<~ Getting (BitVector 32) Pipe (BitVector 32)
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting (BitVector 32) Pipe (BitVector 32)
Lens' Pipe (BitVector 32)
exPC
  BitVector 32
pc4 <- (Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe
Lens' Pipe Rvfi
meRvfi((Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe)
-> ((BitVector 32 -> Identity (BitVector 32))
    -> Rvfi -> Identity Rvfi)
-> (BitVector 32 -> Identity (BitVector 32))
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BitVector 32 -> Identity (BitVector 32)) -> Rvfi -> Identity Rvfi
Lens' Rvfi (BitVector 32)
rvfiPcWData ((BitVector 32 -> Identity (BitVector 32))
 -> Pipe -> Identity Pipe)
-> BitVector 32
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m b
<.= BitVector 32
pc BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Num a => a -> a -> a
+ BitVector 32
4
  BitVector 32
rs1Data <- (Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi)
-> Pipe -> Pretext (->) (BitVector 32) (BitVector 32) Pipe
Lens' Pipe Rvfi
meRvfi((Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi)
 -> Pipe -> Pretext (->) (BitVector 32) (BitVector 32) Pipe)
-> ((BitVector 32
     -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
    -> Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi)
-> (BitVector 32
    -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
-> Pipe
-> Pretext (->) (BitVector 32) (BitVector 32) Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BitVector 32
 -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
-> Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi
Lens' Rvfi (BitVector 32)
rvfiRs1Data ((BitVector 32
  -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
 -> Pipe -> Pretext (->) (BitVector 32) (BitVector 32) Pipe)
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
forall s (m :: Type -> Type) a b.
MonadState s m =>
ALens s s a b -> m b -> m b
<<~ Lens' Pipe (Unsigned 5)
-> Lens' ToPipe (BitVector 32)
-> Lens' Pipe (Maybe (Unsigned 5, BitVector 32))
-> Lens' Pipe (Maybe (Unsigned 5, BitVector 32))
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
forall s (m :: Type -> Type) r.
(MonadState s m, MonadReader r m) =>
Lens' s (Unsigned 5)
-> Lens' r (BitVector 32)
-> Lens' s (Maybe (Unsigned 5, BitVector 32))
-> Lens' s (Maybe (Unsigned 5, BitVector 32))
-> m (BitVector 32)
regFwd Lens' Pipe (Unsigned 5)
exRs1 Lens' ToPipe (BitVector 32)
fromRs1 ((Control -> f Control) -> Pipe -> f Pipe
Lens' Pipe Control
control((Control -> f Control) -> Pipe -> f Pipe)
-> ((Maybe (Unsigned 5, BitVector 32)
     -> f (Maybe (Unsigned 5, BitVector 32)))
    -> Control -> f Control)
-> (Maybe (Unsigned 5, BitVector 32)
    -> f (Maybe (Unsigned 5, BitVector 32)))
-> Pipe
-> f Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (Unsigned 5, BitVector 32)
 -> f (Maybe (Unsigned 5, BitVector 32)))
-> Control -> f Control
Lens' Control (Maybe (Unsigned 5, BitVector 32))
meRegFwd) ((Control -> f Control) -> Pipe -> f Pipe
Lens' Pipe Control
control((Control -> f Control) -> Pipe -> f Pipe)
-> ((Maybe (Unsigned 5, BitVector 32)
     -> f (Maybe (Unsigned 5, BitVector 32)))
    -> Control -> f Control)
-> (Maybe (Unsigned 5, BitVector 32)
    -> f (Maybe (Unsigned 5, BitVector 32)))
-> Pipe
-> f Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (Unsigned 5, BitVector 32)
 -> f (Maybe (Unsigned 5, BitVector 32)))
-> Control -> f Control
Lens' Control (Maybe (Unsigned 5, BitVector 32))
wbRegFwd)
  BitVector 32
rs2Data <- (Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi)
-> Pipe -> Pretext (->) (BitVector 32) (BitVector 32) Pipe
Lens' Pipe Rvfi
meRvfi((Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi)
 -> Pipe -> Pretext (->) (BitVector 32) (BitVector 32) Pipe)
-> ((BitVector 32
     -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
    -> Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi)
-> (BitVector 32
    -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
-> Pipe
-> Pretext (->) (BitVector 32) (BitVector 32) Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BitVector 32
 -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
-> Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi
Lens' Rvfi (BitVector 32)
rvfiRs2Data ((BitVector 32
  -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
 -> Pipe -> Pretext (->) (BitVector 32) (BitVector 32) Pipe)
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
forall s (m :: Type -> Type) a b.
MonadState s m =>
ALens s s a b -> m b -> m b
<<~ Lens' Pipe (Unsigned 5)
-> Lens' ToPipe (BitVector 32)
-> Lens' Pipe (Maybe (Unsigned 5, BitVector 32))
-> Lens' Pipe (Maybe (Unsigned 5, BitVector 32))
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
forall s (m :: Type -> Type) r.
(MonadState s m, MonadReader r m) =>
Lens' s (Unsigned 5)
-> Lens' r (BitVector 32)
-> Lens' s (Maybe (Unsigned 5, BitVector 32))
-> Lens' s (Maybe (Unsigned 5, BitVector 32))
-> m (BitVector 32)
regFwd Lens' Pipe (Unsigned 5)
exRs2 Lens' ToPipe (BitVector 32)
fromRs2 ((Control -> f Control) -> Pipe -> f Pipe
Lens' Pipe Control
control((Control -> f Control) -> Pipe -> f Pipe)
-> ((Maybe (Unsigned 5, BitVector 32)
     -> f (Maybe (Unsigned 5, BitVector 32)))
    -> Control -> f Control)
-> (Maybe (Unsigned 5, BitVector 32)
    -> f (Maybe (Unsigned 5, BitVector 32)))
-> Pipe
-> f Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (Unsigned 5, BitVector 32)
 -> f (Maybe (Unsigned 5, BitVector 32)))
-> Control -> f Control
Lens' Control (Maybe (Unsigned 5, BitVector 32))
meRegFwd) ((Control -> f Control) -> Pipe -> f Pipe
Lens' Pipe Control
control((Control -> f Control) -> Pipe -> f Pipe)
-> ((Maybe (Unsigned 5, BitVector 32)
     -> f (Maybe (Unsigned 5, BitVector 32)))
    -> Control -> f Control)
-> (Maybe (Unsigned 5, BitVector 32)
    -> f (Maybe (Unsigned 5, BitVector 32)))
-> Pipe
-> f Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (Unsigned 5, BitVector 32)
 -> f (Maybe (Unsigned 5, BitVector 32)))
-> Control -> f Control
Lens' Control (Maybe (Unsigned 5, BitVector 32))
wbRegFwd)
  Lens' Pipe (Maybe ExInstr)
-> (ExInstr -> RWS ToPipe FromPipe Pipe ())
-> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a.
MonadState s m =>
Lens' s (Maybe a) -> (a -> m ()) -> m ()
withInstr Lens' Pipe (Maybe ExInstr)
exIR ((ExInstr -> RWS ToPipe FromPipe Pipe ())
 -> RWS ToPipe FromPipe Pipe ())
-> (ExInstr -> RWS ToPipe FromPipe Pipe ())
-> RWS ToPipe FromPipe Pipe ()
forall a b. (a -> b) -> a -> b
$ \case
    Ex ExOp
op Unsigned 5
rd BitVector 32
imm -> do
      Op -> BitVector 32 -> BitVector 32 -> RWS ToPipe FromPipe Pipe ()
forall (m :: Type -> Type).
MonadWriter FromPipe m =>
Op -> BitVector 32 -> BitVector 32 -> m ()
scribeAlu Op
Add BitVector 32
imm (BitVector 32 -> RWS ToPipe FromPipe Pipe ())
-> BitVector 32 -> RWS ToPipe FromPipe Pipe ()
forall a b. (a -> b) -> a -> b
$ case ExOp
op of
        ExOp
Lui   -> BitVector 32
0
        ExOp
Auipc -> BitVector 32
pc
      (Maybe MeInstr -> Identity (Maybe MeInstr))
-> Pipe -> Identity Pipe
Lens' Pipe (Maybe MeInstr)
meIR ((Maybe MeInstr -> Identity (Maybe MeInstr))
 -> Pipe -> Identity Pipe)
-> MeInstr -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Unsigned 5 -> MeInstr
MeRegWr Unsigned 5
rd
    ExJump Jump
jump Unsigned 5
rd BitVector 32
imm -> do
      BitVector 32
npc <- (Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi)
-> Pipe -> Pretext (->) (BitVector 32) (BitVector 32) Pipe
Lens' Pipe Rvfi
meRvfi((Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi)
 -> Pipe -> Pretext (->) (BitVector 32) (BitVector 32) Pipe)
-> ((BitVector 32
     -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
    -> Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi)
-> (BitVector 32
    -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
-> Pipe
-> Pretext (->) (BitVector 32) (BitVector 32) Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BitVector 32
 -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
-> Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi
Lens' Rvfi (BitVector 32)
rvfiPcWData ((BitVector 32
  -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
 -> Pipe -> Pretext (->) (BitVector 32) (BitVector 32) Pipe)
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
forall s (m :: Type -> Type) a b.
MonadState s m =>
ALens s s a b -> m b -> m b
<<~ (Control -> Identity Control) -> Pipe -> Identity Pipe
Lens' Pipe Control
control((Control -> Identity Control) -> Pipe -> Identity Pipe)
-> ((Maybe (BitVector 32) -> Identity (Maybe (BitVector 32)))
    -> Control -> Identity Control)
-> (Maybe (BitVector 32) -> Identity (Maybe (BitVector 32)))
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (BitVector 32) -> Identity (Maybe (BitVector 32)))
-> Control -> Identity Control
Lens' Control (Maybe (BitVector 32))
exBranching ((Maybe (BitVector 32) -> Identity (Maybe (BitVector 32)))
 -> Pipe -> Identity Pipe)
-> BitVector 32
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m b
<?= case Jump
jump of
        Jump
Jal  -> BitVector 32
pc BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Num a => a -> a -> a
+ BitVector 32
imm
        Jump
Jalr -> BitVector 32 -> Int -> BitVector 32
forall a. Bits a => a -> Int -> a
clearBit (BitVector 32
rs1Data BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Num a => a -> a -> a
+ BitVector 32
imm) Int
0
      (Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe
Lens' Pipe Rvfi
meRvfi((Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe)
-> ((Bool -> Identity Bool) -> Rvfi -> Identity Rvfi)
-> (Bool -> Identity Bool)
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Rvfi -> Identity Rvfi
Lens' Rvfi Bool
rvfiTrap ((Bool -> Identity Bool) -> Pipe -> Identity Pipe)
-> Bool -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type).
MonadState s m =>
ASetter' s Bool -> Bool -> m ()
||= BitVector 32 -> Bool
forall a. (Bits a, Num a) => a -> Bool
isMisaligned BitVector 32
npc
      (Maybe MeInstr -> Identity (Maybe MeInstr))
-> Pipe -> Identity Pipe
Lens' Pipe (Maybe MeInstr)
meIR ((Maybe MeInstr -> Identity (Maybe MeInstr))
 -> Pipe -> Identity Pipe)
-> MeInstr -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Unsigned 5 -> BitVector 32 -> MeInstr
MeJump Unsigned 5
rd BitVector 32
pc4
    ExBranch Branch
op BitVector 32
imm ->
      if Branch -> BitVector 32 -> BitVector 32 -> Bool
branch Branch
op BitVector 32
rs1Data BitVector 32
rs2Data
        then do
          BitVector 32
branchPC <- (Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi)
-> Pipe -> Pretext (->) (BitVector 32) (BitVector 32) Pipe
Lens' Pipe Rvfi
meRvfi((Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi)
 -> Pipe -> Pretext (->) (BitVector 32) (BitVector 32) Pipe)
-> ((BitVector 32
     -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
    -> Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi)
-> (BitVector 32
    -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
-> Pipe
-> Pretext (->) (BitVector 32) (BitVector 32) Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BitVector 32
 -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
-> Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi
Lens' Rvfi (BitVector 32)
rvfiPcWData ((BitVector 32
  -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
 -> Pipe -> Pretext (->) (BitVector 32) (BitVector 32) Pipe)
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
forall s (m :: Type -> Type) a b.
MonadState s m =>
ALens s s a b -> m b -> m b
<<~ (Control -> Identity Control) -> Pipe -> Identity Pipe
Lens' Pipe Control
control((Control -> Identity Control) -> Pipe -> Identity Pipe)
-> ((Maybe (BitVector 32) -> Identity (Maybe (BitVector 32)))
    -> Control -> Identity Control)
-> (Maybe (BitVector 32) -> Identity (Maybe (BitVector 32)))
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (BitVector 32) -> Identity (Maybe (BitVector 32)))
-> Control -> Identity Control
Lens' Control (Maybe (BitVector 32))
exBranching ((Maybe (BitVector 32) -> Identity (Maybe (BitVector 32)))
 -> Pipe -> Identity Pipe)
-> BitVector 32
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m b
<?= BitVector 32
pc BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Num a => a -> a -> a
+ BitVector 32
imm
          (Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe
Lens' Pipe Rvfi
meRvfi((Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe)
-> ((Bool -> Identity Bool) -> Rvfi -> Identity Rvfi)
-> (Bool -> Identity Bool)
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Rvfi -> Identity Rvfi
Lens' Rvfi Bool
rvfiTrap ((Bool -> Identity Bool) -> Pipe -> Identity Pipe)
-> Bool -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type).
MonadState s m =>
ASetter' s Bool -> Bool -> m ()
||= BitVector 32 -> Bool
forall a. (Bits a, Num a) => a -> Bool
isMisaligned BitVector 32
branchPC
          (Maybe MeInstr -> Identity (Maybe MeInstr))
-> Pipe -> Identity Pipe
Lens' Pipe (Maybe MeInstr)
meIR ((Maybe MeInstr -> Identity (Maybe MeInstr))
 -> Pipe -> Identity Pipe)
-> MeInstr -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= MeInstr
MeBranch
        else do
          (Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe
Lens' Pipe Rvfi
meRvfi((Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe)
-> ((Bool -> Identity Bool) -> Rvfi -> Identity Rvfi)
-> (Bool -> Identity Bool)
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Rvfi -> Identity Rvfi
Lens' Rvfi Bool
rvfiTrap ((Bool -> Identity Bool) -> Pipe -> Identity Pipe)
-> Bool -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type).
MonadState s m =>
ASetter' s Bool -> Bool -> m ()
||= BitVector 32 -> Bool
forall a. (Bits a, Num a) => a -> Bool
isMisaligned BitVector 32
pc4
          (Maybe MeInstr -> Identity (Maybe MeInstr))
-> Pipe -> Identity Pipe
Lens' Pipe (Maybe MeInstr)
meIR ((Maybe MeInstr -> Identity (Maybe MeInstr))
 -> Pipe -> Identity Pipe)
-> MeInstr -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= MeInstr
MeNop
    ExStore Store
op BitVector 32
imm -> do
      let addr :: BitVector 32
addr = BitVector 32
rs1Data BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Num a => a -> a -> a
+ BitVector 32
imm            -- unaligned
          addr' :: BitVector 32
addr' = BitVector 32
addr BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Bits a => a -> a -> a
.&. BitVector 32 -> BitVector 32
forall a. Bits a => a -> a
complement BitVector 32
0x3 -- aligned
      case Store
op of
        Store
Sb -> let wr :: BitVector (4 * 8)
wr = Vec 4 (BitVector 8) -> BitVector (4 * 8)
forall (n :: Nat) (m :: Nat).
(KnownNat n, KnownNat m) =>
Vec n (BitVector m) -> BitVector (n * m)
concatBitVector# (Vec 4 (BitVector 8) -> BitVector (4 * 8))
-> Vec 4 (BitVector 8) -> BitVector (4 * 8)
forall a b. (a -> b) -> a -> b
$ SNat 4 -> BitVector 8 -> Vec 4 (BitVector 8)
forall (n :: Nat) a. SNat n -> a -> Vec n a
replicate SNat 4
d4 (BitVector 8 -> Vec 4 (BitVector 8))
-> BitVector 8 -> Vec 4 (BitVector 8)
forall a b. (a -> b) -> a -> b
$ SNat 7 -> SNat 0 -> BitVector 32 -> BitVector ((7 + 1) - 0)
forall a (m :: Nat) (i :: Nat) (n :: Nat).
(BitPack a, BitSize a ~ ((m + 1) + i)) =>
SNat m -> SNat n -> a -> BitVector ((m + 1) - n)
slice SNat 7
d7 SNat 0
d0 BitVector 32
rs2Data
              in (Maybe MeInstr -> Identity (Maybe MeInstr))
-> Pipe -> Identity Pipe
Lens' Pipe (Maybe MeInstr)
meIR ((Maybe MeInstr -> Identity (Maybe MeInstr))
 -> Pipe -> Identity Pipe)
-> MeInstr -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= BitVector 32 -> BitVector 4 -> BitVector 32 -> MeInstr
MeStore BitVector 32
addr' (BitVector 32 -> BitVector 4
byteMask BitVector 32
addr) BitVector 32
BitVector (4 * 8)
wr
        Store
Sh -> do
          (Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe
Lens' Pipe Rvfi
meRvfi((Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe)
-> ((Bool -> Identity Bool) -> Rvfi -> Identity Rvfi)
-> (Bool -> Identity Bool)
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Rvfi -> Identity Rvfi
Lens' Rvfi Bool
rvfiTrap ((Bool -> Identity Bool) -> Pipe -> Identity Pipe)
-> Bool -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type).
MonadState s m =>
ASetter' s Bool -> Bool -> m ()
||= BitVector 32 -> Bool
forall a. (Bits a, Num a) => a -> Bool
isMisalignedHalf BitVector 32
addr -- trap on half-word boundary
          let wr :: BitVector (2 * 16)
wr = Vec 2 (BitVector 16) -> BitVector (2 * 16)
forall (n :: Nat) (m :: Nat).
(KnownNat n, KnownNat m) =>
Vec n (BitVector m) -> BitVector (n * m)
concatBitVector# (Vec 2 (BitVector 16) -> BitVector (2 * 16))
-> Vec 2 (BitVector 16) -> BitVector (2 * 16)
forall a b. (a -> b) -> a -> b
$ SNat 2 -> BitVector 16 -> Vec 2 (BitVector 16)
forall (n :: Nat) a. SNat n -> a -> Vec n a
replicate SNat 2
d2 (BitVector 16 -> Vec 2 (BitVector 16))
-> BitVector 16 -> Vec 2 (BitVector 16)
forall a b. (a -> b) -> a -> b
$ SNat 15 -> SNat 0 -> BitVector 32 -> BitVector ((15 + 1) - 0)
forall a (m :: Nat) (i :: Nat) (n :: Nat).
(BitPack a, BitSize a ~ ((m + 1) + i)) =>
SNat m -> SNat n -> a -> BitVector ((m + 1) - n)
slice SNat 15
d15 SNat 0
d0 BitVector 32
rs2Data
          (Maybe MeInstr -> Identity (Maybe MeInstr))
-> Pipe -> Identity Pipe
Lens' Pipe (Maybe MeInstr)
meIR ((Maybe MeInstr -> Identity (Maybe MeInstr))
 -> Pipe -> Identity Pipe)
-> MeInstr -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= BitVector 32 -> BitVector 4 -> BitVector 32 -> MeInstr
MeStore BitVector 32
addr' (BitVector 32 -> BitVector 4
halfMask BitVector 32
addr) BitVector 32
BitVector (2 * 16)
wr
        Store
Sw -> do
          (Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe
Lens' Pipe Rvfi
meRvfi((Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe)
-> ((Bool -> Identity Bool) -> Rvfi -> Identity Rvfi)
-> (Bool -> Identity Bool)
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Rvfi -> Identity Rvfi
Lens' Rvfi Bool
rvfiTrap ((Bool -> Identity Bool) -> Pipe -> Identity Pipe)
-> Bool -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type).
MonadState s m =>
ASetter' s Bool -> Bool -> m ()
||= BitVector 32 -> Bool
forall a. (Bits a, Num a) => a -> Bool
isMisaligned BitVector 32
addr -- trap on word boundary
          (Maybe MeInstr -> Identity (Maybe MeInstr))
-> Pipe -> Identity Pipe
Lens' Pipe (Maybe MeInstr)
meIR ((Maybe MeInstr -> Identity (Maybe MeInstr))
 -> Pipe -> Identity Pipe)
-> MeInstr -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= BitVector 32 -> BitVector 4 -> BitVector 32 -> MeInstr
MeStore BitVector 32
addr' BitVector 4
0xF BitVector 32
rs2Data
    ExLoad Load
op Unsigned 5
rdAddr BitVector 32
imm -> do
      (Control -> Identity Control) -> Pipe -> Identity Pipe
Lens' Pipe Control
control((Control -> Identity Control) -> Pipe -> Identity Pipe)
-> ((Bool -> Identity Bool) -> Control -> Identity Control)
-> (Bool -> Identity Bool)
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Control -> Identity Control
Lens' Control Bool
exLoad ((Bool -> Identity Bool) -> Pipe -> Identity Pipe)
-> Bool -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
      let addr :: BitVector 32
addr = BitVector 32
rs1Data BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Num a => a -> a -> a
+ BitVector 32
imm            -- unaligned
          addr' :: BitVector 32
addr' = BitVector 32
addr BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Bits a => a -> a -> a
.&. BitVector 32 -> BitVector 32
forall a. Bits a => a -> a
complement BitVector 32
0x3 -- aligned
      if | Load
op Load -> Load -> Bool
forall a. Eq a => a -> a -> Bool
== Load
Lb Bool -> Bool -> Bool
|| Load
op Load -> Load -> Bool
forall a. Eq a => a -> a -> Bool
== Load
Lbu -> (Maybe MeInstr -> Identity (Maybe MeInstr))
-> Pipe -> Identity Pipe
Lens' Pipe (Maybe MeInstr)
meIR ((Maybe MeInstr -> Identity (Maybe MeInstr))
 -> Pipe -> Identity Pipe)
-> MeInstr -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Load -> Unsigned 5 -> BitVector 32 -> BitVector 4 -> MeInstr
MeLoad Load
op Unsigned 5
rdAddr BitVector 32
addr' (BitVector 32 -> BitVector 4
byteMask BitVector 32
addr)
         | Load
op Load -> Load -> Bool
forall a. Eq a => a -> a -> Bool
== Load
Lh Bool -> Bool -> Bool
|| Load
op Load -> Load -> Bool
forall a. Eq a => a -> a -> Bool
== Load
Lhu -> do
             (Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe
Lens' Pipe Rvfi
meRvfi((Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe)
-> ((Bool -> Identity Bool) -> Rvfi -> Identity Rvfi)
-> (Bool -> Identity Bool)
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Rvfi -> Identity Rvfi
Lens' Rvfi Bool
rvfiTrap ((Bool -> Identity Bool) -> Pipe -> Identity Pipe)
-> Bool -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type).
MonadState s m =>
ASetter' s Bool -> Bool -> m ()
||= BitVector 32 -> Bool
forall a. (Bits a, Num a) => a -> Bool
isMisalignedHalf BitVector 32
addr -- trap on half-word boundary
             (Maybe MeInstr -> Identity (Maybe MeInstr))
-> Pipe -> Identity Pipe
Lens' Pipe (Maybe MeInstr)
meIR ((Maybe MeInstr -> Identity (Maybe MeInstr))
 -> Pipe -> Identity Pipe)
-> MeInstr -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Load -> Unsigned 5 -> BitVector 32 -> BitVector 4 -> MeInstr
MeLoad Load
op Unsigned 5
rdAddr BitVector 32
addr' (BitVector 32 -> BitVector 4
halfMask BitVector 32
addr)
         | Bool
otherwise -> do -- Lw
             (Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe
Lens' Pipe Rvfi
meRvfi((Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe)
-> ((Bool -> Identity Bool) -> Rvfi -> Identity Rvfi)
-> (Bool -> Identity Bool)
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Rvfi -> Identity Rvfi
Lens' Rvfi Bool
rvfiTrap ((Bool -> Identity Bool) -> Pipe -> Identity Pipe)
-> Bool -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type).
MonadState s m =>
ASetter' s Bool -> Bool -> m ()
||= BitVector 32 -> Bool
forall a. (Bits a, Num a) => a -> Bool
isMisaligned BitVector 32
addr -- trap on word boundary
             (Maybe MeInstr -> Identity (Maybe MeInstr))
-> Pipe -> Identity Pipe
Lens' Pipe (Maybe MeInstr)
meIR ((Maybe MeInstr -> Identity (Maybe MeInstr))
 -> Pipe -> Identity Pipe)
-> MeInstr -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Load -> Unsigned 5 -> BitVector 32 -> BitVector 4 -> MeInstr
MeLoad Load
op Unsigned 5
rdAddr BitVector 32
addr' BitVector 4
0xF
    ExAlu Op
op Unsigned 5
rd -> do
      Op -> BitVector 32 -> BitVector 32 -> RWS ToPipe FromPipe Pipe ()
forall (m :: Type -> Type).
MonadWriter FromPipe m =>
Op -> BitVector 32 -> BitVector 32 -> m ()
scribeAlu Op
op BitVector 32
rs1Data BitVector 32
rs2Data
      (Maybe MeInstr -> Identity (Maybe MeInstr))
-> Pipe -> Identity Pipe
Lens' Pipe (Maybe MeInstr)
meIR ((Maybe MeInstr -> Identity (Maybe MeInstr))
 -> Pipe -> Identity Pipe)
-> MeInstr -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Unsigned 5 -> MeInstr
MeRegWr Unsigned 5
rd
    ExAluImm Op
op Unsigned 5
rd BitVector 32
imm -> do
      Op -> BitVector 32 -> BitVector 32 -> RWS ToPipe FromPipe Pipe ()
forall (m :: Type -> Type).
MonadWriter FromPipe m =>
Op -> BitVector 32 -> BitVector 32 -> m ()
scribeAlu Op
op BitVector 32
rs1Data BitVector 32
imm
      (Maybe MeInstr -> Identity (Maybe MeInstr))
-> Pipe -> Identity Pipe
Lens' Pipe (Maybe MeInstr)
meIR ((Maybe MeInstr -> Identity (Maybe MeInstr))
 -> Pipe -> Identity Pipe)
-> MeInstr -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Unsigned 5 -> MeInstr
MeRegWr Unsigned 5
rd
  where
    scribeAlu :: Op -> BitVector 32 -> BitVector 32 -> m ()
scribeAlu Op
op BitVector 32
in1 BitVector 32
in2 = do
      ASetter FromPipe FromPipe (First Op) (First Op) -> First Op -> m ()
forall t (m :: Type -> Type) s a b.
(MonadWriter t m, Monoid s) =>
ASetter s t a b -> b -> m ()
scribe ASetter FromPipe FromPipe (First Op) (First Op)
Lens' FromPipe (First Op)
toAluOp     (First Op -> m ()) -> First Op -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe Op -> First Op
forall a. Maybe a -> First a
First (Maybe Op -> First Op) -> Maybe Op -> First Op
forall a b. (a -> b) -> a -> b
$ Op -> Maybe Op
forall a. a -> Maybe a
Just Op
op
      ASetter
  FromPipe FromPipe (First (BitVector 32)) (First (BitVector 32))
-> First (BitVector 32) -> m ()
forall t (m :: Type -> Type) s a b.
(MonadWriter t m, Monoid s) =>
ASetter s t a b -> b -> m ()
scribe ASetter
  FromPipe FromPipe (First (BitVector 32)) (First (BitVector 32))
Lens' FromPipe (First (BitVector 32))
toAluInput1 (First (BitVector 32) -> m ()) -> First (BitVector 32) -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe (BitVector 32) -> First (BitVector 32)
forall a. Maybe a -> First a
First (Maybe (BitVector 32) -> First (BitVector 32))
-> Maybe (BitVector 32) -> First (BitVector 32)
forall a b. (a -> b) -> a -> b
$ BitVector 32 -> Maybe (BitVector 32)
forall a. a -> Maybe a
Just BitVector 32
in1
      ASetter
  FromPipe FromPipe (First (BitVector 32)) (First (BitVector 32))
-> First (BitVector 32) -> m ()
forall t (m :: Type -> Type) s a b.
(MonadWriter t m, Monoid s) =>
ASetter s t a b -> b -> m ()
scribe ASetter
  FromPipe FromPipe (First (BitVector 32)) (First (BitVector 32))
Lens' FromPipe (First (BitVector 32))
toAluInput2 (First (BitVector 32) -> m ()) -> First (BitVector 32) -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe (BitVector 32) -> First (BitVector 32)
forall a. Maybe a -> First a
First (Maybe (BitVector 32) -> First (BitVector 32))
-> Maybe (BitVector 32) -> First (BitVector 32)
forall a b. (a -> b) -> a -> b
$ BitVector 32 -> Maybe (BitVector 32)
forall a. a -> Maybe a
Just BitVector 32
in2

    regFwd 
      :: MonadState s m 
      => MonadReader r m
      => Lens' s (Unsigned 5) 
      -> Lens' r (BitVector 32)
      -> Lens' s (Maybe (Unsigned 5, BitVector 32))
      -> Lens' s (Maybe (Unsigned 5, BitVector 32))
      -> m (BitVector 32)
    regFwd :: Lens' s (Unsigned 5)
-> Lens' r (BitVector 32)
-> Lens' s (Maybe (Unsigned 5, BitVector 32))
-> Lens' s (Maybe (Unsigned 5, BitVector 32))
-> m (BitVector 32)
regFwd Lens' s (Unsigned 5)
rsAddr Lens' r (BitVector 32)
rsData Lens' s (Maybe (Unsigned 5, BitVector 32))
meFwd Lens' s (Maybe (Unsigned 5, BitVector 32))
wbFwd = 
      Lens' s (Unsigned 5) -> BitVector 32 -> m (BitVector 32)
forall s (m :: Type -> Type).
MonadState s m =>
Lens' s (Unsigned 5) -> BitVector 32 -> m (BitVector 32)
guardZero Lens' s (Unsigned 5)
rsAddr (BitVector 32 -> m (BitVector 32))
-> m (BitVector 32) -> m (BitVector 32)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< Unsigned 5
-> BitVector 32
-> Maybe (Unsigned 5, BitVector 32)
-> Maybe (Unsigned 5, BitVector 32)
-> BitVector 32
fwd (Unsigned 5
 -> BitVector 32
 -> Maybe (Unsigned 5, BitVector 32)
 -> Maybe (Unsigned 5, BitVector 32)
 -> BitVector 32)
-> m (Unsigned 5)
-> m (BitVector 32
      -> Maybe (Unsigned 5, BitVector 32)
      -> Maybe (Unsigned 5, BitVector 32)
      -> BitVector 32)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Unsigned 5) s (Unsigned 5) -> m (Unsigned 5)
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting (Unsigned 5) s (Unsigned 5)
Lens' s (Unsigned 5)
rsAddr m (BitVector 32
   -> Maybe (Unsigned 5, BitVector 32)
   -> Maybe (Unsigned 5, BitVector 32)
   -> BitVector 32)
-> m (BitVector 32)
-> m (Maybe (Unsigned 5, BitVector 32)
      -> Maybe (Unsigned 5, BitVector 32) -> BitVector 32)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Getting (BitVector 32) r (BitVector 32) -> m (BitVector 32)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting (BitVector 32) r (BitVector 32)
Lens' r (BitVector 32)
rsData m (Maybe (Unsigned 5, BitVector 32)
   -> Maybe (Unsigned 5, BitVector 32) -> BitVector 32)
-> m (Maybe (Unsigned 5, BitVector 32))
-> m (Maybe (Unsigned 5, BitVector 32) -> BitVector 32)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Getting
  (Maybe (Unsigned 5, BitVector 32))
  s
  (Maybe (Unsigned 5, BitVector 32))
-> m (Maybe (Unsigned 5, BitVector 32))
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting
  (Maybe (Unsigned 5, BitVector 32))
  s
  (Maybe (Unsigned 5, BitVector 32))
Lens' s (Maybe (Unsigned 5, BitVector 32))
meFwd m (Maybe (Unsigned 5, BitVector 32) -> BitVector 32)
-> m (Maybe (Unsigned 5, BitVector 32)) -> m (BitVector 32)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Getting
  (Maybe (Unsigned 5, BitVector 32))
  s
  (Maybe (Unsigned 5, BitVector 32))
-> m (Maybe (Unsigned 5, BitVector 32))
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting
  (Maybe (Unsigned 5, BitVector 32))
  s
  (Maybe (Unsigned 5, BitVector 32))
Lens' s (Maybe (Unsigned 5, BitVector 32))
wbFwd
      where
        guardZero  -- register x0 always has value 0.
          :: MonadState s m 
          => Lens' s (Unsigned 5) 
          -> BitVector 32 
          -> m (BitVector 32)
        guardZero :: Lens' s (Unsigned 5) -> BitVector 32 -> m (BitVector 32)
guardZero Lens' s (Unsigned 5)
addr BitVector 32
value = do
          Bool
isZero <- LensLike' (Const Bool) s (Unsigned 5)
-> (Unsigned 5 -> Bool) -> m Bool
forall s (m :: Type -> Type) r a.
MonadState s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
uses LensLike' (Const Bool) s (Unsigned 5)
Lens' s (Unsigned 5)
addr (Unsigned 5 -> Unsigned 5 -> Bool
forall a. Eq a => a -> a -> Bool
== Unsigned 5
0)
          BitVector 32 -> m (BitVector 32)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BitVector 32 -> m (BitVector 32))
-> BitVector 32 -> m (BitVector 32)
forall a b. (a -> b) -> a -> b
$ if Bool
isZero
             then BitVector 32
0
             else BitVector 32
value

-- | Decode stage
decode :: RWS ToPipe FromPipe Pipe ()
decode :: RWS ToPipe FromPipe Pipe ()
decode = do
  (Maybe ExInstr -> Identity (Maybe ExInstr))
-> Pipe -> Identity Pipe
Lens' Pipe (Maybe ExInstr)
exIR ((Maybe ExInstr -> Identity (Maybe ExInstr))
 -> Pipe -> Identity Pipe)
-> Maybe ExInstr -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe ExInstr
forall a. Maybe a
Nothing
  (Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe
Lens' Pipe Rvfi
exRvfi ((Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe)
-> Rvfi -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Rvfi
mkRvfi
  (BitVector 32 -> Identity (BitVector 32)) -> Pipe -> Identity Pipe
Lens' Pipe (BitVector 32)
exPC ((BitVector 32 -> Identity (BitVector 32))
 -> Pipe -> Identity Pipe)
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
-> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> m b -> m ()
<~ Getting (BitVector 32) Pipe (BitVector 32)
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting (BitVector 32) Pipe (BitVector 32)
Lens' Pipe (BitVector 32)
dePC
  BitVector 32
mem <- (Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi)
-> Pipe -> Pretext (->) (BitVector 32) (BitVector 32) Pipe
Lens' Pipe Rvfi
exRvfi((Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi)
 -> Pipe -> Pretext (->) (BitVector 32) (BitVector 32) Pipe)
-> ((BitVector 32
     -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
    -> Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi)
-> (BitVector 32
    -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
-> Pipe
-> Pretext (->) (BitVector 32) (BitVector 32) Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BitVector 32
 -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
-> Rvfi -> Pretext (->) (BitVector 32) (BitVector 32) Rvfi
Lens' Rvfi (BitVector 32)
rvfiInsn ((BitVector 32
  -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
 -> Pipe -> Pretext (->) (BitVector 32) (BitVector 32) Pipe)
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
forall s (m :: Type -> Type) a b.
MonadState s m =>
ALens s s a b -> m b -> m b
<<~ Getting (BitVector 32) ToPipe (BitVector 32)
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting (BitVector 32) ToPipe (BitVector 32)
Lens' ToPipe (BitVector 32)
fromMem
  ASetter FromPipe FromPipe (First (Unsigned 5)) (First (Unsigned 5))
-> First (Unsigned 5) -> RWS ToPipe FromPipe Pipe ()
forall t (m :: Type -> Type) s a b.
(MonadWriter t m, Monoid s) =>
ASetter s t a b -> b -> m ()
scribe ASetter FromPipe FromPipe (First (Unsigned 5)) (First (Unsigned 5))
Lens' FromPipe (First (Unsigned 5))
toRs1Addr (First (Unsigned 5) -> RWS ToPipe FromPipe Pipe ())
-> (Unsigned 5 -> First (Unsigned 5))
-> Unsigned 5
-> RWS ToPipe FromPipe Pipe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Unsigned 5) -> First (Unsigned 5)
forall a. Maybe a -> First a
First (Maybe (Unsigned 5) -> First (Unsigned 5))
-> (Unsigned 5 -> Maybe (Unsigned 5))
-> Unsigned 5
-> First (Unsigned 5)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unsigned 5 -> Maybe (Unsigned 5)
forall a. a -> Maybe a
Just (Unsigned 5 -> RWS ToPipe FromPipe Pipe ())
-> RWST ToPipe FromPipe Pipe Identity (Unsigned 5)
-> RWS ToPipe FromPipe Pipe ()
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Rvfi -> Pretext (->) (Unsigned 5) (Unsigned 5) Rvfi)
-> Pipe -> Pretext (->) (Unsigned 5) (Unsigned 5) Pipe
Lens' Pipe Rvfi
exRvfi((Rvfi -> Pretext (->) (Unsigned 5) (Unsigned 5) Rvfi)
 -> Pipe -> Pretext (->) (Unsigned 5) (Unsigned 5) Pipe)
-> ((Unsigned 5
     -> Pretext (->) (Unsigned 5) (Unsigned 5) (Unsigned 5))
    -> Rvfi -> Pretext (->) (Unsigned 5) (Unsigned 5) Rvfi)
-> (Unsigned 5
    -> Pretext (->) (Unsigned 5) (Unsigned 5) (Unsigned 5))
-> Pipe
-> Pretext (->) (Unsigned 5) (Unsigned 5) Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Unsigned 5 -> Pretext (->) (Unsigned 5) (Unsigned 5) (Unsigned 5))
-> Rvfi -> Pretext (->) (Unsigned 5) (Unsigned 5) Rvfi
Lens' Rvfi (Unsigned 5)
rvfiRs1Addr ((Unsigned 5
  -> Pretext (->) (Unsigned 5) (Unsigned 5) (Unsigned 5))
 -> Pipe -> Pretext (->) (Unsigned 5) (Unsigned 5) Pipe)
-> RWST ToPipe FromPipe Pipe Identity (Unsigned 5)
-> RWST ToPipe FromPipe Pipe Identity (Unsigned 5)
forall s (m :: Type -> Type) a b.
MonadState s m =>
ALens s s a b -> m b -> m b
<<~ (Unsigned 5 -> Identity (Unsigned 5)) -> Pipe -> Identity Pipe
Lens' Pipe (Unsigned 5)
exRs1 ((Unsigned 5 -> Identity (Unsigned 5)) -> Pipe -> Identity Pipe)
-> Unsigned 5 -> RWST ToPipe FromPipe Pipe Identity (Unsigned 5)
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m b
<.= BitVector 32 -> Unsigned 5
sliceRs1 BitVector 32
mem
  ASetter FromPipe FromPipe (First (Unsigned 5)) (First (Unsigned 5))
-> First (Unsigned 5) -> RWS ToPipe FromPipe Pipe ()
forall t (m :: Type -> Type) s a b.
(MonadWriter t m, Monoid s) =>
ASetter s t a b -> b -> m ()
scribe ASetter FromPipe FromPipe (First (Unsigned 5)) (First (Unsigned 5))
Lens' FromPipe (First (Unsigned 5))
toRs2Addr (First (Unsigned 5) -> RWS ToPipe FromPipe Pipe ())
-> (Unsigned 5 -> First (Unsigned 5))
-> Unsigned 5
-> RWS ToPipe FromPipe Pipe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Unsigned 5) -> First (Unsigned 5)
forall a. Maybe a -> First a
First (Maybe (Unsigned 5) -> First (Unsigned 5))
-> (Unsigned 5 -> Maybe (Unsigned 5))
-> Unsigned 5
-> First (Unsigned 5)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unsigned 5 -> Maybe (Unsigned 5)
forall a. a -> Maybe a
Just (Unsigned 5 -> RWS ToPipe FromPipe Pipe ())
-> RWST ToPipe FromPipe Pipe Identity (Unsigned 5)
-> RWS ToPipe FromPipe Pipe ()
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Rvfi -> Pretext (->) (Unsigned 5) (Unsigned 5) Rvfi)
-> Pipe -> Pretext (->) (Unsigned 5) (Unsigned 5) Pipe
Lens' Pipe Rvfi
exRvfi((Rvfi -> Pretext (->) (Unsigned 5) (Unsigned 5) Rvfi)
 -> Pipe -> Pretext (->) (Unsigned 5) (Unsigned 5) Pipe)
-> ((Unsigned 5
     -> Pretext (->) (Unsigned 5) (Unsigned 5) (Unsigned 5))
    -> Rvfi -> Pretext (->) (Unsigned 5) (Unsigned 5) Rvfi)
-> (Unsigned 5
    -> Pretext (->) (Unsigned 5) (Unsigned 5) (Unsigned 5))
-> Pipe
-> Pretext (->) (Unsigned 5) (Unsigned 5) Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Unsigned 5 -> Pretext (->) (Unsigned 5) (Unsigned 5) (Unsigned 5))
-> Rvfi -> Pretext (->) (Unsigned 5) (Unsigned 5) Rvfi
Lens' Rvfi (Unsigned 5)
rvfiRs2Addr ((Unsigned 5
  -> Pretext (->) (Unsigned 5) (Unsigned 5) (Unsigned 5))
 -> Pipe -> Pretext (->) (Unsigned 5) (Unsigned 5) Pipe)
-> RWST ToPipe FromPipe Pipe Identity (Unsigned 5)
-> RWST ToPipe FromPipe Pipe Identity (Unsigned 5)
forall s (m :: Type -> Type) a b.
MonadState s m =>
ALens s s a b -> m b -> m b
<<~ (Unsigned 5 -> Identity (Unsigned 5)) -> Pipe -> Identity Pipe
Lens' Pipe (Unsigned 5)
exRs2 ((Unsigned 5 -> Identity (Unsigned 5)) -> Pipe -> Identity Pipe)
-> Unsigned 5 -> RWST ToPipe FromPipe Pipe Identity (Unsigned 5)
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m b
<.= BitVector 32 -> Unsigned 5
sliceRs2 BitVector 32
mem
  Bool
isFirstCycle  <- Getting Bool Pipe Bool -> RWST ToPipe FromPipe Pipe Identity Bool
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use (Getting Bool Pipe Bool -> RWST ToPipe FromPipe Pipe Identity Bool)
-> Getting Bool Pipe Bool
-> RWST ToPipe FromPipe Pipe Identity Bool
forall a b. (a -> b) -> a -> b
$ (Control -> Const Bool Control) -> Pipe -> Const Bool Pipe
Lens' Pipe Control
control((Control -> Const Bool Control) -> Pipe -> Const Bool Pipe)
-> ((Bool -> Const Bool Bool) -> Control -> Const Bool Control)
-> Getting Bool Pipe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool) -> Control -> Const Bool Control
Lens' Control Bool
firstCycle -- first memory output undefined
  Bool
isMeBranching <- Getting Bool Pipe Bool -> RWST ToPipe FromPipe Pipe Identity Bool
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use (Getting Bool Pipe Bool -> RWST ToPipe FromPipe Pipe Identity Bool)
-> Getting Bool Pipe Bool
-> RWST ToPipe FromPipe Pipe Identity Bool
forall a b. (a -> b) -> a -> b
$ (Control -> Const Bool Control) -> Pipe -> Const Bool Pipe
Lens' Pipe Control
control((Control -> Const Bool Control) -> Pipe -> Const Bool Pipe)
-> ((Bool -> Const Bool Bool) -> Control -> Const Bool Control)
-> Getting Bool Pipe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool) -> Control -> Const Bool Control
Lens' Control Bool
meBranching
  Bool
isWbMemory    <- Getting Bool Pipe Bool -> RWST ToPipe FromPipe Pipe Identity Bool
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use (Getting Bool Pipe Bool -> RWST ToPipe FromPipe Pipe Identity Bool)
-> Getting Bool Pipe Bool
-> RWST ToPipe FromPipe Pipe Identity Bool
forall a b. (a -> b) -> a -> b
$ (Control -> Const Bool Control) -> Pipe -> Const Bool Pipe
Lens' Pipe Control
control((Control -> Const Bool Control) -> Pipe -> Const Bool Pipe)
-> ((Bool -> Const Bool Bool) -> Control -> Const Bool Control)
-> Getting Bool Pipe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool) -> Control -> Const Bool Control
Lens' Control Bool
wbMemory
  Bool
isExLoad      <- Getting Bool Pipe Bool -> RWST ToPipe FromPipe Pipe Identity Bool
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use (Getting Bool Pipe Bool -> RWST ToPipe FromPipe Pipe Identity Bool)
-> Getting Bool Pipe Bool
-> RWST ToPipe FromPipe Pipe Identity Bool
forall a b. (a -> b) -> a -> b
$ (Control -> Const Bool Control) -> Pipe -> Const Bool Pipe
Lens' Pipe Control
control((Control -> Const Bool Control) -> Pipe -> Const Bool Pipe)
-> ((Bool -> Const Bool Bool) -> Control -> Const Bool Control)
-> Getting Bool Pipe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool) -> Control -> Const Bool Control
Lens' Control Bool
exLoad
  Bool
isExBranching <- LensLike' (Const Bool) Pipe (Maybe (BitVector 32))
-> (Maybe (BitVector 32) -> Bool)
-> RWST ToPipe FromPipe Pipe Identity Bool
forall s (m :: Type -> Type) r a.
MonadState s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
uses ((Control -> Const Bool Control) -> Pipe -> Const Bool Pipe
Lens' Pipe Control
control((Control -> Const Bool Control) -> Pipe -> Const Bool Pipe)
-> ((Maybe (BitVector 32) -> Const Bool (Maybe (BitVector 32)))
    -> Control -> Const Bool Control)
-> LensLike' (Const Bool) Pipe (Maybe (BitVector 32))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (BitVector 32) -> Const Bool (Maybe (BitVector 32)))
-> Control -> Const Bool Control
Lens' Control (Maybe (BitVector 32))
exBranching) Maybe (BitVector 32) -> Bool
forall a. Maybe a -> Bool
isJust
  let bubble :: Bool
bubble = Bool
isFirstCycle Bool -> Bool -> Bool
|| Bool
isMeBranching Bool -> Bool -> Bool
|| Bool
isWbMemory Bool -> Bool -> Bool
|| Bool
isExLoad Bool -> Bool -> Bool
|| Bool
isExBranching
  case BitVector 32 -> Either Exception ExInstr
parseInstr BitVector 32
mem of
    Right ExInstr
instr -> Bool -> RWS ToPipe FromPipe Pipe () -> RWS ToPipe FromPipe Pipe ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless Bool
bubble (RWS ToPipe FromPipe Pipe () -> RWS ToPipe FromPipe Pipe ())
-> RWS ToPipe FromPipe Pipe () -> RWS ToPipe FromPipe Pipe ()
forall a b. (a -> b) -> a -> b
$ do
      (Maybe ExInstr -> Identity (Maybe ExInstr))
-> Pipe -> Identity Pipe
Lens' Pipe (Maybe ExInstr)
exIR ((Maybe ExInstr -> Identity (Maybe ExInstr))
 -> Pipe -> Identity Pipe)
-> ExInstr -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= ExInstr
instr
      (Control -> Identity Control) -> Pipe -> Identity Pipe
Lens' Pipe Control
control((Control -> Identity Control) -> Pipe -> Identity Pipe)
-> ((Bool -> Identity Bool) -> Control -> Identity Control)
-> (Bool -> Identity Bool)
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Control -> Identity Control
Lens' Control Bool
deLoad ((Bool -> Identity Bool) -> Pipe -> Identity Pipe)
-> Bool -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= case ExInstr
instr of
        ExLoad{} -> Bool
True
        ExInstr
_        -> Bool
False
    Left Exception
IllegalInstruction -> do -- trap and instr=Nop (addi x0 x0 0)
      Bool -> RWS ToPipe FromPipe Pipe () -> RWS ToPipe FromPipe Pipe ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless Bool
bubble (RWS ToPipe FromPipe Pipe () -> RWS ToPipe FromPipe Pipe ())
-> RWS ToPipe FromPipe Pipe () -> RWS ToPipe FromPipe Pipe ()
forall a b. (a -> b) -> a -> b
$ (Maybe ExInstr -> Identity (Maybe ExInstr))
-> Pipe -> Identity Pipe
Lens' Pipe (Maybe ExInstr)
exIR ((Maybe ExInstr -> Identity (Maybe ExInstr))
 -> Pipe -> Identity Pipe)
-> ExInstr -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Op -> Unsigned 5 -> ExInstr
ExAlu Op
Add Unsigned 5
0
      (Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe
Lens' Pipe Rvfi
exRvfi((Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe)
-> ((Bool -> Identity Bool) -> Rvfi -> Identity Rvfi)
-> (Bool -> Identity Bool)
-> Pipe
-> Identity Pipe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Rvfi -> Identity Rvfi
Lens' Rvfi Bool
rvfiTrap ((Bool -> Identity Bool) -> Pipe -> Identity Pipe)
-> Bool -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
        
-- | fetch instruction
fetch :: RWS ToPipe FromPipe Pipe ()
fetch :: RWS ToPipe FromPipe Pipe ()
fetch = do
  ASetter FromPipe FromPipe (First ToMem) (First ToMem)
-> First ToMem -> RWS ToPipe FromPipe Pipe ()
forall t (m :: Type -> Type) s a b.
(MonadWriter t m, Monoid s) =>
ASetter s t a b -> b -> m ()
scribe ASetter FromPipe FromPipe (First ToMem) (First ToMem)
Lens' FromPipe (First ToMem)
toMem (First ToMem -> RWS ToPipe FromPipe Pipe ())
-> (BitVector 32 -> First ToMem)
-> BitVector 32
-> RWS ToPipe FromPipe Pipe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ToMem -> First ToMem
forall a. Maybe a -> First a
First (Maybe ToMem -> First ToMem)
-> (BitVector 32 -> Maybe ToMem) -> BitVector 32 -> First ToMem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToMem -> Maybe ToMem
forall a. a -> Maybe a
Just (ToMem -> Maybe ToMem)
-> (BitVector 32 -> ToMem) -> BitVector 32 -> Maybe ToMem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitVector 32 -> ToMem
instrMem (BitVector 32 -> RWS ToPipe FromPipe Pipe ())
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
-> RWS ToPipe FromPipe Pipe ()
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< Getting (BitVector 32) Pipe (BitVector 32)
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting (BitVector 32) Pipe (BitVector 32)
Lens' Pipe (BitVector 32)
fetchPC
  Bool
isMeMemory <- Getting Bool Pipe Bool -> RWST ToPipe FromPipe Pipe Identity Bool
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use (Getting Bool Pipe Bool -> RWST ToPipe FromPipe Pipe Identity Bool)
-> Getting Bool Pipe Bool
-> RWST ToPipe FromPipe Pipe Identity Bool
forall a b. (a -> b) -> a -> b
$ (Control -> Const Bool Control) -> Pipe -> Const Bool Pipe
Lens' Pipe Control
control((Control -> Const Bool Control) -> Pipe -> Const Bool Pipe)
-> ((Bool -> Const Bool Bool) -> Control -> Const Bool Control)
-> Getting Bool Pipe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool) -> Control -> Const Bool Control
Lens' Control Bool
meMemory
  Bool
isDeLoad   <- Getting Bool Pipe Bool -> RWST ToPipe FromPipe Pipe Identity Bool
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use (Getting Bool Pipe Bool -> RWST ToPipe FromPipe Pipe Identity Bool)
-> Getting Bool Pipe Bool
-> RWST ToPipe FromPipe Pipe Identity Bool
forall a b. (a -> b) -> a -> b
$ (Control -> Const Bool Control) -> Pipe -> Const Bool Pipe
Lens' Pipe Control
control((Control -> Const Bool Control) -> Pipe -> Const Bool Pipe)
-> ((Bool -> Const Bool Bool) -> Control -> Const Bool Control)
-> Getting Bool Pipe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool) -> Control -> Const Bool Control
Lens' Control Bool
deLoad
  Getting (Maybe (BitVector 32)) Pipe (Maybe (BitVector 32))
-> RWST ToPipe FromPipe Pipe Identity (Maybe (BitVector 32))
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use ((Control -> Const (Maybe (BitVector 32)) Control)
-> Pipe -> Const (Maybe (BitVector 32)) Pipe
Lens' Pipe Control
control((Control -> Const (Maybe (BitVector 32)) Control)
 -> Pipe -> Const (Maybe (BitVector 32)) Pipe)
-> ((Maybe (BitVector 32)
     -> Const (Maybe (BitVector 32)) (Maybe (BitVector 32)))
    -> Control -> Const (Maybe (BitVector 32)) Control)
-> Getting (Maybe (BitVector 32)) Pipe (Maybe (BitVector 32))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (BitVector 32)
 -> Const (Maybe (BitVector 32)) (Maybe (BitVector 32)))
-> Control -> Const (Maybe (BitVector 32)) Control
Lens' Control (Maybe (BitVector 32))
exBranching) RWST ToPipe FromPipe Pipe Identity (Maybe (BitVector 32))
-> (Maybe (BitVector 32) -> RWS ToPipe FromPipe Pipe ())
-> RWS ToPipe FromPipe Pipe ()
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just BitVector 32
npc -> (BitVector 32 -> Identity (BitVector 32)) -> Pipe -> Identity Pipe
Lens' Pipe (BitVector 32)
fetchPC ((BitVector 32 -> Identity (BitVector 32))
 -> Pipe -> Identity Pipe)
-> BitVector 32 -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= BitVector 32
npc
    Maybe (BitVector 32)
Nothing  -> Bool -> RWS ToPipe FromPipe Pipe () -> RWS ToPipe FromPipe Pipe ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (Bool
isMeMemory Bool -> Bool -> Bool
|| Bool
isDeLoad) (RWS ToPipe FromPipe Pipe () -> RWS ToPipe FromPipe Pipe ())
-> RWS ToPipe FromPipe Pipe () -> RWS ToPipe FromPipe Pipe ()
forall a b. (a -> b) -> a -> b
$ (BitVector 32 -> Identity (BitVector 32)) -> Pipe -> Identity Pipe
Lens' Pipe (BitVector 32)
dePC ((BitVector 32 -> Identity (BitVector 32))
 -> Pipe -> Identity Pipe)
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
-> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> m b -> m ()
<~ (BitVector 32 -> (BitVector 32, BitVector 32))
-> Pipe -> (BitVector 32, Pipe)
Lens' Pipe (BitVector 32)
fetchPC ((BitVector 32 -> (BitVector 32, BitVector 32))
 -> Pipe -> (BitVector 32, Pipe))
-> BitVector 32
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
forall s (m :: Type -> Type) a.
(MonadState s m, Num a) =>
LensLike' ((,) a) s a -> a -> m a
<<+= BitVector 32
4

-------------
-- Utility --
-------------

-- | forward register writes
fwd 
  :: Unsigned 5 
  -> BitVector 32 
  -> Maybe (Unsigned 5, BitVector 32) -- ^ meRegFwd
  -> Maybe (Unsigned 5, BitVector 32) -- ^ wbRegFwd
  -> BitVector 32
fwd :: Unsigned 5
-> BitVector 32
-> Maybe (Unsigned 5, BitVector 32)
-> Maybe (Unsigned 5, BitVector 32)
-> BitVector 32
fwd Unsigned 5
_    BitVector 32
wr Maybe (Unsigned 5, BitVector 32)
Nothing Maybe (Unsigned 5, BitVector 32)
Nothing = BitVector 32
wr
fwd Unsigned 5
addr BitVector 32
wr Maybe (Unsigned 5, BitVector 32)
Nothing (Just (Unsigned 5
wbAddr, BitVector 32
wbWr))
  | Unsigned 5
addr Unsigned 5 -> Unsigned 5 -> Bool
forall a. Eq a => a -> a -> Bool
== Unsigned 5
wbAddr = BitVector 32
wbWr
  | Bool
otherwise      = BitVector 32
wr
fwd Unsigned 5
addr BitVector 32
wr (Just (Unsigned 5
meAddr, BitVector 32
meWr)) Maybe (Unsigned 5, BitVector 32)
Nothing
  | Unsigned 5
addr Unsigned 5 -> Unsigned 5 -> Bool
forall a. Eq a => a -> a -> Bool
== Unsigned 5
meAddr = BitVector 32
meWr
  | Bool
otherwise      = BitVector 32
wr
fwd Unsigned 5
addr BitVector 32
wr (Just (Unsigned 5
meAddr, BitVector 32
meWr)) (Just (Unsigned 5
wbAddr, BitVector 32
wbWr))
  | Unsigned 5
addr Unsigned 5 -> Unsigned 5 -> Bool
forall a. Eq a => a -> a -> Bool
== Unsigned 5
meAddr = BitVector 32
meWr
  | Unsigned 5
addr Unsigned 5 -> Unsigned 5 -> Bool
forall a. Eq a => a -> a -> Bool
== Unsigned 5
wbAddr = BitVector 32
wbWr
  | Bool
otherwise      = BitVector 32
wr

-- | calcluate byte mask based on address
byteMask :: BitVector 32 -> BitVector 4
byteMask :: BitVector 32 -> BitVector 4
byteMask = (BitVector 4
1 BitVector 4 -> Int -> BitVector 4
forall a. Bits a => a -> Int -> a
`shiftL`) (Int -> BitVector 4)
-> (BitVector 32 -> Int) -> BitVector 32 -> BitVector 4
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitVector 64 -> Int
forall a. BitPack a => BitVector (BitSize a) -> a
unpack (BitVector 64 -> Int)
-> (BitVector 32 -> BitVector 64) -> BitVector 32 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitVector 2 -> BitVector 64
forall (f :: Nat -> Type) (a :: Nat) (b :: Nat).
(Resize f, KnownNat a, KnownNat b) =>
f a -> f b
resize (BitVector 2 -> BitVector 64)
-> (BitVector 32 -> BitVector 2) -> BitVector 32 -> BitVector 64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SNat 1 -> SNat 0 -> BitVector 32 -> BitVector ((1 + 1) - 0)
forall a (m :: Nat) (i :: Nat) (n :: Nat).
(BitPack a, BitSize a ~ ((m + 1) + i)) =>
SNat m -> SNat n -> a -> BitVector ((m + 1) - n)
slice SNat 1
d1 SNat 0
d0

-- | calculate half word mask based on address
halfMask :: BitVector 32 -> BitVector 4
halfMask :: BitVector 32 -> BitVector 4
halfMask BitVector 32
addr = if BitVector 32
addr BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Bits a => a -> a -> a
.&. BitVector 32
0x2 BitVector 32 -> BitVector 32 -> Bool
forall a. Eq a => a -> a -> Bool
== BitVector 32
0
                  then BitVector 4
0x3
                  else BitVector 4
0xC

-- | slice address based on mask
sliceByte :: BitVector 4 -> BitVector 32 -> BitVector 8
sliceByte :: BitVector 4 -> BitVector 32 -> BitVector 8
sliceByte = \case
  $(bitPattern "...1") -> SNat 7 -> SNat 0 -> BitVector 32 -> BitVector ((7 + 1) - 0)
forall a (m :: Nat) (i :: Nat) (n :: Nat).
(BitPack a, BitSize a ~ ((m + 1) + i)) =>
SNat m -> SNat n -> a -> BitVector ((m + 1) - n)
slice SNat 7
d7  SNat 0
d0
  $(bitPattern "..1.") -> SNat 15 -> SNat 8 -> BitVector 32 -> BitVector ((15 + 1) - 8)
forall a (m :: Nat) (i :: Nat) (n :: Nat).
(BitPack a, BitSize a ~ ((m + 1) + i)) =>
SNat m -> SNat n -> a -> BitVector ((m + 1) - n)
slice SNat 15
d15 SNat 8
d8
  $(bitPattern ".1..") -> SNat 23 -> SNat 16 -> BitVector 32 -> BitVector ((23 + 1) - 16)
forall a (m :: Nat) (i :: Nat) (n :: Nat).
(BitPack a, BitSize a ~ ((m + 1) + i)) =>
SNat m -> SNat n -> a -> BitVector ((m + 1) - n)
slice SNat 23
d23 SNat 16
d16
  $(bitPattern "1...") -> SNat 31 -> SNat 24 -> BitVector 32 -> BitVector ((31 + 1) - 24)
forall a (m :: Nat) (i :: Nat) (n :: Nat).
(BitPack a, BitSize a ~ ((m + 1) + i)) =>
SNat m -> SNat n -> a -> BitVector ((m + 1) - n)
slice SNat 31
d31 SNat 24
d24
  BitVector 4
_ -> BitVector 8 -> BitVector 32 -> BitVector 8
forall a b. a -> b -> a
const BitVector 8
0

-- | slice address based on mask
sliceHalf :: BitVector 4 -> BitVector 32 -> BitVector 16
sliceHalf :: BitVector 4 -> BitVector 32 -> BitVector 16
sliceHalf = \case
  $(bitPattern "..11") -> SNat 15 -> SNat 0 -> BitVector 32 -> BitVector ((15 + 1) - 0)
forall a (m :: Nat) (i :: Nat) (n :: Nat).
(BitPack a, BitSize a ~ ((m + 1) + i)) =>
SNat m -> SNat n -> a -> BitVector ((m + 1) - n)
slice SNat 15
d15 SNat 0
d0
  $(bitPattern "11..") -> SNat 31 -> SNat 16 -> BitVector 32 -> BitVector ((31 + 1) - 16)
forall a (m :: Nat) (i :: Nat) (n :: Nat).
(BitPack a, BitSize a ~ ((m + 1) + i)) =>
SNat m -> SNat n -> a -> BitVector ((m + 1) - n)
slice SNat 31
d31 SNat 16
d16
  BitVector 4
_ -> BitVector 16 -> BitVector 32 -> BitVector 16
forall a b. a -> b -> a
const BitVector 16
0

-- | check if memory address misaligned on word boundary
isMisaligned :: (Bits a, Num a) => a -> Bool
isMisaligned :: a -> Bool
isMisaligned a
a = a
a a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x3 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0

-- | check if memory address misaligned on half-word boundary
isMisalignedHalf :: (Bits a, Num a) => a -> Bool
isMisalignedHalf :: a -> Bool
isMisalignedHalf a
a = a
a a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0

-- | run monadic action when instruction is Just
withInstr :: MonadState s m => Lens' s (Maybe a) -> (a -> m ()) -> m ()
withInstr :: Lens' s (Maybe a) -> (a -> m ()) -> m ()
withInstr Lens' s (Maybe a)
l a -> m ()
k = Getting (Maybe a) s (Maybe a) -> m (Maybe a)
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting (Maybe a) s (Maybe a)
Lens' s (Maybe a)
l m (Maybe a) -> (Maybe a -> m ()) -> m ()
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> m ()) -> Maybe a -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> m ()
k

-- | Hazards Note
--
-- Key:
-- J  = JAL
-- JR = JALR
-- O  = Bubble
-- S  = Store
-- *  = Stall
-- B  = Branch
--
-- Jump/Branch
-- +----+------+------+------+----+
-- | IF |  DE  |  EX  |  ME  | WB |
-- +====+======+======+======+====+
-- | 4  | ---- | ---- | ---- | -- |
-- +----+------+------+------+----+
-- | 8  | JR20 | ---- | ---- | -- |
-- +----+------+------+------+----+
-- | 12 |  O   | JR20 | ---- | -- |
-- +----+------+------+------+----+
-- | 20 |  O   |  O   | JR20 | -- |
-- +----+------+------+------+----+
--
-- Store
-- +-------+------+------+------+----+
-- |  IF   | DE   |  EX  |  ME  | WB |
-- +=======+======+======+======+====+
-- | 4     | ---- | ---- | ---- | -- |
-- +-------+------+------+------+----+
-- | 8     |  S   | ---- | ---- | -- |
-- +-------+------+------+------+----+
-- | 12    | J100 |  S   | ---- | -- |
-- +-------+------+------+------+----+
-- | *16*  |  O   | J100 |  S   | -- |
-- +-------+------+------+------+----+
-- |  100  |  O   |  O   | J100 | S  |
-- +-------+------+------+------+----+
--
-- Load
-- +------+------+------+------+----+
-- | IF   |  DE  |  EX  |  ME  | WB |
-- +======+======+======+======+====+
-- | 4    | ---- | ---- | ---- | -- |
-- +------+------+------+------+----+
-- | *8*  |  L   | ---- | ---- | -- |
-- +------+------+------+------+----+
-- | 8    |  O   |  L   | ---- | -- |
-- +------+------+------+------+----+
-- | *12* | B100 |  O   |  L   | -- |
-- +------+------+------+------+----+
-- |  12  |  O   | B100 |  O   | L  |
-- +------+------+------+------+----+
-- | 100  |  O   |  O   | B100 | O  |
-- +------+------+------+------+----+