Add AXI4 Lite types

Author: PietPtr

clash-protocols.cabal

@@ -134,7 +134,9 @@ library
 
       -- To be removed; we need 'Test.Tasty.Hedgehog.Extra' to fix upstream issues
     , tasty >= 1.2 && < 1.5
+    , tasty-th
     , tasty-hedgehog
+    , strict-tuple
 
   exposed-modules:
     Protocols
@@ -146,6 +148,7 @@ library
     Protocols.Axi4.WriteAddress
     Protocols.Axi4.WriteData
     Protocols.Axi4.WriteResponse
+    Protocols.Axi4.Lite.Axi4Lite
 
     Protocols.Df
     Protocols.DfLike
@@ -154,6 +157,7 @@ library
     Protocols.Internal
     Protocols.Plugin
 
+
     -- 'testProperty' is broken upstream, it reports wrong test names
     -- TODO: test / upstream ^
     Test.Tasty.Hedgehog.Extra

src/Protocols/Axi4/Common.hs

@@ -18,6 +18,8 @@ import Clash.Prelude (type (^), type (-), type (*))
 -- strict-tuple
 import Data.Tuple.Strict (T4)
 
+import Control.DeepSeq
+
 -- | Simple wrapper to achieve "named arguments" when instantiating an AXI protocol
 data IdWidth = IdWidth Nat
 
@@ -70,10 +72,10 @@ data SKeepStrobe (strobeType :: KeepStrobe) where
   SNoStrobe :: SKeepStrobe 'NoStrobe
 
 -- | Extracts Nat from 'IdWidth', 'AddrWidth', and 'LengthWidth'
