54 lines
2.2 KiB
Haskell
54 lines
2.2 KiB
Haskell
package Server(
|
|
serverArbitRequests,
|
|
serverRouteResponse
|
|
) where
|
|
|
|
import Types
|
|
import BusTypes
|
|
import TagEngine
|
|
import Vector
|
|
import Util
|
|
import Arbiter
|
|
import FIFO
|
|
import FIFOF
|
|
import SpecialFIFOs
|
|
import Printf
|
|
|
|
serverArbitRequests :: Integer
|
|
-> Arbiter.Arbiter_IFC numClients
|
|
-> FIFOF (MkClientTagType numClients, TaggedBusRequest inFlightTransactions)
|
|
-> Vector numClients (FIFOF (TaggedBusRequest inFlightTransactions))
|
|
-> Rules
|
|
serverArbitRequests serverIdx serverArbiter consumeReqQueue clientReqQueues =
|
|
rules
|
|
(sprintf "server[%d] arbit requests" serverIdx): when True ==> do
|
|
let grantedClientIdx :: MkClientTagType numClients
|
|
grantedClientIdx = unpack serverArbiter.grant_id
|
|
|
|
selectedClientReqQueue :: FIFOF (TaggedBusRequest inFlightTransactions)
|
|
selectedClientReqQueue = select clientReqQueues grantedClientIdx
|
|
|
|
clientRequest :: TaggedBusRequest inFlightTransactions
|
|
clientRequest = selectedClientReqQueue.first
|
|
consumeReqQueue.enq (grantedClientIdx, clientRequest)
|
|
selectedClientReqQueue.deq
|
|
|
|
serverRouteResponse :: Integer
|
|
-> FIFOF (MkClientTagType numClients, TaggedBusResponse inFlightTransactions)
|
|
-> Vector numClients (Arbiter.Arbiter_IFC (TAdd numServers 1))
|
|
-> Rules
|
|
serverRouteResponse serverIdx submitRespQueue responseArbiterByClient =
|
|
rules
|
|
(sprintf "server[%d] route response" serverIdx): when True ==> do
|
|
let response :: (MkClientTagType numClients, TaggedBusResponse inFlightTransactions)
|
|
response = submitRespQueue.first
|
|
|
|
clientTag :: MkClientTagType numClients
|
|
clientTag = response.fst
|
|
|
|
targetClientRespArbiter :: Arbiter.Arbiter_IFC (TAdd numServers 1)
|
|
targetClientRespArbiter = select responseArbiterByClient clientTag
|
|
|
|
arbiterClientSlot :: Arbiter.ArbiterClient_IFC
|
|
arbiterClientSlot = select targetClientRespArbiter.clients serverIdx
|
|
arbiterClientSlot.request |