diff --git a/.github/synthesis/debug.json b/.github/synthesis/debug.json new file mode 100644 index 000000000..14d3eb573 --- /dev/null +++ b/.github/synthesis/debug.json @@ -0,0 +1,3 @@ +[ + {"top": "fmcClockTests", "stage": "test", "targets": "Specific [-1]"} +] diff --git a/bittide-instances/bittide-instances.cabal b/bittide-instances/bittide-instances.cabal index 5d53a776c..c2c2da619 100644 --- a/bittide-instances/bittide-instances.cabal +++ b/bittide-instances/bittide-instances.cabal @@ -110,6 +110,7 @@ library -- Hardware-in-the-loop tests Bittide.Instances.Hitl.BoardTest Bittide.Instances.Hitl.FincFdec + Bittide.Instances.Hitl.FmcClock Bittide.Instances.Hitl.FullMeshHwCc Bittide.Instances.Hitl.FullMeshSwCc Bittide.Instances.Hitl.HwCcTopologies @@ -131,6 +132,7 @@ library Bittide.Instances.Pnr.ClockControl Bittide.Instances.Pnr.Counter Bittide.Instances.Pnr.ElasticBuffer + Bittide.Instances.Pnr.I2C Bittide.Instances.Pnr.ProcessingElement Bittide.Instances.Pnr.ScatterGather Bittide.Instances.Pnr.Si539xSpi diff --git a/bittide-instances/data/constraints/fmcClockTests.xdc b/bittide-instances/data/constraints/fmcClockTests.xdc new file mode 100644 index 000000000..921a4df67 --- /dev/null +++ b/bittide-instances/data/constraints/fmcClockTests.xdc @@ -0,0 +1,48 @@ +# SPDX-FileCopyrightText: 2024 Google LLC +# +# SPDX-License-Identifier: Apache-2.0 + + +set_property BOARD_PART_PIN sysclk_125_p [get_ports {SYSCLK_125_p}] +set_property BOARD_PART_PIN sysclk_125_n [get_ports {SYSCLK_125_n}] + +# FMC_HPC_GBTCLK1_M2C +set_property PACKAGE_PIN H6 [get_ports {FMC_HPC_GBTCLK1_M2C_p}] +set_property PACKAGE_PIN H5 [get_ports {FMC_HPC_GBTCLK1_M2C_n}] + +set_clock_groups \ + -asynchronous \ + -group [get_clocks -include_generated_clocks {SYSCLK_125_p}] \ + -group [get_clocks -include_generated_clocks {FMC_HPC_GBTCLK1_M2C_p}] + +#FMC_HPC_LA01_CC_N +set_property PACKAGE_PIN F9 [get_ports muxSelect[0]] +set_property IOSTANDARD LVCMOS18 [get_ports muxSelect[0]] +#FMC_HPC_LA02_P +set_property PACKAGE_PIN K10 [get_ports muxSelect[1]] +set_property IOSTANDARD LVCMOS18 [get_ports muxSelect[1]] +#FMC_HPC_LA02_N +set_property PACKAGE_PIN J10 [get_ports muxSelect[2]] +set_property IOSTANDARD LVCMOS18 [get_ports muxSelect[2]] +#FMC_HPC_LA00_P +set_property PACKAGE_PIN H11 [get_ports "sclBs"] +set_property IOSTANDARD LVCMOS18 [get_ports "sclBs"] +# FMC_HPC_LA00_N +set_property PACKAGE_PIN G11 [get_ports "sdaOut"] +set_property IOSTANDARD LVCMOS18 [get_ports "sdaOut"] +# FMC_HPC_LA01_P +set_property PACKAGE_PIN G9 [get_ports "sdaIn"] +set_property IOSTANDARD LVCMOS18 [get_ports "sdaIn"] + +# GPIO_LED_0_LS +set_property PACKAGE_PIN AP8 [get_ports "done"] +set_property IOSTANDARD LVCMOS18 [get_ports "done"] +# GPIO_LED_1_LS +set_property PACKAGE_PIN H23 [get_ports "success"] +set_property IOSTANDARD LVCMOS18 [get_ports "success"] + +set_property PACKAGE_PIN K26 [get_ports "USB_UART_RX"] +set_property IOSTANDARD LVCMOS18 [get_ports "USB_UART_RX"] + +set_property PACKAGE_PIN G25 [get_ports "USB_UART_TX"] +set_property IOSTANDARD LVCMOS18 [get_ports "USB_UART_TX"] diff --git a/bittide-instances/data/constraints/i2cTest.xdc b/bittide-instances/data/constraints/i2cTest.xdc new file mode 100644 index 000000000..59111a3e6 --- /dev/null +++ b/bittide-instances/data/constraints/i2cTest.xdc @@ -0,0 +1,32 @@ +# SPDX-FileCopyrightText: 2022-2023 Google LLC +# +# SPDX-License-Identifier: Apache-2.0 + + +# CLK_125MHZ +set_property BOARD_PART_PIN sysclk_125_p [get_ports sys_125_p] +set_property BOARD_PART_PIN sysclk_125_n [get_ports sys_125_n] + +#FMC_HPC_LA01_CC_N +set_property PACKAGE_PIN F9 [get_ports mux_select[0]] +set_property IOSTANDARD LVCMOS18 [get_ports mux_select[0]] + +#FMC_HPC_LA02_P +set_property PACKAGE_PIN K10 [get_ports mux_select[1]] +set_property IOSTANDARD LVCMOS18 [get_ports mux_select[1]] + +#FMC_HPC_LA02_N +set_property PACKAGE_PIN J10 [get_ports mux_select[2]] +set_property IOSTANDARD LVCMOS18 [get_ports mux_select[2]] + +#FMC_HPC_LA00_CC_P +set_property PACKAGE_PIN H11 [get_ports "sclOut"] +set_property IOSTANDARD LVCMOS18 [get_ports "sclOut"] + +# FMC_HPC_LA00_CC_N +set_property PACKAGE_PIN G11 [get_ports "sdaOut"] +set_property IOSTANDARD LVCMOS18 [get_ports "sdaOut"] + +# FMC_HPC_LA01_CC_P +set_property PACKAGE_PIN G9 [get_ports "sdaIn"] +set_property IOSTANDARD LVCMOS18 [get_ports "sdaIn"] diff --git a/bittide-instances/src/Bittide/Instances/Domains.hs b/bittide-instances/src/Bittide/Instances/Domains.hs index 404109872..9a6ce0a6e 100644 --- a/bittide-instances/src/Bittide/Instances/Domains.hs +++ b/bittide-instances/src/Bittide/Instances/Domains.hs @@ -14,6 +14,7 @@ import Bittide.Arithmetic.Ppm import Data.Proxy createDomain vXilinxSystem{vName="Basic100", vPeriod= hzToPeriod 100e6} +createDomain vXilinxSystem{vName="Basic124", vPeriod=hzToPeriod 124e6} createDomain vXilinxSystem{vName="Basic125", vPeriod= hzToPeriod 125e6} createDomain vXilinxSystem{vName="Ext125", vPeriod= hzToPeriod 125e6, vResetKind=Asynchronous} createDomain vXilinxSystem{vName="Basic25", vPeriod= hzToPeriod 25e6} diff --git a/bittide-instances/src/Bittide/Instances/Hitl/FincFdec.hs b/bittide-instances/src/Bittide/Instances/Hitl/FincFdec.hs index 77eedc17b..7699296b8 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/FincFdec.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/FincFdec.hs @@ -27,6 +27,7 @@ import Data.Maybe (isJust) import qualified Bittide.ClockControl.Si5395J as Si5395J data TestState = Busy | Fail | Success + deriving (Generic, NFDataX, BitPack) data Test -- | Keep pressing FDEC, see if counter falls below certain threshold = FDec @@ -36,7 +37,7 @@ data Test | FDecInc -- | 'FInc' test followed by an 'FDec' one | FIncDec - deriving (Enum, Generic, NFDataX, Bounded, BitPack, ShowX, Show) + deriving (Enum, Generic, NFDataX, Bounded, BitPack, ShowX, Show, Eq) -- | Counter threshold after which a test is considered passed/failed. In theory -- clocks can diverge at +-20 kHz (at 200 MHz), which gives the tests 500 ms to diff --git a/bittide-instances/src/Bittide/Instances/Hitl/FmcClock.hs b/bittide-instances/src/Bittide/Instances/Hitl/FmcClock.hs new file mode 100644 index 000000000..278cd8221 --- /dev/null +++ b/bittide-instances/src/Bittide/Instances/Hitl/FmcClock.hs @@ -0,0 +1,237 @@ +-- SPDX-FileCopyrightText: 2024 Google LLC +-- +-- SPDX-License-Identifier: Apache-2.0 +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +{-# OPTIONS_GHC -fplugin=Protocols.Plugin #-} +{-# LANGUAGE FlexibleInstances #-} +module Bittide.Instances.Hitl.FmcClock where + +import Clash.Prelude +import Clash.Explicit.Prelude (orReset, noReset) + +import Data.Maybe (fromMaybe, isJust) +import Language.Haskell.TH (runIO) +import System.FilePath + +import Protocols +import Protocols.Wishbone + +import VexRiscv + +import Clash.Annotations.TH (makeTopEntity) +import Clash.Cores.UART (ValidBaud) +import Clash.Cores.Xilinx.Ila (IlaConfig(..), Depth(..), ila, ilaConfig) +import Clash.Xilinx.ClockGen (clockWizardDifferential) + +import Bittide.ClockControl +import Bittide.ClockControl.Registers (dataCountsWb) +import Bittide.Counter (domainDiffCounter) +import Bittide.DoubleBufferedRam +import Bittide.Hitl (HitlTests, testsFromEnum, hitlVio, singleFpga) +import Bittide.ProcessingElement +import Bittide.ProcessingElement.Util (memBlobsFromElf) +import Bittide.SharedTypes (ByteOrder(BigEndian)) +import Bittide.Wishbone + +import Bittide.Instances.Domains +import Bittide.Instances.Hitl.FincFdec (TestState(..), Test(..), testStateToDoneSuccess) +import Project.FilePath + +import Clash.Cores.Xilinx.GTH (ibufds_gte3, gthCore) +import Clash.Explicit.Reset.Extra (Asserted(..), xpmResetSynchronizer) + + +onChange :: (HiddenClockResetEnable dom, Eq a, NFDataX a) => Signal dom a -> Signal dom Bool +onChange x = (Just <$> x) ./=. register Nothing (Just <$> x) + +fmcClockRiscv :: + forall dom . + ( HiddenClockResetEnable dom + , 1 <= DomainPeriod dom + , ValidBaud dom 921600 ) => + "sclBs" ::: BiSignalIn 'PullUp dom 1 -> + "sdaIn" ::: Signal dom Bit -> + "datacounts" ::: Vec 1 (Signal dom (DataCount 32)) -> + "USB_UART_TX" ::: Signal dom Bit -> + "testSelect" ::: Signal dom (Maybe Test) -> + ( "sclBs" ::: BiSignalOut 'PullUp dom 1 + , "sdaOut" ::: Signal dom Bit + , "muxSelect" ::: BitVector 3 + , "clockInitDone" ::: Signal dom Bool + , "testResult" ::: Signal dom TestState + , "USB_UART_RX" ::: Signal dom Bit + ) +fmcClockRiscv sclBs sdaIn dataCounts uartRx testSelect = + ( writeToBiSignal sclBs sclOut + , fromMaybe 1 <$> sdaOut + , 0b100 + , clockInitDoneO + , testResultO + , uartTx + ) + where + (_, (i2cOut, controlReg, uartTx)) = + circuitFn (((i2cIn, Just <$> testSelect, uartRx), pure (JtagIn low low low)), (pure (), pure (), pure ())) + + Circuit circuitFn = circuit $ \((i2cIn, statusRegIn, uartRx), jtag) -> do + [timeBus, i2cBus, controlRegBus, statusRegBus, dataCountsBus, uartBus, dummyBus] <- processingElement @dom peConfig -< jtag + (uartTx, _uartStatus) <- uartWb d16 d16 (SNat @921600) -< (uartBus, uartRx) + i2cOut <- i2cWb -< (i2cBus, i2cIn) + dummyWb -< dummyBus + timeWb -< timeBus + statusRegWb Nothing -< (statusRegIn, statusRegBus) + controlReg <- controlRegWb (False, Busy) -< controlRegBus + dataCountsWb dataCounts -< dataCountsBus + idC -< (i2cOut, controlReg, uartTx) + + (sclOut, sdaOut) = unbundle i2cOut + (clockInitDoneO, testResultO) = unbundle controlReg + + sclIn = readFromBiSignal sclBs + i2cIn :: Signal dom (Bit, Bit) + i2cIn = bundle (sclIn, fromMaybe <$> sdaIn <*> sdaOut) + + dummyWb :: NFDataX a => Circuit (Wishbone dom 'Standard aw a) () + dummyWb = Circuit $ const (pure emptyWishboneS2M, ()) + + (iMem, dMem) = $(do + root <- runIO $ findParentContaining "cabal.project" + let + elfDir = root firmwareBinariesDir "riscv32imc-unknown-none-elf" Release + elfPath = elfDir "fmc-clock" + iSize = 128 * 1024 -- 128 KiB + dSize = 64 * 1024 -- 64 KiB + memBlobsFromElf BigEndian (Just iSize, Just dSize) elfPath Nothing) + + {- + MSBs Device + 0b1000 Instruction memory + 0b0100 Data memory + 0b0001 Memory mapped time component + 0b0010 Memory mapped I2C core + 0b0011 Memory mapped control register + 0b0101 Memory mapped status register + 0b0110 Memory mapped datacounts + 0b0111 Memory mapped UART core + 0b0000 Memory mapped dummy device + + Dummy device is needed because the total number of devices cannot be equal to a power + of 2. The dummy device must then be mapped to the zero-address. + -} + peConfig = + PeConfig + (0b1000 :> 0b0100 :> 0b0001 :> 0b0010 :> 0b0011 :> 0b0101 :> 0b0110 :> 0b0111 :> (0b0000 :: Unsigned 4) :> Nil) + (Reloadable $ Blob iMem) + (Reloadable $ Blob dMem) + +fmcClockTests :: + "SYSCLK_125" ::: DiffClock Ext125 -> + "FMC_HPC_GBTCLK1_M2C" ::: DiffClock Ext200 -> + "sclBs" ::: BiSignalIn 'PullUp Basic125 1 -> + "sdaIn" ::: Signal Basic125 Bit -> + "USB_UART_TX" ::: Signal Basic125 Bit -> + ( "sclBs" ::: BiSignalOut 'PullUp Basic125 1 + , "sdaOut" ::: Signal Basic125 Bit + , "muxSelect" ::: BitVector 3 + , "" ::: + ( "done" ::: Signal Basic125 Bool + , "success" ::: Signal Basic125 Bool + ) + , "USB_UART_RX" ::: Signal Basic125 Bit + ) +fmcClockTests sysClkDiff fmcClkDiff sclBsIn sdaIn uartIn = + fmcClockIla `hwSeqX` + (sclBsOut, sdaOut, muxSelect, (testDone, testSuccess), uartOut) + where + (sysClk, sysRst :: Reset Basic125) = clockWizardDifferential sysClkDiff noReset + + (sclBsOut, sdaOut, muxSelect, clockInitDone, testResult, uartOut) = + withClockResetEnable sysClk sysRst enableGen $ + fmcClockRiscv sclBsIn sdaIn (domainDiff :> Nil) uartIn testInput + + fmcClk = ibufds_gte3 fmcClkDiff :: Clock Ext200 + + ( _gthtxn_out + , _gthtxp_out + , txClock::Clock GthTx + , _gtwiz_userclk_rx_usrclk2_out::Clock GthRx + , _gtwiz_userdata_rx_out + , _gtwiz_reset_tx_done_out + , _gtwiz_reset_rx_done_out + , xpmResetSynchronizer Asserted txClock txClock . unsafeFromActiveLow . fmap unpack -> txClkRst + ) = + gthCore + "X0Y10" "clk0" (pure 0) (pure 0) + sysClk + gthRst noReset noReset noReset noReset (pure 0) (pure 0) + sysClk fmcClk + + gthRst = + sysRst `orReset` + unsafeFromActiveLow clockInitDone + testRst = + sysRst `orReset` + unsafeFromActiveLow clockInitDone `orReset` + unsafeFromActiveLow testStarted + + (domainDiff, dcActive) = + unbundle $ domainDiffCounter txClock txClkRst sysClk testRst + + testStarted = isJust <$> testInput + (testDone, testSuccess) = unbundle $ testStateToDoneSuccess <$> testResult + + testInput :: Signal Basic125 (Maybe Test) + testInput = + hitlVio + FDec + sysClk + testDone + testSuccess + + capture :: Signal Basic125 Bool + capture = + withClockResetEnable sysClk sysRst enableGen $ + onChange $ bundle + ( domainDiff + , testInput + , testDone + , testSuccess + , clockInitDone + ) + + fmcClockIla :: Signal Basic125 () + fmcClockIla = setName @"fmcClockIla" $ ila + (ilaConfig $ + "trigger_0" + :> "capture_0" + :> "probe_testInput" + :> "probe_testDone" + :> "probe_testSuccess" + :> "probe_clockInitDone" + :> "probe_testRst" + :> "probe_txLockRst" + :> "probe_domainDiffActive" + :> "probe_domainDiff" + :> Nil + ) { depth = D32768 } + sysClk + testStarted + capture + -- Debug signals + testInput + testDone + testSuccess + clockInitDone + (unsafeToActiveHigh testRst) + (unsafeToActiveHigh $ xpmResetSynchronizer Asserted txClock sysClk txClkRst) + dcActive + domainDiff +{-# NOINLINE fmcClockTests #-} +makeTopEntity 'fmcClockTests + +tests :: HitlTests Test +tests = testsFromEnum (singleFpga maxBound) diff --git a/bittide-instances/src/Bittide/Instances/Hitl/Tests.hs b/bittide-instances/src/Bittide/Instances/Hitl/Tests.hs index 567e2dd2e..e2bc927ca 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/Tests.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/Tests.hs @@ -16,6 +16,7 @@ import Data.Aeson (ToJSON) import qualified Bittide.Instances.Hitl.BoardTest as BoardTest import qualified Bittide.Instances.Hitl.FincFdec as FincFdec +import qualified Bittide.Instances.Hitl.FmcClock as FmcClock import qualified Bittide.Instances.Hitl.FullMeshHwCc as FullMeshHwCc import qualified Bittide.Instances.Hitl.FullMeshSwCc as FullMeshSwCc import qualified Bittide.Instances.Hitl.HwCcTopologies as HwCcTopologies @@ -47,6 +48,7 @@ hitlTests = knownType 'BoardTest.boardTestExtended BoardTest.testsExtended , knownType 'BoardTest.boardTestSimple BoardTest.testsSimple , knownType 'FincFdec.fincFdecTests FincFdec.tests + , knownType 'FmcClock.fmcClockTests FmcClock.tests , knownType 'FullMeshHwCc.fullMeshHwCcTest FullMeshHwCc.tests , knownType 'FullMeshHwCc.fullMeshHwCcWithRiscvTest FullMeshHwCc.tests , knownType 'FullMeshSwCc.fullMeshSwCcTest FullMeshSwCc.tests diff --git a/bittide-instances/src/Bittide/Instances/Pnr/I2C.hs b/bittide-instances/src/Bittide/Instances/Pnr/I2C.hs new file mode 100644 index 000000000..51bc17614 --- /dev/null +++ b/bittide-instances/src/Bittide/Instances/Pnr/I2C.hs @@ -0,0 +1,131 @@ +-- SPDX-FileCopyrightText: 2023 Google LLC +-- +-- SPDX-License-Identifier: Apache-2.0 + +{-# LANGUAGE CPP #-} +{-# LANGUAGE ViewPatterns #-} + +module Bittide.Instances.Pnr.I2C where + +import Clash.Explicit.Prelude hiding (read) + +import Clash.Cores.Xilinx.Extra +import Clash.Cores.Xilinx.VIO +import Clash.Cores.Experimental.I2C + +import Clash.Annotations.TH (makeTopEntity) + +import Data.Maybe + +import Bittide.Instances.Domains + + +data I2CControllerState = I2CIdle | I2CWriteAddress | I2CWriteData | I2CReadData + deriving (Generic, NFDataX, Eq) + +i2cController :: + (KnownDomain dom) => + Clock dom -> + Reset dom -> + Enable dom -> + Signal dom (RamOp 128 (BitVector 8)) -> + Signal dom Bool -> + Signal dom Bool -> + ( Signal dom Bool + , Signal dom (Maybe I2COperation) + , Signal dom Bool) +i2cController clk rst ena ramOp' hostAck' arbLost' = mealyB clk rst ena go I2CIdle + (ramOp', hostAck', arbLost') + where + deconstructRamOp RamNoOp = (0, 0) + deconstructRamOp (RamRead a) = (pack (a, True), 0) + deconstructRamOp (RamWrite a b) = (pack (a, False), b) + + go state (ramOp, hostAck, arbLost) = (nextState, coreInput) + where + coreInput = (claimBus, i2cOp, cmdAck) + cmdAck = state /= I2CIdle && nextState == I2CIdle + (ramOpAddr, ramOpData) = deconstructRamOp ramOp + (claimBus, i2cOp) = case state of + I2CIdle -> (False, Nothing) + I2CWriteAddress -> (True, Just $ WriteData ramOpAddr) + I2CWriteData -> (True, Just $ WriteData ramOpData) + I2CReadData -> (True, Just $ ReadData) + + nextState = case (state, ramOp, hostAck, arbLost) of + (I2CIdle, RamNoOp, _, _) -> I2CIdle + (I2CIdle, _, _, _) -> I2CWriteAddress + (I2CWriteAddress, RamRead _, True, False) -> I2CReadData + (I2CWriteAddress, RamWrite _ _, True, False) -> I2CWriteData + (_, _, False, False) -> state + _ -> I2CIdle + +orNothing :: Bool -> a -> Maybe a +orNothing True a = Just a +orNothing False _ = Nothing + +i2cTest :: + "sys_125" ::: DiffClock Basic125 -> + "sdaIn" ::: Signal Basic125 Bit -> + ( "sclOut" ::: Signal Basic125 Bit + , "sdaOut" ::: Signal Basic125 Bit + , "mux_select" ::: Signal Basic125 (BitVector 3)) +i2cTest diffClk sdaIn = + ( sclOut + , sdaOut + , mux_select + ) + where + clk = ibufds diffClk + sdaOut = fmap (bitCoerce . isNothing) sdaMaybe + sclOut = fmap (bitCoerce . isNothing) sclMaybe + (sclMaybe, sdaMaybe) = unbundle i2cO + i2cIn = bundle (fmap bitCoerce sclOut, fromMaybe <$> sdaIn <*> sdaMaybe) + + (dout,hostAck,busy,al,ackOut,i2cO) = i2c clk vioAsyncReset vioStatemachineReset vioEnaCore clkCnt claimBus i2cOp ackIn i2cIn + (claimBus, i2cOp, cmdAck) = i2cController clk vioAsyncReset vioEnaController ramOp hostAck al + + ramOp = regEn clk vioAsyncReset enableGen RamNoOp (startOpEdge .||. cmdAck .||. al) $ mux startOpEdge vioRamOp (pure RamNoOp) + vioRamOp = mux vioIsWriteOp (RamWrite <$> vioAddr <*> vioI2CWriteData) (RamRead <$> vioAddr) + startOpEdge = isRising clk vioAsyncReset enableGen False vioStartOp + + capturedData = regEn clk vioAsyncReset enableGen 0 hostAck dout + ( unsafeFromActiveHigh -> vioAsyncReset + , vioStatemachineReset + , vioEnaCore + , toEnable -> vioEnaController + , clkCnt + , ackIn + , vioStartOp + , vioIsWriteOp + , vioAddr + , vioI2CWriteData + , mux_select + ) = unbundle $ setName @"i2cVio" $ + vioProbe + ( "capturedData" + :> "busy" + :> "al" + :> "ackOut" + :> Nil) + + ( "vioAsyncReset" + :> "vioStatemachineReset" + :> "vioEnaCore" + :> "vioEnaController" + :> "clkCnt" + :> "ackIn" + :> "vioStartOp" + :> "vioIsWriteOp" + :> "vioAddr" + :> "vioI2CWriteData" + :> "mux_select" + :> Nil) + + (True, True, False, False, 1 :: Unsigned 16, False, False, False, 0 :: Index 128, 0 :: BitVector 8, 0b100) clk + capturedData + busy + al + ackOut + +makeTopEntity 'i2cTest diff --git a/bittide-shake/exe/Main.hs b/bittide-shake/exe/Main.hs index d42b2de77..d974e81d0 100644 --- a/bittide-shake/exe/Main.hs +++ b/bittide-shake/exe/Main.hs @@ -186,6 +186,8 @@ targets = map enforceValidTarget , defTarget "Bittide.Instances.Pnr.ClockControl.callisto3" , defTarget "Bittide.Instances.Pnr.Counter.counterReducedPins" , defTarget "Bittide.Instances.Pnr.ElasticBuffer.elasticBuffer5" + , (defTarget "Bittide.Instances.Pnr.I2C.i2cTest") + {targetHasXdc = True, targetHasVio = True} , defTarget "Bittide.Instances.Pnr.ScatterGather.gatherUnit1K" , defTarget "Bittide.Instances.Pnr.ScatterGather.gatherUnit1KReducedPins" , defTarget "Bittide.Instances.Pnr.ScatterGather.scatterUnit1K" @@ -199,6 +201,7 @@ targets = map enforceValidTarget {targetPostProcess = Just "post-board-test-extended"} , testTarget "Bittide.Instances.Hitl.BoardTest.boardTestSimple" , testTarget "Bittide.Instances.Hitl.FincFdec.fincFdecTests" + , testTarget "Bittide.Instances.Hitl.FmcClock.fmcClockTests" , testTarget "Bittide.Instances.Hitl.FullMeshHwCc.fullMeshHwCcTest" , testTarget "Bittide.Instances.Hitl.FullMeshHwCc.fullMeshHwCcWithRiscvTest" , testTarget "Bittide.Instances.Hitl.FullMeshSwCc.fullMeshSwCcTest" diff --git a/bittide-shake/src/Clash/Shake/Vivado.hs b/bittide-shake/src/Clash/Shake/Vivado.hs index 0f2ba3b6d..d5fdd380a 100644 --- a/bittide-shake/src/Clash/Shake/Vivado.hs +++ b/bittide-shake/src/Clash/Shake/Vivado.hs @@ -165,6 +165,7 @@ mkSynthesisTcl outputDir outOfContext boardPart constraints manifest@LocatedMani #{constraintDigests} set_msg_config -severity {CRITICAL WARNING} -new_severity ERROR + set_param synth.elaboration.rodinMoreOptions "rt::set_parameter var_size_limit 4194304" #{constraintsString} file mkdir {#{outputDir "reports"}} file mkdir {#{outputDir "checkpoints"}} diff --git a/bittide/src/Bittide/ClockControl/Registers.hs b/bittide/src/Bittide/ClockControl/Registers.hs index 9b8bab72a..3d5fed44d 100644 --- a/bittide/src/Bittide/ClockControl/Registers.hs +++ b/bittide/src/Bittide/ClockControl/Registers.hs @@ -2,7 +2,6 @@ -- -- SPDX-License-Identifier: Apache-2.0 -{-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fconstraint-solver-iterations=6 #-} @@ -81,4 +80,36 @@ clockControlWb margin framesize linkMask counters = Circuit go fIncDec3 = delay minBound {- glitch filter -} $ stickyBits d20 (speedChangeToPins <$> fIncDec2) - (writeVec, wbS2M) = unbundle $ wbToVec <$> bundle readVec <*> wbM2S + (writeVec, _, wbS2M) = unbundle $ wbToVec <$> bundle readVec <*> pure True <*> wbM2S + +-- | A wishbone accessible interface which exposes the datacounts. +-- +-- The word-aligned address layout of the Wishbone interface is as follows: +-- +-- - Address 0: Number of links +-- - Addresses 1 to (1 + nLinks): Data counts (Addr 1 is link 0) +dataCountsWb :: + forall dom addrW nLinks m . + ( HiddenClockResetEnable dom + , KnownNat addrW + , 2 <= addrW + , 1 <= nLinks + , KnownNat nLinks + , KnownNat m + , m <= 32 + , nLinks <= 32 + ) => + -- | Counters + Vec nLinks (Signal dom (DataCount m)) -> + -- | Wishbone accessible clock control circuitry + Circuit + (Wishbone dom 'Standard addrW (BitVector 32)) + () +dataCountsWb counters = Circuit go + where + go (wbM2S, _) = (wbS2M, ()) + where + readVec = dflipflop <$> ( + pure (natToNum @nLinks) + :> (pack . (extend @_ @_ @(32 - m)) <<$>> counters)) + (_, _, wbS2M) = unbundle $ wbToVec <$> bundle readVec <*> pure True <*> wbM2S diff --git a/bittide/src/Bittide/Wishbone.hs b/bittide/src/Bittide/Wishbone.hs index fbedb510c..dfd70ad7b 100644 --- a/bittide/src/Bittide/Wishbone.hs +++ b/bittide/src/Bittide/Wishbone.hs @@ -15,9 +15,14 @@ import Bittide.Arithmetic.Time(DomainFrequency) import Bittide.SharedTypes import Clash.Cores.UART (uart, ValidBaud) -import Clash.Cores.Xilinx.Ila (ila, ilaConfig, IlaConfig(..), Depth) +import Clash.Cores.Experimental.I2C +import Clash.Cores.Xilinx.Ila (ila, ilaConfig, IlaConfig(..), Depth (..)) +import Clash.Sized.Vector.ToTuple import Clash.Util.Interpolate +import Bittide.DoubleBufferedRam (RegisterWritePriority(..), registerWb) +import Bittide.Extra.Maybe +import Clash.Functor.Extra import Data.Bifunctor import Data.Bool(bool) import Data.Constraint.Nat.Extra @@ -26,10 +31,10 @@ import Data.Maybe import Protocols import Protocols.Wishbone +import qualified Clash.Cores.Experimental.I2C.ByteMaster as I2C import qualified Protocols.Df as Df import qualified Protocols.Wishbone as Wishbone - {- $setup >>> import Clash.Prelude -} @@ -425,23 +430,28 @@ wbToVec :: , 1 <= nRegisters) => -- | Readable data. Vec nRegisters (Bytes nBytes) -> + -- | Read acknowledgement -> + Bool -> -- | Wishbone bus (master to slave) WishboneM2S addrW nBytes (Bytes nBytes) -> -- | -- 1. Written data + -- 2. Transaction address -- 2. Outgoing wishbone bus (slave to master) ( Vec nRegisters (Maybe (Bytes nBytes)) + , Maybe (Index nRegisters) , WishboneS2M (Bytes nBytes)) -wbToVec readableData WishboneM2S{..} = (writtenData, wbS2M) +wbToVec readableData readAck 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 - wbWriting = writeEnable && acknowledge + acknowledge = masterActive && not err && readAck + wbWriting = writeEnable && masterActive && not err wbAddr = unpack $ resize alignedAddress :: Index nRegisters + transAddr = orNothing (masterActive && not err) wbAddr readData = readableData !! wbAddr writtenData | wbWriting = replace wbAddr (Just writeData) (repeat Nothing) @@ -466,5 +476,145 @@ timeWb = Circuit $ \(wbM2S, _) -> (mealy goMealy (0,0) wbM2S, ()) nextFrozen = if isJust (head writes) then count else frozen RegisterBank (splitAtI -> (frozenMsbs, frozenLsbs)) = getRegsBe @8 frozen RegisterBank (splitAtI -> (freqMsbs, freqLsbs)) = getRegsBe @8 freq - (writes, wbS2M) = wbToVec - (0 :> fmap pack (frozenLsbs :> frozenMsbs :> freqLsbs :> freqMsbs :> Nil)) wbM2S + (writes, _, wbS2M) = wbToVec + (0 :> fmap pack (frozenLsbs :> frozenMsbs :> freqLsbs :> freqMsbs :> Nil)) True wbM2S + +i2cWb :: + forall dom addrW nBytes . + ( HiddenClockResetEnable dom + , 2 <= addrW + , KnownNat addrW + , KnownNat nBytes, 1 <= nBytes + ) => + Circuit + (Wishbone dom 'Standard addrW (Bytes nBytes), CSignal dom (Bit, Bit)) + (CSignal dom (Maybe Bit, Maybe Bit)) +i2cWb = case (cancelMulDiv @nBytes @8) of + Dict -> Circuit go + where + go ((wbM2S, i2cIn), _) = i2cWbIla `hwSeqX` ((wbS2M, pure ()), i2cOut) + where + -- Wishbone interface consists of: + -- 0. i2c data Read-Write + -- 1. clock divider Read-Write + -- 2. flags: MSBs are Read-Only flags, LSBs are Read-Write flags. + (vecOut, transAddr, wbS2M) = unbundle $ wbToVec <$> bundle vecIn <*> wbAck <*> wbM2S + vecIn = fmap resize dOut :> fmap (resize . pack) clkDiv :> flagsRead :> Nil + (i2cWrite, clkDivWrite, flagsWrite) = (vecToTuple . unbundle) vecOut + + -- busy is the only Read-only flag, other flags are Read-Write. + flagsRead = resize . pack <$> bundle (busy, rwFlagsReg) + rwFlagsWrite :: Signal dom (Maybe (Vec 5 Bool)) + rwFlagsWrite = (unpack . resize) <<$>> flagsWrite + + rwFlagsReg = regMaybe + (False :> False :> False :> False :> True :> Nil) + rwFlagsRegNext + (_, ackOutReg, ackIn, claimBus, smReset) = (vecToTuple . unbundle) rwFlagsReg + + -- ReadWrite flags + 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 .||. hostAck) <*> (zipWith (||) <$> rwFlagsReg <*> rwFlagsRegSetters)) + + clkDiv = regMaybe maxBound (unpack . resize <<$>> clkDivWrite) + + -- Alternative based on i2cWrite and transAddr + i2cOp = mux hostAck (pure Nothing) $ (<|>) + <$> ((I2C.WriteData . resize) <<$>> i2cWrite) + <*> (flip orNothing I2C.ReadData <$> (transAddr .==. pure (Just 0))) + + -- If the wishbone interface targets the i2c core, wait for acknowledgement. + wbAck = (pure (Just 0) ./=. transAddr) .||. hostAck + (dOut,hostAck,busy,al,ackOut,i2cOut) = + i2c hasClock hasReset smReset (fromEnable hasEnable) clkDiv claimBus i2cOp ackIn i2cIn + + onChange :: (HiddenClockResetEnable dom, Eq a, NFDataX a) => Signal dom a -> Signal dom Bool + onChange x = (Just <$> x) ./=. register Nothing (Just <$> x) + + capture :: Signal dom Bool + capture = withClockResetEnable hasClock hasReset enableGen $ + onChange $ bundle + ( isJust <$> i2cOp + , wbAck + , flagsRead + , isJust <$> transAddr + , hostAck + , busy + , al + , ackOut + , ackIn + , claimBus + ) + + i2cWbIla :: Signal dom () + i2cWbIla = setName @"i2cWbIla" $ ila + ((ilaConfig $ + "trigger_2" + :> "capture_2" + :> "i2cOp" + :> "wbAck" + :> "flagsRead" + :> "transAddr" + :> "hostAck" + :> "busy" + :> "al" + :> "ackOut" + :> "ackIn" + :> "claimBus" + :> Nil + ) { depth = D16384 }) + hasClock + (pure True :: Signal dom Bool) + capture + -- Debug signals + i2cOp + wbAck + flagsRead + transAddr + hostAck + busy + al + ackOut + ackIn + claimBus + +-- Wishbone accessible register circuit which can only be written to from the circuit. +statusRegWb :: + forall dom a nBytes addrW . + ( HiddenClockResetEnable dom + , BitPack a, NFDataX a + , KnownNat nBytes, 1 <= nBytes + , KnownNat addrW, 2 <= addrW + ) => + a -> + Circuit + (CSignal dom (Maybe a), Wishbone dom 'Standard addrW (Bytes nBytes)) + () +statusRegWb initVal = case (cancelMulDiv @nBytes @8) of + Dict -> fromSignals go + where + go ((inp,wbM2S), _) = ((pure (), wbS2M), ()) + where + (_, wbS2M) = registerWb CircuitPriority initVal wbM2S inp + +-- Wishbone accessible register circuit which can only be written to by the wishbone bus. +controlRegWb :: + forall dom a nBytes addrW . + ( HiddenClockResetEnable dom + , BitPack a, NFDataX a + , KnownNat nBytes, 1 <= nBytes + , KnownNat addrW, 2 <= addrW + ) => + a -> + Circuit + (Wishbone dom 'Standard addrW (Bytes nBytes)) + (CSignal dom a) +controlRegWb initVal = case (cancelMulDiv @nBytes @8) of + Dict -> fromSignals go + where + go (wbM2S, _) = (wbS2M, a) + where + (a, wbS2M) = registerWb WishbonePriority initVal wbM2S (pure Nothing) diff --git a/cabal.project b/cabal.project index ea0c35fc7..a3a139eee 100644 --- a/cabal.project +++ b/cabal.project @@ -73,31 +73,31 @@ index-state: 2023-12-05T05:33:28Z source-repository-package type: git location: https://github.com/clash-lang/clash-compiler.git - tag: 9afc2262a66cbf98c7c157d5472cbb46d0016f7f + tag: 59cb3c716153e46ec543572142f1b22b32c47852 subdir: clash-prelude source-repository-package type: git location: https://github.com/clash-lang/clash-compiler.git - tag: 9afc2262a66cbf98c7c157d5472cbb46d0016f7f + tag: 59cb3c716153e46ec543572142f1b22b32c47852 subdir: clash-ghc source-repository-package type: git location: https://github.com/clash-lang/clash-compiler.git - tag: 9afc2262a66cbf98c7c157d5472cbb46d0016f7f + tag: 59cb3c716153e46ec543572142f1b22b32c47852 subdir: clash-lib source-repository-package type: git location: https://github.com/clash-lang/clash-compiler.git - tag: 9afc2262a66cbf98c7c157d5472cbb46d0016f7f + tag: 59cb3c716153e46ec543572142f1b22b32c47852 subdir: clash-prelude-hedgehog source-repository-package type: git location: https://github.com/clash-lang/clash-compiler.git - tag: 9afc2262a66cbf98c7c157d5472cbb46d0016f7f + tag: 59cb3c716153e46ec543572142f1b22b32c47852 subdir: clash-cores source-repository-package diff --git a/firmware-binaries/Cargo.lock b/firmware-binaries/Cargo.lock index 2e6bac3a0..ef2b52490 100644 --- a/firmware-binaries/Cargo.lock +++ b/firmware-binaries/Cargo.lock @@ -85,6 +85,15 @@ version = "0.1.5" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "784a4df722dc6267a04af36895398f59d21d07dce47232adf31ec0ff2fa45e67" +[[package]] +name = "fmc-clock" +version = "0.1.0" +dependencies = [ + "bittide-sys", + "riscv-rt", + "ufmt", +] + [[package]] name = "hash32" version = "0.2.1" diff --git a/firmware-binaries/Cargo.toml b/firmware-binaries/Cargo.toml index a817d4c8d..9e420ebb4 100644 --- a/firmware-binaries/Cargo.toml +++ b/firmware-binaries/Cargo.toml @@ -16,9 +16,9 @@ members = [ "examples/hello", "test-cases/time_self_test", - "clock-control", - "processing-element-test", "clock-control", "clock-control-reg-cpy", + "fmc-clock", + "processing-element-test", ] resolver = "2" diff --git a/firmware-binaries/fmc-clock/Cargo.lock.license b/firmware-binaries/fmc-clock/Cargo.lock.license new file mode 100644 index 000000000..2b4d55897 --- /dev/null +++ b/firmware-binaries/fmc-clock/Cargo.lock.license @@ -0,0 +1,3 @@ +SPDX-FileCopyrightText: 2024 Google LLC + +SPDX-License-Identifier: CC0-1.0 diff --git a/firmware-binaries/fmc-clock/Cargo.toml b/firmware-binaries/fmc-clock/Cargo.toml new file mode 100644 index 000000000..8fa66a00a --- /dev/null +++ b/firmware-binaries/fmc-clock/Cargo.toml @@ -0,0 +1,17 @@ +# SPDX-FileCopyrightText: 2024 Google LLC +# +# SPDX-License-Identifier: CC0-1.0 + +[package] +name = "fmc-clock" +version = "0.1.0" +edition = "2021" +license = "Apache-2.0" +authors = ["Google LLC"] + +# See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html + +[dependencies] +riscv-rt = "0.11.0" +bittide-sys = { path = "../../firmware-support/bittide-sys" } +ufmt = "0.2.0" diff --git a/firmware-binaries/fmc-clock/build.rs b/firmware-binaries/fmc-clock/build.rs new file mode 100644 index 000000000..cd062a257 --- /dev/null +++ b/firmware-binaries/fmc-clock/build.rs @@ -0,0 +1,23 @@ +// SPDX-FileCopyrightText: 2024 Google LLC +// +// SPDX-License-Identifier: Apache-2.0 + +use std::env; +use std::fs; +use std::path::Path; + +/// Put the linker script somewhere the linker can find it. +fn main() { + let out_dir = env::var("OUT_DIR").expect("No out dir"); + let dest_path = Path::new(&out_dir).join("memory.x"); + fs::write(dest_path, include_bytes!("memory.x")).expect("Could not write file"); + + if env::var("CARGO_CFG_TARGET_ARCH").unwrap() == "riscv32" { + println!("cargo:rustc-link-arg=-Tmemory.x"); + println!("cargo:rustc-link-arg=-Tlink.x"); // linker script from riscv-rt + } + println!("cargo:rustc-link-search={out_dir}"); + + println!("cargo:rerun-if-changed=memory.x"); + println!("cargo:rerun-if-changed=build.rs"); +} diff --git a/firmware-binaries/fmc-clock/memory.x b/firmware-binaries/fmc-clock/memory.x new file mode 100644 index 000000000..29fd53f1c --- /dev/null +++ b/firmware-binaries/fmc-clock/memory.x @@ -0,0 +1,18 @@ +/* +SPDX-FileCopyrightText: 2024 Google LLC + +SPDX-License-Identifier: CC0-1.0 +*/ + +MEMORY +{ + IMEM : ORIGIN = 0x80000000, LENGTH = 128K + DMEM : ORIGIN = 0x40000000, LENGTH = 64K +} + +REGION_ALIAS("REGION_TEXT", IMEM); +REGION_ALIAS("REGION_RODATA", DMEM); +REGION_ALIAS("REGION_DATA", DMEM); +REGION_ALIAS("REGION_BSS", DMEM); +REGION_ALIAS("REGION_HEAP", DMEM); +REGION_ALIAS("REGION_STACK", DMEM); diff --git a/firmware-binaries/fmc-clock/rust-toolchain.toml b/firmware-binaries/fmc-clock/rust-toolchain.toml new file mode 100644 index 000000000..f0242ef95 --- /dev/null +++ b/firmware-binaries/fmc-clock/rust-toolchain.toml @@ -0,0 +1,7 @@ +# SPDX-FileCopyrightText: 2024 Google LLC +# +# SPDX-License-Identifier: CC0-1.0 + +[toolchain] +channel = "stable" +targets = [ "riscv32imc-unknown-none-elf" ] diff --git a/firmware-binaries/fmc-clock/src/config.csv b/firmware-binaries/fmc-clock/src/config.csv new file mode 100644 index 000000000..4510bedea --- /dev/null +++ b/firmware-binaries/fmc-clock/src/config.csv @@ -0,0 +1,560 @@ +# SPDX-FileCopyrightText: 2024 Google LLC +# +# SPDX-License-Identifier: Apache-2.0 +# +# Si534x/7x/8x/9x Registers Script +# +# Part: Si5345 +# Project File: C:\Users\User\Desktop\Si5345-RevD-FMC200M-Project.slabtimeproj +# Design ID: FMC200M +# Includes Pre/Post Download Control Register Writes: Yes +# Device Revision: D +# Creator: ClockBuilder Pro v4.11.0.1 [2023-09-14] +# Created On: 2024-02-08 02:47:30 GMT-08:00 +Address,Data +# +# Start configuration preamble +0x0B24,0xC0 +0x0B25,0x00 +0x0540,0x01 +# End configuration preamble +# +# Delay 300 msec +# Delay is worst case time for device to complete any calibration +# that is running due to device state change previous to this script +# being processed. +# +# Start configuration registers +0x0006,0x00 +0x0007,0x00 +0x0008,0x00 +0x000B,0x68 +0x0016,0x02 +0x0017,0xDC +0x0018,0xEE +0x0019,0xDD +0x001A,0xDF +0x0023,0xFE +0x0024,0x0B +0x0025,0x00 +0x0026,0x00 +0x0027,0x00 +0x0028,0x00 +0x002B,0x02 +0x002C,0x01 +0x002D,0x01 +0x002E,0x3F +0x002F,0x01 +0x0030,0x00 +0x0031,0x00 +0x0032,0x00 +0x0033,0x00 +0x0034,0x00 +0x0035,0x00 +0x0036,0x3F +0x0037,0x01 +0x0038,0x00 +0x0039,0x00 +0x003A,0x00 +0x003B,0x00 +0x003C,0x00 +0x003D,0x00 +0x003F,0x11 +0x0040,0x04 +0x0041,0x0B +0x0042,0x00 +0x0043,0x00 +0x0044,0x00 +0x0045,0x0C +0x0046,0x32 +0x0047,0x00 +0x0048,0x00 +0x0049,0x00 +0x004A,0x32 +0x004B,0x00 +0x004C,0x00 +0x004D,0x00 +0x004E,0x05 +0x004F,0x00 +0x0050,0x0F +0x0051,0x03 +0x0052,0x00 +0x0053,0x00 +0x0054,0x00 +0x0055,0x03 +0x0056,0x00 +0x0057,0x00 +0x0058,0x00 +0x0059,0x01 +0x005A,0x7B +0x005B,0x09 +0x005C,0xED +0x005D,0x00 +0x005E,0x00 +0x005F,0x00 +0x0060,0x00 +0x0061,0x00 +0x0062,0x00 +0x0063,0x00 +0x0064,0x00 +0x0065,0x00 +0x0066,0x00 +0x0067,0x00 +0x0068,0x00 +0x0069,0x00 +0x0092,0x02 +0x0093,0xA0 +0x0095,0x00 +0x0096,0x80 +0x0098,0x60 +0x009A,0x02 +0x009B,0x60 +0x009D,0x08 +0x009E,0x40 +0x00A0,0x20 +0x00A2,0x00 +0x00A9,0xA2 +0x00AA,0x61 +0x00AB,0x00 +0x00AC,0x00 +0x00E5,0x00 +0x00EA,0x0A +0x00EB,0x60 +0x00EC,0x00 +0x00ED,0x00 +0x0102,0x01 +0x0108,0x02 +0x0109,0x09 +0x010A,0x3E +0x010B,0x19 +0x010D,0x01 +0x010E,0x09 +0x010F,0x3B +0x0110,0x28 +0x0112,0x06 +0x0113,0x09 +0x0114,0x3E +0x0115,0x18 +0x0117,0x01 +0x0118,0x09 +0x0119,0x3B +0x011A,0x28 +0x011C,0x01 +0x011D,0x09 +0x011E,0x3B +0x011F,0x28 +0x0121,0x01 +0x0122,0x09 +0x0123,0x3B +0x0124,0x28 +0x0126,0x01 +0x0127,0x09 +0x0128,0x3B +0x0129,0x28 +0x012B,0x01 +0x012C,0x09 +0x012D,0x3B +0x012E,0x28 +0x0130,0x01 +0x0131,0x09 +0x0132,0x3B +0x0133,0x28 +0x013A,0x01 +0x013B,0x09 +0x013C,0x3B +0x013D,0x28 +0x013F,0x00 +0x0140,0x00 +0x0141,0x40 +0x0142,0xFF +0x0206,0x00 +0x0208,0x7D +0x0209,0x00 +0x020A,0x00 +0x020B,0x00 +0x020C,0x00 +0x020D,0x00 +0x020E,0x01 +0x020F,0x00 +0x0210,0x00 +0x0211,0x00 +0x0212,0x00 +0x0213,0x00 +0x0214,0x00 +0x0215,0x00 +0x0216,0x00 +0x0217,0x00 +0x0218,0x00 +0x0219,0x00 +0x021A,0x00 +0x021B,0x00 +0x021C,0x00 +0x021D,0x00 +0x021E,0x00 +0x021F,0x00 +0x0220,0x00 +0x0221,0x00 +0x0222,0x00 +0x0223,0x00 +0x0224,0x00 +0x0225,0x00 +0x0226,0x00 +0x0227,0x00 +0x0228,0x00 +0x0229,0x00 +0x022A,0x00 +0x022B,0x00 +0x022C,0x00 +0x022D,0x00 +0x022E,0x00 +0x022F,0x00 +0x0231,0x0B +0x0232,0x0B +0x0233,0x0B +0x0234,0x0B +0x0235,0x00 +0x0236,0x00 +0x0237,0x00 +0x0238,0x98 +0x0239,0xCE +0x023A,0x00 +0x023B,0x00 +0x023C,0x00 +0x023D,0x00 +0x023E,0xD8 +0x024A,0x03 +0x024B,0x00 +0x024C,0x00 +0x024D,0x00 +0x024E,0x00 +0x024F,0x00 +0x0250,0x00 +0x0251,0x00 +0x0252,0x00 +0x0253,0x00 +0x0254,0x00 +0x0255,0x00 +0x0256,0x00 +0x0257,0x00 +0x0258,0x00 +0x0259,0x00 +0x025A,0x00 +0x025B,0x00 +0x025C,0x00 +0x025D,0x00 +0x025E,0x00 +0x025F,0x00 +0x0260,0x00 +0x0261,0x00 +0x0262,0x00 +0x0263,0x00 +0x0264,0x00 +0x0268,0x00 +0x0269,0x00 +0x026A,0x00 +0x026B,0x46 +0x026C,0x4D +0x026D,0x43 +0x026E,0x32 +0x026F,0x30 +0x0270,0x30 +0x0271,0x4D +0x0272,0x00 +0x028A,0x00 +0x028B,0x00 +0x028C,0x00 +0x028D,0x00 +0x028E,0x00 +0x028F,0x00 +0x0290,0x00 +0x0291,0x00 +0x0294,0xB0 +0x0296,0x02 +0x0297,0x02 +0x0299,0x02 +0x029D,0xFA +0x029E,0x01 +0x029F,0x00 +0x02A9,0xCC +0x02AA,0x04 +0x02AB,0x00 +0x02B7,0xFF +0x0302,0x00 +0x0303,0x00 +0x0304,0x00 +0x0305,0xD3 +0x0306,0x19 +0x0307,0x00 +0x0308,0x00 +0x0309,0x00 +0x030A,0x00 +0x030B,0xC8 +0x030C,0x00 +0x030D,0x00 +0x030E,0x00 +0x030F,0x00 +0x0310,0xA6 +0x0311,0x33 +0x0312,0x00 +0x0313,0x00 +0x0314,0x00 +0x0315,0x00 +0x0316,0xC8 +0x0317,0x00 +0x0318,0x00 +0x0319,0x00 +0x031A,0x00 +0x031B,0x00 +0x031C,0x00 +0x031D,0x00 +0x031E,0x00 +0x031F,0x00 +0x0320,0x00 +0x0321,0x00 +0x0322,0x00 +0x0323,0x00 +0x0324,0x00 +0x0325,0x00 +0x0326,0x00 +0x0327,0x00 +0x0328,0x00 +0x0329,0x00 +0x032A,0x00 +0x032B,0x00 +0x032C,0x00 +0x032D,0x00 +0x032E,0x00 +0x032F,0x00 +0x0330,0x00 +0x0331,0x00 +0x0332,0x00 +0x0333,0x00 +0x0334,0x00 +0x0335,0x00 +0x0336,0x00 +0x0337,0x00 +0x0338,0x00 +0x0339,0x1E +0x033B,0x6F +0x033C,0x00 +0x033D,0x00 +0x033E,0x00 +0x033F,0x00 +0x0340,0x00 +0x0341,0x00 +0x0342,0x00 +0x0343,0x00 +0x0344,0x00 +0x0345,0x00 +0x0346,0x00 +0x0347,0x00 +0x0348,0x00 +0x0349,0x00 +0x034A,0x00 +0x034B,0x00 +0x034C,0x00 +0x034D,0x00 +0x034E,0x00 +0x034F,0x00 +0x0350,0x00 +0x0351,0x00 +0x0352,0x00 +0x0353,0x00 +0x0354,0x00 +0x0355,0x00 +0x0356,0x00 +0x0357,0x00 +0x0358,0x00 +0x0359,0x00 +0x035A,0x00 +0x035B,0x00 +0x035C,0x00 +0x035D,0x00 +0x035E,0x00 +0x035F,0x00 +0x0360,0x00 +0x0361,0x00 +0x0362,0x00 +0x0487,0x00 +0x0508,0x13 +0x0509,0x22 +0x050A,0x0C +0x050B,0x0B +0x050C,0x07 +0x050D,0x07 +0x050E,0x16 +0x050F,0x2A +0x0510,0x09 +0x0511,0x08 +0x0512,0x07 +0x0513,0x07 +0x0515,0x00 +0x0516,0x00 +0x0517,0x00 +0x0518,0x00 +0x0519,0xD3 +0x051A,0x19 +0x051B,0x00 +0x051C,0x00 +0x051D,0x00 +0x051E,0x00 +0x051F,0x80 +0x0521,0x2B +0x052A,0x01 +0x052B,0x01 +0x052C,0x87 +0x052D,0x03 +0x052E,0x19 +0x052F,0x19 +0x0531,0x00 +0x0532,0x8E +0x0533,0x20 +0x0534,0x00 +0x0535,0x00 +0x0536,0x04 +0x0537,0x00 +0x0538,0x00 +0x0539,0x00 +0x053A,0x02 +0x053B,0x03 +0x053C,0x00 +0x053D,0x0E +0x053E,0x06 +0x0589,0x81 +0x058A,0x00 +0x059B,0xF8 +0x059D,0x13 +0x059E,0x24 +0x059F,0x0C +0x05A0,0x0B +0x05A1,0x07 +0x05A2,0x07 +0x05A6,0x03 +0x0802,0x35 +0x0803,0x05 +0x0804,0x00 +0x0805,0x00 +0x0806,0x00 +0x0807,0x00 +0x0808,0x00 +0x0809,0x00 +0x080A,0x00 +0x080B,0x00 +0x080C,0x00 +0x080D,0x00 +0x080E,0x00 +0x080F,0x00 +0x0810,0x00 +0x0811,0x00 +0x0812,0x00 +0x0813,0x00 +0x0814,0x00 +0x0815,0x00 +0x0816,0x00 +0x0817,0x00 +0x0818,0x00 +0x0819,0x00 +0x081A,0x00 +0x081B,0x00 +0x081C,0x00 +0x081D,0x00 +0x081E,0x00 +0x081F,0x00 +0x0820,0x00 +0x0821,0x00 +0x0822,0x00 +0x0823,0x00 +0x0824,0x00 +0x0825,0x00 +0x0826,0x00 +0x0827,0x00 +0x0828,0x00 +0x0829,0x00 +0x082A,0x00 +0x082B,0x00 +0x082C,0x00 +0x082D,0x00 +0x082E,0x00 +0x082F,0x00 +0x0830,0x00 +0x0831,0x00 +0x0832,0x00 +0x0833,0x00 +0x0834,0x00 +0x0835,0x00 +0x0836,0x00 +0x0837,0x00 +0x0838,0x00 +0x0839,0x00 +0x083A,0x00 +0x083B,0x00 +0x083C,0x00 +0x083D,0x00 +0x083E,0x00 +0x083F,0x00 +0x0840,0x00 +0x0841,0x00 +0x0842,0x00 +0x0843,0x00 +0x0844,0x00 +0x0845,0x00 +0x0846,0x00 +0x0847,0x00 +0x0848,0x00 +0x0849,0x00 +0x084A,0x00 +0x084B,0x00 +0x084C,0x00 +0x084D,0x00 +0x084E,0x00 +0x084F,0x00 +0x0850,0x00 +0x0851,0x00 +0x0852,0x00 +0x0853,0x00 +0x0854,0x00 +0x0855,0x00 +0x0856,0x00 +0x0857,0x00 +0x0858,0x00 +0x0859,0x00 +0x085A,0x00 +0x085B,0x00 +0x085C,0x00 +0x085D,0x00 +0x085E,0x00 +0x085F,0x00 +0x0860,0x00 +0x0861,0x00 +0x090E,0x02 +0x0943,0x00 +0x0949,0x01 +0x094A,0x01 +0x094E,0x49 +0x094F,0x02 +0x095E,0x00 +0x0A02,0x00 +0x0A03,0x03 +0x0A04,0x00 +0x0A05,0x03 +0x0A14,0x00 +0x0A1A,0x00 +0x0A20,0x00 +0x0A26,0x00 +0x0A2C,0x00 +0x0B44,0x2F +0x0B46,0x00 +0x0B47,0x0E +0x0B48,0x0E +0x0B4A,0x1C +0x0B57,0xF0 +0x0B58,0x00 +# End configuration registers +# +# Start configuration postamble +0x0514,0x01 +0x001C,0x01 +0x0540,0x00 +0x0B24,0xC3 +0x0B25,0x02 +# End configuration postamble diff --git a/firmware-binaries/fmc-clock/src/main.rs b/firmware-binaries/fmc-clock/src/main.rs new file mode 100644 index 000000000..de82f728a --- /dev/null +++ b/firmware-binaries/fmc-clock/src/main.rs @@ -0,0 +1,429 @@ +#![no_std] +#![cfg_attr(not(test), no_main)] + +// SPDX-FileCopyrightText: 2024 Google LLC +// +// SPDX-License-Identifier: Apache-2.0 + +use core::panic::PanicInfo; +use ufmt::{derive::uDebug, uwriteln}; + +use bittide_sys::{ + clock_config::{self, ConfigEntry, ParserState}, + data_counts::DataCounts, + i2c::I2CError, + si534x::SI534X, + time::{Clock, Duration}, + uart::Uart, +}; +#[cfg(not(test))] +use riscv_rt::entry; + +#[derive(PartialEq, uDebug)] +pub enum TestState { + Busy, + Fail, + Success, +} + +// A Control Register is a register which controls peripherals outside the CPU, and which +// can only be written to by the CPU. +#[derive(uDebug)] +pub struct ControlRegister { + addr: *mut u8, + clock_init_done: bool, + test_state: TestState, +} + +impl ControlRegister { + pub fn new(base_addr: *mut u8) -> ControlRegister { + ControlRegister { + addr: base_addr, + clock_init_done: false, + test_state: TestState::Busy, + } + } + + pub fn set_clock_init_done(&mut self) { + self.clock_init_done = true; + self.update(); + } + + pub fn clear_clock_init_done(&mut self) { + self.clock_init_done = false; + self.update(); + } + + pub fn set_test_state(&mut self, ts: TestState) { + self.test_state = ts; + self.update(); + } + + fn update(&mut self) { + let mut p: u8 = 0x00; + if self.clock_init_done { + p |= 0b100; + } + match self.test_state { + TestState::Busy => p |= 0b000, + TestState::Fail => p |= 0b001, + TestState::Success => p |= 0b010, + } + unsafe { self.addr.write_volatile(p) }; + } +} + +#[derive(Copy, Clone, PartialEq)] +pub enum Test { + /// Reconfigure the clock chip and reset test status + Idle, + /// Keep pressing FDEC, see if counter falls below certain threshold + FDec, + /// Keep pressing FINC, see if counter exceeds certain threshold + FInc, + /// 'FDec' test followed by an 'FInc' one + FDecInc, + /// 'FInc' test followed by an 'FDec' one + FIncDec, +} + +#[derive(uDebug)] +pub struct InvalidStatusRegister { + pub val: u8, +} + +// A Status Register is a register with which a peripheral can communicate its status +// to the CPU. This register can only be written to by the peripheral. +pub struct StatusRegister { + pub addr: *mut u8, + pub test: Test, +} + +impl StatusRegister { + pub fn new(base_addr: *mut u8) -> StatusRegister { + StatusRegister { + addr: base_addr, + test: Test::Idle, + } + } + + pub fn get_test(&mut self) -> Result { + self.refresh()?; + Ok(self.test) + } + + fn refresh(&mut self) -> Result<(), InvalidStatusRegister> { + let data = unsafe { self.addr.read_volatile() }; + self.test = Self::parse_reg(data)?; + Ok(()) + } + + fn parse_reg(data: u8) -> Result { + if (data & 0b100) == 0 { + Ok(Test::Idle) + } else if (data & 0b100) == 0b100 { + match data & 0b011 { + 0b00 => Ok(Test::FDec), + 0b01 => Ok(Test::FInc), + 0b10 => Ok(Test::FDecInc), + 0b11 => Ok(Test::FIncDec), + _ => Err(InvalidStatusRegister { val: data }), + } + } else { + Err(InvalidStatusRegister { val: data }) + } + } +} + +const THRESHOLD: i32 = 20_000; + +pub fn test_fdec( + data_counts: &DataCounts, + si534x: &mut SI534X, + threshold_up: i32, + threshold_down: i32, +) -> Option { + let dc = data_counts.data_counts().next().unwrap(); + if dc > threshold_up { + return Some(false); + } else if dc < threshold_down { + return Some(true); + } + if si534x.fdec().is_err() { + Some(false) + } else { + None + } +} + +pub fn test_finc( + data_counts: &DataCounts, + si534x: &mut SI534X, + threshold_up: i32, + threshold_down: i32, +) -> Option { + let dc = data_counts.data_counts().next().unwrap(); + if dc > threshold_up { + return Some(true); + } else if dc < threshold_down { + return Some(false); + } + if si534x.finc().is_err() { + Some(false) + } else { + None + } +} + +pub fn configure_clock_chip( + uart: &mut Uart, + si534x: &mut SI534X, + clock: &Clock, +) -> Result<(), I2CError> { + // Parse config.csv using bittide::clock_config + uwriteln!(uart, "Starting clock chip configuration").unwrap(); + let si534x_config = include_str!("config.csv"); + let mut parser = clock_config::ClockConfigParser::new(); + for line in si534x_config.lines() { + if !parser.is_done() { + let old_state = parser.state; + match parser.parse_line(line) { + Ok(Some(ConfigEntry { page, addr, data })) => { + si534x.write_byte(page, addr, data)?; + uwriteln!(uart, "Wrote: {:2X} {:2X} {:2X}", page, addr, data).unwrap(); + } + Ok(None) => {} + Err(e) => { + uwriteln!(uart, "Error: {:?}", e).unwrap(); + } + } + if old_state == ParserState::Preamble && parser.state == ParserState::PostPreambleDelay + { + // Wait 300ms after writing the preamble + uwriteln!(uart, "Waiting 300 ms after preamble...").unwrap(); + clock.wait(Duration::from_millis(300)); + uwriteln!(uart, "Done waiting").unwrap(); + } + } + } + uwriteln!(uart, "Configured clock chip").unwrap(); + Ok(()) +} + +#[cfg_attr(not(test), entry)] +fn main() -> ! { + let clock = unsafe { Clock::new((0b0001 << 28) as *const u32) }; + let mut si534x = unsafe { SI534X::new((0b0010 << 28) as *mut u8, 0x69) }; + let mut control_reg = ControlRegister::new((0b0011 << 28) as *mut u8); + let mut status_reg = StatusRegister::new((0b0101 << 28) as *mut u8); + let data_counts = unsafe { DataCounts::from_base_addr((0b0110 << 28) as *mut u32) }; + let mut uart = unsafe { Uart::new((0b0111 << 28) as *mut u8) }; + + uwriteln!(uart, "Starting RiscV core").unwrap(); + + // Set up clock chip i2c interface. + let clk_div = 300; + si534x.set_clock_divider(clk_div); + + if configure_clock_chip(&mut uart, &mut si534x, &clock).is_ok() { + // Communicate to hardware that the CPU is done programming the I2C chip + control_reg.set_clock_init_done(); + } + + // Try to read and write the page number + match si534x.read_byte(0x0, 0x01) { + Ok(d) => uwriteln!(uart, "Current page: {:2X}", d).unwrap(), + Err(e) => uwriteln!(uart, "ERROR: {:?}", e).unwrap(), + } + _ = si534x.set_page(0x1); + match si534x.read_byte(0x1, 0x01) { + Ok(d) => uwriteln!(uart, "Current page: {:2X}", d).unwrap(), + Err(e) => uwriteln!(uart, "ERROR: {:?}", e).unwrap(), + } + uwriteln!(uart, "Checked pages, continuing...").unwrap(); + + // Do the FInc FDec tests + let mut last_status_reg; + let mut sub_test = Test::Idle; + let mut finc_decs: i32 = 0; + loop { + last_status_reg = status_reg.test; + match status_reg.get_test() { + Err(e) => { + uwriteln!( + uart, + "Could not parse status register with data {:02X}", + e.val + ) + .unwrap(); + } + Ok(Test::Idle) => { + if last_status_reg != status_reg.test { + control_reg.set_test_state(TestState::Busy); + finc_decs = 0; + control_reg.clear_clock_init_done(); + match configure_clock_chip(&mut uart, &mut si534x, &clock) { + Ok(()) => { + control_reg.set_clock_init_done(); + } + Err(e) => { + uwriteln!(uart, "Failed to configure clock: {:?}", e).unwrap(); + control_reg.set_test_state(TestState::Fail); + } + } + } + } + Ok(Test::FDec) => { + if last_status_reg != status_reg.test { + uwriteln!(uart, "\nStarting FDec test").unwrap(); + control_reg.set_test_state(TestState::Busy); + } + if control_reg.test_state != TestState::Busy { + continue; + } + finc_decs -= 1; + match test_fdec(&data_counts, &mut si534x, THRESHOLD, -THRESHOLD) { + Some(true) => { + if control_reg.test_state == TestState::Busy { + uwriteln!(uart, "Pressed finc_dec {} times", finc_decs).unwrap(); + } + control_reg.set_test_state(TestState::Success); + } + Some(false) => { + if control_reg.test_state == TestState::Busy { + uwriteln!(uart, "Pressed finc_dec {} times", finc_decs).unwrap(); + } + control_reg.set_test_state(TestState::Fail); + } + None => {} + } + } + Ok(Test::FInc) => { + if last_status_reg != status_reg.test { + uwriteln!(uart, "\nStarting FInc test").unwrap(); + control_reg.set_test_state(TestState::Busy); + } + if control_reg.test_state != TestState::Busy { + continue; + } + finc_decs += 1; + match test_finc(&data_counts, &mut si534x, THRESHOLD, -THRESHOLD) { + Some(true) => { + if control_reg.test_state == TestState::Busy { + uwriteln!(uart, "Pressed finc_dec {} times", finc_decs).unwrap(); + } + control_reg.set_test_state(TestState::Success); + } + Some(false) => { + if control_reg.test_state == TestState::Busy { + uwriteln!(uart, "Pressed finc_dec {} times", finc_decs).unwrap(); + } + control_reg.set_test_state(TestState::Fail); + } + None => {} + } + } + Ok(Test::FDecInc) => { + if last_status_reg != status_reg.test { + uwriteln!(uart, "\nStarting FDecInc test").unwrap(); + control_reg.set_test_state(TestState::Busy); + sub_test = Test::FDec; + } + if control_reg.test_state != TestState::Busy { + continue; + } + if sub_test == Test::FDec { + finc_decs -= 1; + match test_fdec(&data_counts, &mut si534x, THRESHOLD, -THRESHOLD) { + Some(true) => { + if control_reg.test_state == TestState::Busy { + uwriteln!(uart, "Pressed finc_dec {} times", finc_decs).unwrap(); + finc_decs = 0; + } + sub_test = Test::FInc; + } + Some(false) => { + if control_reg.test_state == TestState::Busy { + uwriteln!(uart, "Pressed finc_dec {} times", finc_decs).unwrap(); + finc_decs = 0; + } + control_reg.set_test_state(TestState::Fail); + } + None => {} + } + } else if sub_test == Test::FInc { + finc_decs += 1; + match test_finc(&data_counts, &mut si534x, 0, 3 * -THRESHOLD) { + Some(true) => { + if control_reg.test_state == TestState::Busy { + uwriteln!(uart, "Pressed finc_dec {} times", finc_decs).unwrap(); + } + control_reg.set_test_state(TestState::Success); + } + Some(false) => { + if control_reg.test_state == TestState::Busy { + uwriteln!(uart, "Pressed finc_dec {} times", finc_decs).unwrap(); + } + control_reg.set_test_state(TestState::Fail); + } + None => {} + } + } + } + Ok(Test::FIncDec) => { + if last_status_reg != status_reg.test { + uwriteln!(uart, "\nStarting FIncDec test").unwrap(); + control_reg.set_test_state(TestState::Busy); + sub_test = Test::FInc; + } + if control_reg.test_state != TestState::Busy { + continue; + } + if sub_test == Test::FInc { + finc_decs += 1; + match test_finc(&data_counts, &mut si534x, THRESHOLD, -THRESHOLD) { + Some(true) => { + if control_reg.test_state == TestState::Busy { + uwriteln!(uart, "Pressed finc_dec {} times", finc_decs).unwrap(); + finc_decs = 0; + } + sub_test = Test::FDec; + } + Some(false) => { + if control_reg.test_state == TestState::Busy { + uwriteln!(uart, "Pressed finc_dec {} times", finc_decs).unwrap(); + finc_decs = 0; + } + control_reg.set_test_state(TestState::Fail); + } + None => {} + } + } else if sub_test == Test::FDec { + finc_decs -= 1; + match test_fdec(&data_counts, &mut si534x, 3 * THRESHOLD, 0) { + Some(true) => { + if control_reg.test_state == TestState::Busy { + uwriteln!(uart, "Pressed finc_dec {} times", finc_decs).unwrap(); + } + control_reg.set_test_state(TestState::Success); + } + Some(false) => { + if control_reg.test_state == TestState::Busy { + uwriteln!(uart, "Pressed finc_dec {} times", finc_decs).unwrap(); + } + control_reg.set_test_state(TestState::Fail); + } + None => {} + } + } + } + } + } +} + +#[panic_handler] +fn panic_handler(_info: &PanicInfo) -> ! { + loop { + continue; + } +} diff --git a/firmware-support/bittide-sys/src/clock_config.rs b/firmware-support/bittide-sys/src/clock_config.rs new file mode 100644 index 000000000..2e59871d4 --- /dev/null +++ b/firmware-support/bittide-sys/src/clock_config.rs @@ -0,0 +1,143 @@ +// SPDX-FileCopyrightText: 2023-2024 Google LLC +// +// SPDX-License-Identifier: Apache-2.0 + +use ufmt::derive::uDebug; +use ufmt::uDebug; + +#[derive(Debug, Copy, Clone, PartialEq)] +pub enum ParserState { + PreambleHeader, + Preamble, + PostPreambleDelay, + Config, + PostambleHeader, + Postamble, + Done, +} + +#[derive(uDebug)] +pub struct ConfigEntry { + pub page: u8, + pub addr: u8, + pub data: u8, +} + +#[derive(uDebug)] +pub enum ClockConfigParseError { + AddressMissing, + DataMissing, + AddressOutOfRange, + DataOutOfRange, + EndOfConfig, + InvalidHexNumber, +} + +/// Create a class that implements the statemachine for parsing the clock configuration file. +pub struct ClockConfigParser { + pub state: ParserState, +} + +impl ClockConfigParser { + /// Create a new parser. + pub fn new() -> Self { + Self { + state: ParserState::PreambleHeader, + } + } + + /// Parse a line of the clock configuration file. + pub fn parse_line(&mut self, line: &str) -> Result, ClockConfigParseError> { + let (next_state, result) = parse_line(self.state, line); + self.state = next_state; + result + } + + /// Check if the parser is done. + pub fn is_done(&self) -> bool { + self.state == ParserState::Done + } +} + +impl Default for ClockConfigParser { + fn default() -> Self { + Self::new() + } +} + +fn parse_line( + state: ParserState, + line: &str, +) -> ( + ParserState, + Result, ClockConfigParseError>, +) { + let next_state = match (state, line) { + (ParserState::PreambleHeader, _) if line.contains("Start configuration preamble") => { + ParserState::Preamble + } + (ParserState::Preamble, _) if line.contains("End configuration preamble") => { + ParserState::PostPreambleDelay + } + (ParserState::PostPreambleDelay, _) if line.contains("Start configuration registers") => { + ParserState::Config + } + (ParserState::Config, _) if line.contains("End configuration registers") => { + ParserState::PostambleHeader + } + (ParserState::PostambleHeader, _) if line.contains("Start configuration postamble") => { + ParserState::Postamble + } + (ParserState::Postamble, _) if line.contains("End configuration postamble") => { + ParserState::Done + } + _ => state, + }; + if next_state != state { + return (next_state, Ok(None)); + } + let result = match state { + ParserState::Preamble | ParserState::Config | ParserState::Postamble => { + parse_address_data(line).map(Some) + } + ParserState::Done => Err(ClockConfigParseError::EndOfConfig), + _ => Ok(None), + }; + (next_state, result) +} + +fn parse_address_data(line: &str) -> Result { + let mut parts = line.split(','); + + let address_str = parts.next().ok_or(ClockConfigParseError::AddressMissing)?; + let full_address: u16 = parse_hex(address_str)? + .try_into() + .map_err(|_| ClockConfigParseError::AddressOutOfRange)?; + let page = (full_address >> 8) as u8; + let addr = (full_address & 0xff) as u8; + + let data_str = parts.next().ok_or(ClockConfigParseError::DataMissing)?; + let data: u8 = parse_hex(data_str)? + .try_into() + .map_err(|_| ClockConfigParseError::DataOutOfRange)?; + + let config_entry = ConfigEntry { page, addr, data }; + Ok(config_entry) +} + +fn parse_hex(hex_string: &str) -> Result { + if let Some(hex_stripped) = hex_string.strip_prefix("0x") { + u32::from_str_radix(hex_stripped, 16).map_err(|_| ClockConfigParseError::InvalidHexNumber) + } else { + Err(ClockConfigParseError::InvalidHexNumber) + } +} + +impl ufmt::uDisplay for ClockConfigParseError { + fn fmt(&self, f: &mut ufmt::Formatter<'_, W>) -> Result<(), W::Error> + where + W: ufmt::uWrite + ?Sized, + { + ::fmt(self, f) + } +} diff --git a/firmware-support/bittide-sys/src/data_counts.rs b/firmware-support/bittide-sys/src/data_counts.rs new file mode 100644 index 000000000..4918ccbfe --- /dev/null +++ b/firmware-support/bittide-sys/src/data_counts.rs @@ -0,0 +1,42 @@ +// SPDX-FileCopyrightText: 2024 Google LLC +// +// SPDX-License-Identifier: Apache-2.0 + +pub struct DataCounts { + num_links: *const u8, + data_counts_start: *const i32, +} + +impl DataCounts { + /// Load the domainDiffCounters registers from a flattened-devicetree. + /// + /// # Safety + /// + /// The `base_addr` must be a valid memory address to dataCount registers. + pub unsafe fn from_base_addr(base_addr: *const u32) -> Self { + Self { + num_links: base_addr.cast::(), + data_counts_start: base_addr.add(1).cast(), + } + } + + pub fn num_links(&self) -> u8 { + // SAFETY: This is safe since this function can only be called + // after construction, which is only valid with valid addresses. + unsafe { self.num_links.read_volatile() } + } + + pub fn data_counts(&self) -> impl Iterator + '_ { + let n = self.num_links(); + let mut i = 0; + core::iter::from_fn(move || { + if i == n { + None + } else { + let count = unsafe { self.data_counts_start.add(i as usize).read_volatile() }; + i += 1; + Some(count) + } + }) + } +} diff --git a/firmware-support/bittide-sys/src/i2c.rs b/firmware-support/bittide-sys/src/i2c.rs new file mode 100644 index 000000000..1b5e5d150 --- /dev/null +++ b/firmware-support/bittide-sys/src/i2c.rs @@ -0,0 +1,196 @@ +// SPDX-FileCopyrightText: 2023-2024 Google LLC +// +// SPDX-License-Identifier: Apache-2.0 + +use ufmt::derive::uDebug; +#[derive(Copy, Clone, uDebug)] +pub struct I2CFlags { + pub bus_busy: bool, + pub arbitration_lost: bool, + pub acknowledge_incoming: bool, + pub transaction_acknowledged: bool, + pub bus_claimed: bool, + pub statemachine_reset: bool, +} + +#[derive(uDebug)] +pub enum I2CError { + ArbitrationLost, + BusClaimedByOther, + NotAcknowledged, +} + +/// `I2C` is a structure representing a universal asynchronous receiver-transmitter. +#[derive(uDebug)] +pub struct I2C { + /// `payload_addr` is a mutable pointer to the address of the data payload. + payload_addr: *mut u8, + /// `flags_addr` is a constant pointer to the address of the flags. + flags_addr: *mut u8, + /// `clk_div_addr` is a constant pointer to the address of the clock divider. + clk_div_addr: *mut u16, +} + +impl I2C { + /// Create a new [`I2C`] instance given a base address. + /// + /// # Safety + /// + /// The `base_addr` pointer MUST BE a valid pointer that is backed + /// by either a memory mapped UART instance or at valid read-writable memory + /// (which will likely cause incorrect behaviour, but not break memory safety) + pub const unsafe fn new(base_addr: *mut u8) -> I2C { + I2C { + payload_addr: base_addr, + clk_div_addr: base_addr.add(4).cast(), + flags_addr: base_addr.add(8).cast(), + } + } + + pub fn init(&mut self) { + let flags = I2CFlags { + bus_busy: false, + arbitration_lost: false, + acknowledge_incoming: false, + transaction_acknowledged: false, + bus_claimed: false, + statemachine_reset: false, + }; + self.write_flags(flags); + } + + pub fn claim_bus(&mut self) -> Result<(), I2CError> { + let mut flags = self.read_flags(); + if flags.bus_busy && !flags.bus_claimed { + Err(I2CError::BusClaimedByOther) + } else { + flags.bus_claimed = true; + self.write_flags(flags); + Ok(()) + } + } + + pub fn claim_bus_with_retry(&mut self) -> Result<(), I2CError> { + const MAX_RETRIES: usize = 10; + for _ in 0..MAX_RETRIES { + let mut flags = self.read_flags(); + if !flags.bus_busy || flags.bus_claimed { + flags.bus_claimed = true; + self.write_flags(flags); + return Ok(()); + } + } + // If all retries failed, return an error + Err(I2CError::BusClaimedByOther) + } + + pub fn release_bus(&mut self) { + let mut flags = self.read_flags(); + flags.bus_claimed = false; + flags.arbitration_lost = false; + self.write_flags(flags); + } + + pub fn read_byte(&mut self) -> Result { + let flags = self.read_flags(); + let already_claimed = flags.bus_claimed; + if !already_claimed { + self.claim_bus_with_retry()?; + }; + let data = unsafe { self.payload_addr.read_volatile() }; + let old_flags = self.read_flags(); + let mut new_flags = old_flags; + if !already_claimed { + new_flags.bus_claimed = false + }; + new_flags.arbitration_lost = false; + new_flags.transaction_acknowledged = false; + self.write_flags(new_flags); + if old_flags.arbitration_lost { + Err(I2CError::ArbitrationLost) + } else { + Ok(data) + } + } + + pub fn write_byte(&mut self, data: u8) -> Result<(), I2CError> { + let flags = self.read_flags(); + let already_claimed = flags.bus_claimed; + if !already_claimed { + self.claim_bus_with_retry()?; + }; + unsafe { self.payload_addr.write_volatile(data) }; + let old_flags = self.read_flags(); + let mut new_flags = old_flags; + if !already_claimed { + new_flags.bus_claimed = false + }; + new_flags.arbitration_lost = false; + new_flags.transaction_acknowledged = false; + self.write_flags(new_flags); + if old_flags.arbitration_lost { + Err(I2CError::ArbitrationLost) + } else if !old_flags.transaction_acknowledged { + Err(I2CError::NotAcknowledged) + } else { + Ok(()) + } + } + + /// I2C status register output + pub fn read_flags(&mut self) -> I2CFlags { + let flags = unsafe { self.flags_addr.read_volatile() } as u32; + + let bus_busy = check_bit(flags, 5); + let arbitration_lost = check_bit(flags, 4); + let transaction_acknowledged = check_bit(flags, 3); + let acknowledge_incoming = check_bit(flags, 2); + let bus_claimed = check_bit(flags, 1); + let statemachine_reset = check_bit(flags, 0); + + I2CFlags { + bus_busy, + arbitration_lost, + transaction_acknowledged, + acknowledge_incoming, + bus_claimed, + statemachine_reset, + } + } + + /// UART status register output + pub fn write_flags(&mut self, status: I2CFlags) { + let mut flags: u8 = 0; + + if status.arbitration_lost { + flags |= 0b010000; + } + if status.transaction_acknowledged { + flags |= 0b001000; + } + if status.acknowledge_incoming { + flags |= 0b000100; + } + if status.bus_claimed { + flags |= 0b000010; + } + if status.statemachine_reset { + flags |= 0b000001; + } + + unsafe { self.flags_addr.write_volatile(flags) }; + } + + pub fn get_clock_divider(&mut self) -> u16 { + unsafe { self.clk_div_addr.read_volatile() } + } + + pub fn set_clock_divider(&mut self, clk_div: u16) { + unsafe { self.clk_div_addr.write_volatile(clk_div) } + } +} + +fn check_bit(a: u32, index: u32) -> bool { + let mask = 1 << index; + a & mask == mask +} diff --git a/firmware-support/bittide-sys/src/lib.rs b/firmware-support/bittide-sys/src/lib.rs index 42b770aed..82590d7a1 100644 --- a/firmware-support/bittide-sys/src/lib.rs +++ b/firmware-support/bittide-sys/src/lib.rs @@ -8,10 +8,14 @@ use fdt::Fdt; use utils::matches_fdt_name; pub mod callisto; +pub mod clock_config; pub mod clock_control; +pub mod data_counts; pub mod gather_unit; +pub mod i2c; pub mod program_stream; pub mod scatter_unit; +pub mod si534x; pub mod time; pub mod uart; diff --git a/firmware-support/bittide-sys/src/si534x.rs b/firmware-support/bittide-sys/src/si534x.rs new file mode 100644 index 000000000..60b93f73b --- /dev/null +++ b/firmware-support/bittide-sys/src/si534x.rs @@ -0,0 +1,100 @@ +// SPDX-FileCopyrightText: 2023-2024 Google LLC +// +// SPDX-License-Identifier: Apache-2.0 + +use ufmt::derive::uDebug; + +use crate::i2c::{I2CError, I2C}; + +#[derive(uDebug)] +pub struct SI534X { + i2c: I2C, + slave_addr: u8, + page: Option, + addr: Option, +} + +impl SI534X { + /// Create a new [`SI534X`] instance given a base address and the slave + /// address of the SI534X chip. + /// + /// # Safety + /// + /// The `base_addr` pointer MUST BE a valid pointer that is backed + /// by either a memory mapped UART instance or at valid read-writable memory + /// (which will likely cause incorrect behaviour, but not break memory safety) + pub unsafe fn new(base_addr: *mut u8, slave_addr: u8) -> SI534X { + let mut si = SI534X { + i2c: I2C::new(base_addr), + slave_addr, + page: None, + addr: None, + }; + si.i2c.init(); + si + } + + pub fn read_byte(&mut self, page: u8, addr: u8) -> Result { + self.set_page(page)?; + + self.i2c.claim_bus_with_retry()?; + self.i2c.write_byte(self.slave_addr << 1)?; + self.i2c.write_byte(addr)?; + self.addr = Some(addr); + self.i2c.release_bus(); + + self.i2c.claim_bus_with_retry()?; + self.i2c.write_byte((self.slave_addr << 1) | 1)?; + let data = self.i2c.read_byte()?; + self.i2c.release_bus(); + + Ok(data) + } + + pub fn write_byte(&mut self, page: u8, addr: u8, data: u8) -> Result<(), I2CError> { + self.set_page(page)?; + + self.i2c.claim_bus_with_retry()?; + self.i2c.write_byte(self.slave_addr << 1)?; + self.i2c.write_byte(addr)?; + self.addr = Some(addr); + self.i2c.write_byte(data)?; + self.i2c.release_bus(); + + Ok(()) + } + + pub fn set_page(&mut self, page: u8) -> Result<(), I2CError> { + if self.page != Some(page) { + self.i2c.claim_bus_with_retry()?; + self.i2c.write_byte(self.slave_addr << 1)?; + self.i2c.write_byte(0x01)?; + self.i2c.write_byte(page)?; + self.page = Some(page); + self.i2c.release_bus(); + } + Ok(()) + } + + /// Clear the internal page and address to force setting the page again. + pub fn clear_state(&mut self) { + self.page = None; + self.addr = None; + } + + pub fn finc(&mut self) -> Result<(), I2CError> { + self.write_byte(0, 0x1D, 0b01) + } + + pub fn fdec(&mut self) -> Result<(), I2CError> { + self.write_byte(0, 0x1D, 0b10) + } + + pub fn get_clock_divider(&mut self) -> u16 { + self.i2c.get_clock_divider() + } + + pub fn set_clock_divider(&mut self, clk_div: u16) { + self.i2c.set_clock_divider(clk_div) + } +}