-type family Width (a :: k) :: Nat where
-  Width ('IdWidth n) = n
-  Width ('AddrWidth n) = n
-  Width ('LengthWidth n) = n
+type family Width (a :: k) :: Nat --where
+type instance Width ('IdWidth n) = n
+type instance Width ('AddrWidth n) = n
+type instance Width ('LengthWidth n) = n
 
 -- | Enables or disables 'BurstMode'
 type family BurstType (keepBurst :: KeepBurst) where
@@ -102,7 +104,7 @@ type family LockType (keepLockType :: KeepLock) where
 
 -- | Enables or disables 'Privileged', 'Secure', and 'InstructionOrData'
 type family PermissionsType (keepPermissions :: KeepPermissions) where
-  PermissionsType 'KeepPermissions = T3 Privileged Secure InstructionOrData
+  PermissionsType 'KeepPermissions = (Privileged, Secure, InstructionOrData)
   PermissionsType 'NoPermissions = ()
 
 -- | Enables or disables 'Qos'
@@ -245,6 +247,19 @@ data Resp
   | RDecodeError
   deriving (Show, C.ShowX, Generic, C.NFDataX)
 
+-- | Status of a read or write transaction on AXI4 Lite.
+data RespLite
+  -- | Normal access success. Indicates that a normal access has been
+  -- successful.
+  = RLOkay
+  -- | Slave error. Used when the access has reached the slave successfully, but
+  -- the slave wishes to return an error condition to the originating master.
+  | RLSlaveError
+  -- | Decode error. Generated, typically by an interconnect component, to
+  -- indicate that there is no slave at the transaction address.
+  | RLDecodeError
+  deriving (Show, C.ShowX, Generic, C.NFDataX)
+
 -- | Whether a resource is accessed with exclusive access or not
 data AtomicAccess
   = NonExclusiveAccess
@@ -260,12 +275,14 @@ data Modifiable
 data Secure
   = Secure
   | NonSecure
+  deriving (Show, Generic, C.NFDataX, NFData, C.ShowX, Eq)
 
 -- | An AXI master might support more than one level of operating privilege,
 -- and extend this concept of privilege to memory access.
 data Privileged
   = NotPrivileged
   | Privileged
+  deriving (Show, Generic, C.NFDataX, NFData, C.ShowX, Eq)
 
 -- | Whether the transaction is an instruction access or a data access. The AXI
 -- protocol defines this indication as a hint. It is not accurate in all cases,
@@ -276,3 +293,4 @@ data Privileged
 data InstructionOrData
   = Data
   | Instruction
+  deriving (Show, Generic, C.NFDataX, NFData, C.ShowX, Eq)

src/Protocols/Axi4/Lite/Axi4Lite.hs

@@ -1,7 +1,10 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
+<<<<<<< HEAD
 {-# LANGUAGE RecordWildCards #-}
+=======
+>>>>>>> cc790e6... Add AXI4 Lite types
 {-|
 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.
@@ -16,7 +19,11 @@ import Clash.Prelude as C
 import Control.DeepSeq
 
 -- | AXI4 Lite busses are always either 32 bit or 64 bit.
+<<<<<<< HEAD
 data BusWidth = Width32 | Width64 deriving (Show, Eq, Generic, NFDataX)
+=======
+data BusWidth = Width32 | Width64 deriving (Show, Eq)
+>>>>>>> cc790e6... Add AXI4 Lite types
 
 type instance Width 'Width32 = 32
 type instance Width 'Width64 = 64
@@ -33,6 +40,10 @@ type family ReadBusWidthType (bw :: BusWidth) where
   ReadBusWidthType 'Width32 = C.Vec 4 (C.BitVector 8)
   ReadBusWidthType 'Width64 = C.Vec 8 (C.BitVector 8)
 
+<<<<<<< HEAD
+=======
+
+>>>>>>> cc790e6... Add AXI4 Lite types
 ---------------------------
 --- Write address types ---
 ---------------------------

src/Protocols/Df.hs

@@ -75,12 +75,17 @@ import qualified Prelude as P
 import           Clash.Prelude (type (<=))
 import           Clash.Signal.Internal (Signal)
 import qualified Clash.Prelude as C
+import qualified Clash.Explicit.Prelude as CE
 
 -- me
 import           Protocols.Internal
 import           Protocols.DfLike (DfLike)
 import qualified Protocols.DfLike as DfLike
 
+<<<<<<< HEAD
+=======
+import Debug.Trace
+>>>>>>> cc790e6... Add AXI4 Lite types
 
 -- $setup
 -- >>> import Protocols
@@ -137,6 +142,7 @@ dataToMaybe :: Data a -> Maybe a
 dataToMaybe NoData = Nothing
 dataToMaybe (Data a) = Just a
 
+
 instance (C.KnownDomain dom, C.NFDataX a, C.ShowX a, Show a) => Simulate (Df dom a) where
   type SimulateFwdType (Df dom a) = [Data a]
   type SimulateBwdType (Df dom a) = [Ack]
@@ -159,6 +165,52 @@ instance (C.KnownDomain dom, C.NFDataX a, C.ShowX a, Show a) => Drivable (Df dom
   sampleC = sample
 
 
+  simulateRight SimulationConfig{..} acks circ =
+    P.take timeoutAfter $
+    CE.sample_lazy $
+    P.snd $
+    toSignals circ ((), resetAndAcks)
+    where
+      resetAndAcks = C.fromList $ (P.map Ack (replicate resetCycles False) <> acks)
+
+  simulateLeft SimulationConfig{..} fwds circ = CE.sample_lazy ackSig
+    where
+      (ackSig, ()) = toSignals circ (dataSig, ())
+      dataSig = C.fromList_lazy (ackedData resetCycles fwds (C.sample ackSig))
+
+      ackedData resetN _ (_:acks) | resetN > 0 =
+        NoData : ackedData (resetN - 1) fwds acks
+      ackedData _ _ [] = C.errorX "Empty acks list."
+      ackedData _ [] (_:acks) = NoData : ackedData 0 [] acks
+      ackedData _ (dat:datas) (ack:acks) = case ack of
+        Ack True -> dat : ackedData 0 (datas) acks
+        Ack False -> dat : ackedData 0 (dat:datas) acks
+
+
+
+  simulateManager SimulationConfig{..} acks circ =
+    P.take timeoutAfter $
+    CE.sample_lazy $
+    P.snd $
+    toSignals circ ((), resetAndAcks)
+    where
+      resetAndAcks = C.fromList $ (P.map Ack (replicate resetCycles False) <> acks)
+
+  -- TODO: apply simulation config
+  simulateSubordinate SimulationConfig{..} fwds circ = CE.sample_lazy ackSig
+    where
+      (ackSig, ()) = toSignals circ (dataSig, ())
+      dataSig = C.fromList_lazy (ackedData resetCycles fwds (C.sample ackSig))
+
+      ackedData resetN _ (_:acks) | resetN > 0 =
+        NoData : ackedData (resetN - 1) fwds acks
+      ackedData _ [] (_:acks) = NoData : ackedData 0 [] acks
+      ackedData _ (dat:datas) (ack:acks) = case ack of
+        Ack True -> dat : ackedData 0 (datas) acks
+        Ack False -> dat : ackedData 0 (dat:datas) acks
+
+
+
 instance DfLike dom (Df dom) a where
   type Data (Df dom) a = Data a
   type Payload a = a
@@ -441,6 +493,7 @@ registerBwd = DfLike.registerBwd Proxy
 
 --------------------------------- SIMULATE -------------------------------------
 
+
 -- | Emit values given in list. Emits no data while reset is asserted. Not
 -- synthesizable.
 drive ::

src/Protocols/DfLike.hs

@@ -595,7 +595,7 @@ fanin ::
   ) =>
   (a -> a -> a) ->
   Circuit (C.Vec n (df x)) (df x)
-fanin f = bundleVec Proxy Proxy |> map Proxy Proxy (C.fold @(n-1) f)
+fanin f = bundleVec Proxy Proxy |> map Proxy Proxy (C.fold  @(n-1) f)
 {-# INLINE fanin #-}
 
 -- | Merge data of multiple streams using Monoid's '<>'.
@@ -673,7 +673,7 @@ unbundleVec dfX dfY =
 
           -- Store new acks, send ack if all "clients" have acked
           acked1 = C.zipWith (||) acked (C.map (ackToBool dfY) acks)
-          ack = C.fold @(n-1) (&&) acked1
+          ack = C.fold  @(n-1) (&&) acked1
         in
           ( if ack then initState else acked1
           , (boolToAck dfX ack, dats1) )
@@ -776,7 +776,7 @@ roundrobinCollect dfA Parallel =
     acks = Maybe.fromMaybe nacks ((\i -> C.replace i ack nacks) <$> iM)
     dat1 = Maybe.fromMaybe (noData dfA) dat0
     (iM, dat0) = Data.List.NonEmpty.unzip dats1
-    dats1 = C.fold @(n-1) (<|>) (C.zipWith goDat C.indicesI dats0)
+    dats1 = C.fold  @(n-1) (<|>) (C.zipWith goDat C.indicesI dats0)
 
     goDat i dat
       | hasPayload dfA dat = Just (i, dat)
@@ -883,7 +883,9 @@ stall ::
   Proxy (df a) ->
   SimulationConfig ->
   -- | Acknowledgement to send when LHS does not send data. Stall will act
-  -- transparently when reset is asserted.
+  -- transparently when reset is asserted. A correct circuit would nack during reset,
+  -- however since "stall" is used to debug other components it acts transparently as
+  -- otherwise it may occlude the behavior of the components under test.
   StallAck ->
   -- Number of cycles to stall for every valid Df packet
   [Int] ->

src/Protocols/Internal.hs

@@ -6,6 +6,7 @@ Internal module to prevent hs-boot files (breaks Haddock)
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE TypeFamilyDependencies #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 
 module Protocols.Internal where
 
@@ -145,6 +146,7 @@ newtype Circuit a b =
 newtype Ack = Ack Bool
   deriving (Generic, C.NFDataX, Show)
 
+
 -- | Acknowledge. Used in circuit-notation plugin to drive ignore components.
 instance Default Ack where
   def = Ack True
@@ -365,6 +367,7 @@ data StallAck
   | StallCycle
   deriving (Eq, Bounded, Enum, Show)
 
+
 -- | Class that defines how to /drive/, /sample/, and /stall/ a "Circuit" of
 -- some shape. The "Backpressure" instance requires that the /backward/ type of the
 -- circuit can be generated from a list of Booleans.
@@ -490,6 +493,13 @@ instance Drivable () where
   sampleC _  _ = ()
 
 
+  simulateRight _ _ _ = ()
+  simulateLeft _ _ _ = ()
+
+  simulateManager _ _ _ = ()
+  simulateSubordinate _ _ _ = ()
+
+
 instance (Simulate a, Simulate b) => Simulate (a, b) where
   type SimulateFwdType (a, b) = (SimulateFwdType a, SimulateFwdType b)
   type SimulateBwdType (a, b) = (SimulateBwdType a, SimulateBwdType b)