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

import Clocks
import GetPut

struct I2CStatus =
  { -- | This bit is low when a message is being sent, and gets raised after:
    --
    -- - We finished sending an address, but a NACK was received.
    -- - We finished reading a byte, including starting to send an ACK or NACK
    --   bit.
    -- - We finished writing a byte, including reading an ACK or NACK bit.
    --
    -- When this bit is `True`, writing to it will cause a new read or write,
    -- either in the current transaction (if this happened before `busIdle` was
    -- lowered) or in a new one.
    ready :: Bool
  ; -- | Whether the bus is idle. Usually, software will want to enable
    -- interrupts on the `ready` 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.
    addrAckBit :: Bool
  ; -- | The last ACK bit we received during a write, or the next ACK bit we'll
    -- send during a read.
    dataAckBit :: 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

  -- | Reads from the address register, which contains the address in the high
  -- 7 bits and the R/!W bit in the low bit.
  addrRegGet :: Bit 8
  -- | Writes to the address register, which contains the address in the high
  -- 7 bits and the R/!W bit in the low bit.
  addrRegPut :: Bit 8 -> Action
  -- | Reads from 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.
  dataRegGet :: Bit 8
  -- | Writes to 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.
  dataRegPut :: Bit 8 -> Action
  -- | Reads from the status register.
  statusRegGet :: I2CStatus
  -- | Writes to the status register.
  statusRegPut :: I2CStatus -> Action

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 raising 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
  | -- | TODO
    WriteLowerSCL (Bit 1) (Bit 3)
  | -- | TODO
    WriteWriteSDA (Bit 3)
  | -- | TODO
    WriteRaiseSCL (Bit 1) (Bit 3) (Bit 1)
  | -- | TODO
    WriteAckLowerSCL (Bit 1)
  | -- | TODO
    WriteAckRaiseSDA
  | -- | TODO
    WriteAckRaiseSCL
  | -- | TODO
    WriteAckReadSDA
  | -- | TODO
    WriteAckLowerSCL2
  | -- | TODO
    TODO
  | -- | 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
    StopLowerSCL
  | -- | TODO
    StopLowerSDA
  | -- | TODO
    StopRaiseSCL
  | -- | TODO
    StopRaiseSDA
  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
  savedAddr :: Reg (Bit 8) <- mkReg 0
  savedData :: Reg (Bit 8) <- mkReg 0
  rules
    "debug": when True ==> $display (fshow state)
    "remain Idle": when Idle <- state, statusReg.ready ==> do
      state := Idle
      txSCL := 1
      txSDA := 1
    "triggered from Idle": when Idle <- state, not statusReg.ready ==>
      if rxSDA == 0 then do
        statusReg := statusReg { ready = True; busIdle = True; arbitrationLost = True }
        state := Idle
        txSCL := 1
        txSDA := 1
      else do
        state := StartSDA
        savedAddr := addrReg
        savedData := if savedAddr[0:0] == 1 -- R/!W
                     then 0 -- R
                     else dataReg -- !W
        txSCL := 1
        txSDA := 0
    "StartSDA": when StartSDA <- state ==> do
      state := SendAddrBitSDA 7
      txSCL := 0
      txSDA := 0
    "SendAddrBitSDA": when SendAddrBitSDA n <- state ==> do
      let bit = savedAddr[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 := 1
    "GetAddrAckRaiseSCL": when GetAddrAckRaiseSCL <- state ==> do
      state := GetAddrAckReadSDA
      txSCL := 1
      txSDA := 1
    "GetAddrAckReadSDA": when GetAddrAckReadSDA <- state ==> do
      statusReg := statusReg { addrAckBit = unpack rxSDA }
      state := if rxSDA == 1 -- NACK
               then TODO
               else if savedAddr[0:0] == 0 -- R/!W
               then WriteLowerSCL 1 7 -- !W
               else ReadLowerSCL 7 1 -- R
      txSCL := 1
      txSDA := 1
    "WriteLowerSCL": when WriteLowerSCL bit n <- state ==> do
      state := WriteWriteSDA n
      txSCL := 0
      txSDA := bit
    "WriteWriteSDA": when WriteWriteSDA n <- state ==> do
      let bit = savedData[n:n]
      state := WriteRaiseSCL bit n 1
      txSCL := 0
      txSDA := bit
    "WriteRaiseSCL": when WriteRaiseSCL bit n time <- state ==> do
      state := if time == 1
               then WriteRaiseSCL bit n (time - 1)
               else if n == 0
               then WriteAckLowerSCL bit
               else WriteLowerSCL bit (n - 1)
      txSCL := 1
      txSDA := bit
    "WriteAckLowerSCL": when WriteAckLowerSCL bit <- state ==> do
      state := WriteAckRaiseSDA
      txSCL := 0
      txSDA := bit
    "WriteAckRaiseSDA": when WriteAckRaiseSDA <- state ==> do
      state := WriteAckRaiseSCL
      txSCL := 0
      txSDA := 1
    "WriteAckRaiseSCL": when WriteAckRaiseSCL <- state ==> do
      state := WriteAckReadSDA
      txSCL := 1
      txSDA := 1
    "WriteAckReadSDA": when WriteAckReadSDA <- state ==> do
      statusReg := statusReg { ready = True; dataAckBit = unpack rxSDA }
      state := if rxSDA == 1 -- NACK
               then StopLowerSCL
               else WriteAckLowerSCL2
      txSCL := 1
      txSDA := 1
    "WriteAckLowerSCL2": when WriteAckLowerSCL2 <- state ==> do
      if not statusReg.ready && addrReg == savedAddr then do
        state := WriteWriteSDA 7
        savedAddr := addrReg
        savedData := if savedAddr[0:0] == 1 -- R/!W
                     then 0 -- R
                     else dataReg -- !W
      else do
        state := StopLowerSDA
      txSCL := 0
      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
      savedData := savedData [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.dataAckBit
      statusReg := statusReg { ready = True }
      dataReg := savedData
      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 if bit == 0
               then ReadLowerSCL 7 1 -- ACK
               else StopLowerSCL -- NACK
      txSCL := 1
      txSDA := bit
    "StopLowerSCL": when StopLowerSCL <- state ==> do
      state := StopLowerSDA
      txSCL := 0
      txSDA := 1
    "StopLowerSDA": when StopLowerSDA <- state ==> do
      state := StopRaiseSCL
      txSCL := 0
      txSDA := 0
    "StopRaiseSCL": when StopRaiseSCL <- state ==> do
      state := StopRaiseSDA
      txSCL := 1
      txSDA := 0
    "StopRaiseSDA": when StopRaiseSDA <- state ==> do
      state := Idle
      statusReg := statusReg { busIdle = True }
      txSCL := 1
      txSDA := 1
  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
    { ready = True
    ; busIdle = True
    ; addrAckBit = False
    ; dataAckBit = False
    ; arbitrationLost = False
    ; rsvd = 0
    })
  mkI2C' rxSCL rxSDA txSCL txSDA addrReg dataReg statusReg

  interface I2C
    txSCL = txSCL
    txSDA = txSDA
    addrRegGet = addrReg
    addrRegPut value = addrReg := value
    dataRegGet = dataReg
    dataRegPut value = dataReg := value
    statusRegGet = statusReg
    statusRegPut value = statusReg := value

{-
-- | Returns an I²C interface that runs on a clock derived from the current
-- clock divided by `divisor`. This should run at four times the rate of the
-- I²C bus's clock rate.
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 :: SyncPulseIfc <- mkSyncPulseToCC clock.slowClock reset
  txSDASync :: SyncPulseIfc <- mkSyncPulseToCC clock.slowClock reset

  addrReg <- mkReg 0
  dataReg <- mkReg 0
  statusReg <- mkReg (I2CStatus
    { ready = True
    ; busIdle = True
    ; addrAckBit = False
    ; dataAckBit = False
    ; arbitrationLost = False
    ; rsvd = 0
    })

  txSCL <- mkWire
  txSDA <- mkWire
  changeSpecialWires (Just clock.slowClock) (Just reset) Nothing $ module
    mkI2C' rxSCL rxSDA txSCL txSDA addrReg dataReg statusReg
  rules
    when unpack txSCL ==> txSCLSync.send
    when unpack txSDA ==> txSDASync.send

  interface I2C
    txSCL = pack txSCLSync.pulse
    txSDA = pack txSDASync.pulse
    addrRegGet = 0
    addrRegPut value = undefined
    dataRegGet = 0
    dataRegPut value = undefined
    statusRegGet = undefined
    statusRegPut value = undefined
-}

-- vim: set ft=haskell :