diff --git a/clash-cores/src/Clash/Cores/I2C.hs b/clash-cores/src/Clash/Cores/I2C.hs index fab8d2f361..d682d323d1 100644 --- a/clash-cores/src/Clash/Cores/I2C.hs +++ b/clash-cores/src/Clash/Cores/I2C.hs @@ -22,18 +22,12 @@ i2c :: "ena" ::: Signal dom Bool -> -- | Clock divider "clkCnt" ::: Signal dom (Unsigned 16) -> - -- | Start signal - "start" ::: Signal dom Bool -> - -- | Stop signal - "stop" ::: Signal dom Bool -> - -- | Read signal - "read" ::: Signal dom Bool -> - -- | Write signal - "write" ::: Signal dom Bool -> + -- | Claim bus signal + "claimBus" ::: Signal dom Bool -> + -- | I2C operation + "i2cOp" ::: Signal dom (Maybe I2COperation) -> -- | Ack signal "ackIn" ::: Signal dom Bool -> - -- | Input data - "din" ::: Signal dom (BitVector 8) -> -- | I2C input signals (SCL, SDA) "i2c" ::: Signal dom ("scl" ::: Bit, "sda" ::: Bit) -> -- | @@ -49,16 +43,16 @@ i2c :: -- 6.4 SDA Output enable "" ::: ( "i2cO" ::: Signal dom (BitVector 8) - , "scl" ::: Signal dom Bool - , "sclOEn" ::: Signal dom Bool - , "sda" ::: Signal dom Bool - , "sdaOEn" ::: Signal dom Bool - , "i2cO" ::: Signal dom ("scl" ::: Bit, "sclOEn" ::: Bool, "sda" ::: Bit, "sdaOEn" ::: Bool)) -i2c clk arst rst ena clkCnt start stop read write ackIn din i2cI = (dout,hostAck,busy,al,ackOut,i2cO) + , "i2cOpAck" ::: Signal dom Bool + , "busy" ::: Signal dom Bool + , "al" ::: Signal dom Bool + , "slaveAck" ::: Signal dom Bool + , "i2cO" ::: Signal dom ("sclOEn" ::: Bool, "sdaOEn" ::: Bool)) +i2c clk arst rst ena clkCnt claimBus i2cOp ackIn i2cI = (dout,i2cOpAck,busy,al,slaveAck,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 + (i2cOpAck,slaveAck,dout,bitCtrl) = byteMaster clk arst enableGen (rst,claimBus, i2cOp, ackIn,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/clash-cores/src/Clash/Cores/I2C/BitMaster.hs b/clash-cores/src/Clash/Cores/I2C/BitMaster.hs index bf1a751e90..152fc41ae6 100644 --- a/clash-cores/src/Clash/Cores/I2C/BitMaster.hs +++ b/clash-cores/src/Clash/Cores/I2C/BitMaster.hs @@ -52,7 +52,11 @@ type BitMasterI = (Bool,Bool,Unsigned 16,BitCtrlSig,I2CIn) -- 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 @@ -118,9 +122,6 @@ bitMasterT s@(BitS { _stateMachine = StateMachine {..} 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) + let outp = ((_cmdAck,_al,_dout),_busy,(_sclOen,_sdaOen)) return outp diff --git a/clash-cores/src/Clash/Cores/I2C/ByteMaster.hs b/clash-cores/src/Clash/Cores/I2C/ByteMaster.hs index d2558d68b3..e2f636e51e 100644 --- a/clash-cores/src/Clash/Cores/I2C/ByteMaster.hs +++ b/clash-cores/src/Clash/Cores/I2C/ByteMaster.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} -module Clash.Cores.I2C.ByteMaster (byteMaster) where +module Clash.Cores.I2C.ByteMaster (byteMaster, I2COperation(..)) where import Clash.Prelude hiding (read) @@ -11,10 +11,16 @@ import Data.Tuple import Clash.Cores.I2C.ByteMaster.ShiftRegister import Clash.Cores.I2C.Types +import Data.Maybe (fromJust) -data ByteStateMachine = Idle | Start | Read | Write | Ack | Stop +data ByteStateMachine = Idle | Active | Start | Read | Write | Ack | Stop deriving (Show, Generic, NFDataX) +data I2COperation = ReadData | WriteData (BitVector 8) + deriving (Generic, NFDataX) +getWriteData :: I2COperation -> BitVector 8 +getWriteData ReadData = deepErrorX "Write data undefined for ReadData in I2COperation" +getWriteData (WriteData d) = d data ByteMasterS = ByteS { _srState :: ShiftRegister @@ -23,8 +29,8 @@ data ByteMasterS , _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 + , _i2cOpAck :: Bool -- host cmd acknowlegde register + , _slaveAck :: Bool -- slave ack register } deriving (Generic, NFDataX) @@ -32,14 +38,11 @@ makeLenses ''ByteMasterS -- | -- 1. Statemachine reset --- 2. Start --- 3. Stop --- 4. Read --- 5. Write --- 6. Acknowledge --- 7. Data in --- 8. Bitmaster response -type ByteMasterI = (Bool,Bool,Bool,Bool,Bool,Bool,BitVector 8,BitRespSig) +-- 2. Claim bus +-- 3. Bus operation +-- 4. Acknowledge +-- 5. Bitmaster response +type ByteMasterI = (Bool,Bool,Maybe I2COperation, Bool,BitRespSig) -- | -- 1. Acknowledge for I2C controller @@ -73,63 +76,64 @@ byteMasterInit , _coreTxd = low , _shiftsr = False , _ld = False - , _hostAck = False - , _ackOut = True + , _i2cOpAck = False + , _slaveAck = 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) + (rst,claimBus,maybeI2COp,ackIn,~(coreAck,al,coreRxd)) = swap $ flip runState s $ do -- assign dOut the output of the shift-register - dout = _sr + let dout = _sr - cntDone <- zoom srState (shiftRegister rst _ld _shiftsr (bv2v din) coreRxd) + cntDone <- zoom srState (shiftRegister rst _ld _shiftsr (bv2v (getWriteData $ fromJust maybeI2COp )) coreRxd) -- state machine coreTxd .= head dout shiftsr .= False ld .= False - hostAck .= False + i2cOpAck .= False if rst || al then do coreCmd .= I2Cnop coreTxd .= low byteStateM .= Idle - ackOut .= True - else case _byteStateM of - Idle -> when go $ do + slaveAck .= True + else case (_byteStateM, maybeI2COp) of + (Idle, _) -> when claimBus $ 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 + byteStateM .= Start + coreCmd .= I2Cstart + (Active, Just ReadData) -> do + byteStateM .= Read + coreCmd .= I2Cread + (Active, Just (WriteData _)) -> do ld .= True - if read then do - byteStateM .= Read - coreCmd .= I2Cread - else do - byteStateM .= Write - coreCmd .= I2Cwrite - Write -> when coreAck $ do + byteStateM .= Write + coreCmd .= I2Cwrite + (Active ,Nothing) -> do + byteStateM .= Active + coreCmd .= I2Cnop + (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 + + (Read, _) -> when coreAck $ do shiftsr .= True coreTxd .= bitCoerce ackIn if cntDone then do @@ -137,26 +141,29 @@ byteMasterT s@(ByteS {_srState = ShiftRegister {..}, ..}) coreCmd .= I2Cwrite else do coreCmd .= I2Cread - Ack -> if coreAck then do - ackOut .= bitCoerce coreRxd + + (Ack, _) -> + if coreAck then do + slaveAck .= 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 + if claimBus then do + byteStateM .= Active coreCmd .= I2Cnop -- generate command acknowledge signal - hostAck .= True + i2cOpAck .= True + else do + byteStateM .= Stop + coreCmd .= I2Cstop else coreTxd .= bitCoerce ackIn - Stop -> when coreAck $ do + + (Stop, _) -> when coreAck $ do byteStateM .= Idle coreCmd .= I2Cnop - hostAck .= True + i2cOpAck .= True let bitCtrl = (_coreCmd,_coreTxd) - outp = (_hostAck,_ackOut,v2bv dout,bitCtrl) + outp = (_i2cOpAck,_slaveAck,v2bv dout,bitCtrl) return outp diff --git a/clash-cores/src/Clash/Cores/I2C/Types.hs b/clash-cores/src/Clash/Cores/I2C/Types.hs index a9fe4d8580..c8a0a4f1ae 100644 --- a/clash-cores/src/Clash/Cores/I2C/Types.hs +++ b/clash-cores/src/Clash/Cores/I2C/Types.hs @@ -15,5 +15,5 @@ type BitRespSig = (Bool, Bool, Bit) -- | I2C input signals (SCL, SDA). type I2CIn = (Bit, Bit) --- | I2C output signals (SCL, SCL enable, SDA, SDA enable). -type I2COut = (Bit, Bool, Bit, Bool) +-- | I2C output signals (SCL enable, SDA enable). +type I2COut = (Bool, Bool) diff --git a/clash-cores/test/Test/Cores/I2C.hs b/clash-cores/test/Test/Cores/I2C.hs index 4b04c08fb2..3af1ee3e58 100644 --- a/clash-cores/test/Test/Cores/I2C.hs +++ b/clash-cores/test/Test/Cores/I2C.hs @@ -9,17 +9,20 @@ import Clash.Cores.I2C import Test.Cores.I2C.Slave import Test.Cores.I2C.Config +import Clash.Cores.I2C.ByteMaster (I2COperation(..)) system0 :: Clock System -> Reset System -> Signal System (Vec 16 (Unsigned 8), Bool, Bool) system0 clk arst = bundle (registerFile,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 + i2c clk arst rst (pure True) (pure 19) claim i2cOp (pure True) i2cI - (start,stop,write,din,done,fault) = unbundle $ + i2cOp = mux claim (Just <$> mux write (WriteData <$> din) (pure ReadData)) (pure Nothing) + + (claim,write,din,done,fault) = unbundle $ config clk (bundle (rst, fmap not rst,hostAck,ackOut,al)) - (_,sclOen,_,sdaOen) = unbundle i2cO + (sclOen,sdaOen) = unbundle i2cO scl = fmap bitCoerce sclOen i2cI = bundle (scl,sdaS) diff --git a/clash-cores/test/Test/Cores/I2C/Config.hs b/clash-cores/test/Test/Cores/I2C/Config.hs index 7444962664..f020668f53 100644 --- a/clash-cores/test/Test/Cores/I2C/Config.hs +++ b/clash-cores/test/Test/Cores/I2C/Config.hs @@ -13,8 +13,7 @@ data ConfStateMachine = CONFena | deriving Show data ConfS = ConfS { i2cConfStateM :: ConfStateMachine - , i2cStart :: Bool - , i2cStop :: Bool + , i2cClaim :: Bool , i2cWrite :: Bool , i2cDin :: Vec 8 Bit , i2cLutIndex :: Index 16 @@ -22,12 +21,11 @@ data ConfS = ConfS { i2cConfStateM :: ConfStateMachine } type ConfI = (Bool,Bool,Bool,Bool,Bool) -type ConfO = (Bool,Bool,Bool,BitVector 8,Bool,Bool) +type ConfO = (Bool,Bool,BitVector 8,Bool,Bool) confInit :: ConfS confInit = ConfS { i2cConfStateM = CONFena - , i2cStart = False - , i2cStop = False + , i2cClaim = False , i2cWrite = False , i2cDin = repeat low , i2cLutIndex = 0 @@ -40,7 +38,7 @@ configT -> SimIO ConfO configT s0 (rst,ena,cmdAck,rxAck,al) = do s <- readReg s0 - let ConfS confStateM start stop write din lutIndex fault = s + let ConfS confStateM claim write din lutIndex fault = s let i2cSlvAddr = 0x34 :: BitVector 8 @@ -60,7 +58,7 @@ configT s0 (rst,ena,cmdAck,rxAck,al) = do CONFaddr -> pure s { i2cConfStateM = CONFaddrAck - , i2cStart = True + , i2cClaim = True , i2cWrite = True , i2cDin = unpack i2cSlvAddr } @@ -69,12 +67,11 @@ configT s0 (rst,ena,cmdAck,rxAck,al) = do | success -> do display "CONFaddrAck" pure s { i2cConfStateM = CONFreg - , i2cStart = False , i2cWrite = False } CONFreg - -> if rxAck == False then do + -> if not rxAck then do display "Success CONFreg" pure s { i2cConfStateM = CONFregAck , i2cWrite = True @@ -100,7 +97,7 @@ configT s0 (rst,ena,cmdAck,rxAck,al) = do display "Success CONFdata" pure s { i2cConfStateM = CONFdataAck , i2cWrite = True - , i2cStop = True + , i2cClaim = False , i2cDin = unpack (snd lutData) , i2cFault = False } @@ -115,7 +112,6 @@ configT s0 (rst,ena,cmdAck,rxAck,al) = do | success -> do display "CONFdataAck" pure s { i2cConfStateM = CONFstop - , i2cStop = False , i2cWrite = False } @@ -127,7 +123,7 @@ configT s0 (rst,ena,cmdAck,rxAck,al) = do , i2cFault = False } else do - display "Failure CONFdata" + display "Failure CONFstop" _ <- finish 1 pure s { i2cConfStateM = CONFena , i2cFault = True @@ -136,7 +132,7 @@ configT s0 (rst,ena,cmdAck,rxAck,al) = do _ -> pure s writeReg s0 sNext - pure (start,stop,write,pack din,done,fault) + pure (claim,write,pack din,done,fault) configLut :: Index 16 -> (BitVector 8, BitVector 8) configLut i