blob: cbe64548d4e1adf53601da9f36a2a4302b1e3192 (
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
|
package App where
import BRAM
import GetPut
interface App =
led :: Bit 1
hexToBits :: Bit 8 -> Maybe (Bit 4)
hexToBits 0x30 = Just 0b0000
hexToBits 0x31 = Just 0b0001
hexToBits 0x32 = Just 0b0010
hexToBits 0x33 = Just 0b0011
hexToBits 0x34 = Just 0b0100
hexToBits 0x35 = Just 0b0101
hexToBits 0x36 = Just 0b0110
hexToBits 0x37 = Just 0b0111
hexToBits 0x38 = Just 0b1000
hexToBits 0x39 = Just 0b1001
hexToBits 0x41 = Just 0b1010
hexToBits 0x42 = Just 0b1011
hexToBits 0x43 = Just 0b1100
hexToBits 0x44 = Just 0b1101
hexToBits 0x45 = Just 0b1110
hexToBits 0x46 = Just 0b1111
hexToBits 0x61 = Just 0b1010
hexToBits 0x62 = Just 0b1011
hexToBits 0x63 = Just 0b1100
hexToBits 0x64 = Just 0b1101
hexToBits 0x65 = Just 0b1110
hexToBits 0x66 = Just 0b1111
hexToBits _ = Nothing
bitsToHex :: Bit 4 -> Bit 8
bitsToHex b =
if b < 10
then 0x30 + (0 ++ b)
else 0x41 + (0 ++ (b - 10))
data State
= WaitingForAddrHiNybble
| WaitingForAddrLoNybble (Bit 4)
| WaitingForRW (Bit 8)
| WaitingForRead
| WritingData3 (Bit 12)
| WritingData2 (Bit 8)
| WritingData1 (Bit 4)
| WritingCR
| WritingLF
| WaitingForValueNybble1 (Bit 8)
| WaitingForValueNybble2 (Bit 8) (Bit 4)
| WaitingForValueNybble3 (Bit 8) (Bit 8)
| WaitingForValueNybble4 (Bit 8) (Bit 12)
deriving (Bits)
mkApp :: Get (Bit 8) -> Put (Bit 8) -> Module App
mkApp uartRecv uartSend =
module
led :: Reg (Bit 1) <- mkReg 1
state :: Reg State <- mkReg WaitingForAddrHiNybble
ebr :: BRAM2Port (Bit 8) (Bit 16) <- mkBRAM2Server
(defaultValue { memorySize = 256 })
rules
"get_hi_nybble": when WaitingForAddrHiNybble <- state ==> do
byte <- uartRecv.get
case hexToBits byte of
Just hiNybble -> do
uartSend.put byte
state := WaitingForAddrLoNybble hiNybble
Nothing -> return ()
"get_lo_nybble": when WaitingForAddrLoNybble hiNybble <- state ==> do
byte <- uartRecv.get
case hexToBits byte of
Just loNybble -> do
uartSend.put byte
state := WaitingForRW (hiNybble ++ loNybble)
led := 0
Nothing -> return ()
"get_rw": when WaitingForRW addr <- state ==> do
byte <- uartRecv.get
case byte of
0x72 {- r -} -> do
uartSend.put byte
ebr.portA.request.put (BRAMRequest
{ write = False
; responseOnWrite = _
; address = addr
; datain = _
})
state := WaitingForRead
0x77 {- w -} -> do
uartSend.put byte
state := WaitingForValueNybble1 addr
_ -> return ()
"get_read": when WaitingForRead <- state ==> do
resp <- ebr.portA.response.get
uartSend.put (bitsToHex resp[15:12])
state := WritingData3 resp[11:0]
"write_data_3": when WritingData3 resp <- state ==> do
uartSend.put (bitsToHex resp[11:8])
state := WritingData2 resp[7:0]
"write_data_2": when WritingData2 resp <- state ==> do
uartSend.put (bitsToHex resp[7:4])
state := WritingData1 resp[3:0]
"write_data_1": when WritingData1 resp <- state ==> do
uartSend.put (bitsToHex resp)
state := WritingCR
"write_cr": when WritingCR <- state ==> do
uartSend.put 0x0d
state := WritingLF
"write_lf": when WritingLF <- state ==> do
uartSend.put 0x0a
state := WaitingForAddrHiNybble
led := 1
"get_nybble_1": when WaitingForValueNybble1 addr <- state ==> do
byte <- uartRecv.get
case hexToBits byte of
Just nybble -> do
uartSend.put byte
state := WaitingForValueNybble2 addr nybble
Nothing -> return ()
"get_nybble_2": when WaitingForValueNybble2 addr value <- state ==> do
byte <- uartRecv.get
case hexToBits byte of
Just nybble -> do
uartSend.put byte
state := WaitingForValueNybble3 addr (value ++ nybble)
Nothing -> return ()
"get_nybble_3": when WaitingForValueNybble3 addr value <- state ==> do
byte <- uartRecv.get
case hexToBits byte of
Just nybble -> do
uartSend.put byte
state := WaitingForValueNybble4 addr (value ++ nybble)
Nothing -> return ()
"get_nybble_4": when WaitingForValueNybble4 addr value <- state ==> do
byte <- uartRecv.get
case hexToBits byte of
Just nybble -> do
uartSend.put byte
ebr.portA.request.put (BRAMRequest
{ write = True
; responseOnWrite = False
; address = addr
; datain = value ++ nybble
})
state := WritingCR
Nothing -> return ()
interface App
led = led
-- vim: set ft=haskell :
|
