/
mmq-tools.fs
214 lines (184 loc) · 5.85 KB
/
mmq-tools.fs
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
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
include slip-esc.fs
\ include stringbuf.fs
\ cornerstone <<<stringbuf-lib>>>
\ resembles
\ https://github.com/hexagon5un/hackaday_esp-14_power_meter/blob/master/forth_system/messages.fs
\ line 59:
: decbyte #10 /mod #10 /mod .digit rot .digit rot .digit swap ;
\ ah I see ... line 63
\ |-data-|
\ 3 0 49 53 57 0 2 0 3 0 0 0
create MQTT.msg.val.tplt
hex
$0c c,
bytes," 03 00 23 23 23 00 " \ data
bytes," 02 00 03 00 00 00 " \ len of data
calign
myalign
\ patch value as 3 dec digits into string, given by address
: patch-value ( value address -- )
swap
#10 /mod swap .digit 2 pick 2+ c!
#10 /mod swap .digit 2 pick 1+ c!
.digit swap c!
;
\ https://github.com/hexagon5un/hackaday_esp-14_power_meter/blob/master/forth_system/crc.fs
\ CRC accumulator
\ this is our companion
\ https://github.com/jeelabs/esp-link/blob/fe4f565fe83f05e402cc8d8ca3ceefbc39692a1f/serial/crc16.c
\ it uses shortint, so we mask intermediates to 16 bit
: crc+ ( old_running_sum new_byte -- new_running_sum )
xor
dup 8 rshift swap 8 lshift or
$ffff and
dup $ff00 and 4 lshift xor
$ffff and
dup 8 rshift 4 rshift xor
dup $ff00 and 5 rshift xor
;
\ does not belong here
: sb-byte-app stringbuf-byte-app ;
: crc-assemble ( first afterlast -- hsb lsb )
0 -rot swap
DO I c@ crc+ LOOP
\ dup cr ." CRC: " hex. cr
dup $00ff and swap $ff00 and 8 rshift
swap
;
\ assemble MQTT message, enclosed in SLIP frame
: MQTT-assemble ( buf-addr top-adr top-len msg-adr msg-len --)
4 pick
ESPL-sync memstr-counted 2 pick stringbuf-write
SLIP_END over sb-byte-app
dup stringbuf-wheretowrite >r
MQTT-preamble memstr-counted 2 pick stringbuf-write
4 roll 4 roll rot stringbuf-write
2 pick stringbuf-write
MQTT-qos.and.retain memstr-counted 2 pick stringbuf-write
dup stringbuf-wheretowrite
r> swap
crc-assemble
2 pick sb-byte-app
over sb-byte-app
SLIP_END swap sb-byte-app
;
\ enclose arbitrary string into slip frame ( <END> <message> <CRC> <END> )
: SLIP-assemble ( buf-addr msg-adr msg-len --)
rot >r
r@ stringbuf-clear
\ ( msg-adr msg-len -- ... ) R: ( buf-addr -- ... )
ESPL-sync memstr-counted r@ stringbuf-write
SLIP_END r@ sb-byte-app
r@ dup stringbuf-wheretowrite >r
\ ( msg-adr msg-len buf-addr -- ... ) R: ( buf-addr crc-start -- ... )
stringbuf-write
1 rpick stringbuf-wheretowrite
\ ( crc-end -- ) R: ( buf-addr crc-start -- )
r> swap
crc-assemble
r@ sb-byte-app
r@ sb-byte-app
SLIP_END r> sb-byte-app
;
\ send slip for arbitrary string over the line,
\ use escaped emit and unescaped delimiters, add crc16
: SLIP-send ( msg-adr msg-len --)
SLIP_END sys-emit
over + swap 0 -rot ( 0 msg-adr+len msg-adr --)
DO
I c@ dup slip-emit crc+
LOOP
( crc -- )
dup $00ff and swap $ff00 and 8 rshift
swap ( crc-lsb crc-hsb --)
slip-emit slip-emit
SLIP_END sys-emit
;
\ add a string in adr / len format to a buffer, prepending 16 bit little-endian counter and 16 bit padding
: MQTT-stringadd ( buf-addr string-adr string-len -- )
dup >r
rot >r
\ ( string-adr string-len -- ... ) R: ( string-len buf-addr -- ... )
\ append len in 16 bit little endian
dup littleendian16
r@ stringbuf-byte-app
r@ stringbuf-byte-app
\ append string itself
r@ stringbuf-write
r> r>
\ ( buf-addr string-len -- ... ) R: ( -- )
\ 1 and IF 0 swap stringbuf-byte-app ELSE drop THEN
\ pad to 32 bit = 4 bytes
BEGIN dup $3 and WHILE over 0 swap stringbuf-byte-app 1+ REPEAT
drop drop
;
\ we want to have a topic with
\ 16 bit litte endian header
\ topic and dest concatenated
\ 0x00 padded to 16 bit
\ MQTT-topic ( buf-addr top-adr top-len msg-adr msg-len --)
: MQTT-topic ( buf-addr prefix-adr prefix-len subtop-adr subtop-len -- )
2 pick over + 1+ >r
4 roll >r
2swap
\ ( subtop-adr subtop-len prefix-adr prefix-len -- ... ) R: ( string-len buf-addr -- ... )
\ append len in 16 bit little endian
1 rpick littleendian16
r@ stringbuf-byte-app
r@ stringbuf-byte-app
\ append prefix/subtopic
r@ stringbuf-write
$2F r@ stringbuf-byte-app
r@ stringbuf-write
\ pad to even and balance stacks
r> r>
\ ( buf-addr string-len -- ... ) R: ( -- )
\ 1 and IF 0 swap stringbuf-byte-app ELSE drop THEN
\ pad to 32 bit = 4 bytes
BEGIN dup $3 and WHILE over 0 swap stringbuf-byte-app 1+ REPEAT
drop drop
;
\ clear buffer and add generic mqtt pramble
: MQTT-init ( buf-adr -- )
dup stringbuf-clear
MQTT-preamble memstr-counted rot stringbuf-write
;
\ add a number of 0 ... 4 bytes, with 2 bytes length + 4 byte data field , - no sanity check
: MQTT-numberadd ( buf-addr number valid-bytes -- )
rot >r
r@ stringbuf-byte-app
0 r@ stringbuf-byte-app
( number -- )
$100 /mod swap r@ stringbuf-byte-app
$100 /mod swap r@ stringbuf-byte-app
$100 /mod swap r@ stringbuf-byte-app
r> stringbuf-byte-app
;
\ add data string and additional data lengt field, both 4-padded
: MQTT-dataadd ( buf-addr string-addr len -- )
swap 2 pick swap 2 pick
( buf-addr len buf-addr string-addr len -- )
MQTT-stringadd
( buf-addr len -- )
\ reply length in 16 bit data_len field
2 MQTT-numberadd
;
\ add MQTT header with command, counter of additional data fields and some value . fixed length of 8 bytes
: MQTT-cmdadd ( buf-addr cmd argc value -- )
3 roll >r
rot \ ( argc value cmd -- ) R: ( buf-addr -- )
r@ stringbuf-byte-app
0 r@ stringbuf-byte-app
swap
r@ stringbuf-byte-app
0 r@ stringbuf-byte-app
\ ( value -- ) R: ( buf-addr -- )
$100 /mod swap r@ stringbuf-byte-app
$100 /mod swap r@ stringbuf-byte-app
$100 /mod swap r@ stringbuf-byte-app
r> stringbuf-byte-app
;
\ static string appenders ( buf-adr -- )
: MQTT-append-on MQTT-msg.on memstr-counted rot stringbuf-write ;
: MQTT-append-off MQTT-msg.off memstr-counted rot stringbuf-write ;
: MQTT-append-q.a.r MQTT-qos.and.retain memstr-counted rot stringbuf-write ;