Added proper 64-bit versions of modules with inline assembly code

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

source/AMD64.Oberon.Bitmaps.Mod

@@ -0,0 +1,438 @@
+(* 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 Bitmaps IN Oberon;	(** non-portable *)
+
+(* as 20.02.99, ported to Shark Oberon *)
+
+(* to do:
+o get rid of buffer
+o ASSERT bounds everywhere
+*)
+
+IMPORT SYSTEM, Display;
+
+CONST
+	BufSize = 10000H;
+	Assembler = TRUE;
+
+TYPE
+	Bitmap* = POINTER TO BitmapDesc;
+	BitmapDesc* = RECORD	(* cf. Display.DisplayBlock  *)
+		width*, height*, depth*: INTEGER;	(* offset 0, 2, 4 *)
+		wth*, size: LONGINT;	(* offset 8, 12 *)
+		address*: ADDRESS;	(* offset 16 *)
+	END;
+
+	Buffer = RECORD bytes: ARRAY BufSize OF CHAR END;
+
+VAR
+	buffer: POINTER TO Buffer;
+
+PROCEDURE Define*(B: Bitmap; width, height, depth: INTEGER; address: ADDRESS);
+BEGIN
+	B.width := width;
+	B.wth := width;
+	B.height := height;
+	B.depth := depth;
+	B.address := address;
+	B.size := LONG(width)*height
+END Define;
+
+PROCEDURE Get*(B: Bitmap; X, Y: INTEGER): INTEGER;
+VAR ofs: LONGINT; ch: CHAR;
+BEGIN
+	ofs := Y*B.wth + X;  ASSERT((ofs >= 0) & (ofs < B.size));
+	SYSTEM.GET(B.address + ofs, ch);
+	RETURN ORD(ch)
+END Get;
+
+PROCEDURE Clear*(B: Bitmap);
+VAR adr: ADDRESS; size: LONGINT;
+BEGIN
+	size := B.size;  adr := B.address;
+	WHILE size >= 4 DO
+		SYSTEM.PUT(adr, SYSTEM.VAL(LONGINT, 0));
+		INC(adr, 4);  DEC(size, 4)
+	END;
+	WHILE size > 0 DO SYSTEM.PUT(adr, 0X);  INC(adr);  DEC(size) END
+END Clear;
+
+PROCEDURE Dot*(B: Bitmap; col, X, Y, mode: INTEGER);
+VAR adr: ADDRESS;  ch: CHAR;
+BEGIN
+	adr := Y*B.wth + X;  ASSERT((adr >= 0) & (adr < B.size));
+	INC(adr, B.address);
+	IF mode = Display.invert THEN
+		SYSTEM.GET(adr, ch);
+		SYSTEM.PUT(adr, CHR(SYSTEM.VAL(LONGINT,
+				SYSTEM.VAL(SET, LONG(ORD(ch))) / SYSTEM.VAL(SET, LONG(col)))))
+	ELSE
+		SYSTEM.PUT(adr, CHR(col))
+	END
+END Dot;
+
+PROCEDURE CopyBlock0(n, w: LONGINT; adr: ADDRESS; buf: ADDRESS; width: LONGINT;  from: BOOLEAN);
+BEGIN
+	IF from THEN
+		REPEAT SYSTEM.MOVE(adr, buf, w); DEC(n);  INC(adr, width);  INC(buf, w) UNTIL n = 0
+	ELSE
+		REPEAT SYSTEM.MOVE(buf, adr, w); DEC(n);  INC(adr, width);  INC(buf, w) UNTIL n = 0
+	END
+END CopyBlock0;
+
+PROCEDURE CopyBlock*(sB, dB: Bitmap; SX, SY, W, H, DX, DY, mode: INTEGER);
+VAR SourceWth, DestWth, sx, sy, w, h, dx, dy, w0, h0, dx0, dy0, src, dst, n, bufLines: LONGINT;
+BEGIN	(* only the destination block is clipped *)
+	SourceWth := sB.wth; DestWth := dB.wth;
+	sx := SX;  sy := SY;  w := W;  h := H;  dx := DX;  dy := DY;
+	w0 := w;  h0 := h;  dx0 := dx;  dy0 := dy;
+	IF dx < 0 THEN dx := 0;  DEC(w, dx-dx0) END;
+	IF dy < 0 THEN dy := 0;  DEC(h, dy-dy0) END;
+	IF (w > 0) & (h > 0) & (w <= w0) & (h <= h0) THEN
+		IF dx+w-1 > dB.width-1 THEN DEC(w, dx+w-1 - (dB.width-1)) END;
+		IF dy+h-1 > dB.height-1 THEN DEC(h, dy+h-1 - (dB.height-1)) END;
+		IF (w > 0) & (h > 0) & (w <= w0) & (h <= h0) THEN
+			src := sy*SourceWth + sx;  ASSERT((src >= 0) & (src < sB.size));
+			dst := dy*DestWth + dx;  ASSERT((dst >= 0) & (dst < dB.size));
+			bufLines := BufSize DIV w;	(* lines to copy at a time *)
+			IF bufLines > h THEN bufLines := h END;
+				(* adjust direction for overlap *)
+			IF (dy-h+1 < sy) & (sy < dy) THEN	(* start at bottom *)
+				n := h-bufLines;
+				INC(src, SourceWth*n);  INC(dst, DestWth*n);
+				REPEAT
+					CopyBlock0(bufLines, w, sB.address+src, ADDRESSOF(buffer.bytes[0]), SourceWth, TRUE);
+					CopyBlock0(bufLines, w, dB.address+dst, ADDRESSOF(buffer.bytes[0]), DestWth, FALSE);
+					DEC(h, bufLines);
+					IF bufLines > h THEN bufLines := h END;
+					DEC(src, bufLines * SourceWth);  DEC(dst, bufLines * DestWth)
+				UNTIL h = 0
+			ELSE	(* start at top *)
+				REPEAT
+					CopyBlock0(bufLines, w, sB.address+src, ADDRESSOF(buffer.bytes[0]), SourceWth, TRUE);
+					CopyBlock0(bufLines, w, dB.address+dst, ADDRESSOF(buffer.bytes[0]), DestWth, FALSE);
+					INC(src, bufLines * SourceWth);  INC(dst, bufLines * DestWth);
+					DEC(h, bufLines);
+					IF bufLines > h THEN bufLines := h END
+				UNTIL h = 0
+			END
+		END
+	END
+END CopyBlock;
+
+PROCEDURE CopyPattern0(ofs: LONGINT; src, dst: ADDRESS; w, col, mode: LONGINT);
+VAR ch: CHAR;  m, i: LONGINT;  s: SET;
+BEGIN
+	IF mode = Display.invert THEN
+		REPEAT	(* loop over w pixels *)
+			SYSTEM.GET(src, ch);
+			i := ofs;	(* start bit *)
+			m := 8;	(* stop bit *)
+			IF m > ofs+w THEN m := ofs+w END;
+			REPEAT	(* loop over bits *)
+				IF ODD(ASH(ORD(ch), -i)) THEN	(* pixel on *)
+					SYSTEM.GET(dst, SYSTEM.VAL(CHAR, s));
+					SYSTEM.PUT(dst, CHR(SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, col) / s)))
+				END;
+				INC(dst);  INC(i)
+			UNTIL i = m;
+			INC(src);  DEC(w, m-ofs);  ofs := 0
+		UNTIL w = 0
+	ELSE (* paint, replace *)
+		REPEAT	(* loop over w pixels *)
+			SYSTEM.GET(src, ch);
+			i := ofs;	(* start bit *)
+			m := 8;	(* stop bit *)
+			IF m > ofs+w THEN m := ofs+w END;
+			REPEAT	(* loop over bits *)
+				IF ODD(ASH(ORD(ch), -i)) THEN	(* pixel on *)
+					(* paint & replace *)
+					SYSTEM.PUT(dst, CHR(col))
+				ELSIF mode = Display.replace THEN	(* pixel off *)
+					SYSTEM.PUT(dst, CHR(Display.BG))
+				ELSE (* skip *)
+				END;
+				INC(dst);  INC(i)
+			UNTIL i = m;
+			INC(src);  DEC(w, m-ofs);  ofs := 0
+		UNTIL w = 0
+	END;
+END CopyPattern0;
+
+PROCEDURE CopyPattern1(B: Bitmap; src: ADDRESS; x, y, w, col, mode: LONGINT);
+VAR ch: CHAR;  m, i: LONGINT;
+BEGIN
+	IF (y < 0) OR (y > B.height-1) THEN RETURN END;
+	REPEAT	(* loop over w pixels *)
+		SYSTEM.GET(src, ch);
+		i := 0;	(* start bit *)
+		m := 8;	(* stop bit *)
+		IF m > w THEN m := w END;
+		REPEAT	(* loop over bits *)
+			IF ODD(ASH(ORD(ch), -i)) THEN	(* pixel on *)
+				Dot(B,SHORT(col), SHORT(x), SHORT(y), SHORT(mode))
+			ELSIF mode = Display.replace THEN	(* pixel off *)
+				Dot(B,Display.BG, SHORT(x), SHORT(y), Display.replace)
+			ELSE (* skip *)
+			END;
+			INC(x);  INC(i)
+		UNTIL i = m;
+		INC(src);  DEC(w, m)
+	UNTIL w = 0
+END CopyPattern1;
+
+PROCEDURE CopyPattern*(B: Bitmap; col: INTEGER; pat: Display.Pattern; X, Y, mode: INTEGER);
+VAR x, y, x2, y2, w, w0, h: LONGINT; src, dst: ADDRESS;  ch: CHAR;
+BEGIN
+	SYSTEM.GET(pat, ch);  w := ORD(ch);
+	SYSTEM.GET(pat+1, ch);  h := ORD(ch);
+	IF (w > 0) & (h > 0) THEN
+		x := X;  y := Y;  x2 := x+w-1;  y2 := y+h-1;	(* (x,y) bottom left & (x2,y2) top right *)
+		src := pat+2;	(* first line of pattern *)
+		w0 := (w+7) DIV 8;	(* bytes in pattern line *)
+		IF (x >= 0) & (y >= 0) & (x2 < B.width) & (y2 < B.height) THEN	(* fully visible - common case *)
+			dst := y * B.wth + x + B.address;
+			REPEAT	(* loop over h lines *)
+				CopyPattern0(0, src, dst, w, col, mode);
+				DEC(h);  INC(dst, B.wth);  INC(src, w0)
+			UNTIL h = 0
+		ELSIF (x2 >= 0) & (y2 >= 0) & (x < B.width) & (y < B.height) THEN	(* partially visible *)
+			REPEAT	(* loop over h lines *)
+				CopyPattern1(B, src, x, y, w, col, mode);
+				INC(y);  INC(src, w0);  DEC(h)
+			UNTIL h = 0
+		ELSE (* invisible *)
+		END
+	END
+END CopyPattern;
+
+PROCEDURE ReplConst*(B: Bitmap; col, X, Y, W, H, mode: INTEGER);
+VAR addr, addr0: ADDRESS; pat, w: LONGINT; s: SET;
+BEGIN
+	addr := B.address + B.wth*Y + X;
+	pat := col + ASH(col, 8) + ASH(col, 16) + ASH(col, 24);
+	IF mode = Display.invert THEN
+		WHILE H > 0 DO w := W; addr0 := addr;
+			WHILE w # 0 DO
+				SYSTEM.GET(addr0, SYSTEM.VAL(CHAR,s));
+				SYSTEM.PUT(addr0, CHR(SYSTEM.VAL(LONGINT, s/SYSTEM.VAL(SET, col))));
+				DEC(w); INC(addr0)
+			END;
+			INC(addr, B.wth); DEC(H)
+		END
+	ELSE
+		WHILE H > 0 DO w := W; addr0 := addr;
+			WHILE w # 0 DO SYSTEM.PUT(addr0, CHR(col)); DEC(w); INC(addr0) END;
+			INC(addr, B.wth); DEC(H)
+		END
+	END;
+END ReplConst;
+
+PROCEDURE FillPattern0(ofs: LONGINT; src, dst: ADDRESS; w, pw, col, mode: LONGINT);
+VAR ch: CHAR;  m, i: LONGINT; src0: ADDRESS; left: LONGINT;  s: SET;
+BEGIN
+	left := pw-ofs;	(* pixels left to do in pattern *)
+	src0 := src;  INC(src, ofs DIV 8);  ofs := ofs MOD 8;	(* start position *)
+	IF mode = Display.invert THEN
+		REPEAT	(* loop over w pixels *)
+			SYSTEM.GET(src, ch);
+			i := ofs;	(* start bit *)
+			m := 8;	(* stop bit *)
+			IF m > ofs+left THEN m := ofs+left END;	(* max left times *)
+			IF m > ofs+w THEN m := ofs+w END;	(* max w times *)
+			REPEAT	(* loop over bits *)
+				IF ODD(ASH(ORD(ch), -i)) THEN	(* pixel on *)
+					SYSTEM.GET(dst, SYSTEM.VAL(CHAR, s));
+					SYSTEM.PUT(dst, CHR(SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, col) / s)))
+				END;
+				INC(dst);  INC(i)
+			UNTIL i = m;
+			INC(src);  DEC(left, m-ofs);  DEC(w, m-ofs);  ofs := 0;
+			IF left = 0 THEN src := src0;  left := pw END	(* wrap to start of pattern *)
+		UNTIL w = 0
+	ELSIF mode = Display.paint THEN
+		REPEAT	(* loop over w pixels *)
+			SYSTEM.GET(src, ch);
+			i := ofs;	(* start bit *)
+			m := 8;	(* stop bit *)
+			IF m > ofs+left THEN m := ofs+left END;	(* max left times *)
+			IF m > ofs+w THEN m := ofs+w END;	(* max w times *)
+			REPEAT	(* loop over bits *)
+				IF ODD(ASH(ORD(ch), -i)) THEN	(* pixel on *)
+					SYSTEM.PUT(dst, CHR(col))
+				END;
+				INC(dst);  INC(i)
+			UNTIL i = m;
+			INC(src);  DEC(left, m-ofs);  DEC(w, m-ofs);  ofs := 0;
+			IF left = 0 THEN src := src0;  left := pw END	(* wrap to start of pattern *)
+		UNTIL w = 0
+	ELSE (* replace *)
+		REPEAT	(* loop over w pixels *)
+			SYSTEM.GET(src, ch);
+			i := ofs;	(* start bit *)
+			m := 8;	(* stop bit *)
+			IF m > ofs+left THEN m := ofs+left END;	(* max left times *)
+			IF m > ofs+w THEN m := ofs+w END;	(* max w times *)
+			REPEAT	(* loop over bits *)
+				IF ODD(ASH(ORD(ch), -i)) THEN	(* pixel on *)
+					SYSTEM.PUT(dst, CHR(col))
+				ELSE (* pixel off *)
+					SYSTEM.PUT(dst, CHR(Display.BG))
+				END;
+				INC(dst);  INC(i)
+			UNTIL i = m;
+			INC(src);  DEC(left, m-ofs);  DEC(w, m-ofs);  ofs := 0;
+			IF left = 0 THEN src := src0;  left := pw END	(* wrap to start of pattern *)
+		UNTIL w = 0
+	END
+END FillPattern0;
+
+PROCEDURE ReplPattern*(B: Bitmap; col: INTEGER; pat: LONGINT; X, Y, W, H, mode: INTEGER);
+VAR px, pw, ph, x, y, x2, y2, w, w0, h: LONGINT; src0, src, dst: ADDRESS;  ch: CHAR;
+BEGIN
+	x := X;  y := Y;  w := W;  h := H;
+	x2 := x+w-1;  y2 := y+h-1;	(* (x,y) bottom left & (x2,y2) top right *)
+	IF (w > 0) & (h > 0) THEN
+		SYSTEM.GET(pat, ch);  pw := ORD(ch);
+		SYSTEM.GET(pat+1, ch);  ph := ORD(ch);
+		IF (pw > 0) & (ph > 0) THEN
+			INC(pat, 2);	(* adr of bitmap *)
+			w0 := (pw+7) DIV 8;	(* bytes in pattern line *)
+			src0 := pat + (ph-1)*w0;	(* last line of pattern *)
+			src := pat;	(* start line of pattern *)
+			px := x MOD pw;	(* start pixel offset *)
+			dst := y * B.wth + x + B.address;
+			REPEAT	(* loop over h lines *)
+				FillPattern0(px, src, dst, w, pw, col, mode);
+				DEC(h);  INC(dst, B.wth);
+				IF src = src0 THEN src := pat ELSE INC(src, w0) END
+			UNTIL h = 0
+		END
+	END
+END ReplPattern;
+
+PROCEDURE DisplayBlock*(B: Bitmap; SX, SY, W, H, DX, DY, mode: INTEGER; VAR colortable: ARRAY OF LONGINT (* fof *));
+BEGIN
+	Display.DisplayBlock(B, SX, SY, W, H, DX, DY, mode,colortable);
+END DisplayBlock;
+
+PROCEDURE GetPix*(VAR addr: ADDRESS; VAR buf: SYSTEM.BYTE; depth: INTEGER);
+VAR s1, s2, s3: SHORTINT;
+BEGIN
+	IF depth = 8 THEN SYSTEM.GET(addr, buf); INC(addr)
+	ELSIF depth = 4 THEN
+		SYSTEM.GET(addr, s1); INC(addr); SYSTEM.GET(addr, s2); INC(addr); buf := s2*16 + (s1 MOD 16)
+	ELSE (* depth = 1 *)
+		s1 := 0; s2 := 0;
+		WHILE s1 < 8 DO SYSTEM.GET(addr, s3); INC(addr); INC(s1); s2 := s2*2 + s3 MOD 2 END; buf := s2
+	END;
+END GetPix;
+
+PROCEDURE PutPix*(VAR addr: ADDRESS; border: ADDRESS; buf: SYSTEM.BYTE; depth: INTEGER);
+VAR s1: SHORTINT;
+BEGIN
+	IF (depth = 8) & (addr < border) THEN SYSTEM.PUT(addr, buf); INC(addr)
+	ELSIF depth = 4 THEN
+		IF addr < border THEN SYSTEM.PUT(addr, SYSTEM.VAL(SHORTINT, buf) MOD 16); INC(addr) END;
+		IF addr < border THEN SYSTEM.PUT(addr, SYSTEM.VAL(SHORTINT, buf) DIV 16 MOD 16); INC(addr) END;
+	ELSE (* depth = 1 *)
+		s1 := 0;
+		WHILE s1 < 8 DO
+			IF addr < border THEN
+				IF ODD(SYSTEM.VAL(SHORTINT, buf)) THEN SYSTEM.PUT(addr, 15) ELSE SYSTEM.PUT(addr, 0) END
+			END;
+			INC(s1); INC(addr); buf := SYSTEM.VAL(SHORTINT, buf) DIV 2;
+		END
+	END;
+END PutPix;
+
+PROCEDURE -Copy0(src, dst: ADDRESS; hx, sw2, dw2: LONGINT);
+CODE {SYSTEM.AMD64}
+	POP EDX	; dw2
+	POP ECX	; sw2
+	POP EBX	; hx
+	POP RDI	; dst
+	POP RSI	; src
+	MOV EAX, EDX
+	SHR EAX, 1
+	PUSH EAX	; count
+for:
+	MOV AL, [RSI]
+	MOV [RDI], AL
+	JMP while1
+while0:
+	INC RSI
+	SUB EBX, EDX
+while1:
+	CMP EBX, 0
+	JG while0
+	INC RDI
+	ADD EBX, ECX
+	DEC DWORD [RSP]
+	JNZ for
+	POP EAX
+END Copy0;
+
+PROCEDURE Copy*(sB, dB: Bitmap; SX, SY, SW, SH, DX, DY, DW, DH, mode: INTEGER);
+VAR hx, hy, DW2, SW2: LONGINT; src, dst: ADDRESS; i: LONGINT; dy: INTEGER; ch: CHAR;
+BEGIN
+	IF (SX >= 0) & (SY >= 0) & (SX+SW <= sB.width) & (SY+SH <= sB.height) &
+			(DX >= 0) & (DY >= 0) & (DX+DW <= dB.width) & (DY+DH <= dB.height) &
+			(SW > 0) & (SH > 0) & (DW > 0) & (DH > 0) THEN
+		dy := DY + DH; DW2 := 2 * DW; SW2 := 2 * SW;
+		hy := 2*SH - DH;
+		WHILE DY < dy DO
+			IF Assembler THEN
+				Copy0(sB.address + SY*sB.wth + SX, dB.address + DY*dB.wth + DX, 2*SW - DW, SW2, DW2)
+			ELSE
+				hx := 2*SW - DW;
+				src := sB.address + SY*sB.wth + SX;
+				dst := dB.address + DY*dB.wth + DX;
+				FOR i := 1 TO DW DO
+					SYSTEM.GET(src, ch); SYSTEM.PUT(dst, ch);
+					WHILE hx > 0 DO INC(src); DEC(hx, DW2) END;
+					INC(dst); INC(hx, SW2)
+				END
+			END;
+			WHILE hy > 0 DO INC(SY); hy := hy - 2 * DH END;
+			INC(DY); hy := hy + 2*SH
+		END
+	ELSE
+		HALT(99)
+	END
+END Copy;
+
+PROCEDURE PutLine*(B: Bitmap; VAR data: ARRAY OF INTEGER; X, Y, W: INTEGER);
+VAR dst, src: ADDRESS; i: LONGINT; ch: CHAR;
+BEGIN
+	IF (X >= 0) & (X+W <= B.width) & (Y >= 0) & (Y < B.height) & (W <= LEN(data)) THEN
+		src := ADDRESSOF(data[0]); dst := B.address + Y*B.wth + X; i := W;
+		WHILE i > 0 DO
+			SYSTEM.GET(src, ch); SYSTEM.PUT(dst, ch);
+			INC(src, 2); INC(dst);
+			DEC(i)
+		END
+	ELSE
+		HALT(99)
+	END
+END PutLine;
+
+PROCEDURE GetLine*(B: Bitmap; VAR data: ARRAY OF INTEGER; X, Y, W: INTEGER);
+VAR dst, src: ADDRESS; i: LONGINT; ch: CHAR;
+BEGIN
+	IF (X >= 0) & (X+W <= B.width) & (Y >= 0) & (Y < B.height) & (W <= LEN(data)) THEN
+		dst := ADDRESSOF(data[0]); src := B.address + Y*B.wth + X; i := W;
+		WHILE i > 0 DO
+			SYSTEM.GET(src, ch); SYSTEM.PUT(dst, ORD(ch));
+			INC(src); INC(dst, 2);
+			DEC(i)
+		END
+	ELSE
+		HALT(99)
+	END
+END GetLine;
+
+BEGIN
+	NEW(buffer)
+END Bitmaps.

