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;