From 6c687b3ea520405ffc430b7189f8a92db4a78b83 Mon Sep 17 00:00:00 2001 From: Pieter Staal Date: Fri, 14 Jan 2022 10:45:54 +0100 Subject: [PATCH] Add comments Remove example --- clash-protocols.cabal | 1 - src/Protocols/Axi4/Lite/Axi4Lite.hs | 35 ++++- src/Protocols/Axi4/Lite/Example.hs | 195 ---------------------------- 3 files changed, 28 insertions(+), 203 deletions(-) delete mode 100644 src/Protocols/Axi4/Lite/Example.hs diff --git a/clash-protocols.cabal b/clash-protocols.cabal index fa4ea319..77a34b6a 100644 --- a/clash-protocols.cabal +++ b/clash-protocols.cabal @@ -141,7 +141,6 @@ library Protocols.Axi4.Common Protocols.Axi4.Lite.Axi4Lite - Protocols.Axi4.Lite.Example Protocols.Df Protocols.DfLike diff --git a/src/Protocols/Axi4/Lite/Axi4Lite.hs b/src/Protocols/Axi4/Lite/Axi4Lite.hs index e5cdb351..ae8f9e91 100644 --- a/src/Protocols/Axi4/Lite/Axi4Lite.hs +++ b/src/Protocols/Axi4/Lite/Axi4Lite.hs @@ -1,6 +1,10 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} +{-| +Defines datatypes for all five channels of the AXI4 Lite protocol. For more +information on AXI4 Lite, see chapter B of the AMBA AXI specification. +-} module Protocols.Axi4.Lite.Axi4Lite where @@ -8,12 +12,14 @@ import Protocols import Protocols.Axi4.Common import Clash.Prelude as C -import Data.Tuple.Strict (T3) +-- | AXI4 Lite busses are always either 32 bit or 64 bit. data BusWidth = Width32 | Width64 deriving (Show, Eq) +-- | AXI4 Lite defines a strobe signal to signify which bytes of the input +-- signal should be committed to memory. The strobe signal is encoded in +-- the 'Maybe' data type. Strobing is mandatory in AXI4 Lite. type family WriteBusWidthType (bw :: BusWidth) where - -- The strobe signal is encoded in maybes WriteBusWidthType 'Width32 = C.Vec 4 (Maybe (C.BitVector 8)) WriteBusWidthType 'Width64 = C.Vec 8 (Maybe (C.BitVector 8)) @@ -26,12 +32,18 @@ type family ReadBusWidthType (bw :: BusWidth) where --- Write address types --- --------------------------- + +-- | The xvalid signals in AXI4 Lite are encoded in the datatype by having two +-- options, e.g. M2S_NoWriteAddress and M2S_WriteAddress. The rest of the channels +-- are fields in the record. Table B1.1 defines which signals AXI4 Lite uses. data M2S_WriteAddress (aw :: AddrWidth) = M2S_NoWriteAddress | M2S_WriteAddress { - -- _awvalid is deduced from the fact that this is not NoWriteAddress + -- | Address to be written to _awaddr :: !(C.BitVector (Width aw)), + + -- | Protection permissions, in AXI4 Lite these are always enabled. _awprot :: PermissionsType 'KeepPermissions } deriving (Generic, NFDataX) @@ -47,6 +59,7 @@ data Axi4LiteWA (dom :: C.Domain) (aw :: AddrWidth) +-- | Protocol instance for the write address channel. instance Protocol (Axi4LiteWA dom aw) where type Fwd (Axi4LiteWA dom aw) = C.Signal dom (M2S_WriteAddress aw) type Bwd (Axi4LiteWA dom aw) = C.Signal dom (S2M_WriteAddress) @@ -59,7 +72,7 @@ data M2S_WriteData (bw :: BusWidth) = M2S_NoWriteData | M2S_WriteData { - -- In AXI4 Lite, strobing is mandatory for masters and interconnects + -- | Write data _wdata :: !(WriteBusWidthType bw) } deriving (Generic) @@ -79,6 +92,7 @@ data Axi4LiteWD (dom :: C.Domain) (bw :: BusWidth) +-- | Protocol instance for the write data channel. instance Protocol (Axi4LiteWD dom bw) where type Fwd (Axi4LiteWD dom bw) = C.Signal dom (M2S_WriteData bw) type Bwd (Axi4LiteWD dom bw) = C.Signal dom (S2M_WriteData) @@ -101,6 +115,7 @@ data S2M_WriteResponse data Axi4LiteWR (dom :: C.Domain) +-- | Protocol instance for the write response channel. instance Protocol (Axi4LiteWR dom) where type Fwd (Axi4LiteWR dom) = C.Signal dom (M2S_WriteResponse) type Bwd (Axi4LiteWR dom) = C.Signal dom (S2M_WriteResponse) @@ -131,6 +146,7 @@ data Axi4LiteRA (dom :: C.Domain) (aw :: AddrWidth) +-- | Protocol instance for the read address channel. instance Protocol (Axi4LiteRA dom aw) where type Fwd (Axi4LiteRA dom aw) = C.Signal dom (M2S_ReadAddress aw) type Bwd (Axi4LiteRA dom aw) = C.Signal dom (S2M_ReadAddress) @@ -139,6 +155,8 @@ instance Protocol (Axi4LiteRA dom aw) where --- Read data types --- ----------------------- +-- | Acknowledges data from the slave component. This data type needs the 'bw' type +-- to fullfil the injectivity requirement of 'Fwd' in 'Protocol'. data M2S_ReadData (bw :: BusWidth) -- Necessary for the injectivity requirement of Fwd = M2S_ReadData { @@ -162,26 +180,29 @@ data Axi4LiteRD (dom :: C.Domain) (bw :: BusWidth) +-- | Protocol instance for the read data channel. Notice that in this protocol +-- data flows over the backward channel, but due to type injectivity the forward +-- channel needs to contain the 'bw' type as well. instance Protocol (Axi4LiteRD dom bw) where type Fwd (Axi4LiteRD dom bw) = C.Signal dom (M2S_ReadData bw) type Bwd (Axi4LiteRD dom bw) = C.Signal dom (S2M_ReadData bw) --- Just the write part of the AXI4 Lite +-- | Protocols for writing to an AXI4 Lite component. type Axi4LiteWrite (dom :: C.Domain) (aw :: AddrWidth) (bw :: BusWidth) = (Axi4LiteWA dom aw, Axi4LiteWD dom bw, Axi4LiteWR dom) --- Just the read part of AXI4 Lite +-- | Protocols for reading from an AXI4 Lite component. type Axi4LiteRead (dom :: C.Domain) (aw :: AddrWidth) (bw :: BusWidth) = (Axi4LiteRA dom aw, Axi4LiteRD dom bw) --- Full AXI4 Lite protocol (both read and write channel sets) +-- | Full AXI4 Lite protocol with both read and write channel sets. type Axi4Lite (dom :: C.Domain) (aw :: AddrWidth) diff --git a/src/Protocols/Axi4/Lite/Example.hs b/src/Protocols/Axi4/Lite/Example.hs deleted file mode 100644 index 52188335..00000000 --- a/src/Protocols/Axi4/Lite/Example.hs +++ /dev/null @@ -1,195 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} - -module Protocols.Axi4.Lite.Example where - -import Clash.Prelude hiding (zip, undefined) -import Prelude hiding ((!!)) -import qualified Prelude as P -import Protocols -import Protocols.Axi4.Common -import Protocols.Axi4.Lite.Axi4Lite - - -type BasicAddrWidth = BitVector (Width ('AddrWidth 4)) - -data BasicAxiMaster - = BM_Read BasicAddrWidth - | BM_Write BasicAddrWidth (WriteBusWidthType 'Width32) - | BM_NoData - deriving (Show, Generic, NFDataX) - -data BasicAxiSlave - = BS_Read (ReadBusWidthType 'Width32) - | BS_Idle - | BS_Busy - deriving (Show, Generic, NFDataX) - -data BasicAxi (dom :: Domain) - -instance Protocol (BasicAxi dom) where - type Fwd (BasicAxi dom) = Signal dom BasicAxiMaster - type Bwd (BasicAxi dom) = Signal dom BasicAxiSlave - -type AxiToBasic dom = Circuit - (Axi4Lite dom ('AddrWidth 4) 'Width32) - (BasicAxi dom) - - -masterTestSigs :: [(M2S_ReadAddress ('AddrWidth 4), M2S_ReadData 'Width32)] -masterTestSigs = zip ra rd - where - ra = - [ M2S_NoReadAddress - , m2s_ra 3 - , M2S_NoReadAddress - , M2S_NoReadAddress - , M2S_NoReadAddress - , M2S_NoReadAddress - , M2S_NoReadAddress - , M2S_NoReadAddress - , M2S_NoReadAddress - , m2s_ra 4 - , M2S_NoReadAddress - , M2S_NoReadAddress - , M2S_NoReadAddress - , M2S_NoReadAddress - , M2S_NoReadAddress - , M2S_NoReadAddress - , M2S_NoReadAddress - , M2S_NoReadAddress - , M2S_NoReadAddress] - rd = - [ nack, nack, nack, nack, nack, nack, ack, nack, nack, nack, nack, nack, nack, ack ] P.++ P.repeat nack - - m2s_ra addr = M2S_ReadAddress { _araddr = addr, _arprot = (NotPrivileged, NonSecure, Data)} - ack = M2S_ReadData { _rready = True } - nack = M2S_ReadData { _rready = False } - -sim :: [(M2S_ReadAddress ('AddrWidth 4), M2S_ReadData 'Width32)] - -> [(S2M_ReadAddress, S2M_ReadData 'Width32)] -sim = simulate @System (bundle . top' . unbundle) - where - top :: HiddenClockResetEnable dom => - ((Signal dom (M2S_ReadAddress ('AddrWidth 4)), - Signal dom (M2S_ReadData 'Width32)), - ()) - -> ((Signal dom S2M_ReadAddress, - Signal dom (S2M_ReadData 'Width32)), - ()) - top = toSignals $ convertRead |> basicAxiMem - -- top' :: forall dom . HiddenClockResetEnable dom => - -- (Signal dom (M2S_ReadAddress ('AddrWidth 4)), Signal dom (M2S_ReadData 'Width32)) -> - -- (Signal dom S2M_ReadAddress, Signal dom (S2M_ReadData 'Width32)) - top' sigs = case top (sigs, ()) of - (sigs', ()) -> sigs' - - --- converter :: AxiToBasic dom --- converter = Circuit go - --- convertWrite :: Circuit (Axi4LiteWrite dom ('AddrWidth 4) 'Width32) (BasicAxi dom) --- convertWrite = Circuit go - -convertRead :: HiddenClockResetEnable dom => - Circuit (Axi4LiteRead dom ('AddrWidth 4) 'Width32) (BasicAxi dom) -convertRead = Circuit go - where - go ((ra_data, rd_ack), basicSlave) = ((ra_ack, rd_data), basicMaster) - where - (ra_ack, rd_data) = unbundle ra_rd - (ra_rd, basicMaster) = unbundle $ (machine) - (bundle (bundle (ra_data, rd_ack), basicSlave)) - - machine = mealy convertReadMealy CR_Idle - -convertRA :: M2S_ReadAddress ('AddrWidth 4) -> BasicAxiMaster -convertRA M2S_NoReadAddress = BM_NoData -convertRA M2S_ReadAddress {..} = BM_Read _araddr - -convertRD :: BasicAxiSlave -> S2M_ReadData 'Width32 -convertRD basicSlave = case basicSlave of - BS_Read d -> S2M_ReadData { - _rdata = d, - _rresp = RLOkay - } - _ -> S2M_NoReadData - -type ConvertReadInput = ((M2S_ReadAddress ('AddrWidth 4), M2S_ReadData 'Width32), BasicAxiSlave) -type ConvertReadOutput = ((S2M_ReadAddress, S2M_ReadData 'Width32), BasicAxiMaster) - -data ConvertReadState = CR_Idle | CR_WaitForReady BasicAxiSlave - deriving (Show, Generic, NFDataX) - -convertReadMealy :: ConvertReadState -> ConvertReadInput -> (ConvertReadState, ConvertReadOutput) -convertReadMealy (keepData) ((ra_data, rd_ack), basicSlave) = (keepData', ((ra_ack, rd_data), basicMaster)) - where - rd_data = case keepData of - CR_WaitForReady d -> convertRD d - _ -> convertRD basicSlave - ra_ack = s2m_ra basicSlave - basicMaster = convertRA ra_data - keepData' = case keepData of - CR_Idle -> case basicSlave of - BS_Read _ -> CR_WaitForReady basicSlave - _ -> CR_Idle - CR_WaitForReady _ -> if masterReady - then CR_Idle - else keepData - - masterReady = _rready rd_ack - - s2m_ra slaveCmd = case slaveCmd of - BS_Idle -> S2M_ReadAddress { _arready = True } - _ -> S2M_ReadAddress { _arready = False } - -basicAxiMem :: HiddenClockResetEnable dom => - Circuit (BasicAxi dom) () -basicAxiMem = Circuit go - where - go (master, ()) = (memory master, ()) - -memory :: HiddenClockResetEnable dom => - Signal dom BasicAxiMaster -> Signal dom BasicAxiSlave -memory = mealy memoryMealy emptyMemoryState - -data MemState = MemState { - counter :: Unsigned 2, - values :: Vec 16 (BitVector 8), - last_command :: Maybe BasicAxiMaster - } deriving (Show, NFDataX, Generic) - -emptyMemoryState :: MemState -emptyMemoryState = MemState { - counter = 0, - values = 0:>1:>2:>3:>4:>5:>6:>7:>8:>9:>10:>11:>12:>13:>14:>15:>Nil, - last_command = Nothing - } - -memoryMealy :: MemState -> BasicAxiMaster -> (MemState, BasicAxiSlave) -memoryMealy state command = (state', result) - where - MemState {..} = state - state' = state { - counter = counter + 1, - last_command = case last_command of - Nothing -> case command of - BM_NoData -> Nothing - _ -> Just command - Just _ -> if counter == 0 - then case command of - BM_NoData -> Nothing - _ -> Just command - else last_command - } - - result = if counter == 0 - then case last_command of - Just cmd -> execute cmd - Nothing -> BS_Idle - else case last_command of - Just _ -> BS_Busy - Nothing -> BS_Idle - - execute cmd = case cmd of - BM_Read addr -> BS_Read (0:>0:>0:>(values !! addr):>Nil) - _ -> BS_Idle