diff --git a/.gitignore b/.gitignore index 9291deb..85c69dc 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,4 @@ *.vcd -*.bkp *.so # bluespec files diff --git a/Makefile b/Makefile index d92f15a..7579e84 100644 --- a/Makefile +++ b/Makefile @@ -51,6 +51,7 @@ 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 4a8bb31..0faaa54 100644 --- a/bs/Bus.bs +++ b/bs/Bus.bs @@ -1,287 +1,7 @@ -package Bus(mkBus, Bus(..)) where +package Bus(a) where import Types import BusTypes -import TagEngine -import Vector -import Util -import Arbiter -import FIFO -import FIFOF -import SpecialFIFOs -import Printf -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 +a :: UInt 5 +a = 3 diff --git a/bs/BusTypes.bs b/bs/BusTypes.bs index a5f344f..99d0fb4 100644 --- a/bs/BusTypes.bs +++ b/bs/BusTypes.bs @@ -1,20 +1,12 @@ package BusTypes( - Bus(..), - MkServerIdx, - MkClientTagType, - BusClient(..), BusServer(..), - BusRequest(..), BusResponse(..), - ReadRequest(..), ReadResponse(..), WriteRequest(..), WriteResponse(..), - BusVal(..), BusError(..), TransactionSize(..), - TaggedBusRequest(..), TaggedBusResponse(..) + BusVal(..), + BusError(..), + TransactionSize(..), + ReadRequest(..), + WriteRequest(..) ) where import Types -import Vector -import TagEngine - -type MkClientTagType numClients = (UInt (TLog numClients)) -type MkServerIdx numServers = (UInt (TLog numServers)) data BusError = UnMapped @@ -48,7 +40,7 @@ type WriteResponse = Either BusError () data BusRequest = BusReadRequest ReadRequest - | BusWriteRequest WriteRequest + | WriteReadRequest WriteRequest deriving (Bits, Eq, FShow) data BusResponse @@ -56,60 +48,21 @@ data BusResponse | BusWriteResponse WriteResponse deriving (Bits, Eq, FShow) -struct TaggedBusRequest inFlightTransactions = - { tag :: (MkTagType inFlightTransactions); - busRequest :: BusRequest - } - 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 TaggedBusResponse inFlightTransactions = - { tag :: (MkTagType inFlightTransactions); - busResponse :: BusResponse - } - deriving (Bits, Eq, FShow) +type Token = UInt 5 --- # 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) +a :: UInt 5 +a = 3 diff --git a/bs/ClkDivider.bs b/bs/ClkDivider.bs index cd94bc9..789489e 100644 --- a/bs/ClkDivider.bs +++ b/bs/ClkDivider.bs @@ -1,8 +1,4 @@ -package ClkDivider( - mkClkDivider, - MkClkDivType, - ClkDivider(..) - ) where +package ClkDivider(mkClkDivider, ClkDivider(..)) where interface (ClkDivider :: # -> *) hi = { @@ -11,13 +7,11 @@ interface (ClkDivider :: # -> *) hi = ;isHalfCycle :: Bool } -type MkClkDivType maxCycles = (UInt (TLog (TAdd 1 maxCycles))) - mkClkDivider :: Handle -> Module (ClkDivider hi) mkClkDivider fileHandle = do - counter <- mkReg(0 :: MkClkDivType hi) - let hi_value :: (MkClkDivType hi) = (fromInteger $ valueOf hi) - let half_hi_value :: (MkClkDivType hi) = (fromInteger $ valueOf (TDiv hi 2)) + 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)) 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 2ef5fd9..1b821ec 100644 --- a/bs/Core.bs +++ b/bs/Core.bs @@ -11,13 +11,13 @@ interface (Core :: # -> *) clkFreq = { mkCore :: Module (Core clkFreq) mkCore = do - counter :: Reg (MkClkDivType clkFreq) <- mkReg 0 + counter :: Reg (UInt (TLog 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 :: (MkClkDivType clkFreq) = fromInteger clkFreqInt + let clkFreqUInt :: UInt (TLog clkFreq) = fromInteger clkFreqInt let val :: Real = fromInteger clkFreqInt messageM $ "mkCore clkFreq" + realToString val diff --git a/bs/TagEngine.bs b/bs/TagEngine.bs index 8b12b9d..921e58e 100644 --- a/bs/TagEngine.bs +++ b/bs/TagEngine.bs @@ -1,5 +1,4 @@ package TagEngine( - MkTagType, TagEngine(..), Util.BasicResult(..), mkTagEngine) where @@ -7,13 +6,14 @@ package TagEngine( import Vector import Util import FIFO +import FIFOF import SpecialFIFOs -type MkTagType numTags = (UInt (TLog (TAdd 1 numTags))) +#define UIntLog2N(n) (UInt (TLog n)) interface (TagEngine :: # -> *) numTags = - requestTag :: ActionValue (MkTagType numTags) - retireTag :: (MkTagType numTags) -> Action + requestTag :: ActionValue UIntLog2N(numTags) + retireTag :: UIntLog2N(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 <- mkSizedFIFO maxTagCount -- Queue of available tags + freeTagQueue <- mkSizedFIFOF 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 (MkTagType numTags) + requestTag :: ActionValue UIntLog2N(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 :: (MkTagType numTags) -> Action + retireTag :: UIntLog2N(numTags) -> Action retireTag tag = do let diff --git a/bs/Top.bs b/bs/Top.bs index a0816a0..f4f1cda 100644 --- a/bs/Top.bs +++ b/bs/Top.bs @@ -10,9 +10,6 @@ import TagEngine import List import ActionSeq -import Vector -import BusTypes - import TagEngineTester type FCLK = 25000000 @@ -60,18 +57,11 @@ mkTop = do mkSim :: Module Empty mkSim = do _ :: Empty <- mkTagEngineTester - initCFunctions :: Reg Bool <- mkReg False - core :: Core FCLK <- mkCore - let busMap _ = Just 0 - bus :: (Bus 4 2 2) <- mkBus busMap + initCFunctions :: Reg Bool <- mkReg False; + core :: Core FCLK <- mkCore; 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 deleted file mode 100644 index 7f93ffd..0000000 --- a/diagrams/bus.drawio +++ /dev/null @@ -1,423 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -