65 lines
2.2 KiB
Haskell
65 lines
2.2 KiB
Haskell
package Bus(mkBus) where
|
|
|
|
import Types
|
|
import BusTypes
|
|
import TagEngine
|
|
import Vector
|
|
import Util
|
|
import Arbiter
|
|
|
|
clientRequest :: Arbiter.ArbiterClient_IFC -> Action
|
|
clientRequest ifc = ifc.request
|
|
|
|
busRequestToAddr :: BusRequest -> Addr
|
|
busRequestToAddr req = case req of
|
|
BusReadRequest (ReadRequest addr _) -> addr
|
|
WriteReadRequest (WriteRequest addr _) -> addr
|
|
|
|
mkBus :: (Addr -> Integer)
|
|
-> Vector numClients (BusClient inFlightTransactions)
|
|
-> Vector numServers (BusServer inFlightTransactions numClients)
|
|
-> Module Empty
|
|
mkBus addrToServerTranslation clientVec serverVec = do
|
|
tagEngineByClientVec :: Vector numClients (TagEngine inFlightTransactions)
|
|
tagEngineByClientVec <- replicateM mkTagEngine
|
|
|
|
arbiterByServerVec :: Vector numServers (Arbiter_IFC numClients)
|
|
arbiterByServerVec <- replicateM (mkArbiter False)
|
|
|
|
-- statically determinate criteria
|
|
let
|
|
clientIdx :: Integer = 0
|
|
selectedClient ::(BusClient inFlightTransactions)
|
|
selectedClient = (select clientVec clientIdx)
|
|
selectedTagEngine = (select tagEngineByClientVec clientIdx)
|
|
|
|
addRules |>
|
|
rules
|
|
"placeholder rule": when True ==> do
|
|
let selectedServerArbiter = (select arbiterByServerVec 0)
|
|
mapM_ clientRequest selectedServerArbiter.clients
|
|
|
|
"connect request client 0":
|
|
when True
|
|
==> do
|
|
tag <- selectedTagEngine.requestTag
|
|
|
|
busRequest :: BusRequest
|
|
busRequest <- selectedClient.dequeueRequest tag
|
|
|
|
-- let
|
|
-- addr = busRequestToAddr busRequest
|
|
-- targetServerIdx = addrToServerTranslation addr
|
|
-- targetServer = (select serverVec targetServerIdx)
|
|
-- targetServerArbiter = (select arbiterByServerVec targetServerIdx)
|
|
|
|
-- targetServerArbiter.request
|
|
|
|
-- if targetServerArbiter.grant
|
|
-- then targetServer.enqueueRequest (tag, busRequest)
|
|
-- else action {}
|
|
|
|
-- targetServer
|
|
action {}
|
|
|
|
return $ interface Empty { }
|