refactored server functions as well
This commit is contained in:
Yehowshua Immanuel
parent
2fee6a3bd8
commit
a58c908763
|
|
@ -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
|
||||
|
|
|
|||
54
bs/Bus/Server.bs
Normal file
54
bs/Bus/Server.bs
Normal file
|
|
@ -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
|
||||
Loading…
Reference in a new issue