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
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
|
PACKET net hardware
(************************************************************************)
(**** Netzprotokoll Anpassung *)
(**** Komplette Version mit BUS Anpassung 10.06.87 *)
(**** mit I/0 Controls fuer integrierte Karten *)
(**** Verschiedene Nutztelegrammgrössen *)
(**** Version: GMD 2.0 A.Reichpietsch *)
(************************************************************************)
DEFINES
blockin,
blockout,
set net mode,
net address,
mode text,
data length,
data length via node,
decode packet length,
next packet start,
flush buffers,
transmit header,
transmit trailer,
version,
reset box,
max mode,
net mode:
LET eak prefix laenge = 6,
packet length before stx = 14 (*eth header =14 *),
maximum mode nr = 12,
stx = ""2"",
niltext = "",
null = "0",
hex null = ""0"",
blank = " ",
eak prefix = ""0""0""0""0"",
typefield = "EU",
prefix adresse = "BOX",
second prefix adresse = ""0"BOX",
second address type bound = 90;
INT CONST data length via node :: 64;
TEXT CONST version :: "GMD 2.0 (10.6.87)";
TEXT VAR own address;
INT VAR paketlaenge, eumel paket laenge, mode, rahmenlaenge, actual data length;
BOOL PROC blockin (DATASPACE VAR ds, INT CONST seite, abstand, laenge):
INT VAR hilfslaenge:=laenge, code:= abstand+laenge+512;
REAL VAR time out := clock (1) + 10.0;
REP
blockin (ds,seite,code-hilfslaenge, hilfslaenge, hilfslaenge);
UNTIL hilfslaenge = 0 OR clock (1) > time out PER ;
IF hilfslaenge <> 0
THEN report ("blockin abbruch, fehlende Zeichen: "+text(hilfslaenge));
FI;
hilfslaenge = 0
END PROC blockin;
PROC blockout (DATASPACE CONST ds, INT CONST seite, abstand, laenge):
INT VAR hilfslaenge:=laenge, code:= abstand+laenge+512;
REP
blockout (ds,seite,code-hilfslaenge, hilfslaenge, hilfslaenge);
UNTIL hilfslaenge = 0 PER
END PROC blockout;
PROC set net mode (INT CONST new mode):
mode := new mode ;
own address := net address (station(myself));
SELECT mode OF
CASE 1,3 : set data length (64);
CASE 2 : std framelength; set data length (64)
CASE 4,6 : set data length (128)
CASE 5 : std framelength; set data length (128)
CASE 7,9 : set data length (256)
CASE 8 : std framelength; set data length (256)
CASE 10,12 : set data length (512)
CASE 11 : std framelength; set data length (512);
OTHERWISE
END SELECT.
std framelength:
rahmenlaenge := eak prefix laenge + packet length before stx.
ENDPROC set net mode;
INT PROC max mode:
maximum mode nr
ENDPROC max mode;
INT PROC net mode:
mode
ENDPROC net mode;
TEXT PROC mode text:
mode text (mode)
ENDPROC mode text;
TEXT PROC mode text (INT CONST act mode):
SELECT act mode OF
CASE 1: "Modus: (1) EUMEL-Netz 64 Byte"
CASE 2: "Modus: (2) ETHERNET via V.24 64 Byte"
CASE 3: "Modus: (3) ETHERNET integrated 64 Byte"
CASE 4: "Modus: (4) EUMEL-Netz 128 Byte"
CASE 5: "Modus: (5) ETHERNET via V.24 128 Byte"
CASE 6: "Modus: (6) ETHERNET integrated 128 Byte"
CASE 7: "MODUS: (7) EUMEL-Netz 256 Byte"
CASE 8: "MODUS: (8) ETHERNET via V.24 256 Byte"
CASE 9: "MODUS: (9) ETHERNET integrated 256 Byte"
CASE 10: "MODUS: (10) EUMEL-Netz 512 Byte"
CASE 11: "MODUS: (11) ETHERNET via V.24 512 Byte"
CASE 12: "MODUS: (12) ETHERNET integrated 512 Byte"
OTHERWISE errorstop ("Modus " + text(mode) + " gibt es nicht");
error message
END SELECT
ENDPROC mode text;
PROC set data length (INT CONST new data length):
actual data length := new data length
ENDPROC set data length;
INT PROC data length:
actual data length
ENDPROC data length;
PROC reset box (INT CONST net mode):
SELECT net mode OF
CASE 1,4,7,10 : eumel net box reset
CASE 2,5,8,11 : eak reset
OTHERWISE controler reset
END SELECT.
eumel net box reset:
out (90*""4"");
REP UNTIL incharety (1) = niltext PER.
eak reset:
out ("E0"13"E0"13"").
controler reset:
INT VAR dummy;
control (-35, 0,0,dummy);
control (22,0,0,dummy).
ENDPROC reset box;
PROC remove frame
(TEXT VAR erstes zeichen vom eumel telegramm, BOOL VAR kein telegramm da):
kein telegramm da := FALSE;
SELECT net mode OF
CASE 2,5,8,11 : remove ethernet frame
(erstes zeichen vom eumel telegramm, kein telegramm da)
OTHERWISE
END SELECT;
ENDPROC remove frame;
PROC remove ethernet frame (TEXT VAR string, BOOL VAR schrott):
TEXT VAR speicher, t;
INT VAR lg;
t := string;
speicher := niltext;
WHILE kein stx da REP
lies zeichen ein;
teste auf timeout;
UNTIL textoverflow PER;
melde eingelesene zeichen.
lies zeichen ein:
speicher CAT t;
t := incharety (1).
teste auf timeout:
IF t = niltext THEN schrott := (speicher <> niltext)
CAND not only fill characters;
string := niltext;
LEAVE remove ethernet frame
FI.
not only fill characters:
pos (speicher, ""1"", ""254"",1) <> 0.
kein stx da :
t <> stx.
textoverflow:
length (speicher) > 1000.
melde eingelesene zeichen:
IF kein stx da
THEN kein eumeltelegrammanfang
ELSE untersuche ethernet header
FI.
kein eumeltelegrammanfang:
report ("skipped ,fehlendes <STX> ,letztes Zeichen:", t);
string := t;
schrott := TRUE.
untersuche ethernet header:
string := t;
IF ethernet header inkorrekt
THEN melde fehler
FI.
ethernet header inkorrekt:
lg := length (speicher);
packet zu kurz COR adresse falsch.
packet zu kurz:
lg < packet length before stx.
adresse falsch:
INT VAR adrpos := pos (speicher, own address);
zieladresse falsch COR adresse nicht an der richtigen pos .
zieladresse falsch:
adrpos < 1.
adresse nicht an der richtigen pos:
adrpos <> lg - packet length before stx + 1.
melde fehler:
report ("Header inkorrekt eingelesen: ", speicher + t);
string := t;
schrott := TRUE.
ENDPROC remove ethernet frame;
TEXT PROC next packet start:
TEXT VAR t := niltext;
BOOL VAR schrott := FALSE;
t:= incharety (1);
IF t = niltext THEN LEAVE next packet start WITH niltext
ELSE remove frame (t, schrott)
FI;
IF schrott THEN no stx or niltext
ELSE t
FI.
no stx or niltext:
IF t = stx THEN "2"
ELIF t = niltext THEN "0"
ELSE t
FI.
ENDPROC next packet start;
PROC flush buffers:
REP UNTIL incharety (5) = niltext PER;
report ("buffers flushed");
ENDPROC flush buffers;
PROC transmit header (DATASPACE CONST w):
BOUND INT VAR laengeninformation := w;
eumel paket laenge := laengeninformation ;
decode packet length (eumel paket laenge);
SELECT net mode OF
CASE 1,4,7,10 :
CASE 2,5,8,11 : eak und eth header senden (w)
OTHERWISE : telegrammanfang melden;
std ethernet header senden (w)
END SELECT;
ENDPROC transmit header;
PROC decode packet length (INT VAR decoded length):
decoded length DECR 2;
rotate (decoded length, 8);
IF decoded length < 96 THEN
ELIF decoded length < 128 THEN decoded length INCR 32
ELIF decoded length < 160 THEN decoded length INCR 128
ELIF decoded length < 192 THEN decoded length INCR 352
ELIF decoded length < 224 THEN decoded length INCR 832
ELIF decoded length < 256 THEN decoded length INCR 1824
FI;
ENDPROC decode packet length;
PROC transmit trailer:
INT VAR dummy;
SELECT net mode OF
CASE 3,6,9,12 : control (21,0,0,dummy)
OTHERWISE
END SELECT.
ENDPROC transmit trailer;
PROC std ethernet header senden (DATASPACE CONST x):
TEXT VAR eth adresse, ethernet kopf := niltext;
INT VAR adresse;
BOUND STRUCT (INT head, zwischennummern) VAR header := x;
zieladresse holen;
zieladresse senden;
quelladresse senden;
typfeld senden;
ausgeben.
zieladresse holen:
adresse := header.zwischennummern AND 255;
eth adresse := net address (adresse).
zieladresse senden:
ethernetkopf CAT eth adresse.
quelladresse senden:
ethernetkopf CAT own address.
typfeld senden:
ethernetkopf CAT typefield.
ausgeben:
out (ethernetkopf).
ENDPROC std ethernet header senden;
PROC telegrammanfang melden:
INT VAR dummy;
control (20,eumel paket laenge + packet length before stx,0, dummy).
ENDPROC telegrammanfang melden;
PROC eak und eth header senden (DATASPACE CONST x):
TEXT VAR res:= niltext;
neue laenge berechnen;
eak kopf senden;
std ethernet header senden (x).
neue laenge berechnen:
paket laenge := rahmenlaenge + eumel paket laenge.
eak kopf senden:
res := code (paket laenge DIV 256);
res CAT (code (paket laenge AND 255));
res CAT eak prefix;
out(res).
ENDPROC eak und eth header senden;
TEXT PROC net address (INT CONST eumel address):
TEXT VAR res ;
INT VAR low byte;
SELECT mode OF
CASE 1,4,7,10 : eumel net address
OTHERWISE ethernet address
END SELECT.
eumel net address:
text(eumel address).
ethernet address:
IF second adress kind THEN second eth header
ELSE first eth header
FI;
res.
second adress kind:
eumel address = 34 COR
eumel address > second address type bound.
second eth header:
low byte := eumel address AND 255;
res := second prefix adresse + code (low byte);
res CAT hex null.
first eth header:
res := prefix adresse + text (eumel address, 3);
changeall (res, blank, null).
ENDPROC net address;
ENDPACKET net hardware;
|
