-- | A simple I²C controller.
package I2C where

import Clocks
import GetPut

struct I2CStatus =
  { -- | Whether a read or write is not in progress, so a new command can be
    -- performed. Writing this bit to move it from high to low begins a
    -- command.
    notBusy :: Bool
  ; -- | Whether the bus is idle. Usually, software will want to use the
    -- `notBusy` bit instead to determine when to send new commands; the
    -- `busIdle` bit is only set to `True` after the STOP condition (i.e.,
    -- after the transaction ends). Writing to this bit does not affect the
    -- internal state of the I²C controller.
    busIdle :: Bool
  ; -- | The last ACK bit we received from sending an address. Writing to this
    -- bit does not affect the internal state of the I²C controller.
    addrAck :: Bool
  ; -- | The last ACK bit we received during a write, or the next ACK bit we'll
    -- send during a read.
    dataAck :: Bool
  ; -- | A flag set if we detect during a START condition that we've lost
    -- arbitration. If this occurs, no read or write will occur, and the read
    -- or write should be retried later. Writing to this bit does not affect
    -- the internal state of the I²C controller.
    arbitrationLost :: Bool
  ; -- | Not-yet-allocated bits.
    rsvd :: Bit 3
  }
  deriving (Bits)

-- | An I²C controller.
interface I2C =
  -- | The TX side of the SCL pin. High corresponds to high-impedance.
  txSCL :: Bit 1
  -- | The TX side of the SDA pin. High corresponds to high-impedance.
  txSDA :: Bit 1

  -- | The address register, which contains the address in the high 7 bits and
  -- the R/!W bit in the low bit.
  addrReg :: Reg (Bit 8)
  -- | The data register, which can be read into by a read command or written
  -- from by a write command, depending on which the address register's low bit
  -- says to do.
  dataReg :: Reg (Bit 8)
  -- | The status register.
  statusReg :: Reg I2CStatus

data I2CBusState
  = -- | (We believe) the bus is idle.
    Idle
  | -- | We've driven SDA low as part of the START condition.
    StartSDA
  | -- | We're sending an address, and about to write the numbered bit to SDA.
    -- SCL should be low.
    SendAddrBitSDA (Bit 3)
  | -- | We're sending an address, and about to raise SCL.
    SendAddrBitRaiseSCL (Bit 3) (Bit 1)
  | -- | We're waiting for the device to read our address bit. SCL should be
    -- high.
    SendAddrBitWait (Bit 3) (Bit 1)
  | -- | We're sending an address, and about to lower SCL.
    SendAddrBitLowerSCL (Bit 3) (Bit 1)
  | -- | We're lowering SDA as part of getting the ACK bit after sending an
    -- address.
    GetAddrAckSDA
  | -- | We're raising SCL to start the clock cycle in which we'll get the ACK
    -- bit after sending an address.
    GetAddrAckRaiseSCL
  | -- | We're reading SDA, which should be the ACK bit after sending an
    -- address.
    GetAddrAckReadSDA
  | -- | We're about to either lower SCL or keep it low as part of reading a
    -- byte from a device.
    ReadLowerSCL (Bit 3) (Bit 1)
  | -- | We're about to raise SCL as part of reading a byte from a device.
    ReadRaiseSCL (Bit 3)
  | -- | We're about to read SDA while keeping SCL high as part of reading a
    -- byte from a device.
    ReadReadSDA (Bit 3)
  | -- | We're about to lower SCL as part of writing an ACK bit after reading a
    -- byte from a device.
    ReadAckLowerSCL
  | -- | We're about to write SDA while keeping SCL low as part of writing an
    -- ACK bit in response to reading a byte from a device.
    ReadAckWriteSDA
  | -- | We're about to raise SCL or keep it raised as part of writing an ACK
    -- bit after reading a byte from a device. The first bit is the bit to
    -- hold, the second is the number of cycles to hold it for.
    ReadAckRaiseSCL (Bit 1) (Bit 1)
  | -- | TODO
    TODO
  deriving (Bits, FShow)

-- | Runs an I²C interface on the current clock.
mkI2C' :: Bit 1 -> Bit 1 -> Wire (Bit 1) -> Wire (Bit 1) -> Reg (Bit 8) ->
  Reg (Bit 8) -> Reg I2CStatus -> Module ()
