98 lines
2.9 KiB
Haskell
98 lines
2.9 KiB
Haskell
package TagEngine(
|
|
TagEngine(..),
|
|
mkTagEngine) where
|
|
|
|
import Vector
|
|
import Util
|
|
|
|
#define UIntLog2N(n) (UInt (TLog n))
|
|
|
|
data Tag numTags
|
|
= Next UIntLog2N(numTags)
|
|
| Freed
|
|
| Tail
|
|
deriving (Bits, Eq, FShow)
|
|
|
|
data TagPtr numTags
|
|
= SomeTagPtr UIntLog2N(numTags)
|
|
| None
|
|
deriving (Bits, Eq, FShow)
|
|
|
|
interface (TagEngine :: # -> *) numTags =
|
|
requestTag :: ActionValue UIntLog2N(numTags)
|
|
retireTag :: UIntLog2N(numTags) -> Action
|
|
|
|
instance FShow (Reg (Tag numTags)) where
|
|
fshow value = fshow (readReg value)
|
|
|
|
initTagNext :: Integer -> Module(Reg (Tag numTags))
|
|
initTagNext i = do
|
|
t :: Reg (Tag numTags)
|
|
t <- mkReg (Next (fromInteger i))
|
|
return t
|
|
|
|
initTagTail :: Module(Reg (Tag numTags))
|
|
initTagTail = do
|
|
t :: Reg (Tag numTags)
|
|
t <- mkReg Tail
|
|
return t
|
|
|
|
initTagVec :: Module(Vector numTags (Reg (Tag numTags)))
|
|
initTagVec =
|
|
let
|
|
lastIdx :: Integer = (fromInteger |> valueOf numTags) - 1
|
|
initByIdx currIdx =
|
|
if (currIdx < lastIdx)
|
|
then initTagNext (currIdx + 1)
|
|
else initTagTail
|
|
in
|
|
mapM initByIdx genVector
|
|
|
|
mkTagEngine :: Module (TagEngine numTags)
|
|
mkTagEngine =
|
|
do
|
|
tagVec :: Vector numTags (Reg (Tag numTags))
|
|
tagVec <- initTagVec
|
|
|
|
head :: Reg(TagPtr(numTags)) <- mkReg(SomeTagPtr(0))
|
|
tail :: Reg(TagPtr(numTags)) <- mkReg(SomeTagPtr(lastIdx))
|
|
|
|
debugOnce <- mkReg True
|
|
|
|
addRules $
|
|
rules
|
|
"display": when (debugOnce == True) ==>
|
|
do
|
|
$display (fshow tagVec)
|
|
debugOnce := False
|
|
|
|
counter <- mkReg(0 :: UIntLog2N(numTags))
|
|
return $
|
|
interface TagEngine
|
|
requestTag :: ActionValue UIntLog2N(numTags)
|
|
requestTag =
|
|
do
|
|
let currHeadPtr :: UIntLog2N(numTags) =
|
|
case head of
|
|
SomeTagPtr ptr -> ptr
|
|
-- we technically will never hit this arm
|
|
-- due to when guard `SomeTagPtr ptr <- head`
|
|
None -> 0
|
|
let currHead :: (Reg (Tag numTags)) = (select tagVec currHeadPtr)
|
|
let nextHeadPtr :: UIntLog2N(numTags) =
|
|
case currHead of
|
|
Next ptr -> ptr
|
|
-- TODO : handle tail correctly
|
|
Tail -> 0
|
|
currHead := Freed
|
|
head := SomeTagPtr(nextHeadPtr)
|
|
return nextHeadPtr
|
|
when
|
|
SomeTagPtr ptr <- head
|
|
retireTag :: UIntLog2N(numTags) -> Action
|
|
retireTag tag = do
|
|
-- placeholder
|
|
counter := 0
|
|
where
|
|
lastIdx :: UIntLog2N(numTags) = (fromInteger |> valueOf numTags) - 1
|