Oberon/ETH Oberon/PPPTools.Mod

(* 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.