Compare commits
24 commits
b326ac894e
...
7d470fbed0
Author | SHA1 | Date | |
---|---|---|---|
|
7d470fbed0 | ||
|
ece1f86574 | ||
![]() |
c28425f10c | ||
![]() |
a58c836981 | ||
![]() |
f3acae0c1c | ||
![]() |
180eeeefbe | ||
![]() |
cd3d728083 | ||
![]() |
373d170c3f | ||
![]() |
98f2f5cdfd | ||
![]() |
813f543b42 | ||
|
628319709e | ||
![]() |
45191a2abd | ||
![]() |
cffbadd1cc | ||
![]() |
5efef8b19c | ||
![]() |
548a2f26bd | ||
![]() |
71fbb7d2e5 | ||
|
c9356eecfd | ||
|
979adf3660 | ||
|
ca02c88be3 | ||
![]() |
076d3aed43 | ||
|
b4c7537a85 | ||
|
989c4e9616 | ||
|
fe2fa21fcc | ||
|
da761f6e4e |
1
.gitignore
vendored
1
.gitignore
vendored
|
@ -1,4 +1,5 @@
|
|||
*.vcd
|
||||
*.bkp
|
||||
*.so
|
||||
|
||||
# bluespec files
|
||||
|
|
1
Makefile
1
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)
|
||||
|
|
286
bs/Bus.bs
286
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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
14
bs/Top.bs
14
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
|
||||
|
|
423
diagrams/bus.drawio
Normal file
423
diagrams/bus.drawio
Normal file
|
@ -0,0 +1,423 @@
|
|||
<mxfile host="Electron" agent="Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/537.36 (KHTML, like Gecko) draw.io/26.0.16 Chrome/132.0.6834.196 Electron/34.2.0 Safari/537.36" version="26.0.16">
|
||||
<diagram name="simplified" id="y4uZzcGV7WDpy27g0Dv6">
|
||||
<mxGraphModel dx="673" dy="413" grid="1" gridSize="10" guides="1" tooltips="1" connect="1" arrows="1" fold="1" page="1" pageScale="1" pageWidth="850" pageHeight="1100" math="0" shadow="0">
|
||||
<root>
|
||||
<mxCell id="0" />
|
||||
<mxCell id="1" parent="0" />
|
||||
<mxCell id="svE0qh3njN4fsUmnxisL-6" value="" style="rounded=1;whiteSpace=wrap;html=1;fillColor=#f8cecc;strokeColor=#b85450;labelBackgroundColor=default;fontSize=10;" parent="1" vertex="1">
|
||||
<mxGeometry x="190" y="255" width="340" height="125" as="geometry" />
|
||||
</mxCell>
|
||||
<mxCell id="svE0qh3njN4fsUmnxisL-5" value="" style="rounded=1;whiteSpace=wrap;html=1;fillColor=#dae8fc;strokeColor=#6c8ebf;labelBackgroundColor=default;fontSize=10;" parent="1" vertex="1">
|
||||
<mxGeometry x="65" y="470" width="360" height="125" as="geometry" />
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-235" value="Client 1" style="rounded=1;whiteSpace=wrap;html=1;labelBackgroundColor=default;" parent="1" vertex="1">
|
||||
<mxGeometry x="80" y="80" width="200" height="40" as="geometry" />
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-236" value="submit<div>request</div>" style="endArrow=classic;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="1" edge="1">
|
||||
<mxGeometry x="-0.52" width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="130" y="120" as="sourcePoint" />
|
||||
<mxPoint x="130.00000000000006" y="380" as="targetPoint" />
|
||||
<mxPoint as="offset" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-237" value="<div>consume</div><div>response</div>" style="endArrow=classic;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="1" edge="1">
|
||||
<mxGeometry x="-0.0501" width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="240" y="160" as="sourcePoint" />
|
||||
<mxPoint x="239.68000000000006" y="120" as="targetPoint" />
|
||||
<mxPoint as="offset" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-238" value="" style="group;labelBackgroundColor=default;fontSize=10;" parent="1" vertex="1" connectable="0">
|
||||
<mxGeometry x="100" y="380" width="40" height="80" as="geometry" />
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-239" value="" style="rounded=1;whiteSpace=wrap;html=1;labelBackgroundColor=default;fontSize=10;" parent="DDLsznhKMAXYVWb-8vYK-238" vertex="1">
|
||||
<mxGeometry width="40" height="80" as="geometry" />
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-240" value="" style="endArrow=none;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="DDLsznhKMAXYVWb-8vYK-238" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="10" y="19.75" as="sourcePoint" />
|
||||
<mxPoint x="30" y="19.75" as="targetPoint" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-241" value="" style="endArrow=none;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="DDLsznhKMAXYVWb-8vYK-238" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="10" y="39.5" as="sourcePoint" />
|
||||
<mxPoint x="30" y="39.5" as="targetPoint" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-242" value="" style="endArrow=none;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="DDLsznhKMAXYVWb-8vYK-238" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="10" y="59.75" as="sourcePoint" />
|
||||
<mxPoint x="30" y="59.75" as="targetPoint" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-243" value="" style="group;labelBackgroundColor=default;fontSize=10;" parent="1" vertex="1" connectable="0">
|
||||
<mxGeometry x="220" y="160" width="40" height="80" as="geometry" />
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-244" value="" style="rounded=1;whiteSpace=wrap;html=1;labelBackgroundColor=default;fontSize=10;" parent="DDLsznhKMAXYVWb-8vYK-243" vertex="1">
|
||||
<mxGeometry width="40" height="80" as="geometry" />
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-245" value="" style="endArrow=none;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="DDLsznhKMAXYVWb-8vYK-243" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="10" y="19.75" as="sourcePoint" />
|
||||
<mxPoint x="30" y="19.75" as="targetPoint" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-246" value="" style="endArrow=none;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="DDLsznhKMAXYVWb-8vYK-243" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="10" y="39.5" as="sourcePoint" />
|
||||
<mxPoint x="30" y="39.5" as="targetPoint" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-247" value="" style="endArrow=none;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="DDLsznhKMAXYVWb-8vYK-243" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="10" y="59.75" as="sourcePoint" />
|
||||
<mxPoint x="30" y="59.75" as="targetPoint" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-270" value="Server 1" style="rounded=1;whiteSpace=wrap;html=1;labelBackgroundColor=default;fontSize=12;" parent="1" vertex="1">
|
||||
<mxGeometry x="80" y="640" width="200" height="40" as="geometry" />
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-274" value="" style="endArrow=classic;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="1" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="239.90999999999994" y="270" as="sourcePoint" />
|
||||
<mxPoint x="240" y="240" as="targetPoint" />
|
||||
<mxPoint as="offset" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-279" value="client1<div>arbiter</div>" style="rounded=1;whiteSpace=wrap;html=1;labelBackgroundColor=default;fontSize=11;" parent="1" vertex="1">
|
||||
<mxGeometry x="200" y="270" width="80" height="30" as="geometry" />
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-280" value="server1<div>router</div>" style="rounded=1;whiteSpace=wrap;html=1;labelBackgroundColor=default;fontSize=11;" parent="1" vertex="1">
|
||||
<mxGeometry x="200" y="340" width="80" height="30" as="geometry" />
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-281" value="request /<div>grant</div>" style="endArrow=classic;html=1;rounded=0;labelBackgroundColor=#F8CECC;fontSize=10;startArrow=classic;startFill=1;" parent="1" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="214.89" y="340" as="sourcePoint" />
|
||||
<mxPoint x="214.89" y="300" as="targetPoint" />
|
||||
<mxPoint as="offset" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-282" value="value" style="endArrow=classic;html=1;rounded=0;labelBackgroundColor=#F8CECC;fontSize=10;" parent="1" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="264.89" y="340" as="sourcePoint" />
|
||||
<mxPoint x="264.89" y="300" as="targetPoint" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-283" value="" style="endArrow=classic;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="1" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="119.69000000000017" y="460" as="sourcePoint" />
|
||||
<mxPoint x="119.68999999999994" y="480" as="targetPoint" />
|
||||
<mxPoint as="offset" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-284" value="client1<div>router</div>" style="rounded=1;whiteSpace=wrap;html=1;labelBackgroundColor=default;fontSize=11;" parent="1" vertex="1">
|
||||
<mxGeometry x="80" y="480" width="80" height="30" as="geometry" />
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-285" value="server1<div>arbiter</div>" style="rounded=1;whiteSpace=wrap;html=1;labelBackgroundColor=default;fontSize=11;" parent="1" vertex="1">
|
||||
<mxGeometry x="80" y="550" width="80" height="30" as="geometry" />
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-286" value="request /<div>grant</div>" style="endArrow=classic;html=1;rounded=0;labelBackgroundColor=#DAE8FC;fontSize=10;startArrow=classic;startFill=1;" parent="1" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="94.88999999999999" y="510" as="sourcePoint" />
|
||||
<mxPoint x="94.88999999999999" y="550" as="targetPoint" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-287" value="value" style="endArrow=classic;html=1;rounded=0;labelBackgroundColor=#DAE8FC;fontSize=10;" parent="1" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="144.89" y="510" as="sourcePoint" />
|
||||
<mxPoint x="144.89" y="550" as="targetPoint" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-288" value="consume<div>request</div>" style="endArrow=classic;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="1" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="119.67999999999995" y="580" as="sourcePoint" />
|
||||
<mxPoint x="119.67999999999995" y="640" as="targetPoint" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-289" value="<div><br></div><div>submit</div><div>response</div>" style="endArrow=classic;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="1" edge="1">
|
||||
<mxGeometry x="0.7037" width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="250" y="640" as="sourcePoint" />
|
||||
<mxPoint x="250" y="370" as="targetPoint" />
|
||||
<mxPoint as="offset" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-290" value="Client 2" style="rounded=1;whiteSpace=wrap;html=1;labelBackgroundColor=default;" parent="1" vertex="1">
|
||||
<mxGeometry x="320" y="80" width="200" height="40" as="geometry" />
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-291" value="submit<div>request</div>" style="endArrow=classic;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="1" edge="1">
|
||||
<mxGeometry x="-0.2" width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="370" y="120" as="sourcePoint" />
|
||||
<mxPoint x="370.00000000000006" y="380" as="targetPoint" />
|
||||
<mxPoint as="offset" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-292" value="<div>consume</div><div>response</div>" style="endArrow=classic;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="1" edge="1">
|
||||
<mxGeometry x="-0.0501" width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="480" y="160" as="sourcePoint" />
|
||||
<mxPoint x="479.68000000000006" y="120" as="targetPoint" />
|
||||
<mxPoint as="offset" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-293" value="" style="group;labelBackgroundColor=default;fontSize=10;" parent="1" vertex="1" connectable="0">
|
||||
<mxGeometry x="340" y="380" width="40" height="80" as="geometry" />
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-294" value="" style="rounded=1;whiteSpace=wrap;html=1;labelBackgroundColor=default;fontSize=10;" parent="DDLsznhKMAXYVWb-8vYK-293" vertex="1">
|
||||
<mxGeometry width="40" height="80" as="geometry" />
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-295" value="" style="endArrow=none;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="DDLsznhKMAXYVWb-8vYK-293" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="10" y="19.75" as="sourcePoint" />
|
||||
<mxPoint x="30" y="19.75" as="targetPoint" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-296" value="" style="endArrow=none;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="DDLsznhKMAXYVWb-8vYK-293" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="10" y="39.5" as="sourcePoint" />
|
||||
<mxPoint x="30" y="39.5" as="targetPoint" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-297" value="" style="endArrow=none;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="DDLsznhKMAXYVWb-8vYK-293" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="10" y="59.75" as="sourcePoint" />
|
||||
<mxPoint x="30" y="59.75" as="targetPoint" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-298" value="" style="group;labelBackgroundColor=default;fontSize=10;" parent="1" vertex="1" connectable="0">
|
||||
<mxGeometry x="460" y="160" width="40" height="80" as="geometry" />
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-299" value="" style="rounded=1;whiteSpace=wrap;html=1;labelBackgroundColor=default;fontSize=10;" parent="DDLsznhKMAXYVWb-8vYK-298" vertex="1">
|
||||
<mxGeometry width="40" height="80" as="geometry" />
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-300" value="" style="endArrow=none;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="DDLsznhKMAXYVWb-8vYK-298" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="10" y="19.75" as="sourcePoint" />
|
||||
<mxPoint x="30" y="19.75" as="targetPoint" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-301" value="" style="endArrow=none;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="DDLsznhKMAXYVWb-8vYK-298" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="10" y="39.5" as="sourcePoint" />
|
||||
<mxPoint x="30" y="39.5" as="targetPoint" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-302" value="" style="endArrow=none;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="DDLsznhKMAXYVWb-8vYK-298" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="10" y="59.75" as="sourcePoint" />
|
||||
<mxPoint x="30" y="59.75" as="targetPoint" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-303" value="Server 2" style="rounded=1;whiteSpace=wrap;html=1;labelBackgroundColor=default;fontSize=12;" parent="1" vertex="1">
|
||||
<mxGeometry x="320" y="640" width="200" height="40" as="geometry" />
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-304" value="" style="endArrow=classic;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="1" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="479.90999999999997" y="270" as="sourcePoint" />
|
||||
<mxPoint x="479.9100000000001" y="240" as="targetPoint" />
|
||||
<mxPoint as="offset" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-305" value="client2<div>arbiter</div>" style="rounded=1;whiteSpace=wrap;html=1;labelBackgroundColor=default;fontSize=11;" parent="1" vertex="1">
|
||||
<mxGeometry x="440" y="270" width="80" height="30" as="geometry" />
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-306" value="server2<div>router</div>" style="rounded=1;whiteSpace=wrap;html=1;labelBackgroundColor=default;fontSize=11;" parent="1" vertex="1">
|
||||
<mxGeometry x="440" y="340" width="80" height="30" as="geometry" />
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-307" value="request /<div>grant</div>" style="endArrow=classic;html=1;rounded=0;labelBackgroundColor=#F8CECC;fontSize=10;startArrow=classic;startFill=1;" parent="1" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="454.8899999999999" y="340" as="sourcePoint" />
|
||||
<mxPoint x="454.8899999999999" y="300" as="targetPoint" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-308" value="value" style="endArrow=classic;html=1;rounded=0;labelBackgroundColor=#F8CECC;fontSize=10;" parent="1" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="504.8899999999999" y="340" as="sourcePoint" />
|
||||
<mxPoint x="504.8899999999999" y="300" as="targetPoint" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-309" value="" style="endArrow=classic;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="1" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="359.69000000000005" y="460" as="sourcePoint" />
|
||||
<mxPoint x="359.69000000000005" y="480" as="targetPoint" />
|
||||
<mxPoint as="offset" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-310" value="client2<div>router</div>" style="rounded=1;whiteSpace=wrap;html=1;labelBackgroundColor=default;fontSize=11;" parent="1" vertex="1">
|
||||
<mxGeometry x="320" y="480" width="80" height="30" as="geometry" />
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-311" value="server2<div>arbiter</div>" style="rounded=1;whiteSpace=wrap;html=1;labelBackgroundColor=default;fontSize=11;" parent="1" vertex="1">
|
||||
<mxGeometry x="320" y="550" width="80" height="30" as="geometry" />
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-312" value="request /<div>grant</div>" style="endArrow=classic;html=1;rounded=0;labelBackgroundColor=#DAE8FC;fontSize=10;startArrow=classic;startFill=1;" parent="1" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="334.8899999999999" y="510" as="sourcePoint" />
|
||||
<mxPoint x="334.8899999999999" y="550" as="targetPoint" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-313" value="value" style="endArrow=classic;html=1;rounded=0;labelBackgroundColor=#DAE8FC;fontSize=10;" parent="1" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="384.8899999999999" y="510" as="sourcePoint" />
|
||||
<mxPoint x="384.8899999999999" y="550" as="targetPoint" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-314" value="consume<div>request</div>" style="endArrow=classic;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="1" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="359.67999999999984" y="580" as="sourcePoint" />
|
||||
<mxPoint x="359.67999999999984" y="640" as="targetPoint" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-315" value="<div><br></div><div>submit</div><div>response</div>" style="endArrow=classic;html=1;rounded=0;labelBackgroundColor=default;labelBorderColor=none;textShadow=0;jumpStyle=gap;fontSize=10;" parent="1" edge="1">
|
||||
<mxGeometry x="0.7037" width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="479.67999999999984" y="640" as="sourcePoint" />
|
||||
<mxPoint x="479.67999999999984" y="370" as="targetPoint" />
|
||||
<mxPoint as="offset" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-316" value="request /<div>&nbsp;grant</div>" style="endArrow=classic;html=1;rounded=0;jumpStyle=gap;labelBackgroundColor=#DAE8FC;fontSize=10;startArrow=classic;startFill=1;" parent="1" edge="1">
|
||||
<mxGeometry x="-0.6481" width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="160" y="500" as="sourcePoint" />
|
||||
<mxPoint x="320" y="555.32" as="targetPoint" />
|
||||
<Array as="points">
|
||||
<mxPoint x="180" y="500" />
|
||||
<mxPoint x="180" y="555" />
|
||||
</Array>
|
||||
<mxPoint as="offset" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-317" value="value" style="endArrow=classic;html=1;rounded=0;jumpStyle=gap;labelBackgroundColor=#DAE8FC;fontSize=10;" parent="1" edge="1">
|
||||
<mxGeometry x="0.7414" width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="160" y="490" as="sourcePoint" />
|
||||
<mxPoint x="320" y="562" as="targetPoint" />
|
||||
<Array as="points">
|
||||
<mxPoint x="260" y="490" />
|
||||
<mxPoint x="260" y="562" />
|
||||
</Array>
|
||||
<mxPoint as="offset" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-318" value="request /<div>grant</div>" style="endArrow=classic;html=1;rounded=0;jumpStyle=gap;labelBackgroundColor=#DAE8FC;fontSize=10;startArrow=classic;startFill=1;" parent="1" edge="1">
|
||||
<mxGeometry x="-0.7" y="-15" width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="320" y="500" as="sourcePoint" />
|
||||
<mxPoint x="160" y="560" as="targetPoint" />
|
||||
<Array as="points">
|
||||
<mxPoint x="220" y="500" />
|
||||
<mxPoint x="220" y="560" />
|
||||
</Array>
|
||||
<mxPoint as="offset" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="DDLsznhKMAXYVWb-8vYK-320" value="value" style="endArrow=classic;html=1;rounded=0;jumpStyle=gap;labelBackgroundColor=#DAE8FC;fontSize=10;" parent="1" edge="1">
|
||||
<mxGeometry x="0.6444" width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="320" y="505" as="sourcePoint" />
|
||||
<mxPoint x="160" y="570" as="targetPoint" />
|
||||
<Array as="points">
|
||||
<mxPoint x="240" y="505" />
|
||||
<mxPoint x="240" y="570" />
|
||||
</Array>
|
||||
<mxPoint as="offset" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="x_lcP1lRQqL86m_3BT7G-5" value="request /&nbsp;<div>grant</div>" style="endArrow=classic;html=1;rounded=0;jumpStyle=gap;labelBackgroundColor=#F8CECC;fontSize=10;startArrow=classic;startFill=1;" parent="1" edge="1">
|
||||
<mxGeometry x="0.6415" y="-5" width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="440" y="345.32000000000005" as="sourcePoint" />
|
||||
<mxPoint x="279" y="272" as="targetPoint" />
|
||||
<Array as="points">
|
||||
<mxPoint x="420" y="345.32000000000005" />
|
||||
<mxPoint x="420" y="272" />
|
||||
</Array>
|
||||
<mxPoint as="offset" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="x_lcP1lRQqL86m_3BT7G-6" value="value" style="endArrow=classic;html=1;rounded=0;jumpStyle=gap;labelBackgroundColor=#F8CECC;fontSize=10;" parent="1" edge="1">
|
||||
<mxGeometry x="-0.8667" width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="440" y="360" as="sourcePoint" />
|
||||
<mxPoint x="280" y="280" as="targetPoint" />
|
||||
<Array as="points">
|
||||
<mxPoint x="380" y="360" />
|
||||
<mxPoint x="380" y="280" />
|
||||
</Array>
|
||||
<mxPoint as="offset" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="x_lcP1lRQqL86m_3BT7G-7" value="request /<div>grant</div>" style="endArrow=classic;html=1;rounded=0;jumpStyle=gap;labelBackgroundColor=#F8CECC;fontSize=10;startArrow=classic;startFill=1;" parent="1" edge="1">
|
||||
<mxGeometry x="-0.2727" y="10" width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="280" y="350" as="sourcePoint" />
|
||||
<mxPoint x="440" y="290" as="targetPoint" />
|
||||
<Array as="points">
|
||||
<mxPoint x="320" y="350" />
|
||||
<mxPoint x="320" y="290" />
|
||||
</Array>
|
||||
<mxPoint as="offset" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="x_lcP1lRQqL86m_3BT7G-8" value="value" style="endArrow=classic;html=1;rounded=0;jumpStyle=gap;labelBackgroundColor=#F8CECC;fontSize=10;" parent="1" edge="1">
|
||||
<mxGeometry x="-0.7333" width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="280" y="360" as="sourcePoint" />
|
||||
<mxPoint x="440" y="295" as="targetPoint" />
|
||||
<Array as="points">
|
||||
<mxPoint x="340" y="360" />
|
||||
<mxPoint x="340" y="295" />
|
||||
</Array>
|
||||
<mxPoint as="offset" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="svE0qh3njN4fsUmnxisL-1" value="bypass&nbsp;<div>response<div>value</div></div>" style="endArrow=classic;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="1" edge="1">
|
||||
<mxGeometry x="0.288" y="-5" width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="150" y="480" as="sourcePoint" />
|
||||
<mxPoint x="200" y="280" as="targetPoint" />
|
||||
<Array as="points">
|
||||
<mxPoint x="150" y="280" />
|
||||
</Array>
|
||||
<mxPoint as="offset" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="svE0qh3njN4fsUmnxisL-2" value="bypass<div>response</div><div>value</div>" style="endArrow=classic;html=1;rounded=0;jumpStyle=gap;labelBackgroundColor=default;fontSize=10;" parent="1" edge="1">
|
||||
<mxGeometry x="0.6774" y="14" width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="390" y="480" as="sourcePoint" />
|
||||
<mxPoint x="450" y="270" as="targetPoint" />
|
||||
<Array as="points">
|
||||
<mxPoint x="390" y="250" />
|
||||
<mxPoint x="450" y="250" />
|
||||
</Array>
|
||||
<mxPoint as="offset" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="svE0qh3njN4fsUmnxisL-3" value="tag" style="endArrow=classic;html=1;rounded=0;labelBackgroundColor=default;fontSize=10;" parent="1" edge="1">
|
||||
<mxGeometry width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="110" y="380" as="sourcePoint" />
|
||||
<mxPoint x="110" y="120" as="targetPoint" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="svE0qh3njN4fsUmnxisL-4" value="tag" style="endArrow=classic;html=1;rounded=0;jumpStyle=gap;labelBackgroundColor=default;fontSize=10;" parent="1" edge="1">
|
||||
<mxGeometry x="0.6" width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="350" y="380" as="sourcePoint" />
|
||||
<mxPoint x="350" y="120" as="targetPoint" />
|
||||
<mxPoint as="offset" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="Bx_jwq7m4Ip0YGT7EWWs-1" value="request/<div>grant</div>" style="endArrow=classic;html=1;rounded=0;jumpStyle=gap;labelBorderColor=none;labelBackgroundColor=default;fontSize=10;startArrow=classic;startFill=1;" edge="1" parent="1">
|
||||
<mxGeometry x="-0.2" y="-10" width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="400" y="490" as="sourcePoint" />
|
||||
<mxPoint x="440" y="280" as="targetPoint" />
|
||||
<Array as="points">
|
||||
<mxPoint x="410" y="490" />
|
||||
<mxPoint x="410" y="280" />
|
||||
</Array>
|
||||
<mxPoint as="offset" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
<mxCell id="Bx_jwq7m4Ip0YGT7EWWs-2" value="request/<div>grant</div>" style="endArrow=classic;html=1;rounded=0;fontSize=10;startArrow=classic;startFill=1;" edge="1" parent="1">
|
||||
<mxGeometry x="-0.3617" width="50" height="50" relative="1" as="geometry">
|
||||
<mxPoint x="160" y="485" as="sourcePoint" />
|
||||
<mxPoint x="200" y="290" as="targetPoint" />
|
||||
<Array as="points">
|
||||
<mxPoint x="180" y="485" />
|
||||
<mxPoint x="180" y="290" />
|
||||
</Array>
|
||||
<mxPoint as="offset" />
|
||||
</mxGeometry>
|
||||
</mxCell>
|
||||
</root>
|
||||
</mxGraphModel>
|
||||
</diagram>
|
||||
</mxfile>
|
Loading…
Reference in a new issue