aboutsummaryrefslogtreecommitdiff
path: root/src/Uart.bs
blob: 0a3e82b395b5d4b6c560145104e0a045e8631b23 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
package Uart where

import FIFOF
import GetPut
import Util

interface Clock =
  clk :: Bool

mkDivider :: Integer -> Module Clock
mkDivider divisor =
  module
    count :: Reg (Bit 32) <- mkReg 0

    rules
      "increment_divider": when True ==> do
        if count == fromInteger (divisor - 1) then do
          count := 0
        else
          count := count + 1

    interface Clock
      clk = count == 0

-- | A shift register.
interface ShiftRegister item numItems =
  -- | Shifts an item into the shift register.
  put :: Put item
  -- | Shifts an item out of the shift register.
  get :: Get item
  -- | The number of items currently in the shift register.
  size :: Bit (TLog numItems)

-- | Creates a shift register.
mkShiftRegister :: (Bits item itemSize) => Module (ShiftRegister item numItems)
mkShiftRegister =
  module
    size :: Reg (Bit (TLog numItems)) <- mkReg 0
    buffer :: Reg (Bit (TMul itemSize numItems)) <- mkReg 0

    interface ShiftRegister
      put = interface Put
              put _ = return ()
      get = interface Get
              get = return (unpack 0) when False
      size = size

-- | The state of the TX side of the UART.
data TxState
  = -- | The UART is not currently sending anything. May transition to
    -- 'Start b' when ready to send 'b'.
    Idle
  | -- | The UART is about to send the start bit. 'Start b' transitions to
    -- 'Data b 7' by sending the start bit.
    Start (Bit 8)
  | -- | The UART is about to send a data bit. 'Data b n' transitions to
    -- 'Data (b >> 1) (n - 1)' by sending a data bit. 'Data b 0' transitions to
    -- 'Stop' by sending the last data bit.
    Data (Bit 8) (Bit 3)
  | -- | The UART is about to send the stop bit. Transitions to 'Idle'.
    Stop
  deriving (Bits)

-- | The TX side of the UART.
interface TxUart =
  -- | The TX pin.
  pin :: Bit 1
  -- Writes a byte to the UART.
  send :: Put (Bit 8)

mkTxUart :: Clock -> Integer -> Module TxUart
mkTxUart baudClock bufferSize =
  module
    fifo :: FIFOF (Bit 8) <- mkSizedFIFOF bufferSize
    state <- mkReg Idle
    rules
      "uart_tx_send": when baudClock.clk ==> do
        case state of
          Idle -> do
            b <- (toGet fifo).get
            state := Start b
          Start b -> do
            state := Data b 7
          Data _ 0 -> do
            state := Stop
          Data b n -> do
            state := Data (b >> 1) (n - 1)
          Stop -> do
            state := Idle
    interface TxUart
      pin = case state of
              Idle -> 1
              Start _ -> 0
              Data b _ -> b[0:0]
              Stop -> 1
      send = toPut fifo

-- An 8n1 UART.
interface Uart =
  -- The RX pin.
  rxPin :: Bit 1 -> Action
  -- The TX pin.
  txPin :: Bit 1

  -- Reads a byte from the UART.
  recv :: Get (Bit 8)
  -- Writes a byte to the UART.
  send :: Put (Bit 8)

mkUart :: Integer -> Module Uart
mkUart baudDivisor =
  module
    baudClock <- mkDivider baudDivisor
    tx <- mkTxUart baudClock 1

    interface Uart
      rxPin _bit = when_ baudClock.clk $ do
        return () -- TODO
      txPin = tx.pin

      recv = interface Get
               get = return 0 when False
      send = tx.send

-- vim: set ft=haskell :