blob: adf77d4aa6fadc07de7cb47079b11a8738d0720f (
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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
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
-- | 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's transmit buffer.
send :: Put (Bit 8)
mkTxUart :: Clock -> Integer -> Module TxUart
mkTxUart baudClock bufferSize =
module
fifo :: FIFOF (Bit 8) <- mkSizedFIFOF bufferSize
state :: Reg TxState <- mkReg Idle
pin :: Reg (Bit 1) <- mkReg 1
rules
"uart_tx": when baudClock.clk
rules
"uart_tx_idle": when Idle <- state ==> do
pin := 1
b <- (toGet fifo).get
state := Start b
"uart_tx_start": when Start b <- state ==> do
pin := 0
state := Data b 7
"uart_tx_data": when Data b n <- state ==> do
pin := b[0:0]
if n == 0 then
state := Stop
else
state := Data (b >> 1) (n - 1)
"uart_tx_stop": when Stop <- state ==> do
pin := 1
state := Idle
interface TxUart
pin = pin
send = toPut fifo
-- | The state of the RX side of the UART.
data RxState
= -- | The UART is not currently receiving anything. May transition to
-- 'Data 0 0' when the start bit is received.
Idle
| -- | In the 'Data _ n' state, the UART has received the start bit and 'n'
-- data bits, and is about to receive more data bits. 'Data _ n'
-- transitions to 'Data _ (n + 1)' by receiving a data bit. 'Data b 7'
-- transitions to 'Idle' by receving the last data bit.
Data (Bit 8) (Bit 3)
deriving (Bits)
-- | The RX side of the UART.
interface RxUart =
-- | The RX pin.
pin :: Bit 1 -> Action
-- | Reads a byte from the UART's receive buffer.
recv :: Get (Bit 8)
debugBit :: Bit 1
mkRxUart :: Clock -> Integer -> Module RxUart
mkRxUart baudClock bufferSize =
module
fifo :: FIFOF (Bit 8) <- mkGSizedFIFOF True False bufferSize
state :: Reg RxState <- mkReg Idle
pin :: Wire (Bit 1) <- mkWire
debugBit :: Reg (Bit 1) <- mkReg 1
rules
"uart_rx": when baudClock.clk
rules
"uart_rx_idle": when Idle <- state ==>
if pin == 0 then do
debugBit := 0
state := Data 0 0
else
state := Idle
"uart_rx_data": when Data oldBits n <- state ==> do
let newBits = pin ++ oldBits[6:0]
if n == 7 then do
fifo.enq newBits
debugBit := 1
state := Idle
else
state := Data newBits (n + 1)
interface RxUart
pin bit = pin := bit
recv = toGet fifo
debugBit = debugBit
-- | An 8n1 UART.
interface Uart =
-- | The RX pin.
rxPin :: Bit 1 -> Action
-- | The TX pin.
txPin :: Bit 1
-- | Reads a byte from the UART's receive buffer.
recv :: Get (Bit 8)
-- | Writes a byte to the UART's transmit buffer.
send :: Put (Bit 8)
debugBit :: Bit 1
mkUart :: Integer -> Module Uart
mkUart baudDivisor =
module
baudClock <- mkDivider baudDivisor
rx <- mkRxUart baudClock 8
tx <- mkTxUart baudClock 8
interface Uart
rxPin = rx.pin
txPin = tx.pin
recv = rx.recv
send = tx.send
debugBit = rx.debugBit
-- vim: set ft=haskell :
|
