128 lines
5.2 KiB
Haskell
128 lines
5.2 KiB
Haskell
package TagEngine(
|
|
TagEngine(..),
|
|
Util.BasicResult(..),
|
|
mkTagEngine) where
|
|
|
|
import Vector
|
|
import Util
|
|
|
|
#define UIntLog2N(n) (UInt (TLog n))
|
|
|
|
interface (TagEngine :: # -> *) numTags =
|
|
requestTag :: ActionValue (Maybe UIntLog2N(numTags))
|
|
retireTag :: UIntLog2N(numTags) -> ActionValue BasicResult
|
|
|
|
-- The tag engine returns a tag that is unique for the duration of
|
|
-- the lifetime of the tag. Useful when you need to tag transactions
|
|
-- on a bus for example.
|
|
-- This implementation is stack based.
|
|
mkTagEngine :: Module (TagEngine numTags)
|
|
mkTagEngine =
|
|
do
|
|
|
|
let reifiedNumTags = fromInteger |> valueOf numTags
|
|
|
|
freeStackVec :: Vector numTags (Reg UIntLog2N(numTags))
|
|
freeStackVec <- mapM (\i -> mkReg |> fromInteger i) genVector
|
|
|
|
inUseVec :: Vector numTags (Reg Bool)
|
|
inUseVec <- replicateM |> mkReg False
|
|
|
|
stackPtr :: (Reg (Maybe(UIntLog2N(numTags))))
|
|
stackPtr <- mkReg |> Just |> reifiedNumTags - 1
|
|
|
|
methodRequestTagCalled :: PulseWire
|
|
methodRequestTagCalled <- mkPulseWire
|
|
|
|
methodRetireTagCalledValid :: RWire UIntLog2N(numTags)
|
|
methodRetireTagCalledValid <- mkUnsafeRWire
|
|
-- methodRetireTagCalledValid <- mkRWireSBR
|
|
|
|
computedTagResult :: Wire (Maybe UIntLog2N(numTags))
|
|
computedTagResult <- mkBypassWire
|
|
|
|
debugOnce <- mkReg True
|
|
|
|
addRules $
|
|
rules
|
|
"display": when (debugOnce == True) ==>
|
|
do
|
|
$display "freeStackVec : " (fshow |> readVReg freeStackVec)
|
|
$display "inUseVec : " (fshow |> readVReg inUseVec)
|
|
$display "stackPtr : " (fshow stackPtr)
|
|
debugOnce := False
|
|
|
|
"update stack pointer": when True ==>
|
|
do
|
|
stackPtr :=
|
|
case (methodRequestTagCalled, methodRetireTagCalledValid.wget) of
|
|
(True, Just _) -> stackPtr
|
|
(True, Nothing) ->
|
|
case stackPtr of
|
|
Just 0 -> Nothing
|
|
Just sampledStackPtr -> Just |> sampledStackPtr - 1
|
|
Nothing -> Nothing
|
|
(False, Just _) ->
|
|
case stackPtr of
|
|
Just sampledStackPtr -> Just |> sampledStackPtr + 1
|
|
Nothing -> Nothing
|
|
(False, Nothing) -> stackPtr
|
|
|
|
"update free stack": when True ==>
|
|
do
|
|
case (methodRequestTagCalled, methodRetireTagCalledValid.wget) of
|
|
(True, Just _) -> do action {}
|
|
(True, Nothing) -> do action {}
|
|
(False, Just tag) -> do
|
|
case stackPtr of
|
|
Just sampledStackPtr -> do
|
|
(select freeStackVec (sampledStackPtr + 1)) := tag
|
|
Nothing -> do
|
|
(select freeStackVec 0) := tag
|
|
(False, Nothing) -> do action {}
|
|
|
|
"update in use": when True ==>
|
|
do
|
|
case (methodRequestTagCalled, methodRetireTagCalledValid.wget) of
|
|
(True, Just _) -> do action {}
|
|
(True, Nothing) ->
|
|
case stackPtr of
|
|
Just sampledStackPtr -> do
|
|
(select inUseVec sampledStackPtr) := True
|
|
Nothing -> do action {}
|
|
(False, Just tag) -> do
|
|
(select inUseVec tag) := False
|
|
(False, Nothing) -> do action {}
|
|
|
|
"compute tag": when True ==>
|
|
computedTagResult :=
|
|
case methodRetireTagCalledValid.wget of
|
|
Just tag -> Just tag
|
|
Nothing ->
|
|
case stackPtr of
|
|
Just sampledStackPtr ->
|
|
Just |> readReg (select freeStackVec sampledStackPtr)
|
|
Nothing -> Nothing
|
|
|
|
return $
|
|
interface TagEngine
|
|
|
|
requestTag :: ActionValue (Maybe UIntLog2N(numTags))
|
|
requestTag =
|
|
do
|
|
methodRequestTagCalled.send
|
|
return computedTagResult
|
|
|
|
retireTag :: UIntLog2N(numTags) -> ActionValue BasicResult
|
|
retireTag tag =
|
|
do
|
|
let
|
|
tagValid = tag < reifiedNumTags
|
|
tagInUse = readReg (select inUseVec tag)
|
|
if (tagValid && tagInUse)
|
|
then do
|
|
methodRetireTagCalledValid.wset tag
|
|
return Success
|
|
else do
|
|
return Failure
|