diff --git a/bs/Bus/Bus.bs b/bs/Bus/Bus.bs index d409b29..cf1cafd 100644 --- a/bs/Bus/Bus.bs +++ b/bs/Bus/Bus.bs @@ -3,7 +3,9 @@ package Bus(mkBus, Bus(..)) where import Types import BusTypes import Client +import Server import TagEngine + import Vector import Util import Arbiter @@ -76,7 +78,7 @@ mkBus serverMap = do submitResponseQueues <- replicateM mkBypassFIFOF let clientRules :: Vector numClients (Rules) - clientRules = genWith $ \clientIdx -> + clientRules = genWith |> \clientIdx -> let selectedClientReqQueue :: FIFOF (TaggedBusRequest inFlightTransactions) selectedClientReqQueue = select clientRequestQueues clientIdx @@ -105,59 +107,37 @@ mkBus serverMap = do clientRouterRule <+> clientArbiterRule let serverRules :: Vector numServers (Rules) - serverRules = genWith $ \serverIdx -> - let - selectedServerArbiter :: Arbiter.Arbiter_IFC numClients - selectedServerArbiter = (select requestArbiterByServer serverIdx) + serverRules = genWith |> \serverIdx -> + let selectedServerArbiter :: Arbiter.Arbiter_IFC numClients + selectedServerArbiter = select requestArbiterByServer serverIdx - selectedConsumeRequestQueue :: FIFOF ( - MkClientTagType numClients, - TaggedBusRequest inFlightTransactions - ) - selectedConsumeRequestQueue = (select consumeRequestQueues serverIdx) + selectedConsumeReqQueue :: FIFOF (MkClientTagType numClients, TaggedBusRequest inFlightTransactions) + selectedConsumeReqQueue = select consumeRequestQueues serverIdx + + selectedSubmitRespQueue :: FIFOF (MkClientTagType numClients, TaggedBusResponse inFlightTransactions) + selectedSubmitRespQueue = select submitResponseQueues serverIdx + + serverRouterRule :: Rules + serverRouterRule = serverRouteResponse + serverIdx + selectedSubmitRespQueue + responseArbiterByClient + + serverArbiterRule :: Rules + serverArbiterRule = serverArbitRequests + serverIdx + selectedServerArbiter + selectedConsumeReqQueue + clientRequestQueues in - rules - (sprintf "server[%d] arbit requests" serverIdx): when True ==> do - let - grantedClientIdx :: MkClientTagType numClients - grantedClientIdx = unpack selectedServerArbiter.grant_id - - selectedClientRequestQueue :: FIFOF (TaggedBusRequest inFlightTransactions) - selectedClientRequestQueue = (select clientRequestQueues grantedClientIdx) - - clientRequest :: TaggedBusRequest inFlightTransactions - clientRequest = selectedClientRequestQueue.first - - selectedConsumeRequestQueue.enq (grantedClientIdx, clientRequest) - selectedClientRequestQueue.deq - - (sprintf "server[%d] route response" serverIdx): when True ==> do - let - selectedSubmitResponseQueue :: FIFOF ( - MkClientTagType numClients, - TaggedBusResponse inFlightTransactions - ) - selectedSubmitResponseQueue = (select submitResponseQueues serverIdx) - - response :: (MkClientTagType numClients, TaggedBusResponse inFlightTransactions) - response = selectedSubmitResponseQueue.first - - clientTag :: MkClientTagType numClients - clientTag = response.fst - - targetClientResponseArbiter :: Arbiter.Arbiter_IFC (TAdd numServers 1) - targetClientResponseArbiter = (select responseArbiterByClient clientTag) - - arbiterClientSlot :: Arbiter.ArbiterClient_IFC - arbiterClientSlot = (select targetClientResponseArbiter.clients serverIdx) - arbiterClientSlot.request + serverRouterRule <+> serverArbiterRule addRules |> foldr (<+>) (rules {}) clientRules addRules |> foldr (<+>) (rules {}) serverRules -- Client interface vector let clients :: Vector numClients (BusClient inFlightTransactions) - clients = genWith $ \clientIdx -> + clients = genWith |> \clientIdx -> let selectedClientRequestQueue :: FIFOF (TaggedBusRequest inFlightTransactions) selectedClientRequestQueue = (select clientRequestQueues clientIdx) @@ -188,7 +168,7 @@ mkBus serverMap = do -- Server interface vector let servers :: Vector numServers (BusServer inFlightTransactions numClients) - servers = genWith $ \serverIdx -> + servers = genWith |> \serverIdx -> let selectedConsumeRequestQueue :: FIFOF ( MkClientTagType numClients, @@ -217,7 +197,7 @@ mkBus serverMap = do selectedSubmitResponseQueue = (select submitResponseQueues serverIdx) selectedSubmitResponseQueue.enq (clientTag, taggedBusResponse) - return $ + return |> interface Bus clients = clients servers = servers diff --git a/bs/Bus/Server.bs b/bs/Bus/Server.bs new file mode 100644 index 0000000..794a161 --- /dev/null +++ b/bs/Bus/Server.bs @@ -0,0 +1,54 @@ +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 \ No newline at end of file