411 REFERENCE · Wikibooks
Oberon/ETH Oberon/PPPTools.Mod
Reference material by Wikibooks contributors. This retains its source identity and is not 411 news reporting.
(* ETH Oberon, Copyright 1990-2003 Computer Systems Institute, ETH Zurich, CH-8092 Zurich.
Refer to the license.txt file provided with this distribution. *)
MODULE PPPTools; (** non-portable *)
(* $VCS 1, Edgar.Schwarz@z.zgs.de, 28 Feb 99, 22:9:47 $
$Log$
$ 1, Edgar.Schwarz@z.zgs.de, 28 Feb 99, 22:9:47
version for PPP 1.0.0
*)
IMPORT
SYSTEM, PT := (*es*) NetBase, NetIP (*PacketTools*), Debug := PPPDebug;
CONST
GoodFCS = - 0F48H; (* 0F0B8H *)
InitialFCS = - 1H; (* 0FFFFH *)
VAR
FCSTable: ARRAY 256 OF INTEGER;
PROCEDURE XOR(a, b:INTEGER): INTEGER;
BEGIN RETURN SYSTEM.VAL(INTEGER, (SYSTEM.VAL(SET, LONG(a)) / SYSTEM.VAL(SET, LONG(b))))
END XOR;
(*es*) (* aktiviert *)
PROCEDURE FCS (VAR a: ARRAY OF CHAR; pos, len: INTEGER): INTEGER;
VAR code, i: INTEGER; (* we use 16 bit chksum *)
BEGIN
code := InitialFCS;
FOR i := pos TO pos+len-1 DO
code := XOR(SYSTEM.LSH(code, - 8), FCSTable[SYSTEM.VAL(INTEGER,
SYSTEM.VAL(SET, LONG(XOR(code, SYSTEM.VAL(SHORTINT, a[i])))) * {0..7})])
END;
RETURN code
END FCS;
(**)
PROCEDURE CalcFCS16;
BEGIN
END CalcFCS16;
(*
PROCEDURE -CalcFCS16
43H, 0F1H, 10H, 00H, (* LEA 0(A1, D1.W), D1 *)
70H, 0FFH, (* MOVEQ #-1, D0 *)
4AH, 42H, (* TST.W D2 *)
67H, 14H, (* BEQ.S end *)
53H, 42H, (* SUBQ.W #1, D2 *)
12H, 19H, (* MOVE.B (A1)+, D1 *)
0B1H, 41H, (* EOR.W D0, D1 *)
0E0H, 48H, (* LSR.W #8, D0 *)
02H, 41H, 00H, 0FFH, (* ANDI.W #$00FF, D1 *)
32H, 30H, 12H, 00H, (* MOVE.W 0(A0, D1.W*2), D1*)
0B3H, 40H, (* EOR.W D1, D0 *)
60H, 0E8H; (* BRA.S loop1 *)
*)
(*es*) (*
PROCEDURE FCS (VAR a: ARRAY OF CHAR; pos, len: INTEGER): INTEGER;
CONST
D0 = 0; D1 = 1; D2 = 2; A0 = 8; A1 = 9;
VAR code: INTEGER;
BEGIN
SYSTEM.PUTREG(A0, SYSTEM.ADR(FCSTable)); SYSTEM.PUTREG(A1, SYSTEM.ADR(a));
SYSTEM.PUTREG(D1, pos); SYSTEM.PUTREG(D2, len);
CalcFCS16;
SYSTEM.GETREG(D0, code);
RETURN code
END FCS;
*)
(** CalcFCS - Calculates the FCS, should include Flag, Address etc.,
but no EscCodes, Space for FCS.. *)
PROCEDURE CalcFCS* (VAR a: ARRAY OF CHAR; pos, len: INTEGER): INTEGER;
BEGIN RETURN XOR(FCS(a, pos, len), -1)
END CalcFCS;
(* CheckFCS - Checks a complete packet, including Flag, Address AND FCS-Code! Returns TRUE if Packet is ok *)
PROCEDURE CheckFCS* (VAR a: ARRAY OF CHAR; pos, len: INTEGER): BOOLEAN;
BEGIN RETURN GoodFCS = FCS(a, pos, len)
END CheckFCS;
PROCEDURE GenerateFCSTab;
CONST P = - 7BF8H; (* 8408H *)
VAR b, v, i:INTEGER;
BEGIN
FOR b := 0 TO 255 DO v := b;
FOR i:= 0 TO 7 DO
IF ODD(v) THEN v := XOR(SYSTEM.LSH(v, -1), P) ELSE v := SYSTEM.LSH(v, -1) END
END;
FCSTable[b] := v
END
END GenerateFCSTab;
(*---*)
PROCEDURE PutInt* (x: INTEGER; VAR p: ARRAY OF CHAR; pos: INTEGER);
BEGIN
p[pos + 0] := CHR(SYSTEM.LSH(x, -8) MOD 256);
p[pos + 1] := CHR(x MOD 256)
END PutInt;
PROCEDURE GetInt* (VAR p: ARRAY OF CHAR; pos: INTEGER): INTEGER;
BEGIN RETURN ORD(p[pos])*256 + ORD(p[pos + 1])
END GetInt;
PROCEDURE PutLong *(x: LONGINT; VAR p: ARRAY OF CHAR; pos: INTEGER);
BEGIN
p[pos + 0] := CHR(SYSTEM.LSH(x, -24) MOD 256);
p[pos + 1] := CHR(SYSTEM.LSH(x, -16) MOD 256);
p[pos + 2] := CHR(SYSTEM.LSH(x, -8) MOD 256);
p[pos + 3] := CHR(x MOD 256)
END PutLong;
PROCEDURE GetLong* (VAR p: ARRAY OF CHAR; pos: INTEGER): LONGINT;
BEGIN
RETURN ((LONG(ORD(p[pos]))*256 + LONG(ORD(p[pos + 1])))*256
+ LONG(ORD(p[pos + 2])))*256 + LONG(ORD(p[pos + 3]))
END GetLong;
PROCEDURE GetSet* (VAR p: ARRAY OF CHAR; pos: INTEGER): SET;
BEGIN RETURN SYSTEM.VAL(SET, GetLong(p, pos))
END GetSet;
PROCEDURE PutSet* (x: SET; VAR p: ARRAY OF CHAR; pos: INTEGER);
BEGIN PutLong(SYSTEM.VAL(LONGINT, x), p, pos)
END PutSet;
PROCEDURE GetIP* (VAR p: ARRAY OF CHAR; pos: INTEGER;
VAR x: (*es*)NetIP.Adr(*PT.IPAdr*));
VAR i: INTEGER;
BEGIN FOR i := 0 TO (*es*)NetIP.AdrLen(*PT.IPAdrLen*) - 1 DO x[i] := p[pos + i] END
END GetIP;
PROCEDURE PutIP* (VAR x: (*es*)NetIP.Adr(*PT.IPAdr*); VAR p: ARRAY OF CHAR; pos: INTEGER);
VAR i: INTEGER;
BEGIN
FOR i := 0 TO (*es*)NetIP.AdrLen(*PT.IPAdrLen*) - 1 DO
p[pos + i] := SYSTEM.VAL(CHAR,x[i])(*x[i]*)
END
END PutIP;
PROCEDURE EqualIP* (VAR p: ARRAY OF CHAR; pos: INTEGER;
VAR x: (*es*)NetIP.Adr(*PT.IPAdr*)): BOOLEAN;
VAR i: INTEGER;
BEGIN i := 0;
WHILE (i # (*es*)NetIP.AdrLen(*PT.IPAdrLen*))
& ((*es*)SYSTEM.VAL(CHAR,x[i])(*x[i]*) = p[pos + i]) DO
INC(i)
END;
RETURN i = (*es*)NetIP.AdrLen(*PT.IPAdrLen*)
END EqualIP;
PROCEDURE CopyString* (VAR a: ARRAY OF CHAR; posfrom, posto, len: INTEGER);
VAR i: INTEGER;
BEGIN
IF posfrom > posto THEN FOR i := 0 TO len - 1 DO a[posto + i] := a[posfrom + i] END
ELSIF posfrom < posto THEN FOR i := len - 1 TO 0 BY - 1 DO a[posto + i] := a[posfrom + i] END
END
END CopyString;
PROCEDURE Magic* (): LONGINT;
BEGIN RETURN 0;
END Magic;
PROCEDURE OutPacket* (VAR p: ARRAY OF CHAR; pos, len: INTEGER);
VAR i: INTEGER;
BEGIN
FOR i := 0 TO len - 1 DO
Debug.HexByte(p[pos + i]);
IF i MOD 4 = 3 THEN Debug.String(" "); END;
IF i MOD 16 = 15 THEN Debug.Ln END;
END;
(*
FOR i := 0 TO len BY 4 DO
Debug.Hex(SYSTEM.VAL(LONGINT, p[pos + i])); Debug.String(" ");
IF i MOD 16 = 0 THEN Debug.Ln END
END;
*)
IF i MOD 16 # 0 THEN Debug.Ln END (* Avoid redundant line break. *)
(* Debug.Ln *)
END OutPacket;
PROCEDURE WriteSet*(s:SET; VAR a:ARRAY OF CHAR);
VAR k,i:INTEGER;
BEGIN k:=0;
FOR i:=31 TO 0 BY -1 DO IF (i IN s) THEN a[k]:="1"; ELSE a[k]:="0"; END; INC(k); END; a[k]:=0X;
END WriteSet;
BEGIN
GenerateFCSTab
END PPPTools.