Skip to content

Commit e192099

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

4 files changed

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