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 :
|