From 7d0ef73739d7d8b286d3881404a268e5a62e874b Mon Sep 17 00:00:00 2001 From: Hidde Moll Date: Tue, 28 Nov 2023 15:07:19 +0100 Subject: [PATCH] Fix i2c interface to `vexRiscUartHello` Co-authored-by: Lucas Bollen --- .../Instances/Pnr/ProcessingElement.hs | 6 +- bittide/src/Bittide/Wishbone.hs | 63 ++++++++++++++----- firmware-binaries/examples/hello/src/main.rs | 24 +++++-- 3 files changed, 73 insertions(+), 20 deletions(-) diff --git a/bittide-instances/src/Bittide/Instances/Pnr/ProcessingElement.hs b/bittide-instances/src/Bittide/Instances/Pnr/ProcessingElement.hs index 66e57ca4b..983a7c575 100644 --- a/bittide-instances/src/Bittide/Instances/Pnr/ProcessingElement.hs +++ b/bittide-instances/src/Bittide/Instances/Pnr/ProcessingElement.hs @@ -8,6 +8,7 @@ module Bittide.Instances.Pnr.ProcessingElement where import Clash.Prelude import Clash.Annotations.TH +import Clash.Cores.Xilinx.Ila (Depth(D4096)) import Clash.Explicit.Prelude(orReset, noReset) import Clash.Xilinx.ClockGen import Language.Haskell.TH @@ -47,9 +48,10 @@ vexRiscUartHello diffClk rst_in (uartIn, sclBs, sdaIn) = peFunction = toSignals $ withClockResetEnable clk200 rst200 enableGen $ circuit $ \(uartRx, i2cIn) -> do - [uartBus, i2cBus] <- processingElement @Basic200 peConfig -< () + [uartBus, i2cBus0] <- processingElement @Basic200 peConfig -< () (uartTx, _uartStatus) <- uartWb d16 d16 (SNat @921600) -< (uartBus, uartRx) - i2cOut <- i2cWb -< (i2cBus, i2cIn) + i2cBus1 <- ilaWb 0 D4096 -< i2cBus0 + i2cOut <- i2cWb -< (i2cBus1, i2cIn) idC -< (uartTx, i2cOut) (_,(uartOut, i2cO)) = diff --git a/bittide/src/Bittide/Wishbone.hs b/bittide/src/Bittide/Wishbone.hs index 71188fe35..01052a784 100644 --- a/bittide/src/Bittide/Wishbone.hs +++ b/bittide/src/Bittide/Wishbone.hs @@ -15,7 +15,7 @@ import Bittide.SharedTypes import Clash.Cores.UART (uart, ValidBaud) import Clash.Cores.I2C -import Clash.Cores.Xilinx.Ila (ila, ilaConfig, IlaConfig(..), Depth) +import Clash.Cores.Xilinx.Ila hiding (Data) import Clash.Util.Interpolate import Bittide.Extra.Maybe @@ -25,7 +25,7 @@ import Data.Bool(bool) import Data.Constraint.Nat.Extra import Data.Maybe -import Protocols.Df hiding (zipWith, pure, bimap, first, second, route, zip) +import Protocols.Df hiding (zipWith, pure, bimap, first, second, route, zip, snd) import Protocols.Internal import Protocols.Wishbone @@ -440,17 +440,17 @@ wbToVec :: ( Vec nRegisters (Maybe (Bytes nBytes)) , Maybe (Index nRegisters) , WishboneS2M (Bytes nBytes)) -wbToVec readableData readAck WishboneM2S{..} = (writtenData, readRequest, wbS2M) +wbToVec readableData ack WishboneM2S{..} = (writtenData, transAddr, wbS2M) where (alignedAddress, alignment) = split @_ @(addrW - 2) @2 addr addressRange = maxBound :: Index nRegisters invalidAddress = (alignedAddress > resize (pack addressRange)) || alignment /= 0 masterActive = strobe && busCycle err = masterActive && invalidAddress - acknowledge = masterActive && not err && (writeEnable || readAck) - wbWriting = writeEnable && acknowledge + acknowledge = masterActive && not err && ack + wbWriting = writeEnable && masterActive && not err wbAddr = unpack $ resize alignedAddress :: Index nRegisters - readRequest = orNothing (masterActive && not err && not writeEnable) wbAddr + transAddr = orNothing (masterActive && not err) wbAddr readData = readableData !! wbAddr writtenData | wbWriting = replace wbAddr (Just writeData) (repeat Nothing) @@ -470,13 +470,13 @@ i2cWb :: i2cWb = case (cancelMulDiv @nBytes @8) of Dict -> Circuit go where - go ((wbM2S, CSignal i2cIn), _) = ((wbS2M, CSignal $ pure ()), CSignal i2cOut) + go ((wbM2S, CSignal i2cIn), _) = hwSeqX ilaInstance ((wbS2M, CSignal $ pure ()), CSignal i2cOut) where -- Wishbone interface consists of: -- 0. i2c data Read-Write -- 1. clock divider Read-Write -- 3. flags: MSBs are Read-Only flags, LSBs are Read-Write flags. - (vecOut, readRequest, wbS2M) = unbundle $ wbToVec <$> bundle vecIn <*> readAck <*> wbM2S + (vecOut, transAddr, wbS2M) = unbundle $ wbToVec <$> bundle vecIn <*> wbAck <*> wbM2S vecIn = fmap resize dOut :> fmap (resize . pack) clkDiv :> flagsRead :> Nil (i2cWrite :> clkDivWrite :> flagsWrite :> Nil) = unbundle vecOut @@ -488,23 +488,58 @@ i2cWb = case (cancelMulDiv @nBytes @8) of rwFlagsReg = regMaybe (False :> False :> False :> False :> True :> Nil) rwFlagsRegNext - (_ :> _ :> ackIn :> claimBus :> smReset :> Nil) = unbundle rwFlagsReg + (_ :> ackOutReg :> ackIn :> claimBus :> smReset :> Nil) = unbundle rwFlagsReg -- ReadWrite flags - rwFlagsRegSetters = bundle $ al :> ackOut :> ackIn :> claimBus :> smReset :> Nil + rwFlagsRegSetters = bundle $ al :> (mux hostAck (fmap not ackOut) ackOutReg) :> ackIn :> claimBus :> smReset :> Nil -- Alternative of wishbone write and updated i2c status signals. rwFlagsRegNext = (<|>) <$> rwFlagsWrite <*> - (orNothing <$> (al .||. ackOut) <*> (zipWith (||) <$> rwFlagsReg <*> rwFlagsRegSetters)) + (orNothing <$> (al .||. hostAck) <*> (zipWith (||) <$> rwFlagsReg <*> rwFlagsRegSetters)) clkDiv = regMaybe maxBound (unpack . resize <<$>> clkDivWrite) - -- Alternative based on i2cWrite and readRequest + -- Alternative based on i2cWrite and transAddr i2cOp = (<|>) <$> ((I2C.WriteData . resize) <<$>> i2cWrite) - <*> (flip orNothing I2C.ReadData <$> (readRequest .==. pure (Just 0))) + <*> (flip orNothing I2C.ReadData <$> (transAddr .==. pure (Just 0))) -- If the wishbone interface targets the i2c core, wait for acknowledgement. - readAck = (pure (Just 0) ./=. readRequest) .||. hostAck + wbAck = (pure (Just 0) ./=. transAddr) .||. hostAck (dOut,hostAck,busy,al,ackOut,i2cOut) = i2c hasClock hasReset smReset (fromEnable hasEnable) clkDiv claimBus i2cOp ackIn i2cIn + + (sclMaybe, sdaMaybe) = unbundle i2cOut + ilaInstance :: Signal dom () + ilaInstance = + ila + ( ilaConfig $ + "probe_sdaIn" + :> "probe_sclOut" + :> "probe_sdaOut" + :> "probe_i2c_dout" + :> "probe_i2c_hostAck" + :> "probe_i2c_busy" + :> "probe_i2c_al" + :> "probe_i2c_ackOut" + :> "probe_i2c_op" + :> "probe_rwFlagsReg" + :> "probe_clkDiv" + :> "probe_i2cWrite" + :> "probe_transAddr" + :> Nil + ) {stages = 2, depth = D32768, advancedTriggers = True } + hasClock + (dflipflop $ snd <$> i2cIn) + (dflipflop $ fmap isNothing sclMaybe) + (dflipflop $ fmap isNothing sdaMaybe) + (dflipflop dOut) + (dflipflop hostAck) + (dflipflop busy) + (dflipflop al) + (dflipflop $ fmap not ackOut) + (dflipflop i2cOp) + (dflipflop rwFlagsReg) + (dflipflop clkDiv) + (dflipflop i2cWrite) + (dflipflop transAddr) diff --git a/firmware-binaries/examples/hello/src/main.rs b/firmware-binaries/examples/hello/src/main.rs index 07e1b310f..7c98ddc77 100644 --- a/firmware-binaries/examples/hello/src/main.rs +++ b/firmware-binaries/examples/hello/src/main.rs @@ -23,19 +23,34 @@ fn main() -> ! { uwriteln!(uart, "Hello from {}!", name).unwrap(); } uwriteln!(uart, "This can also do {} {:#x}", "debug prints", 42).unwrap(); + _ = uart.receive(); uwriteln!(uart, "i2c device:\n{:?}", i2c).unwrap(); - let mut flags = i2c.read_flags(); - uwriteln!(uart, "i2c flags:\n{:?}", flags).unwrap(); + // Deasserting i2c reset uwriteln!(uart, "Deasserting i2c statemachine reset").unwrap(); + let mut flags = i2c.read_flags(); flags.statemachine_reset = false; i2c.write_flags(flags); uwriteln!(uart, "i2c flags:\n{:?}", flags).unwrap(); + + // Getting and setting clock divider + let mut clk_div = i2c.get_clock_divider(); + uwriteln!(uart, "i2c clk div:\n{:?}", clk_div).unwrap(); + clk_div = 300; + uwriteln!(uart, "Changing i2c clk div to {}", clk_div).unwrap(); + i2c.set_clock_divider(clk_div); + clk_div = i2c.get_clock_divider(); + uwriteln!(uart, "i2c clk div:\n{:?}", clk_div).unwrap(); + + // Initiating i2c communication uwriteln!(uart, "Claiming i2c bus").unwrap(); if i2c.claim_bus().is_err() { uwriteln!(uart, "I2CError").unwrap(); + } else { + let flags = i2c.read_flags(); + uwriteln!(uart, "i2c bus claimed, status:\n{:?}", flags).unwrap(); }; - uwriteln!(uart, "i2c bus claimed, status:\n{:?}", i2c.read_flags()).unwrap(); + let a = 0x69; match i2c.write_byte((a << 1) + 1) { Ok(_) => (), @@ -55,7 +70,8 @@ fn main() -> ! { }; i2c.release_bus(); - uwriteln!(uart, "i2c bus released, status: {:?}", i2c.read_flags()).unwrap(); + let flags = i2c.read_flags(); + uwriteln!(uart, "i2c bus released, status: {:?}", flags).unwrap(); uwriteln!(uart, "Going in echo mode!").unwrap(); loop { let c = uart.receive();