diff --git a/clash-cores/clash-cores.cabal b/clash-cores/clash-cores.cabal index 3e89b4c38e..e330cc3dfe 100644 --- a/clash-cores/clash-cores.cabal +++ b/clash-cores/clash-cores.cabal @@ -117,12 +117,21 @@ common basic-config QuickCheck, string-interpolate ^>= 0.3, template-haskell, + transformers, library import: basic-config hs-source-dirs: src exposed-modules: + Clash.Cores.Experimental.I2C + Clash.Cores.Experimental.I2C.BitMaster + Clash.Cores.Experimental.I2C.BitMaster.BusCtrl + Clash.Cores.Experimental.I2C.BitMaster.StateMachine + Clash.Cores.Experimental.I2C.ByteMaster + Clash.Cores.Experimental.I2C.ByteMaster.ShiftRegister + Clash.Cores.Experimental.I2C.Types + Clash.Cores.LatticeSemi.ECP5.Blackboxes.IO Clash.Cores.LatticeSemi.ECP5.IO Clash.Cores.LatticeSemi.ICE40.Blackboxes.IO @@ -188,6 +197,9 @@ test-suite unittests buildable: False other-Modules: + Test.Cores.Experimental.I2C + Test.Cores.Experimental.I2C.Config + Test.Cores.Experimental.I2C.Slave Test.Cores.Internal.SampleSPI Test.Cores.Internal.Signals Test.Cores.SPI diff --git a/clash-cores/src/Clash/Cores/Experimental/I2C.hs b/clash-cores/src/Clash/Cores/Experimental/I2C.hs new file mode 100644 index 0000000000..e31c154979 --- /dev/null +++ b/clash-cores/src/Clash/Cores/Experimental/I2C.hs @@ -0,0 +1,87 @@ +{-| + Copyright : (C) 2014, University of Twente + 2024, Google LLC + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. + + I2C core +-} + +{-# LANGUAGE CPP #-} + +module Clash.Cores.Experimental.I2C + ( i2c + , Clash.Cores.Experimental.I2C.ByteMaster.I2COperation(..) + ) where + +import Clash.Prelude hiding (read) + +import Clash.Cores.Experimental.I2C.BitMaster +import Clash.Cores.Experimental.I2C.ByteMaster + +-- | Core for I2C communication. Returns the output enable signals for SCL en SDA +-- These signals assume that when they are `high`, they pull down SCL and SDA respectively. +-- For 2-wire I2C, you can use BiSignals (`Clash.Signal.Bidirectional.BiSignalIn` and `Clash.Signal.Bidirectional.BiSignalOut`) +-- +-- === __Example__ +-- +-- @ +-- i2cComp clk rst ena sclIn sdaIn = (sclOut, sdaOut) +-- where +-- sclOut = writeToBiSignal sclIn (mux sclOe (pure $ Just 0) (pure Nothing)) +-- sdaOut = writeToBiSignal sdaIn (mux sdaOe (pure $ Just 0) (pure Nothing)) +-- (sclOe, sdaOe) = unbundle i2cO +-- i2cIn = bundle (readFromBiSignal sclIn, readFromBiSignal sdaIn) +-- (dout,i2cOpAck,busy,al,ackWrite,i2cOut) = i2c clk arst rst ena clkCnt claimBus i2cOp ackRead i2cI +-- @ + +i2c :: + forall dom . + KnownDomain dom => + -- | Input Clock + "clk" ::: Clock dom -> + -- | Low level reset + "arst" ::: Reset dom -> + -- | Statemachine reset + "rst" ::: Signal dom Bool -> + -- | BitMaster enable + "ena" ::: Signal dom Bool -> + -- | Clock divider + "clkCnt" ::: Signal dom (Unsigned 16) -> + -- | Claim bus signal + "claimBus" ::: Signal dom Bool -> + -- | I2C operation + "i2cOp" ::: Signal dom (Maybe I2COperation) -> + -- | Acknowledge signal to be transmitted from master to slave on read operations + -- True means SDA is low. + "ackRead" ::: Signal dom Bool -> + -- | I2C input signals (SCL, SDA) + "i2c" ::: Signal dom ("scl" ::: Bit, "sda" ::: Bit) -> + -- | + -- 1. Received data + -- 2. Command acknowledgement + -- 3. I2C bus busy + -- 4. Arbitration lost + -- 5. Received acknowledge signal from slave to master on write operations. + -- True means SDA is low. + -- 6. Outgoing I2C signals + -- 6.1 SCL Tri-state signals, Nothing means pulled high. + -- 6.2 SDA Tri-state signals, Nothing means pulled high. + "" ::: + ( "i2cO" ::: Signal dom (BitVector 8) + , "i2cOpAck" ::: Signal dom Bool + , "busy" ::: Signal dom Bool + , "al" ::: Signal dom Bool + , "ackWrite" ::: Signal dom Bool + , "i2cO" ::: Signal dom ("sclOut" ::: Maybe Bit, "sclOut" ::: Maybe Bit)) +i2c clk arst rst ena clkCnt claimBus i2cOp ackRead i2cI = + (dout,i2cOpAck,busy,al,ackWrite,i2cO) + + where + (i2cOpAck,ackWrite,dout,bitCtrl) + = byteMaster clk arst enableGen (rst,claimBus,i2cOp,ackRead,bitResp) + (bitResp,busy,i2cO) + = bitMaster clk arst enableGen (rst,ena,clkCnt,bitCtrl,i2cI) + (_cmdAck,al,_dout) = unbundle bitResp +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE i2c #-} diff --git a/clash-cores/src/Clash/Cores/Experimental/I2C/BitMaster.hs b/clash-cores/src/Clash/Cores/Experimental/I2C/BitMaster.hs new file mode 100644 index 0000000000..5f0db15e81 --- /dev/null +++ b/clash-cores/src/Clash/Cores/Experimental/I2C/BitMaster.hs @@ -0,0 +1,134 @@ +{-| + Copyright : (C) 2014, University of Twente + 2024, Google LLC + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. +-} + +{-# LANGUAGE CPP #-} +{-# LANGUAGE RecordWildCards #-} +module Clash.Cores.Experimental.I2C.BitMaster + ( bitMaster + , BitMasterI + , BitMasterO + ) where + +import Clash.Prelude + +import Control.Lens +import Control.Monad +import Control.Monad.Trans.State +import Data.Tuple + +import Clash.Cores.Experimental.I2C.BitMaster.BusCtrl +import Clash.Cores.Experimental.I2C.BitMaster.StateMachine +import Clash.Cores.Experimental.I2C.Types + +-- | Internal state of the I2C BitMaster. +data BitMasterS + = BitS + { _busState :: BusStatusCtrl -- ^ Manage overall status of the I2C bus. + , _stateMachine :: StateMachine -- ^ Handles the bit-level I2C operations + , _dout :: Bit -- ^ Data to be sent out on the I2C bus + , _dsclOen :: Bool -- ^ Delayed version of the SCL output enable signal + , _clkEn :: Bool -- ^ Enable the clock for the state machine + , _slaveWait :: Bool -- ^ Whether the slave is pulling the SCL line low, causing the master to wait + , _cnt :: Unsigned 16 -- ^ Counter used for clock division + } + deriving (Generic, NFDataX) + +makeLenses ''BitMasterS + + +-- | 5-tuple containing the input interface for the BitMaster. +-- +-- 1. Resets the internal state when asserted +-- 2. Enables or disables the BitMaster +-- 3. Used for clock division +-- 4. Carries command and data in signals +-- 5. Contains the SCL and SDA input signals +type BitMasterI = (Bool,Bool,Unsigned 16,BitCtrlSig,I2CIn) + +-- | 3-tuple containing the output interface for the BitMaster. +-- +-- 1. Carries command acknowledgment and other flags +-- 2. Indicates if the BitMaster is currently busy +-- 3. Contains the SCL and SDA output signals +type BitMasterO = (BitRespSig,Bool,I2COut) + +-- | Bit level I2C controller that contains a statemachine to properly: +-- +-- * Monitor the bus for activity and arbitration. +-- * Read singular bits from the bus. +-- * Write singular bits to the bus. +-- * Return bits read from the bus. +bitMaster + :: KnownDomain dom + => Clock dom + -> Reset dom + -> Enable dom + -> Unbundled dom BitMasterI + -> Unbundled dom BitMasterO +bitMaster = exposeClockResetEnable (mealyB bitMasterT bitMasterInit) +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE bitMaster #-} + +bitMasterInit :: BitMasterS +bitMasterInit = BitS { _stateMachine = stateMachineStart + , _busState = busStartState + , _dout = high + , _dsclOen = False + , _clkEn = True + , _slaveWait = False + , _cnt = 0 + } + + +bitMasterT :: BitMasterS -> BitMasterI -> (BitMasterS, BitMasterO) +bitMasterT s@(BitS { _stateMachine = StateMachine {..} + , _busState = BusStatusCtrl {..} + , .. + }) + (rst,ena,clkCnt,(cmd,din),i2cI@(_sclI,_sdaI)) = + swap $ flip runState s $ do + -- Whenever the slave is not ready it can delay the cycle by pulling SCL low + -- delay scloEn + dsclOen .= _sclOen + + -- slaveWait is asserted when the master wants to drive SCL high, but the slave pulls it low + -- slaveWait remains asserted until the slave releases SCL + let masterSclHigh = _sclOen && not _dsclOen + (sSCL,sSDA) = _sI2C + slaveWait .= ((masterSclHigh || _slaveWait) && sSCL == 0) + + -- master drives SCL high, but another master pulls it low + -- master start counting down it low cycle now (clock synchronization) + let dSCL = fst _dI2C + sclSync = dSCL == high && sSCL == low && _sclOen + + -- generate clk enable signal + if rst || _cnt == 0 || not ena || sclSync then do + cnt .= clkCnt + clkEn .= True + else if _slaveWait then do + clkEn .= False + else do + cnt -= 1 + clkEn .= False + + -- bus status controller + zoom busState (busStatusCtrl rst ena clkCnt cmd _clkEn i2cI _bitStateM _sdaChk _sdaOen) + + -- generate dout signal, store dout on rising edge of SCL + when (sSCL == high && dSCL == low) $ + dout .= sSDA + + -- state machine + zoom stateMachine (bitStateMachine rst _al _clkEn cmd din) + + -- assign outputs + let + i2cO = (if _sclOen then Nothing else Just 0, if _sdaOen then Nothing else Just 0) + outp = ((_cmdAck,_al,_dout),_busy,i2cO) + + return outp diff --git a/clash-cores/src/Clash/Cores/Experimental/I2C/BitMaster/BusCtrl.hs b/clash-cores/src/Clash/Cores/Experimental/I2C/BitMaster/BusCtrl.hs new file mode 100644 index 0000000000..6689ffb4e8 --- /dev/null +++ b/clash-cores/src/Clash/Cores/Experimental/I2C/BitMaster/BusCtrl.hs @@ -0,0 +1,146 @@ +{-| + Copyright : (C) 2014, University of Twente + 2024, Google LLC + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. +-} + +{-# LANGUAGE CPP #-} +{-# LANGUAGE RecordWildCards #-} +module Clash.Cores.Experimental.I2C.BitMaster.BusCtrl + ( busStatusCtrl + , BusStatusCtrl(..) + , busStartState + ) where + +import Clash.Prelude +import Control.Lens +import Control.Monad +import Control.Monad.State + +import Clash.Cores.Experimental.I2C.BitMaster.StateMachine +import Clash.Cores.Experimental.I2C.Types + +-- | Bus status control state. +data BusStatusCtrl + = BusStatusCtrl + { _sI2C :: I2CIn -- ^ Synchronized SCL and SDA + , _dI2C :: I2CIn -- ^ Delayed sI2C + , _al :: Bool -- ^ Internal arbitration lost signal + , _cI2C :: Vec 2 I2CIn -- ^ Capture SCL and SDA + , _fI2C :: Vec 3 I2CIn -- ^ Filter input for SCL and SDA + , _filterCnt :: Unsigned 14 -- ^ Clock divider for filter + , _startCondition :: Bool -- ^ Start detected + , _stopCondition :: Bool -- ^ Stop detected + , _busy :: Bool -- ^ Internal busy signal + , _cmdStop :: Bool -- ^ Stop command + } deriving (Generic, NFDataX) + +makeLenses ''BusStatusCtrl + +{-# INLINE busStartState #-} +busStartState :: BusStatusCtrl +busStartState + = BusStatusCtrl + { _sI2C = (high,high) + , _dI2C = (high,high) + , _al = False + , _cI2C = repeat (high,high) + , _fI2C = repeat (high,high) + , _filterCnt = 0 + , _startCondition = False + , _stopCondition = False + , _busy = False + , _cmdStop = False + } + +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE busStatusCtrl #-} +-- | Low level bus status controller that monitors the state of the bus and performs +-- glitch filtering. It detects start conditions, stop conditions and arbitration loss. +busStatusCtrl + :: Bool + -- ^ Reset + -> Bool + -- ^ Enable + -> Unsigned 16 + -- ^ Clock counter used for clock division + -> I2CCommand + -- ^ I2C command + -> Bool + -- ^ Clock enable + -> I2CIn + -- ^ SCL and SDA + -> BitStateMachine + -- ^ Current state of the bit-level state machine + -> Bool + -- ^ Checks SDA status + -> Bool + -- ^ Inverted SDA output enable, False pulls the sda low. + -> State BusStatusCtrl () + -- ^ Bus status control state +busStatusCtrl rst ena clkCnt cmd clkEn i2cI bitStateM0 sdaChk0 sdaOen0 = do + BusStatusCtrl {..} <- get + + -- capture SCL and SDA + if rst then do + cI2C .= repeat (low,low) + else do + cI2C .= (_cI2C <<+ i2cI) + + -- filter SCL and SDA; (attempt to remove glitches) + filterCnt .= if rst || not ena then + 0 + else if _filterCnt == 0 then + resize (shiftR clkCnt 2) + else + _filterCnt - 1 + + if rst then do + fI2C .= repeat (high,high) + else when (_filterCnt == 0) $ do + fI2C .= (_fI2C <<+ head _cI2C) + + -- filtered SCL and SDA signal + if rst then do + sI2C .= (high,high) + else do + sI2C._1 .= filterT (map fst _fI2C) + sI2C._2 .= filterT (map snd _fI2C) + + dI2C .= _sI2C + + let (sSCL,sSDA) = _sI2C + dSDA = snd _dI2C + + -- detect start condition => detect falling edge on SDA while SCL is high + -- detect stop condition => detect rising edge on SDA wile SCL is high + if rst then do + startCondition .= False + stopCondition .= False + else do + startCondition .= ((sSDA == low && dSDA == high) && (sSCL == high)) + stopCondition .= ((sSDA == high && dSDA == low ) && (sSCL == high)) + + -- i2c busy signal + busy .= if rst then False else (_startCondition || _busy) && (not _stopCondition) + + -- generate arbitration lost signal + -- arbitration lost when: + -- 1) master drives SDA high, but the i2c bus is low + -- 2) stop detected while not requested (detect during 'idle' state) + let masterHighBusLow = sdaChk0 && sSDA == low && sdaOen0 + if rst then do + cmdStop .= False + al .= False + else do + when clkEn $ + cmdStop .= (cmd == I2Cstop) + if bitStateM0 == Idle then + al .= (masterHighBusLow || (_stopCondition && (not _cmdStop))) + else + al .= masterHighBusLow + where + filterT f = (f !! (2 :: Integer) .&. f !! (1 :: Integer)) .|. + (f !! (2 :: Integer) .&. f !! (0 :: Integer)) .|. + (f !! (1 :: Integer) .&. f !! (0 :: Integer)) diff --git a/examples/i2c/I2C/BitMaster/StateMachine.hs b/clash-cores/src/Clash/Cores/Experimental/I2C/BitMaster/StateMachine.hs similarity index 69% rename from examples/i2c/I2C/BitMaster/StateMachine.hs rename to clash-cores/src/Clash/Cores/Experimental/I2C/BitMaster/StateMachine.hs index 8ce41bda39..745535795c 100644 --- a/examples/i2c/I2C/BitMaster/StateMachine.hs +++ b/clash-cores/src/Clash/Cores/Experimental/I2C/BitMaster/StateMachine.hs @@ -1,45 +1,64 @@ +{-| + Copyright : (C) 2014, University of Twente + 2024, Google LLC + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. +-} + {-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} -module I2C.BitMaster.StateMachine where +module Clash.Cores.Experimental.I2C.BitMaster.StateMachine where -import Clash.Prelude +import Clash.Prelude hiding (Read) import Control.Lens hiding (Index) import Control.Monad import Control.Monad.State -import I2C.Types +import Clash.Cores.Experimental.I2C.Types +-- | States for bit-level I2C operations. data BitStateMachine - = Idle - | Start (Index 5) - | Stop (Index 4) - | Read (Index 4) - | Write (Index 4) + = Idle -- ^ Idle state + | Start (Index 5) -- ^ Start condition state + | Stop (Index 4) -- ^ Stop condition state + | Read (Index 4) -- ^ Read operation state + | Write (Index 4) -- ^ Write operation state deriving (Eq, Generic, NFDataX) +-- | Defines the state machine with control and status registers. data StateMachine = StateMachine - { _sclOen :: Bool -- i2c clock output enable register - , _sdaOen :: Bool -- i2c data output enable register - , _sdaChk :: Bool -- check SDA status (multi-master arbiter) - , _cmdAck :: Bool -- command completed - , _bitStateM :: BitStateMachine -- State Machine + { _sclOen :: Bool -- ^ Inverted SCL output enable, False pulls the scl low. + , _sdaOen :: Bool -- ^ Inverted SDA output enable, False pulls the sda low. + , _sdaChk :: Bool -- ^ Checks SDA status + , _cmdAck :: Bool -- ^ Acknowledges command completion + , _bitStateM :: BitStateMachine -- ^ Current state of the bit-level state machine } deriving (Generic, NFDataX) makeLenses ''StateMachine -{-# INLINE stateMachineStart #-} +-- | Initial state of the state machine. +stateMachineStart :: StateMachine stateMachineStart = StateMachine - { _sclOen = True - , _sdaOen = True - , _sdaChk = False - , _cmdAck = False - , _bitStateM = Idle + { _sclOen = True -- ^ SCL output enabled by default + , _sdaOen = True -- ^ SDA output enabled by default + , _sdaChk = False -- ^ SDA status check disabled by default + , _cmdAck = False -- ^ Command acknowledgment flag set to false + , _bitStateM = Idle -- ^ Initial state set to Idle } -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE bitStateMachine #-} +-- | Bit level I2C state machine that manages transitions between various states from +-- 'StateMachine' based on the input parameters and the current state. +-- +-- * In the 'Start' state, the function initiates the start condition on the I2C bus. +-- * In the 'Stop' state, it initiates the stop condition, releasing the bus. +-- * In the 'Read' state, it reads a bit from the slave device. +-- * In the 'Write' state, it writes a bit to the slave device. +-- +-- The function ensures that the state transitions are compliant with the I2C protocol. bitStateMachine :: Bool -> Bool -> Bool @@ -175,5 +194,5 @@ bitStateMachine rst al clkEn cmd din = do I2Cstop -> Stop 0 I2Cwrite -> Write 0 I2Cread -> Read 0 - otherwise -> Idle + _ -> Idle sdaChk .= False diff --git a/clash-cores/src/Clash/Cores/Experimental/I2C/ByteMaster.hs b/clash-cores/src/Clash/Cores/Experimental/I2C/ByteMaster.hs new file mode 100644 index 0000000000..3cc1c10add --- /dev/null +++ b/clash-cores/src/Clash/Cores/Experimental/I2C/ByteMaster.hs @@ -0,0 +1,184 @@ +{-| + Copyright : (C) 2014, University of Twente + 2024, Google LLC + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. +-} + +{-# LANGUAGE CPP #-} +{-# LANGUAGE RecordWildCards #-} +module Clash.Cores.Experimental.I2C.ByteMaster + ( byteMaster + , ByteMasterI + , ByteMasterO + , I2COperation(..) + ) where + +import Clash.Prelude + +import Control.Lens +import Control.Monad +import Control.Monad.Trans.State +import Data.Tuple + +import Clash.Cores.Experimental.I2C.ByteMaster.ShiftRegister +import Clash.Cores.Experimental.I2C.Types +import Data.Maybe (fromJust) + +data ByteStateMachine = Idle | Active | Start | Read | Write | Ack | Stop + deriving (Show, Generic, NFDataX, Eq) + +data I2COperation = ReadData | WriteData (BitVector 8) + deriving (Generic, NFDataX, BitPack) + +getWriteData :: I2COperation -> BitVector 8 +getWriteData ReadData = 0 +getWriteData (WriteData d) = d + +data ByteMasterS + = ByteS + { _srState :: ShiftRegister + , _byteStateM :: ByteStateMachine + , _coreCmd :: I2CCommand + , _coreTxd :: Bit + , _shiftsr :: Bool + , _ld :: Bool + } + deriving (Generic, NFDataX, Eq) + +makeLenses ''ByteMasterS + +-- | +-- 1. Statemachine reset +-- 2. Claim bus +-- 3. Bus operation +-- 4. Acknowledge signal to be transmitted from master to slave on read operations. +-- True means SDA is low. +-- 5. Bitmaster response +type ByteMasterI = (Bool,Bool,Maybe I2COperation,Bool,BitRespSig) + +-- | +-- 1. Acknowledge for `I2COperation` +-- 2. Received acknowledge signal from slave to master on write operations. True +-- means SDA is low. +-- 3. Data output +-- 4 Bitmaster control signals +type ByteMasterO = (Bool,Bool,BitVector 8,BitCtrlSig) + +-- | Byte level controller, takes care of correctly executing i2c communication +-- based on the supplied control signals. It should be instantiated alongside +-- 'Clash.Cores.Experimental.I2C.BitMaster.bitMaster'. The outgoing 'BitCtrlSig' controls the +-- 'Clash.Cores.Experimental.I2C.BitMaster.bitMaster. whose 'BitRespSig' should be supplied as last +-- input. +byteMaster + :: KnownDomain dom + => Clock dom + -> Reset dom + -> Enable dom + -> Unbundled dom ByteMasterI + -> Unbundled dom ByteMasterO +byteMaster = exposeClockResetEnable (mealyB byteMasterT byteMasterInit) +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE byteMaster #-} + +{-# INLINE byteMasterInit #-} +byteMasterInit :: ByteMasterS +byteMasterInit + = ByteS + { _srState = shiftStartState + , _byteStateM = Idle + , _coreCmd = I2Cnop + , _coreTxd = low + , _shiftsr = False + , _ld = False + } + +byteMasterT :: ByteMasterS -> ByteMasterI -> (ByteMasterS, ByteMasterO) +byteMasterT s@(ByteS {_srState = ShiftRegister {..}, ..}) + (rst,claimBus,maybeI2COp,ackRead,~(coreAck,al,coreRxd)) = swap $ flip runState s $ do + + -- assign dOut the output of the shift-register + let dout = _sr + + cntDone <- zoom srState (shiftRegister rst _ld _shiftsr (bv2v (getWriteData $ fromJust maybeI2COp )) coreRxd) + + -- state machine + coreTxd .= head dout + shiftsr .= False + ld .= False + + if rst || al then do + coreCmd .= I2Cnop + coreTxd .= low + byteStateM .= Idle + else case (_byteStateM, maybeI2COp) of + (Idle, _) -> when claimBus $ do + ld .= True + byteStateM .= Start + coreCmd .= I2Cstart + (Active, Just ReadData) -> do + ld .= True + byteStateM .= Read + coreCmd .= I2Cread + (Active, Just (WriteData _)) -> do + ld .= True + byteStateM .= Write + coreCmd .= I2Cwrite + (Active ,Nothing) -> + if claimBus then do + byteStateM .= Active + coreCmd .= I2Cnop + else do + byteStateM .= Stop + coreCmd .= I2Cstop + (Start, Nothing) -> when coreAck $ do + byteStateM .= Active + coreCmd .= I2Cnop + (Start, Just ReadData) -> when coreAck $ do + byteStateM .= Read + coreCmd .= I2Cread + (Start, Just (WriteData _)) -> when coreAck $ do + ld .= True + byteStateM .= Write + coreCmd .= I2Cwrite + (Write, _) -> when coreAck $ do + if cntDone then do + byteStateM .= Ack + coreCmd .= I2Cread + else do + coreCmd .= I2Cwrite + shiftsr .= True + + (Read, _) -> when coreAck $ do + shiftsr .= True + coreTxd .= bitCoerce (not ackRead) + if cntDone then do + byteStateM .= Ack + coreCmd .= I2Cwrite + else do + coreCmd .= I2Cread + + (Ack, _) -> + if coreAck then do + coreTxd .= high + -- check for stop; Should a STOP command be generated? + if claimBus then do + byteStateM .= Active + coreCmd .= I2Cnop + else do + byteStateM .= Stop + coreCmd .= I2Cstop + else + coreTxd .= bitCoerce (not ackRead) + + (Stop, _) -> when coreAck $ do + byteStateM .= Idle + coreCmd .= I2Cnop + + let + bitCtrl = (_coreCmd,_coreTxd) + i2cOpAck = (_byteStateM == Ack) && coreAck + ackWrite = i2cOpAck && not (bitCoerce coreRxd) + outp = (i2cOpAck,ackWrite,v2bv dout,bitCtrl) + + return outp diff --git a/examples/i2c/I2C/ByteMaster/ShiftRegister.hs b/clash-cores/src/Clash/Cores/Experimental/I2C/ByteMaster/ShiftRegister.hs similarity index 59% rename from examples/i2c/I2C/ByteMaster/ShiftRegister.hs rename to clash-cores/src/Clash/Cores/Experimental/I2C/ByteMaster/ShiftRegister.hs index 44c1655db6..659edf3074 100644 --- a/examples/i2c/I2C/ByteMaster/ShiftRegister.hs +++ b/clash-cores/src/Clash/Cores/Experimental/I2C/ByteMaster/ShiftRegister.hs @@ -1,5 +1,12 @@ +{-| + Copyright : (C) 2014, University of Twente + 2024, Google LLC + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. +-} + {-# LANGUAGE RecordWildCards #-} -module I2C.ByteMaster.ShiftRegister where +module Clash.Cores.Experimental.I2C.ByteMaster.ShiftRegister where import Clash.Prelude @@ -11,23 +18,25 @@ data ShiftRegister = ShiftRegister { _sr :: Vec 8 Bit , _dcnt :: Index 8 - } deriving (Generic, NFDataX) + } deriving (Generic, NFDataX, Eq) makeLenses ''ShiftRegister {-# INLINE shiftStartState #-} +shiftStartState :: ShiftRegister shiftStartState = ShiftRegister { _sr = repeat low , _dcnt = 0 } -shiftRegister :: Bool - -> Bool - -> Bool - -> Vec 8 Bit - -> Bit - -> State ShiftRegister Bool +shiftRegister :: + Bool -> + Bool -> + Bool -> + Vec 8 Bit -> + Bit -> + State ShiftRegister Bool shiftRegister rst ld shiftsr din coreRxd = do (ShiftRegister {..}) <- get diff --git a/clash-cores/src/Clash/Cores/Experimental/I2C/Types.hs b/clash-cores/src/Clash/Cores/Experimental/I2C/Types.hs new file mode 100644 index 0000000000..6bfb176b0c --- /dev/null +++ b/clash-cores/src/Clash/Cores/Experimental/I2C/Types.hs @@ -0,0 +1,27 @@ +{-| + Copyright : (C) 2014, University of Twente + 2024, Google LLC + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. +-} + +module Clash.Cores.Experimental.I2C.Types where + +import Clash.Prelude + +-- | I2C commands: start, stop, read, write, and no-op. +data I2CCommand = I2Cstart | I2Cstop | I2Cwrite | I2Cread | I2Cnop + deriving (Eq, Ord, Generic, NFDataX) + +-- | Bit-level I2C control signals (Command, Bit). +type BitCtrlSig = (I2CCommand, Bit) + +-- | Bit-level I2C response signals (Ack, Busy, Bit). +type BitRespSig = (Bool, Bool, Bit) + +-- | I2C input signals (SCL, SDA). +type I2CIn = (Bit, Bit) + +-- | I2C output Tri-state signals (SCL, SDA) +-- Since I2C is a protocol with pull ups, Nothing means pulled high. +type I2COut = (Maybe Bit, Maybe Bit) diff --git a/clash-cores/test/Test/Cores/Experimental/I2C.hs b/clash-cores/test/Test/Cores/Experimental/I2C.hs new file mode 100644 index 0000000000..3a4b256415 --- /dev/null +++ b/clash-cores/test/Test/Cores/Experimental/I2C.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE CPP #-} + +module Test.Cores.Experimental.I2C where + +import qualified Data.List as L + +import Clash.Explicit.Prelude +import Clash.Cores.Experimental.I2C + +import Data.Maybe +import Test.Cores.Experimental.I2C.Config +import Test.Cores.Experimental.I2C.Slave +import Test.Tasty +import Test.Tasty.HUnit + + +system0 :: Clock System -> Reset System -> Signal System (Vec 16 (Unsigned 8), Bool, Bool) +system0 clk arst = bundle (registerFile,i2cDone <$> confO,i2cFault <$> confO) + where + (_dout,hostAck,_busy,al,ackOut,i2cO) = + i2c clk arst rst (pure True) (pure 19) (i2cClaim <$> confO) (i2cOp <$> confO) (pure True) i2cI + + confO = config clk $ ConfI <$> rst <*> fmap not rst <*> hostAck <*> ackOut <*> al + + (sclOut,sdaOut) = unbundle i2cO + scl = fmap (bitCoerce . isNothing) sclOut + sda = fmap (bitCoerce . isNothing) sdaOut + i2cI = bundle (scl,sdaS) + + (sdaS,registerFile) = unbundle + (i2cSlave clk (bundle (scl, sda))) + + rst = liftA2 (<) rstCounter 500 + rstCounter = register clk arst enableGen (0 :: Unsigned 18) (rstCounter + 1) +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE system0 #-} + +{-# ANN system (defSyn "system") #-} +system :: Signal System (Vec 16 (Unsigned 8), Bool, Bool) +system = system0 systemClockGen resetGen + +systemResult :: (Vec 16 (Unsigned 8), Bool, Bool) +systemResult = L.last (sampleN 200050 system) + +i2cTest :: TestTree +i2cTest = + testCase "I2C" $ + assertBool "I2C core test procedure failed" (not fault) + where + fault = + any (\(_,_,f) -> f) (takeWhile (\ (_, done, _) -> not done) $ sample system) diff --git a/clash-cores/test/Test/Cores/Experimental/I2C/Config.hs b/clash-cores/test/Test/Cores/Experimental/I2C/Config.hs new file mode 100644 index 0000000000..0168f5dc0d --- /dev/null +++ b/clash-cores/test/Test/Cores/Experimental/I2C/Config.hs @@ -0,0 +1,172 @@ +{-# LANGUAGE CPP #-} + +module Test.Cores.Experimental.I2C.Config where + +import Clash.Prelude +import Clash.Explicit.SimIO +import Control.Monad (when) +import Numeric (showHex) + +import Clash.Cores.Experimental.I2C.ByteMaster (I2COperation(..)) + +data ConfStateMachine = CONFena | + CONFaddr | CONFaddrAck | + CONFreg | CONFregAck | + CONFdata | CONFdataAck | + CONFstop + deriving Show + +data ConfS = ConfS { i2cConfStateM :: ConfStateMachine + , i2cConfClaim :: Bool + , i2cConfOp :: Maybe I2COperation + , i2cConfLutIndex :: Index 16 + , i2cConfFault :: Bool + , i2cConfDebug :: Bool + } + +data ConfI = ConfI { i2cRst :: Bool + , i2cEna :: Bool + , i2cCmdAck :: Bool + , i2cRxAck :: Bool + , i2cAl :: Bool + } + +data ConfO = ConfO { i2cClaim :: Bool + , i2cOp :: Maybe I2COperation + , i2cDone :: Bool + , i2cFault :: Bool + } + +confInit :: ConfS +confInit = ConfS { i2cConfStateM = CONFena + , i2cConfClaim = False + , i2cConfOp = Nothing + , i2cConfLutIndex = 0 + , i2cConfFault = False + , i2cConfDebug = False + } + +configT + :: Reg ConfS + -> ConfI + -> SimIO ConfO +configT s0 ConfI{i2cRst=rst,i2cEna=ena,i2cCmdAck=cmdAck,i2cRxAck=rxAck,i2cAl=al} = do + s <- readReg s0 + let ConfS confStateM claim op lutIndex fault debug = s + + let i2cSlvAddr = 0x34 :: BitVector 8 + + let success = cmdAck && not al + done = lutIndex == 11 + + let lutData = configLut lutIndex + + sNext <- if rst then pure confInit else case confStateM of + CONFena + | ena && not done + -> pure s { i2cConfStateM = CONFaddr + , i2cConfClaim = True + } + | done + -> do when debug $ display "done" + pure s + + CONFaddr + -> do + when debug $ display $ "CONFaddr, writing: " <> showHex i2cSlvAddr "" + pure s { i2cConfStateM = CONFaddrAck + , i2cConfOp = Just (WriteData (unpack i2cSlvAddr)) + } + + CONFaddrAck + | success + -> if rxAck then do + when debug $ display "CONFaddrAck" + pure s { i2cConfStateM = CONFreg + , i2cConfOp = Nothing + } + else do + when debug $ display "Failure CONFaddr" + pure s { i2cConfStateM = CONFena + , i2cConfFault = True + } + + CONFreg + -> do + when debug $ display $ + "CONFreg, writing: " <> showHex (fst lutData) "" <> + ", lutIndex: " <> show lutIndex + pure s { i2cConfStateM = CONFregAck + , i2cConfOp = Just (WriteData (unpack (fst lutData))) + } + CONFregAck + | success + -> if rxAck then do + when debug $ display "Success CONFreg" + pure s { i2cConfStateM = CONFdata + , i2cConfOp = Nothing + } + else do + when debug $ display "Failure CONFreg" + pure s { i2cConfStateM = CONFena + , i2cConfFault = True + } + + CONFdata + -> do when debug $ display $ "CONFdata, writing: " <> showHex (snd lutData) "" + pure s { i2cConfStateM = CONFdataAck + , i2cConfOp = Just (WriteData (unpack (snd lutData))) + } + CONFdataAck + | success + -> if rxAck then do + when debug $ display "Success CONFdata" + pure s { i2cConfStateM = CONFstop + , i2cConfOp = Nothing + } + else do + when debug $ display "Failure CONFdata" + pure s { i2cConfStateM = CONFena + , i2cConfFault = True + } + + CONFstop + -> do + when debug $ display "Success CONFstop" + pure s { i2cConfStateM = CONFena + , i2cConfClaim = False + , i2cConfLutIndex = lutIndex + 1 + } + + _ -> pure s + + writeReg s0 sNext + pure $ ConfO claim op done fault + +configLut :: Index 16 -> (BitVector 8, BitVector 8) +configLut i + | i > 10 = + (0x1E, 0b00000000) + | otherwise = lut !! i + where + lut = (0x1E, 0b00000000) :> + (0x00, 0b00011111) :> + (0x02, 0b00011111) :> + (0x04, 0b11111001) :> + (0x06, 0b11111001) :> + (0x08, 0b00010010) :> + (0x0A, 0b00000110) :> + (0x0C, 0b00000000) :> + (0x0E, 0b01001010) :> + (0x10, 0b00000001) :> + (0x12, 0b00000001) :> + Nil + +{-# ANN config Synthesize { t_name = "configi2c", t_inputs = [], t_output = PortName "" } #-} +config + :: Clock System + -> Signal System ConfI + -> Signal System ConfO +config clk = mealyIO clk configT (reg confInit) +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE config #-} diff --git a/clash-cores/test/Test/Cores/Experimental/I2C/Slave.hs b/clash-cores/test/Test/Cores/Experimental/I2C/Slave.hs new file mode 100644 index 0000000000..af91aaec75 --- /dev/null +++ b/clash-cores/test/Test/Cores/Experimental/I2C/Slave.hs @@ -0,0 +1,134 @@ +{-# LANGUAGE CPP #-} + +module Test.Cores.Experimental.I2C.Slave where + +import Clash.Prelude +import Clash.Explicit.SimIO +import Control.Monad (when) + +data ACConfTestS = ACCTS { i2cSlaveRegFile :: Vec 16 (Unsigned 8) + , i2cSlaveAddr :: Vec 8 Bit + , i2cSlaveCntr :: Int + , i2cSlaveAtStateM :: AudioTestSM + , i2cSlavePrevSCL :: Bit + , i2cSlavePrevSDA :: Bit + , i2cSlaveSdaOut :: Bit + , i2cSlaveRegAddr :: Unsigned 8 + , i2cSlaveDebug :: Bool + } + +data AudioTestSM = ATidle | ATaddr | ATaddrAck | ATreg | ATregAck | ATval | ATvalAck | ATstop + deriving Show + +type ACConfTestI = (Bit,Bit) +type ACConfTestO = (Bit,Vec 16 (Unsigned 8)) + +i2cSlaveInit :: ACConfTestS +i2cSlaveInit = ACCTS { i2cSlaveRegFile = replicate d16 0x0 + , i2cSlaveAddr = replicate d8 0 + , i2cSlaveCntr = 0 + , i2cSlaveAtStateM = ATidle + , i2cSlavePrevSCL = high + , i2cSlavePrevSDA = high + , i2cSlaveSdaOut = high + , i2cSlaveRegAddr = 0 + , i2cSlaveDebug = False + } + +i2cSlaveT :: Reg ACConfTestS -> ACConfTestI -> SimIO ACConfTestO +i2cSlaveT s0 (scl,sda) = do + s <- readReg s0 + + let ACCTS regFile addr cntr atStateM prevSCL prevSDA sdaOut regAddr debug = s + + let startCondition = (prevSDA == high && sda == low) && scl == high + stopCondition = (prevSDA == low && sda == high) && scl == high + + sclRising = prevSCL == low && scl == high + validAddr = pack addr == 0x34 + validRegAddr = (pack addr >= 0 || pack addr <= 1) && lsb addr == low + + stateMachine <- case atStateM of + ATidle + | startCondition -> do when debug $ display "start" + pure s {i2cSlaveAtStateM = ATaddr} + ATaddr + | cntr == 8 -> if validAddr then do + when debug $ display "valid addr" + pure s { i2cSlaveAtStateM = ATaddrAck + , i2cSlaveAddr = repeat low + , i2cSlaveCntr = 0 + } + else do + when debug $ display $ "invalid addr: " <> show addr + pure s { i2cSlaveAtStateM = ATidle + , i2cSlaveAddr = repeat low + , i2cSlaveCntr = 0 + } + | sclRising -> pure s { i2cSlaveAddr = addr <<+ sda + , i2cSlaveCntr = cntr + 1 + , i2cSlaveSdaOut = high + } + ATaddrAck + | sclRising -> do when debug $ display "addrAck" + pure s { i2cSlaveAtStateM = ATreg + , i2cSlaveSdaOut = low + } + ATreg + | cntr == 8 -> if validRegAddr then do + when debug $ display "valid reg addr" + pure s { i2cSlaveAtStateM = ATregAck + , i2cSlaveAddr = repeat low + , i2cSlaveCntr = 0 + , i2cSlaveRegAddr = shiftR (bitCoerce addr) 1 + } + else do + when debug $ display $ "invalid reg addr: " <> show addr + pure s { i2cSlaveAtStateM = ATidle + , i2cSlaveAddr = repeat low + , i2cSlaveCntr = 0 + } + | sclRising -> pure s { i2cSlaveAddr = addr <<+ sda + , i2cSlaveCntr = cntr + 1 + , i2cSlaveSdaOut = high + } + ATregAck + | sclRising -> do when debug $ display "regAck" + pure s { i2cSlaveAtStateM = ATval + , i2cSlaveSdaOut = low + } + ATval + | cntr == 8 -> do when debug $ display "val" + pure s { i2cSlaveAtStateM = ATvalAck + , i2cSlaveAddr = repeat low + , i2cSlaveCntr = 0 + , i2cSlaveRegFile = + replace regAddr (bitCoerce addr) regFile + } + | sclRising -> pure s { i2cSlaveAddr = addr <<+ sda + , i2cSlaveCntr = cntr + 1 + , i2cSlaveSdaOut = high + } + ATvalAck + | sclRising -> do when debug $ display "valAck" + pure s { i2cSlaveAtStateM = ATstop + , i2cSlaveSdaOut = low + } + ATstop + | stopCondition -> do when debug $ display "stop" + pure s { i2cSlaveAtStateM = ATidle + , i2cSlaveSdaOut = high + } + _ -> pure s + + writeReg s0 (stateMachine {i2cSlavePrevSDA = sda, i2cSlavePrevSCL = scl}) + pure (sdaOut, regFile) + +{-# ANN i2cSlave Synthesize { t_name = "slave", t_inputs = [], t_output = PortName "" } #-} +i2cSlave + :: Clock System + -> Signal System ACConfTestI + -> Signal System ACConfTestO +i2cSlave clk = mealyIO clk i2cSlaveT (reg i2cSlaveInit) +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE i2cSlave #-} diff --git a/clash-cores/test/unittests.hs b/clash-cores/test/unittests.hs index b481b5e1ce..06c174b3b0 100644 --- a/clash-cores/test/unittests.hs +++ b/clash-cores/test/unittests.hs @@ -10,6 +10,7 @@ module Main where import Prelude import Test.Tasty +import qualified Test.Cores.Experimental.I2C import qualified Test.Cores.SPI import qualified Test.Cores.SPI.MultiSlave import qualified Test.Cores.UART @@ -19,7 +20,8 @@ import qualified Test.Cores.Xilinx.DnaPortE2 tests :: TestTree tests = testGroup "Unittests" - [ Test.Cores.SPI.tests + [ Test.Cores.Experimental.I2C.i2cTest + , Test.Cores.SPI.tests , Test.Cores.SPI.MultiSlave.tests , Test.Cores.UART.tests , Test.Cores.Xilinx.BlockRam.tests diff --git a/examples/i2c/I2C.hs b/examples/i2c/I2C.hs deleted file mode 100644 index 1adbe22df1..0000000000 --- a/examples/i2c/I2C.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-# LANGUAGE CPP #-} - -module I2C where - -import Clash.Prelude - -import I2C.BitMaster -import I2C.ByteMaster -import I2C.Types - -{-# ANN i2c - (Synthesize - { t_name = "i2c" - , t_inputs = [ PortName "clk" - , PortName "arst" - , PortName "rst" - , PortName "ena" - , PortName "clkCnt" - , PortName "start" - , PortName "stop" - , PortName "read" - , PortName "write" - , PortName "ackIn" - , PortName "din" - , PortName "i2cI"] - , t_output = PortProduct "" - [ PortName "dout" - , PortName "hostAck" - , PortName "busy" - , PortName "al" - , PortName "ackOut" - , PortProduct "" [PortName "i2cO_clk"] - ] - }) #-} -i2c clk arst rst ena clkCnt start stop read write ackIn din i2cI = (dout,hostAck,busy,al,ackOut,i2cO) - where - (hostAck,ackOut,dout,bitCtrl) = byteMaster clk arst enableGen (rst,start,stop,read,write,ackIn,din,bitResp) - (bitResp,busy,i2cO) = bitMaster clk arst enableGen (rst,ena,clkCnt,bitCtrl,i2cI) - (cmdAck,al,dbout) = unbundle bitResp --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE i2c #-} diff --git a/examples/i2c/I2C/BitMaster.hs b/examples/i2c/I2C/BitMaster.hs deleted file mode 100644 index aa81b97136..0000000000 --- a/examples/i2c/I2C/BitMaster.hs +++ /dev/null @@ -1,124 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE RecordWildCards #-} -module I2C.BitMaster (bitMaster) where - -import Clash.Prelude - -import Control.Lens -import Control.Monad -import Control.Monad.Trans.State -import Data.Tuple - -import I2C.BitMaster.BusCtrl -import I2C.BitMaster.StateMachine -import I2C.Types - -data BitMasterS - = BitS - { _busState :: BusStatusCtrl - , _stateMachine :: StateMachine - , _dout :: Bit -- dout register - , _dsclOen :: Bool -- delayed sclOen signal - , _clkEn :: Bool -- statemachine clock enable - , _slaveWait :: Bool -- clock generation signal - , _cnt :: Unsigned 16 -- clock divider counter (synthesis) - } - deriving (Generic, NFDataX) - -makeLenses ''BitMasterS - -type BitMasterI = (Bool,Bool,Unsigned 16,BitCtrlSig,I2CIn) -type BitMasterO = (BitRespSig,Bool,I2COut) - -{-# ANN bitMaster - (Synthesize - { t_name = "bitmaster" - , t_inputs = [ PortName "clk" - , PortName "arst" - , PortName "gen" - , PortProduct "" - [ PortName "rst" - , PortName "ena" - , PortName "clkCnt" - , PortProduct "" - [ PortName "cmd" - , PortName "din" ] - , PortName "i2cI" ] - ] - , t_output = PortProduct "" - [ PortProduct "" - [ PortName "cmdAck" - , PortName "al" - , PortName "dout" ] - , PortName "busy" - , PortName "i2cO" - ] - }) #-} -bitMaster - :: Clock System - -> Reset System - -> Enable System - -> Unbundled System BitMasterI - -> Unbundled System BitMasterO -bitMaster = exposeClockResetEnable (mealyB bitMasterT bitMasterInit) --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE bitMaster #-} - -bitMasterInit = BitS { _stateMachine = stateMachineStart - , _busState = busStartState - , _dout = high -- dout register - , _dsclOen = False -- delayed sclOen signal - , _clkEn = True -- statemachine clock enable - , _slaveWait = False -- clock generation signal - , _cnt = 0 -- clock divider counter (synthesis) - } - - -bitMasterT :: BitMasterS -> BitMasterI -> (BitMasterS, BitMasterO) -bitMasterT s@(BitS { _stateMachine = StateMachine {..} - , _busState = BusStatusCtrl {..} - , .. - }) - (rst,ena,clkCnt,(cmd,din),i2cI@(sclI,sdaI)) = swap $ flip runState s $ do - -- Whenever the slave is not ready it can delay the cycle by pulling SCL low - -- delay scloEn - dsclOen .= _sclOen - - -- slaveWait is asserted when the master wants to drive SCL high, but the slave pulls it low - -- slaveWait remains asserted until the slave releases SCL - let masterSclHigh = _sclOen && not _dsclOen - (sSCL,sSDA) = _sI2C - slaveWait .= ((masterSclHigh || _slaveWait) && sSCL == 0) - - -- master drives SCL high, but another master pulls it low - -- master start counting down it low cycle now (clock synchronization) - let dSCL = fst _dI2C - sclSync = dSCL == high && sSCL == low && _sclOen - - -- generate clk enable signal - if rst || _cnt == 0 || not ena || sclSync then do - cnt .= clkCnt - clkEn .= True - else if _slaveWait then do - clkEn .= False - else do - cnt -= 1 - clkEn .= False - - -- bus status controller - zoom busState (busStatusCtrl rst ena clkCnt cmd _clkEn i2cI _bitStateM _sdaChk _sdaOen) - - -- generate dout signal, store dout on rising edge of SCL - when (sSCL == high && dSCL == low) $ - dout .= sSDA - - -- state machine - zoom stateMachine (bitStateMachine rst _al _clkEn cmd din) - - -- assign outputs - let sclO = low - sdaO = low - i2cO = (sclO,_sclOen,sdaO,_sdaOen) - outp = ((_cmdAck,_al,_dout),_busy,i2cO) - - return outp diff --git a/examples/i2c/I2C/BitMaster/BusCtrl.hs b/examples/i2c/I2C/BitMaster/BusCtrl.hs deleted file mode 100644 index 0e33cb1e46..0000000000 --- a/examples/i2c/I2C/BitMaster/BusCtrl.hs +++ /dev/null @@ -1,120 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE RecordWildCards #-} -module I2C.BitMaster.BusCtrl where - -import Clash.Prelude -import Control.Lens -import Control.Monad -import Control.Monad.State - -import I2C.BitMaster.StateMachine -import I2C.Types - -data BusStatusCtrl - = BusStatusCtrl - { _sI2C :: I2CIn -- synchronized SCL and SDA - , _dI2C :: I2CIn -- delayed sI2C - , _al :: Bool -- internal arbitration lost signal - , _cI2C :: Vec 2 I2CIn -- capture SCL and SDA - , _fI2C :: Vec 3 I2CIn -- filter input for SCL and SDA - , _filterCnt :: Unsigned 14 -- clock divider for filter - , _startCondition :: Bool -- start detected - , _stopCondition :: Bool -- stop detected - , _busy :: Bool -- internal busy signal - , _cmdStop :: Bool -- STOP command - } deriving (Generic, NFDataX) - -makeLenses ''BusStatusCtrl - -{-# INLINE busStartState #-} -busStartState - = BusStatusCtrl - { _sI2C = (high,high) -- synchronized SCL and SDA input - , _dI2C = (high,high) -- delayed sI2C - , _al = False -- internal arbitration lost signal - , _cI2C = repeat (high,high) -- capture SCL and SDA - , _fI2C = repeat (high,high) -- filter input for SCL and SDA - , _filterCnt = 0 -- clock divider for filter - , _startCondition = False -- start detected - , _stopCondition = False -- stop detected - , _busy = False -- internal busy signal - , _cmdStop = False -- STOP command - } - --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE busStatusCtrl #-} -busStatusCtrl :: Bool - -> Bool - -> Unsigned 16 - -> I2CCommand - -> Bool - -> I2CIn - -> BitStateMachine - -> Bool - -> Bool - -> State BusStatusCtrl () -busStatusCtrl rst ena clkCnt cmd clkEn i2cI bitStateM sdaChk sdaOen = do - BusStatusCtrl {..} <- get - - -- capture SCL and SDA - if rst then do - cI2C .= repeat (low,low) - else do - cI2C .= (_cI2C <<+ i2cI) - - -- filter SCL and SDA; (attempt to remove glitches) - filterCnt .= if rst || not ena then - 0 - else if _filterCnt == 0 then - resize (shiftR clkCnt 2) - else - _filterCnt - 1 - - if rst then do - fI2C .= repeat (high,high) - else when (_filterCnt == 0) $ do - fI2C .= (_fI2C <<+ head _cI2C) - - -- filtered SCL and SDA signal - if rst then do - sI2C .= (high,high) - else do - sI2C._1 .= filterT (map fst _fI2C) - sI2C._2 .= filterT (map snd _fI2C) - - dI2C .= _sI2C - - let (sSCL,sSDA) = _sI2C - dSDA = snd _dI2C - - -- detect start condition => detect falling edge on SDA while SCL is high - -- detect stop condition => detect rising edge on SDA wile SCL is high - if rst then do - startCondition .= False - stopCondition .= False - else do - startCondition .= ((sSDA == low && dSDA == high) && (sSCL == high)) - stopCondition .= ((sSDA == high && dSDA == low ) && (sSCL == high)) - - -- i2c busy signal - busy .= if rst then False else (_startCondition || _busy) && (not _stopCondition) - - -- generate arbitration lost signal - -- arbitration lost when: - -- 1) master drives SDA high, but the i2c bus is low - -- 2) stop detected while not requested (detect during 'idle' state) - let masterHighBusLow = sdaChk && sSDA == low && sdaOen - if rst then do - cmdStop .= False - al .= False - else do - when clkEn $ - cmdStop .= (cmd == I2Cstop) - if bitStateM == Idle then - al .= (masterHighBusLow || (_stopCondition && (not _cmdStop))) - else - al .= masterHighBusLow - where - filterT f = (f!!2 .&. f!!1) .|. - (f!!2 .&. f!!0) .|. - (f!!1 .&. f!!0) diff --git a/examples/i2c/I2C/ByteMaster.hs b/examples/i2c/I2C/ByteMaster.hs deleted file mode 100644 index 1fb68ef4a1..0000000000 --- a/examples/i2c/I2C/ByteMaster.hs +++ /dev/null @@ -1,165 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE RecordWildCards #-} -module I2C.ByteMaster (byteMaster) where - -import Clash.Prelude - -import Control.Lens hiding (Index) -import Control.Monad -import Control.Monad.Trans.State -import Data.Tuple - -import I2C.ByteMaster.ShiftRegister -import I2C.Types - -data ByteStateMachine = Idle | Start | Read | Write | Ack | Stop - deriving (Show, Generic, NFDataX) - -data ByteMasterS - = ByteS - { _srState :: ShiftRegister - , _byteStateM :: ByteStateMachine -- State machine - , _coreCmd :: I2CCommand -- coreCmd register - , _coreTxd :: Bit -- coreTxd register - , _shiftsr :: Bool -- shift sr - , _ld :: Bool -- load values in to sr - , _hostAck :: Bool -- host cmd acknowlegde register - , _ackOut :: Bool -- slave ack register - } - deriving (Generic, NFDataX) - -makeLenses ''ByteMasterS - -type ByteMasterI = (Bool,Bool,Bool,Bool,Bool,Bool,BitVector 8,BitRespSig) -type ByteMasterO = (Bool,Bool,BitVector 8,BitCtrlSig) - -{-# ANN byteMaster - (Synthesize - { t_name = "bytemaster" - , t_inputs = [ PortName "clk" - , PortName "arst" - , PortName "gen" - , PortProduct "" - [ PortName "rst" - , PortName "start" - , PortName "stop" - , PortName "read" - , PortName "write" - , PortName "ackIn" - , PortName "din" - , PortName "bitResp" ] - ] - , t_output = PortProduct "" - [ PortName "hostAck" - , PortName "ackOut" - , PortName "dout" - , PortName "bitCtrl" - ] - }) #-} -byteMaster - :: Clock System - -> Reset System - -> Enable System - -> Unbundled System ByteMasterI - -> Unbundled System ByteMasterO -byteMaster = exposeClockResetEnable (mealyB byteMasterT byteMasterInit) --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE byteMaster #-} - -{-# INLINE byteMasterInit #-} -byteMasterInit :: ByteMasterS -byteMasterInit - = ByteS - { _srState = shiftStartState - , _byteStateM = Idle - , _coreCmd = I2Cnop - , _coreTxd = low - , _shiftsr = False - , _ld = False - , _hostAck = False - , _ackOut = True - } - -byteMasterT :: ByteMasterS -> ByteMasterI -> (ByteMasterS, ByteMasterO) -byteMasterT s@(ByteS {_srState = ShiftRegister {..}, ..}) - (rst,start,stop,read,write,ackIn,din,~(coreAck,al,coreRxd)) = swap $ flip runState s $ do - -- generate go-signal - let go = (read || write || stop) && (not _hostAck) - - -- assign dOut the output of the shift-register - dout = _sr - - cntDone <- zoom srState (shiftRegister rst _ld _shiftsr (bv2v din) coreRxd) - - -- state machine - coreTxd .= head dout - shiftsr .= False - ld .= False - hostAck .= False - - if rst || al then do - coreCmd .= I2Cnop - coreTxd .= low - byteStateM .= Idle - ackOut .= True - else case _byteStateM of - Idle -> when go $ do - ld .= True - if start then do - byteStateM .= Start - coreCmd .= I2Cstart - else if read then do - byteStateM .= Read - coreCmd .= I2Cread - else if write then do - byteStateM .= Write - coreCmd .= I2Cwrite - else do-- stop - byteStateM .= Stop - coreCmd .= I2Cstop - Start -> when coreAck $ do - ld .= True - if read then do - byteStateM .= Read - coreCmd .= I2Cread - else do - byteStateM .= Write - coreCmd .= I2Cwrite - Write -> when coreAck $ do - if cntDone then do - byteStateM .= Ack - coreCmd .= I2Cread - else do - coreCmd .= I2Cwrite - shiftsr .= True - Read -> when coreAck $ do - shiftsr .= True - coreTxd .= bitCoerce ackIn - if cntDone then do - byteStateM .= Ack - coreCmd .= I2Cwrite - else do - coreCmd .= I2Cread - Ack -> if coreAck then do - ackOut .= bitCoerce coreRxd - coreTxd .= high - -- check for stop; Should a STOP command be generated? - if stop then do - byteStateM .= Stop - coreCmd .= I2Cstop - else do - byteStateM .= Idle - coreCmd .= I2Cnop - -- generate command acknowledge signal - hostAck .= True - else - coreTxd .= bitCoerce ackIn - Stop -> when coreAck $ do - byteStateM .= Idle - coreCmd .= I2Cnop - hostAck .= True - - let bitCtrl = (_coreCmd,_coreTxd) - outp = (_hostAck,_ackOut,v2bv dout,bitCtrl) - - return outp diff --git a/examples/i2c/I2C/Types.hs b/examples/i2c/I2C/Types.hs deleted file mode 100644 index d28e725015..0000000000 --- a/examples/i2c/I2C/Types.hs +++ /dev/null @@ -1,12 +0,0 @@ -module I2C.Types where - -import Clash.Prelude - -data I2CCommand = I2Cstart | I2Cstop | I2Cwrite | I2Cread | I2Cnop - deriving (Eq, Ord, Generic, NFDataX) - -type BitCtrlSig = (I2CCommand,Bit) -type BitRespSig = (Bool,Bool,Bit) - -type I2CIn = (Bit,Bit) -type I2COut = (Bit,Bool,Bit,Bool) diff --git a/examples/i2c/I2Ctest.hs b/examples/i2c/I2Ctest.hs deleted file mode 100644 index cf8eafc804..0000000000 --- a/examples/i2c/I2Ctest.hs +++ /dev/null @@ -1,37 +0,0 @@ -{-# LANGUAGE CPP #-} - -module I2Ctest where - -import qualified Data.List as L - -import Clash.Explicit.Prelude -import I2C - -import I2Ctest.I2CSlave -import I2Ctest.I2CConfig - -system0 :: Clock System -> Reset System -> Signal System (Vec 16 (Unsigned 8), Bool, Bool) -system0 clk arst = bundle (regFile,done,fault) - where - (dout,hostAck,busy,al,ackOut,i2cO) = - i2c clk arst rst (pure True) (pure 19) start stop (pure False) write (pure True) din i2cI - - (start,stop,write,din,done,fault) = unbundle $ - config clk (bundle (rst, fmap not rst,hostAck,ackOut,al)) - - (_,sclOen,_,sdaOen) = unbundle i2cO - scl = fmap bitCoerce sclOen - i2cI = bundle (scl,sdaS) - - (sdaS,regFile) = unbundle - (i2cSlave clk (bundle (scl, bitCoerce <$> sdaOen))) - - rst = liftA2 (<) rstCounter 500 - rstCounter = register clk arst enableGen (0 :: Unsigned 18) (rstCounter + 1) --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE system0 #-} - -{-# ANN system Synthesize { t_name = "system", t_inputs = [], t_output = PortName "" } #-} -system = system0 systemClockGen resetGen - -systemResult = L.last (sampleN 200050 system) diff --git a/examples/i2c/I2Ctest/I2CConfig.hs b/examples/i2c/I2Ctest/I2CConfig.hs deleted file mode 100644 index 27d5835818..0000000000 --- a/examples/i2c/I2Ctest/I2CConfig.hs +++ /dev/null @@ -1,167 +0,0 @@ -{-# LANGUAGE CPP #-} - -module I2Ctest.I2CConfig where - -import Clash.Prelude -import Clash.Explicit.SimIO - -data ConfStateMachine = CONFena | - CONFaddr | CONFaddrAck | - CONFreg | CONFregAck | - CONFdata | CONFdataAck | - CONFstop - deriving Show - -data ConfS = ConfS { confStateM :: ConfStateMachine - , start :: Bool - , stop :: Bool - , write :: Bool - , din :: Vec 8 Bit - , lutIndex :: Index 16 - , fault :: Bool - } - -type ConfI = (Bool,Bool,Bool,Bool,Bool) -type ConfO = (Bool,Bool,Bool,BitVector 8,Bool,Bool) - -confInit :: ConfS -confInit = ConfS { confStateM = CONFena - , start = False - , stop = False - , write = False - , din = repeat low - , lutIndex = 0 - , fault = False - } - -configT - :: Reg ConfS - -> ConfI - -> SimIO ConfO -configT s0 (rst,ena,cmdAck,rxAck,al) = do - s <- readReg s0 - let ConfS confStateM start stop write din lutIndex fault = s - - let i2cSlvAddr = 0x34 :: BitVector 8 - - - let success = cmdAck && not al - done = lutIndex == 11 - - let lutData = configLut lutIndex - - sNext <- if rst then pure confInit else case confStateM of - CONFena - | ena && not done - -> pure s { confStateM = CONFaddr } - | done - -> do display "done" - finish 0 - - CONFaddr - -> pure s { confStateM = CONFaddrAck - , start = True - , write = True - , din = unpack i2cSlvAddr - } - - CONFaddrAck - | success - -> do display "CONFaddrAck" - pure s { confStateM = CONFreg - , start = False - , write = False - } - - CONFreg - -> if rxAck == False then do - display "Success CONFreg" - pure s { confStateM = CONFregAck - , write = True - , din = unpack (fst lutData) - , fault = False - } - else do - display "Failure CONFreg" - finish 1 - pure s { confStateM = CONFena - , fault = True - } - - CONFregAck - | success - -> do display "CONFregAck" - pure s { confStateM = CONFdata - , write = False - } - - CONFdata - -> if rxAck == False then do - display "Success CONFdata" - pure s { confStateM = CONFdataAck - , write = True - , stop = True - , din = unpack (snd lutData) - , fault = False - } - else do - display "Failure CONFdata" - finish 1 - pure s { confStateM = CONFena - , fault = True - } - - CONFdataAck - | success - -> do display "CONFdataAck" - pure s { confStateM = CONFstop - , stop = False - , write = False - } - - CONFstop - -> if rxAck == False then do - display "Success CONFstop" - pure s { confStateM = CONFena - , lutIndex = lutIndex + 1 - , fault = False - } - else do - display "Failure CONFdata" - finish 1 - pure s { confStateM = CONFena - , fault = True - } - - _ -> pure s - - writeReg s0 sNext - pure (start,stop,write,pack din,done,fault) - -configLut :: Index 16 -> (BitVector 8, BitVector 8) -configLut i - | i > 10 = - (0x1E, 0b00000000) - | otherwise = lut !! i - where - lut = (0x1E, 0b00000000) :> - (0x00, 0b00011111) :> - (0x02, 0b00011111) :> - (0x04, 0b11111001) :> - (0x06, 0b11111001) :> - (0x08, 0b00010010) :> - (0x0A, 0b00000110) :> - (0x0C, 0b00000000) :> - (0x0E, 0b01001010) :> - (0x10, 0b00000001) :> - (0x12, 0b00000001) :> - Nil - -{-# ANN config Synthesize { t_name = "configi2c", t_inputs = [], t_output = PortName "" } #-} -config - :: Clock System - -> Signal System ConfI - -> Signal System ConfO -config clk = mealyIO clk configT (reg confInit) --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE config #-} diff --git a/examples/i2c/I2Ctest/I2CSlave.hs b/examples/i2c/I2Ctest/I2CSlave.hs deleted file mode 100644 index 49d3a44162..0000000000 --- a/examples/i2c/I2Ctest/I2CSlave.hs +++ /dev/null @@ -1,115 +0,0 @@ -{-# LANGUAGE CPP #-} - -module I2Ctest.I2CSlave where - -import Clash.Prelude -import Clash.Explicit.SimIO - -data ACConfTestS = ACCTS { regFile :: Vec 16 (Unsigned 8) - , addr :: Vec 8 Bit - , cntr :: Int - , atStateM :: AudioTestSM - , prevSCL :: Bit - , prevSDA :: Bit - , sdaOut :: Bit - , regAddr :: Unsigned 8 - } - -data AudioTestSM = ATidle | ATaddr | ATaddrAck | ATreg | ATregAck | ATval | ATvalAck | ATstop - deriving Show - -type ACConfTestI = (Bit,Bit) -type ACConfTestO = (Bit,Vec 16 (Unsigned 8)) - -i2cSlaveInit :: ACConfTestS -i2cSlaveInit = ACCTS (replicate d16 0x0) (replicate d8 0) 0 ATidle high high high 0 - -i2cSlaveT :: Reg ACConfTestS -> ACConfTestI -> SimIO ACConfTestO -i2cSlaveT s0 (scl,sda) = do - s <- readReg s0 - - let ACCTS regFile addr cntr atStateM prevSCL prevSDA sdaOut regAddr = s - - let startCondition = (prevSDA == high && sda == low) && scl == high - stopCondition = (prevSDA == low && sda == high) && scl == high - - sclRising = prevSCL == low && scl == high - validAddr = pack addr == 0x34 - validRegAddr = (pack addr >= 0 || pack addr <= 1) && lsb addr == low - - stateMachine <- case atStateM of - ATidle - | startCondition -> do display "start" - pure s {atStateM = ATaddr} - ATaddr - | cntr == 8 -> if validAddr then do - display "valid addr" - pure s { atStateM = ATaddrAck - , addr = repeat low - , cntr = 0 } - else do - display "invalid addr" - pure s { atStateM = ATidle - , addr = repeat low - , cntr = 0} - | sclRising -> pure s { cntr = cntr + 1 - , addr = addr <<+ sda - , sdaOut = high } - ATaddrAck - | sclRising -> do display "addrAck" - pure s { atStateM = ATreg, sdaOut = low } - ATreg - | cntr == 8 -> if validRegAddr then do - display "valid reg addr" - pure s { atStateM = ATregAck - , addr = repeat low - , cntr = 0 - , regAddr = shiftR (bitCoerce addr) 1 - } - else do - display "invalid reg addr" - pure s { atStateM = ATidle - , addr = repeat low - , cntr = 0 - } - | sclRising -> pure s { cntr = cntr + 1 - , addr = addr <<+ sda - , sdaOut = high } - ATregAck - | sclRising -> do display "regAck" - pure s { sdaOut = low - , atStateM = ATval - } - ATval - | cntr == 8 -> do display "val" - pure s { atStateM = ATvalAck - , addr = repeat low - , cntr = 0 - , regFile = replace regAddr (bitCoerce addr) regFile - } - | sclRising -> pure s { cntr = cntr + 1 - , addr = addr <<+ sda - , sdaOut = high } - ATvalAck - | sclRising -> do display "valAck" - pure s { sdaOut = low - , atStateM = ATstop - } - ATstop - | stopCondition -> do display "stop" - pure s { atStateM = ATidle - , sdaOut = high - } - _ -> pure s - - writeReg s0 (stateMachine {prevSDA = sda, prevSCL = scl}) - pure (sdaOut, regFile) - -{-# ANN i2cSlave Synthesize { t_name = "slave", t_inputs = [], t_output = PortName "" } #-} -i2cSlave - :: Clock System - -> Signal System ACConfTestI - -> Signal System ACConfTestO -i2cSlave clk = mealyIO clk i2cSlaveT (reg i2cSlaveInit) --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE i2cSlave #-} diff --git a/tests/Main.hs b/tests/Main.hs index b800b58cf2..92e7ed8fed 100755 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -158,24 +158,6 @@ runClashTest = defaultMain $ clashTestRoot , clashTestGroup "crc32" [ runTest "CRC32" def ] - , clashTestGroup "i2c" - [ let _opts = def { clashFlags=["-O2","-fclash-component-prefix","test"] - , buildTargets=BuildSpecific ["test_i2c"] - , hdlSim=[] - } - in runTest "I2C" _opts - , - -- TODO: this uses finish_and_return, with is Icarus Verilog only. - -- see: https://github.com/clash-lang/clash-compiler/issues/2265 - let _opts = def { buildTargets = BuildSpecific ["system"] - , hdlTargets = [Verilog] - , hdlLoad = [IVerilog] - , hdlSim = [IVerilog] - , vvpStdoutNonEmptyFail = False - } - in runTest "I2Ctest" _opts - - ] ] , clashTestGroup "tests" [ clashTestGroup "shouldfail"