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