package TagEngine(
    TagEngine(..),
    Util.BasicResult(..),
    mkTagEngine) where

import Vector
import Util

#define UIntLog2N(n) (UInt (TLog n))

interface (TagEngine :: # -> *) numTags =
    requestTag :: ActionValue 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

        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

        counter <- mkReg(0 :: UIntLog2N(numTags))
        return $
          interface TagEngine

            requestTag :: ActionValue UIntLog2N(numTags)
            requestTag =
                do
                    stackPtr :=
                        if sampledStackPtr == 0
                            then Nothing
                            else Just |> sampledStackPtr - 1
                    (select inUseVec sampledStackPtr) := True
                    return |> readReg (select freeStackVec sampledStackPtr)
                when
                    Just sampledStackPtr <- stackPtr

            -- retireTag isn't guarded so its up to external module to only attempt to
            -- retire valid tags... At any rate, we can notify the requestor of failures
            -- to retire tags - although the requestor can merely ignore this
            -- notification.
            retireTag :: UIntLog2N(numTags) -> ActionValue BasicResult
            retireTag tag =
                do
                    let
                        tagValid = tag < reifiedNumTags
                        tagInUse = readReg (select inUseVec tag)
                        nextStackPtrUint =
                            case stackPtr of
                                Nothing -> 0
                                Just n -> n + 1
                    if (tagValid && tagInUse)
                        then do
                            (select inUseVec tag) := False
                            (select freeStackVec nextStackPtrUint) := tag
                            stackPtr := Just nextStackPtrUint
                            return Success
                        else do
                            return Failure