Greatly simpliflied tag engine to use stack implementation. Having trouble guarding on interface argument...
This commit is contained in:
parent
8e27ca877f
commit
c5ad62aaed
|
@ -7,55 +7,23 @@ 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
|
||||
let reifiedNumTags = fromInteger |> valueOf numTags
|
||||
|
||||
head :: Reg(TagPtr(numTags)) <- mkReg(SomeTagPtr(0))
|
||||
tail :: Reg(TagPtr(numTags)) <- mkReg(SomeTagPtr(lastIdx))
|
||||
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
|
||||
|
||||
|
@ -63,35 +31,37 @@ mkTagEngine =
|
|||
rules
|
||||
"display": when (debugOnce == True) ==>
|
||||
do
|
||||
$display (fshow tagVec)
|
||||
$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
|
||||
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
|
||||
stackPtr :=
|
||||
if sampledStackPtr == 0
|
||||
then Nothing
|
||||
else Just |> sampledStackPtr - 1
|
||||
(select inUseVec sampledStackPtr) := True
|
||||
return |> readReg (select freeStackVec sampledStackPtr)
|
||||
when
|
||||
SomeTagPtr ptr <- head
|
||||
Just sampledStackPtr <- stackPtr
|
||||
|
||||
retireTag :: UIntLog2N(numTags) -> Action
|
||||
retireTag tag = do
|
||||
-- placeholder
|
||||
counter := 0
|
||||
where
|
||||
lastIdx :: UIntLog2N(numTags) = (fromInteger |> valueOf numTags) - 1
|
||||
retireTag tag =
|
||||
do
|
||||
let nextStackPtrUint =
|
||||
case stackPtr of
|
||||
Nothing -> 0
|
||||
Just n -> n + 1
|
||||
(select inUseVec tag) := False
|
||||
(select freeStackVec nextStackPtrUint) := tag
|
||||
stackPtr := Just nextStackPtrUint
|
||||
-- when
|
||||
-- tag < (reifiedNumTags - 1),
|
||||
-- readReg (select inUseVec tag)
|
||||
|
|
|
@ -1,5 +1,7 @@
|
|||
package Util((|>), simulate_for) where
|
||||
|
||||
infixr 0 |>
|
||||
|
||||
(|>) :: (a -> b) -> a -> b
|
||||
f |> x = f x;
|
||||
|
||||
|
|
Loading…
Reference in a new issue