Browse Source

console Windows version added

Alexander Shiryaev 12 years ago
parent
commit
54a9ab0956

+ 5 - 2
BlackBox/Cons/Mod/Interp.txt

@@ -21,8 +21,11 @@ MODULE ConsInterp;
 		textR.SetPos(0);
 		textR.ReadChar(c);
 		WHILE ~textR.eot DO
-			IF c = 0DX THEN c := 0AX END;
-			Console.WriteChar(c);
+			IF c = 0DX THEN
+				Console.WriteLn
+			ELSE
+				Console.WriteChar(c)
+			END;
 			textR.ReadChar(c)
 		END;
 		StdLog.text.Delete(0, StdLog.text.Length())

+ 5 - 2
BlackBox/Cons/Mod/Log.txt

@@ -42,8 +42,11 @@ MODULE ConsLog;
 			textR.SetPos(0);
 			textR.ReadChar(c);
 			WHILE ~textR.eot DO
-				IF c = 0DX THEN c := 0AX END;
-				Console.WriteChar(c);
+				IF c = 0DX THEN
+					Console.WriteLn
+				ELSE
+					Console.WriteChar(c)
+				END;
 				textR.ReadChar(c)
 			END;
 			buf.Delete(0, buf.Length())

+ 3 - 3
BlackBox/Dev0/Mod/Interp.txt

@@ -2,8 +2,6 @@ MODULE Dev0Interp;
 
 	(*
 		A. V. Shiryaev, 2012.10
-
-		(Std)Interpreter on (Host)Console
 	*)
 
 	IMPORT Console, HostConsole (* required *), Strings, Dialog, StdInterpreter (* required (Dialog.SetCallHook) *);
@@ -42,7 +40,7 @@ MODULE Dev0Interp;
 	RETURN res
 	END Call;
 
-	PROCEDURE Init*;
+	PROCEDURE Init;
 		VAR s: ARRAY 1024 OF CHAR;
 	BEGIN
 		Console.ReadLn(s);
@@ -51,4 +49,6 @@ MODULE Dev0Interp;
 		END
 	END Init;
 
+BEGIN
+	Init
 END Dev0Interp.

BIN
BlackBox/Dev0/Mod/Linker.odc


+ 1779 - 0
BlackBox/Dev0/Mod/Linker.txt

