in theory bus is now complete

bs/Bus.bs

@@ -11,21 +11,16 @@ import FIFOF
 import SpecialFIFOs
 import Printf
 
-clientRequest :: Arbiter.ArbiterClient_IFC -> Action
-clientRequest ifc = ifc.request
-
 busRequestToAddr :: BusRequest -> Addr
 busRequestToAddr req = case req of
     BusReadRequest (ReadRequest addr _) -> addr
     BusWriteRequest (WriteRequest addr _) -> addr
 
-dummyRule :: Rules
-dummyRule =
-    rules
-        "test rule": when True ==> do
-            $display "test rule"
-
--- we need a way to make serverMap safer...
+-- Create a Bus Module that supports multiple clients and servers
+-- submitting requests and simultaneously returning responses.
+-- Responses can be consumed by clients out of order as all client
+-- submitted requests are tagged - and servers keep that tag
+-- when responding.
 mkBus :: (Add n (TLog numServers) (TLog (TAdd numServers 1)))
       => (Addr -> Maybe (MkServerIdx numServers))
       -> Module (Bus inFlightTransactions numClients numServers)
@@ -71,7 +66,12 @@ mkBus serverMap = do
                                         )
     consumeRequestQueues <- replicateM mkBypassFIFOF
 
-    submitResponseQueues :: Vector numServers (FIFOF (TaggedBusResponse inFlightTransactions))
+    submitResponseQueues :: Vector numServers (
+                                        FIFOF (
+                                            MkClientTagType numClients,
+                                            TaggedBusResponse inFlightTransactions
+                                            )
+                                        )
     submitResponseQueues <- replicateM mkBypassFIFOF
 
     let clientRules :: Vector numClients (Rules)
@@ -157,12 +157,15 @@ mkBus serverMap = do
                                 grantedServerIdx :: MkServerIdx numServers
                                 grantedServerIdx = truncate grantedIdx
 
-                                selectedSubmitResponseQueue :: FIFOF (TaggedBusResponse inFlightTransactions)
+                                selectedSubmitResponseQueue :: FIFOF (
+                                                                    MkClientTagType numClients,
+                                                                    TaggedBusResponse inFlightTransactions
+                                                                )
                                 selectedSubmitResponseQueue = (select submitResponseQueues grantedServerIdx)
 
-                                response :: TaggedBusResponse inFlightTransactions
+                                response :: (MkClientTagType numClients, TaggedBusResponse inFlightTransactions)
                                 response = selectedSubmitResponseQueue.first
-                            selectedClientResponseQueue.enq response
+                            selectedClientResponseQueue.enq response.snd
                             selectedSubmitResponseQueue.deq
 
     let serverRules :: Vector numServers (Rules)
@@ -178,7 +181,7 @@ mkBus serverMap = do
                 selectedConsumeRequestQueue = (select consumeRequestQueues serverIdx)
             in
                 rules
-                    (sprintf "server[%d] handle request" serverIdx): when True ==> do
+                    (sprintf "server[%d] arbit requests" serverIdx): when True ==> do
                         let
                             grantedClientIdx :: MkClientTagType numClients
                             grantedClientIdx = unpack selectedServerArbiter.grant_id
@@ -192,7 +195,29 @@ mkBus serverMap = do
                         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
+
     addRules |> foldr (<+>) (rules {}) clientRules
+    addRules |> foldr (<+>) (rules {}) serverRules
 
     -- Client interface vector
     let clients :: Vector numClients (BusClient inFlightTransactions)
@@ -248,7 +273,13 @@ mkBus serverMap = do
                                         TaggedBusResponse inFlightTransactions
                                         ) -> Action
                     submitResponse (clientTag, taggedBusResponse) = do
-                        dummyVar := (not dummyVar)
+                        let
+                            selectedSubmitResponseQueue :: FIFOF (
+                                                                MkClientTagType numClients,
+                                                                TaggedBusResponse inFlightTransactions
+                                                            )
+                            selectedSubmitResponseQueue = (select submitResponseQueues serverIdx)
+                        selectedSubmitResponseQueue.enq (clientTag, taggedBusResponse)
 
     return $
         interface Bus