blob: 182236d2ea04f965fe6cf9b15b0f667c770ddea2 (
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
158
|
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
rules
"uart_tx_update_state": 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
-- | 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) <- mkUGSizedFIFOF bufferSize
state :: Reg RxState <- mkReg Idle
debugBit :: Reg (Bit 1) <- mkReg 1
interface RxUart
pin bit = when_ baudClock.clk $ do
nextState :: RxState <- case state of
Idle -> do
debugBit := bit
if bit == 0 then
return (Data 0 0)
else
return Idle
Data hi n -> do
debugBit := bit
-- // Timing estimate: 1000010.53 ns (0.00 MHz)
-- let b :: Bit 8 = bit ++ hi[7:1]
let b :: Bit 8 = hi[7:1] ++ bit
if n == 7 then do
when_ fifo.notFull $ do
fifo.enq b
return Idle
else
return (Data b (n + 1))
state := nextState
recv = interface Get
get = do
let byte = fifo.first
fifo.deq
return byte
when fifo.notEmpty
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 :
|
