{-|
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 inputs
data ToPipe = ToPipe
  { ToPipe -> BitVector 32
_fromRs1 :: BitVector 32
  , ToPipe -> BitVector 32
_fromRs2 :: 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 bus
--
--   Lion has a shared instruction/memory bus
data ToMem = InstrMem         -- ^ instruction read
               (BitVector 32) -- ^ instruction address
           | DataMem                  -- ^ data access
               (BitVector 32)         -- ^ data address
               (BitVector 4)          -- ^ data byte mask
               (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

-- | 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 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)
_branching  :: Maybe (BitVector 32)             -- ^ execute stage branch
  , 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
-> Maybe (Unsigned 5, BitVector 32)
-> Maybe (Unsigned 5, BitVector 32)
-> Control
Control 
  { _firstCycle :: Bool
_firstCycle = Bool
True   
  , _branching :: Maybe (BitVector 32)
_branching  = Maybe (BitVector 32)
forall a. Maybe a
Nothing
  , _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 :: BitVector 32 -> Pipe
mkPipe :: BitVector 32 -> Pipe
mkPipe BitVector 32
start = 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 = BitVector 32
start  

  -- 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
  => BitVector 32
  -> Signal dom ToPipe
  -> Signal dom FromPipe
pipe :: BitVector 32 -> Signal dom ToPipe -> Signal dom FromPipe
pipe BitVector 32
start = (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 (BitVector 32 -> Pipe
mkPipe BitVector 32
start)
  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) 

-- | reset control signals (except first cycle)
resetControl :: MonadState Pipe m => m ()
resetControl :: m ()
resetControl = do
  (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))
branching ((Maybe (BitVector 32) -> Identity (Maybe (BitVector 32)))
 -> Pipe -> Identity Pipe)
-> Maybe (BitVector 32) -> m ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (BitVector 32)
forall a. Maybe a
Nothing
  (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 -> m ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
  (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 -> m ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
  (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 -> m ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
  (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 -> m ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
  (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)
-> Maybe (Unsigned 5, BitVector 32) -> m ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (Unsigned 5, BitVector 32)
forall a. Maybe a
Nothing
  (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) -> m ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (Unsigned 5, BitVector 32)
forall a. Maybe a
Nothing

-- | Monadic pipeline
pipeM :: RWS ToPipe FromPipe Pipe ()
pipeM :: RWS ToPipe FromPipe Pipe ()
pipeM = do
  RWS ToPipe FromPipe Pipe ()
forall (m :: Type -> Type). MonadState Pipe m => m ()
resetControl
  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

-- | 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 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 -> BitVector (24 + 8))
-> BitVector 8 -> BitVector (24 + 8)
forall a b. (a -> b) -> a -> b
$ BitVector 4 -> BitVector 32 -> BitVector 8
sliceByte BitVector 4
mask BitVector 32
mem
            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 -> BitVector (16 + 16))
-> BitVector 16 -> BitVector (16 + 16)
forall a b. (a -> b) -> a -> b
$ BitVector 4 -> BitVector 32 -> BitVector 16
sliceHalf BitVector 4
mask BitVector 32
mem
            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 -> BitVector (24 + 8))
-> BitVector 8 -> BitVector (24 + 8)
forall a b. (a -> b) -> a -> b
$ BitVector 4 -> BitVector 32 -> BitVector 8
sliceByte BitVector 4
mask BitVector 32
mem
            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 -> BitVector (16 + 16))
-> BitVector 16 -> BitVector (16 + 16)
forall a b. (a -> b) -> a -> b
$ BitVector 4 -> BitVector 32 -> BitVector 16
sliceHalf BitVector 4
mask BitVector 32
mem
      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
    MeRegWr Unsigned 5
rd BitVector 32
wr -> do
      (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
    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
    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
  (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 -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= 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 -> case ExOp
op of
      ExOp
Lui -> (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
MeRegWr Unsigned 5
rd BitVector 32
imm
      ExOp
Auipc -> (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
MeRegWr Unsigned 5
rd (BitVector 32
pc BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Num a => a -> a -> a
+ BitVector 32
imm) 
      ExOp
Jal -> do
        BitVector 32
npc <- (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
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
npc BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Bits a => a -> a -> a
.&. BitVector 32
0x3 BitVector 32 -> BitVector 32 -> Bool
forall a. Eq a => a -> a -> Bool
/= BitVector 32
0)
        (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))
branching ((Maybe (BitVector 32) -> Identity (Maybe (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 (Maybe b) -> b -> m ()
?= 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
MeRegWr Unsigned 5
rd (BitVector 32
pc BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Num a => a -> a -> a
+ BitVector 32
4)
      ExOp
Jalr -> do
        BitVector 32
npc <- (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 -> 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
npc BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Bits a => a -> a -> a
.&. BitVector 32
0x3 BitVector 32 -> BitVector 32 -> Bool
forall a. Eq a => a -> a -> Bool
/= BitVector 32
0)
        (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))
branching ((Maybe (BitVector 32) -> Identity (Maybe (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 (Maybe b) -> b -> m ()
?= 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
MeRegWr Unsigned 5
rd (BitVector 32
pc BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Num a => a -> a -> a
+ BitVector 32
4)
    ExBranch Branch
op 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
<<~ if Branch -> BitVector 32 -> BitVector 32 -> Bool
branch Branch
op BitVector 32
rs1Data BitVector 32
rs2Data
                                      then (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))
branching ((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)
                                      else BitVector 32 -> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BitVector 32 -> RWST ToPipe FromPipe Pipe Identity (BitVector 32))
-> BitVector 32
-> RWST ToPipe FromPipe Pipe Identity (BitVector 32)
forall a b. (a -> b) -> a -> b
$ BitVector 32
pc BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Num a => a -> a -> a
+ BitVector 32
4
      (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
npc BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Bits a => a -> a -> a
.&. BitVector 32
0x3 BitVector 32 -> BitVector 32 -> Bool
forall a. Eq a => a -> a -> Bool
/= BitVector 32
0)
      (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
addr BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Bits a => a -> a -> a
.&. BitVector 32
0x1 BitVector 32 -> BitVector 32 -> Bool
forall a. Eq a => a -> a -> Bool
/= BitVector 32
0) -- 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
addr BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Bits a => a -> a -> a
.&. BitVector 32
0x3 BitVector 32 -> BitVector 32 -> Bool
forall a. Eq a => a -> a -> Bool
/= BitVector 32
0) -- 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
addr BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Bits a => a -> a -> a
.&. BitVector 32
0x1 BitVector 32 -> BitVector 32 -> Bool
forall a. Eq a => a -> a -> Bool
/= BitVector 32
0) -- 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
addr BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Bits a => a -> a -> a
.&. BitVector 32
0x3 BitVector 32 -> BitVector 32 -> Bool
forall a. Eq a => a -> a -> Bool
/= BitVector 32
0) -- 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     -> (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
MeRegWr Unsigned 5
rd (Op -> BitVector 32 -> BitVector 32 -> BitVector 32
alu Op
op BitVector 32
rs1Data BitVector 32
rs2Data)
    ExAluImm Op
op Unsigned 5
rd 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 -> BitVector 32 -> MeInstr
MeRegWr Unsigned 5
rd (Op -> BitVector 32 -> BitVector 32 -> BitVector 32
alu Op
op BitVector 32
rs1Data BitVector 32
imm)
  where
    guardZero :: 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)
rsAddr BitVector 32
rsValue = 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)
rsAddr (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
rsValue
    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

-- | 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
  Bool
isFirstCycle <- (Control -> (Bool, Control)) -> Pipe -> (Bool, Pipe)
Lens' Pipe Control
control((Control -> (Bool, Control)) -> Pipe -> (Bool, Pipe))
-> ((Bool -> (Bool, Bool)) -> Control -> (Bool, Control))
-> (Bool -> (Bool, Bool))
-> Pipe
-> (Bool, Pipe)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> (Bool, Bool)) -> Control -> (Bool, Control)
Lens' Control Bool
firstCycle ((Bool -> (Bool, Bool)) -> Pipe -> (Bool, Pipe))
-> Bool -> RWST ToPipe FromPipe Pipe Identity Bool
forall s (m :: Type -> Type) a b.
MonadState s m =>
LensLike ((,) a) s s a b -> b -> m a
<<.= Bool
False -- first memory output undefined
  Bool
isBranching  <- 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))
branching) Maybe (BitVector 32) -> Bool
forall a. Maybe a -> Bool
isJust
  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 -> RWS ToPipe FromPipe Pipe () -> RWS ToPipe FromPipe Pipe ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (Bool
isFirstCycle Bool -> Bool -> Bool
|| Bool
isBranching Bool -> Bool -> Bool
|| Bool
isWbMemory Bool -> Bool -> Bool
|| Bool
isExLoad) (RWS ToPipe FromPipe Pipe () -> RWS ToPipe FromPipe Pipe ())
-> RWS ToPipe FromPipe Pipe () -> RWS ToPipe FromPipe Pipe ()
forall a b. (a -> b) -> a -> b
$ do
    BitVector 32
mem <- 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
    case BitVector 32 -> Either Exception ExInstr
parseInstr BitVector 32
mem of
      Right ExInstr
instr -> 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
        (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
        (Rvfi -> Identity Rvfi) -> Pipe -> Identity Pipe
Lens' Pipe Rvfi
exRvfi((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)
rvfiInsn ((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
mem
        (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 Load
_ Unsigned 5
_ BitVector 32
_ -> Bool
True
          ExInstr
_ -> Bool
False
        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
      Left Exception
IllegalInstruction -> (BitVector 32 -> Identity (BitVector 32)) -> Pipe -> Identity Pipe
Lens' Pipe (BitVector 32)
fetchPC ((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 -- roll-back PC, should handle trap
        

-- | fetch instruction
--   stalled when instruction in memory stage needs bus  
fetch :: RWS ToPipe FromPipe Pipe ()
fetch :: RWS ToPipe FromPipe Pipe ()
fetch = do
  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))
branching) 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
>>= (BitVector 32 -> RWS ToPipe FromPipe Pipe ())
-> Maybe (BitVector 32) -> RWS ToPipe FromPipe Pipe ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (((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 ()
assign (BitVector 32 -> Identity (BitVector 32)) -> Pipe -> Identity Pipe
Lens' Pipe (BitVector 32)
fetchPC)
  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
=<< (BitVector 32
 -> Pretext (->) (BitVector 32) (BitVector 32) (BitVector 32))
-> Pipe -> Pretext (->) (BitVector 32) (BitVector 32) Pipe
Lens' Pipe (BitVector 32)
dePC ((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)
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
  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)
fetchPC ((BitVector 32 -> Identity (BitVector 32))
 -> Pipe -> Identity Pipe)
-> BitVector 32 -> RWS ToPipe FromPipe Pipe ()
forall s (m :: Type -> Type) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= 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 "0001") -> 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 "0010") -> 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 "0100") -> 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 "1000") -> 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 "0011") -> 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 "1100") -> 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

-- | 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 = Jump
-- O = Bubble
-- S = Store
-- * = Stall
-- B = Branch
-- 
-- Jump/Branch
-- +----+-----+-----+----+----+
-- | IF | DE  | EX  | ME | WB |
-- +====+=====+=====+====+====+
-- | 4  | --- | --- | -- | -- |   
-- +----+-----+-----+----+----+
-- | 8  | J15 | --- | -- | -- |
-- +----+-----+-----+----+----+
-- | 15 |  O  | J15 | -- | -- |
-- +----+-----+-----+----+----+
--
-- Store
-- +-------+------+------+------+----+
-- |  IF   | DE   |  EX  |  ME  | WB |
-- +=======+======+======+======+====+
-- | 4     | ---- | ---- | ---- | -- |
-- +-------+------+------+------+----+
-- | 8     |  S   | ---- | ---- | -- |
-- +-------+------+------+------+----+
-- | 12    | J100 |  S   | ---- | -- |
-- +-------+------+------+------+----+
-- | *100* |  O   | J100 |  S   | -- |
-- +-------+------+------+------+----+
-- |  100  |  O   |  O   | J100 | S  |
-- +-------+------+------+------+----+
--
-- Load
-- +------+------+------+----+----+
-- | IF   |  DE  |  EX  | ME | WB |
-- +======+======+======+====+====+
-- | 4    | ---- | ---- | -- | -- |
-- +------+------+------+----+----+
-- | *8*  |  L   | ---- | -- | -- |
-- +------+------+------+----+----+
-- | 8    |  O   |  L   | -- | -- |
-- +------+------+------+----+----+
-- | *12* | B100 |  O   | L  | -- |
-- +------+------+------+----+----+
-- | 100  |  O   | B100 | O  | L  |
-- +------+------+------+----+----+