source/Release.Tool

@@ -390,10 +390,12 @@ PACKAGE System ARCHIVE "System.zip" SOURCE "SystemSrc.zip" DESCRIPTION "System"
 	WIN { Win32.Display.Mod }
 	WINCOOP { Coop.Win32.Display.Mod }
 
+	WIN { Win32.WSock32.Mod }
+	WIN32 { Win32.I386.Network.Mod Win32.I386.IP.Mod }
+	WIN64 { Win32.AMD64.Network.Mod Win32.AMD64.IP.Mod }
+
 	WIN {
-		Win32.WSock32.Mod
-		Win32.Network.Mod
-		Win32.IP.Mod Win32.DNS.Mod
+		Win32.DNS.Mod
 		Win32.UDP.Mod
 		Win32.TCP.Mod
 		Win32.CommandLine.Mod	# Command Line Parsing for Windows A2
@@ -409,8 +411,10 @@ PACKAGE System ARCHIVE "System.zip" SOURCE "SystemSrc.zip" DESCRIPTION "System"
 		Ping.Mod TraceRoute.Mod TCPPortLog.Mod		# network tools
 	}
 
+	UNIX32 { Unix.I386.IP.Mod }
+	UNIX64 { Unix.AMD64.IP.Mod }
+
 	UNIX {
-		Unix.IP.Mod
 		Unix.Sockets.Mod
 		Unix.TCP.Mod Unix.UDP.Mod Unix.DNS.Mod
 	}