@@ -0,0 +1,1779 @@
+MODULE Dev0Linker;
+
+	(* THIS IS TEXT COPY OF Linker.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT
+		Kernel, Files, (* Dates, Dialog, *) Strings,
+		(* TextModels, TextViews, TextMappers,
+		Log := StdLog, DevCommanders *) Console;
+	
+	CONST
+		NewRecFP = 4E27A847H;
+		NewArrFP = 76068C78H;
+
+		ImageBase = 00400000H;
+		ObjAlign = 1000H;
+		FileAlign = 200H;
+		HeaderSize = 400H;
+
+		FixLen = 30000;
+		
+		OFdir = "Code";
+		SYSdir = "System";
+		RsrcDir = "Rsrc";
+		WinDir = "Win";
+
+		(* meta interface consts *)
+		mConst = 1; mTyp = 2; mVar = 3; mProc = 4; mField = 5;
+		mInternal = 1; mReadonly = 2; mExported = 4;
+
+		(* fixup types *)
+		absolute = 100; relative = 101; copy = 102; table = 103; tableend = 104;
+		
+		(* mod desc fields *)
+		modOpts = 4; modRefcnt = 8; modTerm = 40; modNames = 84; modImports = 92; modExports = 96;
+		
+
+		(* A. V. Shiryaev: Scanner *)
+		TMChar = 0; TMString = 1; TMInt = 2; TMEOT = 3;
+
+	TYPE
+		Name = ARRAY 40 OF SHORTCHAR;
+		Export = POINTER TO RECORD
+			next: Export;
+			name: Name;
+			adr: INTEGER
+		END;
+		Resource = POINTER TO RECORD
+			next, local: Resource;
+			typ, id, lid, size, pos, x, y: INTEGER;
+			opts: SET;
+			file: Files.File;
+			name: Files.Name
+		END;
+		Module = POINTER TO RECORD
+			next: Module;
+			name: Files.Name;
+			file: Files.File;
+			hs, ms, ds, cs, vs, ni, ma, ca, va: INTEGER;
+			dll, intf: BOOLEAN;
+			exp: Export;
+			imp: POINTER TO ARRAY OF Module;
+			data: POINTER TO ARRAY OF BYTE;
+		END;
+		
+		(* A. V. Shiryaev: Scanner *)
+			ScanRider = RECORD
+				s: POINTER TO ARRAY OF CHAR;
+				i: INTEGER
+			END;
+			Scanner = RECORD
+				rider: ScanRider;
+				start, type: INTEGER;
+
+				string: ARRAY 100 OF CHAR;
+				char: CHAR;
+				int: INTEGER
+			END;
+
+	VAR
+(*
+		W: TextMappers.Formatter;
+*)
+		Out: Files.File;
+		R: Files.Reader;
+		Ro: Files.Writer;
+		error, isDll, isStatic, comLine: BOOLEAN;
+		modList, kernel, main, last, impg, impd: Module;
+		numMod, lastTerm: INTEGER;
+		resList: Resource;
+		numType, resHSize: INTEGER;
+		numId: ARRAY 32 OF INTEGER;
+		rsrcName: ARRAY 16 OF CHAR;	(* name of resource file *)
+		firstExp, lastExp: Export;
+		entryPos, isPos, fixPos, himpPos, hexpPos, hrsrcPos, termPos: INTEGER;
+		codePos, dataPos, conPos, rsrcPos, impPos, expPos, relPos: INTEGER;
+		CodeSize, DataSize, ConSize, RsrcSize, ImpSize, ImpHSize, ExpSize, RelocSize, DllSize: INTEGER;
+		CodeRva, DataRva, ConRva, RsrcRva, ImpRva, ExpRva, RelocRva, ImagesSize: INTEGER;
+		CodeBase, DataBase, ConBase, maxCode, numImp, numExp, noffixup, timeStamp: INTEGER;
+		newRec, newArr: Name;
+		fixups: POINTER TO ARRAY OF INTEGER;
+		code: POINTER TO ARRAY OF BYTE;
+		atab: POINTER TO ARRAY OF INTEGER;
+		ntab: POINTER TO ARRAY OF SHORTCHAR;
+
+	(* A. V. Shiryaev: Console *)
+
+		PROCEDURE WriteString (s: ARRAY OF CHAR);
+		BEGIN
+			Console.WriteStr(s)
+		END WriteString;
+
+		PROCEDURE WriteChar (c: CHAR);
+			VAR s: ARRAY 2 OF CHAR;
+		BEGIN
+			s[0] := c; s[1] := 0X;
+			Console.WriteStr(s)
+		END WriteChar;
+
+		PROCEDURE WriteSString (ss: ARRAY OF SHORTCHAR);
+		BEGIN
+			Console.WriteStr(ss$)
+		END WriteSString;
+
+		PROCEDURE WriteInt (x: INTEGER);
+			VAR s: ARRAY 16 OF CHAR;
+		BEGIN
+			Strings.IntToString(x, s);
+			Console.WriteStr(s)
+		END WriteInt;
+
+		PROCEDURE WriteLn;
+		BEGIN
+			Console.WriteLn
+		END WriteLn;
+
+		PROCEDURE FlushW;
+		BEGIN
+		END FlushW;
+
+(*
+	PROCEDURE TimeStamp (): INTEGER;	(* seconds since 1.1.1970 00:00:00 *)
+		VAR a: INTEGER; t: Dates.Time; d: Dates.Date;
+	BEGIN
+		Dates.GetTime(t); Dates.GetDate(d);
+		a := 12 * (d.year - 70) + d.month - 3;
+		a := a DIV 12 * 1461 DIV 4 + (a MOD 12 * 153 + 2) DIV 5 + d.day + 59;
+		RETURN ((a * 24 + t.hour) * 60 + t.minute) * 60 + t.second;
+	END TimeStamp;
+*)
+
+	PROCEDURE ThisFile (modname: ARRAY OF CHAR): Files.File;
+		VAR dir, name: Files.Name; loc: Files.Locator; f: Files.File;
+	BEGIN
+		Kernel.SplitName(modname, dir, name);
+		Kernel.MakeFileName(name, Kernel.objType);
+		loc := Files.dir.This(dir); loc := loc.This(OFdir);
+		f := Files.dir.Old(loc, name, TRUE);
+		IF (f = NIL) & (dir = "") THEN
+			loc := Files.dir.This(SYSdir); loc := loc.This(OFdir);
+			f := Files.dir.Old(loc, name, TRUE)
+		END;
+		RETURN f
+	END ThisFile;
+	
+	PROCEDURE ThisResFile (VAR name: Files.Name): Files.File;
+		VAR loc: Files.Locator; f: Files.File;
+	BEGIN
+		f := Files.dir.Old(Files.dir.This(RsrcDir), name, TRUE);
+		IF f = NIL THEN
+			loc := Files.dir.This(WinDir); loc := loc.This(RsrcDir);
+			f := Files.dir.Old(loc, name, TRUE);
+			IF f = NIL THEN
+				f := Files.dir.Old(Files.dir.This(""), name, TRUE)
+			END
+		END;
+		RETURN f
+	END ThisResFile;
+	
+	PROCEDURE Read2 (VAR x: INTEGER);
+		VAR b: BYTE;
+	BEGIN
+		R.ReadByte(b); x := b MOD 256;
+		R.ReadByte(b); x := x + 100H * (b MOD 256)
+	END Read2;
+	
+	PROCEDURE Read4 (VAR x: INTEGER);
+		VAR b: BYTE;
+	BEGIN
+		R.ReadByte(b); x := b MOD 256;
+		R.ReadByte(b); x := x + 100H * (b MOD 256);
+		R.ReadByte(b); x := x + 10000H * (b MOD 256);
+		R.ReadByte(b); x := x + 1000000H * b
+	END Read4;
+	
+	PROCEDURE ReadName (VAR name: ARRAY OF SHORTCHAR);
+		VAR i: INTEGER; b: BYTE;
+	BEGIN i := 0;
+		REPEAT
+			R.ReadByte(b); name[i] := SHORT(CHR(b)); INC(i)
+		UNTIL b = 0
+	END ReadName;
+		
+	PROCEDURE RNum (VAR i: INTEGER);
+		VAR b: BYTE; s, y: INTEGER;
+	BEGIN
+		s := 0; y := 0; R.ReadByte(b);
+		WHILE b < 0 DO INC(y, ASH(b + 128, s)); INC(s, 7); R.ReadByte(b) END;
+		i := ASH((b + 64) MOD 128 - 64, s) + y
+	END RNum;
+	
+	PROCEDURE WriteCh (ch: SHORTCHAR);
+	BEGIN
+		Ro.WriteByte(SHORT(ORD(ch)))
+	END WriteCh;
+	
+	PROCEDURE Write2 (x: INTEGER);
+	BEGIN
+		Ro.WriteByte(SHORT(SHORT(x MOD 256))); x := x DIV 256;
+		Ro.WriteByte(SHORT(SHORT(x MOD 256)))
+	END Write2;
+	
+	PROCEDURE Write4 (x: INTEGER);
+	BEGIN
+		Ro.WriteByte(SHORT(SHORT(x MOD 256))); x := x DIV 256;
+		Ro.WriteByte(SHORT(SHORT(x MOD 256))); x := x DIV 256;
+		Ro.WriteByte(SHORT(SHORT(x MOD 256))); x := x DIV 256;
+		Ro.WriteByte(SHORT(SHORT(x MOD 256)))
+	END Write4;
+	
+	PROCEDURE WriteName (s: ARRAY OF SHORTCHAR; len: SHORTINT);
+		VAR i: SHORTINT;
+	BEGIN i := 0;
+		WHILE s[i] # 0X DO Ro.WriteByte(SHORT(ORD(s[i]))); INC(i) END;
+		WHILE i < len DO Ro.WriteByte(0); INC(i) END
+	END WriteName;
+	
+	PROCEDURE Reloc (a: INTEGER);
+		VAR p: POINTER TO ARRAY OF INTEGER; i: INTEGER;
+	BEGIN
+		IF noffixup >= LEN(fixups) THEN
+			NEW(p, 2 * LEN(fixups));
+			i := 0; WHILE i < LEN(fixups) DO p[i] := fixups[i]; INC(i) END;
+			fixups := p
+		END;
+		fixups[noffixup] := a; INC(noffixup)
+(*
+		ELSE
+			IF ~error THEN W.WriteSString("  too many fixups") END;
+			error := TRUE
+		END
+*)
+	END Reloc;
+	
+	PROCEDURE Put (mod: Module; a, x: INTEGER);
+	BEGIN
+		mod.data[a] := SHORT(SHORT(x)); INC(a); x := x DIV 256;
+		mod.data[a] := SHORT(SHORT(x)); INC(a); x := x DIV 256;
+		mod.data[a] := SHORT(SHORT(x)); INC(a); x := x DIV 256;
+		mod.data[a] := SHORT(SHORT(x))
+	END Put;
+	
+	PROCEDURE Get (mod: Module; a: INTEGER; VAR x: INTEGER);
+	BEGIN
+		x := ((mod.data[a + 3] * 256 +
+			(mod.data[a + 2] MOD 256)) * 256 +
+			(mod.data[a + 1] MOD 256)) * 256 +
+			(mod.data[a] MOD 256)
+	END Get;
+	
+	PROCEDURE GenName (VAR from, to: ARRAY OF SHORTCHAR; ext: ARRAY OF SHORTCHAR);
+		VAR i, j: INTEGER;
+	BEGIN
+		i := 0;
+		WHILE from[i] # 0X DO to[i] := from[i]; INC(i) END;
+		IF ext # "" THEN
+			to[i] := "."; INC(i); j := 0;
+			WHILE ext[j] # 0X DO to[i] := ext[j]; INC(i); INC(j) END
+		END;
+		to[i] := 0X
+	END GenName;
+	
+	PROCEDURE Fixup0 (link, adr: INTEGER);
+		VAR offset, linkadr, t, n, x: INTEGER;
+	BEGIN
+		WHILE link # 0 DO
+			RNum(offset);
+			WHILE link # 0 DO
+				IF link > 0 THEN
+					n := (code[link] MOD 256) + (code[link+1] MOD 256) * 256 + code[link+2] * 65536;
+					t := code[link+3]; linkadr := CodeBase + impg.ca + link
+				ELSE
+					n := (impg.data[-link] MOD 256) + (impg.data[-link+1] MOD 256) * 256 + impg.data[-link+2] * 65536;
+					t := impg.data[-link+3]; linkadr := ConBase + impg.ma - link
+				END;
+				IF t = absolute THEN x := adr + offset
+				ELSIF t = relative THEN x := adr + offset - linkadr - 4
+				ELSIF t = copy THEN Get(impd, adr + offset - ConBase - impd.ma, x)
+				ELSIF t = table THEN x := adr + n; n := link + 4
+				ELSIF t = tableend THEN x := adr + n; n := 0
+				ELSE HALT(99)
+				END;
+				IF link > 0 THEN
+					code[link] := SHORT(SHORT(x));
+					code[link+1] := SHORT(SHORT(x DIV 100H));
+					code[link+2] := SHORT(SHORT(x DIV 10000H));
+					code[link+3] := SHORT(SHORT(x DIV 1000000H))
+				ELSE
+					link := -link;
+					impg.data[link] := SHORT(SHORT(x));
+					impg.data[link+1] := SHORT(SHORT(x DIV 100H));
+					impg.data[link+2] := SHORT(SHORT(x DIV 10000H));
+					impg.data[link+3] := SHORT(SHORT(x DIV 1000000H))
+				END;
+				IF (t # relative) & ((t # copy) OR (x DIV 65536 # 0)) THEN Reloc(linkadr) END;
+				link := n
+			END;
+			RNum(link)
+		END
+	END Fixup0;
+	
+	PROCEDURE Fixup (adr: INTEGER);
+		VAR link: INTEGER;
+	BEGIN
+		RNum(link); Fixup0(link, adr)
+	END Fixup;
+	
+	PROCEDURE CheckDllImports (mod: Module);
+		VAR i, x, y: INTEGER; name: Name; imp: Module; exp: Export;
+		
+		PROCEDURE SkipLink;
+			VAR a: INTEGER;
+		BEGIN
+			RNum(a);
+			WHILE a # 0 DO RNum(a); RNum(a) END
+		END SkipLink;
+
+	BEGIN
+		R := mod.file.NewReader(R);
+		R.SetPos(mod.hs + mod.ms + mod.ds + mod.cs);
+		SkipLink; SkipLink; SkipLink; SkipLink; SkipLink; SkipLink; i := 0;
+		WHILE i < mod.ni DO
+			imp := mod.imp[i];
+			IF imp # NIL THEN
+				RNum(x);
+				WHILE x # 0 DO
+					ReadName(name); RNum(y);
+					IF x = mVar THEN SkipLink;
+						IF imp.dll THEN
+							WriteString("variable (");
+							WriteString(imp.name); WriteChar(".");
+							WriteSString(name);
+							WriteString(") imported from DLL in ");
+							WriteString(mod.name);
+							WriteLn; FlushW; error := TRUE;
+							RETURN
+						END
+					ELSIF x = mTyp THEN RNum(y);
+						IF imp.dll THEN
+							RNum(y);
+							IF y # 0 THEN
+								WriteString("type descriptor (");
+								WriteString(imp.name); WriteChar(".");
+								WriteSString(name);
+								WriteString(") imported from DLL in ");
+								WriteString(mod.name);
+								WriteLn; FlushW; error := TRUE;
+								RETURN
+							END
+						ELSE SkipLink
+						END
+					ELSIF x = mProc THEN
+						IF imp.dll THEN
+							SkipLink; exp := imp.exp;
+							WHILE (exp # NIL) & (exp.name # name) DO exp := exp.next END;
+							IF exp = NIL THEN
+								NEW(exp); exp.name := name$;
+								exp.next := imp.exp; imp.exp := exp; INC(DllSize, 6)
+							 END
+						END
+					END;
+					RNum(x)
+				END
+			END;
+			INC(i)
+		END
+	END CheckDllImports;
+	
+	PROCEDURE ReadHeaders;
+		VAR mod, im, t: Module; x, i: INTEGER; impdll: BOOLEAN; exp: Export; name: Name;
+	BEGIN
+		mod := modList; modList := NIL; numMod := 0;
+		WHILE mod # NIL DO	(* reverse mod list & count modules *)
+			IF ~mod.dll THEN INC(numMod) END;
+			t := mod; mod := t.next; t.next := modList; modList := t
+		END;
+		IF isStatic THEN
+			IF isDll THEN
+				(* push ebx; cmp [12, esp], 1; jne L1; mov ebx, modlist; { call body; } jp L2 *)
+				(* L1: cmp [12, esp], 0; jne L2; { call term; } *)
+				(* L2: pop ebx; mov aex,1; ret 12 *)
+				CodeSize := 42 + 10 * numMod
+			ELSE
+				(* push ebx; push ebx; push ebx; mov ebx, modlist; { call body; } { call term; } *)
+				(* pop ebx; pop ebx; pop ebx; ret *)
+				CodeSize := 12 + 10 * numMod
+			END
+		ELSE
+			IF isDll THEN
+				(* push ebx; cmp [12, esp], 1; jne L1; mov ebx, modlist; call main; jp L2 *)
+				(* L1: cmp [12, esp], 0; jne L2; call mainTerm; *)
+				(* L2: pop ebx; mov aex,1; ret 12 *)
+				CodeSize := 41
+			ELSE
+				(* mov ebx, modlist; jmp main *)
+				CodeSize := 10
+			END
+		END;
+(*
+		IF isDll THEN
+			CodeSize := 24	(* push ebx, esi, edi; mov bx, modlist; call main; pop edi, esi, ebx; mov aex,1; ret 12 *)
+		ELSE
+			CodeSize := 10	(* mov bx, modlist; jmp main *)
+		END
+*)
+		DataSize := 0; ConSize := 0;
+		ImpSize := 0; ImpHSize := 0; ExpSize := 0;
+		RelocSize := 0; DllSize := 0; noffixup := 0; maxCode := 0; numImp := 0; numExp := 0;
+		mod := modList;
+		WHILE mod # NIL DO
+			IF ~mod.dll THEN
+				mod.file := ThisFile(mod.name);
+				IF mod.file # NIL THEN
+					R := mod.file.NewReader(R); R.SetPos(0); Read4(x);
+					IF x = 6F4F4346H THEN
+						Read4(x);
+						Read4(mod.hs); Read4(mod.ms); Read4(mod.ds); Read4(mod.cs);
+						Read4(mod.vs); RNum(mod.ni); ReadName(name); impdll := FALSE;
+						IF mod.ni > 0 THEN
+							NEW(mod.imp, mod.ni); x := 0;
+							WHILE x < mod.ni DO
+								ReadName(name);
+								IF name = "$$" THEN
+									IF (mod # kernel) & (kernel # NIL) THEN
+										mod.imp[x] := kernel
+									ELSE
+										WriteSString("no kernel"); WriteLn;
+										FlushW; error := TRUE
+									END
+								ELSIF name[0] = "$" THEN
+									i := 1;
+									WHILE name[i] # 0X DO name[i-1] := name[i]; INC(i) END;
+									name[i-1] := 0X; impdll := TRUE; im := modList;
+									WHILE (im # mod) & (im.name # name) DO im := im.next END;
+									IF (im = NIL) OR ~im.dll THEN
+										NEW(im); im.next := modList; modList := im;
+										im.name := name$;
+										im.dll := TRUE
+									END;
+									mod.imp[x] := im;
+								ELSE
+									im := modList;
+									WHILE (im # mod) & (im.name # name) DO im := im.next END;
+									IF im # mod THEN
+										mod.imp[x] := im;
+									ELSE
+										WriteSString(name);
+										WriteString(" not present (imported in ");
+										WriteString(mod.name); WriteChar(")");
+										WriteLn; FlushW; error := TRUE
+									END
+								END;
+								INC(x)
+							END
+						END;
+						IF impdll & ~error THEN CheckDllImports(mod) END;
+						mod.ma := ConSize; INC(ConSize, mod.ms + mod.ds);
+						mod.va := DataSize; INC(DataSize, mod.vs);
+						mod.ca := CodeSize; INC(CodeSize, mod.cs);
+						IF mod.cs > maxCode THEN maxCode := mod.cs END
+					ELSE
+						WriteString(mod.name); WriteString(": wrong file type"); 
+						WriteLn; FlushW; error := TRUE
+					END;
+					mod.file.Close; mod.file := NIL
+				ELSE
+					WriteString(mod.name); WriteString(" not found"); 
+					WriteLn; FlushW; error := TRUE
+				END;
+				last := mod
+			END;
+			mod := mod.next
+		END;
+		IF ~isStatic & (main = NIL) THEN
+			WriteSString("no main module specified"); WriteLn;
+			FlushW; error := TRUE
+		END;
+		(* calculate rva's *)
+		IF DataSize = 0 THEN DataSize := 1 END;
+		CodeRva := ObjAlign;
+		DataRva := CodeRva + (CodeSize + DllSize + (ObjAlign - 1)) DIV ObjAlign * ObjAlign;
+		ConRva := DataRva + (DataSize + (ObjAlign - 1)) DIV ObjAlign * ObjAlign;
+		RsrcRva := ConRva + (ConSize + (ObjAlign - 1)) DIV ObjAlign * ObjAlign;
+		CodeBase := ImageBase + CodeRva;
+		DataBase := ImageBase + DataRva;
+		ConBase := ImageBase + ConRva;
+		(* write dll export adresses *)
+		mod := modList; x := 0;
+		WHILE mod # NIL DO
+			IF mod.dll THEN
+				exp := mod.exp; INC(ImpSize, 20);
+				WHILE exp # NIL DO exp.adr := x; INC(x, 6); exp := exp.next END
+			END;
+			mod := mod.next
+		END;
+		ASSERT(x = DllSize); INC(ImpSize, 20); (* sentinel *)
+	END ReadHeaders;
+	
+	PROCEDURE MenuSize (r: Resource): INTEGER;
+		VAR s, i: INTEGER;
+	BEGIN
+		s := 0;
+		WHILE r # NIL DO
+			INC(s, 2);
+			IF r.local = NIL THEN INC(s, 2) END;
+			i := 0; WHILE r.name[i] # 0X DO INC(s, 2); INC(i) END;
+			INC(s, 2);
+			s := s + MenuSize(r.local);
+			r := r.next
+		END;
+		RETURN s
+	END MenuSize;
+	
+	PROCEDURE PrepResources;
+		VAR res, r, s: Resource; n, i, j, t, x: INTEGER; loc: Files.Locator;
+	BEGIN
+		r := resList;
+		WHILE r # NIL DO
+			IF r.lid = 0 THEN r.lid := 1033 END;
+			IF r.name = "MENU" THEN
+				r.typ := 4; r.size := 4 + MenuSize(r.local);
+			ELSIF r.name = "ACCELERATOR" THEN
+				r.typ := 9; r.size := 0; s := r.local;
+				WHILE s # NIL DO INC(r.size, 8); s := s.next END;
+			ELSE
+				r.file := ThisResFile(r.name);
+				IF r.file # NIL THEN
+					IF r.typ = -1 THEN	(* typelib *)
+						r.typ := 0; r.size := r.file.Length(); r.pos := 0; rsrcName := "TYPELIB"
+					ELSE
+						R := r.file.NewReader(R); R.SetPos(0); Read2(n);
+						IF n = 4D42H THEN	(* bitmap *)
+							Read4(n); r.typ := 2; r.size := n - 14; r.pos := 14;
+						ELSE
+							Read2(x);
+							IF x = 1 THEN	(* icon *)
+								Read2(n); r.typ := 14; r.size := 6 + 14 * n; r.pos := 0; i := 0;
+								WHILE i < n DO
+									NEW(s); s.typ := 3; s.id := 10 * r.id + i; s.lid := r.lid; s.name := r.name$; 
+									Read4(x); Read4(x); Read4(s.size); Read2(s.pos); Read2(x);
+									s.next := resList; resList := s;
+									INC(i)
+								END
+							ELSIF x = 2 THEN	(* cursor *)
+								Read2(n); r.typ := 12; r.size := 6 + 14 * n; r.pos := 0; i := 0;
+								WHILE i < n DO
+									NEW(s); s.typ := 1; s.id := 10 * r.id + i; s.lid := r.lid; s.name := r.name$; 
+									Read4(x); Read2(s.x); Read2(s.y); Read4(s.size); INC(s.size, 4); Read2(s.pos); Read2(x);
+									s.next := resList; resList := s;
+									INC(i)
+								END
+							ELSE
+								Read4(n);
+								IF (x = 0) & (n = 20H) THEN	(* resource file *)
+									Read4(n); Read4(n); Read4(n); Read4(n); Read4(n); Read4(n);	(* 32 bit marker *)
+									Read4(r.size); Read4(n); Read2(i); 
+									IF i = 0FFFFH THEN
+										Read2(j);
+										IF (j >= 4) & ((j <= 11) OR (j = 16)) THEN
+											r.typ := j; r.pos := n + 32;
+										ELSE
+											WriteString(r.name); WriteString(": invalid type"); WriteLn;
+											FlushW; error := TRUE
+										END
+									ELSE
+										j := 0;
+										WHILE i # 0 DO rsrcName[j] := CHR(i); INC(j); Read2(i) END;
+										rsrcName[j] := 0X;
+										r.typ := 0; r.pos := n + 32
+									END
+								ELSE
+									WriteString(r.name); WriteString(": unknown type"); WriteLn;
+									FlushW; error := TRUE
+								END
+							END
+						END
+					END;
+					r.file.Close; r.file := NIL
+				ELSE
+					WriteString(r.name); WriteString(" not found"); WriteLn;
+					FlushW; error := TRUE
+				END
+			END;
+			r := r.next
+		END;
+		res := resList; resList := NIL;	(* sort resources *)
+		WHILE res # NIL DO
+			r := res; res := res.next;
+			IF (resList = NIL) OR (r.typ < resList.typ) OR (r.typ = resList.typ) & ((r.id < resList.id) OR (r.id = resList.id) & (r.lid < resList.lid))
+			THEN
+				r.next := resList; resList := r
+			ELSE
+				s := resList;
+				WHILE (s.next # NIL) & (r.typ >= s.next.typ)
+					& ((r.typ # s.next.typ) OR (r.id >= s.next.id) & ((r.id # s.next.id) OR (r.lid >= s.next.lid))) DO s := s.next END;
+				r.next := s.next; s.next := r
+			END
+		END;
+		r := resList; numType := 0; resHSize := 16; t := 0; n := 0;	(* get resource size *)
+		WHILE t < LEN(numId) DO numId[t] := 0; INC(t) END;
+		WHILE r # NIL DO
+			INC(numType); INC(resHSize, 24); t := r.typ;
+			WHILE (r # NIL) & (r.typ = t) DO
+				INC(numId[t]); INC(resHSize, 24); i := r.id;
+				WHILE (r # NIL) & (r.typ = t) & (r.id = i) DO
+					INC(resHSize, 24); INC(n, (r.size + 3) DIV 4 * 4); r := r.next
+				END
+			END
+		END;
+		IF numId[0] > 0 THEN INC(n, (LEN(rsrcName$) + 1) * 2) END;
+		RsrcSize := resHSize + n;
+		ImpRva := RsrcRva + (RsrcSize + (ObjAlign - 1)) DIV ObjAlign * ObjAlign
+	END PrepResources;
+	
+	PROCEDURE WriteHeader(VAR name: Files.Name);
+	BEGIN
+		Out := Files.dir.New(Files.dir.This(""), Files.ask); Ro := Out.NewWriter(Ro); Ro.SetPos(0);
+
+		(* DOS header *)
+		Write4(905A4DH); Write4(3); Write4(4); Write4(0FFFFH);
+		Write4(0B8H); Write4(0); Write4(40H); Write4(0);
+		Write4(0); Write4(0); Write4(0); Write4(0);
+		Write4(0); Write4(0); Write4(0); Write4(80H);
+		Write4(0EBA1F0EH); Write4(0CD09B400H); Write4(4C01B821H); Write2(21CDH);
+		WriteName("This program cannot be run in DOS mode.", 39);
+		WriteCh(0DX); WriteCh(0DX); WriteCh(0AX);
+		Write4(24H); Write4(0);
+
+		(* Win32 header *)
+		WriteName("PE", 4); (* signature bytes *)
+		Write2(014CH); (* cpu type (386) *)
+		IF isDll THEN
+			Write2(7); (* 7 objects *)
+		ELSE
+			Write2(6); (* 6 objects *)
+		END;
+		Write4(timeStamp); (* time/date *)
+		Write4(0); Write4(0);
+		Write2(0E0H); (* NT header size *)
+		IF isDll THEN
+			Write2(0A38EH); (* library image flags *)
+		ELSE
+			Write2(838EH); (* program image flags *)
+		END;
+		Write2(10BH); (* magic (normal ececutable file) *)
+		Write2(0301H); (* linker version !!! *)
+		Write4(CodeSize); (* code size *)
+		Write4(ConSize); (* initialized data size *)
+		Write4(DataSize); (* uninitialized data size *)
+		entryPos := Ro.Pos();
+		Write4(0); (* entry point *)	(* !!! *)
+		Write4(CodeRva); (* base of code *)
+		Write4(ConRva); (* base of data *)
+		Write4(400000H); (* image base *)
+		Write4(ObjAlign); (* object align *)
+		Write4(FileAlign); (* file align *)
+		Write4(3); (* OS version *)
+		Write4(4); (* user version *)
+		Write4(4); (* subsys version *) (* mf 14.3.04: value changed from 0A0003H to 4. Corrects menubar pixel bug on Windows XP *)
+		Write4(0);
+		isPos := Ro.Pos();
+		Write4(0); (* image size *)	(* !!! *)
+		Write4(HeaderSize); (* header size !!! *)
+		Write4(0); (* checksum *)
+		IF comLine THEN
+			Write2(3) (* dos subsystem *)
+		ELSE
+			Write2(2) (* gui subsystem *)
+		END;
+		Write2(0); (* dll flags *)
+		Write4(200000H); (* stack reserve size *)
+		Write4(10000H); (* stack commit size *)
+		IF isDll THEN
+			Write4(00100000H); (* heap reserve size *)
+		ELSE
+			Write4(00400000H); (* heap reserve size *)
+		END;
+		Write4(10000H); (* heap commit size *)
+		Write4(0);
+		Write4(16); (* num of rva/sizes *)
+		hexpPos := Ro.Pos();
+		Write4(0); Write4(0); (* export table *)
+		himpPos := Ro.Pos();
+		Write4(0); Write4(0); (* import table *)	(* !!! *)
+		hrsrcPos := Ro.Pos();
+		Write4(0); Write4(0); (* resource table *)	(* !!! *)
+		Write4(0); Write4(0); (* exception table *)
+		Write4(0); Write4(0); (* security table *)
+		fixPos := Ro.Pos();
+		Write4(0); Write4(0); (* fixup table *)	(* !!! *)
+		Write4(0); Write4(0); (* debug table *)
+		Write4(0); Write4(0); (* image description *)
+		Write4(0); Write4(0); (* machine specific *)
+		Write4(0); Write4(0); (* thread local storage *)
+		Write4(0); Write4(0); (* ??? *)
+		Write4(0); Write4(0); (* ??? *)
+		Write4(0); Write4(0); (* ??? *)
+		Write4(0); Write4(0); (* ??? *)
+		Write4(0); Write4(0); (* ??? *)
+		Write4(0); Write4(0); (* ??? *)
+
+		(* object directory *)
+		WriteName(".text", 8); (* code object *)
+		Write4(0); (* object size (always 0) *)
+		codePos := Ro.Pos();
+		Write4(0); (* object rva *)
+		Write4(0); (* physical size *)
+		Write4(0); (* physical offset *)
+		Write4(0); Write4(0); Write4(0);
+		Write4(60000020H); (* flags: code, exec, read *)
+
+		WriteName(".var", 8); (* variable object *)
+		Write4(0); (* object size (always 0) *)
+		dataPos := Ro.Pos();
+		Write4(0); (* object rva *)
+		Write4(0); (* physical size *)
+		Write4(0); (* physical offset *)	(* zero! (noinit) *)
+		Write4(0); Write4(0); Write4(0);
+		Write4(0C0000080H); (* flags: noinit, read, write *)
+
+		WriteName(".data", 8); (* constant object *)
+		Write4(0); (* object size (always 0) *)
+		conPos := Ro.Pos();
+		Write4(0); (* object rva *)
+		Write4(0); (* physical size *)
+		Write4(0); (* physical offset *)
+		Write4(0); Write4(0); Write4(0);
+		Write4(0C0000040H); (* flags: data, read, write *)
+
+		WriteName(".rsrc", 8); (* resource object *)
+		Write4(0); (* object size (always 0) *)
+		rsrcPos := Ro.Pos();
+		Write4(0); (* object rva *)
+		Write4(0); (* physical size *)
+		Write4(0); (* physical offset *)
+		Write4(0); Write4(0); Write4(0);
+		Write4(0C0000040H); (* flags: data, read, write *)
+
+		WriteName(".idata", 8); (* import object *)
+		Write4(0); (* object size (always 0) *)
+		impPos := Ro.Pos();
+		Write4(0); (* object rva *)
+		Write4(0); (* physical size *)
+		Write4(0); (* physical offset *)
+		Write4(0); Write4(0); Write4(0);
+		Write4(0C0000040H); (* flags: data, read, write *)
+
+		IF isDll THEN
+			WriteName(".edata", 8); (* export object *)
+			Write4(0); (* object size (always 0) *)
+			expPos := Ro.Pos();
+			Write4(0); (* object rva *)
+			Write4(0); (* physical size *)
+			Write4(0); (* physical offset *)
+			Write4(0); Write4(0); Write4(0);
+			Write4(0C0000040H); (* flags: data, read, write *)
+		END;
+
+		WriteName(".reloc", 8); (* relocation object *)
+		Write4(0); (* object size (always 0) *)
+		relPos := Ro.Pos();
+		Write4(0); (* object rva *)
+		Write4(0); (* physical size *)
+		Write4(0); (* physical offset *)
+		Write4(0); Write4(0); Write4(0);
+		Write4(42000040H); (* flags: data, read, ? *)
+	END WriteHeader;
+	
+	PROCEDURE SearchObj (mod: Module; VAR name: ARRAY OF SHORTCHAR; m, fp, opt: INTEGER; VAR adr: INTEGER);
+		VAR dir, len, ntab, f, id, l, r, p, n, i, j: INTEGER; nch, och: SHORTCHAR;
+	BEGIN
+		Get(mod, mod.ms + modExports, dir); DEC(dir, ConBase + mod.ma); Get(mod, dir, len); INC(dir, 4);
+		Get(mod, mod.ms + modNames, ntab); DEC(ntab, ConBase + mod.ma);
+		IF name # "" THEN
+			l := 0; r := len;
+			WHILE l < r DO	(* binary search *)
+				n := (l + r) DIV 2; p := dir + n * 16;
+				Get(mod, p + 8, id);
+				i := 0; j := ntab + id DIV 256; nch := name[0]; och := SHORT(CHR(mod.data[j]));
+				WHILE (nch = och) & (nch # 0X) DO INC(i); INC(j); nch := name[i]; och := SHORT(CHR(mod.data[j])) END;
+				IF och = nch THEN
+					IF id MOD 16 = m THEN Get(mod, p, f);
+						IF m = mTyp THEN
+							IF ODD(opt) THEN Get(mod, p + 4, f) END;
+							IF (opt > 1) & (id DIV 16 MOD 16 # mExported) THEN
+								WriteString(mod.name); WriteChar("."); WriteSString(name);
+								WriteString(" imported from "); WriteString(impg.name);
+								WriteString(" has wrong visibility"); WriteLn; error := TRUE
+							END;
+							Get(mod, p + 12, adr)
+						ELSIF m = mVar THEN
+							Get(mod, p + 4, adr); INC(adr, DataBase + mod.va)
+						ELSIF m = mProc THEN
+							Get(mod, p + 4, adr); INC(adr, CodeBase + mod.ca)
+						END;
+						IF f # fp THEN
+							WriteString(mod.name); WriteChar("."); WriteSString(name);
+							WriteString(" imported from "); WriteString(impg.name);
+							WriteString(" has wrong fprint"); WriteLn; error := TRUE
+						END
+					ELSE
+						WriteString(mod.name); WriteChar("."); WriteSString(name);
+						WriteString(" imported from "); WriteString(impg.name);
+						WriteString(" has wrong class"); WriteLn; error := TRUE
+					END;
+					RETURN
+				END;
+				IF och < nch THEN l := n + 1 ELSE r := n END
+			END;
+			WriteString(mod.name); WriteChar("."); WriteSString(name);
+			WriteString(" not found (imported from "); WriteString(impg.name);
+			WriteChar(")"); WriteLn; error := TRUE
+		ELSE (* anonymous type *)
+			WHILE len > 0 DO
+				Get(mod, dir + 4, f); Get(mod, dir + 8, id);
+				IF (f = fp) & (id MOD 16 = mTyp) & (id DIV 256 = 0) THEN
+					Get(mod, dir + 12, adr); RETURN
+				END;
+				DEC(len); INC(dir, 16)
+			END;
+			WriteString("anonymous type in "); WriteString(mod.name);
+			WriteString(" not found"); WriteLn; error := TRUE
+		END
+	END SearchObj;
+	
+	PROCEDURE CollectExports (mod: Module);
+		VAR dir, len, ntab, id, i, j, n: INTEGER; e, exp: Export;
+	BEGIN
+		Get(mod, mod.ms + modExports, dir); DEC(dir, ConBase + mod.ma); Get(mod, dir, len); INC(dir, 4);
+		Get(mod, mod.ms + modNames, ntab); DEC(ntab, ConBase + mod.ma); n := 0;
+		WHILE n < len DO
+			Get(mod, dir + 8, id);
+			IF (id DIV 16 MOD 16 # mInternal) & ((id MOD 16 = mProc) OR (id MOD 16 = mVar))THEN	(* exported procedure & var *)
+				NEW(exp);
+				i := 0; j := ntab + id DIV 256;
+				WHILE mod.data[j] # 0 DO exp.name[i] := SHORT(CHR(mod.data[j])); INC(i); INC(j) END;
+				exp.name[i] := 0X;
+				Get(mod, dir + 4, exp.adr);
+				IF id MOD 16 = mProc THEN INC(exp.adr, CodeRva + mod.ca)
+				ELSE ASSERT(id MOD 16 = mVar); INC(exp.adr, DataRva + mod.va)
+				END;
+				IF (firstExp = NIL) OR (exp.name < firstExp.name) THEN
+					exp.next := firstExp; firstExp := exp;
+					IF lastExp = NIL THEN lastExp := exp END
+				ELSE
+					e := firstExp;
+					WHILE (e.next # NIL) & (exp.name > e.next.name) DO e := e.next END;
+					exp.next := e.next; e.next := exp;
+					IF lastExp = e THEN lastExp := exp END
+				END;
+				INC(numExp);
+			END;
+			INC(n); INC(dir, 16)
+		END
+	END CollectExports;
+
+	PROCEDURE WriteTermCode (m: Module; i: INTEGER);
+		VAR x: INTEGER;
+	BEGIN
+		IF m # NIL THEN
+			IF m.dll THEN WriteTermCode(m.next, i)
+			ELSE
+				IF isStatic THEN WriteTermCode(m.next, i + 1) END;
+				Get(m, m.ms + modTerm, x);	(* terminator address in mod desc*)
+				IF x = 0 THEN
+					WriteCh(005X); Write4(0)	(* add EAX, 0 (nop) *)
+				ELSE
+					WriteCh(0E8X); Write4(x - lastTerm + 5 * i - CodeBase)	(* call term *)
+				END
+			END
+		END
+	END WriteTermCode;
+	
+	PROCEDURE WriteCode;
+		VAR mod, m: Module; i, x, a, fp, opt: INTEGER; exp: Export; name: Name;
+	BEGIN
+		IF isStatic THEN
+			WriteCh(053X);	(* push ebx *)
+			a := 1;
+			IF isDll THEN
+				WriteCh(083X); WriteCh(07CX); WriteCh(024X); WriteCh(00CX); WriteCh(001X);	(* cmp [12, esp], 1 *)
+				WriteCh(00FX); WriteCh(085X); Write4(10 + 5 * numMod);	(* jne L1 *)
+				INC(a, 11)
+			ELSE
+				WriteCh(053X); WriteCh(053X);	(* push ebx; push ebx *)
+				INC(a, 2)
+			END;
+			WriteCh(0BBX); Write4(ConBase + last.ma + last.ms); Reloc(CodeBase + a + 1);	(* mov bx, modlist *)
+			INC(a, 5); m := modList;
+			WHILE m # NIL DO
+				IF ~m.dll THEN
+					WriteCh(0E8X); INC(a, 5); Write4(m.ca - a)	(* call body *)
+				END;
+				m := m.next
+			END;
+			IF isDll THEN
+				WriteCh(0E9X); Write4(11 + 5 * numMod);	(* jp L2 *)
+				WriteCh(083X); WriteCh(07CX); WriteCh(024X); WriteCh(00CX); WriteCh(000X);	(* L1: cmp [12, esp], 0 *)
+				WriteCh(00FX); WriteCh(085X); Write4(5 * numMod);	(* jne L2 *)
+				INC(a, 16)
+			END;
+			termPos := Ro.Pos(); i := 0;
+			WHILE i < numMod DO	(* nop for call terminator *)
+				WriteCh(02DX); Write4(0);	(* sub EAX, 0 *)
+				INC(i); INC(a, 5)
+			END;
+			lastTerm := a;
+			WriteCh(05BX); 	(* L2: pop ebx *)
+			IF isDll THEN
+				WriteCh(0B8X); Write4(1);	(* mov eax,1 *)
+				WriteCh(0C2X); Write2(12)	(* ret 12 *)
+			ELSE
+				WriteCh(05BX); WriteCh(05BX);	(* pop ebx; pop ebx *)
+				WriteCh(0C3X)	(* ret *)
+			END
+		ELSIF isDll THEN
+			WriteCh(053X);	(* push ebx *)
+			WriteCh(083X); WriteCh(07CX); WriteCh(024X); WriteCh(00CX); WriteCh(001X);	(* cmp [12, esp], 1 *)
+			WriteCh(075X); WriteCh(SHORT(CHR(12)));	(* jne L1 *)
+			WriteCh(0BBX); Write4(ConBase + last.ma + last.ms); Reloc(CodeBase + 9);	(* mov bx, modlist *)
+			WriteCh(0E8X); Write4(main.ca - 18);	(* call main *)
+			WriteCh(0EBX); WriteCh(SHORT(CHR(12)));	(* jp L2 *)
+			WriteCh(083X); WriteCh(07CX); WriteCh(024X); WriteCh(00CX); WriteCh(000X);	(* L1: cmp [12, esp], 0 *)
+			WriteCh(075X); WriteCh(SHORT(CHR(5)));	(* jne L2 *)
+			termPos := Ro.Pos();
+			WriteCh(02DX); Write4(0);	(* sub EAX, 0 *)	(* nop for call terminator *)
+			lastTerm := 32;
+			WriteCh(05BX); 	(* L2: pop ebx *)
+			WriteCh(0B8X); Write4(1);	(* mov eax,1 *)
+			WriteCh(0C2X); Write2(12)	(* ret 12 *)
+		ELSE
+			WriteCh(0BBX); Write4(ConBase + last.ma + last.ms); Reloc(CodeBase + 1);	(* mov bx, modlist *)
+			WriteCh(0E9X); Write4(main.ca - 10);	(* jmp main *)
+		END;
+		NEW(code, maxCode);
+		mod := modList;
+		WHILE mod # NIL DO impg := mod; impd := mod;
+			IF ~mod.dll THEN
+				mod.file := ThisFile(mod.name);
+				R := mod.file.NewReader(R); R.SetPos(mod.hs);
+				NEW(mod.data, mod.ms + mod.ds);
+				R.ReadBytes(mod.data^, 0, mod.ms + mod.ds);
+				R.ReadBytes(code^, 0, mod.cs);
+				RNum(x);
+				IF x # 0 THEN
+					IF (mod # kernel) & (kernel # NIL) THEN
+						SearchObj(kernel, newRec, mProc, NewRecFP, -1, a); Fixup0(x, a)
+					ELSE
+						WriteSString("no kernel"); WriteLn;
+						FlushW; error := TRUE; RETURN
+					END
+				END;
+				RNum(x);
+				IF x # 0 THEN
+					IF (mod # kernel) & (kernel # NIL) THEN
+						SearchObj(kernel, newArr, mProc, NewArrFP, -1, a); Fixup0(x, a)
+					ELSE
+						WriteSString("no kernel"); WriteLn;
+						FlushW; error := TRUE; RETURN
+					END
+				END;
+				Fixup(ConBase + mod.ma);
+				Fixup(ConBase + mod.ma + mod.ms);
+				Fixup(CodeBase + mod.ca);
+				Fixup(DataBase + mod.va); i := 0;
+				WHILE i < mod.ni DO
+					m := mod.imp[i]; impd := m; RNum(x);
+					WHILE x # 0 DO
+						ReadName(name); RNum(fp); opt := 0;
+						IF x = mTyp THEN RNum(opt) END;
+						IF m.dll THEN
+							IF x = mProc THEN exp := m.exp;
+								WHILE exp.name # name DO exp := exp.next END;
+								a := exp.adr + CodeBase + CodeSize
+							END
+						ELSE
+							SearchObj(m, name, x, fp, opt, a)
+						END;
+						IF x # mConst THEN Fixup(a) END;
+						RNum(x)
+					END;
+					IF ~m.dll THEN
+						Get(mod, mod.ms + modImports, x); DEC(x, ConBase + mod.ma); INC(x, 4 * i);
+						Put(mod, x, ConBase + m.ma + m.ms);	(* imp ref *)
+						Reloc(ConBase + mod.ma + x);
+						Get(m, m.ms + modRefcnt, x); Put(m, m.ms + modRefcnt, x + 1)	(* inc ref count *)
+					END;
+					INC(i)
+				END;
+				Ro.WriteBytes(code^, 0, mod.cs);
+				IF mod.intf THEN CollectExports(mod) END;
+				mod.file.Close; mod.file := NIL
+			END;
+			mod := mod.next
+		END;
+		(* dll links *)
+		mod := modList; ImpHSize := ImpSize;
+		WHILE mod # NIL DO
+			IF mod.dll THEN
+				exp := mod.exp; 
+				WHILE exp # NIL DO
+					WriteCh(0FFX); WriteCh(25X); Write4(ImageBase + ImpRva + ImpSize);	(* JMP indirect *)
+					Reloc(CodeBase + CodeSize + exp.adr + 2);
+					INC(ImpSize, 4); INC(numImp); exp := exp.next
+				END;
+				INC(ImpSize, 4); INC(numImp) (* sentinel *)
+			END;
+			mod := mod.next
+		END
+	END WriteCode;
+	
+	PROCEDURE WriteConst;
+		VAR mod, last: Module; x: INTEGER;
+	BEGIN
+		mod := modList; last := NIL;
+		WHILE mod # NIL DO
+			IF ~mod.dll THEN
+				IF last # NIL THEN
+					Put(mod, mod.ms, ConBase + last.ma + last.ms);	(* mod list *)
+					Reloc(ConBase + mod.ma + mod.ms);
+				END;
+				Get(mod, mod.ms + modOpts, x);
+				IF isStatic THEN INC(x, 10000H) END;	(* set init bit (16) *)
+				IF isDll THEN INC(x, 1000000H) END;	(* set dll bit (24) *)
+				Put(mod, mod.ms + modOpts, x);
+				Ro.WriteBytes(mod.data^, 0, mod.ms + mod.ds);
+				last := mod
+			END;
+			mod := mod.next
+		END
+	END WriteConst;
+	
+	PROCEDURE WriteResDir (n, i: INTEGER);
+	BEGIN
+		Write4(0);	(* flags *)
+		Write4(timeStamp);
+		Write4(0);	(* version *)
+		Write2(n);	(* name entries *)
+		Write2(i);	(* id entries *)
+	END WriteResDir;
+	
+	PROCEDURE WriteResDirEntry (id, adr: INTEGER; dir: BOOLEAN);
+	BEGIN
+		IF id = 0 THEN id := resHSize + 80000000H END;	(* name Rva *)
+		Write4(id);
+		IF dir THEN Write4(adr + 80000000H) ELSE Write4(adr) END
+	END WriteResDirEntry;
+	
+	PROCEDURE WriteMenu (res: Resource);
+		VAR f, i: INTEGER;
+	BEGIN
+		WHILE res # NIL DO
+			IF res.next = NIL THEN f := 80H ELSE f := 0 END;
+			IF 29 IN res.opts THEN INC(f, 1) END;	(* = grayed *)
+			IF 13 IN res.opts THEN INC(f, 2) END;	(* - inctive *)
+			IF 3 IN res.opts THEN INC(f, 4) END;	(* # bitmap *)
+			IF 10 IN res.opts THEN INC(f, 8) END;	(* * checked *)
+			IF 1 IN res.opts THEN INC(f, 20H) END;	(* ! menubarbreak *)
+			IF 15 IN res.opts THEN INC(f, 40H) END;	(* / menubreak *)
+			IF 31 IN res.opts THEN INC(f, 100H) END;	(* ? ownerdraw *)
+			IF res.local # NIL THEN Write2(f + 10H) ELSE Write2(f); Write2(res.id) END;
+			i := 0; WHILE res.name[i] # 0X DO Write2(ORD(res.name[i])); INC(i) END;
+			Write2(0);
+			WriteMenu(res.local);
+			res := res.next
+		END
+	END WriteMenu;
+	
+	PROCEDURE WriteResource;
+		VAR r, s: Resource; i, t, a, x, n, nlen, nsize: INTEGER;
+	BEGIN
+		IF numId[0] > 0 THEN WriteResDir(1, numType - 1); nlen := LEN(rsrcName$); nsize := (nlen + 1) * 2;
+		ELSE WriteResDir(0, numType)
+		END;
+		a := 16 + 8 * numType; t := 0;
+		WHILE t < LEN(numId) DO
+			IF numId[t] > 0 THEN WriteResDirEntry(t, a, TRUE); INC(a, 16 + 8 * numId[t]) END;
+			INC(t)
+		END;
+		r := resList; t := -1;
+		WHILE r # NIL DO
+			IF t # r.typ THEN t := r.typ; WriteResDir(0, numId[t]) END;
+			WriteResDirEntry(r.id, a, TRUE); INC(a, 16); i := r.id;
+			WHILE (r # NIL) & (r.typ = t) & (r.id = i) DO INC(a, 8); r := r.next END
+		END;
+		r := resList;
+		WHILE r # NIL DO
+			n := 0; s := r;
+			WHILE (s # NIL) & (s.typ = r.typ) & (s.id = r.id) DO INC(n); s := s.next END;
+			WriteResDir(0, n);
+			WHILE r # s DO WriteResDirEntry(r.lid, a, FALSE); INC(a, 16); r := r.next END
+		END;
+		ASSERT(a = resHSize);
+		IF numId[0] > 0 THEN INC(a, nsize) END;	(* TYPELIB string *)
+		r := resList;
+		WHILE r # NIL DO
+			Write4(a + RsrcRva); INC(a, (r.size + 3) DIV 4 * 4);
+			Write4(r.size);
+			Write4(0); Write4(0);
+			r := r.next
+		END;
+		ASSERT(a = RsrcSize);
+		IF numId[0] > 0 THEN
+			Write2(nlen); i := 0;
+			WHILE rsrcName[i] # 0X DO Write2(ORD(rsrcName[i])); INC(i) END
+		END;
+		r := resList;
+		WHILE r # NIL DO
+			IF r.typ = 4 THEN	(* menu *)
+				Write2(0); Write2(0);
+				WriteMenu(r.local);
+				WHILE Ro.Pos() MOD 4 # 0 DO WriteCh(0X) END
+			ELSIF r.typ = 9 THEN	(* accelerator *)
+				s := r.local;
+				WHILE s # NIL DO
+					i := 0; a := 0;
+					IF 10 IN s.opts THEN INC(a, 4) END;	(* * shift *)
+					IF 16 IN s.opts THEN INC(a, 8) END;	(* ^ ctrl *)
+					IF 0 IN s.opts THEN INC(a, 16) END;	(* @ alt *)
+					IF 13 IN s.opts THEN INC(a, 2) END;	(* - noinv *)
+					IF s.next = NIL THEN INC(a, 80H) END;
+					IF (s.name[0] = "v") & (s.name[1] # 0X) THEN
+						s.name[0] := " "; Strings.StringToInt(s.name, x, n); INC(a, 1)
+					ELSE x := ORD(s.name[0])
+					END;
+					Write2(a); Write2(x); Write2(s.id); Write2(0); s := s.next
+				END
+			ELSE
+				r.file := ThisResFile(r.name);
+				IF r.file # NIL THEN
+					R := r.file.NewReader(R); R.SetPos(r.pos); i := 0;
+					IF r.typ = 12 THEN	(* cursor group *)
+						Read4(x); Write4(x); Read2(n); Write2(n);
+						WHILE i < n DO
+							Read4(x); Write2(x MOD 256); Write2(x DIV 256 MOD 256 * 2);
+							Write2(1); Write2(1); Read4(x);	(* ??? *)
+							Read4(x); Write4(x + 4); Read4(x); Write2(r.id * 10 + i); INC(i)
+						END;
+						IF ~ODD(n) THEN Write2(0) END
+					ELSIF r.typ = 14 THEN	(* icon group *)
+						Read4(x); Write4(x); Read2(n); Write2(n);
+						WHILE i < n DO
+							Read2(x); Write2(x); Read2(x);
+							IF (13 IN r.opts) & (x = 16) THEN x := 4 END;
+							Write2(x);
+							a := x MOD 256; Read4(x); Write2(1);
+							IF a <= 2 THEN Write2(1)
+							ELSIF a <= 4 THEN Write2(2)
+							ELSIF a <= 16 THEN Write2(4)
+							ELSE Write2(8)
+							END;
+							Read4(x);
+							IF (13 IN r.opts) & (x = 744) THEN x := 440 END;
+							IF (13 IN r.opts) & (x = 296) THEN x := 184 END;
+							Write4(x); Read4(x); Write2(r.id * 10 + i); INC(i)
+						END;
+						IF ~ODD(n) THEN Write2(0) END
+					ELSE
+						IF r.typ = 1 THEN Write2(r.x); Write2(r.y); i := 4 END;	(* cursor hot spot *)
+						WHILE i < r.size DO Read4(x); Write4(x); INC(i, 4) END
+					END;
+					r.file.Close; r.file := NIL
+				END
+			END;
+			r := r.next
+		END
+	END WriteResource;
+
+	PROCEDURE Insert(VAR name: ARRAY OF SHORTCHAR; VAR idx: INTEGER; hint: INTEGER);
+		VAR i: INTEGER;
+	BEGIN
+		IF hint >= 0 THEN
+			ntab[idx] := SHORT(CHR(hint)); INC(idx);
+			ntab[idx] := SHORT(CHR(hint DIV 256)); INC(idx);
+		END;
+		i := 0;
+		WHILE name[i] # 0X DO ntab[idx] := name[i]; INC(idx); INC(i) END;
+		IF (hint = -1) & ((ntab[idx-4] # ".") OR (CAP(ntab[idx-3]) # "D") OR (CAP(ntab[idx-2]) # "L") OR (CAP(ntab[idx-1]) # "L")) THEN
+			ntab[idx] := "."; INC(idx);
+			ntab[idx] := "d"; INC(idx);
+			ntab[idx] := "l"; INC(idx);
+			ntab[idx] := "l"; INC(idx);
+		END;
+		ntab[idx] := 0X; INC(idx);
+		IF ODD(idx) THEN ntab[idx] := 0X; INC(idx) END
+	END Insert;
+
+	PROCEDURE WriteImport;
+		VAR i, lt, at, nt, ai, ni: INTEGER; mod: Module; exp: Export; ss: ARRAY 256 OF SHORTCHAR;
+	BEGIN
+		IF numImp > 0 THEN NEW(atab, numImp) END;
+		IF numExp > numImp THEN i := numExp ELSE i := numImp END;
+		IF i > 0 THEN NEW(ntab, 40 * i) END;
+		at := ImpRva + ImpHSize; ai := 0; ni := 0;
+		lt := ImpRva + ImpSize; nt := lt + ImpSize - ImpHSize;
+		mod := modList;
+		WHILE mod # NIL DO
+			IF mod.dll THEN
+				Write4(lt); (* lookup table rva *)
+				Write4(0); (* time/data (always 0) *)
+				Write4(0); (* version (always 0) *)
+				Write4(nt + ni); (* name rva *)
+				ss := SHORT(mod.name$); Insert(ss, ni, -1);
+				Write4(at); (* addr table rva *)
+				exp := mod.exp;
+				WHILE exp # NIL DO
+					atab[ai] := nt + ni; (* hint/name rva *)
+					Insert(exp.name, ni, 0);
+					INC(lt, 4); INC(at, 4); INC(ai); exp := exp.next
+				END;
+				atab[ai] := 0; INC(lt, 4); INC(at, 4); INC(ai)
+			END;
+			mod := mod.next
+		END;
+		Write4(0); Write4(0); Write4(0); Write4(0); Write4(0);
+		i := 0;
+		WHILE i < ai DO Write4(atab[i]); INC(i) END; (* address table *)
+		i := 0;
+		WHILE i < ai DO Write4(atab[i]); INC(i) END; (* lookup table *)
+		i := 0;
+		WHILE i < ni DO WriteCh(ntab[i]); INC(i) END;
+		ASSERT(ai * 4 = ImpSize - ImpHSize);
+		INC(ImpSize, ai * 4 + ni);
+		ExpRva := ImpRva + (ImpSize + (ObjAlign - 1)) DIV ObjAlign * ObjAlign;
+		RelocRva := ExpRva;
+	END WriteImport;
+	
+	PROCEDURE WriteExport (VAR name: ARRAY OF CHAR);
+		VAR i, ni: INTEGER; e: Export; ss: ARRAY 256 OF SHORTCHAR;
+	BEGIN
+		Write4(0);	(* flags *)
+		Write4(timeStamp);	(* time stamp *)
+		Write4(0);	(* version *)
+		Write4(ExpRva + 40 + 10 * numExp);	(* name rva *)
+		Write4(1);	(* ordinal base *)
+		Write4(numExp);	(* # entries *)
+		Write4(numExp);	(* # name ptrs *)
+		Write4(ExpRva + 40);	(* address table rva *)
+		Write4(ExpRva + 40 + 4 * numExp);	(* name ptr table rva *)
+		Write4(ExpRva + 40 + 8 * numExp);	(* ordinal table rva *)
+		ExpSize := 40 + 10 * numExp;
+		(* adress table *)
+		e := firstExp;
+		WHILE e # NIL DO Write4(e.adr); e := e.next END;
+		(* name ptr table *)
+		ni := 0; e := firstExp;
+		ss := SHORT(name$); Insert(ss, ni, -2);
+		WHILE e # NIL DO
+			Write4(ExpRva + ExpSize + ni); Insert(e.name, ni, -2); e := e.next
+		END;
+		(* ordinal table *)
+		i := 0;
+		WHILE i < numExp DO Write2(i); INC(i) END;
+		(* name table *)
+		i := 0;
+		WHILE i < ni DO WriteCh(ntab[i]); INC(i) END;
+		ExpSize := (ExpSize + ni + 15) DIV 16 * 16;
+		RelocRva := ExpRva + (ExpSize + (ObjAlign - 1)) DIV ObjAlign * ObjAlign;
+	END WriteExport;
+
+	PROCEDURE Sort (l, r: INTEGER);
+		VAR i, j, x, t: INTEGER;
+	BEGIN
+		i := l; j := r; x := fixups[(l + r) DIV 2];
+		REPEAT
+			WHILE fixups[i] < x DO INC(i) END;
+			WHILE fixups[j] > x DO DEC(j) END;
+			IF i <= j THEN t := fixups[i]; fixups[i] := fixups[j]; fixups[j] := t; INC(i); DEC(j) END
+		UNTIL i > j;
+		IF l < j THEN Sort(l, j) END;
+		IF i < r THEN Sort(i, r) END
+	END Sort;
+
+	PROCEDURE WriteReloc;
+		VAR i, j, h, a, p: INTEGER;
+	BEGIN
+		Sort(0, noffixup - 1); i := 0;
+		WHILE i < noffixup DO
+			p := fixups[i] DIV 4096 * 4096; j := i; a := p + 4096;
+			WHILE (j < noffixup) & (fixups[j] < a) DO INC(j) END;
+			Write4(p - ImageBase); (* page rva *)
+			h := 8 + 2 * (j - i);
+			Write4(h + h MOD 4); (* block size *)
+			INC(RelocSize, h);
+			WHILE i < j DO Write2(fixups[i] - p + 3 * 4096); INC(i) END; (* long fix *)
+			IF h MOD 4 # 0 THEN Write2(0); INC(RelocSize, 2) END
+		END;
+		Write4(0); Write4(0); INC(RelocSize, 8);
+		ImagesSize := RelocRva + (RelocSize + (ObjAlign - 1)) DIV ObjAlign * ObjAlign;
+	END WriteReloc;
+	
+	PROCEDURE Align(VAR pos: INTEGER);
+	BEGIN
+		WHILE Ro.Pos() MOD FileAlign # 0 DO WriteCh(0X) END;
+		pos := Ro.Pos()
+	END Align;
+	
+	PROCEDURE WriteOut (VAR name: Files.Name);
+		VAR res, codepos, conpos, rsrcpos, imppos, exppos, relpos, relend, end: INTEGER;
+	BEGIN
+		IF ~error THEN Align(codepos); WriteCode END;
+		IF ~error THEN Align(conpos); WriteConst END;
+		IF ~error THEN Align(rsrcpos); WriteResource END;
+		IF ~error THEN Align(imppos); WriteImport END;
+		IF ~error & isDll THEN Align(exppos); WriteExport(name) END;
+		IF ~error THEN Align(relpos); WriteReloc END;
+		relend := Ro.Pos() - 8; Align(end);
+		
+		IF ~error THEN
+			Ro.SetPos(entryPos); Write4(CodeRva);
+			Ro.SetPos(isPos); Write4(ImagesSize);
+			IF isDll THEN
+				Ro.SetPos(hexpPos); Write4(ExpRva); Write4(ExpSize);
+			END;
+			Ro.SetPos(himpPos); Write4(ImpRva); Write4(ImpHSize);
+			Ro.SetPos(hrsrcPos); Write4(RsrcRva); Write4(RsrcSize);
+			Ro.SetPos(fixPos); Write4(RelocRva); Write4(relend - relpos);
+	
+			Ro.SetPos(codePos); Write4(CodeRva); Write4(conpos - HeaderSize); Write4(HeaderSize);
+			Ro.SetPos(dataPos); Write4(DataRva); Write4((DataSize + (FileAlign-1)) DIV FileAlign * FileAlign);
+			Ro.SetPos(conPos); Write4(ConRva); Write4(rsrcpos - conpos); Write4(conpos);
+			Ro.SetPos(rsrcPos); Write4(RsrcRva); Write4(imppos - rsrcpos); Write4(rsrcpos);
+			IF isDll THEN
+				Ro.SetPos(impPos); Write4(ImpRva); Write4(exppos - imppos); Write4(imppos);
+				Ro.SetPos(expPos); Write4(ExpRva); Write4(relpos - exppos); Write4(exppos)
+			ELSE
+				Ro.SetPos(impPos); Write4(ImpRva); Write4(relpos - imppos); Write4(imppos);
+			END;
+			Ro.SetPos(relPos); Write4(RelocRva); Write4(end - relpos); Write4(relpos);
+			IF isStatic THEN
+				Ro.SetPos(termPos); WriteTermCode(modList, 0)
+			ELSIF isDll THEN
+				Ro.SetPos(termPos); WriteTermCode(main, 0)
+			END
+		END;
+		
+		IF ~error THEN
+			Out.Register(name, "exe", Files.ask, res);
+			IF res # 0 THEN error := TRUE END
+		END
+	END WriteOut;
+
+	(* A. V. Shiryaev: Scanner *)
+
+		PROCEDURE (VAR S: Scanner) SetPos (x: INTEGER), NEW;
+		BEGIN
+			S.rider.i := x
+		END SetPos;
+
+		PROCEDURE (VAR S: Scanner) ConnectTo (IN src: ARRAY OF CHAR), NEW;
+		BEGIN
+			NEW(S.rider.s, LEN(src$) + 1);
+			S.rider.s^ := src$;
+			S.rider.i := 0;
+			S.start := 0;
+			S.type := TMEOT
+		END ConnectTo;
+
+		PROCEDURE (VAR R: ScanRider) ReadPrevChar (VAR ch: CHAR), NEW;
+		BEGIN
+			ch := R.s[R.i]
+		END ReadPrevChar;
+
+		PROCEDURE (VAR R: ScanRider) ReadChar (VAR ch: CHAR), NEW;
+		BEGIN
+			ch := R.s[R.i];
+			INC(R.i)
+		END ReadChar;
+
+		PROCEDURE (VAR R: ScanRider) Pos (): INTEGER, NEW;
+		BEGIN
+			RETURN R.i
+		END Pos;
+
+		PROCEDURE (VAR S: Scanner) Scan, NEW;
+			VAR j, res: INTEGER;
+		
+			PROCEDURE IsLetter (c: CHAR): BOOLEAN;
+			BEGIN
+				RETURN ((c >= 'A') & (c <= 'Z')) OR ((c >= 'a') & (c <= 'z')) OR (c = '_')
+			END IsLetter;
+
+			PROCEDURE IsDigit (c: CHAR): BOOLEAN;
+			BEGIN
+				RETURN (c >= '0') & (c <= '9')
+			END IsDigit;
+
+		BEGIN
+			WHILE (S.rider.i < LEN(S.rider.s$)) & (S.rider.s[S.rider.i] = ' ') DO
+				INC(S.rider.i)
+			END;
+			IF S.rider.i < LEN(S.rider.s$) THEN
+				S.start := S.rider.i;
+				IF IsDigit(S.rider.s[S.rider.i]) THEN
+					j := 0;
+					WHILE (S.rider.i < LEN(S.rider.s$)) & IsDigit(S.rider.s[S.rider.i]) DO
+						S.string[j] := S.rider.s[S.rider.i];
+						INC(j);
+						INC(S.rider.i)
+					END;
+					S.string[j] := 0X;
+					Strings.StringToInt(S.string, S.int, res);
+					IF res # 0 THEN S.type := TMEOT
+					ELSE S.type := TMInt
+					END
+				ELSIF IsLetter(S.rider.s[S.rider.i]) THEN
+					S.type := TMString;
+					j := 0;
+					WHILE (S.rider.i < LEN(S.rider.s$)) & (IsLetter(S.rider.s[S.rider.i]) OR IsDigit(S.rider.s[S.rider.i])) DO
+						S.string[j] := S.rider.s[S.rider.i];
+						INC(j);
+						INC(S.rider.i)
+					END;
+					S.string[j] := 0X
+				ELSE
+					S.type := TMChar;
+					S.char := S.rider.s[S.rider.i];
+					INC(S.rider.i)
+				END
+			ELSE
+				S.type := TMEOT
+			END
+		END Scan;
+
+	PROCEDURE ScanRes (VAR S: Scanner; end: INTEGER; VAR list: Resource);
+		VAR res, tail: Resource; n: INTEGER;
+	BEGIN
+		tail := NIL;
+		WHILE (S.start < end) & (S.type = TMInt) DO
+			NEW(res); res.id := S.int; S.Scan;
+			IF (S.type = TMChar) & (S.char = "[") THEN
+				S.Scan;
+				IF S.type = TMInt THEN res.lid := S.int; S.Scan END;
+				IF (S.type = TMChar) & (S.char = "]") THEN S.Scan
+				ELSE WriteSString("missing ']'"); error := TRUE
+				END
+			END;
+			WHILE S.type = TMChar DO
+				IF S.char = "@" THEN n := 0
+				ELSIF S.char = "^" THEN n := 16
+				ELSIF S.char = "~" THEN n := 17
+				ELSIF S.char <= "?" THEN n := ORD(S.char) - ORD(" ")
+				END;
+				INCL(res.opts, n); S.Scan
+			END;
+			IF S.type = TMString THEN
+				res.name := S.string$; S.Scan;
+				IF (S.type = TMChar) & (S.char = ".") THEN S.Scan;
+					IF S.type = TMString THEN
+						IF (S.string = "tlb") OR (S.string = "TLB") THEN res.typ := -1 END;
+						Kernel.MakeFileName(res.name, S.string); S.Scan
+					END
+				END;
+				IF (S.type = TMChar) & (S.char = "(") THEN S.Scan;
+					ScanRes(S, end, res.local);
+					IF (S.type = TMChar) & (S.char = ")") THEN S.Scan
+					ELSE WriteSString("missing ')'"); error := TRUE
+					END
+				END;
+				IF tail = NIL THEN list := res ELSE tail.next := res END;
+				tail := res
+			ELSE
+				WriteSString("wrong resource name"); error := TRUE
+			END
+		END;
+	END ScanRes;
+
+	PROCEDURE LinkIt (IN txt: ARRAY OF CHAR);
+		VAR S: Scanner; name: Files.Name; mod: Module; end: INTEGER;
+	BEGIN
+		comLine := FALSE;
+		modList := NIL; kernel := NIL; main := NIL;
+		last := NIL; impg := NIL; impd := NIL; resList := NIL;
+		firstExp := NIL; lastExp := NIL;
+		NEW(fixups, FixLen);
+
+(*
+		Dialog.ShowStatus("linking");
+*)
+		Console.WriteStr("linking"); Console.WriteLn;
+
+(*
+		timeStamp := TimeStamp();
+*)
+		timeStamp := 0;
+
+		error := FALSE; modList := NIL; resList := NIL;
+
+(*
+		IF DevCommanders.par = NIL THEN RETURN END;
+		S.ConnectTo(DevCommanders.par.text);
+		S.SetPos(DevCommanders.par.beg);
+		end := DevCommanders.par.end;
+		DevCommanders.par := NIL;
+		W.ConnectTo(Log.buf);
+*)
+
+		S.ConnectTo(txt);
+		S.SetPos(0);
+		end := LEN(txt$);
+		
+		S.Scan;
+		IF S.type = TMString THEN
+			IF S.string = "dos" THEN comLine := TRUE; S.Scan END;
+			name := S.string$; S.Scan;
+			IF (S.type = TMChar) & (S.char = ".") THEN S.Scan;
+				IF S.type = TMString THEN
+					Kernel.MakeFileName(name, S.string); S.Scan
+				END
+			ELSE Kernel.MakeFileName(name, "EXE");
+			END;
+			IF (S.type = TMChar) & (S.char = ":") THEN S.Scan;
+				IF (S.type = TMChar) & (S.char = "=") THEN S.Scan;
+					WHILE (S.start < end) & (S.type = TMString) DO
+						NEW(mod); mod.name := S.string$;
+						mod.next := modList; modList := mod;
+						S.Scan;
+						WHILE (S.start < end) & (S.type = TMChar) &
+							((S.char = "*") OR (S.char = "+") OR (S.char = "$") OR (S.char = "#")) DO
+							IF S.char = "*" THEN mod.dll := TRUE
+							ELSIF S.char = "+" THEN kernel := mod
+							ELSIF S.char = "$" THEN main := mod
+							ELSE mod.intf := TRUE;
+								IF ~isDll THEN
+									WriteSString("Exports from Exe not possible. Use LinkDll or LinkDynDll.");
+									WriteLn; FlushW; error := TRUE
+								END
+							END;
+							S.Scan
+						END
+					END;
+					ScanRes(S, end, resList);
+					ReadHeaders;
+					PrepResources;
+					IF ~error THEN WriteHeader(name) END;
+					IF ~error THEN WriteOut(name) END;
+					IF ~error THEN	
+						WriteString(name); WriteString(" written  ");
+						WriteInt(Out.Length()); WriteString("  "); WriteInt(CodeSize)
+					END
+				ELSE WriteString(" := missing")
+				END
+			ELSE WriteString(" := missing")
+			END;
+			WriteLn; FlushW
+		END;
+(*
+		IF error THEN Dialog.ShowStatus("failed") ELSE Dialog.ShowStatus("ok") END;
+		W.ConnectTo(NIL); S.ConnectTo(NIL);
+*)
+		IF error THEN Console.WriteStr("failed") ELSE Console.WriteStr("ok") END; Console.WriteLn;
+		S.ConnectTo("");
+
+		modList := NIL; kernel := NIL; main := NIL; firstExp := NIL; lastExp := NIL;
+		last := NIL; impg := NIL; impd := NIL; resList := NIL; code := NIL; atab := NIL; ntab := NIL;
+		fixups := NIL
+	END LinkIt;
+	
+	PROCEDURE Link* (IN txt: ARRAY OF CHAR);
+	BEGIN
+		isDll := FALSE; isStatic := FALSE;
+		LinkIt(txt)
+	END Link;
+	
+	PROCEDURE LinkExe* (IN txt: ARRAY OF CHAR);
+	BEGIN
+		isDll := FALSE; isStatic := TRUE;
+		LinkIt(txt)
+	END LinkExe;
+	
+	PROCEDURE LinkDll* (IN txt: ARRAY OF CHAR);
+	BEGIN
+		isDll := TRUE; isStatic := TRUE;
+		LinkIt(txt)
+	END LinkDll;
+	
+	PROCEDURE LinkDynDll* (IN txt: ARRAY OF CHAR);
+	BEGIN
+		isDll := TRUE; isStatic := FALSE;
+		LinkIt(txt)
+	END LinkDynDll;
+	
+(*
+	PROCEDURE Show*;
+		VAR S: TextMappers.Scanner; name: Name; mod: Module; t: TextModels.Model;
+	BEGIN
+		t := TextViews.FocusText(); IF t = NIL THEN RETURN END;
+		W.ConnectTo(Log.buf); S.ConnectTo(t); S.Scan;
+		IF S.type = TextMappers.string THEN
+			mod := modList;
+			WHILE (mod # NIL) & (mod.name # S.string) DO mod := mod.next END;
+			IF mod # NIL THEN
+				W.WriteString(S.string);
+				W.WriteString(" ca = ");
+				W.WriteIntForm(CodeBase + mod.ca, TextMappers.hexadecimal, 8, "0", TRUE);
+				W.WriteLn; Log.text.Append(Log.buf)
+			END
+		END;
+		W.ConnectTo(NIL); S.ConnectTo(NIL)
+	END Show;
+*)
+		
+BEGIN
+	newRec := "NewRec"; newArr := "NewArr"
+END Dev0Linker.
+
+
+(!)DevLinker.Link Usekrnl.exe := TestKernel$+ Usekrnl ~	(!)"DevDecExe.Decode('', 'Usekrnl.exe')"
+
+(!)DevLinker.LinkDynDll MYDLL.dll := TestKernel+ MYDLL$# ~	(!)"DevDecExe.Decode('', 'MYDLL.dll')"
+
+(!)DevLinker.LinkExe Usekrnl.exe := TestKernel+ Usekrnl ~	(!)"DevDecExe.Decode('', 'Usekrnl.exe')"
+
+(!)DevLinker.LinkDll MYDLL.dll := TestKernel+ MYDLL# ~	(!)"DevDecExe.Decode('', 'MYDLL.dll')"
+
+
+MODULE TestKernel;
+	IMPORT KERNEL32;
+
+	PROCEDURE Beep*;
+	BEGIN
+		KERNEL32.Beep(500, 200)
+	END Beep;
+	
+BEGIN
+CLOSE
+	KERNEL32.ExitProcess(0)
+END TestKernel.
+
+MODULE Usekrnl;
+(* empty windows application using BlackBox Kernel *)
+(* Ominc (!) *)
+
+	IMPORT KERNEL32, USER32, GDI32, S := SYSTEM, Kernel := TestKernel;
+	
+	VAR Instance, MainWnd: USER32.Handle;
+		
+	PROCEDURE WndHandler (wnd, message, wParam, lParam: INTEGER): INTEGER;
+		VAR res: INTEGER; ps: USER32.PaintStruct; dc: GDI32.Handle;
+	BEGIN
+		IF message = USER32.WMDestroy THEN
+			USER32.PostQuitMessage(0)
+		ELSIF message = USER32.WMPaint THEN
+			dc := USER32.BeginPaint(wnd, ps);
+			res := GDI32.TextOutA(dc, 50, 50, "Hello World", 11);
+			res := USER32.EndPaint(wnd, ps)
+		ELSIF message = USER32.WMChar THEN
+			Kernel.Beep
+		ELSE
+			RETURN USER32.DefWindowProcA(wnd, message, wParam, lParam)
+		END;
+		RETURN 0
+	END WndHandler;
+	
+	PROCEDURE OpenWindow;
+		VAR class: USER32.WndClass; res: INTEGER;
+	BEGIN
+		class.cursor := USER32.LoadCursorA(0, USER32.MakeIntRsrc(USER32.IDCArrow));
+		class.icon := USER32.LoadIconA(Instance, USER32.MakeIntRsrc(1));
+		class.menuName := NIL;
+		class.className := "Simple";
+		class.backgnd := GDI32.GetStockObject(GDI32.WhiteBrush);
+		class.style := {0, 1, 5, 7};
+		class.instance := Instance;
+		class.wndProc := WndHandler;
+		class.clsExtra := 0;
+		class.wndExtra := 0;
+		USER32.RegisterClassA(class);
+		MainWnd := USER32.CreateWindowExA({}, "Simple", "Empty Windows Application",
+														{16..19, 22, 23, 25},
+														USER32.CWUseDefault, USER32.CWUseDefault,
+														USER32.CWUseDefault, USER32.CWUseDefault,
+														0, 0, Instance, 0);
+		res := USER32.ShowWindow(MainWnd, 10);
+		res := USER32.UpdateWindow(MainWnd);
+	END OpenWindow;
+	
+	PROCEDURE MainLoop;
+		VAR msg: USER32.Message; res: INTEGER;
+	BEGIN
+		WHILE USER32.GetMessageA(msg, 0, 0, 0) # 0 DO
+			res := USER32.TranslateMessage(msg);
+			res := USER32.DispatchMessageA(msg);
+		END;
+(*
+		KERNEL32.ExitProcess(msg.wParam)
+*)
+	END MainLoop;
+	
+BEGIN
+	Instance := KERNEL32.GetModuleHandleA(NIL);
+	OpenWindow;
+	MainLoop
+CLOSE
+	Kernel.Beep
+END Usekrnl.
+
+
+MODULE MYDLL;
+(* sample module to be linked into a dll *)
+(* Ominc (!) *)
+
+	IMPORT SYSTEM, KERNEL32;
+	
+	VAR expVar*: INTEGER;
+	
+	PROCEDURE GCD* (a, b: INTEGER): INTEGER;
+	BEGIN
+		WHILE a # b DO
+			IF a < b THEN b := b - a ELSE a := a - b END
+		END;
+		expVar := a;
+		RETURN a
+	END GCD;
+
+	PROCEDURE Beep*;
+	BEGIN
+		KERNEL32.Beep(500, 200)
+	END Beep;
+	
+CLOSE
+	Beep
+END MYDLL.
+
+
+
+Resource = Id [ "[" Language "]" ] Options name [ "." ext ] [ "(" { Resource } ")" ]
+Id = number
+Language = number
+Options = { "@" | "!" .. "?" | "^" | "~" }
+
+names
+
+MENU
+	1 MENU (0 File (11 New 12 Open 13 Save 0 "" 14 Exit) 0 Edit (21 Cut 22 Copy 23 Paste))
+		= grayed
+		- inctive
+		# bitmap
+		* checked
+		! menuBarBreak
+		/ menuBreak
+		? ownerDraw
+
+ACCELERATOR
+	1 ACCELERATOR (11 ^N 12 ^O 13 ^S 21 ^X 22 ^C 23 ^V)
+		* shift
+		^ ctrl
+		@ alt
+		- noInvert
+
+filename.ico
+
+filename.cur
+
+filname.bmp
+
+filename.res
+
+filename.tlb

+ 2 - 2
BlackBox/Linux/Lin/Rsrc/loader/Makefile

@@ -14,8 +14,8 @@ CFLAGS += -Wall -O0 -g -m32
 BlackBox: BlackBox-dl.c
 	${CC} ${CFLAGS} -o $@ $^ -ldl
 
-dev0: BlackBox1.c
-	${CC} ${CFLAGS} -o $@ $^ -L . -lBB0
+dev0: dev0.c
+	${CC} ${CFLAGS} -o $@ $^
 
 clean:
 	rm -f dev0 BlackBox

+ 1 - 0
BlackBox/Linux/Lin/Rsrc/loader/dev0.c

@@ -0,0 +1 @@
+../../../../OpenBSD/Lin/Rsrc/loader/dev0.c

BIN
BlackBox/Linux/libBB0.so


+ 5 - 2
BlackBox/OpenBSD/Lin/Rsrc/loader/Makefile

@@ -20,8 +20,11 @@ all: libdlobsdwrap.so dev0 BlackBox
 BlackBox: BlackBox-dl.c
 	${CC} ${CFLAGS} -o ${.TARGET} ${.ALLSRC} -pthread
 
-dev0: BlackBox1.c
-	${CC} ${CFLAGS} -o ${.TARGET} ${.ALLSRC} -L . -lBB0
+#dev0: BlackBox1.c
+#	${CC} ${CFLAGS} -o ${.TARGET} ${.ALLSRC} -L . -lBB0
+
+dev0: dev0.c
+	${CC} ${CFLAGS} -o ${.TARGET} ${.ALLSRC}
 
 libdlobsdwrap.so: libdlobsdwrap.c
 	${CC} ${CFLAGS} -o ${.TARGET} ${.ALLSRC} -fPIC -shared

+ 18 - 0
BlackBox/OpenBSD/Lin/Rsrc/loader/dev0.c

@@ -0,0 +1,18 @@
+#include <dlfcn.h>
+#include <stdio.h>
+
+int main (int argc, char *argv[])
+{
+	void * h;
+	int res;
+
+	h = dlopen("libBB0.so", RTLD_LAZY | RTLD_GLOBAL);
+	if (h != NULL) {
+		res = 0;
+	} else {
+		perror(dlerror());
+		res = 1;
+	}
+
+	return res;
+}

BIN
BlackBox/OpenBSD/libBB0.so


BIN
BlackBox/Windows/Host/Mod/Console.odc


+ 157 - 0
BlackBox/Windows/Host/Mod/Console.txt

@@ -0,0 +1,157 @@
+MODULE HostConsole;
+
+	(* THISIS TEXT COPY OF Console.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT
+		SYSTEM,
+		Console,
+		WinApi;
+
+	TYPE
+		Cons = POINTER TO RECORD (Console.Console) END;
+
+		Process = POINTER TO RECORD (Console.Process) END;
+
+	CONST
+		inBufLen = 128; (* > 0 *)
+
+	VAR
+		cons: Cons;
+		out, in: WinApi.HANDLE;
+
+		ss: ARRAY 1024 OF SHORTCHAR;
+
+		inBuf: ARRAY [untagged] inBufLen OF SHORTCHAR;
+			inBufW, inBufR: INTEGER; (* 0 <= inBufR <= inBufW <= inBufLen *)
+
+		version-: INTEGER;
+		maintainer-: ARRAY 40 OF CHAR;
+
+	PROCEDURE (cons: Cons) ReadLn (OUT text: ARRAY OF CHAR);
+		VAR
+			W: INTEGER;
+			res: WinApi.BOOL;
+			i: INTEGER;
+			done: BOOLEAN;
+			res1: INTEGER;
+	BEGIN
+		(* ReadLine -> ss, W *)
+		W := 0;
+		done := FALSE;
+		REPEAT
+			i := inBufR;
+			WHILE (i < inBufW) & (inBuf[i] # 0AX) & (W < LEN(ss)) DO
+				ss[W] := inBuf[i];
+				INC(W);
+				INC(i)
+			END;
+			IF i = inBufW THEN
+				inBufW := 0; inBufR := 0;
+				res := WinApi.ReadFile(in, SYSTEM.ADR(inBuf[0]), inBufLen, i, NIL);
+				IF res # 0 THEN (* TRUE *)
+					inBufW := i
+				ELSE
+					(* W := 0; *) done := TRUE
+				END
+			ELSIF inBuf[i] = 0AX THEN
+				ss[W] := 0AX; INC(W); done := TRUE;
+				inBufR := i + 1
+			ELSE (* ss is too small *)
+				W := 0; done := TRUE
+			END
+		UNTIL done;
+
+		IF W > 0 THEN
+			res1 := WinApi.MultiByteToWideChar(WinApi.CP_OEMCP, {}, ss, W, text, LEN(text) - 1);
+			IF (res1 > 0) & (res1 < LEN(text)) THEN
+				text[res1] := 0X
+			ELSE
+				text[0] := 0X
+			END
+		ELSE
+			text[0] := 0X
+		END
+	END ReadLn;
+
+	PROCEDURE Print (IN s: ARRAY OF CHAR; len: INTEGER);
+		VAR res, written: INTEGER;
+	BEGIN
+		IF len > 0 THEN
+			res := WinApi.WideCharToMultiByte(WinApi.CP_OEMCP, {}, s, len, ss, LEN(ss), NIL, NIL);
+			IF (res > 0) & (res <= LEN(ss)) THEN
+				res := WinApi.WriteFile(out, SYSTEM.ADR(ss[0]), res, written, NIL)
+			END
+		END
+	END Print;
+
+	PROCEDURE (cons: Cons) WriteChar (c: CHAR);
+		VAR ss: ARRAY 1 OF CHAR;
+	BEGIN
+		ss[0] := c;
+		Print(ss, 1)
+	END WriteChar;
+
+	PROCEDURE (cons: Cons) WriteStr (IN text: ARRAY OF CHAR);
+	BEGIN
+		Print(text, LEN(text$))
+	END WriteStr;
+
+	PROCEDURE (cons: Cons) WriteLn;
+	BEGIN
+		Print(0DX + 0AX, 2)
+	END WriteLn;
+
+	PROCEDURE (cons: Cons) Open;
+		VAR res: WinApi.BOOL;
+	BEGIN
+		res := WinApi.AllocConsole()
+	END Open;
+
+	PROCEDURE (cons: Cons) Close;
+		VAR res: WinApi.BOOL;
+	BEGIN
+		res := WinApi.FreeConsole()
+	END Close;
+
+	PROCEDURE (cons: Cons) CreateProcess (cmdLine: ARRAY OF CHAR): Console.Process;
+	BEGIN
+		(*	needs coding	*)
+		RETURN NIL
+	END CreateProcess;
+
+	PROCEDURE (cons: Cons) CommandLine (OUT cmdLine: ARRAY OF CHAR);
+	BEGIN
+
+	END CommandLine;
+
+	PROCEDURE (p: Process) Terminate;
+	BEGIN
+		(*	needs coding	*)
+	END Terminate;
+
+	PROCEDURE Maintainer;
+	BEGIN
+		version := 303;
+		maintainer := "A.V.Shiryaev"
+	END Maintainer;
+
+	PROCEDURE Init;
+		VAR res: WinApi.BOOL;
+	BEGIN
+		Maintainer;
+		NEW(cons);
+
+		res := WinApi.AllocConsole(); (* Open console on module load time *)
+
+		out := WinApi.GetStdHandle(WinApi.STD_OUTPUT_HANDLE);
+		in := WinApi.GetStdHandle(WinApi.STD_INPUT_HANDLE);
+
+		inBufW := 0; inBufR := 0;
+
+		Console.SetConsole(cons)
+	END Init;
+
+BEGIN
+	Init
+END HostConsole.

BIN
BlackBox/Windows/Host/Mod/Dates.odc


+ 86 - 0
BlackBox/Windows/Host/Mod/Dates.txt

@@ -0,0 +1,86 @@
+MODULE HostDates;
+
+	(* THIS IS TEXT COPY OF Dates.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT Dates, Strings, WinApi, HostRegistry;
+
+	TYPE
+		DatesHook = POINTER TO RECORD (Dates.Hook) END;
+
+	PROCEDURE (hook: DatesHook) GetTime (OUT d: Dates.Date; OUT t: Dates.Time);
+		VAR dt: WinApi.SYSTEMTIME;
+	BEGIN
+		WinApi.GetLocalTime(dt);
+		d.year := dt.wYear; d.month := dt.wMonth; d.day := dt.wDay;
+		t.hour := dt.wHour; t.minute := dt.wMinute; t.second := dt.wSecond
+	END GetTime;
+
+	PROCEDURE (hook: DatesHook) GetUTCTime (OUT d: Dates.Date; OUT t: Dates.Time);
+		VAR dt: WinApi.SYSTEMTIME;
+	BEGIN
+		WinApi.GetSystemTime(dt);
+		d.year := dt.wYear; d.month := dt.wMonth; d.day := dt.wDay;
+		t.hour := dt.wHour; t.minute := dt.wMinute; t.second := dt.wSecond
+	END GetUTCTime;
+
+	PROCEDURE (hook: DatesHook) GetUTCBias (OUT bias: INTEGER);
+		VAR res: INTEGER; info: WinApi.TIME_ZONE_INFORMATION;
+	BEGIN
+		bias := 0;
+		res := WinApi.GetTimeZoneInformation(info);
+		IF res # -1 THEN
+			IF BITS(res) = WinApi.TIME_ZONE_ID_DAYLIGHT THEN bias := info.Bias + info.DaylightBias
+			ELSE bias := info.Bias + info.StandardBias
+			END
+		END
+	END GetUTCBias;
+
+	PROCEDURE (hook: DatesHook) DateToString (d: Dates.Date; format: INTEGER; OUT str: ARRAY OF CHAR);
+		VAR res, pos, i: INTEGER; time: WinApi.SYSTEMTIME; fmt: ARRAY 64 OF CHAR;
+	BEGIN
+		time.wYear := SHORT(d.year); time.wMonth := SHORT(d.month); time.wDay := SHORT(d.day);
+		IF format = Dates.short THEN
+			res := WinApi.GetDateFormatW(
+				HostRegistry.localeId, WinApi.DATE_SHORTDATE, time, NIL, str, LEN(str))
+		ELSIF format = Dates.long THEN
+			res := WinApi.GetDateFormatW(HostRegistry.localeId, WinApi.DATE_LONGDATE, time, NIL, str, LEN(str))
+		ELSE
+			res := WinApi.GetLocaleInfoW(HostRegistry.localeId, WinApi.LOCALE_SLONGDATE, fmt, LEN(fmt));
+			IF format # Dates.abbreviated THEN	(* remove weekday *)
+				Strings.Find(fmt, "dddd", 0, pos); i := pos + 4;
+				IF pos < 0 THEN Strings.Find(fmt, "ddd", 0, pos); i := pos + 3 END;
+				IF pos >= 0 THEN
+					WHILE (fmt[i] # 0X) & (CAP(fmt[i]) < "A") OR (CAP(fmt[i]) > "Z") DO INC(i) END;
+					Strings.Replace(fmt, pos, i - pos, "")
+				END
+			END;
+			IF format # Dates.plainLong THEN	(* abbreviated *)
+				Strings.Find(fmt, "dddd", 0, pos);
+				IF pos >= 0 THEN Strings.Replace(fmt, pos, 4, "ddd") END;
+				Strings.Find(fmt, "MMMM", 0, pos);
+				IF pos >= 0 THEN Strings.Replace(fmt, pos, 4, "MMM") END
+			END;
+			res := WinApi.GetDateFormatW(HostRegistry.localeId, {}, time, fmt, str, LEN(str))
+		END;
+		IF res = 0 THEN str := "?" END
+	END DateToString;
+
+	PROCEDURE (hook: DatesHook) TimeToString (t: Dates.Time; OUT str: ARRAY OF CHAR);
+		VAR res: INTEGER; time: WinApi.SYSTEMTIME;
+	BEGIN
+		time.wHour := SHORT(t.hour); time.wMinute := SHORT(t.minute);
+		time.wSecond := SHORT(t.second); time.wMilliseconds := 0;
+		res := WinApi.GetTimeFormatW(HostRegistry.localeId, {}, time, NIL, str, LEN(str));
+		IF res = 0 THEN str := "?" END
+	END TimeToString;
+
+	PROCEDURE Init;
+		VAR datesHook: DatesHook;
+	BEGIN
+		NEW(datesHook); Dates.SetHook(datesHook)
+	END Init;
+
+BEGIN
+	Init
+END HostDates.

BIN
BlackBox/Windows/Host/Mod/Files.odc


+ 1219 - 0
BlackBox/Windows/Host/Mod/Files.txt

@@ -0,0 +1,1219 @@
+MODULE HostFiles;
+
+	(* THIS IS TEXT COPY OF Files.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT SYSTEM, WinApi, Files, Kernel;
+
+	CONST
+		tempName = "odcxxxxx.tmp";
+		docType = "odc";
+
+		serverVersion = TRUE;
+
+		pathLen* = 260;
+
+		nofbufs = 4;	(* max number of buffers per file *)
+		bufsize = 2 * 1024;	(* size of each buffer *)
+
+		invalid = WinApi.INVALID_HANDLE_VALUE;
+
+		temp = 0; new = 1; shared = 2; hidden = 3; exclusive = 4; closed = 5;	(* file states *)
+		create = -1;
+
+		ok = 0;
+		invalidName = 1;	invalidNameErr = 123;
+		notFound = 2;	fileNotFoundErr = 2; pathNotFoundErr = 3;
+		existsAlready = 3;	fileExistsErr = 80; alreadyExistsErr = 183;
+		writeProtected = 4;	writeProtectedErr = 19;
+		ioError = 5;
+		accessDenied = 6;	accessDeniedErr = 5; sharingErr = 32; netAccessDeniedErr = 65;
+		notEnoughMem = 80;	notEnoughMemoryErr = 8;
+		notEnoughDisk = 81;	diskFullErr = 39; tooManyOpenFilesErr = 4; noSystemResourcesErr = 1450;
+
+		noMoreFilesErr = 18;
+
+		cancel = -8; retry = -9;
+
+	TYPE
+		FullName* = ARRAY pathLen OF CHAR;
+
+		Locator* = POINTER TO RECORD (Files.Locator)
+			path-: FullName;	(* without trailing "/" *)
+			maxLen-: INTEGER;	(* maximum name length *)
+			caseSens-: BOOLEAN;	(* case sensitive file compares *)
+			rootLen-: INTEGER	(* for network version *)
+		END;
+
+		Buffer = POINTER TO RECORD
+			dirty: BOOLEAN;
+			org, len: INTEGER;
+			data: ARRAY bufsize OF BYTE
+		END;
+
+
+		File = POINTER TO RECORD (Files.File)
+			state: INTEGER;
+			name: FullName;
+			ref: WinApi.HANDLE;
+			loc: Locator;
+			swapper: INTEGER;	(* index into file table / next buffer to swap *)
+			len: INTEGER;
+			bufs: ARRAY nofbufs OF Buffer;
+			t: LONGINT	(* time stamp of last file operation *)
+		END;
+
+		Reader = POINTER TO RECORD (Files.Reader)
+			base: File;
+			org, offset: INTEGER;
+			buf: Buffer
+		END;
+
+		Writer = POINTER TO RECORD (Files.Writer)
+			base: File;
+			org, offset: INTEGER;
+			buf: Buffer
+		END;
+
+		Directory = POINTER TO RECORD (Files.Directory)
+			temp, startup: Locator
+		END;
+
+		Identifier = RECORD (Kernel.Identifier)
+			name: FullName
+		END;
+
+		Searcher = RECORD (Kernel.Identifier)
+			t0: INTEGER;
+			f: File
+		END;
+
+		Counter = RECORD (Kernel.Identifier)
+			count: INTEGER
+		END;
+
+
+	VAR
+		MapParamString*: PROCEDURE(in, p0, p1, p2: ARRAY OF CHAR; OUT out: ARRAY OF CHAR);
+		appName-: FullName;
+		dir: Directory;
+		wildcard: Files.Type;
+		startupDir: FullName;
+		startupLen: INTEGER;
+		res: INTEGER;
+
+
+	PROCEDURE Error (n: INTEGER): INTEGER;
+		VAR res: INTEGER;
+	BEGIN
+		IF n = ok THEN res := ok
+		ELSIF n = invalidNameErr THEN res := invalidName
+		ELSIF (n = fileNotFoundErr) OR (n = pathNotFoundErr) THEN res := notFound
+		ELSIF (n = fileExistsErr) OR (n = alreadyExistsErr) THEN res := existsAlready
+		ELSIF n = writeProtectedErr THEN res := writeProtected
+		ELSIF (n = sharingErr) OR (n = accessDeniedErr) OR (n = netAccessDeniedErr) THEN res := accessDenied
+		ELSIF n = notEnoughMemoryErr THEN res := notEnoughMem
+		ELSIF (n = diskFullErr) OR (n = tooManyOpenFilesErr) THEN res := notEnoughDisk
+		ELSE res := -n
+		END;
+		RETURN res
+	END Error;
+
+	PROCEDURE Diff (IN a, b: ARRAY OF CHAR; caseSens: BOOLEAN): INTEGER;
+		VAR i: INTEGER; cha, chb: CHAR;
+	BEGIN
+		i := 0;
+		REPEAT
+			cha := a[i]; chb := b[i]; INC(i);
+			IF cha # chb THEN
+				IF ~caseSens THEN
+					IF (cha >= "a") & ((cha <= "z") OR (cha >= 0E0X) & (cha <= 0FEX) & (cha # 0F7X)) THEN
+						cha := CAP(cha)
+					END;
+					IF (chb >= "a") & ((chb <= "z") OR (chb >= 0E0X) & (chb <= 0FEX) & (chb # 0F7X)) THEN
+						chb := CAP(chb)
+					END
+				END;
+				IF cha = "\" THEN cha := "/" END;
+				IF chb = "\" THEN chb := "/" END;
+				IF cha # chb THEN RETURN ORD(cha) - ORD(chb) END
+			END
+(*
+			IF (cha = chb)
+				OR ~caseSens & (CAP(cha) = CAP(chb)) & (CAP(cha) >= "A") & ((CAP(cha) <= "Z") OR (cha >= "À"))
+				OR ((cha = "/") OR (cha = "\")) & ((chb = "/") OR (chb = "\")) THEN	(* ok *)
+			ELSE RETURN 1
+			END
+*)
+		UNTIL cha = 0X;
+		RETURN 0
+	END Diff;
+
+	PROCEDURE NewLocator* (IN fname: ARRAY OF CHAR): Locator;
+		VAR loc: Locator; res, n, max, i: INTEGER; root: FullName; ch: CHAR; f: SET;
+	BEGIN
+		NEW(loc); loc.path := fname$; i := 0;
+		WHILE loc.path[i] # 0X DO INC(i) END;
+		IF (loc.path[i-1] = "/") OR (loc.path[i-1] = "\") THEN loc.path[i-1] := 0X END;
+		i := 0; n := 1;
+		IF ((fname[0] = "\") OR (fname[0] = "/")) & ((fname[1] = "\") OR (fname[1] = "/")) THEN n := 4 END;
+		REPEAT
+			ch := fname[i]; root[i] := ch; INC(i);
+			IF (ch = "/") OR (ch = "\") THEN DEC(n) END
+		UNTIL (ch = 0X) OR (n = 0);
+		IF ch = 0X THEN root[i-1] := "\" END;
+		root[i] := 0X; res := WinApi.GetVolumeInformationW(root, NIL, 0, n, max, f, NIL, 0);
+		IF res = 0 THEN
+			max := 12; f := {}	(* FAT values *)
+		END;
+		loc.maxLen := max; loc.caseSens := FALSE;	(* 0 IN f; *)	(* NT erroneously returns true here *)
+		RETURN loc
+	END NewLocator;
+
+	PROCEDURE GetType (IN name: ARRAY OF CHAR; VAR type: Files.Type);
+		VAR i, j: INTEGER; ch: CHAR;
+	BEGIN
+		i := 0; j := 0;
+		WHILE name[i] # 0X DO INC(i) END;
+		WHILE (i > 0) & (name[i] # ".") DO DEC(i) END;
+		IF i > 0 THEN
+			INC(i); ch := name[i];
+			WHILE (j < LEN(type) - 1) & (ch # 0X) DO
+				IF (ch >= "A") & (ch <= "Z") THEN ch := CHR(ORD(ch) + (ORD("a") - ORD("A"))) END;
+				type[j] := ch; INC(j);
+				INC(i); ch := name[i]
+			END
+		END;
+		type[j] := 0X
+	END GetType;
+
+	PROCEDURE Append (IN path, name: ARRAY OF CHAR; type: Files.Type; max: INTEGER;
+		VAR res: ARRAY OF CHAR
+	);
+		VAR i, j, n, m, dot: INTEGER; ch: CHAR;
+	BEGIN
+		i := 0;
+		WHILE path[i] # 0X DO res[i] := path[i]; INC(i) END;
+		IF path # "" THEN
+			ASSERT((res[i-1] # "/") & (res[i-1] # "\"), 100);
+			res[i] := "\"; INC(i)
+		END;
+		j := 0; ch := name[0]; n := 0; m := max; dot := -1;
+		IF max = 12 THEN m := 8 END;
+		WHILE (i < LEN(res) - 1) & (ch # 0X) DO
+			IF (ch = "/") OR (ch = "\") THEN
+				res[i] := ch; INC(i); n := 0; m := max; dot := -1;
+				IF max = 12 THEN m := 8 END
+			ELSIF (n < m) OR (ch = ".") & (n = 8) THEN
+				res[i] := ch; INC(i); INC(n);
+				IF ch = "." THEN dot := n;
+					IF max = 12 THEN m := n + 3 END
+				END
+			END;
+			INC(j); ch := name[j]
+		END;
+		IF (dot = -1) & (type # "") THEN
+			IF max = 12 THEN m := n + 4 END;
+			IF (n < m) & (i < LEN(res) - 1) THEN res[i] := "."; INC(i); INC(n); dot := n END
+		END;
+		IF n = dot THEN j := 0;
+			WHILE (n < m) & (i < LEN(res) - 1) & (type[j] # 0X) DO res[i] := type[j]; INC(i); INC(j) END
+		END;
+		res[i] := 0X
+	END Append;
+
+	PROCEDURE CloseFileHandle (f: File; VAR res: INTEGER);
+	BEGIN
+		IF (f.ref = invalid) OR (WinApi.CloseHandle(f.ref) # 0) THEN res := ok	(* !!! *)
+		ELSE res := WinApi.GetLastError()
+		END;
+		f.ref := invalid
+	END CloseFileHandle;
+
+	PROCEDURE CloseFile (f: File; VAR res: INTEGER);
+		VAR s: INTEGER;
+	BEGIN
+		IF f.state = exclusive THEN
+			f.Flush;
+			res := WinApi.FlushFileBuffers(f.ref)
+		 END;
+		s := f.state; f.state := closed;
+		CloseFileHandle (f, res);
+		IF (s IN {temp, new, hidden}) & (f.name # "") THEN
+			res := WinApi.DeleteFileW(f.name)
+		END
+	END CloseFile;
+
+	PROCEDURE (f: File) FINALIZE;
+		VAR res: INTEGER;
+	BEGIN
+		IF f.state # closed THEN CloseFile(f, res) END
+	END FINALIZE;
+
+	PROCEDURE (VAR id: Identifier) Identified (): BOOLEAN;
+		VAR f: File;
+	BEGIN
+		f := id.obj(File);
+		RETURN (f.state IN {shared, exclusive}) & (Diff(f.name, id.name, f.loc.caseSens) = 0)
+	END Identified;
+
+	PROCEDURE ThisFile (IN name: FullName): File;
+		VAR id: Identifier; p: ANYPTR;
+	BEGIN
+		id.typ := SYSTEM.TYP(File); id.name := name$;
+		p := Kernel.ThisFinObj(id);
+		IF p # NIL THEN RETURN p(File)
+		ELSE RETURN NIL
+		END
+	END ThisFile;
+
+	PROCEDURE (VAR s: Searcher) Identified (): BOOLEAN;
+		VAR f: File;
+	BEGIN
+		f := s.obj(File);
+		IF (f.ref # invalid) & ((s.f = NIL) OR (f.t < s.f.t)) THEN s.f := f END;
+		RETURN FALSE
+	END Identified;
+
+	PROCEDURE SearchFileToClose;
+		VAR s: Searcher; p: ANYPTR; (* res: LONGINT; *)
+	BEGIN
+		s.typ := SYSTEM.TYP(File); s.f := NIL;
+		p := Kernel.ThisFinObj(s);
+		IF s.f # NIL THEN
+			res := WinApi.CloseHandle(s.f.ref); s.f.ref := invalid;
+			IF res = 0 THEN res := WinApi.GetLastError(); HALT(100) END
+		END
+	END SearchFileToClose;
+
+	PROCEDURE NewFileRef (state: INTEGER; VAR name: FullName): WinApi.HANDLE;
+	BEGIN
+		IF state = create THEN
+			RETURN WinApi.CreateFileW(name, WinApi.GENERIC_READ + WinApi.GENERIC_WRITE, {},
+										NIL, WinApi.CREATE_NEW, WinApi.FILE_ATTRIBUTE_TEMPORARY, 0)
+		ELSIF state = shared THEN
+			RETURN WinApi.CreateFileW(name, WinApi.GENERIC_READ, WinApi.FILE_SHARE_READ,
+										NIL, WinApi.OPEN_EXISTING, {}, 0)
+		ELSE
+			RETURN WinApi.CreateFileW(name, WinApi.GENERIC_READ + WinApi.GENERIC_WRITE, {},
+										NIL, WinApi.OPEN_EXISTING, {}, 0)
+		END
+	END NewFileRef;
+
+	PROCEDURE OpenFile (state: INTEGER; VAR name: FullName; VAR ref, res: INTEGER);
+	BEGIN
+		ref := NewFileRef(state, name);
+		IF ref = invalid THEN
+			res := WinApi.GetLastError();
+			IF (res = tooManyOpenFilesErr) OR (res = noSystemResourcesErr) THEN
+				Kernel.Collect;
+				ref := NewFileRef(state, name);
+				IF ref = invalid THEN
+					res := WinApi.GetLastError();
+					IF (res = tooManyOpenFilesErr) OR (res = noSystemResourcesErr) THEN
+						SearchFileToClose;
+						ref := NewFileRef(state, name);
+						IF ref = invalid THEN
+							res := WinApi.GetLastError()
+						ELSE res := ok
+						END
+					END
+				ELSE res := ok
+				END
+			END
+		ELSE res := ok
+		END
+	END OpenFile;
+
+	PROCEDURE GetTempFileName (IN path: FullName; OUT name: FullName; num: INTEGER);
+		VAR i: INTEGER; str: ARRAY 16 OF CHAR;
+	BEGIN
+		str := tempName; i := 7;
+		WHILE i > 2 DO
+			str[i] := CHR(num MOD 10 + ORD("0")); DEC(i); num := num DIV 10
+		END;
+		Append(path, str, "", 8, name)
+	END GetTempFileName;
+
+	PROCEDURE CreateFile (f: File; VAR res: INTEGER);
+		VAR num, n: INTEGER;
+	BEGIN
+		IF f.name = "" THEN
+			num := WinApi.GetTickCount(); n := 200;
+			REPEAT
+				GetTempFileName(f.loc.path, f.name, num); INC(num); DEC(n);
+				OpenFile(create, f.name, f.ref, res)
+			UNTIL (res # fileExistsErr) & (res # alreadyExistsErr) & (res # 87) OR (n = 0)
+		ELSE
+			OpenFile(f.state, f.name, f.ref, res)
+		END
+	END CreateFile;
+
+	PROCEDURE Delete (IN fname, path: FullName; VAR res: INTEGER);
+		VAR num, n, s: INTEGER; f: File; new: FullName; attr: SET;
+	BEGIN
+		ASSERT(fname # "", 100);
+		f := ThisFile(fname);
+		IF f = NIL THEN
+			IF WinApi.DeleteFileW(fname) # 0 THEN res := ok
+			ELSE res := WinApi.GetLastError()
+			END
+		ELSE (* still in use => make it anonymous *)
+			IF f.ref # invalid THEN res := WinApi.CloseHandle(f.ref); f.ref := invalid END;	(* !!! *)
+			attr := BITS(WinApi.GetFileAttributesW(fname));
+			ASSERT(attr # {0..MAX(SET)}, 101);
+			IF WinApi.FILE_ATTRIBUTE_READONLY * attr = {} THEN
+				s := f.state; num := WinApi.GetTickCount(); n := 200;
+				REPEAT
+					GetTempFileName(path, new, num); INC(num); DEC(n);
+					IF WinApi.MoveFileW(fname, new) # 0 THEN res := ok
+					ELSE res := WinApi.GetLastError()
+					END
+				UNTIL (res # fileExistsErr) & (res # alreadyExistsErr) & (res # 87) OR (n = 0);
+				IF res = ok THEN
+					f.state := hidden; f.name := new$
+				END
+			ELSE
+				res := writeProtectedErr
+			END
+		END
+	END Delete;
+
+	PROCEDURE FlushBuffer (f: File; i: INTEGER);
+		VAR buf: Buffer; res, h: INTEGER;
+	BEGIN
+		buf := f.bufs[i];
+		IF (buf # NIL) & buf.dirty THEN
+			IF f.ref = invalid THEN CreateFile(f, res) (* ASSERT(res = ok, 100) *) END;
+			IF f.ref # invalid THEN
+				h := 0; h := WinApi.SetFilePointer(f.ref, buf.org, h, 0);
+				IF (WinApi.WriteFile(f.ref, SYSTEM.ADR(buf.data), buf.len, h, NIL) = 0) OR (h < buf.len) THEN
+					res := WinApi.GetLastError(); HALT(101)
+				END;
+				buf.dirty := FALSE; f.t := Kernel.Time()
+			END
+		END
+	END FlushBuffer;
+
+
+
+	(* File *)
+
+	PROCEDURE (f: File) NewReader (old: Files.Reader): Files.Reader;
+		VAR r: Reader;
+	BEGIN	(* portable *)
+		ASSERT(f.state # closed, 20);
+		IF (old # NIL) & (old IS Reader) THEN r := old(Reader) ELSE NEW(r) END;
+		IF r.base # f THEN
+			r.base := f; r.buf := NIL; r.SetPos(0)
+		END;
+		r.eof := FALSE;
+		RETURN r
+	END NewReader;
+
+	PROCEDURE (f: File) NewWriter (old: Files.Writer): Files.Writer;
+		VAR w: Writer;
+	BEGIN	(* portable *)
+		ASSERT(f.state # closed, 20); ASSERT(f.state # shared, 21);
+		IF (old # NIL) & (old IS Writer) THEN w := old(Writer) ELSE NEW(w) END;
+		IF w.base # f THEN
+			w.base := f; w.buf := NIL; w.SetPos(f.len)
+		END;
+		RETURN w
+	END NewWriter;
+
+	PROCEDURE (f: File) Length (): INTEGER;
+	BEGIN	(* portable *)
+		RETURN f.len
+	END Length;
+
+	PROCEDURE (f: File) Flush;
+		VAR i: INTEGER;
+	BEGIN	(* portable *)
+		i := 0; WHILE i # nofbufs DO FlushBuffer(f, i); INC(i) END
+	END Flush;
+
+	PROCEDURE GetPath (IN fname: FullName; OUT path: FullName);
+		VAR i: INTEGER;
+	BEGIN
+		path := fname$; i := LEN(path$);
+		WHILE (i > 0) & (path[i] # "\") & (path[i] # "/") & (path[i-1] # ":") DO DEC(i) END;
+		path[i] := 0X
+	END GetPath;
+
+	PROCEDURE CreateDir (IN path: FullName; OUT res: INTEGER);
+		VAR sec: WinApi.SECURITY_ATTRIBUTES; p: FullName;
+	BEGIN
+		ASSERT(path # "", 100);
+		sec.nLength :=SIZE(WinApi.SECURITY_ATTRIBUTES);
+		sec.lpSecurityDescriptor := 0; sec.bInheritHandle := 0;
+		res := WinApi.CreateDirectoryW(path, sec);
+		IF res = 0 THEN res := WinApi.GetLastError() ELSE res := ok END;
+		IF (res = fileNotFoundErr) OR (res = pathNotFoundErr) THEN
+			GetPath(path, p);
+			CreateDir(p, res);	(* recursive call *)
+			IF res = ok THEN
+				res := WinApi.CreateDirectoryW(path, sec);
+				IF res = 0 THEN res := WinApi.GetLastError() ELSE res := ok END
+			END
+		END
+	END CreateDir;
+
+	PROCEDURE CheckPath (VAR path: FullName; ask: BOOLEAN; VAR res: INTEGER);
+		VAR s: ARRAY 300 OF CHAR; t: ARRAY 32 OF CHAR;
+	BEGIN
+		IF ask THEN
+			IF MapParamString # NIL THEN
+				MapParamString("#Host:CreateDir", path, "", "", s);
+				MapParamString("#Host:MissingDirectory", "", "", "", t)
+			ELSE
+				s := path$; t := "Missing Directory"
+			END;
+			res := WinApi.MessageBoxW(Kernel.mainWnd, s, t, {0, 6})	(* ok cancel, icon information *)
+		ELSE
+			res := 1
+		END;
+		IF res = 1 THEN CreateDir(path, res)
+		ELSIF res = 2 THEN res := cancel
+		END
+	END CheckPath;
+
+	PROCEDURE CheckDelete (IN fname, path: FullName; ask: BOOLEAN; VAR res: INTEGER);
+		VAR s: ARRAY 300 OF CHAR; t: ARRAY 16 OF CHAR;
+	BEGIN
+		REPEAT
+			Delete(fname, path, res);
+			IF (res = writeProtectedErr) OR (res = sharingErr) OR (res = accessDeniedErr)
+				OR (res = netAccessDeniedErr)
+			THEN
+				IF ask THEN
+					IF MapParamString # NIL THEN
+						IF res = writeProtectedErr THEN
+							MapParamString("#Host:ReplaceWriteProtected", fname, 0DX, "", s)
+						ELSIF (res = accessDeniedErr) OR (res = netAccessDeniedErr) THEN
+							MapParamString("#Host:ReplaceAccessDenied", fname, 0DX, "", s)
+						ELSE
+							MapParamString("#Host:ReplaceInUse", fname, 0DX, "", s)
+						END;
+						MapParamString("#Host:FileError", "", "", "", t)
+					ELSE
+						s := fname$; t := "File Error"
+					END;
+					res := WinApi.MessageBoxW(Kernel.mainWnd, s, t, {0, 2, 4, 5});	(* retry cancel, icon warning *)
+					IF res = 2 THEN res := cancel
+					ELSIF res = 4 THEN res := retry
+					END
+				ELSE
+					res := cancel
+				END
+			ELSE
+				res := ok
+			END
+		UNTIL res # retry
+	END CheckDelete;
+
+	PROCEDURE (f: File) Register (name: Files.Name; type: Files.Type; ask: BOOLEAN; OUT res: INTEGER);
+		VAR b: INTEGER; fname: FullName;
+	BEGIN
+		ASSERT(f.state = new, 20); ASSERT(name # "", 21);
+		Append(f.loc.path, name, type, f.loc.maxLen, fname);
+		CheckDelete(fname, f.loc.path, ask, res);
+		ASSERT(res # 87, 100);
+		IF res = ok THEN
+			IF f.name = "" THEN
+				f.name := fname$;
+				OpenFile(create, f.name, f.ref, res);
+				IF res = ok THEN
+					f.state := exclusive; CloseFile(f, res);
+					b := WinApi.SetFileAttributesW(f.name, WinApi.FILE_ATTRIBUTE_ARCHIVE)
+				END
+			ELSE
+				f.state := exclusive; CloseFile(f, res);
+				IF WinApi.MoveFileW(f.name, fname) # 0 THEN
+					res := ok; f.name := fname$;
+					b := WinApi.SetFileAttributesW(f.name, WinApi.FILE_ATTRIBUTE_ARCHIVE)
+				ELSE
+					res := WinApi.GetLastError();
+					ASSERT(res # 87, 101);
+					b := WinApi.DeleteFileW(f.name)
+				END
+			END
+		END;
+		res := Error(res)
+	END Register;
+
+	PROCEDURE (f: File) Close;
+		VAR res: INTEGER;
+	BEGIN	(* portable *)
+		IF f.state # closed THEN
+(*
+			IF f.state = exclusive THEN
+				CloseFile(f, res)
+			ELSE
+				CloseFileHandle(f, res)
+			END
+*)
+			CloseFile(f, res)
+		END
+	END Close;
+
+
+	(* Locator *)
+
+	PROCEDURE (loc: Locator) This* (IN path: ARRAY OF CHAR): Locator;
+		VAR new: Locator; i: INTEGER;
+	BEGIN
+		IF path = "" THEN
+			NEW(new); new^ := loc^
+		ELSIF path[1] = ":" THEN	(* absolute path *)
+			new := NewLocator(path);
+			new.rootLen := 0
+		ELSIF (path[0] = "\") OR (path[0] = "/") THEN
+			IF (path[1] = "\") OR (path[1] = "/") THEN	(* network path *)
+				new := NewLocator(path);
+				new.rootLen := 0
+			ELSE
+				NEW(new); new^ := dir.startup^;
+				new.res := invalidName;
+				RETURN new
+			END
+		ELSE
+			NEW(new); Append(loc.path, path, "", loc.maxLen, new.path);
+			i := 0; WHILE new.path[i] # 0X DO INC(i) END;
+			IF (new.path[i-1] = "/") OR (new.path[i-1] = "\") THEN new.path[i-1] := 0X END;
+			new.maxLen := loc.maxLen;
+			new.caseSens := loc.caseSens;
+			new.rootLen := loc.rootLen
+		END;
+		new.res := ok;
+		RETURN new
+	END This;
+
+
+	(* Reader *)
+
+	PROCEDURE (r: Reader) Base (): Files.File;
+	BEGIN	(* portable *)
+		RETURN r.base
+	END Base;
+
+(*
+	PROCEDURE (r: Reader) Available (): INTEGER;
+	BEGIN	(* portable *)
+		ASSERT(r.base # NIL, 20);
+		RETURN r.base.len - r.org - r.offset
+	END Available;
+*)
+	PROCEDURE (r: Reader) SetPos (pos: INTEGER);
+		VAR f: File; org, offset, i, count, res: INTEGER; buf: Buffer;
+	BEGIN
+		f := r.base; ASSERT(f # NIL, 20); ASSERT(f.state # closed, 25);
+		ASSERT(pos >= 0, 22); ASSERT(pos <= f.len, 21);
+		offset := pos MOD bufsize; org := pos - offset;
+		i := 0; WHILE (i # nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END;
+		IF i # nofbufs THEN
+			buf := f.bufs[i];
+			IF buf = NIL THEN	(* create new buffer *)
+				NEW(buf); f.bufs[i] := buf; buf.org := -1
+			END
+		ELSE	(* choose an existing buffer *)
+			f.swapper := (f.swapper + 1) MOD nofbufs;
+			FlushBuffer(f, f.swapper); buf := f.bufs[f.swapper]; buf.org := -1
+		END;
+		IF buf.org # org THEN
+			IF org + bufsize > f.len THEN buf.len := f.len - org ELSE buf.len := bufsize END;
+			count := buf.len;
+			IF count > 0 THEN
+				IF f.ref = invalid THEN CreateFile(f, res) (* ASSERT(res = ok, 100) *) END;
+				IF f.ref # invalid THEN
+					i := 0; i := WinApi.SetFilePointer(f.ref, org, i, 0);
+					IF (WinApi.ReadFile(f.ref, SYSTEM.ADR(buf.data), count, i, NIL) = 0) OR (i < count) THEN
+						res := WinApi.GetLastError(); res := Error(res); HALT(101)
+					END;
+					f.t := Kernel.Time()
+				END
+			END;
+			buf.org := org; buf.dirty := FALSE
+		END;
+		r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE
+		(* 0<= r.org <= r.base.len *)
+		(* 0 <= r.offset < bufsize *)
+		(* 0 <= r.buf.len <= bufsize *)
+		(* r.offset <= r.base.len *)
+		(* r.offset <= r.buf.len *)
+	END SetPos;
+
+	PROCEDURE (r: Reader) Pos (): INTEGER;
+	BEGIN	(* portable *)
+		ASSERT(r.base # NIL, 20);
+		RETURN r.org + r.offset
+	END Pos;
+
+	PROCEDURE (r: Reader) ReadByte (OUT x: BYTE);
+	BEGIN	(* portable *)
+		IF (r.org # r.buf.org) OR (r.offset >= bufsize) THEN r.SetPos(r.org + r.offset) END;
+		IF r.offset < r.buf.len THEN
+			x := r.buf.data[r.offset]; INC(r.offset)
+		ELSE
+			x := 0; r.eof := TRUE
+		END
+	END ReadByte;
+
+	PROCEDURE (r: Reader) ReadBytes (VAR x: ARRAY OF BYTE; beg, len: INTEGER);
+		VAR from, to, count, restInBuf: INTEGER;
+	BEGIN	(* portable *)
+		ASSERT(beg >= 0, 21);
+		IF len > 0 THEN
+			ASSERT(beg + len <= LEN(x), 23);
+			WHILE len # 0 DO
+				IF (r.org # r.buf.org) OR (r.offset >= bufsize) THEN r.SetPos(r.org + r.offset) END;
+				restInBuf := r.buf.len - r.offset;
+				IF restInBuf = 0 THEN r.eof := TRUE; RETURN
+				ELSIF restInBuf <= len THEN count := restInBuf
+				ELSE count := len
+				END;
+				from := SYSTEM.ADR(r.buf.data[r.offset]); to := SYSTEM.ADR(x) + beg;
+				SYSTEM.MOVE(from, to, count);
+				INC(r.offset, count); INC(beg, count); DEC(len, count)
+			END;
+			r.eof := FALSE
+		ELSE ASSERT(len = 0, 22)
+		END
+	END ReadBytes;
+
+
+
+	(* Writer *)
+
+	PROCEDURE (w: Writer) Base (): Files.File;
+	BEGIN	(* portable *)
+		RETURN w.base
+	END Base;
+
+	PROCEDURE (w: Writer) SetPos (pos: INTEGER);
+		VAR f: File; org, offset, i, count, res: INTEGER; buf: Buffer;
+	BEGIN
+		f := w.base; ASSERT(f # NIL, 20); ASSERT(f.state # closed, 25);
+		ASSERT(pos >= 0, 22); ASSERT(pos <= f.len, 21);
+		offset := pos MOD bufsize; org := pos - offset;
+		i := 0; WHILE (i # nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END;
+		IF i # nofbufs THEN
+			buf := f.bufs[i];
+			IF buf = NIL THEN	(* create new buffer *)
+				NEW(buf); f.bufs[i] := buf; buf.org := -1
+			END
+		ELSE	(* choose an existing buffer *)
+			f.swapper := (f.swapper + 1) MOD nofbufs;
+			FlushBuffer(f, f.swapper); buf := f.bufs[f.swapper]; buf.org := -1
+		END;
+		IF buf.org # org THEN
+			IF org + bufsize > f.len THEN buf.len := f.len - org ELSE buf.len := bufsize END;
+			count := buf.len;
+			IF count > 0 THEN
+				IF f.ref = invalid THEN CreateFile(f, res) (* ASSERT(res = ok, 100) *) END;
+				IF f.ref # invalid THEN
+					i := 0; i := WinApi.SetFilePointer(f.ref, org, i, 0);
+					IF (WinApi.ReadFile(f.ref, SYSTEM.ADR(buf.data), count, i, NIL) = 0) OR (i < count) THEN
+						res := WinApi.GetLastError(); res := Error(res); HALT(101)
+					END;
+					f.t := Kernel.Time()
+				END
+			END;
+			buf.org := org; buf.dirty := FALSE
+		END;
+		w.buf := buf; w.org := org; w.offset := offset
+		(* 0<= w.org <= w.base.len *)
+		(* 0 <= w.offset < bufsize *)
+		(* 0 <= w.buf.len <= bufsize *)
+		(* w.offset <= w.base.len *)
+		(* w.offset <= w.buf.len *)
+	END SetPos;
+
+	PROCEDURE (w: Writer) Pos (): INTEGER;
+	BEGIN	(* portable *)
+		ASSERT(w.base # NIL, 20);
+		RETURN w.org + w.offset
+	END Pos;
+
+	PROCEDURE (w: Writer) WriteByte (x: BYTE);
+	BEGIN	(* portable *)
+		ASSERT(w.base.state # closed, 25);
+		IF (w.org # w.buf.org) OR (w.offset >= bufsize) THEN w.SetPos(w.org + w.offset) END;
+		w.buf.data[w.offset] := x; w.buf.dirty := TRUE;
+		IF w.offset = w.buf.len THEN INC(w.buf.len); INC(w.base.len) END;
+		INC(w.offset)
+	END WriteByte;
+
+	PROCEDURE (w: Writer) WriteBytes (IN x: ARRAY OF BYTE; beg, len: INTEGER);
+		VAR from, to, count, restInBuf: INTEGER;
+	BEGIN	(* portable *)
+		ASSERT(beg >= 0, 21); ASSERT(w.base.state # closed, 25);
+		IF len > 0 THEN
+			ASSERT(beg + len <= LEN(x), 23);
+			WHILE len # 0 DO
+				IF (w.org # w.buf.org) OR (w.offset >= bufsize) THEN w.SetPos(w.org + w.offset) END;
+				restInBuf := bufsize - w.offset;
+				IF restInBuf <= len THEN count := restInBuf ELSE count := len END;
+				from := SYSTEM.ADR(x) + beg; to := SYSTEM.ADR(w.buf.data[w.offset]);
+				SYSTEM.MOVE(from, to, count);
+				INC(w.offset, count); INC(beg, count); DEC(len, count);
+				IF w.offset > w.buf.len THEN INC(w.base.len, w.offset - w.buf.len); w.buf.len := w.offset END;
+				w.buf.dirty := TRUE
+			END
+		ELSE ASSERT(len = 0, 22)
+		END
+	END WriteBytes;
+
+
+
+	(* Directory *)
+
+	PROCEDURE (d: Directory) This (IN path: ARRAY OF CHAR): Files.Locator;
+	BEGIN
+		RETURN d.startup.This(path)
+	END This;
+
+	PROCEDURE (d: Directory) New (loc: Files.Locator; ask: BOOLEAN): Files.File;
+		VAR f: File; res: INTEGER; attr: SET;
+	BEGIN
+		ASSERT(loc # NIL, 20); f := NIL; res := ok;
+		WITH loc: Locator DO
+			IF loc.path # "" THEN
+				attr := BITS(WinApi.GetFileAttributesW(loc.path));
+				IF attr = {0..MAX(SET)} THEN	(* error *)
+					res := WinApi.GetLastError();
+					IF (res = fileNotFoundErr) OR (res = pathNotFoundErr) THEN
+						IF loc.res = 76 THEN CreateDir(loc.path, res)
+						ELSE CheckPath(loc.path, ask, res)
+						END
+					ELSE res := pathNotFoundErr
+					END
+				ELSIF WinApi.FILE_ATTRIBUTE_DIRECTORY * attr = {} THEN res := fileExistsErr
+				END
+			END;
+			IF res = ok THEN
+				NEW(f); f.loc := loc; f.name := "";
+				f.state := new; f.swapper := -1; f.len := 0; f.ref := invalid
+			END
+		ELSE res := invalidNameErr
+		END;
+		loc.res := Error(res);
+		RETURN f
+	END New;
+
+	PROCEDURE (d: Directory) Temp (): Files.File;
+		VAR f: File;
+	BEGIN
+		NEW(f); f.loc := d.temp; f.name := "";
+		f.state := temp; f.swapper := -1; f.len := 0; f.ref := invalid;
+		RETURN f
+	END Temp;
+
+	PROCEDURE GetShadowDir (loc: Locator; OUT dir: FullName);
+		VAR i, j: INTEGER;
+	BEGIN
+		dir := startupDir$; i := startupLen; j := loc.rootLen;
+		WHILE loc.path[j] # 0X DO dir[i] := loc.path[j]; INC(i); INC(j) END;
+		dir[i] := 0X
+	END GetShadowDir;
+
+	PROCEDURE (d: Directory) Old (loc: Files.Locator; name: Files.Name; shrd: BOOLEAN): Files.File;
+		VAR res, i, j: INTEGER; f: File; ref: WinApi.HANDLE; fname: FullName; type: Files.Type; s: BYTE;
+	BEGIN
+		ASSERT(loc # NIL, 20); ASSERT(name # "", 21);
+		res := ok; f := NIL;
+		WITH loc: Locator DO
+			Append(loc.path, name, "", loc.maxLen, fname);
+			f := ThisFile(fname);
+			IF f # NIL THEN
+				IF ~shrd OR (f.state = exclusive) THEN loc.res := Error(sharingErr); RETURN NIL
+				ELSE loc.res := ok; RETURN f
+				END
+			END;
+			IF shrd THEN s := shared ELSE s := exclusive END;
+			OpenFile(s, fname, ref, res);
+			IF ((res = fileNotFoundErr) OR (res = pathNotFoundErr)) & (loc.rootLen > 0) THEN
+				GetShadowDir(loc, fname);
+				Append(fname, name, "", loc.maxLen, fname);
+				f := ThisFile(fname);
+				IF f # NIL THEN
+					IF ~shrd OR (f.state = exclusive) THEN loc.res := Error(sharingErr); RETURN NIL
+					ELSE loc.res := ok; RETURN f
+					END
+				END;
+				OpenFile(s, fname, ref, res)
+			END;
+			IF res = ok THEN
+				NEW(f); f.loc := loc;
+				f.swapper := -1; i := 0;
+				GetType(name, type);
+				f.InitType(type);
+				ASSERT(ref # invalid, 107);
+				f.ref := ref; f.name := fname$; f.state := s; f.t := Kernel.Time();
+				f.len := WinApi.GetFileSize(ref, j)
+			END
+		END;
+		loc.res := Error(res);
+		RETURN f
+	END Old;
+
+	PROCEDURE (d: Directory) Delete* (loc: Files.Locator; name: Files.Name);
+		VAR res: INTEGER; fname: FullName;
+	BEGIN
+		ASSERT(loc # NIL, 20);
+		WITH loc: Locator DO
+			Append(loc.path, name, "", loc.maxLen, fname);
+			Delete(fname, loc.path, res)
+		ELSE res := invalidNameErr
+		END;
+		loc.res := Error(res)
+	END Delete;
+
+	PROCEDURE (d: Directory) Rename* (loc: Files.Locator; old, new: Files.Name; ask: BOOLEAN);
+		VAR res, i: INTEGER; oldname, newname, tn: FullName; f: File; attr: SET;
+	BEGIN
+		ASSERT(loc # NIL, 20);
+		WITH loc: Locator DO
+			Append(loc.path, old, "", loc.maxLen, oldname); Append(loc.path, new, "", loc.maxLen, newname);
+			attr :=BITS( WinApi.GetFileAttributesW(oldname));
+			IF ORD(attr) # -1 THEN
+				f := ThisFile(oldname);
+				IF (f # NIL) & (f.ref # invalid) THEN res := WinApi.CloseHandle(f.ref); f.ref := invalid END;
+				IF Diff(oldname, newname, loc.caseSens) # 0 THEN
+					CheckDelete(newname, loc.path, ask, res);
+					IF res = ok THEN
+						IF WinApi.MoveFileW(oldname, newname) # 0 THEN
+							IF f # NIL THEN	(* still in use => update file table *)
+								f.name := newname$
+							END
+						ELSE res := WinApi.GetLastError()
+						END
+					END
+				ELSE	(* destination is same file as source *)
+					tn := oldname$; i := LEN(tn$) - 1;
+					REPEAT
+						tn[i] := CHR(ORD(tn[i]) + 1);
+						IF WinApi.MoveFileW(oldname, tn) # 0 THEN res := ok
+						ELSE res := WinApi.GetLastError()
+						END
+					UNTIL (res # fileExistsErr) & (res # alreadyExistsErr) & (res # 87);
+					IF res = ok THEN
+						IF WinApi.MoveFileW(tn, newname) = 0 THEN res := WinApi.GetLastError() END
+					END
+				END
+			ELSE res := fileNotFoundErr
+			END
+		ELSE res := invalidNameErr
+		END;
+		loc.res := Error(res)
+	END Rename;
+
+	PROCEDURE (d: Directory) SameFile* (loc0: Files.Locator; name0: Files.Name;
+															loc1: Files.Locator; name1: Files.Name): BOOLEAN;
+		VAR p0, p1: FullName;
+	BEGIN
+		ASSERT(loc0 # NIL, 20); ASSERT(loc1 # NIL, 21);
+		WITH loc0: Locator DO Append(loc0.path, name0, "", loc0.maxLen, p0) END;
+		WITH loc1: Locator DO Append(loc1.path, name1, "", loc1.maxLen, p1) END;
+		RETURN Diff(p0, p1, loc0(Locator).caseSens) = 0
+	END SameFile;
+
+	PROCEDURE (d: Directory) FileList* (loc: Files.Locator): Files.FileInfo;
+		VAR i, res, diff: INTEGER; info, first, last: Files.FileInfo; s: FullName;
+			find: WinApi.HANDLE; fd: WinApi.WIN32_FIND_DATAW; st: WinApi.SYSTEMTIME;
+	BEGIN
+		ASSERT(loc # NIL, 20);
+		first := NIL; last :=NIL;
+		WITH loc: Locator DO
+			Append(loc.path, wildcard, wildcard, loc.maxLen, s);
+			find := WinApi.FindFirstFileW(s, fd);
+			IF find # invalid THEN
+				REPEAT
+					IF ~(WinApi.FILE_ATTRIBUTE_DIRECTORY * fd.dwFileAttributes # {})
+							& (LEN(fd.cFileName$) < LEN(info.name)) THEN
+						info := first; last := NIL; s := fd.cFileName$;
+						WHILE (info # NIL) & (Diff(info.name, s, loc.caseSens) < 0) DO last := info; info := info.next END;
+						NEW(info);
+						info.name := fd.cFileName$;
+						info.length := fd.nFileSizeLow;
+						res := WinApi.FileTimeToSystemTime(fd.ftLastWriteTime, st);
+						info.modified.year := st.wYear;
+						info.modified.month := st.wMonth;
+						info.modified.day := st.wDay;
+						info.modified.hour := st.wHour;
+						info.modified.minute := st.wMinute;
+						info.modified.second := st.wSecond;
+						info.attr := {};
+						IF WinApi.FILE_ATTRIBUTE_HIDDEN * fd.dwFileAttributes # {} THEN
+							INCL(info.attr, Files.hidden)
+						END;
+						IF WinApi.FILE_ATTRIBUTE_READONLY * fd.dwFileAttributes # {} THEN
+							INCL(info.attr, Files.readOnly)
+						END;
+						IF WinApi.FILE_ATTRIBUTE_SYSTEM * fd.dwFileAttributes # {} THEN
+							INCL(info.attr, Files.system)
+						END;
+						IF WinApi.FILE_ATTRIBUTE_ARCHIVE * fd.dwFileAttributes # {} THEN
+							INCL(info.attr, Files.archive)
+						END;
+						GetType(fd.cFileName, info.type);
+						IF last = NIL THEN info.next := first; first := info ELSE info.next := last.next; last.next := info END
+					END;
+					i := WinApi.FindNextFileW(find, fd)
+				UNTIL i = 0;
+				res := WinApi.GetLastError(); i := WinApi.FindClose(find)
+			ELSE res := WinApi.GetLastError()
+			END;
+			IF res = noMoreFilesErr THEN res := ok END;
+			(* check startup directory *)
+			IF (loc.rootLen > 0) & ((res = ok) OR (res = fileNotFoundErr) OR (res = pathNotFoundErr)) THEN
+				GetShadowDir(loc, s);
+				Append(s, wildcard, wildcard, loc.maxLen, s);
+				find := WinApi.FindFirstFileW(s, fd);
+				IF find # invalid THEN
+					REPEAT
+						IF ~(WinApi.FILE_ATTRIBUTE_DIRECTORY * fd.dwFileAttributes # {})
+								& (LEN(fd.cFileName$) < LEN(info.name)) THEN
+							info := first; last := NIL; s := fd.cFileName$;
+							IF info # NIL THEN diff := Diff(info.name, s, loc.caseSens) END;
+							WHILE (info # NIL) & (diff < 0) DO
+								last := info; info := info.next;
+								IF info # NIL THEN diff := Diff(info.name, s, loc.caseSens) END
+							END;
+							IF (info = NIL) OR (diff # 0) THEN
+								NEW(info);
+								info.name := fd.cFileName$;
+								info.length := fd.nFileSizeLow;
+								res := WinApi.FileTimeToSystemTime(fd.ftLastWriteTime, st);
+								info.modified.year := st.wYear;
+								info.modified.month := st.wMonth;
+								info.modified.day := st.wDay;
+								info.modified.hour := st.wHour;
+								info.modified.minute := st.wMinute;
+								info.modified.second := st.wSecond;
+								info.attr := {};
+								IF WinApi.FILE_ATTRIBUTE_HIDDEN * fd.dwFileAttributes # {} THEN
+									INCL(info.attr, Files.hidden)
+								END;
+								IF WinApi.FILE_ATTRIBUTE_READONLY * fd.dwFileAttributes # {} THEN
+									INCL(info.attr, Files.readOnly)
+								END;
+								IF WinApi.FILE_ATTRIBUTE_SYSTEM * fd.dwFileAttributes # {} THEN
+									INCL(info.attr, Files.system)
+								END;
+								IF WinApi.FILE_ATTRIBUTE_ARCHIVE * fd.dwFileAttributes # {} THEN
+									INCL(info.attr, Files.archive)
+								END;
+								GetType(fd.cFileName, info.type);
+								IF last = NIL THEN info.next := first; first := info ELSE info.next := last.next; last.next := info END
+							END
+						END;
+						i := WinApi.FindNextFileW(find, fd)
+					UNTIL i = 0;
+					res := WinApi.GetLastError(); i := WinApi.FindClose(find)
+				ELSE res := WinApi.GetLastError()
+				END;
+				IF res = noMoreFilesErr THEN res := ok END
+			END;
+			loc.res := Error(res)
+		ELSE loc.res := invalidName
+		END;
+		RETURN first
+	END FileList;
+
+	PROCEDURE (d: Directory) LocList* (loc: Files.Locator): Files.LocInfo;
+		VAR i, res, diff: INTEGER; first, last, info: Files.LocInfo; s: FullName;
+			find: WinApi.HANDLE; fd: WinApi.WIN32_FIND_DATAW;
+	BEGIN
+		ASSERT(loc # NIL, 20);
+		first := NIL; last :=NIL;
+		WITH loc: Locator DO
+			Append(loc.path, wildcard, wildcard, loc.maxLen, s);
+			find := WinApi.FindFirstFileW(s, fd);
+			IF find # invalid THEN
+				REPEAT
+					IF (WinApi.FILE_ATTRIBUTE_DIRECTORY * fd.dwFileAttributes # {})
+							& (fd.cFileName[0] # ".") & (LEN(fd.cFileName$) < LEN(info.name)) THEN
+						info := first; last := NIL; s := fd.cFileName$;
+						WHILE (info # NIL) & (Diff(info.name, s, loc.caseSens) < 0) DO last := info; info := info.next END;
+						NEW(info);
+						info.name := fd.cFileName$;
+						info.attr := {};
+						IF WinApi.FILE_ATTRIBUTE_HIDDEN * fd.dwFileAttributes # {} THEN
+							INCL(info.attr, Files.hidden)
+						END;
+						IF WinApi.FILE_ATTRIBUTE_READONLY * fd.dwFileAttributes # {} THEN
+							INCL(info.attr, Files.readOnly)
+						END;
+						IF WinApi.FILE_ATTRIBUTE_SYSTEM * fd.dwFileAttributes # {} THEN
+							INCL(info.attr, Files.system)
+						END;
+						IF WinApi.FILE_ATTRIBUTE_ARCHIVE * fd.dwFileAttributes # {} THEN
+							INCL(info.attr, Files.archive)
+						END;
+						IF last = NIL THEN info.next := first; first := info ELSE info.next := last.next; last.next := info END
+					END;
+					i := WinApi.FindNextFileW(find, fd)
+				UNTIL i = 0;
+				res := WinApi.GetLastError(); i := WinApi.FindClose(find)
+			ELSE res := WinApi.GetLastError()
+			END;
+			IF res = noMoreFilesErr THEN res := ok END;
+			(* check startup directory *)
+			IF (loc.rootLen > 0) & ((res = ok) OR (res = fileNotFoundErr) OR (res = pathNotFoundErr)) THEN
+				GetShadowDir(loc, s);
+				Append(s, wildcard, wildcard, loc.maxLen, s);
+				find := WinApi.FindFirstFileW(s, fd);
+				IF find # invalid THEN
+					REPEAT
+					IF (WinApi.FILE_ATTRIBUTE_DIRECTORY * fd.dwFileAttributes # {})
+							& (fd.cFileName[0] # ".") & (LEN(fd.cFileName$) < LEN(info.name)) THEN
+							info := first; last := NIL; s := fd.cFileName$;
+							IF info # NIL THEN diff := Diff(info.name, s, loc.caseSens) END;
+							WHILE (info # NIL) & (diff < 0) DO
+								last := info; info := info.next;
+								IF info # NIL THEN diff := Diff(info.name, s, loc.caseSens) END
+							END;
+							IF (info = NIL) OR (diff # 0) THEN
+								NEW(info);
+								info.name := fd.cFileName$;
+								info.attr := {};
+								IF WinApi.FILE_ATTRIBUTE_HIDDEN * fd.dwFileAttributes # {} THEN
+									INCL(info.attr, Files.hidden)
+								END;
+								IF WinApi.FILE_ATTRIBUTE_READONLY * fd.dwFileAttributes # {} THEN
+									INCL(info.attr, Files.readOnly)
+								END;
+								IF WinApi.FILE_ATTRIBUTE_SYSTEM * fd.dwFileAttributes # {} THEN
+									INCL(info.attr, Files.system)
+								END;
+								IF WinApi.FILE_ATTRIBUTE_ARCHIVE * fd.dwFileAttributes # {} THEN
+									INCL(info.attr, Files.archive)
+								END;
+								IF last = NIL THEN info.next := first; first := info ELSE info.next := last.next; last.next := info END
+							END
+						END;
+						i := WinApi.FindNextFileW(find, fd)
+					UNTIL i = 0;
+					res := WinApi.GetLastError(); i := WinApi.FindClose(find)
+				ELSE res := WinApi.GetLastError()
+				END;
+				IF res = noMoreFilesErr THEN res := ok END
+			END;
+			loc.res := Error(res)
+		ELSE loc.res := invalidName
+		END;
+		RETURN first
+	END LocList;
+
+	PROCEDURE (d: Directory) GetFileName (name: Files.Name; type: Files.Type; OUT filename: Files.Name);
+	BEGIN
+		Append("", name, type, LEN(filename), filename)
+	END GetFileName;
+
+	(** Miscellaneous **)
+
+	PROCEDURE (VAR id: Counter) Identified (): BOOLEAN;
+		VAR f: File;
+	BEGIN
+		f := id.obj(File);
+		IF f.state # closed THEN INC(id.count) END;
+		RETURN FALSE
+	END Identified;
+
+	PROCEDURE NofFiles* (): INTEGER;
+		VAR p: ANYPTR; cnt: Counter;
+	BEGIN
+		cnt.typ := SYSTEM.TYP(File);
+		cnt.count := 0; p := Kernel.ThisFinObj(cnt);
+		RETURN cnt.count
+	END NofFiles;
+
+	PROCEDURE GetModDate* (f: Files.File; VAR year, month, day, hour, minute, second: INTEGER);
+		VAR res: INTEGER; ft: WinApi.FILETIME; st: WinApi.SYSTEMTIME;
+	BEGIN
+		ASSERT(f IS File, 20);
+		res := WinApi.GetFileTime(f(File).ref, NIL, NIL, ft);
+		res := WinApi.FileTimeToSystemTime(ft, st);
+		year := st.wYear; month := st.wMonth; day := st.wDay;
+		hour := st.wHour; minute := st.wMinute; second := st.wSecond
+	END GetModDate;
+
+	PROCEDURE SetRootDir* (path: ARRAY OF CHAR);
+		VAR i: INTEGER;
+	BEGIN
+		dir.startup := NewLocator(path);
+		dir.startup.rootLen := 0; i := 0;
+		WHILE startupDir[i] # 0X DO INC(i) END;
+		startupLen := i
+	END SetRootDir;
+
+	PROCEDURE GetName (VAR p: WinApi.PtrWSTR; VAR i: INTEGER; OUT name, opt: FullName);
+		VAR ch, tch: CHAR; j: INTEGER;
+	BEGIN
+		j := 0; ch := p[i]; tch := " ";
+		WHILE ch = " " DO INC(i); ch := p[i] END;
+		IF (ch = "'") OR (ch = '"') THEN tch := ch; INC(i); ch := p[i] END;
+		WHILE (ch >= " ") & (ch # tch) DO
+			name[j] := ch;
+			IF (ch >= "a") & (ch <= "z") OR (ch >= "à") & (ch <= "ö") OR (ch >= "ø") & (ch <= "þ") THEN ch := CAP(ch)
+			ELSIF ch = "-" THEN ch := "/"
+			END;
+			opt[j] := ch; INC(j); INC(i); ch := p[i]
+		END;
+		IF ch > " " THEN INC(i); ch := p[i] END;
+		WHILE (ch # 0X) & (ch <= " ") DO INC(i); ch := p[i] END;
+		name[j] := 0X; opt[j] := 0X
+	END GetName;
+
+	PROCEDURE Init;
+		VAR res, res1, i, j: INTEGER; path, opt, s: FullName; attr: SET; p: WinApi.PtrWSTR;
+			find: WinApi.HANDLE; fd: WinApi.WIN32_FIND_DATAW;
+	BEGIN
+		wildcard := "*"; NEW(dir);
+		res := WinApi.GetModuleFileNameW(0, path, LEN(path));
+		GetPath(path, startupDir);
+		dir.startup := NewLocator(startupDir);
+		dir.startup.rootLen := 0;
+		i := LEN(startupDir$); startupLen := i;
+		find := WinApi.FindFirstFileW(path, fd);
+		IF find # invalid THEN
+			appName := fd.cFileName$; res := WinApi.FindClose(find)
+		ELSE
+			INC(i); j := 0;
+			WHILE path[i] # 0X DO appName[j] := path[i]; INC(i); INC(j) END
+		END;
+		i := 0; j := -1;
+		WHILE appName[i] # 0X DO
+			IF appName[i] = "." THEN j := i END;
+			INC(i)
+		END;
+		IF j > 0 THEN appName[j] := 0X END;
+		p := WinApi.GetCommandLineW(); i := 0; res := 1;
+		REPEAT
+			GetName(p, i, path, opt);
+			IF opt = "/USE" THEN
+				GetName(p, i, path, opt);
+				res1 := WinApi.ExpandEnvironmentStringsW(path, s, LEN(s) - 2);
+				IF (res1 = 0) OR (res1 > LEN(s) - 2) THEN s := path ELSE path := s$ END;
+				attr := BITS(WinApi.GetFileAttributesW(s));
+				IF (attr # {0..MAX(SET)}) & (WinApi.FILE_ATTRIBUTE_DIRECTORY * attr # {}) THEN res := 0
+				ELSIF (path[1] = ":") & ((path[2] = 0X) OR (path[2] = "\") & (path[3] = 0X))
+					& (WinApi.GetDriveTypeW(s) >= 2) THEN res := 0
+				END
+			END
+		UNTIL (res = 0) OR (p[i] < " ");
+		IF serverVersion & (res = 0) THEN
+			i := LEN(path$);
+			IF (path[i-1] = "/") OR (path[i-1] = "\") THEN DEC(i); path[i] := 0X END;
+			dir.startup := NewLocator(path);
+			dir.startup.rootLen := i
+		END;
+		res := WinApi.GetTempPathW(LEN(path), path);
+		dir.temp := NewLocator(path);
+		Files.SetDir(dir)
+	END Init;
+
+BEGIN
+	Init
+END HostFiles.

BIN
BlackBox/Windows/Host/Mod/Registry.odc


+ 149 - 0
BlackBox/Windows/Host/Mod/Registry.txt

@@ -0,0 +1,149 @@
+MODULE HostRegistry;
+
+	(* THIS IS TEXT COPY OF Registry.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT WinApi, HostFiles, Dialog, Strings;
+	
+	VAR localeId*: INTEGER;
+
+	PROCEDURE ReadString* (
+		IN key: ARRAY OF CHAR; OUT str: ARRAY OF CHAR; VAR res: INTEGER
+	);
+		VAR r, len: INTEGER; sw, comp, appl, vers: WinApi.HANDLE;
+	BEGIN
+		res := WinApi.RegOpenKeyW(WinApi.HKEY_CURRENT_USER, "Software", sw);
+		IF res = 0 THEN
+			res := WinApi.RegOpenKeyW(sw, "Oberon", comp);
+			IF res = 0 THEN
+				res := WinApi.RegOpenKeyW(comp, Dialog.appName, appl);
+				IF res = 0 THEN
+					res := WinApi.RegOpenKeyW(appl, "CurrentVersion", vers);
+					IF res = 0 THEN
+						len := LEN(str);
+						res := WinApi.RegQueryValueW(vers, key, str, len);
+						r := WinApi.RegCloseKey(vers)
+					END;
+					r := WinApi.RegCloseKey(appl)
+				END;
+				r := WinApi.RegCloseKey(comp)
+			END;
+			r := WinApi.RegCloseKey(sw)
+		END
+	END ReadString;
+	
+	PROCEDURE ReadInt* (IN key: ARRAY OF CHAR; OUT x: INTEGER; OUT res: INTEGER);
+		VAR str: ARRAY 64 OF CHAR;
+	BEGIN
+		ReadString(key, str, res);
+		IF res = 0 THEN Strings.StringToInt(str, x, res) END;
+	END ReadInt;
+	
+	PROCEDURE ReadBool* (IN key: ARRAY OF CHAR; OUT x: BOOLEAN; OUT res: INTEGER);
+		VAR str: ARRAY 4 OF CHAR;
+	BEGIN
+		ReadString(key, str, res);
+		IF res = 0 THEN x := str = "1" END
+	END ReadBool;
+	
+	PROCEDURE ReadIntList* (IN key: ARRAY OF CHAR; OUT x: ARRAY OF INTEGER; OUT res: INTEGER);
+		VAR i, n, val, sig: INTEGER; str: ARRAY 256 OF CHAR;
+	BEGIN
+		ReadString(key, str, res);
+		IF res = 0 THEN
+			n := 0; i := 0;
+			WHILE str[i] # 0X DO
+				IF n >= LEN(x) THEN res := 2; RETURN END;
+				val := 0; sig := 1;
+				IF str[i] = "-" THEN sig := -1; INC(i) END;
+				WHILE (str[i] >= "0") & (str[i] <= "9") DO val := 10 * val + ORD(str[i]) - ORD("0"); INC(i) END;
+				x[n] := sig * val;
+				IF str[i] = "," THEN INC(i)
+				ELSIF str[i] # 0X THEN res := 1; RETURN
+				END;
+				INC(n)
+			END
+		END
+	END ReadIntList;
+	
+	PROCEDURE WriteString* (IN key: ARRAY OF CHAR; IN str: ARRAY OF CHAR);
+		VAR res: INTEGER; sw, comp, appl, vers: WinApi.HANDLE;
+	BEGIN
+		res := WinApi.RegCreateKeyW(WinApi.HKEY_CURRENT_USER, "Software", sw);
+		IF res = 0 THEN
+			res := WinApi.RegCreateKeyW(sw, "Oberon", comp);
+			IF res = 0 THEN
+				res := WinApi.RegCreateKeyW(comp, Dialog.appName, appl);
+				IF res = 0 THEN
+					res := WinApi.RegCreateKeyW(appl, "CurrentVersion", vers);
+					IF res = 0 THEN
+						res := WinApi.RegSetValueW(vers, key, WinApi.REG_SZ, str, LEN(str$) * 2)
+					END;
+					res := WinApi.RegCloseKey(appl)
+				END;
+				res := WinApi.RegCloseKey(comp)
+			END;
+			res := WinApi.RegCloseKey(sw)
+		END
+	END WriteString;
+	
+	PROCEDURE WriteInt* (IN key: ARRAY OF CHAR; x: INTEGER);
+		VAR str: ARRAY 64 OF CHAR;
+	BEGIN
+		Strings.IntToString(x, str);
+		WriteString(key, str)
+	END WriteInt;
+	
+	PROCEDURE WriteBool* (IN key: ARRAY OF CHAR; x: BOOLEAN);
+	BEGIN
+		IF x THEN WriteString(key, "1") ELSE WriteString(key, "0") END
+	END WriteBool;
+	
+	PROCEDURE WriteIntList* (IN key: ARRAY OF CHAR; IN x: ARRAY OF INTEGER);
+		VAR i,j,  n: INTEGER; str: ARRAY 256 OF CHAR; s: ARRAY 16 OF CHAR;
+	BEGIN
+		n := 0; i := 0;
+		WHILE n < LEN(x) DO
+			IF (n > 0) & (i < LEN(str)) THEN str[i] := ","; INC(i) END;
+			Strings.IntToString(x[n], s); j := 0;
+			WHILE (s[j] # 0X) & (i < LEN(str)) DO str[i] := s[j]; INC(i); INC(j) END;
+			INC(n)
+		END;
+		IF i < LEN(str) THEN str[i] := 0X ELSE str[LEN(str) - 1] := 0X END;
+		WriteString(key, str)
+	END WriteIntList;
+	
+
+	PROCEDURE ReadMeasure;
+		VAR res, len: INTEGER; cp, int: WinApi.HANDLE; str: ARRAY 4 OF CHAR;
+	BEGIN
+		res := WinApi.GetProfileIntW("intl", "iMeasure", 1);
+		Dialog.metricSystem := res = 0
+	END ReadMeasure;
+	
+	PROCEDURE Init;
+		VAR name, bname: Dialog.String; res, i, v: INTEGER;
+	BEGIN
+		v := WinApi.GetVersion();
+		localeId := 1024;	(* user default *)
+		name := HostFiles.appName$;
+		bname := "BLACKBOX"; i := 0;
+		WHILE (i < 8) & (CAP(name[i]) = bname[i]) DO INC(i) END;
+		IF i = 8 THEN
+			name := "BlackBox"
+		ELSIF (v < 0) & (v MOD 256 < 4) THEN
+			i := 1;
+			WHILE name[i] # 0X DO
+				IF (name[i] >= "A") & (name[i] <= "Z") THEN name[i] := CHR(ORD(name[i]) + ORD("a") - ORD("A")) END;
+				INC(i)
+			END
+		END;
+		Dialog.appName := name$;
+		Dialog.version := 16;
+		Dialog.Call("Startup.Setup", "", res);
+		ReadMeasure
+	END Init;
+
+BEGIN
+	Init
+END HostRegistry.

BIN
BlackBox/Windows/dev0.exe


+ 0 - 2
BlackBox/build

@@ -117,5 +117,3 @@ DevCompiler.CompileThis XhtmlEntitySets XhtmlWriters XhtmlStdFileWriters XhtmlTe
 
 DevCompiler.CompileThis ObxHello0 ObxPi ObxRandom ObxTrap
 DATA
-
-

+ 3 - 3
BlackBox/build-dev0

@@ -25,17 +25,17 @@ Dev0Compiler.Compile('Dev0/Mod', 'CPV486.txt')
 
 Dev0Compiler.Compile('Dev0/Mod', 'Compiler.txt')
 Dev0Compiler.Compile('Dev0/Mod', 'ElfLinker16.txt')
+Dev0Compiler.Compile('Dev0/Mod', 'Linker.txt')
 
 Dev0Compiler.Compile('Host/Mod', 'Files.txt')
 Dev0Compiler.Compile('Host/Mod', 'Console.txt')
 
-### simple dev interpreter (include Dev0Compiler and Dev0ElfLinker)
+### simple dev interpreter (include Dev0Compiler, Dev0ElfLinker and Dev0Linker)
 
 Dev0Compiler.Compile('', 'Views.txt')
 Dev0Compiler.Compile('Std/Mod', 'Interpreter.txt')
 
 Dev0Compiler.Compile('Dev0/Mod', 'Interp.txt')
 
-# Dev0ElfLinker.LinkDll('libBB0.so := Kernel+ Kernel_so_init# Console Math Strings HostConsole Files HostFiles Dev0CPM Dev0CPT Dev0CPS Dev0CPH Dev0CPB Dev0CPP Dev0CPE Dev0CPL486 Dev0CPC486 Dev0CPV486 Dev0Compiler Dev0ElfLinker Dialog Meta Views StdInterpreter Dev0Interp#')
-Dev0ElfLinker.LinkDll('libBB0.so := Kernel+ Console Math Strings HostConsole Files HostFiles Dev0CPM Dev0CPT Dev0CPS Dev0CPH Dev0CPB Dev0CPP Dev0CPE Dev0CPL486 Dev0CPC486 Dev0CPV486 Dev0Compiler Dev0ElfLinker Dialog Meta Views StdInterpreter Dev0Interp#')
+Dev0ElfLinker.LinkDll('libBB0.so := Kernel+ Console Math Strings HostConsole Files HostFiles Dev0CPM Dev0CPT Dev0CPS Dev0CPH Dev0CPB Dev0CPP Dev0CPE Dev0CPL486 Dev0CPC486 Dev0CPV486 Dev0Compiler Dev0ElfLinker Dev0Linker Dialog Meta Views StdInterpreter Dev0Interp')
 DATA

+ 1 - 1
BlackBox/switch-os

@@ -9,7 +9,7 @@ none() {
 	rm -rf \
 		System/Mod/Kernel.odc System/Mod/Kernel.txt System/Code/Kernel.ocf System/Sym/Kernel.osf \
 		Code/Kernel.ocf Sym/Kernel.osf \
-		Host Win Lin BlackBox blackbox.exe BlackBox.exe *.so dev0
+		Host Win Lin *.exe *.so BlackBox dev0
 }
 
 obsd() {

+ 9 - 0
README

@@ -31,6 +31,8 @@ Files:
 			System/Rsrc/*
 			Text/*
 			Xhtml
+			Windows/Host/Mod/Files.odc (HostFiles)
+			Windows/Host/Mod/Registry.odc (HostRegistry)
 		OpenBUGS:
 			Dev/Mod/ElfLinker16.odc
 			Dev/Docu/ElfLinker.odc
@@ -77,6 +79,8 @@ Files:
 				stdin -> SYSTEM.ADR(__sF[0])
 		Linux/Host/Mod/Console.odc:
 			OpenBUGS Lin/Mod/Console.odc
+		Windows/Host/Mod/Console.odc:
+			OpenBUGS Lin/Mod/Console.odc ported to Windows
 		OpenBSD/Lin/Mod/Libc.txt:
 			OpenBUGS Lin/Mod/Libc.odc:
 				OpenBSD-specific
@@ -89,11 +93,15 @@ Files:
 		Linux/Host/Mod/Dates.odc: from http://oberoncore.ru/
 		OpenBSD/Host/Mod/Dates.odc:
 			Linux/Host/Mod/Dates.odc: OpenBSD-specific
+		Windows/Host/Mod/Dates.odc:
+			BlackBox 1.6-rc6 DatesHook from HostDialog
 		Dev0/Mod
 			CP*
 				BlackBox 1.6-rc6 Dev CP* modified to not depend on Dates, Texts etc.
 			Compiler.odc:
 				modified original BlackBox Dev/Mod/Compiler.odc
+			Linker.odc:
+				modified original BlackBox Dev/Mod/Linker.odc
 			ElfLinker16.odc:
 				modified OpenBUGS Dev/Mod/ElfLinker16.odc
 		HostTextConv.odc:
@@ -107,6 +115,7 @@ Files:
 
 		{OpenBSD,Linux}/libBB.so: compiled and linked shared library to run BlackBox
 		{OpenBSD,Linux}/libBB0.so: compiled and linked shared library to run simple development interpreter
+		Windows/dev0.exe: compiled and linked simple development interpreter
 
 		Views.odc: minimal Views implementation required to compile StdInterpreter
 		HostFonts.odc, HostDialog.odc, HostWindows.odc: simple Hosts implementation