diff --git a/clash-cores/src/Clash/Cores/I2C/ByteMaster.hs b/clash-cores/src/Clash/Cores/I2C/ByteMaster.hs index 224de96a10..9a2bd40593 100644 --- a/clash-cores/src/Clash/Cores/I2C/ByteMaster.hs +++ b/clash-cores/src/Clash/Cores/I2C/ByteMaster.hs @@ -17,10 +17,12 @@ data ByteStateMachine = Idle | Active | Start | Read | Write | Ack | Stop deriving (Show, Generic, NFDataX, Eq) data I2COperation = ReadData | WriteData (BitVector 8) - deriving (Generic, NFDataX) + deriving (Generic, NFDataX, BitPack) + getWriteData :: I2COperation -> BitVector 8 getWriteData ReadData = 0 getWriteData (WriteData d) = d + data ByteMasterS = ByteS { _srState :: ShiftRegister diff --git a/clash-cores/test/Test/Cores/I2C.hs b/clash-cores/test/Test/Cores/I2C.hs index 66fa013c78..99c08b7ca1 100644 --- a/clash-cores/test/Test/Cores/I2C.hs +++ b/clash-cores/test/Test/Cores/I2C.hs @@ -20,10 +20,8 @@ system0 clk arst = bundle (registerFile,done,fault) (_dout,hostAck,_busy,al,ackOut,i2cO) = i2c clk arst rst (pure True) (pure 19) claim i2cOp (pure True) i2cI - 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)) + (claim,i2cOp,done,fault) = + unbundle $ config clk (bundle (rst,fmap not rst,hostAck,ackOut,al)) (sclOut,sdaOut) = unbundle i2cO scl = fmap (bitCoerce . isNothing) sclOut @@ -46,7 +44,8 @@ systemResult :: (Vec 16 (Unsigned 8), Bool, Bool) systemResult = L.last (sampleN 200050 system) i2cTest :: TestTree -i2cTest = testCase "i2c core testcase passed." - $ assertBool "i2c core test procedure failed" (not f) +i2cTest = testCase "i2c core testcase passed" + $ assertBool "i2c core test procedure failed" (not fault) where - (_, _, f) = L.last $ takeWhile (\ (_, done, _) -> not done) $ sample system + fault = + L.or $ fmap (\(_,_,f) -> f) $ takeWhile (\ (_, done, _) -> not done) $ sample system diff --git a/clash-cores/test/Test/Cores/I2C/Config.hs b/clash-cores/test/Test/Cores/I2C/Config.hs index 8726909107..a0463c5fc9 100644 --- a/clash-cores/test/Test/Cores/I2C/Config.hs +++ b/clash-cores/test/Test/Cores/I2C/Config.hs @@ -4,7 +4,8 @@ module Test.Cores.I2C.Config where import Clash.Prelude import Clash.Explicit.SimIO - +import Clash.Cores.I2C.ByteMaster(I2COperation(..)) +import Numeric (showHex) data ConfStateMachine = CONFena | CONFaddr | CONFaddrAck | CONFreg | CONFregAck | @@ -12,24 +13,22 @@ data ConfStateMachine = CONFena | CONFstop deriving Show -data ConfS = ConfS { i2cConfStateM :: ConfStateMachine - , i2cClaim :: Bool - , i2cWrite :: Bool - , i2cDin :: Vec 8 Bit - , i2cLutIndex :: Index 16 - , i2cFault :: Bool +data ConfS = ConfS { i2cConfStateM :: ConfStateMachine + , i2cConfClaim :: Bool + , i2cConfOp :: Maybe (I2COperation) + , i2cConfLutIndex :: Index 16 + , i2cConfFault :: Bool } type ConfI = (Bool,Bool,Bool,Bool,Bool) -type ConfO = (Bool,Bool,BitVector 8,Bool,Bool) +type ConfO = (Bool,Maybe (I2COperation),Bool,Bool) confInit :: ConfS confInit = ConfS { i2cConfStateM = CONFena - , i2cClaim = False - , i2cWrite = False - , i2cDin = repeat low - , i2cLutIndex = 0 - , i2cFault = False + , i2cConfClaim = False + , i2cConfOp = Nothing + , i2cConfLutIndex = 0 + , i2cConfFault = False } configT @@ -38,7 +37,7 @@ configT -> SimIO ConfO configT s0 (rst,ena,cmdAck,rxAck,al) = do s <- readReg s0 - let ConfS confStateM claim write din lutIndex fault = s + let ConfS confStateM claim i2cOp lutIndex fault = s let i2cSlvAddr = 0x34 :: BitVector 8 @@ -48,91 +47,86 @@ configT s0 (rst,ena,cmdAck,rxAck,al) = do let lutData = configLut lutIndex - sNext <- if rst then pure confInit else case confStateM of + sNext <- + if rst then pure confInit else case confStateM of CONFena | ena && not done - -> pure s { i2cConfStateM = CONFaddr } + -> pure s { i2cConfStateM = CONFaddr + , i2cConfClaim = True + } | done -> do display "done" pure s CONFaddr - -> pure s { i2cConfStateM = CONFaddrAck - , i2cClaim = True - , i2cWrite = True - , i2cDin = unpack i2cSlvAddr - } + -> do + display $ "CONFaddr, writing: " <> showHex i2cSlvAddr "" + pure s { i2cConfStateM = CONFaddrAck + , i2cConfOp = Just (WriteData (unpack i2cSlvAddr)) + } CONFaddrAck | success - -> do display "CONFaddrAck" - pure s { i2cConfStateM = CONFreg - , i2cWrite = False + -> if rxAck then do + display "CONFaddrAck" + pure s { i2cConfStateM = CONFreg + , i2cConfOp = Nothing + } + else do + display "Failure CONFaddr" + pure s { i2cConfStateM = CONFena + , i2cConfFault = True } CONFreg - -> if not rxAck then do + -> do + 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 display "Success CONFreg" - pure s { i2cConfStateM = CONFregAck - , i2cWrite = True - , i2cDin = unpack (fst lutData) - , i2cFault = False + pure s { i2cConfStateM = CONFdata + , i2cConfOp = Nothing } else do display "Failure CONFreg" - _ <- finish 1 pure s { i2cConfStateM = CONFena - , i2cFault = True + , i2cConfFault = True } - CONFregAck - | success - -> do display "CONFregAck" - pure s { i2cConfStateM = CONFdata - , i2cWrite = False - } - CONFdata - -> if not rxAck then do + -> do display $ "CONFdata, writing: " <> showHex (snd lutData) "" + pure s { i2cConfStateM = CONFdataAck + , i2cConfOp = Just (WriteData (unpack (snd lutData))) + } + CONFdataAck + | success + -> if rxAck then do display "Success CONFdata" - pure s { i2cConfStateM = CONFdataAck - , i2cWrite = True - , i2cClaim = False - , i2cDin = unpack (snd lutData) - , i2cFault = False + pure s { i2cConfStateM = CONFstop + , i2cConfOp = Nothing } else do display "Failure CONFdata" - _ <- finish 1 pure s { i2cConfStateM = CONFena - , i2cFault = True + , i2cConfFault = True } - CONFdataAck - | success - -> do display "CONFdataAck" - pure s { i2cConfStateM = CONFstop - , i2cWrite = False - } - CONFstop - -> if not rxAck then do + -> do display "Success CONFstop" pure s { i2cConfStateM = CONFena - , i2cLutIndex = lutIndex + 1 - , i2cFault = False - } - else do - display "Failure CONFstop" - _ <- finish 1 - pure s { i2cConfStateM = CONFena - , i2cFault = True + , i2cConfClaim = False + , i2cConfLutIndex = lutIndex + 1 } _ -> pure s writeReg s0 sNext - pure (claim,write,pack din,done,fault) + pure (claim,i2cOp,done,fault) configLut :: Index 16 -> (BitVector 8, BitVector 8) configLut i diff --git a/clash-cores/test/Test/Cores/I2C/Slave.hs b/clash-cores/test/Test/Cores/I2C/Slave.hs index c248cce522..23f89c728d 100644 --- a/clash-cores/test/Test/Cores/I2C/Slave.hs +++ b/clash-cores/test/Test/Cores/I2C/Slave.hs @@ -46,18 +46,23 @@ i2cSlaveT s0 (scl,sda) = do display "valid addr" pure s { i2cSlaveAtStateM = ATaddrAck , i2cSlaveAddr = repeat low - , i2cSlaveCntr = 0 } + , i2cSlaveCntr = 0 + } else do - display "invalid addr" + display $ "invalid addr: " <> show addr pure s { i2cSlaveAtStateM = ATidle , i2cSlaveAddr = repeat low - , i2cSlaveCntr = 0} + , i2cSlaveCntr = 0 + } | sclRising -> pure s { i2cSlaveCntr = cntr + 1 , i2cSlaveAddr = addr <<+ sda - , i2cSlaveSdaOut = high } + , i2cSlaveSdaOut = high + } ATaddrAck | sclRising -> do display "addrAck" - pure s { i2cSlaveAtStateM = ATreg, i2cSlaveSdaOut = low } + pure s { i2cSlaveAtStateM = ATreg + , i2cSlaveSdaOut = low + } ATreg | cntr == 8 -> if validRegAddr then do display "valid reg addr" @@ -67,18 +72,19 @@ i2cSlaveT s0 (scl,sda) = do , i2cSlaveRegAddr = shiftR (bitCoerce addr) 1 } else do - display "invalid reg addr" + display $ "invalid reg addr: " <> show addr pure s { i2cSlaveAtStateM = ATidle , i2cSlaveAddr = repeat low , i2cSlaveCntr = 0 } | sclRising -> pure s { i2cSlaveCntr = cntr + 1 , i2cSlaveAddr = addr <<+ sda - , i2cSlaveSdaOut = high } + , i2cSlaveSdaOut = high + } ATregAck | sclRising -> do display "regAck" - pure s { i2cSlaveSdaOut = low - , i2cSlaveAtStateM = ATval + pure s { i2cSlaveAtStateM = ATval + , i2cSlaveSdaOut = low } ATval | cntr == 8 -> do display "val" @@ -90,11 +96,12 @@ i2cSlaveT s0 (scl,sda) = do } | sclRising -> pure s { i2cSlaveCntr = cntr + 1 , i2cSlaveAddr = addr <<+ sda - , i2cSlaveSdaOut = high } + , i2cSlaveSdaOut = high + } ATvalAck | sclRising -> do display "valAck" - pure s { i2cSlaveSdaOut = low - , i2cSlaveAtStateM = ATstop + pure s { i2cSlaveAtStateM = ATstop + , i2cSlaveSdaOut = low } ATstop | stopCondition -> do display "stop"