@@ -1445,7 +1449,10 @@ PACKAGE Oberon ARCHIVE "Oberon.zip" SOURCE "OberonSrc.zip" DESCRIPTION "Oberon f
 
 	NATIVE, WIN { Oberon.Centronics.Mod }
 
-	I386.Oberon.Bitmaps.Mod Oberon.Pictures.Mod
+	I386, WIN32, UNIX32 { I386.Oberon.Bitmaps.Mod }
+	WIN64, UNIX64 { AMD64.Oberon.Bitmaps.Mod }
+
+	Oberon.Pictures.Mod
 
 	Oberon.RandomNumbers.Mod
 

source/Unix.AMD64.IP.Mod

@@ -0,0 +1,636 @@
+(* Aos, Copyright 2001, Pieter Muller, ETH Zurich *)
+
+MODULE IP;   (** AUTHOR "pjm, mvt, eb, G.F."; PURPOSE "IP (v4 and v6)"; *)
+
+IMPORT S := SYSTEM, KernelLog, Strings, Network;
+
+CONST
+	(** Error codes *)
+	Ok* = 0;
+
+	(** IP address constants *)
+	NilAdrIPv4 = 0;
+
+	(* Comparators for Adr.usedProtocols *)
+	IPv4* = 4;
+	IPv6* = 6;
+	NilAdrIdent = -1;   (* usedProtocol of NilAdrs *)
+
+	MaxNofDNS = 4;
+
+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 *)
+
+	Packet* = POINTER TO ARRAY OF CHAR;
+
+	Name* = ARRAY 128 OF  CHAR;   (** Name type for interface name *)
+
+	ARPHandler* = PROCEDURE {DELEGATE} ( ip: Adr; complete: BOOLEAN;
+											link: Network.LinkAdr;
+											size, sendTime, updateTime, updateDate, hash: LONGINT);
+
+	Interface* = OBJECT
+				(*! 	unused in UnixAos, included only for interface compatibility
+					mostly a dummy, only 'localAdr' contains valid data in UnixAos !! *)
+
+			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! *)
+
+
+
+				PROCEDURE & Init*( addr: Adr );
+				BEGIN
+					localAdr := addr;
+					name := "dummy";
+				END Init;
+
+			END Interface;
+
+	InterfaceHandler* = PROCEDURE {DELEGATE} (int: Interface);
+
+VAR
+	(* IP *)
+	NilAdr*: Adr;   (* To check if an IP address is NIL use IsNilAdr instead *)
+	preferredProtocol*: LONGINT;   (* Preferred IP protocol *)
+
+	(** 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
+			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 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  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 := S.VAL( LONGINT, adr );  retAdr.usedProtocol := IPv4;  RETURN retAdr;
+			ELSE  RETURN NilAdr;
+			END
+		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
+				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:
+				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  COPY( "::", 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[0] := 0X  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 arr: 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( arr )) THEN  RETURN NilAdr  END;
+			S.MOVE( ADDRESSOF( arr[ofs] ), ADDRESSOF( adr.ipv4Adr ), 4 );
+			IF LSBfirst THEN  SwapEndian( adr.ipv4Adr )  END;
+			adr.usedProtocol := IPv4;
+		ELSIF protocol = IPv6 THEN
+			IF ~(ofs + 16 <= LEN( arr )) THEN  RETURN NilAdr  END;
+			S.MOVE( ADDRESSOF( arr[ofs] ), ADDRESSOF( adr.ipv6Adr ), 16 );
+			IF LSBfirst THEN
+				FOR i := 0 TO 3 DO
+					S.MOVE( ADDRESSOF( adr.ipv6Adr[i*4] ), ADDRESSOF( swapTemp ), 4 );
+					SwapEndian( swapTemp );
+					S.MOVE( ADDRESSOF( swapTemp ), ADDRESSOF( adr.ipv6Adr[i*4] ), 4 );
+				END;
+			END;
+			adr.usedProtocol := IPv6;
+		ELSE
+			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 arr: 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( arr )) THEN  tempAdr := NilAdr  END;
+				IF LSBfirst THEN  SwapEndian( tempAdr.ipv4Adr )  END;
+				S.MOVE( ADDRESSOF( tempAdr.ipv4Adr ), ADDRESSOF( arr[ofs] ), 4 );
+		| IPv6:
+				IF ~(ofs + 16 <= LEN( arr )) THEN  tempAdr := NilAdr  END;
+				IF LSBfirst THEN
+					FOR i := 0 TO 3 DO
+						S.MOVE( ADDRESSOF( tempAdr.ipv6Adr[i*4] ), ADDRESSOF( swapTemp ), 4 );
+						SwapEndian( swapTemp );
+						S.MOVE( ADDRESSOF( swapTemp ), ADDRESSOF( tempAdr.ipv6Adr[i*4] ), 4 );
+					END;
+				END;
+				S.MOVE( ADDRESSOF( adr.ipv6Adr ), ADDRESSOF( arr[ofs] ), 16 );
+		ELSE
+		END;
+	END AdrToArray;
+
+
+	(** Aos command: Output statistics and configuration of all installed interfaces. *)
+	PROCEDURE IPConfig*( par: ANY ): ANY;
+	BEGIN
+		KernelLog.String( "Interfaces:" );  KernelLog.Ln;  RETURN NIL;
+	END IPConfig;
+
+
+	(* 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
+		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 (S.VAL( SET, adr.ipv6Adr[bytesToCheck] ) - diffSet) #
+				    (S.VAL( SET, prefix.ipv6Adr[bytesToCheck] ) - diffSet) THEN  matches := FALSE
+				END
+			END
+		END;
+		RETURN matches
+	END MatchPrefix;
+
+
+	(** 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 );
+							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
+			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
+			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;
+
+
+	(* Swap internal representation of an IP address from big to little endian or vice versa. *)
+	PROCEDURE  -SwapEndian(  VAR adr: LONGINT );
+	CODE {SYSTEM.AMD64}
+		POP RAX
+		MOV ECX, [RAX]
+		XCHG CL, CH
+		ROL ECX, 16
+		XCHG CL, CH
+		MOV [RAX], ECX
+	END SwapEndian;
+
+
+BEGIN
+	(* NilAdr *)
+	NilAdr.ipv4Adr := NilAdrIPv4;
+	SetIPv6AdrNil( NilAdr );
+	NilAdr.usedProtocol := NilAdrIdent;
+END IP.
+
+
+			

source/Win32.AMD64.IP.Mod

@@ -0,0 +1,476 @@
+(* Aos Runtime: IP, Copyright 2005, Emil J. Zeller *)
+
+(* Aos, Copyright 2001, Pieter Muller, ETH Zurich *)
+
+MODULE IP; (** AUTHOR "pjm, mvt"; PURPOSE "IP and ARP protocols"; *)
+
+IMPORT SYSTEM, WSock32, Network, Strings, Kernel, KernelLog;
+
+CONST
+	(** Error codes *)
+	Ok* = 0;
+	
+	(** TCP connection states *)
+	NumStates* = 12;  Closed* = 0;  Listen* = 1;  SynSent* = 2;
+	SynReceived* = 3;  Established* = 4;  CloseWait* = 5;  FinWait1* = 6;
+	Closing* = 7;  LastAck* = 8;  FinWait2* = 9;  TimeWait* = 10;
+	Unused* = 11;   (* no real state, only used in this implementation *)
+	
+	Trace=TRUE;
+
+	(** IP address constants *)
+	NilAdrIPv4 = 0;
+	
+	NilPort* = 0;
+
+	(* Comparators for Adr.usedProtocols *)
+	IPv4* = 4;
+	IPv6* = 6;
+	NilAdrIdent = -1;	(* usedProtocol of NilAdrs *)
+
+
+
+
+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 *)
+
+	Name* = ARRAY 128 OF CHAR; (** Name type for interface name *)
+
+	(** IP interface. See note at the end of the module. *)
+	Interface* = OBJECT
+	VAR
+		(** IP addresses of this interface *)
+		localAdr-: Adr;
+		next*:Interface;
+	END Interface;
+	
+
+VAR
+	pool*: Kernel.FinalizedCollection;   (* pool of all IP.Socket *)
+	
+	(* Interfaces *)
+	default-: Interface;
+	interfaces*: Interface; (* list of all installed interfaces *)
+
+
+	(* IP *)
+	NilAdr*: Adr; (* To check if an IP address is NIL use IsNilAdr instead *)
+
+(** 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
+			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
+			RETURN FALSE;
+	END;
+	RETURN FALSE;
+END AdrsEqual;
+
+(** Convert a dotted-decimal string to an ip address. Return NilAdr on failure. *)
+PROCEDURE StrToAdr*(CONST s: ARRAY OF CHAR): Adr;
+VAR
+	i, j, x: LONGINT;
+	adr: ARRAY 4 OF CHAR;
+	ok: BOOLEAN;
+	ip: Adr;
+BEGIN
+	i := 0; j := 0; x := -1; ok := FALSE;
+	LOOP
+		IF (s[i] = ".") OR (s[i] = 0X) THEN
+			IF (x < 0) OR (x > 255) OR (j = 4) THEN EXIT END;
+			adr[j] := CHR(x);
+			IF s[i] = 0X THEN ok := (j = 3); EXIT END;
+			x := -1; INC(i); INC(j)
+		ELSIF (s[i] >= "0") & (s[i] <= "9") THEN
+			IF x = -1 THEN x := 0 END;
+			x := x*10 + (ORD(s[i])-ORD("0"));
+			INC(i)
+		ELSE
+			EXIT
+		END
+	END;
+	IF ok THEN
+		ip.ipv4Adr := SYSTEM.VAL(LONGINT,adr);
+		ip.usedProtocol := IPv4;
+		RETURN ip;
+	ELSE
+		RETURN NilAdr;
+	END
+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
+		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; CONST 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
+	END;
+END AdrToArray;
+
+(** Return the interface on which packets with "dst" address should be sent. Return NIL if no interface matches. *)
+PROCEDURE InterfaceByDstIP*(dst: Adr): Interface;(*! NYI*)
+BEGIN
+	RETURN default
+END InterfaceByDstIP;
+
+		(* Find MULTIPLE IP address of the specified host. *)
+PROCEDURE InitInterfaces( hostname: ARRAY OF CHAR; VAR res: LONGINT );
+	VAR hostent: WSock32.PHostent; str: ARRAY 64 OF CHAR;
+		adr, adr2: Adr;
+		int0, int:Interface; i:LONGINT;
+		addr: ADDRESS;
+	BEGIN
+		hostent := WSock32.gethostbyname(hostname);
+		IF hostent = NIL THEN
+			WSock32.DispError()
+		ELSE
+			WHILE hostent.hLength>0 DO
+				adr.usedProtocol := IPv4;
+				(*adr := hostent.hName;
+				adr.ipv4Adr := hostent.hName;*)
+				SYSTEM.GET(hostent.hAddrList+i*SIZEOF(ADDRESS), addr (*adr.ipv4Adr*));
+				IF addr # NIL (*adr.ipv4Adr # 0*) THEN 
+					SYSTEM.GET(addr (*adr.ipv4Adr*), adr.ipv4Adr); 
+					NEW(int); int.localAdr:=adr;
+					IF int0=NIL THEN 
+						int0:=int; interfaces:=int0; default:=int0;
+					ELSE 
+						int0.next:=int; int0:=int; 
+					END;
+					INC(i); 
+					KernelLog.String("added IP interface "); AdrToStr(adr, str);  KernelLog.String(str); KernelLog.Ln;
+				END;
+				DEC(hostent.hLength);
+			END;
+		END;
+		IF adr.ipv4Adr # 0 THEN res := Ok ELSE res := -1 END;
+END InitInterfaces;
+
+PROCEDURE Init;
+	VAR name: ARRAY 256 OF CHAR; res: LONGINT; 
+BEGIN
+	KernelLog.String("IP.Init: Hostname ");
+	res := WSock32.gethostname(name, 256);
+	IF res = 0 THEN
+		KernelLog.String(name);KernelLog.Ln;
+	ELSE
+		KernelLog.String("failed "); KernelLog.Int(res, 0);KernelLog.Ln;
+		RETURN
+	END;
+	
+	NilAdr.usedProtocol := IPv4;
+	
+	InitInterfaces(name, res);
+END Init;
+
+(* Swap internal representation of an IP address from big to little endian or vice versa. *)
+PROCEDURE -SwapEndian(VAR adr: LONGINT);
+CODE {SYSTEM.AMD64}
+	POP RAX
+	MOV ECX, [RAX]
+	XCHG CL, CH
+	ROL ECX, 16
+	XCHG CL, CH
+	MOV [RAX], ECX
+END SwapEndian;
+
+BEGIN
+	default := NIL; 
+	Init;
+END IP.
+
+
+SystemTools.FreeDownTo IP ~

source/Win32.AMD64.Network.Mod

@@ -0,0 +1,754 @@
+(* Aos, Copyright 2001, Pieter Muller, ETH Zurich *)
+
+MODULE Network; (** AUTHOR "pjm, mvt"; PURPOSE "Abstract network device driver"; *)
+
+IMPORT SYSTEM, WSock32, Machine, KernelLog, Plugins, Kernel, Objects, Modules;
+	VAR
+
+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 *)
+	END;
+
+	ReceiverList = POINTER TO RECORD
+		next: ReceiverList;
+		type: LONGINT;
+		receiver: Receiver;
+	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. *)
+
+			recList: ReceiverList; (* receiver list *)
+			sendSnifferList: SendSnifferList; (* list for send sniffers *)
+			recvSnifferList: RecvSnifferList; (* list for receive sniffers *)
+
+			item: 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 *)
+
+			(* timer and packet count for loopback bandwidth control *)
+			timer: Kernel.MilliTimer;
+			packetCount: 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);
+		VAR res: 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 := {};
+
+			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; VAR 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; VAR 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; VAR 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. Only one receiver can be installed per type! *)
+		PROCEDURE InstallReceiver*(type: LONGINT; r: Receiver);
+		VAR item: ReceiverList;
+		BEGIN {EXCLUSIVE}
+			(* can run concurrently with active body *)
+			ASSERT(~finalized);
+			ASSERT(r # NIL);
+
+			(* test if there is already a receiver installed for this type *)
+			item := recList;
+			WHILE item # NIL DO
+				ASSERT(item^.type # type);
+				item := item^.next;
+			END;
+
+			(* create new entry *)
+			NEW(item);
+			item^.type := type;
+			item^.receiver := r;
+			item^.next := recList;
+			recList := item;
+		END InstallReceiver;
+
+		(** Remove the currently installed receiver for the given type. *)
+		PROCEDURE RemoveReceiver*(type: LONGINT);
+		VAR item: ReceiverList;
+		BEGIN {EXCLUSIVE}
+			(* can run concurrently with active body *)
+			ASSERT(~finalized);
+
+			(* remove receiver *)
+			IF recList = NIL THEN
+				(* empty list - nothing to remove *)
+			ELSIF recList^.type = type THEN
+				(* remove first item *)
+				recList := recList^.next;
+			ELSE
+				(* search list *)
+				item := recList;
+				WHILE (item^.next # NIL) & (item^.next^.type # type) DO
+					item := item^.next;
+				END;
+				IF item^.next # NIL THEN
+					item^.next := item^.next^.next;
+				ELSE
+					(* no receiver found for this type *)
+				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 receiver *)
+				item := recList;
+				WHILE (item # NIL) & (item^.type # buf.int) DO
+					item := item^.next;
+				END;
+				discard := (item = NIL);
+			END;
+			IF discard THEN
+				(* discard packet and return buffer *)
+				ReturnBuffer(buf);
+			ELSE
+				(* do upcall *)
+				item^.receiver(SELF, item^.type, 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);
+
+	(* 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; VAR 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);
+BEGIN {EXCLUSIVE}
+	ASSERT(buf # NIL);
+	buf.next := freeBufList;
+	freeBufList := buf;
+	Machine.AtomicInc(nofFreeBuf);
+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);
+CODE {SYSTEM.AMD64}
+	MOV EAX, [RBP+val]
+	MOV EBX, [RBP+ofs]
+	MOV RCX, [RBP+buf]
+	MOV [RCX+RBX], EAX
+END Put4;
+
+(** Put a 16-bit host value into buf[ofs..ofs+1] *)
+
+PROCEDURE Put2*(VAR buf: ARRAY OF CHAR; ofs, val: LONGINT);
+CODE {SYSTEM.AMD64}
+	MOV EAX, [RBP+val]
+	MOV EBX, [RBP+ofs]
+	MOV RCX, [RBP+buf]
+	MOV [RCX+RBX], AX
+END Put2;
+
+(** Get a 32-bit host value from buf[ofs..ofs+3] *)
+
+PROCEDURE Get4*(CONST buf: ARRAY OF CHAR; ofs: LONGINT): LONGINT;
+CODE {SYSTEM.AMD64}
+	MOV EBX, [RBP+ofs]
+	MOV RCX, [RBP+buf]
+	MOV EAX, [RCX+RBX]
+END Get4;
+
+(** Get a 16-bit host value from buf[ofs..ofs+1] *)
+
+PROCEDURE Get2*(CONST buf: ARRAY OF CHAR; ofs: LONGINT): LONGINT;
+CODE {SYSTEM.AMD64}
+	MOV EBX, [RBP+ofs]
+	MOV RCX, [RBP+buf]
+	XOR EAX, EAX
+	MOV AX, [RCX+RBX]
+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);
+CODE {SYSTEM.AMD64}
+	MOV EAX, [RBP+val]
+	XCHG AL, AH
+	ROL EAX, 16
+	XCHG AL, AH
+	MOV EBX, [RBP+ofs]
+	MOV RCX, [RBP+buf]
+	MOV [RCX+RBX], EAX
+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);
+CODE {SYSTEM.AMD64}
+	MOV EAX, [RBP+val]
+	XCHG AL, AH
+	MOV EBX, [RBP+ofs]
+	MOV RCX, [RBP+buf]
+	MOV [RCX+RBX], AX
+END PutNet2;
+
+(** Get a 32-bit network value from buf[ofs..ofs+3] in host byte order *)
+
+PROCEDURE GetNet4*(CONST buf: ARRAY OF CHAR; ofs: LONGINT): LONGINT;
+CODE {SYSTEM.AMD64}
+	MOV EBX, [RBP+ofs]
+	MOV RCX, [RBP+buf]
+	MOV EAX, [RCX+EBX]
+	XCHG AL, AH
+	ROL EAX, 16
+	XCHG AL, AH
+END GetNet4;
+
+(** Get a 16-bit network value from buf[ofs..ofs+1] in host byte order *)
+
+PROCEDURE GetNet2*(CONST buf: ARRAY OF CHAR; ofs: LONGINT): LONGINT;
+CODE {SYSTEM.AMD64}
+	MOV EBX, [RBP+ofs]
+	MOV RCX, [RBP+buf]
+	XOR EAX, EAX
+	MOV AX, [RCX+RBX]
+	XCHG AL, AH
+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;
+
+(** Copy data from array to array *)
+
+PROCEDURE Copy*(VAR from, to: ARRAY OF CHAR; fofs, tofs, len: LONGINT);
+		VAR res: 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);
+	WSock32.CleanUp;
+END Cleanup;
+
+BEGIN
+	nofBuf := 0;
+	nofFreeBuf := 0;
+
+	NEW(registry, "Network", "Network interface drivers");
+	WSock32.Startup;
+
+	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".
+*)
+
+(**
+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.
+
+*)