From da761f6e4ec6fe3b3f28431919cc6d3cfb0cbaee Mon Sep 17 00:00:00 2001 From: Yehowshua Immanuel Date: Tue, 8 Apr 2025 13:05:34 -0400 Subject: [PATCH 01/23] Type system progress on bus design --- bs/Bus.bs | 13 ++++++++++ bs/BusTypes.bs | 66 ++++++++++++++++++++++++++++++++++++-------------- 2 files changed, 61 insertions(+), 18 deletions(-) diff --git a/bs/Bus.bs b/bs/Bus.bs index 0faaa54..87ca6ff 100644 --- a/bs/Bus.bs +++ b/bs/Bus.bs @@ -3,5 +3,18 @@ package Bus(a) where import Types import BusTypes +interface (TestType :: * -> *) t = {} + -- doSomething :: t -> Action + +mkTestType :: (Bits t n, Arith t, Eq t) => Module (TestType t) +mkTestType = do + return $ interface TestType {} + +mkTestTop :: Module Empty +mkTestTop = do + testType :: TestType (UInt 5) + testType <- mkTestType + return $ interface Empty { } + a :: UInt 5 a = 3 diff --git a/bs/BusTypes.bs b/bs/BusTypes.bs index 99d0fb4..e6943c5 100644 --- a/bs/BusTypes.bs +++ b/bs/BusTypes.bs @@ -1,12 +1,12 @@ package BusTypes( - BusVal(..), - BusError(..), - TransactionSize(..), - ReadRequest(..), - WriteRequest(..) + BusClient(..), BusServer(..), + BusRequest(..), BusResponse(..), + ReadRequest(..), ReadResponse(..), WriteRequest(..), WriteResponse(..), + BusVal(..), BusError(..), TransactionSize(..) ) where import Types +import Vector data BusError = UnMapped @@ -48,21 +48,51 @@ data BusResponse | BusWriteResponse WriteResponse deriving (Bits, Eq, FShow) -interface BusMaster = - -- The Bus arbiter will call the Bus Master's request method - -- if and only if it's the Bus Master's turn to make a request, and the Bus Master - -- has a request to make. - -- It is up to the BusMaster to guard it's request method such that calling - -- it's request method is only valid when the BusMaster has a request to make. - -- This has implications about for the implementor of BusMaster, namely, that it - -- should hold its request until it's request method gets called. - request :: BusRequest - -- From the masters's perspective, the response should not be called by the - -- arbiter until the master is ready to accept the response. In other words, - -- response should be guarded by the client. - response :: BusResponse -> Action +-- # BusClient.dequeueRequest +-- * The Bus arbiter will call the Bus Client's request method if it is +-- the Bus Client's turn to make a request, or if another client forfits +-- its turn. +-- * The BusClient must guard its request method such that calling its +-- request method is only valid when the BusClient has a request to make. +-- * This has implications about for the implementor of BusClient, +-- namely, that it should hold its request until it's request method +-- gets called. The arbiter tags the request so that the client can +-- later correctly correlate the response. +-- * Although the tag is technically passed in as an argument from the +-- arbiter to the client's request method, given that methods are +-- atomic in Bluespec, this is effectively equivalent to tagging the +-- transaction from the client's perspective. Thus, the client must +-- take care to appropiately store the tag. +-- # BusClient.enqueueResponse +-- * From the client's perspective, the response should not be called +-- by the arbiter until the client is ready to accept the response. +-- In other words, the response method should be guarded by the client. +interface (BusClient :: * -> *) transactionTagType = + dequeueRequest :: transactionTagType -> ActionValue BusRequest + enqueueResponse :: (BusResponse, transactionTagType) -> Action + +-- # BusServer.dequeueResponse +-- * If the arbiter is able to successfully call `dequeueResponse`, then +-- the BusServer's internal logici must update such that it understand +-- the response has been handed off. +-- # BusServer.peekClientTagDestination +-- * The arbiter looks at (peekClientTagDestination :: clientTagTye) to +-- determine whether or not it is currently safe whether to dequeue the +-- response as well as where to route the response should it dequeue the +-- response. +-- * `peekClientTagDestination` should be guarded on whether or not there is +-- a valid response available. +interface (BusServer :: * -> * -> *) transactionTagType clientTagType = + enqueueRequest :: (transactionTagType, BusRequest) -> Action + dequeueResponse :: ActionValue (clientTagType, BusResponse, transactionTagType) + peekClientTagDestination :: clientTagTye + +interface (Bus :: # -> # -> * -> * -> *) numClients numServers transactionTagType clientTagType = + clients :: Vector numClients (BusClient transactionTagType) + servers :: Vector numServers (BusServer transactionTagType clientTagType) type Token = UInt 5 +type Numeric = 5 a :: UInt 5 a = 3 -- 2.48.1 From fe2fa21fcc57d03477e82ef0bfa9281de8ea1b10 Mon Sep 17 00:00:00 2001 From: Yehowshua Immanuel Date: Tue, 8 Apr 2025 23:04:30 -0400 Subject: [PATCH 02/23] skeletons of Bus module slowly forming --- bs/Bus.bs | 17 ++++++++++++++++- bs/BusTypes.bs | 5 +---- 2 files changed, 17 insertions(+), 5 deletions(-) diff --git a/bs/Bus.bs b/bs/Bus.bs index 87ca6ff..6d648f1 100644 --- a/bs/Bus.bs +++ b/bs/Bus.bs @@ -2,11 +2,16 @@ package Bus(a) where import Types import BusTypes +import TagEngine +import Vector interface (TestType :: * -> *) t = {} -- doSomething :: t -> Action -mkTestType :: (Bits t n, Arith t, Eq t) => Module (TestType t) +mkTestType :: ( + Bits t n, Arith t, Eq t + ) + => Module (TestType t) mkTestType = do return $ interface TestType {} @@ -16,5 +21,15 @@ mkTestTop = do testType <- mkTestType return $ interface Empty { } +mkBus :: Vector numClients (BusClient (UInt (TLog numClients))) + -> Vector numServers (BusServer (UInt (TLog numClients)) clientTagType) + -> Module Empty +mkBus clientVec serverVec = do + tagEngineByClient :: Vector numClients (TagEngine (TLog numClients)) + tagEngineByClient <- replicateM mkTagEngine + + return $ interface Empty { } + + a :: UInt 5 a = 3 diff --git a/bs/BusTypes.bs b/bs/BusTypes.bs index e6943c5..4828668 100644 --- a/bs/BusTypes.bs +++ b/bs/BusTypes.bs @@ -1,4 +1,5 @@ package BusTypes( + Bus(..), BusClient(..), BusServer(..), BusRequest(..), BusResponse(..), ReadRequest(..), ReadResponse(..), WriteRequest(..), WriteResponse(..), @@ -87,10 +88,6 @@ interface (BusServer :: * -> * -> *) transactionTagType clientTagType = dequeueResponse :: ActionValue (clientTagType, BusResponse, transactionTagType) peekClientTagDestination :: clientTagTye -interface (Bus :: # -> # -> * -> * -> *) numClients numServers transactionTagType clientTagType = - clients :: Vector numClients (BusClient transactionTagType) - servers :: Vector numServers (BusServer transactionTagType clientTagType) - type Token = UInt 5 type Numeric = 5 -- 2.48.1 From 989c4e96167174d1704367ec2424e37b1707ab82 Mon Sep 17 00:00:00 2001 From: Yehowshua Immanuel Date: Tue, 8 Apr 2025 23:36:54 -0400 Subject: [PATCH 03/23] Bus types typecheck!!! --- bs/Bus.bs | 6 +++--- bs/BusTypes.bs | 27 ++++++++++++++++++--------- bs/TagEngine.bs | 11 ++++++----- 3 files changed, 27 insertions(+), 17 deletions(-) diff --git a/bs/Bus.bs b/bs/Bus.bs index 6d648f1..318c029 100644 --- a/bs/Bus.bs +++ b/bs/Bus.bs @@ -21,11 +21,11 @@ mkTestTop = do testType <- mkTestType return $ interface Empty { } -mkBus :: Vector numClients (BusClient (UInt (TLog numClients))) - -> Vector numServers (BusServer (UInt (TLog numClients)) clientTagType) +mkBus :: Vector numClients (BusClient inFlightTransactions) + -> Vector numServers (BusServer inFlightTransactions numClients) -> Module Empty mkBus clientVec serverVec = do - tagEngineByClient :: Vector numClients (TagEngine (TLog numClients)) + tagEngineByClient :: Vector numClients (TagEngine inFlightTransactions) tagEngineByClient <- replicateM mkTagEngine return $ interface Empty { } diff --git a/bs/BusTypes.bs b/bs/BusTypes.bs index 4828668..a9a9125 100644 --- a/bs/BusTypes.bs +++ b/bs/BusTypes.bs @@ -1,5 +1,5 @@ package BusTypes( - Bus(..), + ClientTagType, BusClient(..), BusServer(..), BusRequest(..), BusResponse(..), ReadRequest(..), ReadResponse(..), WriteRequest(..), WriteResponse(..), @@ -8,6 +8,9 @@ package BusTypes( import Types import Vector +import TagEngine + +type ClientTagType a = (UInt (TLog a)) data BusError = UnMapped @@ -68,25 +71,31 @@ data BusResponse -- * From the client's perspective, the response should not be called -- by the arbiter until the client is ready to accept the response. -- In other words, the response method should be guarded by the client. -interface (BusClient :: * -> *) transactionTagType = - dequeueRequest :: transactionTagType -> ActionValue BusRequest - enqueueResponse :: (BusResponse, transactionTagType) -> Action +interface (BusClient :: # -> *) inFlightTransactions = + dequeueRequest :: TagType inFlightTransactions + -> ActionValue BusRequest + enqueueResponse :: (BusResponse, TagType inFlightTransactions) + -> Action -- # BusServer.dequeueResponse -- * If the arbiter is able to successfully call `dequeueResponse`, then -- the BusServer's internal logici must update such that it understand -- the response has been handed off. -- # BusServer.peekClientTagDestination --- * The arbiter looks at (peekClientTagDestination :: clientTagTye) to +-- * The arbiter looks at (peekClientTagDestination :: clientTagType) to -- determine whether or not it is currently safe whether to dequeue the -- response as well as where to route the response should it dequeue the -- response. -- * `peekClientTagDestination` should be guarded on whether or not there is -- a valid response available. -interface (BusServer :: * -> * -> *) transactionTagType clientTagType = - enqueueRequest :: (transactionTagType, BusRequest) -> Action - dequeueResponse :: ActionValue (clientTagType, BusResponse, transactionTagType) - peekClientTagDestination :: clientTagTye +interface (BusServer :: # -> # -> *) inFlightTransactions numClients = + enqueueRequest :: (TagType inFlightTransactions, BusRequest) + -> Action + dequeueResponse :: ActionValue ( + ClientTagType numClients, + BusResponse, transactionTagType + ) + peekClientTagDestination :: clientTagType type Token = UInt 5 type Numeric = 5 diff --git a/bs/TagEngine.bs b/bs/TagEngine.bs index 921e58e..95b0d33 100644 --- a/bs/TagEngine.bs +++ b/bs/TagEngine.bs @@ -1,4 +1,5 @@ package TagEngine( + TagType, TagEngine(..), Util.BasicResult(..), mkTagEngine) where @@ -9,11 +10,11 @@ import FIFO import FIFOF import SpecialFIFOs -#define UIntLog2N(n) (UInt (TLog n)) +type TagType a = (UInt (TLog a)) interface (TagEngine :: # -> *) numTags = - requestTag :: ActionValue UIntLog2N(numTags) - retireTag :: UIntLog2N(numTags) -> Action + requestTag :: ActionValue (TagType numTags) + retireTag :: (TagType numTags) -> Action -- The tag engine returns a tag that is unique for the duration of -- the lifetime of the tag. Useful when you need to tag transactions @@ -79,7 +80,7 @@ mkTagEngine = do -- Interface return $ interface TagEngine - requestTag :: ActionValue UIntLog2N(numTags) + requestTag :: ActionValue (TagType numTags) requestTag = do case initialTagDistributor of Just 0 -> do @@ -100,7 +101,7 @@ mkTagEngine = do -- so it is advisable that the caller of `retireTag` only attempt to retire valid tags. -- Internally, the tagEngine will keep a correct and consistent state since TagEngine -- validates tags before attempting to retire them. - retireTag :: UIntLog2N(numTags) -> Action + retireTag :: (TagType numTags) -> Action retireTag tag = do let -- 2.48.1 From b4c7537a8542fdb2e9d67cf52c76167e9c231ef4 Mon Sep 17 00:00:00 2001 From: Yehowshua Immanuel Date: Wed, 9 Apr 2025 01:08:42 -0400 Subject: [PATCH 04/23] things still typecheck --- bs/Bus.bs | 34 ++++++++++++++-------------------- bs/BusTypes.bs | 24 +++++++++--------------- bs/TagEngine.bs | 16 ++++++++-------- 3 files changed, 31 insertions(+), 43 deletions(-) diff --git a/bs/Bus.bs b/bs/Bus.bs index 318c029..b554ba1 100644 --- a/bs/Bus.bs +++ b/bs/Bus.bs @@ -1,25 +1,14 @@ -package Bus(a) where +package Bus(mkBus) where import Types import BusTypes import TagEngine import Vector +import Util +import Arbiter -interface (TestType :: * -> *) t = {} - -- doSomething :: t -> Action - -mkTestType :: ( - Bits t n, Arith t, Eq t - ) - => Module (TestType t) -mkTestType = do - return $ interface TestType {} - -mkTestTop :: Module Empty -mkTestTop = do - testType :: TestType (UInt 5) - testType <- mkTestType - return $ interface Empty { } +clientRequest :: Arbiter.ArbiterClient_IFC -> Action +clientRequest ifc = ifc.request mkBus :: Vector numClients (BusClient inFlightTransactions) -> Vector numServers (BusServer inFlightTransactions numClients) @@ -28,8 +17,13 @@ mkBus clientVec serverVec = do tagEngineByClient :: Vector numClients (TagEngine inFlightTransactions) tagEngineByClient <- replicateM mkTagEngine + arbiterByServer :: Vector numServers (Arbiter_IFC numClients) + arbiterByServer <- replicateM (mkArbiter False) + + addRules |> + rules + "placeholder rule": when True ==> do + let selectedArbiter = (select arbiterByServer 0) + mapM_ clientRequest selectedArbiter.clients + return $ interface Empty { } - - -a :: UInt 5 -a = 3 diff --git a/bs/BusTypes.bs b/bs/BusTypes.bs index a9a9125..818fd3d 100644 --- a/bs/BusTypes.bs +++ b/bs/BusTypes.bs @@ -1,5 +1,5 @@ package BusTypes( - ClientTagType, + MkClientTagType, BusClient(..), BusServer(..), BusRequest(..), BusResponse(..), ReadRequest(..), ReadResponse(..), WriteRequest(..), WriteResponse(..), @@ -10,7 +10,7 @@ import Types import Vector import TagEngine -type ClientTagType a = (UInt (TLog a)) +type MkClientTagType a = (UInt (TLog a)) data BusError = UnMapped @@ -72,33 +72,27 @@ data BusResponse -- by the arbiter until the client is ready to accept the response. -- In other words, the response method should be guarded by the client. interface (BusClient :: # -> *) inFlightTransactions = - dequeueRequest :: TagType inFlightTransactions + dequeueRequest :: MkTagType inFlightTransactions -> ActionValue BusRequest - enqueueResponse :: (BusResponse, TagType inFlightTransactions) + enqueueResponse :: (BusResponse, MkTagType inFlightTransactions) -> Action -- # BusServer.dequeueResponse -- * If the arbiter is able to successfully call `dequeueResponse`, then --- the BusServer's internal logici must update such that it understand +-- the BusServer's internal logic must update such that it understands -- the response has been handed off. -- # BusServer.peekClientTagDestination --- * The arbiter looks at (peekClientTagDestination :: clientTagType) to +-- * The arbiter looks at (peekClientTagDestination :: MkClientTagType) to -- determine whether or not it is currently safe whether to dequeue the -- response as well as where to route the response should it dequeue the -- response. -- * `peekClientTagDestination` should be guarded on whether or not there is -- a valid response available. interface (BusServer :: # -> # -> *) inFlightTransactions numClients = - enqueueRequest :: (TagType inFlightTransactions, BusRequest) + enqueueRequest :: (MkTagType inFlightTransactions, BusRequest) -> Action dequeueResponse :: ActionValue ( - ClientTagType numClients, + MkClientTagType numClients, BusResponse, transactionTagType ) - peekClientTagDestination :: clientTagType - -type Token = UInt 5 -type Numeric = 5 - -a :: UInt 5 -a = 3 + peekClientTagDestination :: MkClientTagType numClients diff --git a/bs/TagEngine.bs b/bs/TagEngine.bs index 95b0d33..2ddb304 100644 --- a/bs/TagEngine.bs +++ b/bs/TagEngine.bs @@ -1,5 +1,5 @@ package TagEngine( - TagType, + MkTagType, TagEngine(..), Util.BasicResult(..), mkTagEngine) where @@ -10,11 +10,11 @@ import FIFO import FIFOF import SpecialFIFOs -type TagType a = (UInt (TLog a)) +type MkTagType numTags = (UInt (TLog numTags)) interface (TagEngine :: # -> *) numTags = - requestTag :: ActionValue (TagType numTags) - retireTag :: (TagType numTags) -> Action + requestTag :: ActionValue (MkTagType numTags) + retireTag :: (MkTagType numTags) -> Action -- The tag engine returns a tag that is unique for the duration of -- the lifetime of the tag. Useful when you need to tag transactions @@ -45,7 +45,7 @@ mkTagEngine = do debugOnce <- mkReg True -- Rules - addRules $ + addRules |> rules "debug_initial_state": when debugOnce ==> do $display "tagUsage: " (fshow (readVReg tagUsage)) @@ -78,9 +78,9 @@ mkTagEngine = do (Nothing, Nothing) -> action {} -- Interface - return $ + return |> interface TagEngine - requestTag :: ActionValue (TagType numTags) + requestTag :: ActionValue (MkTagType numTags) requestTag = do case initialTagDistributor of Just 0 -> do @@ -101,7 +101,7 @@ mkTagEngine = do -- so it is advisable that the caller of `retireTag` only attempt to retire valid tags. -- Internally, the tagEngine will keep a correct and consistent state since TagEngine -- validates tags before attempting to retire them. - retireTag :: (TagType numTags) -> Action + retireTag :: (MkTagType numTags) -> Action retireTag tag = do let -- 2.48.1 From 076d3aed4367a48aad3cf2d4f297908707223cfa Mon Sep 17 00:00:00 2001 From: Yehowshua Immanuel Date: Wed, 9 Apr 2025 20:58:13 -0400 Subject: [PATCH 05/23] shoudl probably rethink approach... --- bs/Bus.bs | 52 ++++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 44 insertions(+), 8 deletions(-) diff --git a/bs/Bus.bs b/bs/Bus.bs index b554ba1..7df4955 100644 --- a/bs/Bus.bs +++ b/bs/Bus.bs @@ -10,20 +10,56 @@ import Arbiter clientRequest :: Arbiter.ArbiterClient_IFC -> Action clientRequest ifc = ifc.request -mkBus :: Vector numClients (BusClient inFlightTransactions) +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 clientVec serverVec = do - tagEngineByClient :: Vector numClients (TagEngine inFlightTransactions) - tagEngineByClient <- replicateM mkTagEngine +mkBus addrToServerTranslation clientVec serverVec = do + tagEngineByClientVec :: Vector numClients (TagEngine inFlightTransactions) + tagEngineByClientVec <- replicateM mkTagEngine - arbiterByServer :: Vector numServers (Arbiter_IFC numClients) - arbiterByServer <- replicateM (mkArbiter False) + 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 selectedArbiter = (select arbiterByServer 0) - mapM_ clientRequest selectedArbiter.clients + 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 { } -- 2.48.1 From ca02c88be31d0ccc188688bb052a3b42af5cc171 Mon Sep 17 00:00:00 2001 From: Yehowshua Immanuel Date: Wed, 9 Apr 2025 22:31:26 -0400 Subject: [PATCH 06/23] stubbed out mkBus for now - awaits full implementation --- bs/Bus.bs | 86 +++++++++++++++++++++++++++----------------------- bs/BusTypes.bs | 82 +++++++++++++++++++++++------------------------ 2 files changed, 86 insertions(+), 82 deletions(-) diff --git a/bs/Bus.bs b/bs/Bus.bs index 7df4955..73f9e76 100644 --- a/bs/Bus.bs +++ b/bs/Bus.bs @@ -6,60 +6,66 @@ import TagEngine import Vector import Util import Arbiter +import FIFO +import FIFOF +import SpecialFIFOs clientRequest :: Arbiter.ArbiterClient_IFC -> Action clientRequest ifc = ifc.request -busRequestToAddr :: BusRequest -> Addr +busRequestToAddr :: BusRequest -> Maybe Addr busRequestToAddr req = case req of BusReadRequest (ReadRequest addr _) -> addr - WriteReadRequest (WriteRequest addr _) -> addr + BusWriteRequest (WriteRequest addr _) -> addr -mkBus :: (Addr -> Integer) - -> Vector numClients (BusClient inFlightTransactions) - -> Vector numServers (BusServer inFlightTransactions numClients) - -> Module Empty -mkBus addrToServerTranslation clientVec serverVec = do +mkBus :: (Addr -> Maybe Integer) + -> Module (Bus inFlightTransactions numClients numServers) +mkBus addrToServerTranslation = do + -- Tag engines for each client to manage transaction tags tagEngineByClientVec :: Vector numClients (TagEngine inFlightTransactions) tagEngineByClientVec <- replicateM mkTagEngine - arbiterByServerVec :: Vector numServers (Arbiter_IFC numClients) - arbiterByServerVec <- replicateM (mkArbiter False) + -- Arbitration for clients to send requests to servers + clientArbiter :: Arbiter.Arbiter_IFC numClients + clientArbiter <- mkArbiter False - -- statically determinate criteria - let - clientIdx :: Integer = 0 - selectedClient ::(BusClient inFlightTransactions) - selectedClient = (select clientVec clientIdx) - selectedTagEngine = (select tagEngineByClientVec clientIdx) + dummyVar :: Reg(Bool) + dummyVar <- mkReg False - addRules |> - rules - "placeholder rule": when True ==> do - let selectedServerArbiter = (select arbiterByServerVec 0) - mapM_ clientRequest selectedServerArbiter.clients + -- Queues to hold requests from clients to servers + requestQueues :: Vector numServers (FIFOF BusRequest) + requestQueues <- replicateM (mkSizedBypassFIFOF (valueOf inFlightTransactions)) - "connect request client 0": - when True - ==> do - tag <- selectedTagEngine.requestTag + -- Queues to hold responses from servers to clients + responseQueues :: Vector numClients (FIFOF (BusResponse, MkTagType inFlightTransactions)) + responseQueues <- replicateM (mkSizedBypassFIFOF (valueOf inFlightTransactions)) - busRequest :: BusRequest - busRequest <- selectedClient.dequeueRequest tag + -- Client interface vector + let clients :: Vector numClients (BusClient inFlightTransactions) + clients = genWith $ \clientIdx -> + interface BusClient + submitRequest req = do + dummyVar := (not dummyVar) + return 0 - -- let - -- addr = busRequestToAddr busRequest - -- targetServerIdx = addrToServerTranslation addr - -- targetServer = (select serverVec targetServerIdx) - -- targetServerArbiter = (select arbiterByServerVec targetServerIdx) - - -- targetServerArbiter.request + consumeResponse = do + dummyVar := (not dummyVar) + let dummyResponse = BusReadResponse (Left UnMapped) + return (dummyResponse, 0) - -- if targetServerArbiter.grant - -- then targetServer.enqueueRequest (tag, busRequest) - -- else action {} - - -- targetServer - action {} + -- Server interface vector + let servers :: Vector numServers (BusServer inFlightTransactions numClients) + servers = genWith $ \serverIdx -> + interface BusServer + consumeRequest = do + dummyVar := (not dummyVar) + let dummyBusRequest = BusReadRequest (ReadRequest 0 SizeByte) + return (0, dummyBusRequest) - return $ interface Empty { } + submitResponse (clientTag, busResponse, transactionTag) = do + dummyVar := (not dummyVar) + + return $ + interface Bus + clients = clients + servers = servers diff --git a/bs/BusTypes.bs b/bs/BusTypes.bs index 818fd3d..f0ae7fa 100644 --- a/bs/BusTypes.bs +++ b/bs/BusTypes.bs @@ -1,4 +1,5 @@ package BusTypes( + Bus(..), MkClientTagType, BusClient(..), BusServer(..), BusRequest(..), BusResponse(..), @@ -44,7 +45,7 @@ type WriteResponse = Either BusError () data BusRequest = BusReadRequest ReadRequest - | WriteReadRequest WriteRequest + | BusWriteRequest WriteRequest deriving (Bits, Eq, FShow) data BusResponse @@ -52,47 +53,44 @@ data BusResponse | BusWriteResponse WriteResponse deriving (Bits, Eq, FShow) --- # BusClient.dequeueRequest --- * The Bus arbiter will call the Bus Client's request method if it is --- the Bus Client's turn to make a request, or if another client forfits --- its turn. --- * The BusClient must guard its request method such that calling its --- request method is only valid when the BusClient has a request to make. --- * This has implications about for the implementor of BusClient, --- namely, that it should hold its request until it's request method --- gets called. The arbiter tags the request so that the client can --- later correctly correlate the response. --- * Although the tag is technically passed in as an argument from the --- arbiter to the client's request method, given that methods are --- atomic in Bluespec, this is effectively equivalent to tagging the --- transaction from the client's perspective. Thus, the client must --- take care to appropiately store the tag. --- # BusClient.enqueueResponse --- * From the client's perspective, the response should not be called --- by the arbiter until the client is ready to accept the response. --- In other words, the response method should be guarded by the client. +-- # BusClient.submitRequest +-- * The bus client calls the `submitRequest` method of the `BusClient` interface +-- with the `BusRequest` it wishes to submit and immediately recieves back +-- a transaction-duration-unqiue tag that it can later correlate with the +-- returned response should responses arrive out of order(OOO). OOO can +-- happen if a bus server is is able to process bus requests faster than +-- other bus servers for example. +-- # BusClient.consumeResponse +-- * The bus client is able to consume a response when a response is available. +-- Responses are tagged with the tag given to bus client when it called +-- `submitRequest` interface (BusClient :: # -> *) inFlightTransactions = - dequeueRequest :: MkTagType inFlightTransactions - -> ActionValue BusRequest - enqueueResponse :: (BusResponse, MkTagType inFlightTransactions) + submitRequest :: BusRequest + -> ActionValue (MkTagType inFlightTransactions) + consumeResponse :: ActionValue (BusResponse, MkTagType inFlightTransactions) + +-- # BusServer.consumeRequest +-- * The bus server calls the `consumeRequest` method of the `BusServer` interface +-- to retrieve a pending bus request initiated by a client. It immediately +-- receives a tuple containing a transaction-duration-unique tag +-- (associated with the original request) and the `BusRequest` itself. This +-- tag is used to track the transaction and correlate it with the eventual +-- response. +-- # BusServer.submitResponse +-- * The bus server calls the `submitResponse` method to send a `BusResponse` +-- back to the originating client. The method takes a tuple containing: +-- - A client tag (of type `MkClientTagType numClients`) identifying the +-- client that submitted the request. +-- - The `BusResponse` containing the result of the request (either a read +-- or write response). +-- - The transaction tag (of type `transactionTagType`) that matches the tag +-- received from `consumeRequest`, ensuring the response is correctly +-- associated with the original request. +interface (BusServer :: # -> # -> *) inFlightTransactions numClients = + consumeRequest :: ActionValue (MkTagType inFlightTransactions, BusRequest) + submitResponse :: (MkClientTagType numClients, BusResponse, transactionTagType) -> Action --- # BusServer.dequeueResponse --- * If the arbiter is able to successfully call `dequeueResponse`, then --- the BusServer's internal logic must update such that it understands --- the response has been handed off. --- # BusServer.peekClientTagDestination --- * The arbiter looks at (peekClientTagDestination :: MkClientTagType) to --- determine whether or not it is currently safe whether to dequeue the --- response as well as where to route the response should it dequeue the --- response. --- * `peekClientTagDestination` should be guarded on whether or not there is --- a valid response available. -interface (BusServer :: # -> # -> *) inFlightTransactions numClients = - enqueueRequest :: (MkTagType inFlightTransactions, BusRequest) - -> Action - dequeueResponse :: ActionValue ( - MkClientTagType numClients, - BusResponse, transactionTagType - ) - peekClientTagDestination :: MkClientTagType numClients +interface (Bus :: # -> # -> # -> *) inFlightTransactions numClients numServers = + clients :: Vector numClients (BusClient inFlightTransactions) + servers :: Vector numServers (BusServer inFlightTransactions numClients) -- 2.48.1 From 979adf36604826c4850f973858963b02bcd2a55e Mon Sep 17 00:00:00 2001 From: Yehowshua Immanuel Date: Thu, 10 Apr 2025 00:36:29 -0400 Subject: [PATCH 07/23] preliminary work on client methods and some type repair --- bs/Bus.bs | 36 +++++++++++++++++++++++++----------- bs/BusTypes.bs | 13 +++++++++++-- 2 files changed, 36 insertions(+), 13 deletions(-) diff --git a/bs/Bus.bs b/bs/Bus.bs index 73f9e76..51e5784 100644 --- a/bs/Bus.bs +++ b/bs/Bus.bs @@ -13,14 +13,14 @@ import SpecialFIFOs clientRequest :: Arbiter.ArbiterClient_IFC -> Action clientRequest ifc = ifc.request -busRequestToAddr :: BusRequest -> Maybe Addr +busRequestToAddr :: BusRequest -> Addr busRequestToAddr req = case req of BusReadRequest (ReadRequest addr _) -> addr BusWriteRequest (WriteRequest addr _) -> addr mkBus :: (Addr -> Maybe Integer) -> Module (Bus inFlightTransactions numClients numServers) -mkBus addrToServerTranslation = do +mkBus busMap = do -- Tag engines for each client to manage transaction tags tagEngineByClientVec :: Vector numClients (TagEngine inFlightTransactions) tagEngineByClientVec <- replicateM mkTagEngine @@ -33,7 +33,7 @@ mkBus addrToServerTranslation = do dummyVar <- mkReg False -- Queues to hold requests from clients to servers - requestQueues :: Vector numServers (FIFOF BusRequest) + requestQueues :: Vector numServers (FIFOF (TaggedBusRequest inFlightTransactions)) requestQueues <- replicateM (mkSizedBypassFIFOF (valueOf inFlightTransactions)) -- Queues to hold responses from servers to clients @@ -43,25 +43,39 @@ mkBus addrToServerTranslation = do -- Client interface vector let clients :: Vector numClients (BusClient inFlightTransactions) clients = genWith $ \clientIdx -> - interface BusClient - submitRequest req = do - dummyVar := (not dummyVar) - return 0 + let + selectedClientRequestQueue :: FIFOF (TaggedBusRequest inFlightTransactions) + selectedClientRequestQueue = (select requestQueues clientIdx) - consumeResponse = do - dummyVar := (not dummyVar) - let dummyResponse = BusReadResponse (Left UnMapped) - return (dummyResponse, 0) + selectedTagEngine :: TagEngine inFlightTransactions + selectedTagEngine = (select tagEngineByClientVec clientIdx) + in + interface BusClient + submitRequest :: BusRequest + -> ActionValue (MkTagType inFlightTransactions) + submitRequest busRequest = do + tag <- selectedTagEngine.requestTag + selectedClientRequestQueue.enq (TaggedBusRequest tag busRequest) + return tag + + consumeResponse :: ActionValue (TaggedBusResponse inFlightTransactions) + consumeResponse = do + dummyVar := (not dummyVar) + let dummyResponse = BusReadResponse (Left UnMapped) + return (TaggedBusResponse 0 dummyResponse) -- Server interface vector let servers :: Vector numServers (BusServer inFlightTransactions numClients) servers = genWith $ \serverIdx -> interface BusServer + consumeRequest :: ActionValue (MkTagType inFlightTransactions, BusRequest) consumeRequest = do dummyVar := (not dummyVar) let dummyBusRequest = BusReadRequest (ReadRequest 0 SizeByte) return (0, dummyBusRequest) + submitResponse :: (MkClientTagType numClients, BusResponse, transactionTagType) + -> Action submitResponse (clientTag, busResponse, transactionTag) = do dummyVar := (not dummyVar) diff --git a/bs/BusTypes.bs b/bs/BusTypes.bs index f0ae7fa..cf11af0 100644 --- a/bs/BusTypes.bs +++ b/bs/BusTypes.bs @@ -4,7 +4,8 @@ package BusTypes( BusClient(..), BusServer(..), BusRequest(..), BusResponse(..), ReadRequest(..), ReadResponse(..), WriteRequest(..), WriteResponse(..), - BusVal(..), BusError(..), TransactionSize(..) + BusVal(..), BusError(..), TransactionSize(..), + TaggedBusRequest(..), TaggedBusResponse(..) ) where import Types @@ -53,6 +54,14 @@ data BusResponse | BusWriteResponse WriteResponse deriving (Bits, Eq, FShow) +data TaggedBusRequest inFlightTransactions = + TaggedBusRequest (MkTagType inFlightTransactions) BusRequest + deriving (Bits, Eq, FShow) + +data TaggedBusResponse inFlightTransactions = + TaggedBusResponse (MkTagType inFlightTransactions) BusResponse + deriving (Bits, Eq, FShow) + -- # BusClient.submitRequest -- * The bus client calls the `submitRequest` method of the `BusClient` interface -- with the `BusRequest` it wishes to submit and immediately recieves back @@ -67,7 +76,7 @@ data BusResponse interface (BusClient :: # -> *) inFlightTransactions = submitRequest :: BusRequest -> ActionValue (MkTagType inFlightTransactions) - consumeResponse :: ActionValue (BusResponse, MkTagType inFlightTransactions) + consumeResponse :: ActionValue (TaggedBusResponse inFlightTransactions) -- # BusServer.consumeRequest -- * The bus server calls the `consumeRequest` method of the `BusServer` interface -- 2.48.1 From c9356eecfdb890db0684b58368a4b78ec2411731 Mon Sep 17 00:00:00 2001 From: Yehowshua Immanuel Date: Thu, 10 Apr 2025 01:27:33 -0400 Subject: [PATCH 08/23] client methods presumably finished --- bs/Bus.bs | 22 ++++++++++++++-------- bs/BusTypes.bs | 7 +++++-- bs/TagEngine.bs | 3 +-- 3 files changed, 20 insertions(+), 12 deletions(-) diff --git a/bs/Bus.bs b/bs/Bus.bs index 51e5784..58ad27e 100644 --- a/bs/Bus.bs +++ b/bs/Bus.bs @@ -18,7 +18,7 @@ busRequestToAddr req = case req of BusReadRequest (ReadRequest addr _) -> addr BusWriteRequest (WriteRequest addr _) -> addr -mkBus :: (Addr -> Maybe Integer) +mkBus :: (Addr -> Maybe ServerIdx) -> Module (Bus inFlightTransactions numClients numServers) mkBus busMap = do -- Tag engines for each client to manage transaction tags @@ -37,7 +37,7 @@ mkBus busMap = do requestQueues <- replicateM (mkSizedBypassFIFOF (valueOf inFlightTransactions)) -- Queues to hold responses from servers to clients - responseQueues :: Vector numClients (FIFOF (BusResponse, MkTagType inFlightTransactions)) + responseQueues :: Vector numClients (FIFOF (TaggedBusResponse inFlightTransactions)) responseQueues <- replicateM (mkSizedBypassFIFOF (valueOf inFlightTransactions)) -- Client interface vector @@ -47,6 +47,9 @@ mkBus busMap = do selectedClientRequestQueue :: FIFOF (TaggedBusRequest inFlightTransactions) selectedClientRequestQueue = (select requestQueues clientIdx) + selectedClientResponseQueue :: FIFOF (TaggedBusResponse inFlightTransactions) + selectedClientResponseQueue = (select responseQueues clientIdx) + selectedTagEngine :: TagEngine inFlightTransactions selectedTagEngine = (select tagEngineByClientVec clientIdx) in @@ -60,9 +63,11 @@ mkBus busMap = do consumeResponse :: ActionValue (TaggedBusResponse inFlightTransactions) consumeResponse = do - dummyVar := (not dummyVar) - let dummyResponse = BusReadResponse (Left UnMapped) - return (TaggedBusResponse 0 dummyResponse) + let + busResponse :: (TaggedBusResponse inFlightTransactions) + busResponse = selectedClientResponseQueue.first + selectedClientResponseQueue.deq + return busResponse -- Server interface vector let servers :: Vector numServers (BusServer inFlightTransactions numClients) @@ -74,9 +79,10 @@ mkBus busMap = do let dummyBusRequest = BusReadRequest (ReadRequest 0 SizeByte) return (0, dummyBusRequest) - submitResponse :: (MkClientTagType numClients, BusResponse, transactionTagType) - -> Action - submitResponse (clientTag, busResponse, transactionTag) = do + submitResponse :: ( MkClientTagType numClients, + TaggedBusResponse inFlightTransactions + ) -> Action + submitResponse (clientTag, taggedBusResponse) = do dummyVar := (not dummyVar) return $ diff --git a/bs/BusTypes.bs b/bs/BusTypes.bs index cf11af0..e91626c 100644 --- a/bs/BusTypes.bs +++ b/bs/BusTypes.bs @@ -1,5 +1,6 @@ package BusTypes( Bus(..), + ServerIdx, MkClientTagType, BusClient(..), BusServer(..), BusRequest(..), BusResponse(..), @@ -13,6 +14,7 @@ import Vector import TagEngine type MkClientTagType a = (UInt (TLog a)) +type ServerIdx = Integer data BusError = UnMapped @@ -97,8 +99,9 @@ interface (BusClient :: # -> *) inFlightTransactions = -- associated with the original request. interface (BusServer :: # -> # -> *) inFlightTransactions numClients = consumeRequest :: ActionValue (MkTagType inFlightTransactions, BusRequest) - submitResponse :: (MkClientTagType numClients, BusResponse, transactionTagType) - -> Action + submitResponse :: ( MkClientTagType numClients, + TaggedBusResponse inFlightTransactions + ) -> Action interface (Bus :: # -> # -> # -> *) inFlightTransactions numClients numServers = clients :: Vector numClients (BusClient inFlightTransactions) diff --git a/bs/TagEngine.bs b/bs/TagEngine.bs index 2ddb304..f86c811 100644 --- a/bs/TagEngine.bs +++ b/bs/TagEngine.bs @@ -7,7 +7,6 @@ package TagEngine( import Vector import Util import FIFO -import FIFOF import SpecialFIFOs type MkTagType numTags = (UInt (TLog numTags)) @@ -35,7 +34,7 @@ mkTagEngine = do -- to TagEngine where `n := maxTagCount`. initialTagDistributor <- mkReg (Just (maxTagCount - 1)) -- Distributes initial tags retireQueue <- mkBypassFIFO -- Queue for tags being retired - freeTagQueue <- mkSizedFIFOF maxTagCount -- Queue of available tags + freeTagQueue <- mkSizedFIFO maxTagCount -- Queue of available tags -- Signals retireSignal <- mkRWire -- Signals a tag retirement -- 2.48.1 From 71fbb7d2e5c603e05a142c2b9fb3804424ddda40 Mon Sep 17 00:00:00 2001 From: Yehowshua Immanuel Date: Thu, 10 Apr 2025 10:59:52 -0400 Subject: [PATCH 09/23] add bus diagram and further work on Bus --- bs/Bus.bs | 20 ++- diagrams/.$bus.drawio.bkp | 360 ++++++++++++++++++++++++++++++++++++++ diagrams/bus.drawio | 360 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 732 insertions(+), 8 deletions(-) create mode 100644 diagrams/.$bus.drawio.bkp create mode 100644 diagrams/bus.drawio diff --git a/bs/Bus.bs b/bs/Bus.bs index 58ad27e..7313953 100644 --- a/bs/Bus.bs +++ b/bs/Bus.bs @@ -32,23 +32,27 @@ mkBus busMap = do dummyVar :: Reg(Bool) dummyVar <- mkReg False - -- Queues to hold requests from clients to servers - requestQueues :: Vector numServers (FIFOF (TaggedBusRequest inFlightTransactions)) - requestQueues <- replicateM (mkSizedBypassFIFOF (valueOf inFlightTransactions)) + -- Queues to hold requests from clients to arbiter + clientRequestQueues :: Vector numClients (FIFOF (TaggedBusRequest inFlightTransactions)) + clientRequestQueues <- replicateM (mkSizedBypassFIFOF (valueOf inFlightTransactions)) - -- Queues to hold responses from servers to clients - responseQueues :: Vector numClients (FIFOF (TaggedBusResponse inFlightTransactions)) - responseQueues <- replicateM (mkSizedBypassFIFOF (valueOf inFlightTransactions)) + -- Queues to hold responses from arbiter to clients + clientResponseQueues :: Vector numClients (FIFOF (TaggedBusResponse inFlightTransactions)) + clientResponseQueues <- replicateM (mkSizedBypassFIFOF (valueOf inFlightTransactions)) + + -- -- Queues to hold requests from arbiter to server + -- serverRequestQueues :: Vector numServers (FIFOF (TaggedBusRequest inFlightTransactions)) + -- serverRequestQueues <- replicateM (mkSizedBypassFIFOF (valueOf inFlightTransactions)) -- Client interface vector let clients :: Vector numClients (BusClient inFlightTransactions) clients = genWith $ \clientIdx -> let selectedClientRequestQueue :: FIFOF (TaggedBusRequest inFlightTransactions) - selectedClientRequestQueue = (select requestQueues clientIdx) + selectedClientRequestQueue = (select clientRequestQueues clientIdx) selectedClientResponseQueue :: FIFOF (TaggedBusResponse inFlightTransactions) - selectedClientResponseQueue = (select responseQueues clientIdx) + selectedClientResponseQueue = (select clientResponseQueues clientIdx) selectedTagEngine :: TagEngine inFlightTransactions selectedTagEngine = (select tagEngineByClientVec clientIdx) diff --git a/diagrams/.$bus.drawio.bkp b/diagrams/.$bus.drawio.bkp new file mode 100644 index 0000000..bc4e718 --- /dev/null +++ b/diagrams/.$bus.drawio.bkp @@ -0,0 +1,360 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/diagrams/bus.drawio b/diagrams/bus.drawio new file mode 100644 index 0000000..97ba9e7 --- /dev/null +++ b/diagrams/bus.drawio @@ -0,0 +1,360 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -- 2.48.1 From 548a2f26bd56ffa92bb102d659ddfeb3190ec7af Mon Sep 17 00:00:00 2001 From: Yehowshua Immanuel Date: Thu, 10 Apr 2025 11:01:41 -0400 Subject: [PATCH 10/23] don't commit bkp files --- .gitignore | 1 + diagrams/.$bus.drawio.bkp | 360 -------------------------------------- 2 files changed, 1 insertion(+), 360 deletions(-) delete mode 100644 diagrams/.$bus.drawio.bkp diff --git a/.gitignore b/.gitignore index 85c69dc..9291deb 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,5 @@ *.vcd +*.bkp *.so # bluespec files diff --git a/diagrams/.$bus.drawio.bkp b/diagrams/.$bus.drawio.bkp deleted file mode 100644 index bc4e718..0000000 --- a/diagrams/.$bus.drawio.bkp +++ /dev/null @@ -1,360 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- 2.48.1 From 5efef8b19cc9f651b01af5b5d2e00d9ce96101eb Mon Sep 17 00:00:00 2001 From: Yehowshua Immanuel Date: Thu, 10 Apr 2025 20:46:53 -0400 Subject: [PATCH 11/23] quieter builds, more type uniformity, full compiles - made builds less verbose on Mac by removing `-cpp` - made type constructors for most instances of `(UInt (TLog n))` - addressed cases where types built upon `(UInt (TLog n))` may have a max value of `n`, which necessitates changing the type to ` (UInt (TLog (TAdd 1 n)))` - compiler wouldn't fully evaluate types unless mkBus was instantiated --- Makefile | 1 - bs/Bus.bs | 41 ++++++++++++++++++++++++++++++++--------- bs/BusTypes.bs | 2 +- bs/ClkDivider.bs | 14 ++++++++++---- bs/Core.bs | 4 ++-- bs/TagEngine.bs | 2 +- bs/Top.bs | 14 ++++++++++++-- 7 files changed, 58 insertions(+), 20 deletions(-) diff --git a/Makefile b/Makefile index 7579e84..d92f15a 100644 --- a/Makefile +++ b/Makefile @@ -51,7 +51,6 @@ BSC_COMP_FLAGS += \ -aggressive-conditions \ -no-warn-action-shadowing \ -check-assert \ - -cpp \ -show-schedule \ +RTS -K128M -RTS -show-range-conflict \ $(BSC_COMP_FLAG1) $(BSC_COMP_FLAG2) $(BSC_COMP_FLAG3) diff --git a/bs/Bus.bs b/bs/Bus.bs index 7313953..bf6d0c5 100644 --- a/bs/Bus.bs +++ b/bs/Bus.bs @@ -1,4 +1,4 @@ -package Bus(mkBus) where +package Bus(mkBus, Bus(..)) where import Types import BusTypes @@ -18,6 +18,12 @@ 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" + mkBus :: (Addr -> Maybe ServerIdx) -> Module (Bus inFlightTransactions numClients numServers) mkBus busMap = do @@ -25,24 +31,41 @@ mkBus busMap = do tagEngineByClientVec :: Vector numClients (TagEngine inFlightTransactions) tagEngineByClientVec <- replicateM mkTagEngine - -- Arbitration for clients to send requests to servers - clientArbiter :: Arbiter.Arbiter_IFC numClients - clientArbiter <- mkArbiter False + clientArbiters :: Arbiter.Arbiter_IFC numClients + clientArbiters <- mkArbiter False + + serverArbiters :: Arbiter.Arbiter_IFC numServers + serverArbiters <- mkArbiter False dummyVar :: Reg(Bool) dummyVar <- mkReg False - -- Queues to hold requests from clients to arbiter + -- Queues to hold requests from clients clientRequestQueues :: Vector numClients (FIFOF (TaggedBusRequest inFlightTransactions)) clientRequestQueues <- replicateM (mkSizedBypassFIFOF (valueOf inFlightTransactions)) - -- Queues to hold responses from arbiter to clients + -- Queues to hold responses to clients clientResponseQueues :: Vector numClients (FIFOF (TaggedBusResponse inFlightTransactions)) clientResponseQueues <- replicateM (mkSizedBypassFIFOF (valueOf inFlightTransactions)) - -- -- Queues to hold requests from arbiter to server - -- serverRequestQueues :: Vector numServers (FIFOF (TaggedBusRequest inFlightTransactions)) - -- serverRequestQueues <- replicateM (mkSizedBypassFIFOF (valueOf inFlightTransactions)) + let clientRouter :: Vector numClients (Rules) + clientRouter = genWith $ \clientIdx -> + rules + "test rule": when True ==> do + $display "client test rule" + + let clientRouter :: Rules + clientRouter = + rules + "test rule": when True ==> do + $display "client test rule" + + -- Rules + addRules |> + rules + "test rule": when True ==> do + $display "test rule" + <+> clientRouter -- Client interface vector let clients :: Vector numClients (BusClient inFlightTransactions) diff --git a/bs/BusTypes.bs b/bs/BusTypes.bs index e91626c..112e923 100644 --- a/bs/BusTypes.bs +++ b/bs/BusTypes.bs @@ -13,7 +13,7 @@ import Types import Vector import TagEngine -type MkClientTagType a = (UInt (TLog a)) +type MkClientTagType numClients = (UInt (TLog numClients)) type ServerIdx = Integer data BusError diff --git a/bs/ClkDivider.bs b/bs/ClkDivider.bs index 789489e..cd94bc9 100644 --- a/bs/ClkDivider.bs +++ b/bs/ClkDivider.bs @@ -1,4 +1,8 @@ -package ClkDivider(mkClkDivider, ClkDivider(..)) where +package ClkDivider( + mkClkDivider, + MkClkDivType, + ClkDivider(..) + ) where interface (ClkDivider :: # -> *) hi = { @@ -7,11 +11,13 @@ interface (ClkDivider :: # -> *) hi = ;isHalfCycle :: Bool } +type MkClkDivType maxCycles = (UInt (TLog (TAdd 1 maxCycles))) + mkClkDivider :: Handle -> Module (ClkDivider hi) mkClkDivider fileHandle = do - counter <- mkReg(0 :: UInt (TLog hi)) - let hi_value :: UInt (TLog hi) = (fromInteger $ valueOf hi) - let half_hi_value :: UInt (TLog hi) = (fromInteger $ valueOf (TDiv hi 2)) + counter <- mkReg(0 :: MkClkDivType hi) + let hi_value :: (MkClkDivType hi) = (fromInteger $ valueOf hi) + let half_hi_value :: (MkClkDivType hi) = (fromInteger $ valueOf (TDiv hi 2)) let val :: Real = (fromInteger $ valueOf hi) let msg = "Clock Div Period : " + (realToString val) + "\n" diff --git a/bs/Core.bs b/bs/Core.bs index 1b821ec..2ef5fd9 100644 --- a/bs/Core.bs +++ b/bs/Core.bs @@ -11,13 +11,13 @@ interface (Core :: # -> *) clkFreq = { mkCore :: Module (Core clkFreq) mkCore = do - counter :: Reg (UInt (TLog clkFreq)) <- mkReg 0 + counter :: Reg (MkClkDivType clkFreq) <- mkReg 0 tickSecond :: Wire Bool <- mkDWire False uartOut :: Wire (Bit 8) <- mkWire; ledOut :: Reg (Bit 8) <- mkReg 0 let clkFreqInt :: Integer = valueOf clkFreq - let clkFreqUInt :: UInt (TLog clkFreq) = fromInteger clkFreqInt + let clkFreqUInt :: (MkClkDivType clkFreq) = fromInteger clkFreqInt let val :: Real = fromInteger clkFreqInt messageM $ "mkCore clkFreq" + realToString val diff --git a/bs/TagEngine.bs b/bs/TagEngine.bs index f86c811..8b12b9d 100644 --- a/bs/TagEngine.bs +++ b/bs/TagEngine.bs @@ -9,7 +9,7 @@ import Util import FIFO import SpecialFIFOs -type MkTagType numTags = (UInt (TLog numTags)) +type MkTagType numTags = (UInt (TLog (TAdd 1 numTags))) interface (TagEngine :: # -> *) numTags = requestTag :: ActionValue (MkTagType numTags) diff --git a/bs/Top.bs b/bs/Top.bs index f4f1cda..a125406 100644 --- a/bs/Top.bs +++ b/bs/Top.bs @@ -10,6 +10,9 @@ import TagEngine import List import ActionSeq +import Vector +import BusTypes + import TagEngineTester type FCLK = 25000000 @@ -57,11 +60,18 @@ mkTop = do mkSim :: Module Empty mkSim = do _ :: Empty <- mkTagEngineTester - initCFunctions :: Reg Bool <- mkReg False; - core :: Core FCLK <- mkCore; + initCFunctions :: Reg Bool <- mkReg False + core :: Core FCLK <- mkCore + let busMap _ = Just 0 + bus :: (Bus 4 2 2) <- mkBus busMap addRules $ rules + "test bus": when True ==> + do + let server = (Vector.select bus.servers 0) + result <- server.consumeRequest + $display (fshow result) "initCFunctionsOnce": when not initCFunctions ==> do initTerminal -- 2.48.1 From cffbadd1ccb3ea56f1fad6a7dba6b2a27edc36d4 Mon Sep 17 00:00:00 2001 From: Yehowshua Immanuel Date: Thu, 10 Apr 2025 21:42:15 -0400 Subject: [PATCH 12/23] incomplete but need to come to stopping point --- bs/Bus.bs | 36 +++++++++++++++++++++++------------- 1 file changed, 23 insertions(+), 13 deletions(-) diff --git a/bs/Bus.bs b/bs/Bus.bs index bf6d0c5..69034ae 100644 --- a/bs/Bus.bs +++ b/bs/Bus.bs @@ -24,17 +24,19 @@ dummyRule = "test rule": when True ==> do $display "test rule" +-- we need a way to make serverMap safer... mkBus :: (Addr -> Maybe ServerIdx) -> Module (Bus inFlightTransactions numClients numServers) -mkBus busMap = do +mkBus serverMap = do -- Tag engines for each client to manage transaction tags tagEngineByClientVec :: Vector numClients (TagEngine inFlightTransactions) tagEngineByClientVec <- replicateM mkTagEngine - clientArbiters :: Arbiter.Arbiter_IFC numClients + -- each + clientArbiters :: Arbiter.Arbiter_IFC numServers clientArbiters <- mkArbiter False - serverArbiters :: Arbiter.Arbiter_IFC numServers + serverArbiters :: Arbiter.Arbiter_IFC numClients serverArbiters <- mkArbiter False dummyVar :: Reg(Bool) @@ -50,22 +52,30 @@ mkBus busMap = do let clientRouter :: Vector numClients (Rules) clientRouter = genWith $ \clientIdx -> - rules - "test rule": when True ==> do - $display "client test rule" + let + selectedClientRequestQueue :: FIFOF (TaggedBusRequest inFlightTransactions) + selectedClientRequestQueue = (select clientRequestQueues clientIdx) + in + rules + "route request": when True ==> do + let + clientRequest :: (TaggedBusRequest inFlightTransactions) + clientRequest = selectedClientRequestQueue.first - let clientRouter :: Rules - clientRouter = - rules - "test rule": when True ==> do - $display "client test rule" + -- targetAddr :: Addr = busRequestToAddr clientRequest + -- targetServerIdx :: (Maybe ServerIdx) = serverMap targetAddr + -- case targetServerIdx of + -- Just serverIdx -> do + -- targetServerArbiter :: + + $display "client test rule " (fromInteger clientIdx) + + addRules |> foldr (<+>) (rules {}) clientRouter - -- Rules addRules |> rules "test rule": when True ==> do $display "test rule" - <+> clientRouter -- Client interface vector let clients :: Vector numClients (BusClient inFlightTransactions) -- 2.48.1 From 45191a2abd11acd4788580eeadd3d3fe1350ce91 Mon Sep 17 00:00:00 2001 From: Yehowshua Immanuel Date: Fri, 11 Apr 2025 07:54:47 -0400 Subject: [PATCH 13/23] WIP : client request should handle unmapped case --- bs/Bus.bs | 32 ++++++++++++++++++-------------- bs/BusTypes.bs | 12 ++++++++---- 2 files changed, 26 insertions(+), 18 deletions(-) diff --git a/bs/Bus.bs b/bs/Bus.bs index 69034ae..4bb081b 100644 --- a/bs/Bus.bs +++ b/bs/Bus.bs @@ -32,12 +32,14 @@ mkBus serverMap = do tagEngineByClientVec :: Vector numClients (TagEngine inFlightTransactions) tagEngineByClientVec <- replicateM mkTagEngine - -- each - clientArbiters :: Arbiter.Arbiter_IFC numServers - clientArbiters <- mkArbiter False + -- There are `numClients` clients, each of which needs its own + -- arbiter as there are up to `numServer` servers that may wish + -- to submit a response to a given client. + clientArbiters :: Vector numClients (Arbiter.Arbiter_IFC numServers) + clientArbiters <- replicateM (mkArbiter False) - serverArbiters :: Arbiter.Arbiter_IFC numClients - serverArbiters <- mkArbiter False + serverArbiters :: Vector numServers (Arbiter.Arbiter_IFC numClients) + serverArbiters <- replicateM (mkArbiter False) dummyVar :: Reg(Bool) dummyVar <- mkReg False @@ -50,27 +52,28 @@ mkBus serverMap = do clientResponseQueues :: Vector numClients (FIFOF (TaggedBusResponse inFlightTransactions)) clientResponseQueues <- replicateM (mkSizedBypassFIFOF (valueOf inFlightTransactions)) - let clientRouter :: Vector numClients (Rules) - clientRouter = genWith $ \clientIdx -> + let clientRules :: Vector numClients (Rules) + clientRules = genWith $ \clientIdx -> let selectedClientRequestQueue :: FIFOF (TaggedBusRequest inFlightTransactions) selectedClientRequestQueue = (select clientRequestQueues clientIdx) in rules - "route request": when True ==> do + "request": when True ==> do let - clientRequest :: (TaggedBusRequest inFlightTransactions) + clientRequest :: TaggedBusRequest inFlightTransactions clientRequest = selectedClientRequestQueue.first - -- targetAddr :: Addr = busRequestToAddr clientRequest - -- targetServerIdx :: (Maybe ServerIdx) = serverMap targetAddr + targetAddr :: Addr = busRequestToAddr |> clientRequest.busRequest + targetServerIdx :: (Maybe ServerIdx) = serverMap targetAddr -- case targetServerIdx of -- Just serverIdx -> do - -- targetServerArbiter :: + -- targetServerArbiter :: Arbiter.Arbiter_IFC numClients + -- targetServerArbiter = (select serverArbiters serverIdx) $display "client test rule " (fromInteger clientIdx) - addRules |> foldr (<+>) (rules {}) clientRouter + addRules |> foldr (<+>) (rules {}) clientRules addRules |> rules @@ -95,7 +98,8 @@ mkBus serverMap = do -> ActionValue (MkTagType inFlightTransactions) submitRequest busRequest = do tag <- selectedTagEngine.requestTag - selectedClientRequestQueue.enq (TaggedBusRequest tag busRequest) + let taggedReuqest = TaggedBusRequest {tag = tag; busRequest = busRequest} + selectedClientRequestQueue.enq taggedReuqest return tag consumeResponse :: ActionValue (TaggedBusResponse inFlightTransactions) diff --git a/bs/BusTypes.bs b/bs/BusTypes.bs index 112e923..ed6de3b 100644 --- a/bs/BusTypes.bs +++ b/bs/BusTypes.bs @@ -56,12 +56,16 @@ data BusResponse | BusWriteResponse WriteResponse deriving (Bits, Eq, FShow) -data TaggedBusRequest inFlightTransactions = - TaggedBusRequest (MkTagType inFlightTransactions) BusRequest +struct TaggedBusRequest inFlightTransactions = + { tag :: (MkTagType inFlightTransactions); + busRequest :: BusRequest + } deriving (Bits, Eq, FShow) -data TaggedBusResponse inFlightTransactions = - TaggedBusResponse (MkTagType inFlightTransactions) BusResponse +struct TaggedBusResponse inFlightTransactions = + { tag :: (MkTagType inFlightTransactions); + busResponse :: BusResponse + } deriving (Bits, Eq, FShow) -- # BusClient.submitRequest -- 2.48.1 From 628319709e3a3ad813ec89cfa27b421b400e40c0 Mon Sep 17 00:00:00 2001 From: Yehowshua Immanuel Date: Fri, 11 Apr 2025 12:36:43 -0400 Subject: [PATCH 14/23] stopping point --- bs/Bus.bs | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/bs/Bus.bs b/bs/Bus.bs index 4bb081b..3217cb5 100644 --- a/bs/Bus.bs +++ b/bs/Bus.bs @@ -19,7 +19,7 @@ busRequestToAddr req = case req of BusWriteRequest (WriteRequest addr _) -> addr dummyRule :: Rules -dummyRule = +dummyRule = rules "test rule": when True ==> do $display "test rule" @@ -32,14 +32,18 @@ mkBus serverMap = do tagEngineByClientVec :: Vector numClients (TagEngine inFlightTransactions) tagEngineByClientVec <- replicateM mkTagEngine - -- There are `numClients` clients, each of which needs its own - -- arbiter as there are up to `numServer` servers that may wish - -- to submit a response to a given client. - clientArbiters :: Vector numClients (Arbiter.Arbiter_IFC numServers) - clientArbiters <- replicateM (mkArbiter False) + -- There are `numClients` clients, each of which needs its own arbiter as + -- there are up to `numServer` servers that may wish to submit a response + -- to a given client. Furthermore the rule that routes client requests to + -- servers makes for another potential requestor as it may determine that + -- a request is unmappable and instead opt to form and submit a + -- `BusError UnMapped` response directly to a client response arbiter. Thus + -- we must arbit between a total of `numServers + 1` requestors. + clientResponseArbiter :: Vector numClients (Arbiter.Arbiter_IFC (TAdd numServers 1)) + clientResponseArbiter <- replicateM (mkArbiter False) - serverArbiters :: Vector numServers (Arbiter.Arbiter_IFC numClients) - serverArbiters <- replicateM (mkArbiter False) + serverRequestArbiter :: Vector numServers (Arbiter.Arbiter_IFC numClients) + serverRequestArbiter <- replicateM (mkArbiter False) dummyVar :: Reg(Bool) dummyVar <- mkReg False @@ -60,7 +64,7 @@ mkBus serverMap = do in rules "request": when True ==> do - let + let clientRequest :: TaggedBusRequest inFlightTransactions clientRequest = selectedClientRequestQueue.first -- 2.48.1 From 813f543b424eed5a5eea985c5d13e0cb1fb12f30 Mon Sep 17 00:00:00 2001 From: Yehowshua Immanuel Date: Fri, 11 Apr 2025 14:26:40 -0400 Subject: [PATCH 15/23] request server from client rule in client issue --- bs/Bus.bs | 35 ++++++++++++++++++++--------------- bs/Top.bs | 2 +- 2 files changed, 21 insertions(+), 16 deletions(-) diff --git a/bs/Bus.bs b/bs/Bus.bs index 3217cb5..b9d5b32 100644 --- a/bs/Bus.bs +++ b/bs/Bus.bs @@ -9,6 +9,7 @@ import Arbiter import FIFO import FIFOF import SpecialFIFOs +import Printf clientRequest :: Arbiter.ArbiterClient_IFC -> Action clientRequest ifc = ifc.request @@ -39,11 +40,14 @@ mkBus serverMap = do -- a request is unmappable and instead opt to form and submit a -- `BusError UnMapped` response directly to a client response arbiter. Thus -- we must arbit between a total of `numServers + 1` requestors. - clientResponseArbiter :: Vector numClients (Arbiter.Arbiter_IFC (TAdd numServers 1)) - clientResponseArbiter <- replicateM (mkArbiter False) + responseArbiterByClient :: Vector numClients (Arbiter.Arbiter_IFC (TAdd numServers 1)) + responseArbiterByClient <- replicateM (mkArbiter False) - serverRequestArbiter :: Vector numServers (Arbiter.Arbiter_IFC numClients) - serverRequestArbiter <- replicateM (mkArbiter False) + -- There are `numServer` servers, each of which needs its own arbiter as + -- there are up to `numClient` clients that may wish to submit a response + -- to a given client. + requestArbiterByServer :: Vector numServers (Arbiter.Arbiter_IFC numClients) + requestArbiterByServer <- replicateM (mkArbiter False) dummyVar :: Reg(Bool) dummyVar <- mkReg False @@ -63,27 +67,28 @@ mkBus serverMap = do selectedClientRequestQueue = (select clientRequestQueues clientIdx) in rules - "request": when True ==> do + (sprintf "request server from client %d" clientIdx): when True ==> do let clientRequest :: TaggedBusRequest inFlightTransactions clientRequest = selectedClientRequestQueue.first targetAddr :: Addr = busRequestToAddr |> clientRequest.busRequest targetServerIdx :: (Maybe ServerIdx) = serverMap targetAddr - -- case targetServerIdx of - -- Just serverIdx -> do - -- targetServerArbiter :: Arbiter.Arbiter_IFC numClients - -- targetServerArbiter = (select serverArbiters serverIdx) + -- $display "clientRequest" (fshow clientRequest) + case targetServerIdx of + Just serverIdx -> do + let + targetServerArbiter :: Arbiter.Arbiter_IFC numClients + targetServerArbiter = (select requestArbiterByServer serverIdx) + arbiterClientSlot :: Arbiter.ArbiterClient_IFC + arbiterClientSlot = (select targetServerArbiter.clients clientIdx) + arbiterClientSlot.request + Nothing -> do action {} + - $display "client test rule " (fromInteger clientIdx) addRules |> foldr (<+>) (rules {}) clientRules - addRules |> - rules - "test rule": when True ==> do - $display "test rule" - -- Client interface vector let clients :: Vector numClients (BusClient inFlightTransactions) clients = genWith $ \clientIdx -> diff --git a/bs/Top.bs b/bs/Top.bs index a125406..a0816a0 100644 --- a/bs/Top.bs +++ b/bs/Top.bs @@ -71,7 +71,7 @@ mkSim = do do let server = (Vector.select bus.servers 0) result <- server.consumeRequest - $display (fshow result) + $display "Top.bs:74" (fshow result) "initCFunctionsOnce": when not initCFunctions ==> do initTerminal -- 2.48.1 From 98f2f5cdfd7886ea3907c48ffa8655cb2331a24f Mon Sep 17 00:00:00 2001 From: Yehowshua Immanuel Date: Fri, 11 Apr 2025 20:35:26 -0400 Subject: [PATCH 16/23] having trouble with type constraints around clientIdx --- bs/Bus.bs | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/bs/Bus.bs b/bs/Bus.bs index b9d5b32..3afe1e8 100644 --- a/bs/Bus.bs +++ b/bs/Bus.bs @@ -67,6 +67,9 @@ mkBus serverMap = do selectedClientRequestQueue = (select clientRequestQueues clientIdx) in rules + "rule" : when True ==> do + $display "Bus.bs:71" + (sprintf "request server from client %d" clientIdx): when True ==> do let clientRequest :: TaggedBusRequest inFlightTransactions @@ -75,6 +78,7 @@ mkBus serverMap = do targetAddr :: Addr = busRequestToAddr |> clientRequest.busRequest targetServerIdx :: (Maybe ServerIdx) = serverMap targetAddr -- $display "clientRequest" (fshow clientRequest) + $display "Bus.bs:81" (fshow clientRequest) case targetServerIdx of Just serverIdx -> do let @@ -83,7 +87,20 @@ mkBus serverMap = do arbiterClientSlot :: Arbiter.ArbiterClient_IFC arbiterClientSlot = (select targetServerArbiter.clients clientIdx) arbiterClientSlot.request - Nothing -> do action {} + Nothing -> do + let + idx = fromInteger clientIdx + targetClientResponseArbiter :: Arbiter.Arbiter_IFC numClients + targetClientResponseArbiter = (select responseArbiterByClient idx) + + clientResponseArbiterSlot :: Arbiter.ArbiterClient_IFC + -- arbiters 0 to n-1 are where `n:=numServer` are reserved + -- for servers to make requests to. Arbiter n is reserved for + -- when this rule needs to skip making a request to a server + -- and should instead forward the `BusError UnMapped` response + -- back to the client. Vector.last selects arbiter `n` + clientResponseArbiterSlot = Vector.last targetClientResponseArbiter + clientResponseArbiterSlot.request -- 2.48.1 From 373d170c3ffce4050af1142fdb9e839fb2c137f7 Mon Sep 17 00:00:00 2001 From: Yehowshua Immanuel Date: Sun, 13 Apr 2025 22:40:59 -0400 Subject: [PATCH 17/23] notable progress WRT client requests invoking arbiter request --- bs/Bus.bs | 44 +++++++--- bs/BusTypes.bs | 4 +- diagrams/bus.drawio | 208 ++++++++++++++++++++++++++------------------ 3 files changed, 159 insertions(+), 97 deletions(-) diff --git a/bs/Bus.bs b/bs/Bus.bs index 3afe1e8..4a516f4 100644 --- a/bs/Bus.bs +++ b/bs/Bus.bs @@ -25,8 +25,13 @@ dummyRule = "test rule": when True ==> do $display "test rule" +data DispatchFromClient inFlightTransactions numServers + = DispatchRequest (TaggedBusRequest inFlightTransactions) (MkServerIdx numServers) + | DispatchResponse (TaggedBusResponse inFlightTransactions) + deriving (Bits, Eq, FShow) + -- we need a way to make serverMap safer... -mkBus :: (Addr -> Maybe ServerIdx) +mkBus :: (Addr -> Maybe (MkServerIdx numServers)) -> Module (Bus inFlightTransactions numClients numServers) mkBus serverMap = do -- Tag engines for each client to manage transaction tags @@ -43,6 +48,13 @@ mkBus serverMap = do responseArbiterByClient :: Vector numClients (Arbiter.Arbiter_IFC (TAdd numServers 1)) responseArbiterByClient <- replicateM (mkArbiter False) + -- After we inspect the head/oldest request in the `clientRequestQueues` and perform an + -- arbiter request to the destination arbiter, we need to inspect for grant in another + -- rule as I don't believe grant and request can be called simultaneously. + -- The following vector allows us to move + dispatchByClient :: Vector numClients (Wire (DispatchFromClient inFlightTransactions numServers)) + dispatchByClient <- replicateM mkWire + -- There are `numServer` servers, each of which needs its own arbiter as -- there are up to `numClient` clients that may wish to submit a response -- to a given client. @@ -76,9 +88,11 @@ mkBus serverMap = do clientRequest = selectedClientRequestQueue.first targetAddr :: Addr = busRequestToAddr |> clientRequest.busRequest - targetServerIdx :: (Maybe ServerIdx) = serverMap targetAddr - -- $display "clientRequest" (fshow clientRequest) - $display "Bus.bs:81" (fshow clientRequest) + targetServerIdx :: (Maybe (MkServerIdx numServers)) = serverMap targetAddr + + dispatchByClientWire :: Wire (DispatchFromClient inFlightTransactions numServers) + dispatchByClientWire = (select dispatchByClient clientIdx) + case targetServerIdx of Just serverIdx -> do let @@ -87,22 +101,30 @@ mkBus serverMap = do arbiterClientSlot :: Arbiter.ArbiterClient_IFC arbiterClientSlot = (select targetServerArbiter.clients clientIdx) arbiterClientSlot.request + dispatchByClientWire := DispatchRequest clientRequest serverIdx Nothing -> do let - idx = fromInteger clientIdx - targetClientResponseArbiter :: Arbiter.Arbiter_IFC numClients - targetClientResponseArbiter = (select responseArbiterByClient idx) + targetClientResponseArbiter :: Arbiter.Arbiter_IFC (TAdd numServers 1) + targetClientResponseArbiter = (select responseArbiterByClient clientIdx) clientResponseArbiterSlot :: Arbiter.ArbiterClient_IFC - -- arbiters 0 to n-1 are where `n:=numServer` are reserved + -- arbiters 0 to n-1 where `n:=numServer` are reserved -- for servers to make requests to. Arbiter n is reserved for -- when this rule needs to skip making a request to a server -- and should instead forward the `BusError UnMapped` response -- back to the client. Vector.last selects arbiter `n` - clientResponseArbiterSlot = Vector.last targetClientResponseArbiter + clientResponseArbiterSlot = Vector.last targetClientResponseArbiter.clients + responseUnMapped = case clientRequest.busRequest of + BusReadRequest _ -> BusReadResponse (Left UnMapped) + BusWriteRequest _ -> BusWriteResponse (Left UnMapped) + response :: TaggedBusResponse inFlightTransactions + response = TaggedBusResponse { + tag = clientRequest.tag; + busResponse = responseUnMapped + } + clientResponseArbiterSlot.request - - + dispatchByClientWire := DispatchResponse response addRules |> foldr (<+>) (rules {}) clientRules diff --git a/bs/BusTypes.bs b/bs/BusTypes.bs index ed6de3b..7746669 100644 --- a/bs/BusTypes.bs +++ b/bs/BusTypes.bs @@ -1,6 +1,6 @@ package BusTypes( Bus(..), - ServerIdx, + MkServerIdx, MkClientTagType, BusClient(..), BusServer(..), BusRequest(..), BusResponse(..), @@ -14,7 +14,7 @@ import Vector import TagEngine type MkClientTagType numClients = (UInt (TLog numClients)) -type ServerIdx = Integer +type MkServerIdx numServers = (UInt (TLog numServers)) data BusError = UnMapped diff --git a/diagrams/bus.drawio b/diagrams/bus.drawio index 97ba9e7..fb90bc2 100644 --- a/diagrams/bus.drawio +++ b/diagrams/bus.drawio @@ -1,272 +1,278 @@ - + - + - + + + + + + + - + - - + + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - - - - + + + + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + @@ -277,7 +283,7 @@ - + @@ -288,7 +294,7 @@ - + @@ -299,7 +305,7 @@ - + @@ -310,50 +316,84 @@ - - - - + + + + - + - - - - + + + + - + - - - - + + + + - + - - - - + + + + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -- 2.48.1 From cd3d728083b1a9231375507124d6a88d896431d9 Mon Sep 17 00:00:00 2001 From: Yehowshua Immanuel Date: Mon, 14 Apr 2025 14:33:13 -0400 Subject: [PATCH 18/23] some prep work to towards having a server accept a request --- bs/Bus.bs | 14 +++++++++++--- bs/BusTypes.bs | 2 +- 2 files changed, 12 insertions(+), 4 deletions(-) diff --git a/bs/Bus.bs b/bs/Bus.bs index 4a516f4..5e6ddfe 100644 --- a/bs/Bus.bs +++ b/bs/Bus.bs @@ -72,6 +72,14 @@ mkBus serverMap = do clientResponseQueues :: Vector numClients (FIFOF (TaggedBusResponse inFlightTransactions)) clientResponseQueues <- replicateM (mkSizedBypassFIFOF (valueOf inFlightTransactions)) + -- The following two vectors of FIFOs make it easier to push/pull data to/from internal + -- server methods: + consumeRequestQueues :: Vector numServers (FIFOF (TaggedBusResponse inFlightTransactions)) + consumeRequestQueues <- replicateM mkBypassFIFOF + + submitResponseQueues :: Vector numServers (FIFOF (TaggedBusResponse inFlightTransactions)) + submitResponseQueues <- replicateM mkBypassFIFOF + let clientRules :: Vector numClients (Rules) clientRules = genWith $ \clientIdx -> let @@ -82,7 +90,7 @@ mkBus serverMap = do "rule" : when True ==> do $display "Bus.bs:71" - (sprintf "request server from client %d" clientIdx): when True ==> do + (sprintf "dispatch client request %d" clientIdx): when True ==> do let clientRequest :: TaggedBusRequest inFlightTransactions clientRequest = selectedClientRequestQueue.first @@ -162,11 +170,11 @@ mkBus serverMap = do let servers :: Vector numServers (BusServer inFlightTransactions numClients) servers = genWith $ \serverIdx -> interface BusServer - consumeRequest :: ActionValue (MkTagType inFlightTransactions, BusRequest) + consumeRequest :: ActionValue (TaggedBusRequest inFlightTransactions) consumeRequest = do dummyVar := (not dummyVar) let dummyBusRequest = BusReadRequest (ReadRequest 0 SizeByte) - return (0, dummyBusRequest) + return (TaggedBusRequest {tag = 0; busRequest = dummyBusRequest}) submitResponse :: ( MkClientTagType numClients, TaggedBusResponse inFlightTransactions diff --git a/bs/BusTypes.bs b/bs/BusTypes.bs index 7746669..ed8838e 100644 --- a/bs/BusTypes.bs +++ b/bs/BusTypes.bs @@ -102,7 +102,7 @@ interface (BusClient :: # -> *) inFlightTransactions = -- received from `consumeRequest`, ensuring the response is correctly -- associated with the original request. interface (BusServer :: # -> # -> *) inFlightTransactions numClients = - consumeRequest :: ActionValue (MkTagType inFlightTransactions, BusRequest) + consumeRequest :: ActionValue (TaggedBusRequest inFlightTransactions) submitResponse :: ( MkClientTagType numClients, TaggedBusResponse inFlightTransactions ) -> Action -- 2.48.1 From 180eeeefbed7c5ed6edee281feae0d1f86c2b870 Mon Sep 17 00:00:00 2001 From: Yehowshua Immanuel Date: Tue, 15 Apr 2025 13:50:50 -0400 Subject: [PATCH 19/23] we may not need dispatch by client --- bs/Bus.bs | 14 +- diagrams/bus.drawio | 393 +++++++++++++++++++++++--------------------- 2 files changed, 214 insertions(+), 193 deletions(-) diff --git a/bs/Bus.bs b/bs/Bus.bs index 5e6ddfe..62d13ac 100644 --- a/bs/Bus.bs +++ b/bs/Bus.bs @@ -27,7 +27,7 @@ dummyRule = data DispatchFromClient inFlightTransactions numServers = DispatchRequest (TaggedBusRequest inFlightTransactions) (MkServerIdx numServers) - | DispatchResponse (TaggedBusResponse inFlightTransactions) + | BypassResponse (TaggedBusResponse inFlightTransactions) deriving (Bits, Eq, FShow) -- we need a way to make serverMap safer... @@ -57,7 +57,7 @@ mkBus serverMap = do -- There are `numServer` servers, each of which needs its own arbiter as -- there are up to `numClient` clients that may wish to submit a response - -- to a given client. + -- to a given server. requestArbiterByServer :: Vector numServers (Arbiter.Arbiter_IFC numClients) requestArbiterByServer <- replicateM (mkArbiter False) @@ -87,9 +87,6 @@ mkBus serverMap = do selectedClientRequestQueue = (select clientRequestQueues clientIdx) in rules - "rule" : when True ==> do - $display "Bus.bs:71" - (sprintf "dispatch client request %d" clientIdx): when True ==> do let clientRequest :: TaggedBusRequest inFlightTransactions @@ -126,13 +123,13 @@ mkBus serverMap = do BusReadRequest _ -> BusReadResponse (Left UnMapped) BusWriteRequest _ -> BusWriteResponse (Left UnMapped) response :: TaggedBusResponse inFlightTransactions - response = TaggedBusResponse { - tag = clientRequest.tag; + response = TaggedBusResponse { + tag = clientRequest.tag; busResponse = responseUnMapped } clientResponseArbiterSlot.request - dispatchByClientWire := DispatchResponse response + dispatchByClientWire := BypassResponse response addRules |> foldr (<+>) (rules {}) clientRules @@ -163,6 +160,7 @@ mkBus serverMap = do let busResponse :: (TaggedBusResponse inFlightTransactions) busResponse = selectedClientResponseQueue.first + selectedTagEngine.retireTag busResponse.tag selectedClientResponseQueue.deq return busResponse diff --git a/diagrams/bus.drawio b/diagrams/bus.drawio index fb90bc2..442e443 100644 --- a/diagrams/bus.drawio +++ b/diagrams/bus.drawio @@ -1,399 +1,422 @@ - + - + - - + + - - + + - + - + - - + + - - + + - - + + - + - + - + - + - + - + - + - + - + - - + + - + - - + + - - + + - - + + - + - - - - - - - - - - - - - - + + - - - - - - - + - - + + - + - - + + + - + + + + + + + - - + + - + + + + + + + + + + + + + - - + + - + - + - - + + - - + + - - + + - + - + - + - + - + - + - + - + - + - - + + - + - - + + - - + + - - + + - + - - + + - + - - + + - + - - + + - - + + - - + + - + - - + + - + - - + + - + - - + + - + - - + + - - - - + + + + - - + + - + - - + + - - + + - - - - - - - - - - - - - - + + + - - + + - - - - + + + + - - + + - - - - + + + + - - + + - + + + + + + + + + + + + - - - - - - - - - - - - + - - + + - - - - + + + + - + + - - - - + + + + - - + - + + + + + + + + + + + + - + - + - + + + + + + + + + + + + + + + + + + + + + + + -- 2.48.1 From f3acae0c1cc42a67117aa5bed3f807e4f97bfdb2 Mon Sep 17 00:00:00 2001 From: Yehowshua Immanuel Date: Tue, 15 Apr 2025 14:15:49 -0400 Subject: [PATCH 20/23] potential scaffolding for new approach --- bs/Bus.bs | 26 ++++++-------------------- 1 file changed, 6 insertions(+), 20 deletions(-) diff --git a/bs/Bus.bs b/bs/Bus.bs index 62d13ac..335b2e6 100644 --- a/bs/Bus.bs +++ b/bs/Bus.bs @@ -25,11 +25,6 @@ dummyRule = "test rule": when True ==> do $display "test rule" -data DispatchFromClient inFlightTransactions numServers - = DispatchRequest (TaggedBusRequest inFlightTransactions) (MkServerIdx numServers) - | BypassResponse (TaggedBusResponse inFlightTransactions) - deriving (Bits, Eq, FShow) - -- we need a way to make serverMap safer... mkBus :: (Addr -> Maybe (MkServerIdx numServers)) -> Module (Bus inFlightTransactions numClients numServers) @@ -48,13 +43,6 @@ mkBus serverMap = do responseArbiterByClient :: Vector numClients (Arbiter.Arbiter_IFC (TAdd numServers 1)) responseArbiterByClient <- replicateM (mkArbiter False) - -- After we inspect the head/oldest request in the `clientRequestQueues` and perform an - -- arbiter request to the destination arbiter, we need to inspect for grant in another - -- rule as I don't believe grant and request can be called simultaneously. - -- The following vector allows us to move - dispatchByClient :: Vector numClients (Wire (DispatchFromClient inFlightTransactions numServers)) - dispatchByClient <- replicateM mkWire - -- There are `numServer` servers, each of which needs its own arbiter as -- there are up to `numClient` clients that may wish to submit a response -- to a given server. @@ -87,17 +75,13 @@ mkBus serverMap = do selectedClientRequestQueue = (select clientRequestQueues clientIdx) in rules - (sprintf "dispatch client request %d" clientIdx): when True ==> do + (sprintf "client[%d] route request" clientIdx): when True ==> do let clientRequest :: TaggedBusRequest inFlightTransactions clientRequest = selectedClientRequestQueue.first targetAddr :: Addr = busRequestToAddr |> clientRequest.busRequest targetServerIdx :: (Maybe (MkServerIdx numServers)) = serverMap targetAddr - - dispatchByClientWire :: Wire (DispatchFromClient inFlightTransactions numServers) - dispatchByClientWire = (select dispatchByClient clientIdx) - case targetServerIdx of Just serverIdx -> do let @@ -106,7 +90,6 @@ mkBus serverMap = do arbiterClientSlot :: Arbiter.ArbiterClient_IFC arbiterClientSlot = (select targetServerArbiter.clients clientIdx) arbiterClientSlot.request - dispatchByClientWire := DispatchRequest clientRequest serverIdx Nothing -> do let targetClientResponseArbiter :: Arbiter.Arbiter_IFC (TAdd numServers 1) @@ -119,6 +102,7 @@ mkBus serverMap = do -- and should instead forward the `BusError UnMapped` response -- back to the client. Vector.last selects arbiter `n` clientResponseArbiterSlot = Vector.last targetClientResponseArbiter.clients + let responseUnMapped = case clientRequest.busRequest of BusReadRequest _ -> BusReadResponse (Left UnMapped) BusWriteRequest _ -> BusWriteResponse (Left UnMapped) @@ -127,9 +111,11 @@ mkBus serverMap = do tag = clientRequest.tag; busResponse = responseUnMapped } - clientResponseArbiterSlot.request - dispatchByClientWire := BypassResponse response + + (sprintf "client[%d] arbit server response" clientIdx): when True ==> do + return |> action {} + addRules |> foldr (<+>) (rules {}) clientRules -- 2.48.1 From a58c836981df55a81232d8325b0088b9dbe432ea Mon Sep 17 00:00:00 2001 From: Yehowshua Immanuel Date: Tue, 15 Apr 2025 18:21:42 -0400 Subject: [PATCH 21/23] worked on client arbiter but need to consider if starving is possible when multiple client arbiters grant access to the same server --- bs/Bus.bs | 49 ++++++++++++++++++++++++++++++++++++++++++--- diagrams/bus.drawio | 8 ++++---- 2 files changed, 50 insertions(+), 7 deletions(-) diff --git a/bs/Bus.bs b/bs/Bus.bs index 335b2e6..e2545f9 100644 --- a/bs/Bus.bs +++ b/bs/Bus.bs @@ -26,7 +26,8 @@ dummyRule = $display "test rule" -- we need a way to make serverMap safer... -mkBus :: (Addr -> Maybe (MkServerIdx numServers)) +mkBus :: (Add n (TLog numServers) (TLog (TAdd numServers 1))) + => (Addr -> Maybe (MkServerIdx numServers)) -> Module (Bus inFlightTransactions numClients numServers) mkBus serverMap = do -- Tag engines for each client to manage transaction tags @@ -113,9 +114,51 @@ mkBus serverMap = do } clientResponseArbiterSlot.request - (sprintf "client[%d] arbit server response" clientIdx): when True ==> do - return |> action {} + (sprintf "client[%d] arbit submission" clientIdx): when True ==> do + let + selectedClientResponseArbiter :: Arbiter.Arbiter_IFC (TAdd numServers 1) + selectedClientResponseArbiter = (select responseArbiterByClient clientIdx) + selectedClientResponseQueue :: FIFOF (TaggedBusResponse inFlightTransactions) + selectedClientResponseQueue = (select clientResponseQueues clientIdx) + + -- `TAdd numServers 1` because we can receive request from all servers + -- as well as a bypass requests from our one corresponding client request + -- queue + grantedIdx :: UInt (TLog (TAdd numServers 1)) + grantedIdx = unpack selectedClientResponseArbiter.grant_id + + isClientRequest :: Bool + isClientRequest = grantedIdx == fromInteger (valueOf numServers) + if isClientRequest then do + let + clientRequest :: TaggedBusRequest inFlightTransactions + clientRequest = selectedClientRequestQueue.first + + responseUnMapped :: BusResponse + responseUnMapped = case clientRequest.busRequest of + BusReadRequest _ -> BusReadResponse (Left UnMapped) + BusWriteRequest _ -> BusWriteResponse (Left UnMapped) + + response :: TaggedBusResponse inFlightTransactions + response = TaggedBusResponse { + tag = clientRequest.tag; + busResponse = responseUnMapped + } + selectedClientResponseQueue.enq response + selectedClientRequestQueue.deq + else do + let + grantedServerIdx :: MkServerIdx numServers + grantedServerIdx = truncate grantedIdx + + selectedSubmitResponseQueue :: FIFOF (TaggedBusResponse inFlightTransactions) + selectedSubmitResponseQueue = (select submitResponseQueues grantedServerIdx) + + response :: TaggedBusResponse inFlightTransactions + response = selectedSubmitResponseQueue.first + selectedClientResponseQueue.enq response + selectedSubmitResponseQueue.deq addRules |> foldr (<+>) (rules {}) clientRules diff --git a/diagrams/bus.drawio b/diagrams/bus.drawio index 442e443..1d3ed48 100644 --- a/diagrams/bus.drawio +++ b/diagrams/bus.drawio @@ -1,6 +1,6 @@ - + @@ -329,11 +329,11 @@ - - + + - + -- 2.48.1 From c28425f10c137c86adfd571c0e943c8472ed7328 Mon Sep 17 00:00:00 2001 From: Yehowshua Immanuel Date: Wed, 16 Apr 2025 16:55:45 -0400 Subject: [PATCH 22/23] first attempt at server rule, also implemented consumeRequest of the server part of the Bus interface --- bs/Bus.bs | 65 ++++++++++++++++++++++++++++++++++++--------- bs/BusTypes.bs | 5 +++- diagrams/bus.drawio | 10 +++---- 3 files changed, 62 insertions(+), 18 deletions(-) diff --git a/bs/Bus.bs b/bs/Bus.bs index e2545f9..680eb57 100644 --- a/bs/Bus.bs +++ b/bs/Bus.bs @@ -63,7 +63,12 @@ mkBus serverMap = do -- The following two vectors of FIFOs make it easier to push/pull data to/from internal -- server methods: - consumeRequestQueues :: Vector numServers (FIFOF (TaggedBusResponse inFlightTransactions)) + consumeRequestQueues :: Vector numServers ( + FIFOF ( + MkClientTagType numClients, + TaggedBusRequest inFlightTransactions + ) + ) consumeRequestQueues <- replicateM mkBypassFIFOF submitResponseQueues :: Vector numServers (FIFOF (TaggedBusResponse inFlightTransactions)) @@ -160,6 +165,33 @@ mkBus serverMap = do selectedClientResponseQueue.enq response selectedSubmitResponseQueue.deq + let serverRules :: Vector numServers (Rules) + serverRules = genWith $ \serverIdx -> + let + selectedServerArbiter :: Arbiter.Arbiter_IFC numClients + selectedServerArbiter = (select requestArbiterByServer serverIdx) + + selectedConsumeRequestQueue :: FIFOF ( + MkClientTagType numClients, + TaggedBusRequest inFlightTransactions + ) + selectedConsumeRequestQueue = (select consumeRequestQueues serverIdx) + in + rules + (sprintf "server[%d] handle request" 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 + addRules |> foldr (<+>) (rules {}) clientRules -- Client interface vector @@ -196,18 +228,27 @@ mkBus serverMap = do -- Server interface vector let servers :: Vector numServers (BusServer inFlightTransactions numClients) servers = genWith $ \serverIdx -> - interface BusServer - consumeRequest :: ActionValue (TaggedBusRequest inFlightTransactions) - consumeRequest = do - dummyVar := (not dummyVar) - let dummyBusRequest = BusReadRequest (ReadRequest 0 SizeByte) - return (TaggedBusRequest {tag = 0; busRequest = dummyBusRequest}) + let + selectedConsumeRequestQueue :: FIFOF ( + MkClientTagType numClients, + TaggedBusRequest inFlightTransactions + ) + selectedConsumeRequestQueue = (select consumeRequestQueues serverIdx) + in + interface BusServer + consumeRequest :: ActionValue ( + MkClientTagType numClients, + TaggedBusRequest inFlightTransactions + ) + consumeRequest = do + selectedConsumeRequestQueue.deq + return selectedConsumeRequestQueue.first - submitResponse :: ( MkClientTagType numClients, - TaggedBusResponse inFlightTransactions - ) -> Action - submitResponse (clientTag, taggedBusResponse) = do - dummyVar := (not dummyVar) + submitResponse :: ( MkClientTagType numClients, + TaggedBusResponse inFlightTransactions + ) -> Action + submitResponse (clientTag, taggedBusResponse) = do + dummyVar := (not dummyVar) return $ interface Bus diff --git a/bs/BusTypes.bs b/bs/BusTypes.bs index ed8838e..a5f344f 100644 --- a/bs/BusTypes.bs +++ b/bs/BusTypes.bs @@ -102,7 +102,10 @@ interface (BusClient :: # -> *) inFlightTransactions = -- received from `consumeRequest`, ensuring the response is correctly -- associated with the original request. interface (BusServer :: # -> # -> *) inFlightTransactions numClients = - consumeRequest :: ActionValue (TaggedBusRequest inFlightTransactions) + consumeRequest :: ActionValue ( + MkClientTagType numClients, + TaggedBusRequest inFlightTransactions + ) submitResponse :: ( MkClientTagType numClients, TaggedBusResponse inFlightTransactions ) -> Action diff --git a/diagrams/bus.drawio b/diagrams/bus.drawio index 1d3ed48..7f93ffd 100644 --- a/diagrams/bus.drawio +++ b/diagrams/bus.drawio @@ -1,6 +1,6 @@ - + @@ -91,7 +91,7 @@ - + @@ -117,7 +117,7 @@ - + @@ -223,7 +223,7 @@ - + @@ -248,7 +248,7 @@ - + -- 2.48.1 From ece1f865742a3431356e41a7b9182d677475ebca Mon Sep 17 00:00:00 2001 From: Yehowshua Immanuel Date: Wed, 16 Apr 2025 17:58:29 -0400 Subject: [PATCH 23/23] in theory bus is now complete --- bs/Bus.bs | 73 +++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 52 insertions(+), 21 deletions(-) diff --git a/bs/Bus.bs b/bs/Bus.bs index 680eb57..4a8bb31 100644 --- a/bs/Bus.bs +++ b/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) @@ -61,9 +56,9 @@ mkBus serverMap = do clientResponseQueues :: Vector numClients (FIFOF (TaggedBusResponse inFlightTransactions)) clientResponseQueues <- replicateM (mkSizedBypassFIFOF (valueOf inFlightTransactions)) - -- The following two vectors of FIFOs make it easier to push/pull data to/from internal + -- The following two vectors of FIFOs make it easier to push/pull data to/from internal -- server methods: - consumeRequestQueues :: Vector numServers ( + consumeRequestQueues :: Vector numServers ( FIFOF ( MkClientTagType numClients, TaggedBusRequest inFlightTransactions @@ -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) @@ -102,9 +102,9 @@ mkBus serverMap = do targetClientResponseArbiter = (select responseArbiterByClient clientIdx) clientResponseArbiterSlot :: Arbiter.ArbiterClient_IFC - -- arbiters 0 to n-1 where `n:=numServer` are reserved - -- for servers to make requests to. Arbiter n is reserved for - -- when this rule needs to skip making a request to a server + -- arbiters 0 to n-1 where `n:=numServer` are reserved + -- for servers to make requests to. Arbiter n is reserved for + -- when this rule needs to skip making a request to a server -- and should instead forward the `BusError UnMapped` response -- back to the client. Vector.last selects arbiter `n` clientResponseArbiterSlot = Vector.last targetClientResponseArbiter.clients @@ -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 -- 2.48.1