Added ARM port of the System package (trap handling, network and some utilities).

git-svn-id: https://svn.inf.ethz.ch/svn/lecturers/a2/trunk@6436 8c9fc860-2736-0410-a75d-ab315db34111

source/ARM.IP.Mod

@@ -0,0 +1,1635 @@
+(* Aos, Copyright 2001, Pieter Muller, ETH Zurich *)
+
+MODULE IP; (** AUTHOR "pjm, mvt, eb"; PURPOSE "IP (v4 and v6)"; *)
+
+IMPORT SYSTEM, KernelLog, Commands, Strings, Network;
+
+CONST
+	(* DEBUG *)
+	DEBUG = TRUE;
+
+	(** Error codes *)
+	Ok* = 0;
+	DeviceAlreadyUsed* = 3901;
+	DuplicateInterfaceName* = 3902;
+	NoInterfaceName* = 3903;
+	GatewayNotInSubnet* = 3904;
+	IPv6AdrUsedOnIPv4Interface* = 4001;
+	IPv4AdrUsedOnIPv6Interface* = 4002;
+	DublicatedAddresses* = 4003;
+	MixedIpProtocols* = 4003;
+	LocalAdrSetIntv6* = 4004;   (* local address must be NIL when calling SetAdrs on a IPv6 interface *)
+	PrefixNotSet* = 4005; (* prefix on ipv6 interface must be set with local address *)
+
+	MaxNofDNS* = 10; (** maximum number of DNS servers per interface *)
+	MaxTTL* = 255; (** maximum time-to-live on outgoing datagrams *)
+
+	NbrOfReceivers = 255; (* Number of possible receivers, i.e. possible layer 3 protocols *)
+
+	(** IP address constants *)
+	NilAdrIPv4 = 0;
+
+	(* Comparators for Adr.usedProtocols *)
+	IPv4* = 4;
+	IPv6* = 6;
+	NilAdrIdent = -1;	(* usedProtocol of NilAdrs *)
+
+	(* ICMP *)
+	ICMPHdrLen* = 4;
+	ICMPSrcLLAdrOptionType* = 1;
+	ICMPTargetLLAdrOptionType* = 2;
+	ICMPPrefixInfoOptionType* = 3;
+	ICMPRedirectHdrOptionType* = 4;
+	ICMPMTUOptionType* = 5;
+	ICMPAdvIntOptionType* = 7;
+	ICMPHomeAgOptionType* = 8;
+	ICMPRouteOption* = 9;
+
+
+TYPE
+	Adr* = RECORD
+		ipv4Adr*: LONGINT;
+		ipv6Adr*: ARRAY 16 OF CHAR;
+		usedProtocol*: LONGINT;
+		data*: LONGINT;
+	END; (** An IP Address.	usedProtocol = 0: No protocol yet used
+							usedProtocol = IPv4: IPv4 address stored in field ipv4Adr
+							usedProtocol = IPv6: IPv6 address stored in field ipv6Adr
+							data can be used to store additional informations. I.e. in IPv6 the
+							prefix length is stored in the data field *)
+
+TYPE
+	Packet* = POINTER TO ARRAY OF CHAR;
+
+	Name* = ARRAY 128 OF CHAR; (** Name type for interface name *)
+
+	Interface* = OBJECT
+	VAR
+		(** IP addresses of this interface. *)
+		localAdr*, maskAdr*, gatewayAdr*, subnetAdr*, broadAdr*: Adr;
+
+		(** name of the interface *)
+		name*: Name;
+
+		(** Device that the interface belongs to *)
+		dev*: Network.LinkDevice;
+
+		(** DNS server list - can be used by DNS, not used in IP itself *)
+		DNS-: ARRAY MaxNofDNS OF Adr; (* DNS server list *)
+		DNScount*: LONGINT; (* number of DNS servers in list *)
+
+		(* interface *)
+		next*: Interface; (* next pointer for interface list *)
+		closed*: BOOLEAN; (* is interface already closed? *)
+		protocol*: LONGINT; (* Interface for IPv4 or IPv6?. Only used by IP otherwise use dynamic type checking! *)
+
+
+		(** Set addresses. Is normally called just after instanciation, but can also be called later, e.g. by DHCP.
+			If "gatewayAdr" is "NilAdr", the subnet is considered to have no gateway, else it must be in the same
+			subnet as the "localAdr".
+			"domain" can be an empty string. It is normally used by a DNS implementation. It is not used in IP directly.
+			In IPv6 maskAdr is the prefix of the currently IP address *)
+		PROCEDURE SetAdrs*(localAdr, maskOrPrefixAdr, gatewayAdr: Adr; VAR res: LONGINT);
+		BEGIN
+			(* Extensions have to override this method.*)
+			HALT(99);
+		END SetAdrs;
+
+
+		(** Remove all domain name servers from the interface. *)
+		PROCEDURE DNSRemoveAll*;
+		BEGIN {EXCLUSIVE}
+			DNScount := 0;
+		END DNSRemoveAll;
+
+
+		(** Add a domain name server to the interface. *)
+		PROCEDURE DNSAdd*(adr: Adr);
+		VAR
+			i: LONGINT;
+
+		BEGIN {EXCLUSIVE}
+			(* concurrent lookup is consistent *)
+			ASSERT(DNScount < MaxNofDNS);
+
+			i := 0;
+			WHILE i < DNScount DO
+				IF AdrsEqual (DNS[i],adr) THEN RETURN END;
+				INC(i)
+			END;
+			DNS[DNScount] := adr;
+			INC(DNScount);
+		END DNSAdd;
+
+
+		(** Remove a domain name server from the interface. *)
+		PROCEDURE DNSRemove*(adr: Adr);
+		VAR i: LONGINT;
+		BEGIN {EXCLUSIVE}
+			(* concurrent lookup could result in a duplicate address in worst-case *)
+			(* this happends hardly ever and is harmless for DNS anyway *)
+			i := 0;
+			WHILE (i < DNScount) & (~ AdrsEqual(DNS[i],adr)) DO
+				INC(i)
+			END;
+			IF i < DNScount THEN
+				INC(i);
+				WHILE i < DNScount DO
+					DNS[i-1] := DNS[i];
+					INC(i);
+				END;
+				DEC(DNScount);
+			END;
+		END DNSRemove;
+
+
+		(** Send an IP packet on this interface. *)
+		PROCEDURE Send*(type: LONGINT; destAdr: Adr; CONST l4hdr, data: ARRAY OF CHAR; h4len, dofs, dlen, TTL: LONGINT);
+		BEGIN
+			(* Extensions have to override this method.*)
+			HALT(99);
+		END Send;
+
+
+		(* Internal procedure to perform the rest of the send operation. Used by "Send" and for IP forwarding. *)
+		PROCEDURE DoSend*(destAdr: Adr; CONST l3hdr, l4hdr, data: ARRAY OF CHAR; h3len, h4len, dofs, dlen: LONGINT) ;
+		BEGIN
+			(* Extensions have to override this method.*)
+			HALT(99);
+		END DoSend;
+
+
+		(** Enumerate all ARP table entries. *)
+		PROCEDURE ARPEnumerate*(handle: ARPHandler);
+		BEGIN
+			(* Extensions have to override this method.*)
+			HALT(99);
+		END ARPEnumerate;
+
+
+		(** Close and deactivate the interface, i.e. remove it from the configuration. *)
+		PROCEDURE Close*;
+		BEGIN
+			(* Extensions have to override this method.*)
+			HALT(99);
+		END Close;
+
+
+		(** Check if adr is a broadcast address *)
+		PROCEDURE IsBroadcast*(adr: Adr) : BOOLEAN;
+		BEGIN
+			(* Extensions have to override this method.*)
+			HALT(99);
+		END IsBroadcast;
+
+
+		(** Check if adr is a multicast address *)
+		PROCEDURE IsMulticast*(adr: Adr) : BOOLEAN;
+		BEGIN
+			(* Extensions have to override this method.*)
+			HALT(99);
+		END IsMulticast;
+
+
+		(** Receive an IP packet *)
+		PROCEDURE IPInput*(dev: Network.LinkDevice; type: LONGINT; buffer: Network.Buffer);
+		BEGIN
+			(* Extensions have to override this method.*)
+			HALT(99);
+		END IPInput;
+
+
+		(** Reads the source address of a IP packet buffer *)
+		PROCEDURE ReadSrcAdr* (buffer: Network.Buffer): Adr;
+		BEGIN
+			(* Extensions have to override this method.*)
+			HALT(99);
+		END ReadSrcAdr;
+
+
+		(** Reads the destination address of a IP packet buffer *)
+		PROCEDURE ReadDestAdr* (buffer: Network.Buffer): Adr;
+		BEGIN
+			(* Extensions have to override this method.*)
+			HALT(99);
+		END ReadDestAdr;
+
+
+		(** Creates a pseudo-header for checksum calculation (TCP/UDP) and returns the length of this header *)
+		PROCEDURE WritePseudoHeader*(VAR pseudoHdr: ARRAY OF CHAR;  src, dst: Adr; protocol, pktLengthUpperLayer: LONGINT): LONGINT;
+		BEGIN
+			(* Extensions have to override this method.*)
+			HALT(99);
+		END WritePseudoHeader;
+
+
+		(** Writes the configuration of this interface *)
+		PROCEDURE OutInterface*;
+		BEGIN
+			(* Extensions have to override this method.*)
+			HALT(99);
+		END OutInterface;
+
+	END Interface;
+
+
+TYPE
+	(* List of interfaces *)
+	InterfaceList* = POINTER TO RECORD
+		interface*: Interface;
+		next*: InterfaceList;
+	END;
+
+	Receiver* = PROCEDURE {DELEGATE} (int: Interface; type: LONGINT; fip, lip: Adr; buffer: Network.Buffer);
+	V6InterfaceByDstIP* = PROCEDURE {DELEGATE} (dstAdr: Adr): Interface;
+
+	(** Handler for ARPPool.Enumerate. *)
+	ARPHandler* = PROCEDURE {DELEGATE} (ip: Adr; complete: BOOLEAN; link: Network.LinkAdr; size, sendTime, updateTime, updateDate, hash: LONGINT);
+
+	InterfaceHandler* = PROCEDURE {DELEGATE} (int: Interface);
+
+
+VAR
+	(* receiver *)
+	receivers*: ARRAY 256 OF Receiver; (* registered receivers - array position is IPv4 protocol field or IPv6 next header field *)
+
+	(* Interface by dst for IPv6 *)
+	v6InterfaceByDstIP*: V6InterfaceByDstIP;
+
+	(* IP *)
+	NilAdr*: Adr; (* To check if an IP address is NIL use IsNilAdr instead *)
+	preferredProtocol*: LONGINT;	(* Preferred IP protocol *)
+
+	(* IP counters *)
+	NIPSentToSubnet*, NIPSentToGateway*, NIPSentBroadcast*, NIPCantFragment*,
+	NIPRcvTotal*, NIPTooSmall*, NIPBadVersion*, NIPOptions*, NIPBadChecksum*,
+	NIPBadLength*, NIPTrim*, NIPBadHdrLen*, NIPNotForUs*, NIPCantReassemble*, NIPSrcIsBroadcast*,
+	NIPDelivered*, NIPNoReceiver*, NIPForwarded*, NIPSentLocalLoopback*, NIPSentPointToPoint*: LONGINT;
+
+	(* turn on/off IP forwarding, echo replay *)
+	IPForwarding*: BOOLEAN;
+	EchoReply*: BOOLEAN;
+
+	(* Interface *)
+	interfaces*: Interface; (* list of all installed interfaces *)
+
+	counter: LONGINT; (* Use it only in the module body! *)
+
+
+(** Is address not yet specified *)
+PROCEDURE IsNilAdr* (adr: Adr): BOOLEAN;
+VAR
+	isNil: BOOLEAN;
+	i: LONGINT;
+
+BEGIN
+	CASE adr.usedProtocol OF
+		IPv4:
+			RETURN (adr.ipv4Adr = NilAdrIPv4)
+
+		|IPv6:
+			isNil := TRUE;
+			i := 0;
+			WHILE ((i<16) & isNil) DO
+				IF adr.ipv6Adr[i] # 0X THEN
+					isNil := FALSE;
+				END;
+				INC(i);
+			END;
+			RETURN isNil;
+
+		|NilAdrIdent:
+			RETURN TRUE;
+
+		ELSE
+			IF DEBUG THEN
+				ASSERT(TRUE);
+			END;
+			RETURN TRUE;
+	END;
+END IsNilAdr;
+
+
+(* Checks if two addresses are equal *)
+PROCEDURE AdrsEqual* (adr1, adr2: Adr): BOOLEAN;
+VAR
+	equal: BOOLEAN;
+	i: LONGINT;
+
+BEGIN
+	IF adr1.usedProtocol # adr2.usedProtocol THEN
+		RETURN FALSE;
+	END;
+
+	CASE adr1.usedProtocol OF
+		IPv4:
+			IF adr1.ipv4Adr = adr2.ipv4Adr THEN
+				RETURN TRUE;
+			END;
+
+		|IPv6:
+			equal := TRUE;
+			i := 0;
+			WHILE ((i < 16) & equal) DO
+				IF adr1.ipv6Adr[i] # adr2.ipv6Adr[i] THEN
+					equal := FALSE;
+				END;
+				INC(i);
+			END;
+
+			IF adr1.data # adr2.data THEN
+				equal := FALSE;
+			END;
+
+			RETURN equal;
+
+		|NilAdrIdent:
+			(* both addresses NIL therefore equal *)
+			IF adr2.usedProtocol = NilAdrIdent THEN
+				RETURN TRUE;
+			ELSE
+				RETURN FALSE;
+			END;
+
+		ELSE
+			IF DEBUG THEN
+				ASSERT(TRUE);
+			END;
+			RETURN FALSE;
+	END;
+	RETURN FALSE;
+END AdrsEqual;
+
+
+(** Convert a dotted-decimal string to an ip address. Return NilAdr on failure. *)
+PROCEDURE StrToAdr*(ipString: ARRAY OF CHAR): Adr;
+VAR
+	retAdr: Adr;
+	i, j, x: LONGINT;
+	adr: ARRAY 4 OF CHAR;
+	ok: BOOLEAN;
+	charCount: LONGINT;				(* ipv6: number of character between two : *)
+	ipv6AdrPart: ARRAY 6 OF CHAR;		(* two bytes of an IPv6 address *)
+	ipv6AdrRight: ARRAY 16 OF CHAR;	(* right part of an IPv6 address; after :: *)
+	hexToChar: ARRAY 3 OF CHAR;
+	leftParts: LONGINT;					(* number of bytes before :: *)
+	rightParts: LONGINT;				(* number of bytes after :: *)
+	val, res: LONGINT;
+	state: LONGINT;						(* state of the FSM look at the eof for more info *)
+	dPointOcc: BOOLEAN;				(* double point occured *)
+	prefixVal: LONGINT;
+
+
+	(* compute a subpart (two bytes) of a IPv6 address; subpart:=between two : *)
+	PROCEDURE ComputeIPv6Part():BOOLEAN;
+	BEGIN
+		CASE charCount OF
+			0:
+				RETURN TRUE;
+
+			|1,2:
+				IF dPointOcc THEN
+					ipv6AdrRight[rightParts] := 0X;
+					INC(rightParts);
+				ELSE
+					retAdr.ipv6Adr[leftParts] := 0X;
+					INC(leftParts);
+				END;
+				Strings.HexStrToInt(ipv6AdrPart, val, res);
+
+				IF res = Strings.Ok THEN
+					IF dPointOcc THEN
+						ipv6AdrRight[rightParts] := CHR(val);
+						INC(rightParts);
+					ELSE
+						retAdr.ipv6Adr[leftParts] := CHR(val);
+						INC(leftParts);
+					END;
+				ELSE
+					RETURN FALSE;
+				END;
+
+			|3:
+				hexToChar[0] := ipv6AdrPart[0];
+				hexToChar[1] := 0X;
+				Strings.HexStrToInt(hexToChar, val, res);
+
+				IF res = Strings.Ok THEN
+					IF dPointOcc THEN
+						ipv6AdrRight[rightParts] := CHR(val);
+						INC(rightParts);
+					ELSE
+						retAdr.ipv6Adr[leftParts] := CHR(val);
+						INC(leftParts);
+					END;
+				ELSE
+					RETURN FALSE;
+				END;
+				ipv6AdrPart[0] := "0";
+				Strings.HexStrToInt(ipv6AdrPart, val, res);
+
+				IF res = Strings.Ok THEN
+					IF dPointOcc THEN
+						ipv6AdrRight[rightParts] := CHR(val);
+						INC(rightParts);
+					ELSE
+						retAdr.ipv6Adr[leftParts] := CHR(val);
+						INC(leftParts);
+					END;
+				ELSE
+					RETURN FALSE;
+				END;
+
+			|4:
+				hexToChar[0] := ipv6AdrPart[0];
+				hexToChar[1] := ipv6AdrPart[1];
+				hexToChar[2] := 0X;
+				Strings.HexStrToInt(hexToChar, val, res);
+
+				IF res = Strings.Ok THEN
+					IF dPointOcc THEN
+						ipv6AdrRight[rightParts] := CHR(val);
+						INC(rightParts);
+					ELSE
+						retAdr.ipv6Adr[leftParts] := CHR(val);
+						INC(leftParts);
+					END;
+				ELSE
+					RETURN FALSE;
+				END;
+				ipv6AdrPart[0] := "0";
+				ipv6AdrPart[1] := "0";
+				Strings.HexStrToInt(ipv6AdrPart, val, res);
+
+				IF res = Strings.Ok THEN
+					IF dPointOcc THEN
+						ipv6AdrRight[rightParts] := CHR(val);
+						INC(rightParts);
+					ELSE
+						retAdr.ipv6Adr[leftParts] := CHR(val);
+						INC(leftParts);
+					END;
+				ELSE
+					RETURN FALSE;
+				END;
+
+			ELSE
+				IF DEBUG THEN
+					ASSERT(TRUE);
+				END;
+				RETURN FALSE;
+		END;
+		charCount := 0;
+		RETURN TRUE;
+	END ComputeIPv6Part;
+
+
+BEGIN
+	retAdr := NilAdr;
+
+	IF IsValidIPv4Str(ipString) THEN
+		(* Return an ipv4 address *)
+		i := 0;
+		j := 0;
+		x := -1;
+		ok := FALSE;
+
+		LOOP
+			IF (ipString[i] = ".") OR (ipString[i] = 0X) THEN
+				IF (x < 0) OR (x > 255) OR (j = 4) THEN EXIT END;
+				adr[j] := CHR(x);
+				IF ipString[i] = 0X THEN ok := (j = 3); EXIT END;
+				x := -1; INC(i); INC(j)
+			ELSIF (ipString[i] >= "0") & (ipString[i] <= "9") THEN
+				IF x = -1 THEN x := 0 END;
+				x := x*10 + (ORD(ipString[i])-ORD("0"));
+				INC(i)
+			ELSE
+				EXIT
+			END
+		END;
+
+		IF ok THEN
+			retAdr.ipv4Adr := SYSTEM.VAL (LONGINT, adr);
+			retAdr.usedProtocol := IPv4;
+			RETURN retAdr;
+		ELSE
+			RETURN NilAdr;
+		END
+
+
+	(* IPv6 *)
+	ELSIF IsValidIPv6Str(ipString) THEN
+		i := 0;
+		state := 1;
+		charCount := 0;
+		dPointOcc := FALSE;
+		retAdr.usedProtocol := 6;
+		retAdr.ipv4Adr := NilAdrIPv4;
+		i := 0;
+		j := 0;
+		charCount := 0;
+		leftParts := 0;
+		rightParts := 0;
+		prefixVal := 0;
+
+		Strings.UpperCase(ipString);
+
+		WHILE (i < (LEN(ipString) - 1)) & (ipString[i] # 0X) DO
+
+			CASE state OF  (* Using the same FSM as IsValidIPv6Str *)
+				-1:	(* Error state
+					    Should never happen, is checked by IsValidIPv6Str() *)
+					RETURN NilAdr;
+
+				|1:	(* reading two blocks of two bytes of 0-9\A-F *)
+					IF ipString[i] = ":" THEN
+						ipv6AdrPart[charCount] := 0X;
+						IF ~ComputeIPv6Part() THEN
+							RETURN NilAdr;
+						END;
+						state := 2;
+
+					ELSIF ipString[i] = "/" THEN
+						ipv6AdrPart[charCount] := 0X;
+
+						IF ~ComputeIPv6Part() THEN
+							RETURN NilAdr;
+						END;
+						state := 3;
+
+					ELSE
+						(* 0-9, A-F *)
+						ipv6AdrPart[charCount] := ipString[i];
+						INC(charCount);
+					END;
+
+				|2:	(* a : occured *)
+					IF ipString[i] = ":" THEN
+						dPointOcc := TRUE;
+						state := 4;
+					ELSE
+						(* 0-9, A-F *)
+						state := 1;
+						charCount := 0;
+						ipv6AdrPart[charCount] := ipString[i];
+						INC(charCount);
+					END;
+
+				|3:	(* prefix will follow *)
+					prefixVal := (prefixVal * 10) + (ORD(ipString[i]) - ORD("0"));
+
+				|4:	(* A :: occured *)
+					IF ipString[i] = "/" THEN
+						state := 3;
+					ELSE
+						IF ~ComputeIPv6Part() THEN
+							RETURN NilAdr;
+						END;
+
+						(* 0-9, A-F *)
+						state := 1;
+						charCount := 0;
+						ipv6AdrPart[charCount] := ipString[i];
+						INC(charCount);
+					END;
+				ELSE
+					IF DEBUG THEN
+						ASSERT(TRUE);
+					END;
+			END;
+			INC(i);
+		END;
+
+		ipv6AdrPart[charCount] := 0X;
+		IF charCount # 0 THEN
+			IF ~ComputeIPv6Part() THEN
+				RETURN NilAdr;
+			END;
+		END;
+
+		IF dPointOcc THEN
+			(* fill 0X for :: *)
+			FOR i:= leftParts TO ((LEN(retAdr.ipv6Adr) -1) - rightParts) DO
+				retAdr.ipv6Adr[i] := 0X;
+			END;
+
+			(* fill part behind :: *)
+			FOR i := 0 TO (rightParts - 1) DO
+				retAdr.ipv6Adr[(LEN(retAdr.ipv6Adr) - rightParts) + i] := ipv6AdrRight[i];
+			END;
+		END;
+
+		IF prefixVal > 64 THEN
+			RETURN NilAdr;
+		END;
+		retAdr.data := prefixVal;
+		RETURN retAdr;
+	END;
+	RETURN NilAdr;
+END StrToAdr;
+
+
+(** Convert an IP address to a dotted-decimal string. *)
+PROCEDURE AdrToStr*(adr: Adr; VAR string: ARRAY OF CHAR);
+VAR
+	i, j, x: LONGINT;
+	a: ARRAY 4 OF CHAR;
+	val: LONGINT;
+	hexToStr: ARRAY 5 OF CHAR;
+	prefixLenStr: ARRAY 64 OF CHAR;
+	maxZeroRow: LONGINT;
+	currentZeroRow: LONGINT;
+	maxZeroStart: LONGINT;
+	currentZeroStart: LONGINT;
+	lastZero: BOOLEAN;
+	lastDPoint: BOOLEAN;
+	countEnded: BOOLEAN;
+
+BEGIN
+	CASE adr.usedProtocol OF
+		IPv4:
+			ASSERT(LEN(string) >= 16);	(* enough space for largest result *)
+			Network.Put4(a, 0, adr.ipv4Adr);
+			i := 0;
+			FOR j := 0 TO 3 DO
+				x := ORD(a[j]);
+				IF x >= 100 THEN string[i] := CHR(ORD("0")+x DIV 100); INC(i) END;
+				IF x >= 10 THEN string[i] := CHR(ORD("0")+x DIV 10 MOD 10); INC(i) END;
+				string[i] := CHR(ORD("0")+x MOD 10); INC(i);
+				IF j = 3 THEN string[i] := 0X ELSE string[i] := "." END;
+				INC(i)
+			END
+
+		|IPv6:
+			FOR i := 0 TO (LEN(adr.ipv6Adr) -1) BY 2 DO
+				(* simple version *)
+				val :=  ORD(adr.ipv6Adr[i]) * 256;
+				val := val + ORD(adr.ipv6Adr[i+1]);
+				Strings.IntToHexStr (val, 3, hexToStr);
+
+				(* Delete leading zeros *)
+				WHILE (hexToStr[0] = "0") & (hexToStr[1] # 0X) DO
+					Strings.Delete(hexToStr, 0, 1);
+				END;
+				Strings.Append (string, hexToStr);
+
+				IF i # (LEN(adr.ipv6Adr) - 2) THEN
+					Strings.Append (string, ":");
+				END;
+			END;
+
+			(* replace longest row of zeros with :: *)
+			maxZeroRow := 0;
+			currentZeroRow := 0;
+			maxZeroStart := 0;
+			currentZeroStart := 0;
+			i := 0;
+			lastZero := FALSE;
+			lastDPoint := TRUE;
+			countEnded :=TRUE;
+
+			WHILE string[i] # 0X DO
+				IF string[i] = "0" THEN
+					IF lastDPoint THEN
+						INC(currentZeroRow);
+						lastZero := TRUE;
+						lastDPoint := FALSE;
+						IF countEnded THEN
+							currentZeroStart := i;
+							countEnded := FALSE;
+						END;
+					END;
+				ELSIF string[i] = ":" THEN
+					lastDPoint := TRUE;
+					IF lastZero THEN
+						lastZero := FALSE;
+					END;
+				ELSE
+					IF lastDPoint THEN
+						lastDPoint := FALSE;
+						countEnded := TRUE;
+						IF currentZeroRow > maxZeroRow THEN
+							maxZeroRow := currentZeroRow;
+							maxZeroStart := currentZeroStart;
+						END;
+					END;
+				END;
+
+				INC(i);
+			END;
+
+			IF ~countEnded THEN
+				IF currentZeroRow > maxZeroRow THEN
+					maxZeroRow := currentZeroRow;
+					maxZeroStart := currentZeroStart;
+				END;
+			END;
+			IF maxZeroRow # 0 THEN
+				(* write a :: *)
+				IF maxZeroStart = 0 THEN
+					string[0] := ":";
+					i := 1;
+					WHILE ((string[i] # 0X) & ~((string[i] # "0") & (string[i] # ":"))) DO INC(i); END;
+					IF string[i] = 0X THEN
+						string := "::";
+					ELSE
+						Strings.Delete(string, 1, i-2);
+					END;
+				ELSE
+					i := maxZeroStart;
+					WHILE ((string[i] = "0") OR (string[i] = ":")) DO INC(i); END;
+					IF string[i] = 0X THEN
+						string[maxZeroStart] := ":";
+						string[maxZeroStart+1] := 0X;
+					ELSE
+						Strings.Delete(string, maxZeroStart, i - maxZeroStart - 1);
+					END;
+				END;
+			END;
+
+			IF adr.data # 0 THEN
+				(* write prefix *)
+				Strings.IntToStr(adr.data, prefixLenStr);
+				Strings.Append (string, "/");
+				Strings.Append (string, prefixLenStr);
+			END;
+
+		ELSE
+			IF IsNilAdr (adr) THEN
+				string := "";
+			END;
+	END;
+END AdrToStr;
+
+
+(** Convert a IP address from an array [ofs..ofs+x] to an
+	Adr-type variable.
+	Example for IPv4:
+	If the LSB (least significant byte) is stored the the beginning [ofs],
+	LSBfirst must be set to TRUE.
+		(address "a.b.c.d" is stored as [d,c,b,a])
+	If the LSB is stored at the end [ofs+3], LSBfirst must be set to FALSE.
+		(address "a.b.c.d" is stored as [a,b,c,d])
+*)
+PROCEDURE ArrayToAdr*(CONST array: ARRAY OF CHAR; ofs, protocol: LONGINT; LSBfirst: BOOLEAN): Adr;
+VAR
+	adr: Adr;
+	i, swapTemp: LONGINT;
+BEGIN
+	ASSERT((protocol = 4) OR (protocol = 6));
+
+	IF protocol = IPv4 THEN  (* index check *)
+		IF ~(ofs + 4 <= LEN(array)) THEN
+			RETURN NilAdr;
+		END;
+
+		SYSTEM.MOVE(ADDRESSOF(array[ofs]), ADDRESSOF(adr.ipv4Adr), 4);
+		IF LSBfirst THEN
+			SwapEndian(adr.ipv4Adr);
+		END;
+		adr.usedProtocol := IPv4;
+
+	ELSIF protocol = IPv6 THEN
+		IF ~(ofs + 16 <= LEN(array)) THEN
+			RETURN NilAdr;
+		END;
+
+		SYSTEM.MOVE(ADDRESSOF(array[ofs]), ADDRESSOF(adr.ipv6Adr), 16);
+		IF LSBfirst THEN
+			FOR i := 0 TO 3 DO
+				SYSTEM.MOVE(ADDRESSOF(adr.ipv6Adr[i*4]), ADDRESSOF(swapTemp), 4);
+				SwapEndian(swapTemp);
+				SYSTEM.MOVE(ADDRESSOF(swapTemp), ADDRESSOF(adr.ipv6Adr[i*4]), 4);
+			END;
+		END;
+		adr.usedProtocol := IPv6;
+
+	ELSE
+		IF DEBUG THEN
+			ASSERT(TRUE);
+		END;
+		RETURN NilAdr;
+	END;
+	RETURN adr;
+END ArrayToAdr;
+
+
+(** Convert an Adr-type variable  into an array [ofs..ofs+x]
+	Example in IPv4:
+	If the LSB (least significant byte) should be stored the the
+	beginning [ofs], LSBfirst must be set to TRUE.
+		(address "a.b.c.d" is stored as [d,c,b,a])
+	If the LSB should be stored at the end [ofs+3], LSBfirst must be set to FALSE.
+		(address "a.b.c.d" is stored as [a,b,c,d])
+*)
+PROCEDURE AdrToArray*(adr: Adr; VAR array: ARRAY OF CHAR; ofs: LONGINT; LSBfirst: BOOLEAN);
+VAR
+	tempAdr: Adr;
+	i, swapTemp: LONGINT;
+
+BEGIN
+	tempAdr := adr;
+
+	CASE adr.usedProtocol OF
+		IPv4:
+			IF ~(ofs+4 <= LEN(array)) THEN
+				tempAdr := NilAdr;
+			END;
+
+			IF LSBfirst THEN
+				SwapEndian(tempAdr.ipv4Adr);
+			END;
+			SYSTEM.MOVE(ADDRESSOF(tempAdr.ipv4Adr), ADDRESSOF(array[ofs]), 4);
+
+		| IPv6:
+			IF ~(ofs + 16 <= LEN(array)) THEN
+				tempAdr := NilAdr;
+			END;
+
+			IF LSBfirst THEN
+				FOR i := 0 TO 3 DO
+					SYSTEM.MOVE(ADDRESSOF(tempAdr.ipv6Adr[i*4]), ADDRESSOF(swapTemp), 4);
+					SwapEndian(swapTemp);
+					SYSTEM.MOVE(ADDRESSOF(swapTemp), ADDRESSOF(tempAdr.ipv6Adr[i*4]), 4);
+				END;
+			END;
+			SYSTEM.MOVE(ADDRESSOF(adr.ipv6Adr), ADDRESSOF(array[ofs]), 16);
+		ELSE
+			IF DEBUG THEN
+				ASSERT(TRUE);
+			END;
+	END;
+END AdrToArray;
+
+
+(** Reads the IP source address from a buffer *)
+PROCEDURE SrcAdrFromBuffer* (buffer: Network.Buffer): Adr;
+VAR
+	i: LONGINT;
+	adr: Adr;
+
+BEGIN
+	CASE ORD(buffer.data[buffer.l3ofs]) DIV 16 OF
+		IPv4:
+			adr.usedProtocol := IPv4;
+			SYSTEM.MOVE(ADDRESSOF(buffer.data[buffer.l3ofs+12]),ADDRESSOF(adr.ipv4Adr),4); (*adr.ipv4Adr := SYSTEM.VAL(LONGINT, buffer.data[buffer.l3ofs+12]);*)
+			SetIPv6AdrNil(adr);
+			RETURN adr;
+
+		|IPv6:
+			adr.usedProtocol := IPv6;
+			FOR i := 0 TO 15 DO
+				adr.ipv6Adr[i] := buffer.data[buffer.l3ofs+8+i];
+			END;
+			adr.ipv4Adr := NilAdrIPv4;
+
+		ELSE
+			IF DEBUG THEN
+				ASSERT(TRUE);
+			END;
+			RETURN NilAdr;
+	END;
+	RETURN NilAdr;
+END SrcAdrFromBuffer;
+
+
+(** Reads the IP destination address from a buffer *)
+PROCEDURE DestAdrFromBuffer* (buffer: Network.Buffer): Adr;
+VAR
+	adr: Adr;
+	i: LONGINT;
+
+BEGIN
+	CASE ORD(buffer.data[buffer.l3ofs]) DIV 16 OF
+		IPv4:
+			adr.usedProtocol := IPv4;
+			SYSTEM.MOVE(ADDRESSOF(buffer.data[buffer.l3ofs+16]),ADDRESSOF(adr.ipv4Adr),4); (*adr.ipv4Adr := SYSTEM.VAL(LONGINT, buffer.data[buffer.l3ofs+16]);*)
+			SetIPv6AdrNil(adr);
+			RETURN adr;
+
+		|IPv6:
+			adr.usedProtocol := IPv6;
+			FOR i := 0 TO 15 DO
+				adr.ipv6Adr[i] := buffer.data[buffer.l3ofs+24+i];
+			END;
+			adr.ipv4Adr := NilAdrIPv4;
+
+		ELSE
+			IF DEBUG THEN
+				ASSERT(TRUE);
+			END;
+			RETURN NilAdr;
+	END;
+	RETURN NilAdr;
+END DestAdrFromBuffer;
+
+
+(* Swap internal representation of an IP address from big to little endian or vice versa. *)
+PROCEDURE -SwapEndian(VAR adr: LONGINT);
+CODE
+	LDR	R0, [FP, #adr]
+	LDR	R1, [R0, #0]
+	REV	R1, R1
+	STR	R1, [R0, #0]
+	ADD	SP, SP, #4
+END SwapEndian;
+
+
+(** Write an IP address. *)
+PROCEDURE OutAdr*(adr: Adr);
+VAR
+	s: ARRAY 64 OF CHAR;
+
+BEGIN
+	AdrToStr(adr, s); KernelLog.String(s);
+END OutAdr;
+
+
+(** Enumerate all installed interfaces *)
+PROCEDURE Enumerate*(handler: InterfaceHandler);
+VAR item: Interface;
+BEGIN
+	item := interfaces;
+	WHILE item # NIL DO
+		handler(item);
+		item := item.next;
+	END;
+END Enumerate;
+
+
+(** Output the configuration of the specified interface. Can be used as Handler in Enumerate(). *)
+PROCEDURE OutInterface*(interface: Interface);
+BEGIN
+	interface.OutInterface;
+END OutInterface;
+
+
+(** Aos command: Output statistics and configuration of all installed interfaces. *)
+PROCEDURE IPConfig*(context : Commands.Context);
+BEGIN
+	context.out.String("Interfaces:"); context.out.Ln;
+	context.out.String("----------------------"); context.out.Ln;
+	Enumerate(OutInterface);
+	context.out.Ln;
+	context.out.String("IP statistics:"); context.out.Ln;
+	context.out.String("----------------------"); context.out.Ln;
+	context.out.String("NIPSentToSubnet"); context.out.Int(NIPSentToSubnet,10);context.out.Ln;
+	context.out.String("NIPSentToGateway"); context.out.Int(NIPSentToGateway,10);context.out.Ln;
+	context.out.String("NIPSentBroadcast"); context.out.Int(NIPSentBroadcast,10);context.out.Ln;
+	context.out.String("NIPCantFragment"); context.out.Int(NIPCantFragment,10);context.out.Ln;
+	context.out.String("NIPRcvTotal"); context.out.Int(NIPRcvTotal,10);context.out.Ln;
+	context.out.String("NIPTooSmall"); context.out.Int(NIPTooSmall,10);context.out.Ln;
+	context.out.String("NIPBadVersion"); context.out.Int(NIPBadVersion,10);context.out.Ln;
+	context.out.String("NIPOptions"); context.out.Int(NIPOptions,10);context.out.Ln;
+	context.out.String("NIPBadChecksum"); context.out.Int(NIPBadChecksum,10);context.out.Ln;
+	context.out.String("NIPBadLength"); context.out.Int(NIPBadLength,10);context.out.Ln;
+	context.out.String("NIPTrim"); context.out.Int(NIPTrim, 10);context.out.Ln;
+	context.out.String("NIPBadHdrLen"); context.out.Int(NIPBadHdrLen,10);context.out.Ln;
+	context.out.String("NIPNotForUs"); context.out.Int(NIPNotForUs,10);context.out.Ln;
+	context.out.String("NIPCantReassemble"); context.out.Int(NIPCantReassemble,10);context.out.Ln;
+	context.out.String("NIPSrcIsBroadcast"); context.out.Int(NIPSrcIsBroadcast,10);context.out.Ln;
+	context.out.String("NIPDelivered"); context.out.Int(NIPDelivered,10);context.out.Ln;
+	context.out.String("NIPNoReceiver"); context.out.Int(NIPNoReceiver,10);context.out.Ln;
+	context.out.String("NIPForwarded"); context.out.Int(NIPForwarded,10);context.out.Ln;
+	context.out.String("NIPSentLocalLoopback"); context.out.Int(NIPSentLocalLoopback,10);context.out.Ln;
+	context.out.String("NIPSentPointToPoint"); context.out.Int(NIPSentPointToPoint,10);context.out.Ln; context.out.Ln;
+END IPConfig;
+
+
+(**
+	First part of a split checksum operation. len must be non-zero and even. chk1 must be 0 at the
+	beginning. The result can be passed to a following call to Checksum1(). The last chk1 result must
+	be passed to Checksum2, which sums the data following sequentially on the data summed by this
+	operation. Carries from bit 15 are accumulated in the top 16 bits, so at most 65535 words can be
+	summed by Checksum1 and Checksum2 together. *)
+PROCEDURE Checksum1*(CONST data: ARRAY OF CHAR; ofs, len, chk1: LONGINT): LONGINT;
+CODE
+	LDR R0, [FP, #chk1]
+	LDR R1, [FP, #ofs]
+	LDR R2, [FP, #len]
+	LDR R3, [FP, #data] ; LDR R3, [FP, #20]
+	ADD R3, R3, R1
+	AND R4, R2, #1
+	LSR R2, R2, #1 ; number of 16-bit words to process
+	CMP R4, #0
+	BEQ WordLoop
+	SWI #8 ; ASSERT(~ODD(length))
+WordLoop: ; sum up the words
+	LDRH R4, [R3, #0]
+	ADD R0, R0, R4
+	ADD R3, R3, #2
+	SUB R2, R2, #1
+	CMP R2, #0
+	BNE WordLoop
+END Checksum1;
+
+(**
+	Continue a checksum operation. len can be zero or odd. chk1 can be the result of Checksum1 for
+	the immediately preceding data, or 0 for contiguous data. *)
+PROCEDURE Checksum2*(CONST data: ARRAY OF CHAR; ofs, len, chk1: LONGINT): INTEGER;
+CODE
+	LDR	R0, [FP, #chk1]
+	LDR	R1, [FP, #20] ; LDR R1, [FP, #data]
+	LDR	R2, [FP, #ofs]
+	LDR	R3, [FP, #len]
+	ADD	R1, R1, R2
+	LSR	R4, R3, #1 ; number of 16-bit words to process
+	CMP	R4, #0
+	BEQ	Remainder
+WordLoop: ; sum up the words
+	LDRH	R5, [R1, #0]
+	ADD	R0, R0, R5
+	ADD	R1, R1, #2
+	SUB	R4, R4, #1
+	CMP	R4, #0
+	BNE	WordLoop
+	ANDS R5, R3, #1 ; if len is even
+	BEQ WrapUp
+Remainder: ; addition of the remaining byte
+	LDRB	R5, [R1, #0]
+	ADD	R0, R0, R5
+WrapUp: ; 32-bit sum is in R0
+	LDR	R7, [PC, #WordMask - $ - 8] ; load the 16-bit word mask
+	LSR	R6, R0, 16 ; upper 16 bits of R0 is the carry
+	AND	R0, R0, R7
+	ADD	R0, R0, R6
+	LSR	R6, R0, 16 ; upper 16 bits of R0 is the carry
+	AND	R0, R0, R7
+	ADD	R0, R0, R6
+	EOR	R0, R0, R7 ; negate the bits of the resulted 16-bit word
+	B		end
+data:
+	WordMask:	d32 0FFFFH
+end:
+END Checksum2;
+
+(* Return TRUE if "adr1" and "adr2" are in the same subnet defined by "mask". Only for IPv4 *)
+PROCEDURE -SameSubnetv4(adr1, adr2, mask: LONGINT): BOOLEAN;
+CODE
+	LDR		R0, [FP, #adr1]
+	LDR		R1, [FP, #adr2]
+	LDR		R2, [FP, #mask]
+	AND		R0, R0, R2
+	AND		R1, R1, R2
+	CMP		R0, R1
+	BNE false
+	MOV		R0, #1
+	B end
+false:
+	MOV		R0, #0
+end:
+	ADD		SP, SP, #12
+END SameSubnetv4;
+
+
+(* Return TRUE if adr matches the prefix *)
+PROCEDURE MatchPrefix*(adr: Adr; prefix: Adr): BOOLEAN;
+VAR
+	bytesToCheck: LONGINT;
+	bitsToCheck: LONGINT;
+	i: LONGINT;
+	matches: BOOLEAN;
+	diffSet: SET;
+
+BEGIN
+	IF DEBUG THEN
+		ASSERT ((IsNilAdr(adr)) OR (adr.usedProtocol = IPv6));
+	END;
+
+	matches := TRUE;
+
+	bytesToCheck := prefix.data DIV 8;
+	bitsToCheck := prefix.data MOD 8;
+
+	FOR i := 0 TO bytesToCheck - 1 DO
+		IF adr.ipv6Adr[i] # prefix.ipv6Adr[i] THEN
+			matches := FALSE;
+		END;
+	END;
+
+	IF bitsToCheck # 0 THEN
+		diffSet := {};
+		FOR i := 0 TO 8 - bitsToCheck - 1 DO
+			diffSet := diffSet + {i};
+		END;
+
+		FOR i := 0 TO bitsToCheck - 1 DO
+			IF (SYSTEM.VAL(SET, adr.ipv6Adr[bytesToCheck]) - diffSet) # (SYSTEM.VAL(SET, prefix.ipv6Adr[bytesToCheck]) - diffSet) THEN
+				matches := FALSE;
+			END;
+		END;
+	END;
+	RETURN matches;
+END MatchPrefix;
+
+
+(** Return the interface on which packets with "dst" address should be sent. Return NIL if no interface matches. *)
+PROCEDURE InterfaceByDstIP*(dest: Adr): Interface;
+VAR
+	item, gw: Interface;
+
+BEGIN
+	CASE dest.usedProtocol OF
+		IPv4:
+			gw := NIL;
+			item := interfaces;
+			LOOP
+				IF item = NIL THEN EXIT END;
+				IF (item.protocol = IPv4) & (~IsNilAdr(item.localAdr)) & (item.dev.Linked() # Network.LinkNotLinked) THEN
+					IF SameSubnetv4(dest.ipv4Adr, item.subnetAdr.ipv4Adr, item.maskAdr.ipv4Adr) THEN
+						EXIT;
+					ELSIF (gw = NIL) & (~IsNilAdr(item.subnetAdr)) THEN
+						IF item.protocol # IPv4 THEN
+							gw := item;
+						ELSIF ~IsNilAdr(item.gatewayAdr) THEN
+							gw := item;
+						END;
+					END;
+				END;
+				item := item.next;
+			END;
+			IF item # NIL THEN
+				RETURN item;
+			ELSE
+				RETURN gw;
+			END;
+
+		|IPv6:
+			(* Requires special handling when multiple devices are present *)
+			RETURN v6InterfaceByDstIP(dest);
+
+		ELSE
+			IF DEBUG THEN
+				ASSERT(TRUE);
+			END;
+			RETURN NIL;
+	END;
+END InterfaceByDstIP;
+
+
+(** Return the reference to an installed interface by its name. NIL is returned if no interface with this name
+	was found. *)
+PROCEDURE InterfaceByName*(CONST name: ARRAY OF CHAR): Interface;
+VAR item: Interface;
+BEGIN
+	item := interfaces;
+	WHILE (item # NIL) & (item.name # name) DO
+		item := item.next;
+	END;
+	RETURN item;
+END InterfaceByName;
+
+
+(** Delivers first preferred (if possible) interface of an device.
+	Return the reference to an installed interface by its device. NIL is returned if no interface with this
+	device was found. *)
+PROCEDURE InterfaceByDevice*(dev: Network.LinkDevice): Interface;
+VAR
+	item: Interface;
+	unprefInt: Interface;
+BEGIN
+	unprefInt := NIL;
+	item := interfaces;
+	WHILE (item # NIL) DO
+		IF item.dev = dev THEN
+			IF item.protocol # preferredProtocol THEN
+				unprefInt := item;
+			ELSE
+				RETURN item;
+			END;
+		END;
+		item := item.next;
+	END;
+	(* return interface with unpreferred protocol or NIL *)
+	RETURN unprefInt;
+END InterfaceByDevice;
+
+
+(** Return a list of installed interfaces of a certain device. *)
+PROCEDURE InterfaceListByDevice* (dev: Network.LinkDevice):InterfaceList;
+VAR
+	item: Interface;
+	interfaceList: InterfaceList;
+	interfaceListItem: InterfaceList;
+
+BEGIN
+	item := interfaces;
+	interfaceList := NIL;
+
+	(* search for interfaces with matching device and put them in a list *)
+	WHILE item # NIL DO
+		IF item.dev = dev THEN
+			NEW(interfaceListItem);
+			interfaceListItem.interface := item;
+			interfaceListItem.next := interfaceList;
+			interfaceList := interfaceListItem;
+		END;
+		item := item.next;
+	END;
+	RETURN interfaceList;
+END InterfaceListByDevice;
+
+
+(** Install a receiver for a type. The type is stored in
+	IPv4: Protocol field
+	IPv6: Next header field *)
+PROCEDURE InstallReceiver*( type: LONGINT; r: Receiver);
+BEGIN {EXCLUSIVE}
+	IF DEBUG THEN
+		ASSERT(r # NIL);
+		ASSERT((type >=0) & (type <= 255));
+		ASSERT(receivers[type] = NIL);
+	END;
+
+	receivers[type] := r;
+END InstallReceiver;
+
+
+(** Remove the currently installed receiver for a type. The type is stored in
+	IPv4: Protocol field
+	IPv6: Next header field *)
+PROCEDURE RemoveReceiver*(type: LONGINT);
+BEGIN {EXCLUSIVE}
+	ASSERT((type >=0) & (type <= 255));
+	ASSERT(receivers[type] # NIL);
+
+	receivers[type] := NIL;
+END RemoveReceiver;
+
+
+(** Checks if a string is a valid IPv4 address *)
+PROCEDURE IsValidIPv4Str (CONST ipString: ARRAY OF CHAR): BOOLEAN;
+VAR
+	i,j: LONGINT;
+	ipNr: LONGINT;
+	digits: ARRAY 4 OF CHAR;
+	startClass: LONGINT;
+BEGIN
+	i := 0;
+
+	(* Class A *)
+	WHILE (i < Strings.Length(ipString)) & (ipString[i] #'.') & (i < 3) DO
+		digits[i] := ipString[i];
+		INC (i);
+	END;
+	digits[i] := 0X;
+
+	IF ipString[i] # '.' THEN RETURN FALSE END;
+
+	(* Check if in digits are only numbers *)
+	j := 0;
+	WHILE digits[j] # 0X DO
+		IF (ORD(digits[j]) - ORD("0")) > 9 THEN RETURN FALSE END;
+		INC (j);
+	END;
+	Strings.StrToInt (digits, ipNr);
+	IF ipNr > 255 THEN RETURN FALSE END;
+
+	(* Class B *)
+	INC(i);
+	startClass := i;
+	WHILE (i < Strings.Length(ipString)) & (ipString[i] # '.') & (i - startClass <= 3) DO
+		digits[i-startClass] := ipString[i];
+		INC (i);
+	END;
+	digits[i-startClass] := 0X;
+
+	IF ipString[i] # '.' THEN RETURN FALSE END;
+
+	(* Check if in digits are only number *)
+	j := 0;
+	WHILE digits[j] # 0X DO
+		IF (ORD(digits[j]) - ORD("0")) > 9 THEN RETURN FALSE END;
+		INC (j);
+	END;
+	Strings.StrToInt (digits, ipNr);
+	IF ipNr > 255 THEN RETURN FALSE END;
+
+	(* Class C *)
+	INC(i);
+	startClass := i;
+	WHILE (i < Strings.Length (ipString)) & (ipString[i] # '.') & (i - startClass <= 3) DO
+		digits[i-startClass] := ipString[i];
+		INC (i);
+	END;
+	digits[i-startClass] := 0X;
+
+	IF ipString[i] # '.' THEN RETURN FALSE END;
+
+	(* Check if in digits are only number *)
+	j := 0;
+	WHILE digits[j] # 0X DO
+		IF (ORD(digits[j]) - ORD("0")) > 9 THEN RETURN FALSE END;
+		INC (j);
+	END;
+	Strings.StrToInt (digits, ipNr);
+	IF ipNr > 255 THEN RETURN FALSE END;
+
+	(* Class D *)
+	INC(i);
+	startClass := i;
+	WHILE (i < Strings.Length (ipString)) & (i - startClass <= 3) DO
+		digits[i-startClass] := ipString[i];
+		INC (i);
+	END;
+	digits[i-startClass] := 0X;
+
+	(* Check if in digits are only number *)
+	j := 0;
+	WHILE digits[j] # 0X DO
+		IF (ORD(digits[j]) - ORD("0")) > 9 THEN RETURN FALSE END;
+		INC (j);
+	END;
+	Strings.StrToInt (digits, ipNr);
+	IF ipNr > 255 THEN RETURN FALSE END;
+
+	RETURN TRUE;
+END IsValidIPv4Str;
+
+
+(** Checks if a string is a valid IPv6 address *)
+PROCEDURE IsValidIPv6Str (ipString: ARRAY OF CHAR): BOOLEAN;
+VAR
+	i: LONGINT;
+	state: LONGINT; (* -1: error *)
+	charCount: LONGINT;
+	ascD: LONGINT;
+	ascH: LONGINT;
+	dPointOcc: BOOLEAN;
+	prefixLenArr: ARRAY 3 OF LONGINT;
+	prefixLen: LONGINT;
+
+BEGIN
+	i := 0;
+	state := 1;
+	dPointOcc := FALSE;
+
+	Strings.UpperCase(ipString);
+
+	WHILE (i < (LEN(ipString) - 1)) & (ipString[i] # 0X) DO
+
+		CASE state OF
+			-1:
+				RETURN FALSE;
+
+			|1:
+				(* 0-9 & A-F *)
+				ascD := ORD(ipString[i]) - ORD("0");
+				ascH := ORD(ipString[i]) - ORD("A");
+
+				IF ((ascD >= 0) & (ascD <= 9)) OR ((ascH >= 0) & (ascH <= 5)) THEN
+					INC(charCount);
+
+					(* more than 4 digits between two : *)
+					IF charCount > 4 THEN
+						state := -1;
+					END;
+
+				(* : *)
+				ELSIF ipString[i] = ":" THEN
+					charCount := 0;
+					state := 2;
+				ELSIF ipString[i] = "/" THEN
+					charCount := 0;
+					state := 3;
+				ELSE
+					state := -1;
+				END;
+
+			|2:
+				ascD := ORD(ipString[i]) - ORD("0");
+				ascH := ORD(ipString[i]) - ORD("A");
+
+				IF ipString[i] = ":" THEN
+					IF dPointOcc THEN
+						state := -1;
+					ELSE
+						dPointOcc := TRUE;
+						state := 4;
+					END
+
+				ELSIF ((ascD >= 0) & (ascD <= 9)) OR ((ascH >= 0) & (ascH <= 5)) THEN
+					INC(charCount);
+					state := 1;
+				ELSE
+					state := -1;
+				END;
+
+			|3:
+				ascD := ORD(ipString[i]) - ORD("0");
+
+				IF ~((ascD >= 0) & (ascD <= 9)) THEN
+					state := -1;
+				ELSE
+					IF charCount > 3 THEN
+						state := -1;
+					ELSE
+						prefixLenArr[charCount] := ascD;
+						INC(charCount);
+					END;
+				END;
+
+			|4:
+				ascD := ORD(ipString[i]) - ORD("0");
+				ascH := ORD(ipString[i]) - ORD("A");
+
+				IF ipString[i] = "/" THEN
+					state := 3;
+				ELSIF ((ascD >= 0) & (ascD <= 9)) OR ((ascH >= 0) & (ascH <= 5)) THEN
+					INC(charCount);
+					state := 1;
+				ELSE
+					state := -1;
+				END;
+
+			ELSE
+				IF DEBUG THEN
+					ASSERT(TRUE);
+				END;
+		END;
+		INC(i);
+	END;
+
+	CASE state OF
+		1:
+			RETURN TRUE;
+
+		|3:
+			IF charCount > 0 THEN
+				prefixLen := 0;
+				FOR i:= 0 TO charCount - 1 DO
+					prefixLen := prefixLen * 10;
+					INC(prefixLen, prefixLenArr[i]);
+				END;
+				IF prefixLen <= 64 THEN
+					RETURN TRUE;
+				ELSE
+					RETURN FALSE;
+				END;
+			ELSE
+				RETURN FALSE;
+			END;
+
+		|4:
+			RETURN TRUE;
+
+		ELSE
+			IF DEBUG THEN
+				ASSERT(TRUE);
+			END;
+			RETURN FALSE;
+	END;
+	RETURN FALSE;
+END IsValidIPv6Str;
+
+
+(** Set IPv6 address to zero *)
+PROCEDURE SetIPv6AdrNil (adr: Adr);
+VAR
+	i: LONGINT;
+
+BEGIN
+	FOR i := 0 TO 15 DO
+		adr.ipv6Adr[i] := 0X;
+	END;
+END SetIPv6AdrNil;
+
+
+(* Add the interface to the IP configuration. *)
+PROCEDURE AddInterface*(int: Interface; VAR res: LONGINT);
+VAR
+	item: Interface;
+BEGIN {EXCLUSIVE}
+	item := interfaces;
+	WHILE item # NIL DO
+		(* Check if interface name already exists *)
+		IF item.name = int.name THEN
+			res := DuplicateInterfaceName;
+			RETURN;
+		END;
+		item := item.next;
+	END;
+	(* Add interface *)
+	int.next := interfaces;
+	interfaces := int;
+	res := Ok;
+END AddInterface;
+
+
+(* Remove the interface from the IP configuration. *)
+PROCEDURE RemoveInterface*(int: Interface);
+VAR
+	item: Interface;
+
+BEGIN {EXCLUSIVE}
+	item := interfaces;
+	IF item = NIL THEN
+		(* empty list *)
+	ELSIF item = int THEN
+		(* remove first item *)
+		interfaces := interfaces.next;
+	ELSE
+		WHILE item.next # int DO
+			item := item.next;
+		END;
+		IF item.next # NIL THEN
+			item.next := item.next.next;
+		ELSE
+			(* not found *)
+		END;
+	END;
+END RemoveInterface;
+
+
+(* Prints out a packet *)
+PROCEDURE PacketOut*(CONST title, buffer: ARRAY OF CHAR; all: BOOLEAN);
+VAR
+	i: LONGINT;
+	length: LONGINT;
+
+BEGIN
+	KernelLog.Ln;KernelLog.String("********************");KernelLog.Ln;
+	KernelLog.String(title); KernelLog.Ln;
+
+	IF all THEN
+		length := LEN(buffer) -1;
+	ELSE
+		length := Strings.Min(LEN(buffer) - 1, 256);
+	END;
+
+	FOR i := 0 TO length DO
+		IF (i MOD 4) = 0 THEN
+			KernelLog.Ln;
+			KernelLog.Int(i, 2);KernelLog.String(":  ");
+		END;
+		KernelLog.Hex(ORD(buffer[i]), -1);
+		KernelLog.String(" ");
+	END;
+
+	KernelLog.Ln;KernelLog.String("********************");KernelLog.Ln;
+END PacketOut;
+
+
+BEGIN
+	(* IPFowarding default value is FALSE *)
+	IPForwarding := FALSE;
+
+	(* EchoReply default value is TRUE *)
+	EchoReply := TRUE;
+
+	(* Initializations *)
+	(* NilAdr *)
+	NilAdr.ipv4Adr := NilAdrIPv4;
+	SetIPv6AdrNil (NilAdr);
+	NilAdr.usedProtocol := NilAdrIdent;
+
+	(* Initialize receiver list *)
+	FOR counter:=0 TO NbrOfReceivers-1 DO
+		receivers[counter] := NIL;
+	END;
+
+	(* Initialize inteface list *)
+	interfaces := NIL;
+END IP.
+
+
+
+Free:
+SystemTools.Free TraceRoute VNC Ping WMFTPClient FTPClient WebFTPServer TCPServices TLS InitNetwork Ping DHCP TCP DNS UDP ICMP IPv4 IPv6 IP~
+
+Start:
+InitNetwork.Init
+
+Compile:
+PC.Compile \s IP.Mod IPv4.Mod IPv6.Mod ICMP.Mod UDP.Mod DNS.Mod TCP.Mod DHCP.Mod InitNetwork.Mod WebFTPServer.Mod FTPClient.Mod WMFTPClient.Mod Ping.Mod VNC.Mod TraceRoute.Mod~
+
+
+
+History:
+02.05.2005	eb	Supports IPv6 and fragmented IPv6 packets.
+
+
+
+
+IsValidIPv6Str:
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`
+
+FSM used in IsValidIPv6Str:
+-----------------------
+EOS: end of string
+	State 1: Initial state
+			0-9/A-F goto state 1
+			: goto state 2
+			/ goto state 3
+			EOS valid
+	State 2:	0-9/A-F goto state 1
+			: goto state 4
+			EOS invalid
+	State 3:	0-9 goto state 3
+			EOS valid
+	State 4:	/ goto state 3
+			0-9/A-F goto state 1
+			EOS valid
+
+			

source/ARM.IPv4.Mod

@@ -0,0 +1,881 @@
+(* Aos, Copyright 2001, Pieter Muller, ETH Zurich *)
+
+MODULE IPv4; (** AUTHOR "pjm, mvt"; PURPOSE "IPv4 and ARP protocols"; *)
+
+(* Ported to ARM by Timothée Martiel, 09.2014 *)
+
+IMPORT SYSTEM, Machine, Kernel, Modules, Clock, KernelLog, Network, IP;
+
+CONST
+	(* DEBUG *)
+	DEBUG = TRUE;
+
+	(* ARP *)
+	ARPHdrLen = 8;
+	ARPPktLen = 28;
+	EtherTypeARP* = 806H;
+	ARPMonitor = FALSE; (* monitor all ARP packets *)
+	ARPHashSize = 256; (* size of ARP hash table *)
+	MinARPTime = 1000; (* minimum time between ARP requests in ms *)
+
+	(* IP *)
+	EtherTypeIP* = 800H;
+	MinIPHdrLen*= 20;
+	MaxIPHdrLen* = 60;
+	TOS = 10X; (* type-of-service on outgoing datagrams *)
+	BroadcastAdr = LONGINT(0FFFFFFFFH);
+
+TYPE
+	ARPEntry = POINTER TO RECORD
+		next: ARPEntry;
+		ip: IP.Adr;
+		ether: Network.LinkAdr;
+		sendTime, updateTime, updateDate: LONGINT;
+		complete: BOOLEAN;
+		buf: IP.Packet; (* buffer for a packet waiting to be sent, NIL if none *)
+	END;
+
+TYPE
+	Interface* = OBJECT(IP.Interface)
+	VAR
+		(* ARP hash table *)
+		arpTable: ARRAY ARPHashSize OF ARPEntry;
+		NARPEntries: LONGINT;
+
+		(* The interface is trying to get an IP from a DHCP *)
+		doingDHCPRequest*: BOOLEAN;
+
+
+		(** Constructor - Open an IPv4 interface and add it to the IP configuration.
+			"name" must be a unique name for this interface (tested in "AddInterface").
+			"dev" must be a Network.LinkDevice that can be used in other interfaces => multiple IP addresses on the
+			same interface. *)
+		PROCEDURE &Constr*(name: IP.Name; dev: Network.LinkDevice; VAR res: LONGINT);
+		VAR
+			i: LONGINT;
+
+		BEGIN
+			ASSERT(dev # NIL);
+
+			SELF.dev := dev;
+			protocol := IP.IPv4;
+			doingDHCPRequest := FALSE;
+
+			(* set name *)
+			IF name = "" THEN
+				res := IP.NoInterfaceName;
+				RETURN;
+			END;
+			COPY(name, SELF.name);
+
+			(* init addresses *)
+			localAdr := IP.NilAdr;
+			maskAdr := IP.NilAdr;
+			gatewayAdr := IP.NilAdr;
+			subnetAdr := IP.NilAdr;
+
+			broadAdr.usedProtocol := IP.IPv4;
+			broadAdr.ipv4Adr := BroadcastAdr;
+
+			(* init ARP *)
+			FOR i := 0 TO ARPHashSize-1 DO
+				arpTable[i] := NIL;
+			END;
+			NARPEntries := 0;
+
+			(* init DNS *)
+			DNScount := 0;
+
+			closed := FALSE;
+
+			IP.AddInterface(SELF, res);
+			IF res = IP.Ok THEN
+				(* install receivers *)
+				dev.InstallReceiver(SELF, EtherTypeIP, IPInput, IsIPPacketValid, IsIPPacketForSingleInt, IsIPPacketAccepted, IP.IPForwarding); (* IPv4 *)
+				dev.InstallReceiver(SELF, EtherTypeARP, ARPInput, IsARPPacketValid, IsARPPacketForSingleInt, IsARPPacketAccepted, FALSE); (* ARP *)
+			ELSE
+				closed := TRUE;
+			END;
+		END Constr;
+
+
+		(** Close and deactivate the interface, i.e. remove it from the configuration. *)
+		PROCEDURE Close*;
+		BEGIN {EXCLUSIVE}
+			ASSERT(~closed);
+
+			closed := TRUE;
+			(* remove receivers *)
+			dev.RemoveReceiver(SELF, EtherTypeIP); (* IPv4 *)
+			dev.RemoveReceiver(SELF, EtherTypeARP); (* ARP *)
+
+			IP.RemoveInterface(SELF);
+		END Close;
+
+
+		(** Send an IP packet on this interface. *)
+		PROCEDURE Send*(type: LONGINT; fip:IP. Adr; CONST l4hdr, data: ARRAY OF CHAR; h4len, dofs, dlen, TTL: LONGINT);
+		VAR
+			l3hdr: ARRAY MaxIPHdrLen OF CHAR;
+
+		BEGIN
+			ASSERT (fip.usedProtocol =  4, 2345 );
+
+			IF closed THEN RETURN END; (* just in case of concurrent Send/Close *)
+
+			(* set IP header *)
+			l3hdr[0] := CHR(IP.IPv4*10H + MinIPHdrLen DIV 4); (* IP version and header length *)
+			l3hdr[1] := TOS; (* type-of-service *)
+			Network.PutNet2(l3hdr, 2, MinIPHdrLen+h4len+dlen); (* total packet length *)
+			Network.PutNet2(l3hdr, 4, GetNextID()); (* identification *)
+			Network.Put2(l3hdr, 6, 0); (* fragmentation *)
+			l3hdr[8] := CHR(TTL); (* time-to-live *)
+			l3hdr[9] := CHR(type); (* IP type code *)
+
+			Network.Put4(l3hdr, 12, localAdr.ipv4Adr); (* set local address *)
+			Network.Put4(l3hdr, 16, fip.ipv4Adr); (* set foreign address *)
+			Network.Put2(l3hdr, 10, 0); (* checksum := 0 *)
+			IF ~(Network.ChecksumIP IN dev.calcChecksum) THEN
+				Network.Put2(l3hdr, 10, IP.Checksum2(l3hdr, 0, MinIPHdrLen, 0)); (* calculate checksum *)
+			END;
+
+			(* perform sending *)
+			DoSend(fip, l3hdr, l4hdr, data, MinIPHdrLen, h4len, dofs, dlen);
+		END Send;
+
+
+		(* Internal procedure to perform the rest of the send operation. Used by "Send" and for IP forwarding. *)
+		PROCEDURE DoSend*(destAdr: IP.Adr; CONST l3hdr, l4hdr, data: ARRAY OF CHAR; h3len, h4len, dofs, dlen: LONGINT) ;
+		VAR
+			linkDst: Network.LinkAdr;
+
+		BEGIN
+			ASSERT (destAdr.usedProtocol = 4, 2345);
+
+			IF h3len+h4len+dlen <= dev.mtu THEN
+				IF dev.type = Network.TypeEthernet THEN
+					IF IP.AdrsEqual (destAdr, localAdr) THEN
+						(* send local loopback *)
+						Machine.AtomicInc(IP.NIPSentLocalLoopback);
+						dev.Send(linkDst, EtherTypeIP, l3hdr, l4hdr, data, h3len, h4len, dofs, dlen, TRUE);
+					ELSIF IsBroadcast(destAdr) (* (fip = broadAdr) OR  OR (fip = BroadcastAdr) OR (fip = OldBroadcastAdr)  *) THEN
+						(* send broadcast *)
+						Machine.AtomicInc(IP.NIPSentBroadcast);
+						dev.Send(dev.broadcast, EtherTypeIP, l3hdr, l4hdr, data, h3len, h4len, dofs, dlen, FALSE);
+					ELSIF IsMulticast(destAdr) THEN
+						(* Drop Multicast packet, NIY *)
+					ELSE
+						IF (~IP.IsNilAdr (gatewayAdr)) & ~SameSubnet(destAdr.ipv4Adr, subnetAdr.ipv4Adr, maskAdr.ipv4Adr) THEN
+							Machine.AtomicInc(IP.NIPSentToGateway);
+							destAdr := gatewayAdr;
+						ELSE
+							Machine.AtomicInc(IP.NIPSentToSubnet);
+						END;
+						IF ARPLookup(destAdr, linkDst) THEN
+							dev.Send(linkDst, EtherTypeIP, l3hdr, l4hdr, data, h3len, h4len, dofs, dlen, FALSE);
+						ELSE
+							ARPQueue(destAdr, l3hdr, l4hdr, data, h3len, h4len, dofs, dlen);
+						END;
+					END;
+				ELSE
+					(* Network.TypePointToPoint *)
+					Machine.AtomicInc(IP.NIPSentPointToPoint);
+					dev.Send(linkDst, EtherTypeIP, l3hdr, l4hdr, data, h3len, h4len, dofs, dlen, IP.AdrsEqual (destAdr, localAdr));
+				END;
+			ELSE
+				Machine.AtomicInc(IP.NIPCantFragment);
+			END;
+		END DoSend;
+
+
+		(* Receive an ARP packet *)
+		PROCEDURE ARPInput* (dev: Network.LinkDevice; type: LONGINT; buffer: Network.Buffer);
+		VAR
+			src, dst: IP.Adr;
+			forus: BOOLEAN;
+
+		BEGIN
+			src := ARPReadSrcAdr (buffer);
+			dst := ARPReadDestAdr (buffer);
+			IF IP.AdrsEqual (src, localAdr) THEN
+				(* duplicate source address! *)
+				Machine.AtomicInc(NARPRcvDuplicate);
+				KernelLog.Enter;
+				KernelLog.String("IP: Address "); IP.OutAdr(src); KernelLog.String(" hijacked by ");
+				Network.OutLinkAdr(SYSTEM.VAL(Network.LinkAdr, buffer.data[buffer.ofs+8]), dev.adrSize); KernelLog.Ln;
+				KernelLog.Exit;
+			ELSIF (buffer.data[buffer.ofs+7] = 1X) OR (buffer.data[buffer.ofs+7] = 2X) THEN
+				(* request or reply *)
+				IF ~ODD(LONG(ORD(buffer.data[buffer.ofs+8]))) & (~IP.IsNilAdr(src)) THEN
+					forus := (IP.AdrsEqual(dst, localAdr));
+					ARPEnter(src, SYSTEM.VAL(Network.LinkAdr, buffer.data[buffer.ofs+8]), forus);
+					IF (buffer.data[buffer.ofs+7] = 1X) & forus THEN
+						(* request for us *)
+						ARPReply(buffer.data, buffer.ofs);
+					END;
+				ELSE
+					(* nil IP address or non-unicast ethernet address supplied *)
+					Machine.AtomicInc(NARPBadAddr)
+				END
+			ELSE
+				Machine.AtomicInc(NARPRcvIgnored)
+			END;
+
+			(* Return the buffer *)
+			Network.ReturnBuffer(buffer);
+		END ARPInput;
+
+
+		(* Receive an IP packet *)
+		PROCEDURE IPInput(dev: Network.LinkDevice; type: LONGINT; buffer: Network.Buffer);
+		VAR
+			hlen: LONGINT;
+			src, dst: IP.Adr;
+			receiver: IP.Receiver;
+			int: IP.Interface;
+
+		BEGIN
+			hlen := ORD(buffer.data[buffer.ofs]) MOD 10H * 4;
+
+			src := ReadSrcAdr (buffer);
+			dst := ReadDestAdr (buffer);
+
+			IF ~IsBroadcast(src) & ~IsMulticast(src)  THEN
+				IF (IP.AdrsEqual (dst,localAdr)) OR IsBroadcast(dst) (* (dst = broadAdr) OR
+					(dst = BroadcastAdr) OR (dst = OldBroadcastAdr) *) THEN
+					(* packet is for us *)
+					type := ORD(buffer.data[buffer.ofs+9]);
+					receiver := IP.receivers[type];
+					IF receiver # NIL THEN
+						(* do receiver upcall *)
+						buffer.l3ofs := buffer.ofs;
+						INC(buffer.ofs, hlen);
+						DEC(buffer.len, hlen);
+						receiver(SELF, type, src, dst, buffer);
+						Machine.AtomicInc(IP.NIPDelivered);
+						(* Exit here w/o returning buffer because it is passed to a receiver *)
+						RETURN;
+					ELSE
+						Machine.AtomicInc(IP.NIPNoReceiver);
+					END;
+				ELSIF  IsMulticast(dst) THEN
+					(* Drop multicast packet, NIY *)
+				ELSIF IP.IPForwarding THEN
+					int := IP.InterfaceByDstIP(dst);
+					IF int # NIL THEN
+						int.DoSend(dst, buffer.data, buffer.data, buffer.data, 0, 0, buffer.ofs, buffer.len);
+						Machine.AtomicInc(IP.NIPForwarded)
+					ELSE
+						Machine.AtomicInc(IP.NIPNotForUs)
+					END;
+				ELSE
+					Machine.AtomicInc(IP.NIPNotForUs)
+				END
+			ELSE
+				Machine.AtomicInc(IP.NIPSrcIsBroadcast)
+			END;
+			(* Exit and return buffer here because it is no longer used *)
+			Network.ReturnBuffer(buffer);
+		END IPInput;
+
+
+		(** Check if adr is a broadcast address *)
+		PROCEDURE IsBroadcast*(adr: IP.Adr) : BOOLEAN;
+		BEGIN
+			ASSERT (adr.usedProtocol = 4, 2345);
+
+			RETURN (adr.ipv4Adr = broadAdr.ipv4Adr) OR
+				 (adr.ipv4Adr = subnetAdr.ipv4Adr) OR (adr.ipv4Adr = BroadcastAdr)
+		END IsBroadcast;
+
+
+		(** Check if adr is a multicast address *)
+		PROCEDURE IsMulticast*(adr: IP.Adr) : BOOLEAN;
+		VAR
+			arr: ARRAY 4 OF CHAR;
+
+		BEGIN
+			ASSERT (adr.usedProtocol = 4, 2345);
+
+			IP.AdrToArray(adr, arr, 0, FALSE);
+			RETURN (ORD(arr[0]) >= 224) & (ORD(arr[0]) < 240)
+		END IsMulticast;
+
+
+		(** Performs a check for Network if a packet is accepted by this interface *)
+		PROCEDURE IsIPPacketAccepted(buffer: Network.Buffer): BOOLEAN;
+		VAR
+			dstAdr: LONGINT;
+			interface: IP.Interface;
+			accept: BOOLEAN;
+
+		BEGIN
+			dstAdr := Network.Get4(buffer.data, buffer.ofs+16);
+
+			IF IP.IsNilAdr(localAdr) THEN
+				IF doingDHCPRequest THEN
+					(* Check if there are other interface waiting for this packet if not take it could be DHCP *)
+					interface := IP.interfaces;
+					WHILE (interface # NIL) & (interface.localAdr.ipv4Adr # dstAdr) DO
+						interface := interface.next;
+					END;
+					IF interface # NIL THEN
+						accept := FALSE;
+					ELSE
+						accept := TRUE;
+					END;
+				ELSE
+					(* An interface with no IP does not take packets *)
+					accept := FALSE;
+				END;
+			ELSE
+				accept := dstAdr = localAdr.ipv4Adr;
+			END;
+
+			RETURN accept;
+		END IsIPPacketAccepted;
+
+
+		(** Set addresses. Is normally called just after instanciation, but can also be called later, e.g. by DHCP.
+			If "gatewayAdr" is "NilAdr", the subnet is considered to have no gateway, else it must be in the same
+			subnet as the "localAdr".
+			"domain" can be an empty string. It is normally used by a DNS implementation. It is not used in IP directly. *)
+		PROCEDURE SetAdrs*(localAdr, maskAdr, gatewayAdr: IP.Adr; VAR res: LONGINT);
+		VAR
+			maskSet: SET;
+
+		BEGIN {EXCLUSIVE}
+			IF DEBUG THEN
+				ASSERT ((IP.IsNilAdr(localAdr)) OR (localAdr.usedProtocol = 4), 2345);
+				ASSERT ((IP.IsNilAdr(maskAdr)) OR (maskAdr.usedProtocol = 4), 2345);
+				ASSERT ((IP.IsNilAdr(gatewayAdr)) OR (gatewayAdr.usedProtocol = 4), 2345);
+			END;
+
+			IF ~IP.IsNilAdr (localAdr) THEN
+				(* Check, if all IPv6 or all IPv4 *)
+				IF ((localAdr.usedProtocol # maskAdr.usedProtocol) OR
+				    ((~IP.IsNilAdr (gatewayAdr)) & (localAdr.usedProtocol # gatewayAdr.usedProtocol))) THEN
+					res := IP.MixedIpProtocols;
+					RETURN;
+				END;
+
+				(* Check if addresses are of same protocol as interface *)
+				IF localAdr.usedProtocol # IP.IPv4 THEN
+					res := IP.IPv6AdrUsedOnIPv4Interface;
+					RETURN;
+				END;
+			END;
+
+			(* set addresses *)
+			SELF.localAdr := localAdr;
+			SELF.maskAdr := maskAdr;
+			SELF.gatewayAdr := gatewayAdr;
+
+			(* compute other addresses  *)
+			maskSet := SYSTEM.VAL(SET, maskAdr.ipv4Adr);
+			subnetAdr.usedProtocol := IP.IPv4;
+			subnetAdr.ipv4Adr := SYSTEM.VAL (LONGINT, SYSTEM.VAL (SET, localAdr.ipv4Adr) * maskSet);
+			broadAdr.usedProtocol := IP.IPv4;
+			broadAdr.ipv4Adr := SYSTEM.VAL (LONGINT, SYSTEM.VAL (SET, subnetAdr.ipv4Adr) + (-maskSet));
+
+			IF (~IP.IsNilAdr (gatewayAdr)) &
+			    ( ~SameSubnet(gatewayAdr.ipv4Adr, localAdr.ipv4Adr, maskAdr.ipv4Adr)) THEN
+				res := IP.GatewayNotInSubnet;
+			ELSE
+				res := IP.Ok;
+			END;
+		END SetAdrs;
+
+
+		(* Reads the source address of a IPv4 packet buffer *)
+		PROCEDURE ReadSrcAdr* (buffer: Network.Buffer): IP.Adr;
+		VAR
+			adr: IP.Adr;
+
+		BEGIN
+			adr.usedProtocol := IP.IPv4;
+			adr.ipv4Adr := Network.Get4(buffer.data, buffer.ofs+12);
+			RETURN adr;
+		END ReadSrcAdr;
+
+
+		(* Reads the destination address of a IPv4 packet buffer *)
+		PROCEDURE ReadDestAdr* (buffer: Network.Buffer): IP.Adr;
+		VAR
+			adr: IP.Adr;
+
+		BEGIN
+			adr.usedProtocol := IP.IPv4;
+			adr.ipv4Adr := Network.Get4(buffer.data, buffer.ofs+16);
+			RETURN adr;
+		END ReadDestAdr;
+
+
+
+		(** Creates a pseudo-header for checksum calculation (TCP/UDP) and returns the length of this header *)
+		PROCEDURE WritePseudoHeader*(VAR pseudoHdr: ARRAY OF CHAR;  src, dst: IP.Adr; protocol, pktLengthUpperLayer: LONGINT): LONGINT;
+		BEGIN
+			(* UDP/TCP Pseudo-header (for checksum calculation)
+
+			00	32	source address
+			04	32	destination address
+			08	08	zero = 0
+			09	08	protocol = 17
+			10	16	UDP/TCP length *)
+
+			Network.Put4(pseudoHdr, 0, src.ipv4Adr); (* local IP address *)
+			Network.Put4(pseudoHdr, 4, dst.ipv4Adr); (* foreign IP address *)
+			Network.PutNet2(pseudoHdr, 8, protocol); (* IP type code of UDP/TCP*)
+			Network.PutNet2(pseudoHdr, 10, pktLengthUpperLayer); (* UPD/TCP length *)
+
+			RETURN 12; (* IPv4 pseudo header length *)
+		END WritePseudoHeader;
+
+
+		(* Reads the source address of a ARP packet buffer *)
+		PROCEDURE ARPReadSrcAdr* (buffer: Network.Buffer): IP.Adr;
+		VAR
+			adr: IP.Adr;
+
+		BEGIN
+			adr.usedProtocol := IP.IPv4;
+			adr.ipv4Adr := Network.Get4(buffer.data, buffer.ofs+14);
+			RETURN adr;
+		END ARPReadSrcAdr;
+
+
+		(* Reads the destination address of a ARP packet buffer *)
+		PROCEDURE ARPReadDestAdr* (buffer: Network.Buffer): IP.Adr;
+		VAR
+			adr: IP.Adr;
+
+		BEGIN
+			adr.usedProtocol := IP.IPv4;
+			adr.ipv4Adr := Network.Get4(buffer.data, buffer.ofs+24);
+			RETURN adr;
+		END ARPReadDestAdr;
+
+
+		(** Enumerate all ARP table entries. *)
+		PROCEDURE ARPEnumerate*(handle: IP.ARPHandler);
+		VAR
+			p: ARPEntry;
+			i: LONGINT;
+
+		BEGIN
+			FOR i := 0 TO ARPHashSize-1 DO
+				p := arpTable[i];
+				WHILE p # NIL DO
+					handle(p.ip, p.complete, p.ether, 6, p.sendTime, p.updateTime, p.updateDate, i);
+					p := p.next
+				END
+			END
+		END ARPEnumerate;
+
+
+		(* Update or add an ARP entry. *)
+		PROCEDURE ARPEnter(ip:IP. Adr; ether: Network.LinkAdr; forus: BOOLEAN);
+		VAR
+			p, q: ARPEntry;
+			n: LONGINT;
+
+			(* Create a new entry at the front of the hash list *)
+			PROCEDURE NewEntry;
+			BEGIN
+				NEW(p);
+				p.ip := ip;
+				p.buf := NIL;
+				p.sendTime := Kernel.GetTicks() - minARPTime;
+				p.complete := FALSE;
+				p.next := arpTable[n];
+				arpTable[n] := p;
+				Machine.AtomicInc(NARPEntries);
+			END NewEntry;
+
+		BEGIN {EXCLUSIVE}
+			ASSERT (ip.usedProtocol = 4, 2345);
+
+			n := ARPHash(ip.ipv4Adr);
+			p := arpTable[n];
+			WHILE (p # NIL) & (~IP.AdrsEqual(p.ip,ip)) DO
+				p := p.next;
+			END;
+			IF (p = NIL) & (ARPMonitor OR forus) THEN
+				NewEntry();
+			END;
+			IF p # NIL THEN	(* update address *)
+				IF ARPMonitor & p.complete & ~Network.Equal(ether, p.ether, 0, 0, 6) THEN
+					(* mapping changed! *)
+					q := p.next;
+					WHILE (q # NIL) & (~Network.Equal(ether, q.ether, 0, 0, 6) OR ~IP.AdrsEqual(q.ip, ip)) DO
+						q := q.next
+					END;
+					IF q # NIL THEN (* we had this changed mapping before *)
+						p := q; (* update it *)
+					ELSE
+						(* insert new mapping at front *)
+						KernelLog.Enter;
+						KernelLog.String("IP: Address for "); IP.OutAdr(p.ip);
+						KernelLog.String(" changed from "); Network.OutLinkAdr(p.ether, 6);
+						KernelLog.String(" to "); Network.OutLinkAdr(ether, 6);
+						KernelLog.Exit;
+						NewEntry();
+					END;
+				END;
+				(* send queued packet *)
+				IF p.buf # NIL THEN
+					dev.Send(ether, EtherTypeIP, p.buf^, p.buf^, p.buf^, 0, 0, 0, LEN(p.buf^), FALSE);
+					p.buf := NIL; (* 26.02.04 : fixes the resend bug *)
+				END;
+				(* update entry *)
+				p.ether := ether;
+				p.complete := TRUE;
+				Clock.Get(p.updateTime, p.updateDate);
+			END
+		END ARPEnter;
+
+
+		(* Send an ARP reply. Assume arp/ofs contains a valid ARP request packet. *)
+		PROCEDURE ARPReply(VAR arp: ARRAY OF CHAR; ofs: LONGINT);
+		BEGIN
+			Machine.AtomicInc(NARPReply);
+			arp[ofs+7] := 2X;	(* reply operation *)
+			Network.Copy(arp, arp, ofs+8, ofs+18, 6+4); (* target := sender *)
+			Network.Copy(dev.local, arp, 0, ofs+8, 6); (* sender ethernet address *)
+			Network.Put4(arp, ofs+14, localAdr.ipv4Adr); (* sender ip address *)
+			dev.Send(SYSTEM.VAL(Network.LinkAdr, arp[ofs + 18]), EtherTypeARP, arp, arp, arp, 0, 0, ofs, ARPPktLen, FALSE);
+		END ARPReply;
+
+
+		(* Look for the ethernet address matching the specified ip address. *)
+		PROCEDURE ARPLookup(ip: IP.Adr; VAR ether: Network.LinkAdr): BOOLEAN;
+		VAR p: ARPEntry; c: BOOLEAN;
+		BEGIN
+			ASSERT (ip.usedProtocol = 4, 2345);
+
+			p := arpTable[ARPHash(ip.ipv4Adr)];
+			LOOP
+				IF p = NIL THEN RETURN FALSE END;
+				IF IP.AdrsEqual (p.ip, ip) THEN
+					c := p.complete; (* to allow concurrent "Enter" *)
+					ether := p.ether;
+					RETURN c;
+				END;
+				p := p.next
+			END
+		END ARPLookup;
+
+
+		(* Queue an IP packet awaiting an ARP reply. *)
+		PROCEDURE ARPQueue(dst: IP.Adr; CONST l3hdr, l4hdr, data: ARRAY OF CHAR; h3len, h4len, dofs, dlen: LONGINT);
+		VAR p: ARPEntry; n: LONGINT;
+		BEGIN {EXCLUSIVE}
+			ASSERT (dst.usedProtocol = 4, 2345);
+
+			Machine.AtomicInc(NARPPut);
+			n := ARPHash(dst.ipv4Adr);
+			p := arpTable[n];
+			WHILE (p # NIL) & (~IP.AdrsEqual (p.ip, dst)) DO
+				p := p.next
+			END;
+			IF p = NIL THEN
+				(* not found, create a new incomplete entry *)
+				NEW(p);
+				p.complete := FALSE;
+				p.ip := dst;
+				p.sendTime := Kernel.GetTicks() - minARPTime;
+				(* store one packet with the incomplete entry *)
+				NEW(p.buf, h3len+h4len+dlen);
+				Network.Copy(l3hdr, p.buf^, 0, 0, h3len);
+				Network.Copy(l4hdr, p.buf^, 0, h3len, h4len);
+				Network.Copy(data, p.buf^, dofs, h3len+h4len, dlen);
+				(* publish the incomplete entry *)
+				p.next := arpTable[n];
+				arpTable[n] := p;
+				Machine.AtomicInc(NARPEntries);
+			END;
+
+			IF p.complete THEN
+				(* address arrived in the mean-time, so send the packet *)
+				dev.Send(p.ether, EtherTypeIP, l3hdr, l4hdr, data, h3len, h4len, dofs, dlen, FALSE);
+			ELSE
+				(* (re-)send ARP request *)
+				IF Kernel.GetTicks() - p.sendTime >= minARPTime THEN
+					ARPRequest(dst);
+					p.sendTime := Kernel.GetTicks();
+				ELSE
+					Machine.AtomicInc(NARPSkipped);
+				END
+			END
+		END ARPQueue;
+
+
+		(* Send an ARP request *)
+		PROCEDURE ARPRequest(ip: IP.Adr);
+		VAR
+			i: LONGINT;
+			arp: ARRAY ARPPktLen OF CHAR;
+		BEGIN
+			ASSERT (ip.usedProtocol = 4, 2345);
+
+			Machine.AtomicInc(NARPRequest);
+			Network.Copy(arpProto, arp, 0, 0, ARPHdrLen);
+			arp[7] := 1X; (* request operation *)
+			Network.Copy(dev.local, arp, 0, 8, 6); (* sender ethernet address *)
+			Network.Put4(arp, 14, localAdr.ipv4Adr); (* sender ip address *)
+			(* target ethernet address *)
+			FOR i:= 18 TO 23 DO
+				arp[i] := 0X;
+			END;
+			Network.Put4(arp, 24, ip.ipv4Adr); (* target ip address *)
+			dev.Send(dev.broadcast, EtherTypeARP, arp, arp, arp, 0, 0, 0, ARPPktLen, FALSE);
+		END ARPRequest;
+
+
+		(** Writes the configuration of this interface *)
+		PROCEDURE OutInterface*;
+		VAR i: LONGINT;
+			str : ARRAY 32 OF CHAR;
+		BEGIN
+			IF closed THEN
+				KernelLog.Enter;
+				KernelLog.String("IP.OutInterface: Error: Interface already closed!"); KernelLog.Ln;
+				KernelLog.Exit;
+			ELSE
+				KernelLog.Enter; KernelLog.Ln;
+				KernelLog.String("=== Interface ==="); KernelLog.Ln;
+				KernelLog.String("Interface name: "); KernelLog.String(name); KernelLog.Ln;
+				KernelLog.String("Attached device: "); KernelLog.String(dev.name);
+				IF dev.Linked() = Network.LinkLinked THEN
+					KernelLog.String(" (LinkLinked)"); KernelLog.Ln;
+				ELSIF dev.Linked() = Network.LinkNotLinked THEN
+					KernelLog.String(" (LinkNotLinked)"); KernelLog.Ln;
+				ELSE
+					KernelLog.String(" (LinkUnknown)"); KernelLog.Ln;
+				END;
+
+				Network.LinkAdrToStr(dev.local, 8, str);
+				KernelLog.String("MAC address: "); KernelLog.String(str); KernelLog.Ln;
+				KernelLog.String("Local address: "); IP.OutAdr(localAdr); KernelLog.Ln;
+
+				KernelLog.String("Netmask: "); IP.OutAdr(maskAdr); KernelLog.Ln;
+				KernelLog.String("Gateway address: "); IP.OutAdr(gatewayAdr); KernelLog.Ln;
+				KernelLog.String("Subnet: "); IP.OutAdr(subnetAdr); KernelLog.Ln;
+				KernelLog.String("Net broadcast: "); IP.OutAdr(broadAdr); KernelLog.Ln;
+
+				IF DNScount > 0 THEN
+					FOR i:= 0 TO DNScount-1 DO
+						KernelLog.String("DNS server: "); IP.OutAdr(DNS[i]); KernelLog.Ln;
+					END;
+				ELSE
+					KernelLog.String("DNS server: none"); KernelLog.Ln;
+				END;
+				KernelLog.Exit;
+			END;
+		END OutInterface;
+
+
+	END Interface;
+
+
+VAR
+	(* Module variables *)
+	nextID: INTEGER;
+
+	(* ARP *)
+	arpProto: ARRAY ARPHdrLen OF CHAR;
+	minARPTime: LONGINT;	(* minimum time between ARP requests in ticks *)
+
+	(* ARP counters *)
+	NARPPut-, NARPRcvTotal-, NARPRcvTooSmall-, NARPRcvIgnored-, NARPRcvDuplicate-, NARPBadAddr-,
+	NARPRequest-, NARPReply-, NARPSkipped-: LONGINT;
+
+
+(* Return TRUE if "adr1" and "adr2" are in the same subnet defined by "mask". *)
+PROCEDURE SameSubnet(adr1, adr2, mask: LONGINT): BOOLEAN;
+VAR
+	set1, set2: SET;
+BEGIN
+	set1 := SYSTEM.VAL(SET, mask) * SYSTEM.VAL(SET, adr1);
+	set2 := SYSTEM.VAL(SET, mask) * SYSTEM.VAL(SET, adr2);
+	RETURN set1 = set2
+(*CODE
+	LDR	R0, [FP, #adr1]
+	LDR	R1, [FP, #adr2]
+	LDR	R2, [FP, #mask]
+	AND	R0, R0, R2
+	AND	R1, R1, R2
+	CMP	R0, R1
+	BNE	different
+	MOV	R0, #1
+	B end
+different:
+	MOV	R0, #0
+end:*)
+END SameSubnet;
+
+
+(* Inline hash function for ARP hash table *)
+PROCEDURE -ARPHash(ip: LONGINT): LONGINT;
+(*CODE {SYSTEM.i386}
+	; hash := ip MOD ARPHashSize;
+	POP EAX
+	; Convert IP to host byte order
+	XCHG AL, AH
+	ROL EAX, 16
+	XCHG AL, AH
+	; MOD operation
+	MOV EBX, ARPHashSize
+	XOR EDX, EDX
+	DIV EBX
+	MOV EAX, EDX*)
+CODE
+	LDR	R0, [SP, #ip]
+	MOV	R1, #ARPHashSize-1
+	AND	R0, R0, R1
+	ADD	SP, SP, #4
+END ARPHash;
+
+
+(** Performs a check for Network if a packet is only for a single interface. Every ARP packet should go to every interface*)
+PROCEDURE IsARPPacketForSingleInt(buffer: Network.Buffer): BOOLEAN;
+BEGIN
+	RETURN FALSE;
+END IsARPPacketForSingleInt;
+
+
+(** Performs a check for Network if a packet is for a single interface *)
+PROCEDURE IsIPPacketForSingleInt(buffer: Network.Buffer): BOOLEAN;
+BEGIN
+	RETURN ~(buffer.data[buffer.ofs+19] = 0FFX);
+END IsIPPacketForSingleInt;
+
+
+(** Performs a check for Network if a packet is accepted by this interface. Every ARP packet is accepted *)
+PROCEDURE IsARPPacketAccepted(buffer: Network.Buffer): BOOLEAN;
+BEGIN
+	RETURN TRUE;
+END IsARPPacketAccepted;
+
+
+(** Checks if an IPv4 packet is valid *)
+PROCEDURE IsIPPacketValid(VAR buffer: Network.Buffer): BOOLEAN;
+VAR
+	isValid: BOOLEAN;
+	hlen, tlen, frag: LONGINT;
+
+BEGIN
+	isValid := FALSE;
+
+	Machine.AtomicInc(IP.NIPRcvTotal);
+	IF buffer.len >= MinIPHdrLen THEN
+		IF LSH(ORD(buffer.data[buffer.ofs]), -4) = IP.IPv4 THEN
+			hlen := ORD(buffer.data[buffer.ofs]) MOD 10H * 4;
+			IF (hlen >= MinIPHdrLen) & (hlen <= MaxIPHdrLen) THEN
+				IF (Network.ChecksumIP IN buffer.calcChecksum) OR (IP.Checksum2(buffer.data, buffer.ofs, hlen, 0) = 0) THEN
+					tlen := Network.GetNet2(buffer.data, buffer.ofs+2);
+					IF (tlen >= hlen) & (tlen <= buffer.len) THEN
+						IF tlen < buffer.len THEN
+							(* size not used *)
+							Machine.AtomicInc(IP.NIPTrim);
+							buffer.len := tlen;
+						END;
+						frag := Network.GetNet2(buffer.data, buffer.ofs+6);
+						IF (frag = 0) OR (frag = 4000H) THEN (* not a fragment *)
+							IF hlen # MinIPHdrLen THEN
+								(* process options here *)
+								Machine.AtomicInc(IP.NIPOptions);
+							END;
+
+							isValid := TRUE;
+						ELSE
+							Machine.AtomicInc(IP.NIPCantReassemble)
+						END
+					ELSE
+						Machine.AtomicInc(IP.NIPBadLength)
+					END
+				ELSE
+					Machine.AtomicInc(IP.NIPBadChecksum)
+				END
+			ELSE
+				Machine.AtomicInc(IP.NIPBadHdrLen)
+			END
+		ELSE
+			Machine.AtomicInc(IP.NIPBadVersion)
+		END
+	ELSE
+		Machine.AtomicInc(IP.NIPTooSmall)
+	END;
+	RETURN isValid;
+END IsIPPacketValid;
+
+
+(** Checks if an ARP packet is valid *)
+PROCEDURE IsARPPacketValid(VAR buffer: Network.Buffer): BOOLEAN;
+VAR
+	isValid: BOOLEAN;
+
+BEGIN
+	isValid := FALSE;
+
+	Machine.AtomicInc(NARPRcvTotal);
+	IF buffer.len >= ARPPktLen THEN
+		IF Network.Equal(buffer.data, arpProto, buffer.ofs, 0, ARPHdrLen-1) THEN
+			isValid := TRUE;
+		ELSE
+			Machine.AtomicInc(NARPRcvIgnored)
+		END
+	ELSE
+		Machine.AtomicInc(NARPRcvTooSmall)
+	END;
+	RETURN isValid;
+END IsARPPacketValid;
+
+
+(* Return a unique datagram ID *)
+PROCEDURE GetNextID*(): INTEGER;
+BEGIN {EXCLUSIVE}
+	INC(nextID);
+	RETURN nextID;
+END GetNextID;
+
+
+PROCEDURE Cleanup;
+BEGIN
+	(* Remove all interfaces *)
+	WHILE IP.interfaces # NIL DO
+		IP.interfaces.Close();
+	END;
+END Cleanup;
+
+
+BEGIN
+	(* intializations *)
+	nextID := 0;
+
+	(* Init ARP variables *)
+	minARPTime := MinARPTime * Kernel.second DIV 1000;
+	arpProto[0] := 0X; arpProto[1] := 1X; (* hardware type ethernet *)
+	arpProto[2] := CHR(EtherTypeIP DIV 100H); (* protocol type IP *)
+	arpProto[3] := CHR(EtherTypeIP MOD 100H);
+	arpProto[4] := 6X; arpProto[5] := 4X; (* lengths *)
+	arpProto[6] := 0X; arpProto[7] := 0X; (* no operation *)
+
+	Modules.InstallTermHandler(Cleanup);
+END IPv4.
+
+
+
+
+Free:
+SystemTools.Free TraceRoute VNC Ping WMFTPClient FTPClient WebFTPServer TCPServices TLS InitNetwork Ping DHCP TCP DNS UDP ICMP IPv4 IPv6 IP~
+
+Start:
+InitNetwork.Init
+
+Compile:
+PC.Compile \s IP.Mod IPv4.Mod IPv6.Mod ICMP.Mod UDP.Mod DNS.Mod TCP.Mod DHCP.Mod InitNetwork.Mod WebFTPServer.Mod FTPClient.Mod WMFTPClient.Mod Ping.Mod VNC.Mod TraceRoute.Mod~
+
+
+History:
+02.05.2005	eb	Created.

source/ARM.Network.Mod

@@ -0,0 +1,936 @@
+(* Aos, Copyright 2001, Pieter Muller, ETH Zurich *)
+
+MODULE Network; (** AUTHOR "pjm, mvt"; PURPOSE "Abstract network device driver"; *)
+(* Ported to ARM by Timothée Martiel, 2014. *)
+
+IMPORT SYSTEM, Machine, KernelLog, Plugins, Kernel, Objects, Modules;
+
+CONST
+	MaxLinkAdrSize* = 8; (** largest link address size in bytes *)
+	MaxPacketSize* = 1600; (** maximum amount of data bytes in a link layer frame *)
+	MaxNofBuffers = 10000; (* maximum number of buffers allowed within the whole net system *)
+
+	(** Constants for LinkDevice.type *)
+	TypePointToPoint* = 0;
+	TypeEthernet* = 1;
+
+	(** Constants for LinkDevice.Linked *)
+	LinkNotLinked* = 0;
+	LinkLinked* = 1;
+	LinkUnknown* = 2;
+
+	(** Constants for LinkDevice.calcChecksum and Buffer.calcChecksum *)
+	ChecksumIP* = 0;
+	ChecksumUDP* = 1;
+	ChecksumTCP* = 2;
+
+	(* Number of loopback packets that can be sent per 1-2 ms.
+		This protects the upcall buffers from running out. *)
+	MaxLoopbackPacketsPerMS = 500;
+
+TYPE
+	LinkAdr* = ARRAY MaxLinkAdrSize OF CHAR; (** link layer address *)
+
+	(** Buffer for passing network packets to upper layer protocols *)
+	Buffer* = POINTER TO RECORD
+		data*:ARRAY MaxPacketSize OF CHAR;
+		ofs*: LONGINT; (** valid data starts at this offset *)
+		len*: LONGINT; (** length of valid data *)
+		l3ofs*: LONGINT; (** the layer 3 header starts at this offset *)
+		l4ofs*: LONGINT; (** the layer 4 header starts at this offset *)
+		src*: LinkAdr; (** link layer source address *)
+		calcChecksum*: SET; (** these checksums are already verified by the device *)
+		int*: LONGINT; (** used in TCP, UDP and ICMP, but can be used by any upper layer protocol *)
+		set*: SET; (** used in TCP, but can be used by any upper layer protocol *)
+		next*, prev*: Buffer; (** for queueing the buffer *)
+		nextFragment*: Buffer; (** next buffer of a fragmented packet *)
+	END;
+
+
+	(* List of type i.e. 800X for IP *)
+	TypeList = POINTER TO RECORD
+		next: TypeList;
+		type: LONGINT;
+		recList: ReceiverList;
+	END;
+
+
+	ReceiverList = POINTER TO RECORD
+		next: ReceiverList;
+		owner: ANY;
+		receiver: Receiver;
+		isPacketValid: IsPacketValid;
+		isPacketForSingleRec: IsPacketForSingleRec;
+		isPacketAccepted: IsPacketAccepted;
+		isForwardingOn: BOOLEAN;
+	END;
+
+	SendSnifferList = POINTER TO RECORD
+		next: SendSnifferList;
+		sniffer: SendSniffer;
+	END;
+
+	RecvSnifferList = POINTER TO RECORD
+		next: RecvSnifferList;
+		sniffer: ReceiveSniffer;
+	END;
+
+	(** Abstract implementation of a generic network driver object *)
+
+	LinkDevice* = OBJECT (Plugins.Plugin)
+		VAR
+			(** pubic device properties *)
+			type-: LONGINT; (** LinkType: TypePointToPoint, TypeEthernet *)
+			local*: LinkAdr; (** local link address *)
+			broadcast*: LinkAdr; (** link address for sending a broadcast *)
+			mtu-: LONGINT; (** largest packet size in bytes *)
+			adrSize*: LONGINT; (** link address size in bytes *)
+			sendCount*, recvCount-: HUGEINT; (** number of bytes sent and received *)
+			calcChecksum*: SET; (** these checksums are calculated by the device hardware when sending. *)
+
+			typeList: TypeList; (* List of types i.e. 0800X for IP, holds all receiver for a certain type *)
+			recList: ReceiverList; (* receiver list *)
+			sendSnifferList: SendSnifferList; (* list for send sniffers *)
+			recvSnifferList: RecvSnifferList; (* list for receive sniffers *)
+
+			typeItem: TypeList; (* temporary item in type list *)
+			recItem: ReceiverList; (* temporary item in receiver list *)
+			sniffer: RecvSnifferList; (* temporary item in receive sniffer list *)
+
+			discard: BOOLEAN; (* shall the current packet be discarded? (used in active body) *)
+			finalized: BOOLEAN; (* is object already finalized or currently finalizing? *)
+
+			(* queue for buffers waiting for upcall *)
+			upBufFirst, upBufLast: Buffer;
+			buf: Buffer; (* temporary buffer for active body *)
+			bufSec: Buffer; (* temporary buffer for multiple interfaces listening *)
+
+			(* timer and packet count for loopback bandwidth control *)
+			timer: Kernel.MilliTimer;
+			packetCount: LONGINT;
+
+			i: LONGINT;
+
+
+		(** Constructor - Initialize the driver and the device.
+			NOTE:
+			Is normally overridden by device driver. If so, this constructor has to be called at the beginning
+			of the overriding constructor!
+		*)
+		PROCEDURE &Constr*(type, mtu, adrSize: LONGINT);
+		BEGIN
+			ASSERT((mtu >= 0) & (mtu <= MaxPacketSize));
+			ASSERT((adrSize >= 0) & (adrSize <= MaxLinkAdrSize));
+			IF type = TypeEthernet THEN
+				ASSERT(adrSize = 6);
+			END;
+			SELF.type := type;
+			SELF.mtu := mtu;
+			SELF.adrSize := adrSize;
+			SELF.sendCount := 0;
+			SELF.recvCount := 0;
+			SELF.calcChecksum := {};
+
+			typeList := NIL;
+			recList := NIL;
+			upBufFirst := NIL;
+
+			Kernel.SetTimer(timer, 2);
+			packetCount := 0;
+
+			finalized := FALSE;
+
+			sendSnifferList := NIL;
+			recvSnifferList := NIL;
+		END Constr;
+
+		(** Destructor - Finalize driver object. If connected = TRUE, device is still connected and has to be deinitialized.
+			NOTE:
+			Is normally overridden by device driver. If so, this method has to be called at the end
+			of the overriding method!
+		*)
+		PROCEDURE Finalize*(connected: BOOLEAN);
+		BEGIN {EXCLUSIVE}
+			ASSERT(~finalized);
+			finalized := TRUE;
+		END Finalize;
+
+		(** Return the link status of the device.
+			This function has to be overridden by the device driver in order to provide this information.
+		*)
+		PROCEDURE Linked*(): LONGINT;
+		BEGIN
+			RETURN LinkUnknown;
+		END Linked;
+
+
+		(** Send a packet. Called by its user. Can be called concurrently. *)
+		PROCEDURE Send*(dst: LinkAdr; type: LONGINT; CONST l3hdr, l4hdr, data: ARRAY OF CHAR; h3len, h4len, dofs, dlen: LONGINT; loopback: BOOLEAN);
+		VAR
+			sniffer: SendSnifferList;
+			discard: BOOLEAN; (* shall the packet be discarded? *)
+		BEGIN (* can run concurrently with InstallSendSniffer and RemoveSendSniffer *)
+			ASSERT(~finalized);
+			discard := FALSE;
+			sniffer := sendSnifferList;
+			WHILE sniffer # NIL DO
+				(* call sniffer *)
+				discard := discard OR sniffer^.sniffer(SELF, dst, type, l3hdr, l4hdr, data, h3len, h4len, dofs, dlen);
+				sniffer := sniffer^.next;
+			END;
+			IF ~discard THEN
+				(* send the packet *)
+				IF loopback THEN
+					Loopback(dst, type, l3hdr, l4hdr, data, h3len, h4len, dofs, dlen);
+				ELSE
+					DoSend(dst, type, l3hdr, l4hdr, data, h3len, h4len, dofs, dlen);
+				END;
+				INC(sendCount, dlen + h3len + h4len);
+			END;
+		END Send;
+
+		(** Do frame send operation. Must be overridden and implemented by device driver! *)
+		(** Must be able to handle concurrent calls. e.g. by declaring itself as EXCLUSIVE! *)
+
+		PROCEDURE DoSend*(dst: LinkAdr; type: LONGINT; CONST l3hdr, l4hdr, data: ARRAY OF CHAR; h3len, h4len, dofs, dlen: LONGINT);
+		BEGIN
+			HALT(301); (* Abstract! *)
+		END DoSend;
+
+		(* Do internal loopback. Send packet directly to the receive queue. *)
+
+		PROCEDURE Loopback(dst: LinkAdr; type: LONGINT; CONST l3hdr, l4hdr, data: ARRAY OF CHAR; h3len, h4len, dofs, dlen: LONGINT);
+		VAR buf: Buffer;
+		BEGIN
+			IF packetCount >= MaxLoopbackPacketsPerMS THEN
+				WHILE ~Kernel.Expired(timer) DO
+					(* no more packets can be sent until timer is expired *)
+					Objects.Yield();
+				END;
+				Kernel.SetTimer(timer, 2);
+				packetCount := 0;
+			END;
+
+			buf := GetNewBuffer();
+			IF buf # NIL THEN
+				buf.l3ofs := 0;
+				buf.l4ofs := 0;
+				buf.ofs := 0;
+				buf.len := 0;
+				buf.src := dst;
+				buf.calcChecksum := {ChecksumIP, ChecksumUDP, ChecksumTCP};
+
+				(* Copy data to receive buffer *)
+				Copy(l3hdr, buf.data, 0, buf.len, h3len);
+				INC(buf.len, h3len);
+				Copy(l4hdr, buf.data, 0, buf.len, h4len);
+				INC(buf.len, h4len);
+				Copy(data, buf.data, dofs, buf.len, dlen);
+				INC(buf.len, dlen);
+
+				(* Queue the receive buffer *)
+				QueueBuffer(buf, type);
+				Machine.AtomicInc(packetCount)
+			ELSE (* packet loss in loopback :o *)
+
+			END
+		END Loopback;
+
+
+		(** Install a receiver for the given type. *)
+		PROCEDURE InstallReceiver*(owner: ANY;
+									    type: LONGINT;
+									    receiver: Receiver;
+									    isPacketValid: IsPacketValid;
+									    isPacketForSingleRec: IsPacketForSingleRec;
+									    isPacketAccepted: IsPacketAccepted;
+									   isForwardingOn: BOOLEAN);
+		VAR
+			typeItem: TypeList;
+		 	recItem: ReceiverList;
+
+		BEGIN {EXCLUSIVE}	(* can run concurrently with active body *)
+			ASSERT(owner # NIL);
+			ASSERT(~finalized);
+			ASSERT(receiver # NIL);
+			ASSERT(isPacketValid # NIL);
+			ASSERT(isPacketForSingleRec # NIL);
+			ASSERT(isPacketAccepted # NIL);
+
+			IF type = 806H THEN
+				KernelLog.String("Registered ARP receiver"); KernelLog.Ln
+			ELSE
+				KernelLog.String("Registered NON ARP receiver"); KernelLog.Ln
+			END;
+			
+			(* exists the type already? *)
+			typeItem := typeList;
+			WHILE (typeItem # NIL) & (typeItem^.type # type) DO
+				typeItem := typeItem^.next;
+			END;
+
+			IF typeItem = NIL THEN
+				(* create new type item *)
+				NEW(typeItem);
+				typeItem^.next := typeList;
+				typeItem^.type := type;
+				typeItem^.recList := NIL;
+				typeList := typeItem;
+			END;
+
+			(* create a new receiver list item *)
+			NEW(recItem);
+			recItem^.owner := owner;
+			recItem^.receiver := receiver;
+			recItem^.isPacketValid := isPacketValid;
+			recItem^.isPacketForSingleRec := isPacketForSingleRec;
+			recItem^.isPacketAccepted := isPacketAccepted;
+			recItem^.isForwardingOn := isForwardingOn;
+			recItem^.next := typeItem^.recList;
+			typeItem^.recList := recItem;
+		END InstallReceiver;
+
+
+		(** Remove the currently installed receiver for the given type. *)
+		PROCEDURE RemoveReceiver*(owner: ANY; type: LONGINT);
+		VAR
+			typeItem: TypeList;
+			recItem: ReceiverList;
+			typeItemDel: TypeList;
+
+
+		BEGIN {EXCLUSIVE}		(* can run concurrently with active body *)
+			ASSERT(owner # NIL);
+			ASSERT(~finalized);
+
+			(* search type *)
+			typeItem := typeList;
+			WHILE (typeItem # NIL) & (typeItem^.type # type) DO
+				typeItem := typeItem^.next;
+			END;
+
+			IF typeItem # NIL THEN
+				(* search and remove receiver *)
+				recItem := typeItem^.recList;
+
+				IF (recItem # NIL) & (recItem^.owner = owner) THEN
+					(* remove first item *)
+					typeItem^.recList := recItem^.next;
+				ELSE
+					(* search list *)
+					WHILE (recItem^.next # NIL) & (recItem^.next^.owner # owner) DO
+						recItem := recItem^.next;
+					END;
+
+					IF recItem^.next # NIL THEN
+						(* found a receiver *)
+						recItem^.next := recItem^.next^.next;
+					END;
+				END;
+
+				(* If there is no receiver anymore remove type *)
+				IF typeItem^.recList = NIL THEN
+					typeItemDel := typeItem;
+					typeItem := typeList;
+
+					IF (typeItem = typeItemDel) THEN
+						(* remove first type *)
+						typeList := typeItem^.next;
+					ELSE
+						(* search type list *)
+						WHILE (typeItem^.next # typeItemDel) DO
+							typeItem := typeItem^.next;
+						END;
+						typeItem^.next := typeItem^.next^.next;
+					END;
+				END;
+			END;
+		END RemoveReceiver;
+
+
+		(** Install a sniffer for sent packets *)
+		PROCEDURE InstallSendSniffer*(s: SendSniffer);
+		VAR item: SendSnifferList;
+		BEGIN {EXCLUSIVE}
+			ASSERT(~finalized);
+			item := sendSnifferList;
+			WHILE (item # NIL) & (item^.sniffer # s) DO
+				item := item^.next;
+			END;
+			IF item # NIL THEN
+				(* sniffer already registered *)
+			ELSE
+				NEW(item);
+				item^.sniffer := s;
+				item^.next := sendSnifferList;
+				sendSnifferList := item;
+			END;
+		END InstallSendSniffer;
+
+		(** Remove a sniffer for sent packets *)
+		PROCEDURE RemoveSendSniffer*(s: SendSniffer);
+		VAR item: SendSnifferList;
+		BEGIN {EXCLUSIVE}
+			ASSERT(~finalized);
+			IF sendSnifferList = NIL THEN
+				(* empty list *)
+			ELSIF sendSnifferList^.sniffer = s THEN
+				(* remove first item *)
+				sendSnifferList := sendSnifferList^.next;
+			ELSE
+				(* search list *)
+				item := sendSnifferList;
+				WHILE (item^.next # NIL) & (item^.next^.sniffer # s) DO
+					item := item^.next;
+				END;
+				IF item^.next # NIL THEN
+					item^.next := item^.next^.next;
+				ELSE
+					(* sniffer not found *)
+				END;
+			END;
+		END RemoveSendSniffer;
+
+		(** Install a sniffer for received packets *)
+		PROCEDURE InstallReceiveSniffer*(s: ReceiveSniffer);
+		VAR item: RecvSnifferList;
+		BEGIN {EXCLUSIVE}
+			ASSERT(~finalized);
+			item := recvSnifferList;
+			WHILE (item # NIL) & (item^.sniffer # s) DO
+				item := item^.next;
+			END;
+			IF item # NIL THEN
+				(* sniffer already registered *)
+			ELSE
+				NEW(item);
+				item^.sniffer := s;
+				item^.next := recvSnifferList;
+				recvSnifferList := item;
+			END;
+		END InstallReceiveSniffer;
+
+		(** Remove a sniffer for received packets *)
+		PROCEDURE RemoveReceiveSniffer*(s: ReceiveSniffer);
+		VAR item: RecvSnifferList;
+		BEGIN {EXCLUSIVE}
+			ASSERT(~finalized);
+			IF recvSnifferList = NIL THEN
+				(* empty list *)
+			ELSIF recvSnifferList^.sniffer = s THEN
+				(* remove first item *)
+				recvSnifferList := recvSnifferList^.next;
+			ELSE
+				(* search list *)
+				item := recvSnifferList;
+				WHILE (item^.next # NIL) & (item^.next^.sniffer # s) DO
+					item := item^.next;
+				END;
+				IF item^.next # NIL THEN
+					item^.next := item^.next^.next;
+				ELSE
+					(* sniffer not found *)
+				END;
+			END;
+		END RemoveReceiveSniffer;
+
+		(** Queue buffer for upcall. Called from inside the LinkDevice object, normally from the interrupt handler. *)
+		PROCEDURE QueueBuffer*(buf: Buffer; type: LONGINT);
+		BEGIN {EXCLUSIVE}
+			ASSERT(buf # NIL);
+			buf.int := type; (* use "int" field for type information *)
+			buf.next := NIL;
+			IF upBufFirst = NIL THEN
+				upBufFirst := buf;
+			ELSE
+				upBufLast.next := buf;
+			END;
+			upBufLast := buf;
+		END QueueBuffer;
+
+	BEGIN {ACTIVE, PRIORITY(Objects.High)}
+		(* can run concurrently with SetReceiver, QueueBuffer, InstallReceiverSniffer and RemoveReceiverSniffer *)
+		LOOP
+			BEGIN {EXCLUSIVE}
+				AWAIT((upBufFirst # NIL) OR finalized);
+				IF (upBufFirst = NIL) & finalized THEN
+					(* terminate process after all buffer upcalls are done *)
+					EXIT;
+				END;
+				buf := upBufFirst;
+				upBufFirst := upBufFirst.next;
+			END;
+			INC(recvCount, buf.len);
+			discard := FALSE;
+			sniffer := recvSnifferList;
+			WHILE sniffer # NIL DO
+				(* call sniffer *)
+				discard := discard OR sniffer^.sniffer(SELF, buf.int, buf);
+				sniffer := sniffer^.next;
+			END;
+			IF ~discard THEN
+				(* search for type *)
+				typeItem := typeList;
+				WHILE (typeItem # NIL) & (typeItem^.type # buf.int) DO
+					typeItem := typeItem^.next;
+				END;
+				IF typeItem # NIL THEN
+					(* type item found check if packet is valid *)
+					recItem := typeItem^.recList;
+					IF (recItem # NIL) & (recItem^.isPacketValid(buf)) THEN
+						IF recItem^.next # NIL THEN
+							(* multiple receivers installed *)
+							IF ~(recItem^.isPacketForSingleRec(buf)) THEN
+								(* multiple receivers copy buffer *)
+								WHILE recItem^.next # NIL DO
+									bufSec := GetNewBuffer();
+									(* copy buffer *)
+									FOR i := 0 TO MaxPacketSize - 1 DO
+										bufSec^.data[i] := buf^.data[i];
+									END;
+									bufSec^.ofs := buf^.ofs;
+									bufSec^.len := buf^.len;
+									bufSec^.l3ofs := buf^.l3ofs;
+									bufSec^.l4ofs := buf^.l4ofs;
+									bufSec^.src := buf^.src;
+									bufSec^.calcChecksum := buf^.calcChecksum;
+									bufSec^.int := buf^.int;
+									bufSec^.set := buf^.set;
+
+									(* deliver copied buffer to interface *)
+ 									recItem^.receiver(SELF, typeItem^.type, bufSec);
+									recItem := recItem^.next;
+								END;
+
+								(* deliver original buffer *)
+								recItem^.receiver(SELF, typeItem^.type, buf);
+							ELSE
+								(* search for a single receiver *)
+								WHILE (recItem # NIL) & ~(recItem^.isPacketAccepted(buf)) DO
+									recItem := recItem^.next;
+								END;
+								IF recItem # NIL THEN
+									(* deliver buffer *)
+									recItem^.receiver(SELF, typeItem^.type, buf);
+								ELSE
+									(* Packet is not accepted ip ipforwarding is turned on deliver it *)
+									recItem := typeItem^.recList;
+									IF recItem^.isForwardingOn THEN
+										(* deliver buffer *)
+										recItem^.receiver(SELF, typeItem^.type, buf);
+									ELSE
+										discard := TRUE;
+									END;
+								END;
+							END;
+						ELSE
+							(* single receiver deliver buffer directly *)
+							IF recItem^.isPacketAccepted(buf) OR ~(recItem^.isPacketForSingleRec(buf)) THEN
+								recItem^.receiver(SELF, typeItem^.type, buf);
+							ELSE
+								(* Packet is not accepted ip ipforwarding is turned on deliver it *)
+								IF recItem^.isForwardingOn THEN
+									(* deliver buffer *)
+									recItem^.receiver(SELF, typeItem^.type, buf);
+								ELSE
+									discard := TRUE;
+								END;
+							END;
+						END;
+					ELSE
+						discard := TRUE;
+					END;
+				ELSE
+					discard := TRUE;
+				END;
+			END;
+
+			IF discard THEN
+				(* discard packet and return buffer *)
+				ReturnBuffer(buf);
+			END;
+		END;
+	END LinkDevice;
+
+TYPE
+	(** Upcall procedures *)
+
+	(** Packet receiver upcall
+		CAUTION:
+		After the buffer has been used, it has to be returned by calling Network.ReturnBuffer(buffer)!
+		The Receiver can do this by itself or delegate this job to other procedures or processes, wherever the
+		buffer is passed to. It has not necessarily to be returned within the receiver upcall.
+	*)
+	Receiver* = PROCEDURE {DELEGATE} (dev: LinkDevice; type: LONGINT; buffer: Buffer);
+	IsPacketForSingleRec* = PROCEDURE {DELEGATE} (buffer: Buffer): BOOLEAN;	(* Checks if an incoming packet should be sent to only one installed receivers *)
+	IsPacketAccepted* = PROCEDURE {DELEGATE} (buffer: Buffer): BOOLEAN;	(* Checks if an incoming packet is accepted from a certain installed receiver *)
+	IsPacketValid* = PROCEDURE {DELEGATE} (VAR buffer: Buffer): BOOLEAN;	(* Checks if an incoming packet is valid *)
+
+	(* Sniffer for sent packets. May modify type, headers and data. Return TRUE if packet shall be discarded. *)
+	(* Must be able to handle concurrent calls. e.g. by declaring itself as EXCLUSIVE. *)
+	SendSniffer* = PROCEDURE {DELEGATE} (dev: LinkDevice; VAR dst: LinkAdr; VAR type: LONGINT; CONST l3hdr, l4hdr, data: ARRAY OF CHAR; VAR h3len, h4len, dofs, dlen: LONGINT): BOOLEAN;
+
+	(* Sniffer for received packets. May modify type and buffer. Return TRUE if packet shall be discarded. *)
+	(* Will never be called concurrenty from the same LinkDevice. *)
+	ReceiveSniffer* = PROCEDURE {DELEGATE} (dev: LinkDevice; VAR type: LONGINT; buffer: Buffer): BOOLEAN;
+
+(** Module variables *)
+
+VAR
+	registry*: Plugins.Registry;
+
+	nofBuf: LONGINT; (* number of buffers existing *)
+	nofFreeBuf: LONGINT; (* number of free buffers *)
+	freeBufList: Buffer; (* free buffer list *)
+
+
+(** Get a new buffer - return NIL if MaxNofBuffers is exceeded *)
+PROCEDURE GetNewBuffer*(): Buffer;
+VAR item: Buffer;
+BEGIN {EXCLUSIVE}
+	IF freeBufList # NIL THEN
+		(* free buffer is available *)
+		item := freeBufList;
+		freeBufList := freeBufList.next;
+		Machine.AtomicAdd(nofFreeBuf, -1);
+	ELSIF nofBuf < MaxNofBuffers THEN
+		(* no free buffer available - create new one *)
+		NEW(item);
+		Machine.AtomicInc(nofBuf);
+	ELSE
+		(* not allowed to create more buffers *)
+		item := NIL;
+	END;
+	RETURN item;
+END GetNewBuffer;
+
+
+(** Return a buffer to be reused *)
+PROCEDURE ReturnBuffer*(buf: Buffer);
+VAR
+	oldBuffer: Buffer;
+
+BEGIN {EXCLUSIVE}
+	oldBuffer := buf;
+	WHILE buf # NIL DO
+		buf.next := freeBufList;
+		freeBufList := buf;
+		Machine.AtomicInc(nofFreeBuf);
+		oldBuffer := buf;
+		buf := buf.nextFragment;
+		oldBuffer.nextFragment := NIL;
+	END;
+END ReturnBuffer;
+
+(* Passed to registry.Enumerate() to Finalize each registered LinkDevice *)
+
+PROCEDURE Finalize(p: Plugins.Plugin);
+BEGIN
+	p(LinkDevice).Finalize(TRUE);
+END Finalize;
+
+(** Test whether the n bytes of buf1 and buf2 starting at ofs1 and ofs2 respectively are equal *)
+
+PROCEDURE Equal*(VAR buf1, buf2: ARRAY OF CHAR; ofs1, ofs2, n: LONGINT): BOOLEAN;
+BEGIN
+	WHILE (n > 0) & (buf1[ofs1] = buf2[ofs2]) DO INC(ofs1); INC(ofs2); DEC(n) END;
+	RETURN n <= 0
+END Equal;
+
+(** Procedures to put and get data from and to arrays. No index checks are done due to performance! *)
+
+(** Put a 32-bit host value into buf[ofs..ofs+3] *)
+
+PROCEDURE Put4*(VAR buf: ARRAY OF CHAR; ofs, val: LONGINT);
+BEGIN
+	SYSTEM.PUT8(ADDRESSOF(buf[ofs]), val MOD 100H);
+	SYSTEM.PUT8(ADDRESSOF(buf[ofs + 1]), (val DIV 100H) MOD 100H);
+	SYSTEM.PUT8(ADDRESSOF(buf[ofs + 2]), (val DIV 10000H) MOD 100H);
+	SYSTEM.PUT8(ADDRESSOF(buf[ofs + 3]), (val DIV 1000000H) MOD 100H)
+END Put4;
+
+(** Put a 16-bit host value into buf[ofs..ofs+1] *)
+
+PROCEDURE Put2*(VAR buf: ARRAY OF CHAR; ofs, val: LONGINT);
+(*CODE
+	LDR	R0, [FP, #val]
+	LDR	R1, [FP, #buf]
+	LDR	R2, [FP, #ofs]
+	ADD	R2, R1, R2
+	STRH	R0, [R2, #0]*)
+BEGIN
+	SYSTEM.PUT8(ADDRESSOF(buf[ofs]), INTEGER(val) MOD 100H);
+	SYSTEM.PUT8(ADDRESSOF(buf[ofs + 1]), INTEGER(val) DIV 100H);
+END Put2;
+
+(** Get a 32-bit host value from buf[ofs..ofs+3] *)
+
+PROCEDURE Get4*(VAR buf: ARRAY OF CHAR; ofs: LONGINT): LONGINT;
+(*CODE
+	LDR	R1, [FP, #buf]
+	LDR	R2, [FP, #ofs]
+	ADD	R2, R1, R2
+	LDR	R0, [R2, #0]*)
+BEGIN
+	RETURN (*SYSTEM.VAL(LONGINT, SYSTEM.GET16(ADDRESSOF(buf[ofs]))) + LSH(SYSTEM.VAL(LONGINT, SYSTEM.GET16(ADDRESSOF(buf[ofs]) + 2)), 16)*)
+				LONGINT(ORD(buf[ofs])) + LONGINT(ORD(buf[ofs + 1])) * 100H + LONGINT(ORD(buf[ofs + 2])) * 10000H + LONGINT(ORD(buf[ofs + 3])) * 1000000H;
+END Get4;
+
+(** Get a 16-bit host value from buf[ofs..ofs+1] *)
+
+PROCEDURE Get2*(VAR buf: ARRAY OF CHAR; ofs: LONGINT): LONGINT;
+(*CODE
+	LDR	R1, [FP, #buf]
+	LDR	R2, [FP, #ofs]
+	ADD	R2, R1, R2
+	LDRH	R0, [R2, #0]*)
+BEGIN
+	RETURN LONGINT(ORD(buf[ofs])) + LONGINT(ORD(buf[ofs + 1])) * 100H
+END Get2;
+
+(** Put a 32-bit host value into buf[ofs..ofs+3] in network byte order *)
+
+PROCEDURE PutNet4*(VAR buf: ARRAY OF CHAR; ofs, val: LONGINT);
+BEGIN
+	SYSTEM.PUT8(ADDRESSOF(buf[ofs]), (val DIV 1000000H) MOD 100H);
+	SYSTEM.PUT8(ADDRESSOF(buf[ofs + 1]), (val DIV 10000H) MOD 100H);
+	SYSTEM.PUT8(ADDRESSOF(buf[ofs + 2]), (val DIV 100H) MOD 100H);
+	SYSTEM.PUT8(ADDRESSOF(buf[ofs + 3]), val MOD 100H);
+END PutNet4;
+
+(** Put a 16-bit host value into buf[ofs..ofs+1] in network byte order *)
+
+PROCEDURE PutNet2*(VAR buf: ARRAY OF CHAR; ofs, val: LONGINT);
+BEGIN
+	SYSTEM.PUT8(ADDRESSOF(buf[ofs]), INTEGER(val) DIV 100H);
+	SYSTEM.PUT8(ADDRESSOF(buf[ofs +1]), INTEGER(val) MOD 100H);
+END PutNet2;
+
+(** Get a 32-bit network value from buf[ofs..ofs+3] in host byte order *)
+
+PROCEDURE GetNet4*(VAR buf: ARRAY OF CHAR; ofs: LONGINT): LONGINT;
+(*CODE
+	LDR	R1, [FP, #buf]
+	LDR	R2, [FP, #ofs]
+	ADD	R2, R1, R2
+	LDR	R0, [R2, #0]
+	REV	R0, R0*)
+BEGIN
+	RETURN LONGINT(ORD(buf[ofs])) * 1000000H + LONGINT(ORD(buf[ofs + 1])) * 10000H + LONGINT(ORD(buf[ofs + 2])) * 100H + LONGINT(ORD(buf[ofs + 3]))
+END GetNet4;
+
+(** Get a 16-bit network value from buf[ofs..ofs+1] in host byte order *)
+
+PROCEDURE GetNet2*(VAR buf: ARRAY OF CHAR; ofs: LONGINT): LONGINT;
+(*CODE
+	LDR	R1, [FP, #buf]
+	LDR	R2, [FP, #ofs]
+	ADD	R2, R1, R2
+	LDRH	R0, [R2, #0]
+	REV16	R0, R0*)
+BEGIN
+	RETURN LONGINT(ORD(buf[ofs])) * 100H + LONGINT(ORD(buf[ofs + 1]))
+END GetNet2;
+
+(** Convert a LinkAdr to a printable string (up to size*3 characters) *)
+
+PROCEDURE LinkAdrToStr*(VAR adr: LinkAdr; size: LONGINT; VAR s: ARRAY OF CHAR);
+VAR
+	i, j: LONGINT;
+	hex: ARRAY 17 OF CHAR;
+BEGIN
+	ASSERT(LEN(s) >= size*3); (* enough space for largest result *)
+	hex := "0123456789ABCDEF";
+	i := 0;
+	FOR j := 0 TO size-1 DO
+		s[i] := hex[ORD(adr[j]) DIV 10H MOD 10H]; INC(i);
+		s[i] := hex[ORD(adr[j]) MOD 10H]; INC(i);
+		IF j = size-1 THEN s[i] := 0X ELSE s[i] := ":" END;
+		INC(i);
+	END;
+END LinkAdrToStr;
+
+(** Write a link address *)
+
+PROCEDURE OutLinkAdr*(VAR adr: LinkAdr; size: LONGINT);
+VAR s: ARRAY MaxLinkAdrSize*3 OF CHAR;
+BEGIN
+	LinkAdrToStr(adr, size, s);
+	KernelLog.String(s);
+END OutLinkAdr;
+
+
+(** Are two link addresses equl *)
+PROCEDURE LinkAdrsEqual*(adr1: LinkAdr; adr2: LinkAdr): BOOLEAN;
+VAR
+	i: LONGINT;
+	adrsEqual: BOOLEAN;
+
+BEGIN
+	adrsEqual := TRUE;
+	i := 0;
+	WHILE (i<8) & (adr1[i] = adr2[i]) DO
+		INC(i);
+	END;
+
+	IF i < 8 THEN
+		adrsEqual := FALSE;
+	END;
+
+	RETURN adrsEqual;
+END LinkAdrsEqual;
+
+
+(** Copy data from array to array *)
+PROCEDURE Copy*(CONST from: ARRAY OF CHAR; VAR to: ARRAY OF CHAR; fofs, tofs, len: LONGINT);
+BEGIN
+	IF len > 0 THEN
+		ASSERT((fofs+len <= LEN(from)) & (tofs+len <= LEN(to)));
+		SYSTEM.MOVE(ADDRESSOF(from[fofs]), ADDRESSOF(to[tofs]), len);
+	END;
+END Copy;
+
+PROCEDURE Cleanup;
+BEGIN
+	registry.Enumerate(Finalize);
+	Plugins.main.Remove(registry)
+END Cleanup;
+
+BEGIN
+	nofBuf := 0;
+	nofFreeBuf := 0;
+
+	NEW(registry, "Network", "Network interface drivers");
+	Modules.InstallTermHandler(Cleanup);
+END Network.
+
+(*
+History:
+10.10.2003	mvt	Complete redesign and additional implementation of buffer handling and upcall mechanism
+17.10.2003	mvt	Changed the way of initialization and finalization (now only Constr/Finalize)
+21.10.2003	mvt	Changed SetReceiver to InstallReceiver and RemoveReceiver
+15.11.2003	mvt	Changed buffering to work with EXCLUSIVE sections instead of using locking and a semaphore.
+16.11.2003	mvt	Added support for checksum calclulation by the device.
+25.11.2003	mvt	Added l3ofs and l4ofs to Buffer type.
+17.12.2003	mvt	Changed variable "linked" to method "Linked".
+02.05.2005	eb	Supports multiple interfaces per device.
+*)
+
+(**
+How to use the module:
+
+The module is loaded as soon as it is used first. It needn't to be loaded explicitly at startup. It can also be unloaded an reloaded without reboot.
+
+How to use a driver:
+
+Network driver objects in Bluebottle are extensions of the Network.LinkDevice object. All loaded instances of network driver objects are registered in the registry Network.registry. To obtain access to a network driver, use the Get, Await or GetAll methods of this registry.
+
+Example:
+	VAR dev: Network.LinkDevice;
+	dev := Network.registry.Get(""); (* if no name is specified, first device (or NIL) is returned *)
+
+The Send method of LinkDevice is used to send a packet. The dst parameter specifies the link destination address (e.g., a 6-byte ethernet MAC address for an ethernet device). The type parameter specifies the link-layer protocol type (e.g. 800H when sending IP over ethernet). The source address of the packet is automatically generated by the device, if necessary.
+For reasons of reducing buffer copying between network layers, the method allows 3 buffers to be passed:
+The l3hdr, l4hdr, data, h3len, h4len, dofs and dlen fields specify 3 buffers:
+One buffer for a layer 3 header, one for a layer 4 header and one for the payload of the packet. The buffers don't have to be filled like this. They are simply concatenated to one frame by the device driver. Therefore, each of them is allowed to be empty.
+
+The layer 3 header is stored in: l3hdr[0..h3len-1]
+The layer 4 header is stored in: l4hdr[0..h4len-1]
+The payload is stored in data[dofs..dofs+dlen-1]
+
+Example:
+	CONST
+		Type = 05555H;	(* link-layer protocol type *)
+	VAR
+		dlen: LONGINT;
+		l3hdr: ARRAY HdrLen OF CHAR;
+		data: ARRAY MaxDataLen OF CHAR;
+
+	(* - l3hdr[0..HdrLen-1] contains the layer 3 packet header.
+		- data[0..dlen-1] contains the packet data.
+		- there is no layer 4 header in this example, i.e. an empty buffer is passed (len=0)
+	*)
+	dev.Send(dev.broadcast, Type, l3hdr, l3hdr, data, HdrLen, 0, 0, dlen); (* send a broadcast packet *)
+
+Packet receiving is driven by the driver object. A receiver interested in a specific type of packet registers itself using the InstallReceiver method. The type parameter specifies the link-layer protocol type, which must be unique. There can only be one receiver installed per type. When a packet arrives, the driver object looks at the protocol type and calls the specific receiver (if any is installed for this type).
+
+Example:
+	PROCEDURE Receiver(dev: Network.LinkDevice; type: LONGINT; buffer: Network.Buffer);
+	BEGIN
+		ASSERT(type = Type);
+		CheckAdr(buffer.src); (* some link layer source address checks *)
+		IF ~(ChecksumForThisProtocol IN buffer.calcChecksum) THEN
+			VerifyChecksum(buffer);
+		END;
+		ExamineLayer3Header(buffer.data, buffer.ofs, Layer3HeaderSize);
+		ProcessPayload(buffer.data, buffer.ofs+Layer3HeaderSize, buffer.len-Header3LayerSize);
+
+		(* MANDATORY!!
+			Buffer must be returned here! - or at higher layers, if the buffer is passed there! *)
+		Network.ReturnBuffer(buffer);
+	END Receiver;
+
+	dev.InstallReceiver(Type, Receiver); (* install the receiver *)
+
+When passing the buffer to a higher layer (e.g. layer 4), the field "l3ofs" should be set in order to enable the higher layer protocol to access this layer's header (required by ICMP).
+The same is valid for the field "l4ofs" when passing the buffer to a higher layer than 4.
+
+The "type" field of a LinkDevice specifies what kind of device it is. Currently, two options (constants) are available:
+- TypePointToPoint: dev is a point-to-point link (device), e.g. PPP
+- TypeEthernet: dev is an ethernet device
+
+For point-to-point links, the following rules are met:
+In constructor, the "local" and "broadcast" parameters are ignored.
+If it is not possible to transmit the layer 3 type of packet, the type is set to 0 for the received packet.
+If the field "adrSize" is 0, the dst address parameter in Send() is ignored and the src address parameter in the Receiver is not defined.
+If "adrSize" is > 0, the dst address passed in Send() is transmitted and presented as src address for the received packet.
+
+The "local" and "broadcast" fields of the object specify the link-level address of the device, and the broadcast address, respectively. If needed, they have to be set during device initialization.
+The mtu field specifies the largest allowed packet size in bytes, excluding layer 2 headers and trailers (e.g. 1500 for ethernet).
+
+The "sendCount" and "recvCount" fields show the number of data bytes sent and received by the device since the driver object was loaded.
+
+How to implement a driver:
+
+IMPORTANT:
+- Read first "How to use a driver"!
+- Read comments of methods you override!
+
+A network driver object is implemented by extending the LinkDevice object. At least the "DoSend" method has to be overridden with a concrete implementation. Normally, you will also override the constructor, the destructor (method "Finalize") and the method "Linked".
+
+CAUTION:
+If you override the constructor or destructor:
+- At the beginning of the overriding constructor, the overridden constructor has to be called!
+- At the end of the overriding destructor, the overridden destructor has to be called!
+
+NOTE:
+The device has to be registered and deregistered as a Plugin in Network.registry by the device driver as follows:
+Add the device to the registry after it is ready to send/receive data!
+Remove the device from the registry before you begin to deinitialize the device!
+
+Normally, the device driver will have to install an interrupt handler for receiving packets. This handler must be installed in Objects. Interrupts registered in Machine are not allowed! (because they are not allowed to call QueueBuffer due to its EXCLUSIVE section)
+
+If you use interrupts:
+- do the minimum operations required for receiving and queueing a packet!
+- return immediately after having done the operations!
+
+Receiving and queueing packets is done like this:
+
+When you are notified of an incomming network packet (normally by an interrupt), get a new buffer by calling:
+buf := Network.GetNewBuffer();
+
+If buf = NIL, the packet has to be discarded because all buffers are currently in use and the maximum amount of buffers (MaxNofBuffers) is exceeded.
+If buf # NIL (the normal case), read the packet data into buf.data and set buf.ofs and buf.len accordingly.
+The buffer is not initialized in any way.
+
+If the device supports DMA, you could try to get the buffers earlier and pass their physical addesses to the device. With this you can save one packet copying operation!
+
+In addition to the fields "data", "ofs", "len" of "buffer", it is mandatory to set the fields "src" and "calcChecksum" correctly. "src" is the link layer source address and "calcChecksum" is the set of checksums already verified by the device (normally {}).
+
+As soon as the buffer contains the whole packet data, it is passed to the upper layers by calling:
+QueueBuffer(buf, type);
+Where "type" is the layer 3 type of the packet.
+
+See TestNet.Mod (SendBroadcast, SendTest and Receiver) and IP.Mod (ARPRequest and ARPInput) for an example of packet sending and receiving. See Ethernet3Com90x.Mod for an example of an ethernet driver object and Loopback.Mod for a simple point-to-point link implementation.
+
+*)

source/ARM.Reals.Mod

@@ -0,0 +1,309 @@
+(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
+Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *)
+
+MODULE Reals;	(** portable, except where noted *)
+(** AUTHOR "bmoesli"; PURPOSE "Real number manipulation"; *)
+
+(** Implementation of the non-portable components of IEEE REAL and
+LONGREAL manipulation. The routines here are required to do conversion
+of reals to strings and back.
+Implemented by Bernd Moesli, Seminar for Applied Mathematics,
+Swiss Federal Institute of Technology Zürich.
+*)
+
+(** Simple port to ARM, without platform-dependent code by Timothée Martiel *)
+
+IMPORT SYSTEM, Machine;
+
+(* Bernd Moesli
+	Seminar for Applied Mathematics
+	Swiss Federal Institute of Technology Zurich
+	Copyright 1993
+
+	Support module for IEEE floating-point numbers
+
+	Please change constant definitions of H, L depending on byte ordering
+	Use bm.TestReals.Do for testing the implementation.
+
+	Expo, ExpoL return the shifted binary exponent (0 <= e < 256 (2048 resp.))
+	SetExpo, SetExpoL set the shifted binary exponent
+	Real, RealL convert hexadecimals to reals
+	Int, IntL convert reals to hexadecimals
+	Ten returns 10^e (e <= 308, 308 < e delivers NaN)
+
+	1993.4.22	IEEE format only, 32-bits LONGINTs only
+	30.8.1993	mh: changed RealX to avoid compiler warnings;
+	7.11.1995	jt: dynamic endianess test
+	22.01.97	pjm: NaN stuff (using quiet NaNs only to avoid traps)
+	05.01.98	prk: NaN with INF support
+*)
+
+VAR
+	DefaultFCR*: SET;
+	tene: ARRAY 23 OF LONGREAL; (* e = 0..22: exact values of 10^e *)
+	ten: ARRAY 27 OF LONGREAL;
+	eq, gr: ARRAY 20 OF SET;
+	H, L: INTEGER;
+
+(** Returns the shifted binary exponent (0 <= e < 256). *)
+PROCEDURE Expo* (x: REAL): LONGINT;
+BEGIN
+	RETURN ASH(SYSTEM.VAL(LONGINT, x), -23) MOD 256
+END Expo;
+
+(** Returns the shifted binary exponent (0 <= e < 2048). *)
+PROCEDURE ExpoL* (x: LONGREAL): LONGINT;
+	VAR i: LONGINT;
+BEGIN
+	SYSTEM.GET(ADDRESSOF(x) + H, i); RETURN ASH(i, -20) MOD 2048
+END ExpoL;
+
+(** Sets the shifted binary exponent. *)
+PROCEDURE SetExpo* (e: LONGINT; VAR x: REAL);
+	VAR i: LONGINT;
+BEGIN
+	SYSTEM.GET(ADDRESSOF(x), i);
+	i:= ASH(ASH(ASH(i, -31), 8) + e MOD 256, 23) + i MOD ASH(1, 23);
+	SYSTEM.PUT(ADDRESSOF(x), i)
+END SetExpo;
+
+(** Sets the shifted binary exponent. *)
+PROCEDURE SetExpoL* (e: LONGINT; VAR x: LONGREAL);
+	VAR i: LONGINT;
+BEGIN
+	SYSTEM.GET(ADDRESSOF(x) + H, i);
+	i:= ASH(ASH(ASH(i, -31), 11) + e MOD 2048, 20) + i MOD ASH(1, 20);
+	SYSTEM.PUT(ADDRESSOF(x) + H, i)
+END SetExpoL;
+
+(** Convert hexadecimal to REAL. *)
+PROCEDURE Real* (h: LONGINT): REAL;
+	VAR x: REAL;
+BEGIN SYSTEM.PUT(ADDRESSOF(x), h); RETURN x
+END Real;
+
+(** Convert hexadecimal to LONGREAL. h and l are the high and low parts.*)
+PROCEDURE RealL* (h, l: LONGINT): LONGREAL;
+	VAR x: LONGREAL;
+BEGIN SYSTEM.PUT(ADDRESSOF(x) + H, h); SYSTEM.PUT(ADDRESSOF(x) + L, l); RETURN x
+END RealL;
+
+(** Convert REAL to hexadecimal. *)
+PROCEDURE Int* (x: REAL): LONGINT;
+	VAR i: LONGINT;
+BEGIN SYSTEM.PUT(ADDRESSOF(i), x); RETURN i
+END Int;
+
+(** Convert LONGREAL to hexadecimal. h and l are the high and low parts. *)
+PROCEDURE IntL* (x: LONGREAL; VAR h, l: LONGINT);
+BEGIN SYSTEM.GET(ADDRESSOF(x) + H, h); SYSTEM.GET(ADDRESSOF(x) + L, l)
+END IntL;
+
+(** Returns 10^e (e <= 308, 308 < e delivers IEEE-code +INF). *)
+PROCEDURE Ten* (e: LONGINT): LONGREAL;
+	VAR E: LONGINT; r: LONGREAL;
+BEGIN
+	IF e < -307 THEN RETURN 0 ELSIF 308 < e THEN RETURN RealL(2146435072, 0) END;
+	INC(e, 307); r:= ten[e DIV 23] * tene[e MOD 23];
+	IF e MOD 32 IN eq[e DIV 32] THEN RETURN r
+	ELSE
+		E:= ExpoL(r); SetExpoL(1023+52, r);
+		IF e MOD 32 IN gr[e DIV 32] THEN r:= r-1 ELSE r:= r+1 END;
+		SetExpoL(E, r); RETURN r
+	END
+END Ten;
+
+(** Returns the NaN code (0 <= c < 8399608) or -1 if not NaN/Infinite. *)
+PROCEDURE NaNCode* (x: REAL): LONGINT;
+BEGIN
+	IF ASH(SYSTEM.VAL(LONGINT, x), -23) MOD 256 = 255 THEN	(* Infinite or NaN *)
+		RETURN SYSTEM.VAL(LONGINT, x) MOD 800000H	(* lowest 23 bits *)
+	ELSE
+		RETURN -1
+	END
+END NaNCode;
+
+(** Returns the NaN code (0 <= h < 1048576, MIN(LONGINT) <= l <= MAX(LONGINT)) or (-1,-1) if not NaN/Infinite. *)
+PROCEDURE NaNCodeL* (x: LONGREAL;  VAR h, l: LONGINT);
+BEGIN
+	SYSTEM.GET(ADDRESSOF(x) + H, h); SYSTEM.GET(ADDRESSOF(x) + L, l);
+	IF ASH(h, -20) MOD 2048 = 2047 THEN	(* Infinite or NaN *)
+		h := h MOD 100000H	(* lowest 20 bits *)
+	ELSE
+		h := -1;  l := -1
+	END
+END NaNCodeL;
+
+(** Returns TRUE iff x is NaN/Infinite. *)
+PROCEDURE IsNaN* (x: REAL): BOOLEAN;
+BEGIN
+	RETURN ASH(SYSTEM.VAL(LONGINT, x), -23) MOD 256 = 255
+END IsNaN;
+
+(** Returns TRUE iff x is NaN/Infinite. *)
+PROCEDURE IsNaNL* (x: LONGREAL): BOOLEAN;
+VAR h: LONGINT;
+BEGIN
+	SYSTEM.GET(ADDRESSOF(x) + H, h);
+	RETURN ASH(h, -20) MOD 2048 = 2047
+END IsNaNL;
+
+(** Returns NaN with specified code (0 <= l < 8399608). *)
+PROCEDURE NaN* (l: LONGINT): REAL;
+VAR x: REAL;
+BEGIN
+	SYSTEM.PUT(ADDRESSOF(x), (l MOD 800000H) + 7F800000H);
+	RETURN x
+END NaN;
+
+(** Returns NaN with specified code (0 <= h < 1048576, MIN(LONGINT) <= l <= MAX(LONGINT)). *)
+PROCEDURE NaNL* (h, l: LONGINT): LONGREAL;
+VAR x: LONGREAL;
+BEGIN
+	h := (h MOD 100000H) + 7FF00000H;
+	SYSTEM.PUT(ADDRESSOF(x) + H, h);
+	SYSTEM.PUT(ADDRESSOF(x) + L, l);
+	RETURN x
+END NaNL;
+
+(*
+PROCEDURE fcr(): SET;
+CODE {SYSTEM.i386, SYSTEM.FPU}
+	PUSH 0
+	FSTCW [ESP]
+	FWAIT
+	POP EAX
+END fcr;
+*)
+
+(** Return state of the floating-point control register. *)
+PROCEDURE FCR*(): SET;
+END FCR;
+
+(** Set state of floating-point control register.  Traps reset this to the default.  Note that changing the rounding mode affects rounding of imprecise results as well as the ENTIER operation. *)
+
+PROCEDURE SetFCR*(s: SET);
+END SetFCR;
+
+(** Round x to an integer using the current rounding mode. *)
+
+PROCEDURE Round*(x: REAL): LONGINT;	(** non-portable *)
+END Round;
+
+(** Round x to an integer using the current rounding mode. *)
+
+PROCEDURE RoundL*(x: LONGREAL): LONGINT;	(** non-portable *)
+END RoundL;
+
+PROCEDURE RealX (hh, hl: HUGEINT; adr: ADDRESS);
+VAR h,l: LONGINT;
+BEGIN
+	h := SHORT(hh); l := SHORT(hl);
+	SYSTEM.PUT(adr + H, h); SYSTEM.PUT(adr + L, l);
+END RealX;
+
+PROCEDURE InitHL;
+	VAR i: ADDRESS; dmy: INTEGER; littleEndian: BOOLEAN;
+BEGIN
+	DefaultFCR := Machine.fcr;
+
+	dmy := 1; i := ADDRESSOF(dmy);
+	SYSTEM.GET(i, littleEndian);	(* indirection via i avoids warning on SUN cc -O *)
+	IF littleEndian THEN H := 4; L := 0 ELSE H := 0; L := 4 END
+END InitHL;
+
+BEGIN InitHL;
+	RealX(03FF00000H, 0, ADDRESSOF(tene[0]));
+	RealX(040240000H, 0, ADDRESSOF(tene[1])); (* 1 *)
+	RealX(040590000H, 0, ADDRESSOF(tene[2])); (* 2 *)
+	RealX(0408F4000H, 0, ADDRESSOF(tene[3])); (* 3 *)
+	RealX(040C38800H, 0, ADDRESSOF(tene[4])); (* 4 *)
+	RealX(040F86A00H, 0, ADDRESSOF(tene[5])); (* 5 *)
+	RealX(0412E8480H, 0, ADDRESSOF(tene[6])); (* 6 *)
+	RealX(0416312D0H, 0, ADDRESSOF(tene[7])); (* 7 *)
+	RealX(04197D784H, 0, ADDRESSOF(tene[8])); (* 8 *)
+	RealX(041CDCD65H, 0, ADDRESSOF(tene[9])); (* 9 *)
+	RealX(04202A05FH, 020000000H, ADDRESSOF(tene[10])); (* 10 *)
+	RealX(042374876H, 0E8000000H, ADDRESSOF(tene[11])); (* 11 *)
+	RealX(0426D1A94H, 0A2000000H, ADDRESSOF(tene[12])); (* 12 *)
+	RealX(042A2309CH, 0E5400000H, ADDRESSOF(tene[13])); (* 13 *)
+	RealX(042D6BCC4H, 01E900000H, ADDRESSOF(tene[14])); (* 14 *)
+	RealX(0430C6BF5H, 026340000H, ADDRESSOF(tene[15])); (* 15 *)
+	RealX(04341C379H, 037E08000H, ADDRESSOF(tene[16])); (* 16 *)
+	RealX(043763457H, 085D8A000H, ADDRESSOF(tene[17])); (* 17 *)
+	RealX(043ABC16DH, 0674EC800H, ADDRESSOF(tene[18])); (* 18 *)
+	RealX(043E158E4H, 060913D00H, ADDRESSOF(tene[19])); (* 19 *)
+	RealX(04415AF1DH, 078B58C40H, ADDRESSOF(tene[20])); (* 20 *)
+	RealX(0444B1AE4H, 0D6E2EF50H, ADDRESSOF(tene[21])); (* 21 *)
+	RealX(04480F0CFH, 064DD592H, ADDRESSOF(tene[22])); (* 22 *)
+
+	RealX(031FA18H, 02C40C60DH, ADDRESSOF(ten[0])); (* -307 *)
+	RealX(04F7CAD2H, 03DE82D7BH, ADDRESSOF(ten[1])); (* -284 *)
+	RealX(09BF7D22H, 08322BAF5H, ADDRESSOF(ten[2])); (* -261 *)
+	RealX(0E84D669H, 05B193BF8H, ADDRESSOF(ten[3])); (* -238 *)
+	RealX(0134B9408H, 0EEFEA839H, ADDRESSOF(ten[4])); (* -215 *)
+	RealX(018123FF0H, 06EEA847AH, ADDRESSOF(ten[5])); (* -192 *)
+	RealX(01CD82742H, 091C6065BH, ADDRESSOF(ten[6])); (* -169 *)
+	RealX(0219FF779H, 0FD329CB9H, ADDRESSOF(ten[7])); (* -146 *)
+	RealX(02665275EH, 0D8D8F36CH, ADDRESSOF(ten[8])); (* -123 *)
+	RealX(02B2BFF2EH, 0E48E0530H, ADDRESSOF(ten[9])); (* -100 *)
+	RealX(02FF286D8H, 0EC190DCH, ADDRESSOF(ten[10])); (* -77 *)
+	RealX(034B8851AH, 0B548EA4H, ADDRESSOF(ten[11])); (* -54 *)
+	RealX(0398039D6H, 065896880H, ADDRESSOF(ten[12])); (* -31 *)
+	RealX(03E45798EH, 0E2308C3AH, ADDRESSOF(ten[13])); (* -8 *)
+	RealX(0430C6BF5H, 026340000H, ADDRESSOF(ten[14])); (* 15 *)
+	RealX(047D2CED3H, 02A16A1B1H, ADDRESSOF(ten[15])); (* 38 *)
+	RealX(04C98E45EH, 01DF3B015H, ADDRESSOF(ten[16])); (* 61 *)
+	RealX(0516078E1H, 011C3556DH, ADDRESSOF(ten[17])); (* 84 *)
+	RealX(05625CCFEH, 03D35D80EH, ADDRESSOF(ten[18])); (* 107 *)
+	RealX(05AECDA62H, 055B2D9EH, ADDRESSOF(ten[19])); (* 130 *)
+	RealX(05FB317E5H, 0EF3AB327H, ADDRESSOF(ten[20])); (* 153 *)
+	RealX(064794514H, 05230B378H, ADDRESSOF(ten[21])); (* 176 *)
+	RealX(06940B8E0H, 0ACAC4EAFH, ADDRESSOF(ten[22])); (* 199 *)
+	RealX(06E0621B1H, 0C28AC20CH, ADDRESSOF(ten[23])); (* 222 *)
+	RealX(072CD4A7BH, 0EBFA31ABH, ADDRESSOF(ten[24])); (* 245 *)
+	RealX(077936214H, 09CBD3226H, ADDRESSOF(ten[25])); (* 268 *)
+	RealX(07C59A742H, 0461887F6H, ADDRESSOF(ten[26])); (* 291 *)
+
+	eq[0]:= {0, 3, 4, 5, 9, 16, 23, 25, 26, 28, 31};
+	eq[1]:= {2, 5, 6, 8, 9, 10, 11, 12, 13, 14, 15, 17, 18, 19, 20, 21, 23, 24, 25, 27, 28, 29, 30, 31};
+	eq[2]:= {0, 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};
+	eq[3]:= {0, 1, 2, 3, 5, 6, 7, 8, 9, 11, 14, 15, 16, 17, 18, 19, 20, 22, 27, 28, 29, 30, 31};
+	eq[4]:= {0, 6, 7, 10, 11, 12, 13, 14, 15, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31};
+	eq[5]:= {0, 1, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31};
+	eq[6]:= {0, 1, 4, 5, 7, 8, 10, 14, 15, 16, 18, 20, 21, 23, 24, 25, 26, 28, 29, 30, 31};
+	eq[7]:= {0, 1, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 18, 19, 23, 24, 26, 28, 29, 30, 31};
+	eq[8]:= {0, 1, 2, 3, 4, 5, 6, 8, 9, 10, 11, 14, 16, 17, 18, 19, 20, 21, 24, 25, 26, 29};
+	eq[9]:= {1, 2, 4, 6, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31};
+	eq[10]:= {0, 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};
+	eq[11]:= {0, 1, 2, 3, 4, 5, 6, 7, 8, 10, 12, 13, 14, 15, 16, 19, 20, 21, 22, 23, 27, 28, 29, 30};
+	eq[12]:= {0, 1, 2, 3, 4, 5, 7, 8, 9, 10, 12, 14, 15, 16, 17, 18, 19, 20, 21, 23, 26, 27, 29, 30, 31};
+	eq[13]:= {0, 1, 2, 3, 4, 5, 6, 7, 9, 10, 11, 13, 14, 15, 16, 17, 18, 20, 21, 23, 24, 27, 28, 29, 30, 31};
+	eq[14]:= {0, 1, 2, 3, 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};
+	eq[15]:= {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 11, 12, 13, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 28};
+	eq[16]:= {1, 2, 4, 11, 13, 16, 17, 18, 19, 22, 24, 25, 26, 27, 28, 29, 30, 31};
+	eq[17]:= {1, 2, 3, 4, 5, 6, 7, 8, 9, 11, 14, 15, 18, 19, 20, 21, 23, 25, 26, 27, 28, 29, 31};
+	eq[18]:= {0, 2, 4, 5, 6, 8, 9, 11, 12, 13, 14, 16, 17, 19, 20, 22, 23, 24, 26, 27, 28, 29};
+	eq[19]:= {2, 3, 4, 5, 6, 7};
+
+	gr[0]:= {24, 27, 29, 30};
+	gr[1]:= {0, 1, 3, 4, 7};
+	gr[2]:= {29, 30, 31};
+	gr[3]:= {4, 10, 12, 13, 21, 23, 24, 25, 26};
+	gr[4]:= {1, 2, 3, 4, 5, 8, 9, 16, 17};
+	gr[5]:= {2, 3, 4, 18};
+	gr[6]:= {2, 3, 6, 9, 11, 12, 13, 17, 19, 22, 27};
+	gr[7]:= {2};
+	gr[8]:= {7, 12, 13, 15, 22, 23, 27, 28, 30, 31};
+	gr[9]:= {0, 3, 5, 7, 8};
+	gr[10]:= {};
+	gr[11]:= {};
+	gr[12]:= {11, 13, 22, 24, 25, 28};
+	gr[13]:= {22, 25, 26};
+	gr[14]:= {4, 5};
+	gr[15]:= {10, 14, 27, 29, 30, 31};
+	gr[16]:= {0, 3, 5, 6, 7, 8, 9, 10, 12, 14, 15, 20, 21, 23};
+	gr[17]:= {0, 10, 12, 13, 16, 17, 22, 24, 30};
+	gr[18]:= {};
+	gr[19]:= {}
+END Reals.

source/ARM.Traps.Mod

@@ -0,0 +1,468 @@
+MODULE Traps;	(** AUTHOR "pjm"; PURPOSE "Trap handling and symbolic debugging"; *)
+
+IMPORT SYSTEM, Machine, KernelLog, Streams, Modules, Objects, Kernel, Reflection, TrapWriters;
+
+CONST
+	RecursiveLimit = 2;		(* normally 1 or 2 - how many recursive traps to display before stopping *)
+	TraceVerbose = FALSE;
+	TestTrap = TRUE;
+
+	(* Process termination halt codes *)
+	halt* = Objects.halt;
+	haltUnbreakable* = Objects.haltUnbreakable;
+
+	(** Trap Numbers -- Do not modify: these are related to the compiler code generation. *)
+(*
+		WithTrap* = 1; (* generated when a WITH statement fails *)
+		CaseTrap* = 2; (* generated when a case statement without else block fails *)
+		ReturnTrap* = 3;
+		TypeEqualTrap* = 5;
+		TypeCheckTrap* = 6;
+		IndexCheckTrap* = 7; (* generated when index is out of bounds or range is invalid *)
+		AssertTrap* = 8; (* generated when an assert fails *)
+		ArraySizeTrap* = 9;
+		ArrayFormTrap*=10; (* indicates that array cannot be (re-)allocated since shape, type or size does not match *)
+		SetElementTrap*=11; (* indicates that a set element is out of MIN(SET)...MAX(SET) *)
+		NegativeDivisorTrap*=12;
+		NoReturnTrap*=16; (* indicates that a procedure marked no return did return *)
+
+		ELSIF code = 13 THEN StrAppend( desc, "Keyboard interrupt" )
+		ELSIF code = 14 THEN StrAppend( desc, "Out of memory" )
+		ELSIF code = 15 THEN StrAppend( desc, "Deadlock (active objects)" );
+		ELSIF code = 16 THEN StrAppend( desc, "Procedure returned" );
+		ELSIF code = 23 THEN StrAppend( desc, "Exceptions.Raise" )
+*)
+
+	DivisionError = 0;
+	WithError = 1;						(* Compiler generated *)
+	CaseError = 2;						(* Compiler generated *)
+	ReturnError = 3;					(* Compiler generated *)
+	IntOverflow = 4;
+	ImplicitTypeGuardError = 5;		(* Compiler generated *)
+	TypeGuardError = 6;				(* Compiler generated *)
+	IndexOutOfRange = 7;				(* Compiler generated *)
+	AssertError = 8;					(* Compiler generated *)
+	ArraySize = 9;						(* Compiler generated *)
+	ArrayForm = 10;					(* Compiler generated *)
+	SetElement = 11;					(* Compiler generated *)
+	NegativeDivisor = 12;				(* Compiler generated *)
+	KeyboardInt = 13;
+	OutOfMemory = 14;
+	Deadlock = 15;
+	ProcedureReturned = 16;			(* Compiler generated *)
+	UndefinedInstn = 17;				(* ARM specific *)
+	NilPointer = 18;					(* ARM specific *)
+	MemoryError = 19;				(* ARM specific *)
+	ExceptionRaised = 23;
+	ProcessResurrected = 2201;
+	RecursiveExclusive = 2203;
+	AwaitOutsideExclusive = 2204;
+
+	(** Trap descriptions, human-readable *)
+(*
+				|0: w.String("division error")
+				|1: w.String("WITH guard failed")
+				|2: w.String("CASE invalid")
+				|3: w.String("RETURN missing")
+				|4: w.String("integer overflow")
+				|5: w.String("implicit type guard failed")
+				|6: w.String("type guard failed")
+				|7: w.String("index out of range")
+				|8: w.String("ASSERT failed")
+				|9: w.String("array dimension error")
+				|14: w.String("out of memory")
+				|16: w.String("procedure returned")
+*)
+	DivisionErrorDesc = "division error";
+	WithErrorDesc = "WITH guard failed";
+	CaseErrorDesc = "CASE invalid";
+	ReturnErrorDesc = "RETURN missing";
+	IntOverflowDesc = "integer overflow";
+	ImplicitTypeGuardErrorDesc = "implicit type guard failed";
+	TypeGuardErrorDesc = "type guard failed";
+	IndexOutOfRangeDesc = "index out of range";
+	AssertErrorDesc = "ASSERT failed";
+	ArraySizeDesc = "array dimension error";
+	ArrayFormDesc = "invalid array shape";
+	SetElementDesc = "invalid SET element";
+	NegativeDivisorDesc = "negative divisor";
+	KeyboardIntDesc = "keyboard interrupt";
+	OutOfMemoryDesc = "out of memory";
+	DeadlockDesc = "deadlock";
+	ProcedureReturnedDesc = "procedure returned";
+	UndefinedInstnDesc = "undefined instruction";
+	NilPointerDesc = "NIL pointer";
+	MemoryErrorDesc = "invalid memory location";
+	ExceptionRaisedDesc = "exception";
+	ProcessResurrectedDesc = "process resurrected";
+	RecursiveExclusiveDesc = "recursive entrance in EXCLUSIVE section";
+	AwaitOutsideExclusiveDesc = "AWAIT statement outside EXCLUSIVE section";	
+
+TYPE
+	Variable* = RECORD	(** variable descriptor *)
+		adr-: ADDRESS;
+		type-, size-, n-, tdadr-: LONGINT
+	END;
+
+
+VAR
+	trapState: ARRAY Machine.MaxCPU OF LONGINT;	(* indexed by Machine.ID() *)
+	modes: ARRAY 25 OF CHAR;
+	flags: ARRAY 13 OF CHAR;
+
+
+
+	(* Write flag values. *)
+	PROCEDURE Flags(w: Streams.Writer; s: SET);
+	VAR i: SHORTINT; ch: CHAR;
+	BEGIN
+		FOR i := 0 TO 11 DO
+			ch := flags[i];
+			IF ch # "!" THEN
+				IF i IN s THEN ch := CAP(ch) END;
+				w.Char(ch)
+			END
+		END;
+		w.String(" iopl"); w.Int(ASH(SYSTEM.VAL(LONGINT, s * {12,13}), -12), 1)
+	END Flags;
+
+	(** Display trap state. *)
+	PROCEDURE  Show*(p: Objects.Process; VAR int: Machine.State; VAR exc: Machine.ExceptionState; long: BOOLEAN);
+	VAR id: LONGINT; overflow: BOOLEAN; w: Streams.Writer;
+
+		PROCEDURE Val(CONST s: ARRAY OF CHAR; val: HUGEINT);
+		BEGIN
+			w.Char(" "); w.String(s); w.Char("="); w.Hex(val, -8)
+		END Val;
+
+	BEGIN
+		overflow := FALSE;
+		w := TrapWriters.GetWriter();
+		w.Update;	(* flush previous output stuck in global writer w *)
+		w.Char(1X);	(* "start of trap" *)
+		id := Machine.ID();
+		INC(trapState[id]);
+		IF trapState[id] > RecursiveLimit THEN
+			w.String(" [Recursive TRAP]")
+		ELSE
+			(* output first line *)
+			w.String("["); w.Int(trapState[id], 1); w.String("] ");
+			w.String("TRAP "); w.Int(SHORT(exc.halt), 1); w.String(" ");
+			CASE exc.halt OF
+				 DivisionError: w.String(DivisionErrorDesc)
+				|WithError: w.String(WithErrorDesc)
+				|CaseError: w.String(CaseErrorDesc)
+				|ReturnError: w.String(ReturnErrorDesc)
+				|IntOverflow: w.String(IntOverflowDesc)
+				|ImplicitTypeGuardError: w.String(ImplicitTypeGuardErrorDesc)
+				|TypeGuardError: w.String(TypeGuardErrorDesc)
+				|IndexOutOfRange: w.String(IndexOutOfRangeDesc)
+				|AssertError: w.String(AssertErrorDesc)
+				|ArraySize: w.String(ArraySizeDesc)
+				|ArrayForm: w.String(ArrayFormDesc)
+				|SetElement: w.String(SetElementDesc)
+				|NegativeDivisor: w.String(NegativeDivisorDesc)
+				|KeyboardInt: w.String(KeyboardIntDesc)
+				|OutOfMemory: w.String(OutOfMemoryDesc)
+				|Deadlock: w.String(DeadlockDesc)
+				|ProcedureReturned: w.String(ProcedureReturnedDesc)
+				|UndefinedInstn: w.String(UndefinedInstnDesc); w.String(": "); w.Hex(exc.instn,-8)
+				|NilPointer: w.String(NilPointerDesc)
+				|MemoryError: w.String(MemoryErrorDesc); w.String(" at "); w.Address(exc.pf)
+				|ExceptionRaised: w.String(ExceptionRaisedDesc)
+				|ProcessResurrected: w.String(ProcessResurrectedDesc)
+				|RecursiveExclusive: w.String(RecursiveExclusiveDesc)
+				|AwaitOutsideExclusive: w.String(AwaitOutsideExclusiveDesc)
+			ELSE
+				w.String("HALT statement: ");
+				w.Int(exc.halt, 0)
+			END;
+			IF exc.locks # {} THEN
+				w.String(", Locks: "); w.Set(exc.locks)
+			END;
+			w.Char(" "); w.String(Machine.version);
+			IF long THEN
+				w.Char(0EX);	(* "fixed font" *)
+				w.Ln;
+				(* output values *)
+				Val("R0", int.R[0]); Val("R1", int.R[1]); Val("R2", int.R[2]); Val("R3", int.R[3]);
+				Val("R4", int.R[4]); Val("R5", int.R[5]); Val("R6", int.R[6]); Val("R7", int.R[7]);
+				Val("R8", int.R[8]); Val("R9", int.R[9]); Val("R10", int.R[10]); Val("R11", int.R[11]);
+				Val("FP", int.BP); Val("SP", int.SP); Val("LR", int.LR); Val("PC", int.PC);
+				Val("PSR", int.PSR);
+				Val("TMR", Kernel.GetTicks()); w.Ln
+			ELSE
+				w.Ln
+			END;
+			IF exc.halt = UndefinedInstn THEN
+				Val("Instruction", exc.instn)
+			ELSIF exc.halt = MemoryError THEN
+				Val("Location", exc.pf);
+				IF exc.status # - 1 THEN
+					Val("Status", exc.status)
+				END
+			END;
+			w.String("Process:"); Reflection.WriteProcess(w, p); w.Ln;
+			Reflection.StackTraceBack(w, int.PC, int.BP, Objects.GetStackBottom(p), long, overflow);
+		END;
+		w.String("---------------------------------"); w.Ln;
+		w.Char(02X);	(* "end of trap" *)
+		w.Update;
+		TrapWriters.Trapped();
+		trapState[id] := 0
+	END Show;
+
+	PROCEDURE SetLastExceptionState(ex: Machine.ExceptionState);
+	VAR id: LONGINT;
+	BEGIN
+		id := Machine.AcquirePreemption();
+		Objects.running[id].exp := ex;
+		Machine.ReleasePreemption;
+	END SetLastExceptionState;
+
+	PROCEDURE GetLastExceptionState*(): Machine.ExceptionState;
+	VAR
+		id: LONGINT;
+		ex: Machine.ExceptionState;
+	BEGIN
+		id := Machine.AcquirePreemption();
+		ex := Objects.running[id].exp;
+		Machine.ReleasePreemption;
+		RETURN ex;
+	END GetLastExceptionState;
+
+	(**  Handles an exception. Interrupts are on during this procedure. *)
+	PROCEDURE HandleException(VAR int: Machine.State; VAR exc: Machine.ExceptionState; VAR handled: BOOLEAN);
+	VAR
+		bp, sp, pc, handler: ADDRESS;
+	BEGIN
+		bp := int.BP; sp := int.SP; pc := int.PC;
+		handler := Modules.GetExceptionHandler(pc);
+	 	IF handler # -1 THEN (* Handler in the current PAF *)
+			int.PC := handler; handled := TRUE;
+			SetTrapVariable(pc, bp); SetLastExceptionState(exc)
+		ELSE
+			WHILE (bp # 0) & (handler = -1) DO
+				SYSTEM.GET(bp + 4, pc);
+				pc := pc - 1; (*  CALL instruction, machine dependant!!! *)
+				handler := Modules.GetExceptionHandler(pc);
+				sp :=  bp; (* Save the old basepointer into the stack pointer *)
+				SYSTEM.GET(bp, bp) (* Unwind PAF *)
+			END;
+			IF handler = -1 THEN
+				handled := FALSE;
+			ELSE
+				int.PC := handler; int.BP := bp; int.SP := sp;
+				SetTrapVariable(pc, bp); SetLastExceptionState(exc);
+				handled := TRUE
+			END
+		END
+	END HandleException;
+
+	PROCEDURE SetTrapVariable(pc, fp: ADDRESS);
+	VAR
+		varadr: ADDRESS;
+	BEGIN
+		varadr := Reflection.GetVariableAdr(pc, fp, "trap");
+		IF varadr # -1 THEN
+			SYSTEM.PUT8(varadr, 1)
+		END
+	END SetTrapVariable;
+
+	(* Unbreakable stack trace back with regard to every FINALLY on the way *)
+	PROCEDURE Unbreakable(p: Objects.Process; VAR int: Machine.State; VAR exc: Machine.ExceptionState; VAR handled: BOOLEAN);
+	VAR
+		bp, bpSave, pc, handler, bpBottom:ADDRESS;
+		hasFinally : BOOLEAN;
+	BEGIN
+		bp := int.BP;
+		pc := int.PC;
+		hasFinally := FALSE;
+
+		handler := Modules.GetExceptionHandler(pc);
+
+		(* Handler in the current PAF *)
+	 	IF handler # -1 THEN
+			int.PC := handler;
+			hasFinally := TRUE;
+			SetTrapVariable(pc, bp);
+		END;
+
+		(* The first waypoint is the bp of the top PAF *)
+		bpSave := bp;
+
+		WHILE (bp # 0) DO
+			(* Did we reach the last PAF? *)
+			SYSTEM.GET(bp, pc);
+			IF (pc = 0) THEN
+				bpBottom := bp; (* Save the FP of the last PAF *)
+			END;
+
+			(* Get the return pc *)
+			SYSTEM.GET(bp + SIZEOF(ADDRESS), pc);
+
+			handler := Modules.GetExceptionHandler(pc);
+
+			(* Save the last framepointer as stackpointer *)
+			IF ~hasFinally THEN
+				int.SP :=  bp;
+			END;
+
+			SYSTEM.GET(bp, bp);
+
+			(* Here bp may be 0. *)
+
+			IF (handler # -1) & (bp # 0)  THEN (* If Objects.Terminate has a FINALLY this doesn't work !!! *)
+				IF hasFinally THEN
+					(* Connect Finally to Finally *)
+					SYSTEM.PUT(bpSave + SIZEOF(ADDRESS), handler); (* Adapt the return pc *)
+					SYSTEM.PUT(bpSave, bp); (* Adapt the dynamic link *)
+					bpSave := bp;
+				ELSE
+					int.PC := handler;
+					int.BP := bp;
+					bpSave := bp;
+					hasFinally := TRUE;
+				END;
+				SetTrapVariable(pc, bp)
+			END
+		END;
+
+		(* Now bp =  0, bottom of the stack, so link the last known return PC to the Termination *)
+		IF ~hasFinally THEN
+			SYSTEM.GET(bpBottom + SIZEOF(ADDRESS), pc); (* PC of the Terminate *)
+			int.PC := pc;
+			int.BP := bpBottom;
+		ELSIF bpSave # bpBottom THEN
+			SYSTEM.GET(bpBottom + SIZEOF(ADDRESS), pc); (* PC of the Terminate *)
+			SYSTEM.PUT(bpSave + SIZEOF(ADDRESS), pc);
+			SetLastExceptionState(exc)
+		END;
+
+		handled := TRUE; (* If FALSE the process could be restarted, may be this is the meaning? *)
+
+	END Unbreakable;
+
+	(* General exception handler. *)
+	PROCEDURE Exception(VAR int: Machine.State);
+	VAR t: Objects.Process; exc: Machine.ExceptionState; user, traceTrap, handled: BOOLEAN;
+	BEGIN	(* interrupts off *)
+		t := Objects.running[Machine.ID()];	(* t is running process *)
+		handled := FALSE;
+		Machine.GetExceptionState(int, exc);
+		user := TRUE;
+		traceTrap := (exc.locks = {}) & (exc.halt >= MAX(INTEGER)) & (exc.halt <= MAX(INTEGER)+1);
+
+		Show(t, int, exc, exc.halt # MAX(INTEGER)+1);	(* Always show the trap info!*)
+
+		IF exc.halt = haltUnbreakable THEN
+			Unbreakable(t, int, exc, handled)
+		ELSIF ~ traceTrap THEN
+			HandleException( int, exc, handled)
+		END;
+
+		IF ~handled THEN
+			(* Taken from Machine to allow the FINALLY in the kernel *)
+			exc.locks := Machine.BreakAll();
+			Machine.EnableInterrupts();
+			IF ~traceTrap THEN	(* trap *)
+				IF user THEN	(* return to outer level *)
+					IF TraceVerbose THEN
+						KernelLog.Enter;
+						KernelLog.String("Jump");  KernelLog.Hex(t.restartPC, 9);
+						KernelLog.Hex(t.restartSP, 9);  KernelLog.Hex(t.stack.high, 9);
+						KernelLog.Exit
+					END;
+					(*INCL(int.FLAGS, Machine.IFBit);	(* enable interrupts *)*)
+					int.BP := t.restartSP; int.SP := t.restartSP;	(* reset stack *)
+					int.PC := t.restartPC;	(* restart object body or terminate *)
+				ELSE	(* trap was in kernel (interrupt handler) *)	(* fixme: recover from trap in stack traceback *)
+					KernelLog.Enter;  KernelLog.String("Kernel halt");  KernelLog.Exit;
+					Machine.Shutdown(FALSE)
+				END
+			END
+		END;
+
+		IF Objects.PleaseHalt IN t.flags THEN
+			EXCL(t.flags, Objects.PleaseHalt);
+			IF Objects.Unbreakable IN t.flags THEN EXCL(t.flags, Objects.Unbreakable) END;
+			IF Objects.SelfTermination IN t.flags THEN EXCL(t.flags, Objects.SelfTermination) END
+		END
+	END Exception;
+
+	(* Page fault handler. *)
+	PROCEDURE PageFault(VAR state: Machine.State);
+	VAR
+		t: Objects.Process;
+		adr: ADDRESS;
+		ignored: LONGINT;
+	BEGIN
+		t := Objects.running[Machine.ID()];
+		Machine.GetPageFault(adr, ignored);
+		(*IF Machine.IFBit IN state.FLAGS THEN	(* enable interrupts again if they were enabled *)
+			Machine.Sti()	(* avoid Processors.StopAll deadlock when waiting for locks below (fixme: remove) *)
+		END;*)
+		IF adr > 4096 THEN
+			(* Not a NIL pointer, maybe stack overflow? *)
+			IF (t = NIL) OR ~Machine.ExtendStack(t.stack, adr) THEN
+				IF TraceVerbose THEN
+					IF t = NIL THEN
+						KernelLog.Enter;  KernelLog.String("GrowStack running=NIL");
+						KernelLog.Hex(state.PC, 9);  KernelLog.Exit
+					ELSE
+						KernelLog.Enter;
+						KernelLog.String("GrowStack failed, pf="); KernelLog.Hex(adr, 8);
+						KernelLog.String(" adr="); KernelLog.Hex(t.stack.adr, 8);
+						KernelLog.String(" high="); KernelLog.Hex(t.stack.high, 8);
+						KernelLog.Exit
+					END
+				END;
+				Exception(state)
+			ELSE
+				IF TraceVerbose THEN
+					KernelLog.Enter;  KernelLog.String("GrowStack");
+					KernelLog.Hex(t.stack.adr, 9);  KernelLog.Hex(t.stack.high, 9);  KernelLog.Exit
+				END
+			END;
+		ELSE
+			Exception(state)
+		END
+	END PageFault;
+
+	PROCEDURE Init;
+	VAR i: LONGINT; s: ARRAY 8 OF CHAR;
+	BEGIN
+		IF TestTrap THEN
+			Machine.GetConfig("TestTrap", s);
+			IF s[0] = "1" THEN HALT(98) END
+		END;
+		FOR i := 0 TO Machine.MaxCPU-1 DO trapState[i] := 0 END;
+
+		Machine.InstallExceptionHandler(PageFault, Machine.Data);
+		Machine.InstallExceptionHandler(PageFault, Machine.Prefetch);
+		Machine.InstallExceptionHandler(Exception, Machine.Undef);
+		Machine.InstallExceptionHandler(Exception, Machine.Swi);
+		Machine.InstallExceptionHandler(Exception, Machine.Fiq);
+		IF TestTrap & (s[0] = "2") THEN HALT(99) END
+	END Init;
+
+BEGIN
+	modes := " rdy run awl awc awe rip";	(* 4 characters per mode from Objects.Ready to Objects.Terminated *)
+	flags := "c!p!a!zstido";	(* bottom flags, !=reserved *)
+	Init
+END Traps.
+
+(*
+12.03.1998	pjm	Started
+06.08.1998	pjm	Exported Show and removed AosException upcall installation & Modules lock
+10.12.1998	pjm	New refblk
+23.06.1999	pjm	State added
+*)
+
+(*
+to do:
+o stack overflow message is not correctly displayed in case of dynamic arrays (EDI = CR2, ESP # CR2)
+o fix KernelLog.Memory calls removed when switching to Streams
+o fix use of KernelLog lock in Show
+o if allowing modification of variables using their descriptors, it should also have reference to module to avoid gc after free.
+*)

source/Release.Tool

@@ -336,6 +336,7 @@ PACKAGE System ARCHIVE "System.zip" SOURCE "SystemSrc.zip" DESCRIPTION "System"
 
 	I386, WIN, UNIX { I386.Reals.Mod }
 	AMD64 { AMD64.Reals.Mod }
+	ARM { ARM.Reals.Mod }
 
 	# default trap handling
 	UNCOOP { Reflection.Mod }
@@ -343,6 +344,7 @@ PACKAGE System ARCHIVE "System.zip" SOURCE "SystemSrc.zip" DESCRIPTION "System"
 	TrapWriters.Mod CRC.Mod SystemVersion.Mod
 	NATIVEORIG, NATIVEGEN { Traps.Mod }
 	AMD64 { AMD64.Traps.Mod }
+	ARM { ARM.Traps.Mod }
 	WINORIG, WINGEN {  Win32.Traps.Mod }
 	UNIX { Unix.StdIO.Mod Unix.Traps.Mod }
 	COOP { Coop.Traps.Mod }
@@ -415,6 +417,7 @@ PACKAGE System ARCHIVE "System.zip" SOURCE "SystemSrc.zip" DESCRIPTION "System"
 
 	I386,UNIX { I386.Network.Mod }
 	AMD64 { AMD64.Network.Mod }
+	ARM { ARM.Network.Mod }
 	NATIVE { NetworkMii.Mod }
 
 	ActiveTimers.Mod
@@ -434,6 +437,7 @@ PACKAGE System ARCHIVE "System.zip" SOURCE "SystemSrc.zip" DESCRIPTION "System"
 
 	I386 { I386.IP.Mod I386.IPv4.Mod }
 	AMD64 { AMD64.IP.Mod AMD64.IPv4.Mod }
+	ARM { ARM.IP.Mod ARM.IPv4.Mod }
 
 	NATIVE {
 		IPv6.Mod ICMP.Mod UDP.Mod DNS.Mod 	# IP, UDP, TCP