blob: 4b66af584bf638c895f95aca255b006f8c51113c (
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
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
-- | A simple I²C controller.
package I2C where
import Clocks
import GetPut
struct I2CStatus =
{ -- | Whether a read or write is in progress. Writing to this bit does not
-- affect the internal state of the I²C controller.
busy :: Bool
; -- | Whether the bus is idle. Usually, software will want to use the `busy`
-- bit instead to determine when to send new commands; the `busIdle` bit is
-- only set to `True` after the STOP condition. 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.
addrAck :: Bool
; -- | The last ACK bit we received from sending an address, or the next ACK
-- bit we'll send.
dataAck :: 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 2
}
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
-- | The address register, which contains the address in the high 7 bits and
-- the R/!W bit in the low bit.
addrReg :: Reg (Bit 8)
-- | 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.
dataReg :: Reg (Bit 8)
-- | The status register.
statusReg :: Reg I2CStatus
-- | Attempts to trigger a read or write. If one is already in progress (as
-- indicated by the `busy` status bit being True), does nothing.
trigger :: Action
-- | 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 -> PulseWire -> Module ()
mkI2C' rxSCL rxSDA txSCL txSDA addrReg dataReg statusReg trigger = module
n <- mkReg 0
rules
"output txSCL": when True ==> txSCL := n
"flip": when True ==> n := (n + 1)[0:0]
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
{ busy = False
; busIdle = False
; addrAck = False
; dataAck = False
; arbitrationLost = False
; rsvd = 0
})
trigger <- mkPulseWire
mkI2C' rxSCL rxSDA txSCL txSDA addrReg dataReg statusReg trigger
interface I2C
txSCL = txSCL
txSDA = txSDA
addrReg = addrReg
dataReg = dataReg
statusReg = statusReg
trigger = trigger.send
{-
mkI2C' :: Bit 1 -> Bit 1 -> Reg (Bit 1) -> Reg (Bit 1) ->
SyncFIFOIfc I2CCommand -> SyncFIFOIfc I2CResult -> Module I2C
mkI2C' rxSCL rxSDA txSCL txSDA sendFIFO recvFIFO = module
state :: Reg (Bit 1) <- mkReg 0
rules
"output txSCL": when True ==> txSCL := state
"flip state": when True ==> state := 1 - state
{-
state :: Reg State <- mkReg Idle
rules
when True ==> do
$display "state: " (fshow state)
when Idle <- state
rules
when not sendFIFO.notEmpty ==> do
$display "Staying idle"
-- Keep idling.
txSCL := 1
txSDA := 1
when sendFIFO.notEmpty ==> do
let cmd = sendFIFO.first
sendFIFO.deq
$display "Got a command: " (fshow cmd)
-- See if we can get the bus.
case rxSDA of
0 -> do
-- We lost arbitration -- someone else is driving the bus low.
recvFIFO.enq ArbitrationLost
1 -> do
-- Drive SDA low and wait.
txSDA := 0
state := LowerSCLBeforeAddrAndRWBit 7 cmd
when LowerSCLBeforeAddrAndRWBit i cmd <- state ==> do
-- Drive SCL low.
txSCL := 0
-- Prepare to start writing the address.
state := WriteAddrAndRWBit i cmd
when WriteAddrAndRWBit i cmd <- state ==> do
-- Keep SCL low while writing the data bit.
txSDA := (getAddrAndRW cmd)[i:i]
-- Next, we'll raise the clock for a cycle.
state := RaiseSCLAfterAddrAndRWBit i cmd
when RaiseSCLAfterAddrAndRWBit i cmd <- state ==> do
-- Keep SDA the same while raising SCL.
txSCL := 1
state := WaitAfterAddrAndRWBit i cmd
when WaitAfterAddrAndRWBit i cmd <- state ==> do
if i == 0 then
state := TODO
else
state := LowerSCLBeforeAddrAndRWBit (i - 1) cmd
when TODO <- state ==> do
state := TODO
-}
interface I2C
txSCL = txSCL
txSDA = txSDA
recv = toGet recvFIFO
send = toPut sendFIFO
-- | Returns an I²C interface with FIFOs that runs on a divided clock. Note
-- that the clock rate should be twice the bus speed -- to run the bus at
-- 100kbit/s (normal mode), the clock should run at 200kHz.
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 :: Reg (Bit 1) <- mkSyncRegToCC 1 clock.slowClock reset
txSDASync :: Reg (Bit 1) <- mkSyncRegToCC 1 clock.slowClock reset
recvFIFO :: SyncFIFOIfc I2CResult <- mkSyncFIFOToCC 16 clock.slowClock reset
sendFIFO :: SyncFIFOIfc I2CCommand <- mkSyncFIFOFromCC 16 clock.slowClock
rules
"copy rxSCL and rxSDA": when True ==> do
rxSCLSync.send rxSCL
rxSDASync.send rxSDA
changeSpecialWires (Just clock.slowClock) (Just reset) Nothing $ module
mkI2C' rxSCLSync.read rxSDASync.read txSCLSync txSDASync sendFIFO recvFIFO
interface I2C
txSCL = txSCLSync
txSDA = txSDASync
recv = toGet recvFIFO
send = toPut sendFIFO
-}
-- vim: set ft=haskell :
|
