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/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 0faaa54..4a8bb31 100644 --- a/bs/Bus.bs +++ b/bs/Bus.bs @@ -1,7 +1,287 @@ -package Bus(a) where +package Bus(mkBus, Bus(..)) where import Types import BusTypes +import TagEngine +import Vector +import Util +import Arbiter +import FIFO +import FIFOF +import SpecialFIFOs +import Printf -a :: UInt 5 -a = 3 +busRequestToAddr :: BusRequest -> Addr +busRequestToAddr req = case req of + BusReadRequest (ReadRequest addr _) -> addr + BusWriteRequest (WriteRequest addr _) -> addr + +-- 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) +mkBus serverMap = do + -- Tag engines for each client to manage transaction tags + 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. 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. + responseArbiterByClient :: Vector numClients (Arbiter.Arbiter_IFC (TAdd numServers 1)) + responseArbiterByClient <- 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 server. + requestArbiterByServer :: Vector numServers (Arbiter.Arbiter_IFC numClients) + requestArbiterByServer <- replicateM (mkArbiter False) + + dummyVar :: Reg(Bool) + dummyVar <- mkReg False + + -- Queues to hold requests from clients + clientRequestQueues :: Vector numClients (FIFOF (TaggedBusRequest inFlightTransactions)) + clientRequestQueues <- replicateM (mkSizedBypassFIFOF (valueOf inFlightTransactions)) + + -- Queues to hold responses to clients + 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 ( + MkClientTagType numClients, + TaggedBusRequest inFlightTransactions + ) + ) + consumeRequestQueues <- replicateM mkBypassFIFOF + + submitResponseQueues :: Vector numServers ( + FIFOF ( + MkClientTagType numClients, + TaggedBusResponse inFlightTransactions + ) + ) + submitResponseQueues <- replicateM mkBypassFIFOF + + let clientRules :: Vector numClients (Rules) + clientRules = genWith $ \clientIdx -> + let + selectedClientRequestQueue :: FIFOF (TaggedBusRequest inFlightTransactions) + selectedClientRequestQueue = (select clientRequestQueues clientIdx) + in + rules + (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 + 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 + let + targetClientResponseArbiter :: Arbiter.Arbiter_IFC (TAdd numServers 1) + 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 + -- 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) + response :: TaggedBusResponse inFlightTransactions + response = TaggedBusResponse { + tag = clientRequest.tag; + busResponse = responseUnMapped + } + clientResponseArbiterSlot.request + + (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 ( + MkClientTagType numClients, + TaggedBusResponse inFlightTransactions + ) + selectedSubmitResponseQueue = (select submitResponseQueues grantedServerIdx) + + response :: (MkClientTagType numClients, TaggedBusResponse inFlightTransactions) + response = selectedSubmitResponseQueue.first + selectedClientResponseQueue.enq response.snd + 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] arbit requests" serverIdx): when True ==> do + let + grantedClientIdx :: MkClientTagType numClients + grantedClientIdx = unpack selectedServerArbiter.grant_id + + selectedClientRequestQueue :: FIFOF (TaggedBusRequest inFlightTransactions) + selectedClientRequestQueue = (select clientRequestQueues grantedClientIdx) + + clientRequest :: TaggedBusRequest inFlightTransactions + clientRequest = selectedClientRequestQueue.first + + selectedConsumeRequestQueue.enq (grantedClientIdx, clientRequest) + selectedClientRequestQueue.deq + + (sprintf "server[%d] route response" serverIdx): when True ==> do + let + selectedSubmitResponseQueue :: FIFOF ( + MkClientTagType numClients, + TaggedBusResponse inFlightTransactions + ) + selectedSubmitResponseQueue = (select submitResponseQueues serverIdx) + + response :: (MkClientTagType numClients, TaggedBusResponse inFlightTransactions) + response = selectedSubmitResponseQueue.first + + clientTag :: MkClientTagType numClients + clientTag = response.fst + + targetClientResponseArbiter :: Arbiter.Arbiter_IFC (TAdd numServers 1) + targetClientResponseArbiter = (select responseArbiterByClient clientTag) + + arbiterClientSlot :: Arbiter.ArbiterClient_IFC + arbiterClientSlot = (select targetClientResponseArbiter.clients serverIdx) + arbiterClientSlot.request + + addRules |> foldr (<+>) (rules {}) clientRules + addRules |> foldr (<+>) (rules {}) serverRules + + -- Client interface vector + let clients :: Vector numClients (BusClient inFlightTransactions) + clients = genWith $ \clientIdx -> + let + selectedClientRequestQueue :: FIFOF (TaggedBusRequest inFlightTransactions) + selectedClientRequestQueue = (select clientRequestQueues clientIdx) + + selectedClientResponseQueue :: FIFOF (TaggedBusResponse inFlightTransactions) + selectedClientResponseQueue = (select clientResponseQueues clientIdx) + + selectedTagEngine :: TagEngine inFlightTransactions + selectedTagEngine = (select tagEngineByClientVec clientIdx) + in + interface BusClient + submitRequest :: BusRequest + -> ActionValue (MkTagType inFlightTransactions) + submitRequest busRequest = do + tag <- selectedTagEngine.requestTag + let taggedReuqest = TaggedBusRequest {tag = tag; busRequest = busRequest} + selectedClientRequestQueue.enq taggedReuqest + return tag + + consumeResponse :: ActionValue (TaggedBusResponse inFlightTransactions) + consumeResponse = do + let + busResponse :: (TaggedBusResponse inFlightTransactions) + busResponse = selectedClientResponseQueue.first + selectedTagEngine.retireTag busResponse.tag + selectedClientResponseQueue.deq + return busResponse + + -- Server interface vector + let servers :: Vector numServers (BusServer inFlightTransactions numClients) + servers = genWith $ \serverIdx -> + 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 + let + selectedSubmitResponseQueue :: FIFOF ( + MkClientTagType numClients, + TaggedBusResponse inFlightTransactions + ) + selectedSubmitResponseQueue = (select submitResponseQueues serverIdx) + selectedSubmitResponseQueue.enq (clientTag, taggedBusResponse) + + return $ + interface Bus + clients = clients + servers = servers diff --git a/bs/BusTypes.bs b/bs/BusTypes.bs index 99d0fb4..a5f344f 100644 --- a/bs/BusTypes.bs +++ b/bs/BusTypes.bs @@ -1,12 +1,20 @@ package BusTypes( - BusVal(..), - BusError(..), - TransactionSize(..), - ReadRequest(..), - WriteRequest(..) + Bus(..), + MkServerIdx, + MkClientTagType, + BusClient(..), BusServer(..), + BusRequest(..), BusResponse(..), + ReadRequest(..), ReadResponse(..), WriteRequest(..), WriteResponse(..), + BusVal(..), BusError(..), TransactionSize(..), + TaggedBusRequest(..), TaggedBusResponse(..) ) where import Types +import Vector +import TagEngine + +type MkClientTagType numClients = (UInt (TLog numClients)) +type MkServerIdx numServers = (UInt (TLog numServers)) data BusError = UnMapped @@ -40,7 +48,7 @@ type WriteResponse = Either BusError () data BusRequest = BusReadRequest ReadRequest - | WriteReadRequest WriteRequest + | BusWriteRequest WriteRequest deriving (Bits, Eq, FShow) data BusResponse @@ -48,21 +56,60 @@ 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 +struct TaggedBusRequest inFlightTransactions = + { tag :: (MkTagType inFlightTransactions); + busRequest :: BusRequest + } + deriving (Bits, Eq, FShow) -type Token = UInt 5 +struct TaggedBusResponse inFlightTransactions = + { tag :: (MkTagType inFlightTransactions); + busResponse :: BusResponse + } + deriving (Bits, Eq, FShow) -a :: UInt 5 -a = 3 +-- # 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 = + submitRequest :: BusRequest + -> ActionValue (MkTagType inFlightTransactions) + consumeResponse :: ActionValue (TaggedBusResponse 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 ( + MkClientTagType numClients, + TaggedBusRequest inFlightTransactions + ) + submitResponse :: ( MkClientTagType numClients, + TaggedBusResponse inFlightTransactions + ) -> Action + +interface (Bus :: # -> # -> # -> *) inFlightTransactions numClients numServers = + clients :: Vector numClients (BusClient inFlightTransactions) + servers :: Vector numServers (BusServer inFlightTransactions numClients) 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 921e58e..8b12b9d 100644 --- a/bs/TagEngine.bs +++ b/bs/TagEngine.bs @@ -1,4 +1,5 @@ package TagEngine( + MkTagType, TagEngine(..), Util.BasicResult(..), mkTagEngine) where @@ -6,14 +7,13 @@ package TagEngine( import Vector import Util import FIFO -import FIFOF import SpecialFIFOs -#define UIntLog2N(n) (UInt (TLog n)) +type MkTagType numTags = (UInt (TLog (TAdd 1 numTags))) interface (TagEngine :: # -> *) numTags = - requestTag :: ActionValue UIntLog2N(numTags) - retireTag :: UIntLog2N(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 @@ -34,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 @@ -44,7 +44,7 @@ mkTagEngine = do debugOnce <- mkReg True -- Rules - addRules $ + addRules |> rules "debug_initial_state": when debugOnce ==> do $display "tagUsage: " (fshow (readVReg tagUsage)) @@ -77,9 +77,9 @@ mkTagEngine = do (Nothing, Nothing) -> action {} -- Interface - return $ + return |> interface TagEngine - requestTag :: ActionValue UIntLog2N(numTags) + requestTag :: ActionValue (MkTagType numTags) requestTag = do case initialTagDistributor of Just 0 -> do @@ -100,7 +100,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 :: (MkTagType numTags) -> Action retireTag tag = do let diff --git a/bs/Top.bs b/bs/Top.bs index f4f1cda..a0816a0 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 "Top.bs:74" (fshow result) "initCFunctionsOnce": when not initCFunctions ==> do initTerminal diff --git a/diagrams/bus.drawio b/diagrams/bus.drawio new file mode 100644 index 0000000..7f93ffd --- /dev/null +++ b/diagrams/bus.drawio @@ -0,0 +1,423 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +