Skip to content

Commit 0496b73

Browse files
lmbollenlmbollen
committed
Add the ReqResp protocol and utilities
1 parent 72390fc commit 0496b73

4 files changed

Lines changed: 287 additions & 0 deletions

File tree

‎bittide-extra/bittide-extra.cabal‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -177,6 +177,7 @@ library
177177
Protocols.BiDf
178178
Protocols.Df.Extra
179179
Protocols.Extra
180+
Protocols.ReqResp
180181
Protocols.Spi
181182
Protocols.Wishbone.Extra
182183
System.Timeout.Extra
@@ -193,6 +194,7 @@ test-suite unittests
193194
Tests.Numeric.Extra
194195
Tests.Protocols.BiDf
195196
Tests.Protocols.Df.Extra
197+
Tests.Protocols.ReqResp
196198

197199
build-depends:
198200
base,

‎bittide-extra/src/Protocols/ReqResp.hs‎

Lines changed: 226 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,226 @@
1+
-- SPDX-FileCopyrightText: 2026 Google LLC
2+
--
3+
-- SPDX-License-Identifier: Apache-2.0
4+
5+
{- |
6+
Contains the `ReqResp` protocol, the simplest possible protocol for request-response communication
7+
together with utilities for working with it. `ReqResp` is suitable for simple request-response
8+
interactions where pipelining is not required. If you need pipelining, you can use the `BiDf`
9+
protocol instead.
10+
-}
11+
module Protocols.ReqResp (
12+
-- * Types
13+
ReqResp,
14+
15+
-- * Converters
16+
fromDfs,
17+
toDfs,
18+
fromBiDf,
19+
toBiDf,
20+
requests,
21+
dropResponse,
22+
23+
-- * Blockram interfaces
24+
fromBlockRam,
25+
fromBlockRamWithMask,
26+
27+
-- * Other utilities
28+
partitionEithers,
29+
forceResetSanity,
30+
) where
31+
32+
import Clash.Prelude
33+
34+
import Data.Bifunctor (Bifunctor (..))
35+
import Data.Maybe
36+
import Protocols
37+
import Protocols.BiDf (BiDf)
38+
import Protocols.Idle
39+
40+
import qualified Clash.Prelude as C
41+
import qualified Protocols.BiDf as BiDf
42+
43+
{- |
44+
Simplest possible protocol for request-response communication.
45+
46+
The forward channel channel has type @Signal dom (Maybe req)@ and is used to send requests and
47+
the backward channel has type @Signal dom (Maybe resp)@ and is used to send responses. This protocol
48+
can not be pipelined because the request is acknowledged by the response. If you wish to utilize
49+
pipelining, you can use the `BiDf` protocol instead.
50+
51+
The protocol must obey the following rules:
52+
* When the forward channel is @Just a@, it must not change until the transaction is completed.
53+
* The forward channel can not depend on the backward channel.
54+
* When the forward channel is @Nothing@, the backward channel must not be observed.
55+
-}
56+
data ReqResp (dom :: C.Domain) (req :: Type) (resp :: Type)
57+
58+
instance Protocol (ReqResp dom req resp) where
59+
-- \| Request channel for ReqResp protocol
60+
type Fwd (ReqResp dom req resp) = C.Signal dom (Maybe req)
61+
62+
-- \| Response channel for ReqResp protocol
63+
type Bwd (ReqResp dom req resp) = C.Signal dom (Maybe resp)
64+
65+
instance IdleCircuit (ReqResp dom req resp) where
66+
idleFwd _ = pure Nothing
67+
idleBwd _ = pure Nothing
68+
69+
leftToMaybe :: Either a b -> Maybe a
70+
leftToMaybe (Left x) = Just x
71+
leftToMaybe (Right _) = Nothing
72+
rightToMaybe :: Either a b -> Maybe b
73+
rightToMaybe (Left _) = Nothing
74+
rightToMaybe (Right y) = Just y
75+
76+
-- | Partition a `ReqResp` with an `Either` request type into two `ReqResp`s, one for each side of the `Either`.
77+
partitionEithers ::
78+
forall dom a b c. Circuit (ReqResp dom (Either a b) c) (ReqResp dom a c, ReqResp dom b c)
79+
partitionEithers = Circuit goS
80+
where
81+
goS (eitherFwd, (leftBwd, rightBwd)) = (eitherBwd, (leftFwd, rightFwd))
82+
where
83+
leftFwd = fmap (>>= leftToMaybe) eitherFwd
84+
rightFwd = fmap (>>= rightToMaybe) eitherFwd
85+
86+
eitherBwd = selectBwd <$> eitherFwd <*> leftBwd <*> rightBwd
87+
selectBwd (Just (Left _)) leftBwd _ = leftBwd
88+
selectBwd (Just (Right _)) _ rightBwd = rightBwd
89+
selectBwd Nothing _ _ = Nothing
90+
91+
{- | Given a 'blockRam' primitive, create a circuit that offers a 'ReqResp' interface to access
92+
the primitive using 'ReqResp' for the read channel and 'Df' for the write channel.
93+
94+
If you use 'ReqResp' for the write channel, you can use 'requests' to convert it to a 'Df' stream
95+
to be used with this circuit.
96+
-}
97+
fromBlockRamWithMask ::
98+
(C.KnownDomain dom, C.HiddenClock dom, C.HiddenReset dom, Num addr, C.KnownNat words) =>
99+
( C.Signal dom addr ->
100+
C.Signal dom (Maybe (addr, C.BitVector (words C.* 8))) ->
101+
C.Signal dom (C.BitVector words) ->
102+
C.Signal dom (C.BitVector (words C.* 8))
103+
) ->
104+
Circuit
105+
( ReqResp dom addr (C.BitVector (words C.* 8))
106+
, Df dom (addr, C.BitVector words, C.BitVector (words C.* 8))
107+
)
108+
()
109+
fromBlockRamWithMask primitive = Circuit go
110+
where
111+
writeBwd = pure $ Ack True
112+
go ((readFwd, writeFwd), _) = ((readBwd, writeBwd), ())
113+
where
114+
-- Separate the write data and byte enables
115+
writeData = fmap (>>= \(addr, _mask, dat) -> Just (addr, dat)) writeFwd
116+
byteEnables = fmap (\case Just (_, mask, _) -> mask; Nothing -> 0) writeFwd
117+
118+
readData = primitive (fromMaybe 0 <$> readFwd) writeData byteEnables
119+
120+
-- Reading takes 1 cycle so we run at half speed
121+
readValid = C.withEnable C.enableGen C.register False (fmap isJust readFwd C..&&. fmap not readValid)
122+
readBwd = liftA2 (\v d -> if v then Just d else Nothing) readValid readData
123+
124+
{- | Given a 'blockRam' primitive, create a circuit that offers a 'ReqResp' interface to access
125+
the primitive using 'ReqResp' for the read channel and 'Df' for the write channel.
126+
This is a simpler version of 'fromBlockRamWithMask' that doesn't support byte enables.
127+
-}
128+
fromBlockRam ::
129+
(C.KnownDomain dom, C.HiddenClock dom, C.HiddenReset dom, Num addr) =>
130+
(C.Signal dom addr -> C.Signal dom (Maybe (addr, a)) -> C.Signal dom a) ->
131+
Circuit (ReqResp dom addr a, Df dom (addr, a)) ()
132+
fromBlockRam primitive = Circuit go
133+
where
134+
writeBwd = pure $ Ack True
135+
go ((readFwd, writeFwd), _) = ((readBwd, writeBwd), ())
136+
where
137+
readData = primitive (fromMaybe 0 <$> readFwd) writeFwd
138+
139+
-- Reading takes 1 cycle so we run at half speed
140+
readValid = C.withEnable C.enableGen C.register False (fmap isJust readFwd C..&&. fmap not readValid)
141+
readBwd = liftA2 (\v d -> if v then Just d else Nothing) readValid readData
142+
143+
{- | Forces a constant response on the backward channel. Useful for when you don't care
144+
about the response data.
145+
-}
146+
dropResponse :: resp -> Circuit (ReqResp dom req resp) (ReqResp dom req ())
147+
dropResponse resp = applyC id (fmap $ fmap $ const resp)
148+
149+
{- | Force a @Nothing@ on the backward channel and @Nothing@ on the forward
150+
channel if reset is asserted.
151+
-}
152+
forceResetSanity ::
153+
forall dom req resp.
154+
(C.HiddenReset dom) =>
155+
Circuit (ReqResp dom req resp) (ReqResp dom req resp)
156+
forceResetSanity = forceResetSanityGeneric
157+
158+
-- | Convert a `ReqResp` protocol to two `Df` streams, one for requests and one for responses.
159+
toDfs ::
160+
forall dom req resp.
161+
(C.HiddenClockResetEnable dom) =>
162+
Circuit (ReqResp dom req resp, Df dom resp) (Df dom req)
163+
toDfs = ckt
164+
where
165+
ckt = Circuit (first C.unbundle . C.unbundle . C.mealy go Nothing . C.bundle . first C.bundle)
166+
go Nothing _ = (Just False, ((Nothing, Ack False), Nothing))
167+
go (Just accepted0) ~(~(reqLeft, resp), ~(Ack reqRightAck)) = (Just accepted1, ((resp, respAck), reqRight))
168+
where
169+
respAck = Ack True
170+
171+
reqRight
172+
| accepted0 = Nothing
173+
| otherwise = reqLeft
174+
175+
accepted1
176+
| isNothing reqLeft = False -- No request to accept
177+
| isJust resp = False -- Receiving a response clears the state
178+
| isJust reqRight = reqRightAck -- A request for which we have not received a response yet
179+
| otherwise = accepted0
180+
181+
-- | Convert two `Df` streams for requests and responses into a `ReqResp` protocol.
182+
fromDfs ::
183+
forall dom req resp.
184+
(C.HiddenClockResetEnable dom, C.NFDataX resp) =>
185+
Circuit (Df dom req) (ReqResp dom req resp, Df dom resp)
186+
fromDfs = Circuit (second C.unbundle . C.unbundle . C.mealy go Nothing . C.bundle . second C.bundle)
187+
where
188+
go Nothing ~(req, ~(resp, Ack ack)) = (nextState, (Ack (isJust resp), (req, resp)))
189+
where
190+
nextState
191+
| isJust resp && not ack = resp
192+
| otherwise = Nothing
193+
go stored (_, (_, Ack ack)) = (nextState, (Ack False, (Nothing, stored)))
194+
where
195+
nextState
196+
| ack = Nothing
197+
| otherwise = stored
198+
199+
-- | Convert a `ReqResp` protocol to a `BiDf` protocol through `toDfs` and `BiDf.fromDfs`.
200+
toBiDf ::
201+
forall dom req resp.
202+
(C.HiddenClockResetEnable dom) =>
203+
Circuit (ReqResp dom req resp) (BiDf dom req resp)
204+
toBiDf = circuit $ \reqresp -> do
205+
request <- toDfs -< (reqresp, response)
206+
(biDf, response) <- BiDf.fromDfs -< request
207+
idC -< biDf
208+
209+
-- | Convert a `BiDf` protocol to a `ReqResp` protocol through `fromDfs` and `BiDf.toDfs`.
210+
fromBiDf ::
211+
forall dom req resp.
212+
(C.HiddenClockResetEnable dom, C.NFDataX resp) =>
213+
Circuit (BiDf dom req resp) (ReqResp dom req resp)
214+
fromBiDf = circuit $ \biDf -> do
215+
request <- BiDf.toDfs -< (biDf, response)
216+
(reqresp, response) <- fromDfs -< request
217+
idC -< reqresp
218+
219+
-- | Convert a 'ReqResp' protocol where the response type is '()' to a 'Df' stream of requests.
220+
requests ::
221+
forall dom req.
222+
(C.KnownDomain dom) =>
223+
Circuit (ReqResp dom req ()) (Df dom req)
224+
requests = Circuit (C.unbundle . fmap go . C.bundle)
225+
where
226+
go ~(request, Ack ack) = (if ack then Just () else Nothing, request)

‎bittide-extra/tests/unittests/Main.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@ import qualified Tests.Clash.Cores.Xilinx.Xpm.Cdc.Extra
1414
import qualified Tests.Numeric.Extra
1515
import qualified Tests.Protocols.BiDf
1616
import qualified Tests.Protocols.Df.Extra
17+
import qualified Tests.Protocols.ReqResp
1718

1819
setDefaultHedgehogTestLimit :: HedgehogTestLimit -> HedgehogTestLimit
1920
setDefaultHedgehogTestLimit (HedgehogTestLimit Nothing) = HedgehogTestLimit (Just 1000)
@@ -27,6 +28,7 @@ tests =
2728
, Tests.Clash.Cores.Xilinx.Xpm.Cdc.Extra.tests
2829
, Tests.Protocols.BiDf.tests
2930
, Tests.Protocols.Df.Extra.tests
31+
, Tests.Protocols.ReqResp.tests
3032
]
3133

3234
main :: IO ()

‎bittide-extra/tests/unittests/Tests/Protocols/ReqResp.hs‎

Lines changed: 57 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,57 @@
1+
-- SPDX-FileCopyrightText: 2026 Google LLC
2+
--
3+
-- SPDX-License-Identifier: Apache-2.0
4+
5+
module Tests.Protocols.ReqResp (tests) where
6+
7+
import Clash.Prelude as C
8+
9+
import Clash.Hedgehog.Sized.Vector (genVec)
10+
import Hedgehog (Gen, Property)
11+
import Protocols
12+
import Protocols.Hedgehog (defExpectOptions)
13+
import Protocols.ReqResp as ReqResp
14+
import Test.Tasty (TestTree)
15+
import Test.Tasty.Hedgehog.Extra (testProperty)
16+
import Test.Tasty.TH (testGroupGenerator)
17+
18+
import qualified Hedgehog as H
19+
import qualified Hedgehog.Gen as Gen
20+
import qualified Hedgehog.Range as Range
21+
import qualified Protocols.Df as Df
22+
import qualified Protocols.Df.Extra as Df
23+
import qualified Protocols.Hedgehog as PH
24+
25+
smallInt :: Gen Int
26+
smallInt = Gen.integral (Range.linear 0 10)
27+
28+
genStalls :: (KnownNat n) => Gen (Vec n ((StallAck, [Int])))
29+
genStalls = do
30+
numStalls <- smallInt
31+
genVec (PH.genStalls smallInt numStalls PH.Stall)
32+
33+
prop_fromDfs_toDfs_id :: Property
34+
prop_fromDfs_toDfs_id = H.property $ do
35+
stalls <- H.forAll genStalls
36+
let
37+
impl ::
38+
(HiddenClockResetEnable dom) =>
39+
Circuit (Df dom Int) (Df dom Integer)
40+
impl = circuit $ \reqIn -> do
41+
(reqResp, respOut) <- ReqResp.fromDfs -< reqIn
42+
req0 <- ReqResp.toDfs -< (reqResp, req1)
43+
req1 <-
44+
applyC (fmap (fmap toInteger)) id <| stallC def stalls <| Df.bypassFifo d2 (Df.fifo d8) -< req0
45+
idC -< respOut
46+
47+
PH.idWithModelSingleDomainT @System
48+
defExpectOptions
49+
gen
50+
(\_ _ _ -> fmap toInteger)
51+
(exposeClockResetEnable impl)
52+
where
53+
gen :: Gen [Int]
54+
gen = Gen.list (Range.linear 0 10) smallInt
55+
56+
tests :: TestTree
57+
tests = $(testGroupGenerator)

0 commit comments

Comments
 (0)