diff --git a/clash-cores/src/Clash/Cores/SPI.hs b/clash-cores/src/Clash/Cores/SPI.hs index f510020bf4..619eb45038 100644 --- a/clash-cores/src/Clash/Cores/SPI.hs +++ b/clash-cores/src/Clash/Cores/SPI.hs @@ -12,11 +12,13 @@ module Clash.Cores.SPI , SpiMasterIn(..) , SpiMasterOut(..) , spiMaster + , spiMaster1 -- * SPI slave , SpiSlaveIn(..) , SpiSlaveOut(..) , SPISlaveConfig(..) , spiSlave + , spiSlave1 -- ** Vendor configured SPI slaves , spiSlaveLatticeSBIO , spiSlaveLatticeBB @@ -125,7 +127,7 @@ sampleOnLeading _ = False sampleOnTrailing :: SPIMode -> Bool sampleOnTrailing = not . sampleOnLeading -data SPISlaveConfig ds dom +data SPISlaveConfig ds dom (misoW :: Nat) (mosiW :: Nat) = SPISlaveConfig { spiSlaveConfigMode :: SPIMode -- ^ SPI mode @@ -139,10 +141,10 @@ data SPISlaveConfig ds dom -- -- * Set to /False/ when core clock is twice as fast, or as fast, as the SCK , spiSlaveConfigBuffer - :: BiSignalIn ds dom 1 + :: BiSignalIn ds dom misoW -> Signal dom Bool - -> Signal dom Bit - -> BiSignalOut ds dom 1 + -> Signal dom (BitVector misoW) + -> BiSignalOut ds dom misoW -- ^ Tri-state buffer: first argument is the inout pin, second -- argument is the output enable, third argument is the value to -- output when the enable is high @@ -150,19 +152,23 @@ data SPISlaveConfig ds dom -- | SPI capture and shift logic that is shared between slave and master spiCommon - :: forall n dom - . (HiddenClockResetEnable dom, KnownNat n, 1 <= n) + :: forall n dom inW outW + . ( HiddenClockResetEnable dom + , KnownNat inW + , KnownNat outW + , KnownNat n + , 1 <= n ) => SPIMode -> Signal dom Bool -- ^ Slave select - -> Signal dom Bit + -> Signal dom (BitVector inW) -- ^ Slave: MOSI; Master: MISO -> Signal dom Bool -- ^ SCK - -> Signal dom (BitVector n) - -> ( Signal dom Bit -- Slave: MISO; Master: MOSI - , Signal dom Bool -- Acknowledge start of transfer - , Signal dom (Maybe (BitVector n)) + -> Signal dom (Vec outW (BitVector n)) + -> ( Signal dom (BitVector outW) -- Slave: MISO; Master: MOSI + , Signal dom Bool -- Acknowledge start of transfer + , Signal dom (Maybe (Vec inW (BitVector n))) ) spiCommon mode ssI msI sckI dinI = mooreB go cvt ( 0 :: Index n -- cntR @@ -176,13 +182,16 @@ spiCommon mode ssI msI sckI dinI = (ssI,msI,sckI,dinI) where cvt (_,_,_,dataInQ,dataOutQ,ackQ,doneQ) = - ( head dataOutQ + ( v2bv $ map head dataOutQ , ackQ , if doneQ - then Just (pack dataInQ) + then Just (map v2bv dataInQ) else Nothing ) + go :: (Index n, Bool, Bool, Vec inW (Vec n Bit), Vec outW (Vec n Bit), Bool, Bool) + -> (Bool, BitVector inW, Bool, Vec outW (BitVector n)) + -> (Index n, Bool, Bool, Vec inW (Vec n Bit), Vec outW (Vec n Bit), Bool, Bool) go (cntQ,cntOldQ,sckOldQ,dataInQ,dataOutQ,_,_) (ss,ms,sck,din) = (cntD,cntOldD,sck,dataInD,dataOutD,ackD,doneD) where @@ -191,16 +200,18 @@ spiCommon mode ssI msI sckI dinI = | sampleSck = if cntQ == maxBound then 0 else cntQ + 1 | otherwise = cntQ + dataInD :: Vec inW (Vec n Bit) dataInD | ss = unpack undefined# - | sampleSck = tail @(n-1) dataInQ :< ms + | sampleSck = zipWith (\d m -> tail @(n-1) d :< m) dataInQ (bv2v ms) | otherwise = dataInQ + dataOutD :: Vec outW (Vec n Bit) dataOutD - | ss || (sampleOnTrailing mode && sampleSck && cntQ == maxBound) = unpack din + | ss || (sampleOnTrailing mode && sampleSck && cntQ == maxBound) = fmap bv2v din | shiftSck = if sampleOnTrailing mode && cntQ == 0 then dataOutQ - else tail @(n-1) dataOutQ :< unpack undefined# + else map (\d -> tail @(n-1) d :< unpack undefined#) dataOutQ | otherwise = dataOutQ -- The counter is updated during the capture moment @@ -222,19 +233,23 @@ spiCommon mode ssI msI sckI dinI = -- | SPI slave configurable SPI mode and tri-state buffer spiSlave - :: forall n ds dom - . (HiddenClockResetEnable dom, KnownNat n, 1 <= n) - => SPISlaveConfig ds dom + :: forall n ds dom misoW mosiW + . ( HiddenClockResetEnable dom + , KnownNat n + , 1 <= n + , KnownNat misoW + , KnownNat mosiW ) + => SPISlaveConfig ds dom misoW mosiW -- ^ Configure SPI mode and tri-state buffer - -> SpiSlaveIn ds dom 1 1 + -> SpiSlaveIn ds dom misoW mosiW -- ^ SPI interface - -> Signal dom (BitVector n) + -> Signal dom (Vec misoW (BitVector n)) -- ^ Data to send from slave to master. -- -- Input is latched the moment slave select goes low - -> ( SpiSlaveOut ds dom 1 1 + -> ( SpiSlaveOut ds dom misoW mosiW , Signal dom Bool - , Signal dom (Maybe (BitVector n))) + , Signal dom (Maybe (Vec mosiW (BitVector n))) ) -- ^ Parts of the tuple: -- -- 1. The "out" part of the inout port of the MISO; used only for simulation. @@ -246,17 +261,46 @@ spiSlave (SPISlaveConfig mode latch buf) (SpiSlaveIn mosi bin sclk ss) din = let ssL = if latch then delay undefined ss else ss mosiL = if latch then delay undefined mosi else mosi sclkL = if latch then delay undefined sclk else sclk - (miso, ack, dout) = spiCommon mode (bitToBool <$> ssL) (head . bv2v <$> mosiL) (bitToBool <$> sclkL) din + (miso, ack, dout) = spiCommon mode (bitToBool <$> ssL) mosiL (bitToBool <$> sclkL) din bout = buf bin (not . bitToBool <$> ssL) miso in (SpiSlaveOut bout, ack, dout) +spiSlave1 + :: forall n ds dom + . ( HiddenClockResetEnable dom + , KnownNat n + , 1 <= n ) + => SPISlaveConfig ds dom 1 1 + -- ^ Configure SPI mode and tri-state buffer + -> SpiSlaveIn ds dom 1 1 + -- ^ SPI interface + -> Signal dom (BitVector n) + -- ^ Data to send from slave to master. + -- + -- Input is latched the moment slave select goes low + -> ( SpiSlaveOut ds dom 1 1 + , Signal dom Bool + , Signal dom (Maybe (BitVector n)) ) + -- ^ Parts of the tuple: + -- + -- 1. The "out" part of the inout port of the MISO; used only for simulation. + -- + -- 2. the acknowledgement for the data sent from the master to the slave. + -- + -- 2. (Maybe) the word sent by the master +spiSlave1 config spiIn dout = + let (spiOut, ack, din) = spiSlave config spiIn (singleton <$> dout) + in (spiOut, ack, fmap head <$> din) + -- | SPI master configurable in the SPI mode and clock divider -- -- Adds latch to MISO line if the (half period) clock divider is -- set to 2 or higher. spiMaster - :: forall n halfPeriod waitTime dom + :: forall n halfPeriod waitTime dom misoW mosiW . ( HiddenClockResetEnable dom + , KnownNat misoW + , KnownNat mosiW , KnownNat n , 1 <= n , 1 <= halfPeriod @@ -270,14 +314,14 @@ spiMaster -> SNat waitTime -- ^ (core clock) cycles between de-asserting slave-select and start of -- the SPI clock - -> Signal dom (Maybe (BitVector n)) + -> Signal dom (Maybe (Vec mosiW (BitVector n))) -- ^ Data to send from master to slave, transmission starts when receiving -- /Just/ a value - -> SpiMasterIn dom 1 1 - -> ( SpiMasterOut dom 1 1 + -> SpiMasterIn dom misoW mosiW + -> ( SpiMasterOut dom misoW mosiW , Signal dom Bool -- Busy , Signal dom Bool -- Acknowledge - , Signal dom (Maybe (BitVector n)) -- Data: Slave -> Master + , Signal dom (Maybe (Vec misoW (BitVector n))) -- Data: Slave -> Master ) -- ^ Parts of the tuple: -- @@ -288,27 +332,59 @@ spiMaster -- the data line will be ignored when /True/ -- 5. (Maybe) the word send from the slave to the master spiMaster mode fN fW din (SpiMasterIn miso) = - let (mosi, ack, dout) = spiCommon mode ssL (head . bv2v <$> misoL) sclkL - (fromMaybe undefined# <$> din) + let (mosi, ack, dout) = spiCommon mode ssL misoL sclkL + (fromMaybe (repeat undefined#) <$> din) latch = snatToInteger fN /= 1 ssL = if latch then delay undefined ss else ss misoL = if latch then delay undefined miso else miso sclkL = if latch then delay undefined sclk else sclk (ss, sclk, busy) = spiGen mode fN fW din - in (SpiMasterOut (v2bv . singleton <$> mosi) (boolToBit <$> sclk) (boolToBit <$> ss), busy, ack, dout) + in (SpiMasterOut mosi (boolToBit <$> sclk) (boolToBit <$> ss), busy, ack, dout) + +-- | SPI master with single-bit MISO and MOSI width. +spiMaster1 + :: forall n halfPeriod waitTime dom + . ( HiddenClockResetEnable dom + , KnownNat n + , 1 <= n + , 1 <= halfPeriod + , 1 <= waitTime ) + => SPIMode + -- ^ SPI Mode + -> SNat halfPeriod + -- ^ Clock divider (half period) + -- + -- If set to two or higher, the MISO line will be latched + -> SNat waitTime + -- ^ (core clock) cycles between de-asserting slave-select and start of + -- the SPI clock + -> Signal dom (Maybe (BitVector n)) + -- ^ Data to send from master to slave, transmission starts when receiving + -- /Just/ a value + -> SpiMasterIn dom 1 1 + -> ( SpiMasterOut dom 1 1 + , Signal dom Bool -- Busy + , Signal dom Bool -- Acknowledge + , Signal dom (Maybe (BitVector n)) -- Data: Slave -> Master + ) +spiMaster1 mode halfPeriod waitTime dout spiIn = + let (spiOut, busy, ack, din) = + spiMaster mode halfPeriod waitTime (fmap singleton <$> dout) spiIn + in (spiOut, busy, ack, fmap head <$> din) -- | Generate slave select and SCK spiGen - :: forall n halfPeriod waitTime dom + :: forall n halfPeriod waitTime dom outW . ( HiddenClockResetEnable dom , KnownNat n + , KnownNat outW , 1 <= n , 1 <= halfPeriod , 1 <= waitTime ) => SPIMode -> SNat halfPeriod -> SNat waitTime - -> Signal dom (Maybe (BitVector n)) + -> Signal dom (Maybe (Vec outW (BitVector n))) -> ( Signal dom Bool , Signal dom Bool , Signal dom Bool @@ -386,11 +462,11 @@ spiSlaveLatticeSBIO -- -- 2. (Maybe) the word send by the master spiSlaveLatticeSBIO mode latchSPI = - spiSlave (SPISlaveConfig mode latchSPI sbioX) + spiSlave1 (SPISlaveConfig mode latchSPI sbioX) where sbioX bin en dout = bout where - (bout,_,_) = sbio 0b101001 bin (pure 0) dout (pure undefined) en + (bout,_,_) = sbio 0b101001 bin (pure 0) (head . bv2v <$> dout) (pure undefined) en -- | SPI slave configurable SPI mode, using the BB tri-state buffer @@ -423,8 +499,8 @@ spiSlaveLatticeBB -- -- 2. (Maybe) the word send by the master spiSlaveLatticeBB mode latchSPI = - spiSlave (SPISlaveConfig mode latchSPI bbX) + spiSlave1 (SPISlaveConfig mode latchSPI bbX) where bbX bin en dout = bout where - (bout,_) = bidirectionalBuffer (toEnable en) bin dout + (bout,_) = bidirectionalBuffer (toEnable en) bin (head . bv2v <$> dout)