preliminary work on client methods and some type repair
This commit is contained in:
parent
ca02c88be3
commit
979adf3660
36
bs/Bus.bs
36
bs/Bus.bs
|
@ -13,14 +13,14 @@ import SpecialFIFOs
|
||||||
clientRequest :: Arbiter.ArbiterClient_IFC -> Action
|
clientRequest :: Arbiter.ArbiterClient_IFC -> Action
|
||||||
clientRequest ifc = ifc.request
|
clientRequest ifc = ifc.request
|
||||||
|
|
||||||
busRequestToAddr :: BusRequest -> Maybe Addr
|
busRequestToAddr :: BusRequest -> Addr
|
||||||
busRequestToAddr req = case req of
|
busRequestToAddr req = case req of
|
||||||
BusReadRequest (ReadRequest addr _) -> addr
|
BusReadRequest (ReadRequest addr _) -> addr
|
||||||
BusWriteRequest (WriteRequest addr _) -> addr
|
BusWriteRequest (WriteRequest addr _) -> addr
|
||||||
|
|
||||||
mkBus :: (Addr -> Maybe Integer)
|
mkBus :: (Addr -> Maybe Integer)
|
||||||
-> Module (Bus inFlightTransactions numClients numServers)
|
-> Module (Bus inFlightTransactions numClients numServers)
|
||||||
mkBus addrToServerTranslation = do
|
mkBus busMap = do
|
||||||
-- Tag engines for each client to manage transaction tags
|
-- Tag engines for each client to manage transaction tags
|
||||||
tagEngineByClientVec :: Vector numClients (TagEngine inFlightTransactions)
|
tagEngineByClientVec :: Vector numClients (TagEngine inFlightTransactions)
|
||||||
tagEngineByClientVec <- replicateM mkTagEngine
|
tagEngineByClientVec <- replicateM mkTagEngine
|
||||||
|
@ -33,7 +33,7 @@ mkBus addrToServerTranslation = do
|
||||||
dummyVar <- mkReg False
|
dummyVar <- mkReg False
|
||||||
|
|
||||||
-- Queues to hold requests from clients to servers
|
-- Queues to hold requests from clients to servers
|
||||||
requestQueues :: Vector numServers (FIFOF BusRequest)
|
requestQueues :: Vector numServers (FIFOF (TaggedBusRequest inFlightTransactions))
|
||||||
requestQueues <- replicateM (mkSizedBypassFIFOF (valueOf inFlightTransactions))
|
requestQueues <- replicateM (mkSizedBypassFIFOF (valueOf inFlightTransactions))
|
||||||
|
|
||||||
-- Queues to hold responses from servers to clients
|
-- Queues to hold responses from servers to clients
|
||||||
|
@ -43,25 +43,39 @@ mkBus addrToServerTranslation = do
|
||||||
-- Client interface vector
|
-- Client interface vector
|
||||||
let clients :: Vector numClients (BusClient inFlightTransactions)
|
let clients :: Vector numClients (BusClient inFlightTransactions)
|
||||||
clients = genWith $ \clientIdx ->
|
clients = genWith $ \clientIdx ->
|
||||||
interface BusClient
|
let
|
||||||
submitRequest req = do
|
selectedClientRequestQueue :: FIFOF (TaggedBusRequest inFlightTransactions)
|
||||||
dummyVar := (not dummyVar)
|
selectedClientRequestQueue = (select requestQueues clientIdx)
|
||||||
return 0
|
|
||||||
|
|
||||||
consumeResponse = do
|
selectedTagEngine :: TagEngine inFlightTransactions
|
||||||
dummyVar := (not dummyVar)
|
selectedTagEngine = (select tagEngineByClientVec clientIdx)
|
||||||
let dummyResponse = BusReadResponse (Left UnMapped)
|
in
|
||||||
return (dummyResponse, 0)
|
interface BusClient
|
||||||
|
submitRequest :: BusRequest
|
||||||
|
-> ActionValue (MkTagType inFlightTransactions)
|
||||||
|
submitRequest busRequest = do
|
||||||
|
tag <- selectedTagEngine.requestTag
|
||||||
|
selectedClientRequestQueue.enq (TaggedBusRequest tag busRequest)
|
||||||
|
return tag
|
||||||
|
|
||||||
|
consumeResponse :: ActionValue (TaggedBusResponse inFlightTransactions)
|
||||||
|
consumeResponse = do
|
||||||
|
dummyVar := (not dummyVar)
|
||||||
|
let dummyResponse = BusReadResponse (Left UnMapped)
|
||||||
|
return (TaggedBusResponse 0 dummyResponse)
|
||||||
|
|
||||||
-- Server interface vector
|
-- Server interface vector
|
||||||
let servers :: Vector numServers (BusServer inFlightTransactions numClients)
|
let servers :: Vector numServers (BusServer inFlightTransactions numClients)
|
||||||
servers = genWith $ \serverIdx ->
|
servers = genWith $ \serverIdx ->
|
||||||
interface BusServer
|
interface BusServer
|
||||||
|
consumeRequest :: ActionValue (MkTagType inFlightTransactions, BusRequest)
|
||||||
consumeRequest = do
|
consumeRequest = do
|
||||||
dummyVar := (not dummyVar)
|
dummyVar := (not dummyVar)
|
||||||
let dummyBusRequest = BusReadRequest (ReadRequest 0 SizeByte)
|
let dummyBusRequest = BusReadRequest (ReadRequest 0 SizeByte)
|
||||||
return (0, dummyBusRequest)
|
return (0, dummyBusRequest)
|
||||||
|
|
||||||
|
submitResponse :: (MkClientTagType numClients, BusResponse, transactionTagType)
|
||||||
|
-> Action
|
||||||
submitResponse (clientTag, busResponse, transactionTag) = do
|
submitResponse (clientTag, busResponse, transactionTag) = do
|
||||||
dummyVar := (not dummyVar)
|
dummyVar := (not dummyVar)
|
||||||
|
|
||||||
|
|
|
@ -4,7 +4,8 @@ package BusTypes(
|
||||||
BusClient(..), BusServer(..),
|
BusClient(..), BusServer(..),
|
||||||
BusRequest(..), BusResponse(..),
|
BusRequest(..), BusResponse(..),
|
||||||
ReadRequest(..), ReadResponse(..), WriteRequest(..), WriteResponse(..),
|
ReadRequest(..), ReadResponse(..), WriteRequest(..), WriteResponse(..),
|
||||||
BusVal(..), BusError(..), TransactionSize(..)
|
BusVal(..), BusError(..), TransactionSize(..),
|
||||||
|
TaggedBusRequest(..), TaggedBusResponse(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Types
|
import Types
|
||||||
|
@ -53,6 +54,14 @@ data BusResponse
|
||||||
| BusWriteResponse WriteResponse
|
| BusWriteResponse WriteResponse
|
||||||
deriving (Bits, Eq, FShow)
|
deriving (Bits, Eq, FShow)
|
||||||
|
|
||||||
|
data TaggedBusRequest inFlightTransactions =
|
||||||
|
TaggedBusRequest (MkTagType inFlightTransactions) BusRequest
|
||||||
|
deriving (Bits, Eq, FShow)
|
||||||
|
|
||||||
|
data TaggedBusResponse inFlightTransactions =
|
||||||
|
TaggedBusResponse (MkTagType inFlightTransactions) BusResponse
|
||||||
|
deriving (Bits, Eq, FShow)
|
||||||
|
|
||||||
-- # BusClient.submitRequest
|
-- # BusClient.submitRequest
|
||||||
-- * The bus client calls the `submitRequest` method of the `BusClient` interface
|
-- * The bus client calls the `submitRequest` method of the `BusClient` interface
|
||||||
-- with the `BusRequest` it wishes to submit and immediately recieves back
|
-- with the `BusRequest` it wishes to submit and immediately recieves back
|
||||||
|
@ -67,7 +76,7 @@ data BusResponse
|
||||||
interface (BusClient :: # -> *) inFlightTransactions =
|
interface (BusClient :: # -> *) inFlightTransactions =
|
||||||
submitRequest :: BusRequest
|
submitRequest :: BusRequest
|
||||||
-> ActionValue (MkTagType inFlightTransactions)
|
-> ActionValue (MkTagType inFlightTransactions)
|
||||||
consumeResponse :: ActionValue (BusResponse, MkTagType inFlightTransactions)
|
consumeResponse :: ActionValue (TaggedBusResponse inFlightTransactions)
|
||||||
|
|
||||||
-- # BusServer.consumeRequest
|
-- # BusServer.consumeRequest
|
||||||
-- * The bus server calls the `consumeRequest` method of the `BusServer` interface
|
-- * The bus server calls the `consumeRequest` method of the `BusServer` interface
|
||||||
|
|
Loading…
Reference in a new issue