mkI2C' rxSCL rxSDA txSCL txSDA addrReg dataReg statusReg = module
  state :: Reg I2CBusState <- mkReg Idle
  rules
    "debug": when True ==> $display (fshow state)
    "remain Idle": when Idle <- state, statusReg.notBusy ==> do
      state := Idle
      txSCL := 1
      txSDA := 1
    "triggered from Idle": when Idle <- state, not statusReg.notBusy ==>
      if rxSDA == 0 then do
        statusReg := statusReg { arbitrationLost = True }
        state := Idle
        txSCL := 1
        txSDA := 1
      else do
        state := StartSDA
        txSCL := 1
        txSDA := 0
    "StartSDA": when StartSDA <- state ==> do
      state := SendAddrBitSDA 7
      txSCL := 0
      txSDA := 0
    "SendAddrBitSDA": when SendAddrBitSDA n <- state ==> do
      let bit = addrReg[n:n]
      state := SendAddrBitRaiseSCL n bit
      txSCL := 0
      txSDA := bit
    "SendAddrBitRaiseSCL": when SendAddrBitRaiseSCL n bit <- state ==> do
      state := SendAddrBitWait n bit
      txSCL := 1
      txSDA := bit
    "SendAddrBitWait": when SendAddrBitWait n bit <- state ==> do
      state := SendAddrBitLowerSCL n bit
      txSCL := 1
      txSDA := bit
    "SendAddrBitLowerSCL": when SendAddrBitLowerSCL n bit <- state ==> do
      state := if n == 0
               then GetAddrAckSDA
               else SendAddrBitSDA (n - 1)
      txSCL := 0
      txSDA := bit
    "GetAddrAckSDA": when GetAddrAckSDA <- state ==> do
      state := GetAddrAckRaiseSCL
      txSCL := 0
      txSDA := 0
    "GetAddrAckRaiseSCL": when GetAddrAckRaiseSCL <- state ==> do
      state := GetAddrAckReadSDA
      txSCL := 1
      txSDA := 1
    "GetAddrAckReadSDA": when GetAddrAckReadSDA <- state ==> do
      statusReg := statusReg { addrAck = unpack rxSDA }
      state := if rxSDA == 1 -- NACK
               then TODO
               else if addrReg[0:0] == 0 -- R/!W
               then TODO -- !W
               else ReadLowerSCL 7 1
      txSCL := 1
      txSDA := 1
    "ReadLowerSCL": when ReadLowerSCL n time <- state ==> do
      state := if time == 1
               then ReadLowerSCL n (time - 1)
               else ReadRaiseSCL n
      txSCL := 0
      txSDA := 1
    "ReadRaiseSCL": when ReadRaiseSCL n <- state ==> do
      state := ReadReadSDA n
      txSCL := 1
      txSDA := 1
    "ReadReadSDA": when ReadReadSDA n <- state ==> do
      dataReg := dataReg [6:0] ++ rxSDA
      state := if n == 0
               then ReadAckLowerSCL
               else ReadLowerSCL (n - 1) 1
      txSCL := 1
      txSDA := 1
    "ReadAckLowerSCL": when ReadAckLowerSCL <- state ==> do
      state := ReadAckWriteSDA
      txSCL := 0
      txSDA := 1
    "ReadAckWriteSDA": when ReadAckWriteSDA <- state ==> do
      let bit = pack statusReg.dataAck
      state := ReadAckRaiseSCL bit 1
      txSCL := 0
      txSDA := bit
    "ReadAckRaiseSCL": when ReadAckRaiseSCL bit time <- state ==> do
      state := if time == 1
               then ReadAckRaiseSCL bit (time - 1)
               else TODO
      txSCL := 1
      txSDA := bit
  return ()

-- | Returns an I²C interface that runs on the current clock. This is not what
-- you want, most likely.
mkI2C :: Bit 1 -> Bit 1 -> Module I2C
mkI2C rxSCL rxSDA = module
  txSCL <- mkWire
  txSDA <- mkWire
  addrReg <- mkReg 0
  dataReg <- mkReg 0
  statusReg <- mkReg (I2CStatus
    { notBusy = False
    ; busIdle = False
    ; addrAck = False
    ; dataAck = False
    ; arbitrationLost = False
    ; rsvd = 0
    })
  mkI2C' rxSCL rxSDA txSCL txSDA addrReg dataReg statusReg

  interface I2C
    txSCL = txSCL
    txSDA = txSDA
    addrReg = addrReg
    dataReg = dataReg
    statusReg = statusReg

{-
-- | Returns an I²C interface with FIFOs that runs on a divided clock. Note
-- that the clock rate should be twice the bus speed -- to run the bus at
-- 100kbit/s (normal mode), the clock should run at 200kHz.
mkDividedI2C :: Integer -> Bit 1 -> Bit 1 -> Module I2C
mkDividedI2C divisor rxSCL rxSDA = module
  clock <- mkClockDivider divisor
  reset <- mkAsyncResetFromCR divisor clock.slowClock

  rxSCLSync :: SyncBitIfc (Bit 1) <- mkSyncBitFromCC clock.slowClock
  rxSDASync :: SyncBitIfc (Bit 1) <- mkSyncBitFromCC clock.slowClock
  txSCLSync :: Reg (Bit 1) <- mkSyncRegToCC 1 clock.slowClock reset
  txSDASync :: Reg (Bit 1) <- mkSyncRegToCC 1 clock.slowClock reset
  recvFIFO :: SyncFIFOIfc I2CResult <- mkSyncFIFOToCC 16 clock.slowClock reset
  sendFIFO :: SyncFIFOIfc I2CCommand <- mkSyncFIFOFromCC 16 clock.slowClock
  rules
    "copy rxSCL and rxSDA": when True ==> do
      rxSCLSync.send rxSCL
      rxSDASync.send rxSDA

  changeSpecialWires (Just clock.slowClock) (Just reset) Nothing $ module
    mkI2C' rxSCLSync.read rxSDASync.read txSCLSync txSDASync sendFIFO recvFIFO

  interface I2C
    txSCL = txSCLSync
    txSDA = txSDASync
    recv = toGet recvFIFO
    send = toPut sendFIFO
-}

-- vim: set ft=haskell :