basic support for 64-bit IO

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

source/IO64.Files.Mod

@@ -0,0 +1,1537 @@
+(* Aos, Copyright 2001, Pieter Muller, ETH Zurich *)
+
+MODULE Files;	(* pjm *)
+
+(** Aos file system base. *)
+
+IMPORT SYSTEM, Streams, KernelLog, Modules, Kernel, Commands;
+
+CONST
+	(** Volume & file flags *)
+	ReadOnly* = 0;
+
+	(** Volume flags *)
+	Removable* = 1;
+	Boot* = 2;
+
+	(** File flags *)
+	Directory* = 1;
+	Hidden* = 2;
+	System* = 3;
+	Archive* = 4;
+	Temporary* = 5;
+
+	Ok* = 0;
+
+	(* Volume level errors *)
+	ReadOnlyError = 2901;		(* Tried to modify read-only volume. Causes HALT *)
+	VolumeFull = 2902;			(* Tried to allocate block on full volume. Causes HALT *)
+	InvalidAdr= 2903;			(* Block address outside of volume. Causes HALT *)
+
+	(* File level errors *)
+	VolumeReadOnly* = 2905; 	(** Cannot modify read-only volume *)
+	FsNotFound* = 2906; 		(** File system not found *)
+	FileAlreadyExists* = 2908;	(** File already exists *)
+	BadFileName* = 2909;		(** Bad file name *)
+	FileNotFound* = 2910;		(** File not found *)
+
+	EnumSize* = 0; EnumTime* = 1;	(** Enumerate flags. *)
+
+	PrefixLength* = 16;	(** maximum length of a file system prefix. *)
+	NameLength* = 256;	(** maximum length of a file name. *)
+
+	Trace = FALSE;
+
+	WriteError = 2907;
+
+	DefaultWriterSize = 4096;
+	DefaultReaderSize = 4096;
+
+	PathDelimiter* = "/";	(** Path delimiter *)
+
+	BufferSize = 32*1024; 	(* Buffersize for file copy operation *)
+
+	SetSize = MAX (SET) + 1;
+
+	(* file system behaviour flags *)
+	NeedsPrefix* = 0; (* if no prefix given, then this file system cannot handle it, to prevent file systems from being in the search path *)
+
+TYPE
+	Position* = Streams.Position;
+	TSize* = LONGINT;
+
+TYPE
+(** All record fields are read-only for users, and read-write for extenders. *)
+
+	FileName* = ARRAY PrefixLength+NameLength OF CHAR;
+
+		(** A rider points to some location in a file, where reading and writing will be done. *)
+	Rider* = RECORD	(** not shareable between multiple processes *)
+		(* the rider must be a record, otherwise the Oberon text system will not work *)
+		eof*: BOOLEAN;	(** has end of file been passed *)
+		res*: Streams.BufferOffset;	(** leftover byte count for ReadBytes/WriteBytes *)
+			(** private fields for implementors *)
+		apos*: Streams.Position;
+		bpos*: LONGINT;
+		hint*: Hint;
+		file*: File;
+		fs*: FileSystem;
+	END;
+
+TYPE
+
+	(** Reader for buffered reading of a file via Streams.Read* procedures.  See OpenReader. *)
+	Reader* = OBJECT (Streams.Reader)	(** not sharable between multiple processes *)
+	VAR
+		file : File;
+		r: Rider;
+
+		PROCEDURE Receive(VAR buf: ARRAY OF CHAR; ofs, size, min: Streams.BufferOffset; VAR len: Streams.BufferOffset; VAR res: WORD);
+		BEGIN
+			file.ReadBytes(r, buf, ofs, size);
+			len := size - r.res;
+			IF len >= min THEN res := Streams.Ok ELSE res := Streams.EOF (* end of file *) END
+		END Receive;
+
+		PROCEDURE CanSetPos*() : BOOLEAN;
+		BEGIN
+			RETURN TRUE;
+		END CanSetPos;
+
+		PROCEDURE SetPos*(pos : Streams.Position);
+		BEGIN
+			file.Set(r, pos);
+			Reset;
+			received := pos; (* this effects that Streams.Reader.Pos() returns the correct location in the file *)
+		END SetPos;
+
+		PROCEDURE &InitFileReader*(file : File; pos: Streams.Position);
+		BEGIN
+			ASSERT(file # NIL);
+			SELF.file := file;
+			file.Set(r, pos);
+			received := pos; (* this effects that Streams.Reader.Pos() returns the correct location in the file *)
+			InitReader(SELF.Receive, DefaultReaderSize);
+		END InitFileReader;
+
+	END Reader;
+
+TYPE
+
+	(** Writer for buffered writing of a file via Streams.Write* procedures.  See OpenWriter. *)
+	Writer* = OBJECT (Streams.Writer)	(** not sharable between multiple processes *)
+	VAR
+		file : File;
+		r: Rider;
+
+		PROCEDURE Send(CONST buf: ARRAY OF CHAR; ofs, len: Streams.BufferOffset; propagate: BOOLEAN; VAR res: WORD);
+		BEGIN
+			r.file.WriteBytes(r, buf, ofs, len);
+			IF propagate THEN r.file.Update END;
+			IF r.res = 0 THEN res := Streams.Ok ELSE res := WriteError (* not all bytes written *) END
+		END Send;
+
+		PROCEDURE CanSetPos*() : BOOLEAN;
+		BEGIN
+			RETURN TRUE;
+		END CanSetPos;
+
+		PROCEDURE SetPos*(pos : Streams.Position);
+		BEGIN
+			Update;
+			file.Set(r, pos);
+			Reset;
+		END SetPos;
+
+		PROCEDURE Pos*(): Streams.Position;
+		BEGIN
+			Update;
+			RETURN file.Pos(r)
+		END Pos;
+
+		PROCEDURE &InitFileWriter*(file: File; pos: Streams.Position);
+		BEGIN
+			ASSERT(file # NIL);
+			SELF.file := file;
+			file.Set(r, pos);
+			InitWriter(SELF.Send, DefaultWriterSize);
+		END InitFileWriter;
+
+	END Writer;
+
+	Prefix* = ARRAY PrefixLength OF CHAR;
+
+	Address* = LONGINT;	(** Volume block address [1..size] *)
+
+	Hint* = POINTER TO RECORD END;	(** for use by file system implementors. *)
+
+	Bytes2 = ARRAY 2 OF CHAR;
+	Bytes4 = ARRAY 4 OF CHAR;
+	Bytes8 = ARRAY 8 OF CHAR;
+
+TYPE
+(** Volume is the base type of all volumes.  It provides operations on an abstract array of file system data blocks of blockSize bytes, numbered from 1 to size.  It is mainly used by file system implementations. *)
+
+	Volume* = OBJECT	(** shareable *)
+		VAR
+			size*: LONGINT;	(** size in blocks *)
+			blockSize*: LONGINT;	(** block size in bytes *)
+			flags*: SET;	(** ReadOnly, Removable, Boot *)
+			name*: ARRAY 32 OF CHAR;	(** descriptive name - e.g. for matching with Partitions.Show *)
+
+			map: POINTER TO ARRAY OF SET;	(* Block allocation table *)
+			used: LONGINT;	(* used blocks *)
+			reserved: LONGINT;	(* blocks reserved for system *)
+
+		PROCEDURE AllocBlock*(hint: Address; VAR adr: Address);
+		BEGIN {EXCLUSIVE}
+			IF ReadOnly IN flags THEN HALT(ReadOnlyError) END;
+			IF size - used <= reserved THEN HALT(VolumeFull) END;
+			ASSERT(hint >= 0);
+			IF hint > size THEN hint := 0 END;
+			hint := hint - hint MOD SetSize; (* in order to make sure that hint is hit when increasing by SetSize *)
+			adr := hint+1;
+			LOOP
+				IF adr > size THEN adr := 0 END;
+				IF (adr MOD SetSize = 0) & (map[adr DIV SetSize] = {MIN(SET)..MAX(SET)}) THEN
+					INC(adr,SetSize);
+				ELSIF (adr MOD SetSize) IN map[adr DIV SetSize] THEN
+					INC(adr) (* Block in use *)
+				ELSE
+					INCL(map[adr DIV SetSize], adr MOD SetSize);
+					EXIT
+				END;
+				IF adr = hint THEN HALT(VolumeFull) END
+			END;
+			INC(used)
+		END AllocBlock;
+
+		PROCEDURE FreeBlock*(adr: Address);
+		BEGIN {EXCLUSIVE}
+			IF (adr < 1) OR (adr > size) THEN HALT(InvalidAdr) END;
+			IF ReadOnly IN flags THEN HALT(ReadOnlyError) END;
+			EXCL(map[adr DIV SetSize], adr MOD SetSize);
+			DEC(used)
+		END FreeBlock;
+
+		PROCEDURE FreeBlocks*(CONST a: ARRAY OF Address; ofs, len: TSize);
+		VAR i: SIZE;  adr: Address;
+		BEGIN {EXCLUSIVE}
+			IF ReadOnly IN flags THEN HALT(ReadOnlyError) END;
+			FOR i := ofs TO ofs + len -1 DO
+				adr := a[i];
+				IF (adr = 0 ) THEN (* do nothing -- error should have been handled outside *)
+				ELSE 
+					IF (adr < 1) OR (adr > size) THEN HALT(InvalidAdr) END;
+					EXCL(map[adr DIV SetSize], adr MOD SetSize);
+					DEC(used);
+				END;
+			END;
+		END FreeBlocks;
+
+		PROCEDURE MarkBlock*(adr: Address);
+		BEGIN {EXCLUSIVE}
+			IF (adr < 1) OR (adr > size) THEN HALT(InvalidAdr) END;
+			IF ReadOnly IN flags THEN HALT(ReadOnlyError) END;
+			INCL(map[adr DIV SetSize], adr MOD SetSize);
+			INC(used)
+		END MarkBlock;
+		
+		PROCEDURE MarkBlocks*(CONST a: ARRAY OF Address; ofs, len: TSize);
+		VAR i: SIZE;  adr: Address;
+		BEGIN {EXCLUSIVE}
+			IF ReadOnly IN flags THEN HALT(ReadOnlyError) END;
+			FOR i := ofs TO ofs + len -1 DO
+				adr := a[i];
+				IF (adr = 0 ) THEN (* do nothing -- error should have been handled outside *)
+				ELSE 
+					IF (adr < 1) OR (adr > size) THEN HALT(InvalidAdr) END;
+					INCL(map[adr DIV SetSize], adr MOD SetSize);
+					INC(used);
+				END;
+			END;
+		END MarkBlocks;
+
+		PROCEDURE Marked*(adr: Address): BOOLEAN;
+		BEGIN {EXCLUSIVE}
+			IF (adr < 1) OR (adr > size) THEN HALT(InvalidAdr) END;
+			IF ReadOnly IN flags THEN HALT(ReadOnlyError) END;
+			RETURN (adr MOD SetSize) IN map[adr DIV SetSize]
+		END Marked;
+
+		PROCEDURE Available*(): LONGINT;
+		BEGIN {EXCLUSIVE}
+			RETURN size-used
+		END Available;
+
+		PROCEDURE GetBlock*(adr: LONGINT; VAR blk: ARRAY OF CHAR);
+		BEGIN HALT(301) END GetBlock;	(* abstract *)
+
+		PROCEDURE PutBlock*(adr: LONGINT; VAR blk: ARRAY OF CHAR);
+		BEGIN HALT(301) END PutBlock;	(* abstract *)
+
+		(* FIX: This procedure can not be declared exclusive, because it will be overridden by an exclusive procedure in the actual implementation, from where it will be supercalled.  This could be a good example for allowing recursive locks, or an example of where an alternative for overriding methods is needed. In this case the procedure is only called from the exclusive overridden procedure, so it is not a real problem (although it is ugly). *)
+		PROCEDURE Finalize*;
+		BEGIN
+			map := NIL; size := 0; blockSize := 0
+		END Finalize;
+
+		(** Init procedure for private data of above methods only.  If the above methods are not required, this procedure should not be called, and the volume fields should be initialized directly.  The flags parameter defines the volume flags, the size parameter its size, and the reserved parameter says how many blocks are reserved for the system (out of disk space trap occurs when less than this amount of blocks are present). *)
+
+		PROCEDURE Init*(flags: SET; size, reserved: LONGINT);
+		VAR maplen: LONGINT;
+		BEGIN
+			SELF.flags := flags; SELF.size := size; SELF.reserved := reserved;
+			IF ~(ReadOnly IN flags) THEN
+				maplen := (size + SetSize) DIV SetSize;
+				NEW(map, maplen);
+				WHILE maplen > 0 DO DEC(maplen); map[maplen] := {} END;
+				INCL(map[0], 0);	(* reserve sector 0 (illegal to use) *)
+				used := 0
+			ELSE
+				used := size
+			END
+		END Init;
+
+	END Volume;
+
+TYPE
+	FileSystem* = OBJECT	(** shareable *)
+		VAR
+			next: FileSystem;	(* list of known file systems *)
+			prefix*: Prefix;	(** mount prefix *)
+			desc*: ARRAY 32 OF CHAR;	(** description of file system *)
+			vol*: Volume;	(** underlying volume, if any (a boot FS must have a volume) *)
+			flags*: SET; (* flags like propagate prefix / can process  files without prefix *)
+
+		(** Create a new file with the specified name.  End users use Files.New instead. *)
+
+		PROCEDURE New0*(name: ARRAY OF CHAR): File;
+		BEGIN HALT(301) END New0;	(* abstract *)
+
+		(** Open an existing file. The same file descriptor is returned if a file is opened multiple times.  End users use Files.Old instead. *)
+
+		PROCEDURE Old0*(name: ARRAY OF CHAR): File;
+		BEGIN HALT(301) END Old0;	(* abstract *)
+
+		(** Delete a file. res = 0 indicates success.  End users use Files.Delete instead. *)
+
+		PROCEDURE Delete0*(name: ARRAY OF CHAR; VAR key, res: LONGINT);
+		BEGIN HALT(301) END Delete0;	(* abstract *)
+
+		(** Rename a file. res = 0 indicates success.  End users use Files.Rename instead. *)
+
+		PROCEDURE Rename0*(old, new: ARRAY OF CHAR; f: File; VAR res: WORD);
+		BEGIN HALT(301) END Rename0;	(* abstract *)
+
+		(** Enumerate canonical file names. mask may contain * wildcards.  For internal use only.  End users use Enumerator instead. *)
+
+		PROCEDURE Enumerate0*(mask: ARRAY OF CHAR; flags: SET; enum: Enumerator);
+		BEGIN HALT(301) END Enumerate0;	(* abstract *)
+
+		(** Return the unique non-zero key of the named file, if it exists. *)
+
+		PROCEDURE FileKey*(name: ARRAY OF CHAR): LONGINT;
+		BEGIN HALT(301) END FileKey;	(* abstract *)
+
+		(** Create a new directory structure. May not be supported by the actual implementation.
+			End users use Files.CreateDirectory instead.*)
+
+		PROCEDURE CreateDirectory0*(name: ARRAY OF CHAR; VAR res: WORD);
+		BEGIN res := -1	(* not supported *)
+		END CreateDirectory0;
+
+		(** Remove a directory. If force=TRUE, any subdirectories and files should be automatically deleted.
+			End users use Files.RemoveDirectory instead. *)
+
+		PROCEDURE RemoveDirectory0*(name: ARRAY OF CHAR; force: BOOLEAN; VAR key, res: LONGINT);
+		BEGIN res := -1	(* not supported *)
+		END RemoveDirectory0;
+
+		(** Finalize the file system. *)
+
+		PROCEDURE Finalize*;
+		BEGIN	(* see note in Volume.Finalize *)
+			vol := NIL
+		END Finalize;
+
+		(* default implementation using an enumerator *)
+		PROCEDURE Has*(CONST name: ARRAY OF CHAR; VAR fullName: ARRAY OF CHAR; VAR flags: SET): BOOLEAN;
+		VAR enum: Enumerator; time, date: LONGINT; size: Streams.Position;
+		BEGIN
+			NEW(enum);
+			enum.Open(name,{});
+			IF enum.HasMoreEntries() & enum.GetEntry(fullName, flags, time, date, size) THEN
+				RETURN TRUE
+			ELSE
+				RETURN FALSE
+			END;
+		END Has;
+
+(* GC
+		PROCEDURE Purge*(f: File);	(* race! *)
+		BEGIN HALT(301) END Purge;	(* by default not allowed to purge files *)
+*)
+
+	END FileSystem;
+
+	FileSystemTable* = POINTER TO ARRAY OF FileSystem;
+
+TYPE
+	File* = OBJECT	(** sharable *)
+		VAR
+				(** private fields for implementors *)
+			flags*: SET;			(** (read-only!) file-specific flags, i.e. Directory. *)
+			key*: LONGINT;	(* unique id for registered file, never 0 *)
+			fs*: FileSystem;	(* file system containing file *)
+
+		(** Position a Rider at a certain position in a file. Multiple Riders can be positioned at different locations in a file. A Rider cannot be positioned beyond the end of a file. *)
+
+		PROCEDURE Set*(VAR r: Rider; pos: Streams.Position);
+		BEGIN HALT(301) END Set;	(* abstract *)
+
+		(** Return the offset of a Rider positioned on a file. *)
+
+		PROCEDURE Pos*(VAR r: Rider): Streams.Position;
+		BEGIN HALT(301) END Pos;	(* abstract *)
+
+		(** Read a byte from a file, advancing the Rider one byte further.  R.eof indicates if the end of the file has been passed. *)
+
+		PROCEDURE Read*(VAR r: Rider; VAR x: CHAR);
+		BEGIN HALT(301) END Read;	(* abstract *)
+
+		(** Read a sequence of len bytes into the buffer x at offset ofs, advancing the Rider. Less bytes will be read when reading over the end of the file. r.res indicates the number of unread bytes. x must be big enough to hold all the bytes. *)
+
+		PROCEDURE ReadBytes*(VAR r: Rider; VAR x: ARRAY OF CHAR; ofs, len: Streams.BufferOffset);
+		BEGIN HALT(301) END ReadBytes;	(* abstract *)
+
+		(** Write a byte into the file at the Rider position, advancing the Rider by one. *)
+
+		PROCEDURE Write*(VAR r: Rider; x: CHAR);
+		BEGIN HALT(301) END Write;	(* abstract *)
+
+		(** Write the buffer x containing len bytes (starting at offset ofs) into a file at the Rider position. *)
+
+		PROCEDURE WriteBytes*(VAR r: Rider; CONST x: ARRAY OF CHAR; ofs, len: Streams.BufferOffset);
+		BEGIN HALT(301) END WriteBytes;	(* abstract *)
+
+		(** Return the current length of a file. *)
+
+		PROCEDURE Length*(): Streams.Position;
+		BEGIN HALT(301) END Length;	(* abstract *)
+
+		(** Return the time (t) and date (d) when a file was last modified. *)
+
+		PROCEDURE GetDate*(VAR t, d: LONGINT);
+		BEGIN HALT(301) END GetDate;	(* abstract *)
+
+		(** Set the modification time (t) and date (d) of a file. *)
+
+		PROCEDURE SetDate*(t, d: LONGINT);
+		BEGIN HALT(301) END SetDate;	(* abstract *)
+
+		(** Get file attributes. *)
+		PROCEDURE GetAttributes*(): SET;
+		BEGIN HALT(301) END GetAttributes; (* abstract *)
+
+		(** Set file attributes. *)
+		PROCEDURE SetAttributes*(flags: SET);
+		BEGIN HALT(301) END SetAttributes; (* abstract *)
+
+		(** Return the canonical name of a file. *)
+		PROCEDURE GetName*(VAR name: ARRAY OF CHAR);
+		BEGIN HALT(301) END GetName;	(* abstract *)
+
+		(** Register a file created with New in the directory, replacing the previous file in the directory with the same name. The file is automatically updated.  End users use Files.Register instead. *)
+		PROCEDURE Register0*(VAR res: WORD);
+		BEGIN HALT(301) END Register0;	(* abstract *)
+
+		(** Flush the changes made to a file from its buffers. Register0 will automatically update a file. *)
+
+		PROCEDURE Update*;
+		BEGIN HALT(301) END Update;	(* abstract *)
+
+		(*
+			Usually, in Oberon a file is not closed explicitly but by a call to finalizers by the garbage colloector.
+			However, for systems running in a host environment such as WinAos or UnixAos, explicitly closing a file may release files/handles that otherwise are blocked by the system.
+			Close is not necessarily implemented by a file system, therefore a call to Close may or may not have any effect.
+			Implementers of Close have to make sure that a call to close does not possibly contradict with file finalization.
+		*)
+		PROCEDURE Close*;
+		BEGIN
+			(* abstract, potentially empty *)
+		END Close;
+
+	END File;
+
+TYPE
+	Enumerator* = OBJECT	(** not shareable *)
+		VAR
+			r: Rider;	(* data is stored in an anonymous file, because it is potentially very long *)
+			adding: BOOLEAN;	(* prevent user calls of PutEntry *)
+			size-: LONGINT;	(** total number of entries *)
+
+		(** Open an enumerator and enumerate the files that match mask. *)
+
+		PROCEDURE Open*(mask: ARRAY OF CHAR; flags: SET);
+		BEGIN
+			r.file := New("");
+			r.file.Set(r, 0);
+			size := 0;
+			adding := TRUE;
+			Enumerate(mask, flags, SELF);
+			adding := FALSE;
+			r.file.Set(r, 0)
+		END Open;
+
+		(** reset the enumerator to the first entry *)
+
+		PROCEDURE Reset*;
+		BEGIN
+			r.file.Set(r, 0)
+		END Reset;
+
+		(** returns TRUE if the enumerator contains more entries *)
+
+		PROCEDURE HasMoreEntries*(): BOOLEAN;
+		BEGIN
+			RETURN r.file.Pos(r) < r.file.Length()
+		END HasMoreEntries;
+
+		(** Get one entry from the enumerator. *)
+
+		PROCEDURE GetEntry*(VAR name: ARRAY OF CHAR; VAR flags: SET; VAR time, date: LONGINT; VAR size: Streams.Position): BOOLEAN;
+		VAR len: LONGINT;
+		BEGIN
+			ReadNum(r, len);
+			IF ~r.eof THEN
+				name[len] := 0X;	(* index check *)
+				r.file.ReadBytes(r, name, 0, len);
+				ReadSet(r, flags); ReadNum(r, time); ReadNum(r, date); ReadFileSize(r, size);
+				ASSERT(~r.eof)
+			END;
+			RETURN ~r.eof
+		END GetEntry;
+
+		(** Close the enumerator. *)
+
+		PROCEDURE Close*;
+		BEGIN
+			(*r.fs.Purge(r.file);*)
+			r.hint := NIL; r.file := NIL; r.fs := NIL
+		END Close;
+
+		(** For internal use only. *)
+
+		PROCEDURE PutEntry*(VAR name: ARRAY OF CHAR; flags: SET; time, date: LONGINT; size:Streams.Position);
+		VAR len: LONGINT;
+		BEGIN
+			ASSERT(adding);
+			INC(SELF.size);
+			len := 0; WHILE name[len] # 0X DO INC(len) END;
+			WriteNum(r, len); r.file.WriteBytes(r, name, 0, len);
+			WriteSet(r, flags); WriteNum(r, time); WriteNum(r, date); WriteFileSize(r, size)
+		END PutEntry;
+
+	END Enumerator;
+
+TYPE
+	(* FinalizedCollection enumerator searching for a file by (fs,key). *)
+	FileSearcher = OBJECT
+		VAR fs: FileSystem; key: LONGINT; found: File;
+
+		PROCEDURE EnumFile(f: ANY; VAR cont: BOOLEAN);
+		BEGIN
+			WITH f: File DO
+				IF (f.fs = fs) & (f.key = key) THEN
+					found := f; cont := FALSE
+				END
+			END
+		END EnumFile;
+
+	END FileSearcher;
+
+TYPE
+		(** Parameters passed to volume and file system generator commands.  The str field contains a generic parameter string from the mount command.  The vol field returns the new volume from volume generators and passes the volume parameter to file system generators.  The prefix field contains the mount prefix, mainly for file system generators to add themselves with Files.Add. *)
+	Parameters* = OBJECT(Commands.Context)
+	VAR
+		vol*: Volume;	(** out parameter of volume generators and in parameter of file system generators. *)
+		prefix*: Prefix;
+	END Parameters;
+
+	FileSystemFactory* = PROCEDURE(context : Parameters);
+
+VAR
+	fsroot: FileSystem;	(* list of known file systems *)
+	files: Kernel.FinalizedCollection;	(* all open files - cleaned up by GC *)
+	seacher: FileSearcher;	(* enumerator shared by various procedures, protected with module EXCLUSIVE *)
+	fileClipboard : File; (* contains the pointer to the file in the clipboard opened with Copy *)
+
+(** Buffered reading and writing. *)
+
+(** Open a reader on a file at the specified position. *)
+
+PROCEDURE OpenReader*(VAR b: Reader; f: File; pos: Streams.Position);
+BEGIN
+	IF b = NIL THEN
+		NEW(b, f, pos)
+	ELSE
+		b.InitFileReader(f,pos)
+	END;
+END OpenReader;
+
+(** Open a writer on a file at the specified position.  Remember to call Streams.Update before registering or closing the file! *)
+
+PROCEDURE OpenWriter*(VAR b: Writer; f: File; pos: Streams.Position);
+BEGIN
+	NEW(b, f, pos)
+END OpenWriter;
+
+(** File name prefix support. *)
+
+(** Split fullname = ( prefix ":" name ) into prefix and name *)
+
+PROCEDURE SplitName*(fullname: ARRAY OF CHAR; VAR prefix, name: ARRAY OF CHAR);
+VAR i, j, len: SIZE;
+BEGIN
+	i := 0; WHILE (fullname[i] # ":") & (fullname[i] # 0X) DO INC(i) END;
+	IF (fullname[i] # ":") OR (i >= LEN(prefix)) THEN
+		COPY("", prefix); COPY(fullname, name);
+	ELSE
+		j := 0; WHILE j # i DO prefix[j] := fullname[j]; INC(j) END;
+		prefix[j] := 0X;
+		j := 0; INC(i); len := LEN(name)-1;
+		WHILE (j < len) & (fullname[i] # 0X) DO name[j] := fullname[i]; INC(j); INC(i) END;
+		name[j] := 0X
+	END
+END SplitName;
+
+(** Join prefix and name to fullname = ( prefix ":" name ) *)
+
+PROCEDURE JoinName*(prefix, name: ARRAY OF CHAR; VAR fullname: ARRAY OF CHAR);
+VAR i, j, len: SIZE;
+BEGIN
+	len := LEN(fullname)-1;
+	i := 0; WHILE (i < len) & (prefix[i] # 0X) DO fullname[i] := prefix[i]; INC(i) END;
+	IF (i < len) THEN fullname[i] := ":"; INC(i) END;
+	j := 0; WHILE (i < len) & (name[j] # 0X) DO fullname[i] := name[j]; INC(i); INC(j) END;
+	fullname[i] := 0X
+END JoinName;
+
+(** Split a pathname at the last PathDelimiter or ":" into path and filename = ( {path (PathDelimiter|":")} filename ) *)
+
+PROCEDURE SplitPath*(pathname: ARRAY OF CHAR; VAR path, name: ARRAY OF CHAR);
+VAR i, j, len: SIZE;
+BEGIN
+	i := 0; j := -1;
+	WHILE pathname[i] # 0X DO
+		IF (pathname[i] = PathDelimiter) OR (pathname[i] = ":") THEN j := i END;
+		INC(i)
+	END;
+	i := 0; len := LEN(path)-1;
+	WHILE (i < len) & (i < j) DO path[i] := pathname[i]; INC(i) END; path[i] := 0X;
+
+	IF pathname[i] = ":" THEN path[i] := ":"; path[i+1] := 0X;  END; (* fof  for correct splitting of filenames such as c:test into c: and test*)
+
+	INC(j); i := 0; len := LEN(name)-1;
+	WHILE (i < len) & (pathname[j] # 0X) DO name[i] := pathname[j]; INC(i); INC(j) END;
+	name[i] := 0X
+END SplitPath;
+
+(** Join path and file name = ( path PathDelimiter name ) *)
+
+PROCEDURE JoinPath*(path, name: ARRAY OF CHAR; VAR pathname: ARRAY OF CHAR);
+VAR i, j, len: SIZE;
+BEGIN
+	len := LEN(pathname)-1;
+	i := 0; WHILE (i < len) & (path[i] # 0X) DO pathname[i] := path[i]; INC(i) END;
+	IF ((i = 0) OR (pathname[i-1] # PathDelimiter)) & (i < len) THEN pathname[i] := PathDelimiter; INC(i) END;
+	j := 0; WHILE (i < len) & (name[j] # 0X) DO pathname[i] := name[j]; INC(i); INC(j) END;
+	pathname[i] := 0X
+END JoinPath;
+
+(** Split a filename at the last '.' into name and extension = ( name "." extension ) *)
+
+PROCEDURE SplitExtension*(filename: ARRAY OF CHAR; VAR name, extension: ARRAY OF CHAR);
+VAR i, j, len: SIZE;
+BEGIN
+	i := 0; j := 0;
+	WHILE filename[i] # 0X DO
+		IF filename[i] = "." THEN j := i END;
+		INC(i)
+	END;
+	IF (j = 0) & (filename[0] # ".") THEN (* no extension *)
+		COPY(filename, name); COPY("", extension)
+	ELSE
+		i := 0; len := LEN(name)-1;
+		WHILE (i < len) & (i < j) DO name[i] := filename[i]; INC(i) END; name[i] := 0X;
+		INC(j); i := 0; len := LEN(extension)-1;
+		WHILE (i < len) & (filename[j] # 0X) DO extension[i] := filename[j]; INC(i); INC(j) END;
+		extension[i] := 0X
+	END
+END SplitExtension;
+
+(** Join name and extension = ( name "." extension ) *)
+
+PROCEDURE JoinExtension*(name, extension: ARRAY OF CHAR; VAR filename: ARRAY OF CHAR);
+VAR i,j,len: SIZE;
+BEGIN
+	len := LEN(filename)-1;
+	i := 0; WHILE (i < len) & (name[i] # 0X) DO filename[i] := name[i]; INC(i) END;
+	IF ((i = 0) OR (filename[i-1] # ".")) & (i < len) THEN filename[i] := "."; INC(i) END;
+	j := 0; IF extension[0] = "." THEN INC(j) END;
+	WHILE (i < len) & (extension[j] # 0X) DO filename[i] := extension[j]; INC(i); INC(j) END;
+	filename[i] := 0X
+END JoinExtension;
+
+(** Append the path delimiter to path if path does not contain one *)
+
+PROCEDURE ForceTrailingDelimiter*(VAR path: ARRAY OF CHAR);
+VAR i: SIZE;
+BEGIN
+	i := 0; WHILE path[i] # 0X DO INC(i) END;
+	IF (i = 0) OR (path[i-1] # PathDelimiter) THEN
+		path[i] := PathDelimiter;
+		path[i+1] := 0X
+	END
+END ForceTrailingDelimiter;
+
+(** File system list support. *)
+
+PROCEDURE WriteFS(fs: FileSystem);
+BEGIN
+	IF Trace THEN
+		IF fs.vol # NIL THEN KernelLog.String(fs.vol.name); KernelLog.Char(" ") END;
+		KernelLog.String(fs.desc)
+	END
+END WriteFS;
+
+(** Add file system at end of list, with specified prefix, which must be unique. *)
+
+PROCEDURE Add*(fs: FileSystem; prefix: ARRAY OF CHAR);
+VAR p, c: FileSystem;
+BEGIN {EXCLUSIVE}
+	IF Trace THEN
+		KernelLog.Enter; KernelLog.String("Files: Adding "); WriteFS(fs); KernelLog.Exit
+	END;
+	COPY(prefix, fs.prefix);
+	p := NIL; c := fsroot;
+	WHILE c # NIL DO
+		ASSERT((c # fs) & (c.prefix # fs.prefix));	(* duplicate insertion not allowed *)
+		p := c; c := c.next
+	END;
+	IF p = NIL THEN fsroot := fs ELSE p.next := fs END;
+	fs.next := NIL
+END Add;
+
+PROCEDURE DeleteFS(fs: FileSystem);
+VAR p, c: FileSystem;
+BEGIN
+	p := NIL; c := fsroot;
+	WHILE c # fs DO p := c; c := c.next END;	(* fs must be in list *)
+	IF p = NIL THEN fsroot := c.next ELSE p.next := c.next END;
+	c.next := NIL
+END DeleteFS;
+
+(** Promote fs to the start of the list. *)
+
+PROCEDURE Promote*(fs: FileSystem);
+BEGIN {EXCLUSIVE}
+	DeleteFS(fs);
+	fs.next := fsroot; fsroot := fs
+END Promote;
+
+(** Remove the file system and finalize it. *)
+
+PROCEDURE Remove*(fs: FileSystem);
+VAR
+	enum: OBJECT
+		VAR count: LONGINT; fs: FileSystem;
+
+		PROCEDURE EnumFile(f: ANY; VAR cont: BOOLEAN);
+		BEGIN
+			WITH f: File DO
+				IF f.fs = fs THEN INC(count); f.Update(); f.fs := NIL END
+				(* if Update procedure calls back to this module deadlock can result *)
+			END
+		END EnumFile;
+
+	END;
+
+BEGIN {EXCLUSIVE}
+	IF Trace THEN
+		KernelLog.Enter; KernelLog.String("Files: Removing "); WriteFS(fs); KernelLog.Exit
+	END;
+	NEW(enum); enum.count := 0; enum.fs := fs;
+	files.Enumerate(enum.EnumFile);
+	IF enum.count # 0 THEN
+		KernelLog.Enter; KernelLog.String("Files: "); KernelLog.Int(enum.count, 1);
+		KernelLog.String(" open files");
+		IF fs.vol # NIL THEN
+			KernelLog.String(" on "); KernelLog.String(fs.vol.name)
+		END;
+		KernelLog.Exit
+	END;
+	fs.Finalize();	(* potential deadlock *)
+	DeleteFS(fs)
+END Remove;
+
+(* Find the file system with specified prefix. *)
+
+PROCEDURE FindFS(prefix: ARRAY OF CHAR): FileSystem;
+VAR fs: FileSystem;
+BEGIN
+	fs := fsroot; WHILE (fs # NIL) & (fs.prefix # prefix) DO fs := fs.next END;
+	RETURN fs
+END FindFS;
+
+(** Find file system with specified prefix. *)
+
+PROCEDURE This*(prefix: ARRAY OF CHAR): FileSystem;
+BEGIN {EXCLUSIVE}
+	RETURN FindFS(prefix)
+END This;
+
+(** Get a list of file systems. *)
+
+PROCEDURE GetList*(VAR list: FileSystemTable);
+VAR fs: FileSystem; n, i: LONGINT;
+BEGIN {EXCLUSIVE}
+	fs := fsroot; n := 0;
+	WHILE (fs # NIL) DO fs := fs.next; INC(n) END;
+	IF n # 0 THEN
+		NEW(list, n);
+		fs := fsroot;
+		FOR i := 0 TO n-1 DO
+			list[i] := fs; fs := fs.next
+		END
+	ELSE
+		list := NIL
+	END
+END GetList;
+
+(* GC
+PROCEDURE Collect(f: ANY);
+BEGIN
+	WITH f: File DO
+		IF (f.fs # NIL) & (f.fs.vol # NIL) & ~(ReadOnly IN f.fs.vol.flags) THEN
+			IF ~f.fs.Registered(f) THEN f.fs.Purge(f) END
+		END
+	END
+END Collect;
+*)
+
+(* Find file in open file list, or open and add it. *)
+
+PROCEDURE OpenOld(enum: FileSearcher; fs: FileSystem; VAR fname: ARRAY OF CHAR): File;
+VAR f: File; key: LONGINT;
+BEGIN
+	f := NIL;
+	IF (fs # NIL) & (fname # "") THEN
+		key := fs.FileKey(fname);
+		IF key # 0 THEN f := FindOpenFile(enum, fs, key) END;
+		IF f = NIL THEN	(* not found *)
+			f := fs.Old0(fname);
+			IF f # NIL THEN
+				ASSERT(f.key # 0);	(* key must be set *)
+				files.Add(f, NIL);
+(* GC
+				Heaps.RegisterFinalizer(f, Collect);	(* to do: use one finalizer for ordering *)
+*)
+			END
+		END
+	END;
+	RETURN f
+END OpenOld;
+
+(** Open an existing file, searching through the mounted file system list if no prefix is specified. *)
+
+PROCEDURE Old*(name: ARRAY OF CHAR): File;
+VAR fs: FileSystem; f: File; prefix: Prefix; fname: FileName;
+BEGIN {EXCLUSIVE}
+	f := NIL;
+	SplitName(name, prefix, fname);
+	IF prefix = "" THEN
+		fs := fsroot;
+		WHILE (fs # NIL) & (f = NIL) DO
+			IF ~(NeedsPrefix IN fs.flags) THEN (* fof *)
+			f := OpenOld(seacher, fs, fname);
+			END;
+			fs := fs.next
+		END
+	ELSE
+		f := OpenOld(seacher, FindFS(prefix), fname)
+	END;
+	RETURN f
+END Old;
+
+(** Create a new file.  If no prefix is specified, create the file on the first file system in the mounted list. *)
+
+PROCEDURE New*(name: ARRAY OF CHAR): File;
+VAR fs: FileSystem; f: File; prefix: Prefix; fname: FileName;
+BEGIN {EXCLUSIVE}
+	f := NIL; SplitName(name, prefix, fname);
+	IF prefix = "" THEN
+		fs := fsroot;	(* use default file system *)
+		IF fname = "" THEN	(* anonymous file on unspecified file system *)
+			WHILE (fs # NIL) & ((fs.vol = NIL) OR (fs.vol.flags * {Boot,ReadOnly} # {Boot})) DO
+				fs := fs.next	(* find a writable boot file system *)
+			END;
+			IF fs = NIL THEN fs := fsroot END	(* none found, relapse to default *)
+		END
+	ELSE
+		fs := FindFS(prefix);
+	END;
+	IF fs # NIL THEN
+		IF (fs.vol = NIL) OR ~(ReadOnly IN fs.vol.flags) THEN
+			f := fs.New0(fname);
+(* GC
+			IF f # NIL THEN
+				Heaps.RegisterFinalizer(f, Collect)
+			END
+*)
+		END
+	END;
+	RETURN f
+END New;
+
+(** Delete a file. res = 0 indicates success. *)
+
+PROCEDURE Delete*(VAR name: ARRAY OF CHAR; VAR res: WORD);
+VAR fs: FileSystem; f: File; key: LONGINT; prefix: Prefix; fname: FileName;
+BEGIN {EXCLUSIVE}
+	SplitName(name, prefix, fname);
+	IF prefix = "" THEN fs := fsroot ELSE fs := FindFS(prefix) END;
+
+	IF fs # NIL THEN
+		IF (fs.vol = NIL) OR ~(ReadOnly IN fs.vol.flags) THEN
+			fs.Delete0(fname, key, res);
+			IF key # 0 THEN
+				LOOP	(* remove all occurances of file (fs,key) from collection. *)
+					f := FindOpenFile(seacher, fs, key);
+					IF f = NIL THEN EXIT END;
+					files.Remove(f)
+				END
+			END
+		ELSE
+			res := VolumeReadOnly	(* can not modify read-only volume *)
+		END
+	ELSE
+		res := FsNotFound	(* file system not found *)
+	END
+END Delete;
+
+(* copies the file with the given name to the fileClipboard *)
+PROCEDURE Copy*(name: ARRAY OF CHAR; VAR res: WORD);
+VAR file: File;
+BEGIN
+	res := -1;
+	file := Old(name);
+	IF file = NIL THEN RETURN END;
+	fileClipboard := file;
+	res := 0;
+END Copy;
+
+(* pastes the fileClipboard into the file with the given name if it doesn't exist already *)
+PROCEDURE Paste*(name: ARRAY OF CHAR; VAR res: WORD);
+VAR writer : Writer;
+	reader : Reader;
+	file : File;
+	chunk : ARRAY 4096 OF CHAR;
+	len : Streams.BufferOffset;
+BEGIN
+	IF fileClipboard = NIL THEN RETURN END;
+	IF Old(name) # NIL THEN res := FileAlreadyExists;			(* File already exists *)
+	ELSE
+		file := New(name);
+		IF file = NIL THEN res := BadFileName; RETURN END;	(* Bad Filename *)
+		NEW(writer, file, 0);
+		NEW(reader, fileClipboard, 0);
+		WHILE (reader.res = Streams.Ok) DO
+			reader.Bytes(chunk, 0, LEN(chunk), len);
+			writer.Bytes(chunk, 0, len);
+		END;
+		writer.Update;
+		Register(file);
+		res := 0;
+	END;
+END Paste;
+
+(**
+ * Make a copy of a file
+ * @param source: Prefix, path and name of file to be copied
+ * @param destination: Prefix, path and name of file to be created
+ * @param overwrite: @in: Overwrite existing files? @out: Has an existing file been overwritten?
+ * @param res: @out: Result code
+ *)
+PROCEDURE CopyFile*(source, destination : ARRAY OF CHAR; VAR overwrite : BOOLEAN; VAR res : WORD);
+VAR
+	sprefix, dprefix : Prefix;
+	sname, dname, dpath, dfilename: FileName;
+	sPos, dPos : Rider;
+	sfs, dfs : FileSystem;
+	sfile, dfile : File;
+	buffer : ARRAY BufferSize OF CHAR;
+	i : Streams.Position;
+BEGIN
+	SplitName(source, sprefix, sname);
+	SplitName(destination, dprefix, dname);
+	BEGIN {EXCLUSIVE}
+		IF sprefix = "" THEN sfs := fsroot; ELSE sfs := FindFS(sprefix); END;
+		IF dprefix = "" THEN dfs := fsroot; ELSE dfs := FindFS(dprefix); END;
+
+		IF (sfs # NIL) & (dfs # NIL) THEN (* We found the file system *)
+			IF (dfs.vol = NIL) OR ~(ReadOnly IN dfs.vol.flags) THEN (* We may write to the target volume *)
+				sfile := OpenOld(seacher, sfs, sname);
+				IF sfile # NIL THEN (* We found the source file *)
+					SplitName(dname, dpath, dfilename);
+					IF (dfilename # "") THEN
+						dfile := OpenOld(seacher, dfs, dname);
+						IF (dfile = NIL) OR overwrite THEN (* We may write to the target file *)
+							IF dfile # NIL THEN overwrite := TRUE; ELSE overwrite := FALSE; END;
+							IF overwrite THEN
+								dfile.GetName(dname);
+								SplitName(dname, dprefix, dname);
+							END;
+							dfile := dfs.New0(dname);
+							IF dfile # NIL THEN (* We could create the target file *)
+								res := Ok;
+							ELSE res := BadFileName;
+							END;
+						ELSE res := FileAlreadyExists;
+						END;
+					ELSE res := BadFileName;
+					END;
+				ELSE res := FileNotFound;
+				END;
+			ELSE res :=VolumeReadOnly;
+			END;
+		ELSE res := FsNotFound;
+		END;
+	END;
+
+	IF res # Ok THEN RETURN END;
+
+	(* copy file content *)
+	sfile.Set(sPos, 0); dfile.Set(dPos, 0);
+	i := 0;
+	WHILE i < (sfile.Length() DIV BufferSize) DO
+		sfile.ReadBytes(sPos, buffer, 0, BufferSize);
+		dfile.WriteBytes(dPos, buffer, 0, BufferSize);
+		INC(i);
+	END;
+	sfile.ReadBytes(sPos, buffer, 0, Streams.BufferOffset(sfile.Length() MOD BufferSize));
+	dfile.WriteBytes(dPos, buffer, 0, Streams.BufferOffset(sfile.Length() MOD BufferSize));
+	dfile.Update;
+	Register(dfile); (* Will enter exclusive region *)
+END CopyFile;
+
+(** Rename a file. res = 0 indicates success. *)
+
+PROCEDURE Rename*(CONST old, new: ARRAY OF CHAR; VAR res: WORD);
+VAR
+	key: LONGINT; ofs, nfs: FileSystem; f: File; pold, pnew: Prefix;
+	fold, fnew: FileName;
+BEGIN {EXCLUSIVE}
+	SplitName(old, pold, fold);
+	SplitName(new, pnew, fnew);
+	IF pold = "" THEN ofs := fsroot ELSE ofs := FindFS(pold) END;
+	IF pnew = "" THEN nfs := fsroot ELSE nfs := FindFS(pnew) END;
+	IF (nfs # NIL) & (ofs = nfs) THEN
+		IF (nfs.vol = NIL) OR ~(ReadOnly IN nfs.vol.flags) THEN
+			key := nfs.FileKey(fold);
+			IF key # 0 THEN f := FindOpenFile(seacher, nfs, key) ELSE f := NIL END;
+			nfs.Rename0(fold, fnew, f, res)
+		ELSE
+			res := VolumeReadOnly	(* can not modify read-only volume *)
+		END
+	ELSE
+		res := FsNotFound	(* file system not found *)
+	END
+END Rename;
+
+(** Register a file created with New in the directory, replacing the previous file in the directory with the same name. The file is automatically closed. *)
+
+PROCEDURE Register*(f: File);
+VAR res: WORD;
+BEGIN {EXCLUSIVE}
+	IF f # NIL THEN
+		f.Register0(res);
+		IF res = 0 THEN	(* if register went ok (first time register) *)
+			ASSERT(f.key # 0);
+			files.Add(f, NIL)
+		END
+	END
+END Register;
+
+(** Create a directory structure. Directories are automatically registered. res=0 indicates success.
+	Use Files.RemoveDirectory to delete a directory *)
+PROCEDURE CreateDirectory*(path: ARRAY OF CHAR; VAR res: WORD);
+VAR prefix: Prefix; fs: FileSystem; fpath: FileName;
+BEGIN {EXCLUSIVE}
+	SplitName(path, prefix, fpath);
+	IF prefix = "" THEN fs := fsroot
+	ELSE fs := FindFS(prefix)
+	END;
+	IF fs # NIL THEN fs.CreateDirectory0(fpath, res)
+	ELSE res := -1
+	END
+END CreateDirectory;
+
+(** Remove a directory. res=0 indicates success. If force=TRUE, any files and subdirectories are automatically deleted. *)
+PROCEDURE RemoveDirectory*(path: ARRAY OF CHAR; force: BOOLEAN; VAR res: WORD);
+VAR prefix: Prefix; fs: FileSystem; f: File; key: LONGINT; fpath: FileName;
+BEGIN {EXCLUSIVE}
+	SplitName(path, prefix, fpath);
+	IF prefix = "" THEN fs := fsroot ELSE fs := FindFS(prefix) END;
+	IF fs # NIL THEN
+		IF (fs.vol = NIL) OR ~(ReadOnly IN fs.vol.flags) THEN
+			fs.RemoveDirectory0(fpath, force, key, res);
+			IF key # 0 THEN
+				LOOP	(* remove all aoccurances of file (fs,key) from collection. *)
+					f := FindOpenFile(seacher, fs, key);
+					IF f = NIL THEN EXIT END;
+					files.Remove(f)
+				END
+			END
+		ELSE
+			res := VolumeReadOnly	(* can not modify read-only volume *)
+		END
+	ELSE
+		res := FsNotFound	(* file system not found *)
+	END
+END RemoveDirectory;
+
+(* Enumerates files matching mask *)
+
+PROCEDURE Enumerate(VAR mask: ARRAY OF CHAR; flags: SET; enum: Enumerator);
+VAR
+	fs: FileSystem; ft: FileSystemTable; i: LONGINT;
+	prefix: Prefix; fmask: FileName;
+BEGIN
+	SplitName(mask, prefix, fmask);
+	IF prefix = "" THEN
+		GetList(ft);
+		IF ft # NIL THEN
+				(* FIX: deadlock possible if fs containing anonymous file does not allow concurrent Enumerate and Write *)
+			FOR i := 0 TO LEN(ft^)-1 DO
+				IF ~(NeedsPrefix IN ft[i].flags) THEN
+					ft[i].Enumerate0(fmask, flags, enum)
+				END;
+			END
+		END
+	ELSE
+		fs := This(prefix);
+		IF fs # NIL THEN fs.Enumerate0(fmask, flags, enum) END
+	END
+END Enumerate;
+
+PROCEDURE Exists*(CONST fileName: ARRAY OF CHAR; VAR fullName: ARRAY OF CHAR; VAR flags: SET): BOOLEAN;
+VAR
+	fs: FileSystem; ft: FileSystemTable; i: LONGINT;
+	prefix: Prefix;
+BEGIN
+	IF prefix = "" THEN
+		GetList(ft);
+		IF ft # NIL THEN
+				(* FIX: deadlock possible if fs containing anonymous file does not allow concurrent Enumerate and Write *)
+			FOR i := 0 TO LEN(ft^)-1 DO
+				IF ~(NeedsPrefix IN ft[i].flags) THEN
+					IF ft[i].Has(fileName, fullName, flags) THEN RETURN TRUE END;
+				END;
+			END
+		END
+	ELSE
+		fs := This(prefix);
+		RETURN fs.Has(fileName, fullName, flags);
+	END;
+	RETURN FALSE;
+END Exists;
+
+(* add a search path to the system *)
+PROCEDURE AddSearchPath*(context: Commands.Context);
+VAR cmd: ARRAY 32 OF CHAR; msg: ARRAY 256 OF CHAR;  res: WORD;
+BEGIN
+	(* preliminary implementation until we know how to solve this generically *)
+	IF Modules.ModuleByName("HostFiles") # NIL THEN
+		cmd := "HostFiles.AddSearchPath";
+	END;
+	IF cmd # "" THEN
+		Commands.Activate(cmd, context, {Commands.Wait}, res, msg);
+		IF res # 0 THEN context.error.String(msg); context.error.Ln; END;
+	END
+END AddSearchPath;
+
+(* add a search path to the system *)
+PROCEDURE SetWorkPath*(context: Commands.Context);
+VAR cmd: ARRAY 32 OF CHAR; msg: ARRAY 256 OF CHAR;  res: WORD;
+BEGIN
+	(* preliminary implementation until we know how to solve this generically *)
+	IF Modules.ModuleByName("HostFiles") # NIL THEN
+		cmd := "HostFiles.SetWorkPath";
+	END;
+	IF cmd # "" THEN
+		Commands.Activate(cmd, context, {Commands.Wait}, res, msg);
+		IF res # 0 THEN context.error.String(msg); context.error.Ln; END;
+	END
+END SetWorkPath;
+
+(* Find an open file. *)
+
+PROCEDURE FindOpenFile(enum: FileSearcher; fs: FileSystem; key: LONGINT): File;
+BEGIN	(* not exported, because of possible race condition *)
+	enum.fs := fs; enum.key := key; enum.found := NIL;
+	files.Enumerate(enum.EnumFile);
+	RETURN enum.found
+END FindOpenFile;
+
+(** Portable routines to read the standard Oberon types.  DEPRECATED, use Streams instead. *)
+
+PROCEDURE ReadSInt*(VAR r: Rider; VAR x: SHORTINT);
+BEGIN
+	r.file.Read(r, SYSTEM.VAL(CHAR, x))
+END ReadSInt;
+
+PROCEDURE ReadInt*(VAR r: Rider; VAR x: INTEGER);
+BEGIN
+	r.file.ReadBytes(r, SYSTEM.VAL(Bytes2, x), 0, 2)
+END ReadInt;
+
+PROCEDURE ReadLInt*(VAR r: Rider; VAR x: LONGINT);
+BEGIN
+	r.file.ReadBytes(r, SYSTEM.VAL(Bytes4, x), 0, 4)
+END ReadLInt;
+
+PROCEDURE ReadHInt*(VAR r: Rider; VAR x: HUGEINT);
+BEGIN
+	r.file.ReadBytes(r, SYSTEM.VAL(Bytes8, x), 0, 8)
+END ReadHInt;
+
+PROCEDURE ReadFileSize*(VAR r: Rider; VAR x: Streams.Position);
+CONST Size = SIZEOF (Streams.Position);
+TYPE Bytes = ARRAY Size OF CHAR;
+BEGIN
+	r.file.ReadBytes(r, SYSTEM.VAL(Bytes, x), 0, Size)
+END ReadFileSize;
+
+PROCEDURE ReadSet*(VAR r: Rider; VAR x: SET);
+CONST Size = SIZEOF (SET);
+TYPE Bytes = ARRAY Size OF CHAR;
+BEGIN
+	r.file.ReadBytes(r, SYSTEM.VAL(Bytes, x), 0, Size)
+END ReadSet;
+
+PROCEDURE ReadBool*(VAR r: Rider; VAR x: BOOLEAN);
+VAR ch: CHAR;
+BEGIN
+	r.file.Read(r, ch); x := ch # 0X
+END ReadBool;
+
+PROCEDURE ReadReal*(VAR r: Rider; VAR x: REAL);
+BEGIN
+	r.file.ReadBytes(r, SYSTEM.VAL(Bytes4, x), 0, 4)
+END ReadReal;
+
+PROCEDURE ReadLReal*(VAR r: Rider; VAR x: LONGREAL);
+BEGIN
+	r.file.ReadBytes(r, SYSTEM.VAL(Bytes8, x), 0, 8)
+END ReadLReal;
+
+PROCEDURE ReadString*(VAR r: Rider; VAR x: ARRAY OF CHAR);
+VAR i: SIZE; ch: CHAR; f: File;
+BEGIN
+	i := 0; f := r.file;
+	LOOP
+		f.Read(r, ch); x[i] := ch; INC(i);
+		IF ch = 0X THEN EXIT END;
+		IF i = LEN(x) THEN
+			x[i-1] := 0X;
+			REPEAT f.Read(r, ch) UNTIL ch = 0X;
+			EXIT
+		END
+	END
+END ReadString;
+
+(* Reads a number in compressed format. *)
+
+PROCEDURE ReadNum*(VAR r: Rider; VAR x: LONGINT);
+VAR ch: CHAR; n, y: LONGINT; f: File;
+BEGIN
+	n := 0; y := 0; f := r.file;
+	f.Read(r, ch);
+	WHILE ch >= 80X DO
+		INC(y, LSH(LONG(ORD(ch)) - 128, n)); INC(n, 7);
+		f.Read(r, ch)
+	END;
+	x := ASH(LSH(LONG(ORD(ch)), 25), n-25) + y
+END ReadNum;
+
+(** Portable routines to write the standard Oberon types. DEPRECATED, used Streams instead. *)
+
+PROCEDURE WriteSInt*(VAR r: Rider; x: SHORTINT);
+BEGIN
+	r.file.Write(r, SYSTEM.VAL(CHAR, x))
+END WriteSInt;
+
+PROCEDURE WriteInt*(VAR r: Rider; x: INTEGER);
+BEGIN
+	r.file.WriteBytes(r, SYSTEM.VAL(Bytes2, x), 0, 2)
+END WriteInt;
+
+PROCEDURE WriteLInt*(VAR r: Rider; x: LONGINT);
+BEGIN
+	r.file.WriteBytes(r, SYSTEM.VAL(Bytes4, x), 0, 4)
+END WriteLInt;
+
+PROCEDURE WriteHInt*(VAR r: Rider; x: HUGEINT);
+BEGIN
+	r.file.WriteBytes(r, SYSTEM.VAL(Bytes8, x), 0, 8)
+END WriteHInt;
+
+PROCEDURE WriteFileSize*(VAR r: Rider; x: Streams.Position);
+CONST Size = SIZEOF (Streams.Position);
+TYPE Bytes = ARRAY Size OF CHAR;
+BEGIN
+	r.file.WriteBytes(r, SYSTEM.VAL(Bytes, x), 0, Size)
+END WriteFileSize;
+
+PROCEDURE WriteSet*(VAR r: Rider; x: SET);
+CONST Size = SIZEOF (SET);
+TYPE Bytes = ARRAY Size OF CHAR;
+BEGIN
+	r.file.WriteBytes(r, SYSTEM.VAL(Bytes, x), 0, Size)
+END WriteSet;
+
+PROCEDURE WriteBool*(VAR r: Rider; x: BOOLEAN);
+BEGIN
+	IF x THEN r.file.Write(r, 1X) ELSE r.file.Write(r, 0X) END
+END WriteBool;
+
+PROCEDURE WriteReal*(VAR r: Rider; x: REAL);
+BEGIN
+	r.file.WriteBytes(r, SYSTEM.VAL(Bytes4, x), 0, 4)
+END WriteReal;
+
+PROCEDURE WriteLReal*(VAR r: Rider; x: LONGREAL);
+BEGIN
+	r.file.WriteBytes(r, SYSTEM.VAL(Bytes8, x), 0, 8)
+END WriteLReal;
+
+PROCEDURE WriteString*(VAR r: Rider; x: ARRAY OF CHAR);
+VAR i: Streams.BufferOffset;
+BEGIN
+	i := 0; WHILE x[i] # 0X DO INC(i) END;
+	r.file.WriteBytes(r, x, 0, i+1)
+END WriteString;
+
+(* Writes a number in a compressed format. *)
+
+PROCEDURE WriteNum*(VAR r: Rider; x: LONGINT);
+VAR f: File;
+BEGIN
+	f := r.file;
+	WHILE (x < - 64) OR (x > 63) DO
+		f.Write(r, CHR(x MOD 128 + 128)); x := x DIV 128
+	END;
+	f.Write(r, CHR(x MOD 128))
+END WriteNum;
+
+(** Help procedures. *)
+
+(** Append first string to second string, truncating on overflow. *)
+
+PROCEDURE AppendStr*(from: ARRAY OF CHAR; VAR to: ARRAY OF CHAR);
+VAR i, j, m: SIZE;
+BEGIN
+	j := 0; WHILE to[j] # 0X DO INC(j) END;
+	m := LEN(to)-1;
+	i := 0; WHILE (from[i] # 0X) & (j # m) DO to[j] := from[i]; INC(i); INC(j) END;
+	to[j] := 0X
+END AppendStr;
+
+(** Append unsigned integer to string in ASCII format. *)
+
+PROCEDURE AppendInt*(x: LONGINT; VAR to: ARRAY OF CHAR);
+VAR i: SIZE; m: LONGINT;
+BEGIN
+	ASSERT(x >= 0);
+	i := 0; WHILE to[i] # 0X DO INC(i) END;
+	IF x # 0 THEN
+		m := 1000000000;
+		WHILE x < m DO m := m DIV 10 END;
+		REPEAT
+			to[i] := CHR(48 + (x DIV m) MOD 10); INC(i);
+			m := m DIV 10
+		UNTIL m = 0
+	ELSE
+		to[i] := "0"; INC(i)
+	END;
+	to[i] := 0X
+END AppendInt;
+
+(** Get the dev#part string from the stream *)
+PROCEDURE GetDevPart*(arg : Streams.Reader; VAR deviceName : ARRAY OF CHAR; VAR partition : LONGINT);
+VAR i: SIZE; ch : CHAR;
+BEGIN
+	arg.SkipWhitespace;
+	deviceName := ""; partition := 0;
+
+	i := 0;
+	ch := arg.Peek();
+	WHILE (i < LEN(deviceName)-1) & (ch > " ") & (ch # "#") & (ch # ",") & (arg.res = Streams.Ok) DO
+		arg.Char(ch); (* consume ch *)
+		deviceName[i] := ch; INC(i);
+		ch := arg.Peek();
+	END;
+	deviceName[i] := 0X;
+
+	IF (ch = "#") THEN
+		arg.Char(ch); (* consume "#" *)
+		arg.Int(partition, FALSE);
+	ELSE
+		partition := 0;
+	END;
+END GetDevPart;
+
+(* Clean up file systems when shutting down or unloading module. *)
+
+PROCEDURE FSCleanup;
+VAR ft: FileSystemTable; i: LONGINT;
+BEGIN
+	GetList(ft);
+	IF ft # NIL THEN
+		FOR i := 0 TO LEN(ft^)-1 DO Remove(ft[i]) END
+	END
+END FSCleanup;
+
+(* debugging *)
+
+(*
+PROCEDURE ShowList*;
+VAR
+	enum: OBJECT
+		VAR i: LONGINT;
+
+		PROCEDURE EnumFile(f: ANY; VAR cont: BOOLEAN);
+		VAR name: FileName;
+		BEGIN
+			WITH f: File DO
+				KernelLog.Int(i, 1); KernelLog.Char(" ");
+				(*KernelLog.String(f.fs.prefix); KernelLog.Char(" ");*)
+				KernelLog.Address(SYSTEM.VAL(ADDRESS, f)); KernelLog.Char(" ");
+				KernelLog.Int(f.key, 1); KernelLog.Char(" ");
+				KernelLog.Int(f.Length(), 1); KernelLog.Char(" ");
+				f.GetName(name);
+				KernelLog.String(name); KernelLog.Ln;
+				INC(i)
+			END
+		END EnumFile;
+	END;
+
+BEGIN
+	NEW(enum); enum.i := 0; KernelLog.Ln;
+	files.Enumerate(enum.EnumFile)
+END ShowList;
+*)
+
+BEGIN
+	fsroot := NIL; NEW(seacher); NEW(files);
+	Modules.InstallTermHandler(FSCleanup)
+END Files.
+
+(**
+Notes:
+o A typical code pattern for reading a file is:
+
+	VAR f: Files.File; r: Files.Reader; ch: CHAR;
+
+	f := Files.Old(filename);	(* open an existing file *)
+	IF f # NIL THEN
+		Files.OpenReader(r, f, 0);	(* open a buffer on the file *)
+		LOOP
+			ch := r.Get();	(* read a character from the buffer *)
+			IF r.res # Streams.Ok THEN EXIT END;	(* end-of-file, or other error *)
+			"do something with ch"
+		END
+	END
+
+o A typical code pattern for writing a file is:
+
+	VAR f: Files.File; w: Files.Writer; ch: CHAR;
+
+	f := Files.New(filename);	(* create a new file (not visible yet) *)
+	IF f # NIL THEN
+		Files.OpenWriter(w, f, 0);	(* open a buffer on the file *)
+		WHILE "not done" DO
+			"assign ch"
+			w.Char(ch)	(* write a character to the buffer (if the buffer is full, it is written to the file) *)
+		END;
+		w.Update;	(* write the last buffer to the file *)
+		Files.Register(f)	(* enter the file in the directory *)
+
+o See the Streams module for more procedures operating on Reader and Writer buffers, e.g. ReadRawInt, WriteRawInt, etc.
+o Never use an exported identifier with a name ending in "0", unless you are implementing a file system.
+o Never use an exported identifier that is documented as "private".
+o File system implementations must implement the FileKey procedure to assign a unique key value to every file in the file system.  The key is used by the Files module to ensure that the Old procedure returns an existing file if it is already open.  The key need not be persistent, but must stay unique during a whole session (between mount and unmount).  The 0 key is reserved to indicate non-existent files.
+*)
+
+(*
+	On-the-fly GC by bsm
+
+	In order to be non-leaking, a file system must provide the following:
+	- FileSystem.Purge -- to reclaim blocks of an open (being closed) file
+	- FileSystem.Registered -- reports if a particular open file is registered in the file directory
+
+	The following procedures need to be modified to purge file blocks when appropriate.
+	- FileSystem.Register0 -- if an entry to a file, F, which is not open is replaced, purge F.
+	- FileSystem.Rename0 -- same as register.
+	- FileSystem.Delete0 -- if the entry being deleted refers to a file, F, which is not open, purge F.
+*)
+
+(*
+Lock order: Files, File, FileSystem
+*)
+
+Files.File
+Files.File
+
+Files.Rider
+Files.Reader
+Files.Writer
+
+Files.Old
+Files.Old
+
+Files.Set
+Files.OpenReader
+Files.OpenWriter
+
+Files.ReadNum
+Streams.ReadRawNum
+
+Files.ReadInt
+Streams.ReadRawInt
+
+Files.ReadLInt
+Streams.ReadRawLInt
+
+Files.ReadString
+Streams.ReadRawString
+
+Files.ReadBytes
+Streams.ReadBytes [add 0 ofs parameter, and len parameter]
+
+Files.Read(
+Streams.Read(
+
+Files.ReadBool
+Streams.ReadRawBool
+
+Files.WriteInt
+Streams.WriteRawInt
+
+Files.Write(
+Streams.Write(
+
+Files.WriteBytes
+Streams.WriteBytes [add 0 ofs parameter]

source/IO64.Streams.Mod

@@ -0,0 +1,993 @@
+(* Aos, Copyright 2001, Pieter Muller, ETH Zurich *)
+
+MODULE Streams;   (** AUTHOR "pjm/be"; PURPOSE "I/O buffering and formatted writing and reading"; *)
+
+IMPORT SYSTEM, RC := RealConversions;
+
+CONST
+	Ok* = 0;   (** zero result code means no error occurred *)
+	EOF* = 4201;   (** error returned when Receive reads past end of file or stream *)
+
+	EOT* = 1AX;   (** EOT character *)
+
+	StringFull = 4202;
+	FormatError* = 4203;   (** error returned when ReadInt fails *)
+
+	DefaultWriterSize* = 4096;
+	DefaultReaderSize* = 4096;
+
+	Invalid* = -1;  (** invalid stream position *)
+
+CONST
+	CR = 0DX;  LF = 0AX;  TAB = 9X;  SP = 20X;
+
+TYPE
+	BufferSize*		= LONGWORD;
+	BufferOffset*	= LONGWORD; (* offset in the stream biffer *)
+
+TYPE
+	Position* = HUGEINT; (* offset in the stream *)
+	StreamSize* = HUGEINT; (* size of hte stream *)
+
+	(** Any stream output procedure or method. *)
+	Sender* = PROCEDURE {DELEGATE} ( CONST buf: ARRAY OF CHAR;  ofs, len: BufferOffset;  propagate: BOOLEAN;  VAR res: WORD );
+
+	(** Any stream input procedure or method. *)
+	Receiver* = PROCEDURE {DELEGATE} ( VAR buf: ARRAY OF CHAR;  ofs, size, min: BufferOffset;  VAR len: BufferOffset; VAR res: WORD );
+
+	Connection* = OBJECT
+
+		PROCEDURE Send*( CONST data: ARRAY OF CHAR;  ofs, len: BufferOffset;  propagate: BOOLEAN;  VAR res: WORD );
+		END Send;
+
+		PROCEDURE Receive*( VAR data: ARRAY OF CHAR;  ofs, size, min: BufferOffset;  VAR len: BufferOffset; VAR res: WORD );
+		END Receive;
+
+		PROCEDURE Close*;
+		END Close;
+
+	END Connection;
+
+TYPE
+	(** A writer buffers output before it is sent to a Sender.  Must not be shared between processes. *)
+	Writer* = OBJECT
+	VAR
+		tail: BufferOffset;
+		buf: POINTER TO ARRAY OF CHAR;
+		res*: WORD; (** result of last output operation. *)
+		send: Sender;
+		sent*: Position;  (** count of sent bytes *)
+		(* buf[0..tail-1] contains data to write. *)
+
+		PROCEDURE & InitWriter*( send: Sender;  size: BufferOffset );
+		BEGIN
+			ASSERT ( send # NIL );
+			IF (buf = NIL) OR (LEN(buf) # size) THEN
+				NEW( buf, size );
+			END;
+			SELF.send := send;  Reset
+		END InitWriter;
+
+		PROCEDURE Reset*;
+		BEGIN
+			tail := 0;  res := Ok;  sent := 0
+		END Reset;
+
+		PROCEDURE CanSetPos*( ): BOOLEAN;
+		BEGIN
+			RETURN FALSE
+		END CanSetPos;
+
+		PROCEDURE SetPos*( pos: Position );
+		BEGIN
+			HALT( 1234 )
+		END SetPos;
+
+		PROCEDURE Update*;
+		BEGIN
+			IF (res = Ok) THEN
+				send( buf^, 0, tail, TRUE , res );
+				IF res = Ok THEN INC( sent, tail );  tail := 0 END
+			END
+		END Update;
+
+	(** Current write position. *)
+		PROCEDURE Pos*( ): Position;
+		BEGIN
+			RETURN sent + tail;
+		END Pos;
+
+		(** -- Write raw binary data -- *)
+
+	(** Write one byte. *)
+		PROCEDURE Char*( x: CHAR );
+		BEGIN
+			IF (tail = LEN( buf )) & (res = Ok) THEN
+				send( buf^, 0, tail, FALSE , res );
+				IF res = Ok THEN INC( sent, tail );  tail := 0 END
+			END;
+			IF res = Ok THEN buf[tail] := x;  INC( tail ) END
+		END Char;
+
+	(** Write len bytes from x, starting at ofs. *)
+		PROCEDURE Bytes*(CONST x: ARRAY OF CHAR;  ofs, len: BufferOffset );
+		VAR n: BufferOffset;
+		BEGIN
+			ASSERT ( len >= 0 );
+			LOOP
+				n := LEN( buf ) - tail;   (* space available *)
+				IF n = 0 THEN
+					IF res = Ok THEN  (* send current buffer *)
+						send( buf^, 0, tail, FALSE , res );
+						IF res = Ok THEN INC( sent, tail );  tail := 0 ELSE EXIT END
+					ELSE
+						EXIT  (* should not be writing on an erroneous rider *)
+					END;
+					n := LEN( buf )
+				END;
+				IF n > len THEN n := len END;
+				ASSERT ( tail + n <= LEN( buf ) );   (* index check *)
+				SYSTEM.MOVE( ADDRESSOF( x[ofs] ), ADDRESSOF( buf[tail] ), n );  INC( tail, n );
+				IF len = n THEN EXIT END;   (* done *)
+				INC( ofs, n );  DEC( len, n )
+			END
+		END Bytes;
+
+	(** Write a SHORTINT. *)
+		PROCEDURE RawSInt*( x: SHORTINT );
+		BEGIN
+			Char( SYSTEM.VAL( CHAR, x ) )
+		END RawSInt;
+
+	(** Write an INTEGER. *)
+		PROCEDURE RawInt*( x: INTEGER );
+		BEGIN
+			Bytes( SYSTEM.VAL( Bytes2, x ), 0, 2 )
+		END RawInt;
+
+	(** Write a LONGINT. *)
+		PROCEDURE RawLInt*( x: LONGINT );
+		BEGIN
+			Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4 )
+		END RawLInt;
+
+	(** Write a HUGEINT. *)
+		PROCEDURE RawHInt*( x: HUGEINT );
+		BEGIN
+			Bytes( SYSTEM.VAL( Bytes8, x ), 0, 8 )
+		END RawHInt;
+
+	(** Write a 64 bit value in network byte order (most significant byte first) *)
+		PROCEDURE Net64*( x: HUGEINT );
+		BEGIN
+			Net32(LONGINT( x DIV 100000000H MOD 100000000H ));
+			Net32(LONGINT( x MOD 100000000H ));
+		END Net64;
+
+	(** Write a 32 bit value in network byte order (most significant byte first) *)
+		PROCEDURE Net32*( x: LONGINT );
+		BEGIN
+			Char( CHR( x DIV 1000000H MOD 100H ) );  Char( CHR( x DIV 10000H MOD 100H ) );  Char( CHR( x DIV 100H MOD 100H ) );
+			Char( CHR( x MOD 100H ) )
+		END Net32;
+
+	(** Write a 16 bit value in network byte order (most significant byte first) *)
+		PROCEDURE Net16*( x: LONGINT );
+		BEGIN
+			Char( CHR( x DIV 100H MOD 100H ) );  Char( CHR( x MOD 100H ) )
+		END Net16;
+
+	(** write unsigned byte *)
+		PROCEDURE Net8*( x: LONGINT );
+		BEGIN
+			Char( CHR( x MOD 100H ) )
+		END Net8;
+
+	(** Write a SET. *)
+		PROCEDURE RawSet*( x: SET );
+		BEGIN
+			Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4 )
+		END RawSet;
+
+	(** Write a BOOLEAN. *)
+		PROCEDURE RawBool*( x: BOOLEAN );
+		BEGIN
+			IF x THEN Char( 1X ) ELSE Char( 0X ) END
+		END RawBool;
+
+	(** Write a REAL. *)
+		PROCEDURE RawReal*( x: REAL );
+		BEGIN
+			Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4 )
+		END RawReal;
+
+	(** Write a LONGREAL. *)
+		PROCEDURE RawLReal*( x: LONGREAL );
+		BEGIN
+			Bytes( SYSTEM.VAL( Bytes8, x ), 0, 8 )
+		END RawLReal;
+
+	(** Write a 0X-terminated string, including the 0X terminator. *)
+		PROCEDURE RawString*(CONST x: ARRAY OF CHAR );
+		VAR i: SIZE;
+		BEGIN
+			i := 0;
+			WHILE x[i] # 0X DO Char( x[i] );  INC( i ) END;
+			Char( 0X )
+		END RawString;
+
+	(** Write a number in a compressed format. *)
+		PROCEDURE RawNum*( x: LONGINT );
+		BEGIN
+			WHILE (x < -64) OR (x > 63) DO Char( CHR( x MOD 128 + 128 ) );  x := x DIV 128 END;
+			Char( CHR( x MOD 128 ) )
+		END RawNum;
+
+	(** Write a size in a compressed format. *)
+		PROCEDURE RawSize*( x: SIZE );
+		BEGIN
+			WHILE (x < -64) OR (x > 63) DO Char( CHR( x MOD 128 + 128 ) );  x := x DIV 128 END;
+			Char( CHR( x MOD 128 ) )
+		END RawSize;
+
+		(** -- Write formatted data -- *)
+
+	(** Write an ASCII end-of-line (CR/LF). *)
+		PROCEDURE Ln*;
+		BEGIN
+			Char( CR );  Char( LF )
+		END Ln;
+
+	(** Write a 0X-terminated string, excluding the 0X terminator. *)
+		PROCEDURE String*(CONST x: ARRAY OF CHAR );
+		VAR i: SIZE;
+		BEGIN
+			i := 0;
+			WHILE x[i] # 0X DO Char( x[i] );  INC( i ) END
+		END String;
+
+	(** Write an integer in decimal right-justified in a field of at least w characters. *)
+		PROCEDURE Int*( x: HUGEINT; w: SIZE );
+		VAR i: SIZE; x0: HUGEINT;
+			a: ARRAY 21 OF CHAR;
+		BEGIN
+			IF x < 0 THEN
+				IF x = MIN( HUGEINT ) THEN
+					DEC( w, 20 );
+					WHILE w > 0 DO Char( " " );  DEC( w ) END;
+					String( "-9223372036854775808" );  RETURN
+				ELSE DEC( w );  x0 := -x
+				END
+			ELSE x0 := x
+			END;
+			i := 0;
+			REPEAT a[i] := CHR( x0 MOD 10 + 30H );  x0 := x0 DIV 10;  INC( i ) UNTIL x0 = 0;
+			WHILE w > i DO Char( " " );  DEC( w ) END;
+			IF x < 0 THEN Char( "-" ) END;
+			REPEAT DEC( i );  Char( a[i] ) UNTIL i = 0
+		END Int;
+
+	(** Write a SET in Oberon notation. *)
+	(*	PROCEDURE Set*( s: SET );   (* from P. Saladin *)
+		VAR i, last: LONGINT;  dots: BOOLEAN;
+		BEGIN
+			Char( "{" );  last := MIN( LONGINT );  dots := FALSE;
+			FOR i := MIN( SET ) TO MAX( SET ) DO
+				IF i IN s THEN
+					IF last = (i - 1) THEN
+						IF dots THEN String( ".." );  dots := FALSE END;
+						IF (i = MAX( SET )) OR ~((i + 1) IN s) THEN Int( i, 1 ) END
+					ELSE
+						IF last >= MIN( SET ) THEN String( ", " ) END;
+						Int( i, 1 );  dots := TRUE
+					END;
+					last := i
+				END
+			END;
+			Char( "}" )
+		END Set;	*)
+
+		PROCEDURE Set*( s: SET );   (* from P. Saladin *)
+		VAR i, last: LONGINT;  dots: BOOLEAN;
+		BEGIN
+			Char( "{" );  last := MAX( LONGINT );  dots := FALSE;
+			FOR i := MAX( SET ) TO 0 BY -1 DO
+				IF i IN s THEN
+					IF last = (i + 1) THEN
+						IF dots THEN String( ".." );  dots := FALSE END;
+						IF (i = 0) OR ~((i - 1) IN s) THEN Int( i, 1 ) END
+					ELSE
+						IF last <= MAX( SET ) THEN String( ", " ) END;
+						Int( i, 1 );  dots := TRUE
+					END;
+					last := i
+				END
+			END;
+			Char( "}" )
+		END Set;
+
+		(**
+			Write an integer in hexadecimal right-justified in a field of at least ABS(w) characters.
+			If w < 0 THEN w least significant hex digits of x are written (potentially including leading zeros)
+		*)
+		PROCEDURE Hex*(x: HUGEINT; w: SIZE);
+		VAR filler: CHAR; i,maxw: SIZE; a: ARRAY 20 OF CHAR; y: HUGEINT;
+		BEGIN
+			IF w < 0 THEN filler := '0'; w := -w; maxw := w ELSE filler := ' '; maxw := 16 END;
+			i := 0;
+			REPEAT
+				y := x MOD 10H;
+				IF y < 10 THEN a[i] := CHR(y+ORD('0')) ELSE a[i] := CHR(y-10+ORD('A')) END;
+				x := x DIV 10H;
+				INC(i);
+			UNTIL (x=0) OR (i=maxw);
+			WHILE w > i DO Char(filler);  DEC( w ) END;
+			REPEAT DEC( i ); Char( a[i] ) UNTIL i = 0
+		END Hex;
+
+		(** Write "x" as a hexadecimal address. Do not use Hex because of arithmetic shift of the sign !*)
+		PROCEDURE Address* (x: ADDRESS);
+		BEGIN
+			Hex(x,-2*SIZEOF(ADDRESS));
+		END Address;
+
+		PROCEDURE Pair( ch: CHAR;  x: LONGINT );
+		BEGIN
+			IF ch # 0X THEN Char( ch ) END;
+			Char( CHR( ORD( "0" ) + x DIV 10 MOD 10 ) );  Char( CHR( ORD( "0" ) + x MOD 10 ) )
+		END Pair;
+
+	(** Write the date and time in ISO format (yyyy-mm-dd hh:mm:ss).  The t and d parameters are in Oberon time and date format.
+			If all parameters are within range, the output string is exactly 19 characters wide.  The t or d parameter can be -1, in which
+			case the time or date respectively are left out. *)
+		PROCEDURE Date*( t, d: LONGINT );
+		VAR ch: CHAR;
+		BEGIN
+			IF d # -1 THEN
+				Int( 1900 + d DIV 512, 4 );   (* year *)
+				Pair( "-", d DIV 32 MOD 16 );   (* month *)
+				Pair( "-", d MOD 32 );   (* day *)
+				ch := " " (* space between date and time *)
+			ELSE
+				ch := 0X (* no space before time *)
+			END;
+			IF t # -1 THEN
+				Pair( ch, t DIV 4096 MOD 32 );   (* hour *)
+				Pair( ":", t DIV 64 MOD 64 );   (* min *)
+				Pair( ":", t MOD 64 ) (* sec *)
+			END
+		END Date;
+
+	(** Write the date and time in RFC 822/1123 format without the optional day of the week (dd mmm yyyy hh:mm:ss SZZZZ) .
+			The t and d parameters are in Oberon time and date format.  The tz parameter specifies the time zone offset in minutes
+			(from -720 to 720 in steps of 30).  If all parameters are within range, the output string is exactly 26 characters wide.
+			The t, d or tz parameter can be -1, in which case the time, date or timezone respectively are left out. *)
+		PROCEDURE Date822*( t, d, tz: LONGINT );
+		VAR i, m: LONGINT;  ch: CHAR;
+		BEGIN
+			IF d # -1 THEN
+				Int( d MOD 32, 2 );   (* day *)
+				m := (d DIV 32 MOD 16 - 1) * 4;   (* month *)
+				FOR i := m TO m + 3 DO Char( months[i] ) END;
+				Int( 1900 + d DIV 512, 5 );   (* year *)
+				ch := " " (* space *)
+			ELSE
+				ch := 0X (* no space *)
+			END;
+			IF t # -1 THEN
+				Pair( ch, t DIV 4096 MOD 32 );   (* hour *)
+				Pair( ":", t DIV 64 MOD 64 );   (* min *)
+				Pair( ":", t MOD 64 );   (* sec *)
+				ch := " " (* space *)
+			ELSE
+				(* leave ch as before *)
+			END;
+			IF tz # -1 THEN
+				IF ch # 0X THEN Char( ch ) END;
+				IF tz >= 0 THEN Pair( "+", tz DIV 60 ) ELSE Pair( "-", (-tz) DIV 60 ) END;
+				Pair( 0X, ABS( tz ) MOD 60 )
+			END
+		END Date822;
+
+
+	(** Write LONGREAL x  using n character positions. *)
+		PROCEDURE Float*( x: LONGREAL;  n: WORD );
+		VAR
+			buf: ARRAY 32 OF CHAR;
+		BEGIN
+			RC.RealToString( x, n, buf );
+			String( buf )
+		END Float;
+
+	(** Write LONGREAL x in a fixed point notation. n is the overall minimal length for the output field, f the number of fraction digits following the decimal point, D the fixed exponent (printed only when D # 0). *)
+		PROCEDURE FloatFix*( x: LONGREAL;  n, f, D: WORD );
+		VAR
+			buf: ARRAY 64 OF CHAR;
+		BEGIN
+			RC.RealToStringFix( x, n, f, D, buf );
+			String( buf )
+		END FloatFix;
+	END Writer;
+
+	(** A special writer that buffers output to be fetched by GetString or GetRawString. *)
+	StringWriter* = OBJECT (Writer)
+
+		PROCEDURE & InitStringWriter*( size: BufferOffset );
+		BEGIN
+			InitWriter( Send, size )
+		END InitStringWriter;
+
+		PROCEDURE Send( CONST buf: ARRAY OF CHAR;  ofs, len: BufferOffset;  propagate: BOOLEAN;  VAR res: WORD );
+		BEGIN
+			res := StringFull
+		END Send;
+
+		PROCEDURE CanSetPos*( ): BOOLEAN;
+		BEGIN
+			RETURN TRUE;
+		END CanSetPos;
+
+	(* Set the position for the writer *)
+		PROCEDURE SetPos*( pos: Position );
+		BEGIN
+			IF pos > LEN( buf ) THEN pos := LEN( buf ) END;
+			tail := BufferOffset( pos );  sent := 0;  res := Ok;
+		END SetPos;
+
+		PROCEDURE Update*;
+		(* nothing to do *)
+		END Update;
+
+	(** Return the contents of the string writer (0X-terminated). *)
+		PROCEDURE Get*( VAR s: ARRAY OF CHAR );
+		VAR i, m: BufferOffset;
+		BEGIN
+			m := LEN( s ) - 1;  i := 0;
+			WHILE (i # tail) & (i < m) DO s[i] := buf[i];  INC( i ) END;
+			s[i] := 0X;  tail := 0;  res := Ok
+		END Get;
+
+	(** Return the contents of the string writer (not 0X-terminated).  The len parameters returns the string length. *)
+		PROCEDURE GetRaw*( VAR s: ARRAY OF CHAR;  VAR len: BufferOffset );
+		VAR i, m: BufferOffset;
+		BEGIN
+			m := LEN( s );  i := 0;
+			WHILE (i # tail) & (i < m) DO s[i] := buf[i];  INC( i ) END;
+			len := i;  tail := 0;  res := Ok
+		END GetRaw;
+
+	END StringWriter;
+
+TYPE
+	(** A reader buffers input received from a Receiver.  Must not be shared between processes. *)
+	Reader* = OBJECT
+	VAR
+		head, tail: BufferOffset;
+		buf: POINTER TO ARRAY OF CHAR;
+		res*: WORD;   (** result of last input operation. *)
+		receive: Receiver;
+		received*: Position;   (** count of received bytes *)
+		(* buf[buf.head..buf.tail-1] contains data to read. *)
+
+		PROCEDURE & InitReader*( receive: Receiver;  size: BufferOffset );
+		BEGIN
+			ASSERT ( receive # NIL );
+			IF (buf = NIL) OR (LEN(buf) # size) THEN
+				NEW( buf, size );
+			END;
+			SELF.receive := receive;  Reset
+		END InitReader;
+
+	(** reset the reader by dropping the bytes in the buffer, resetting the result code and setting received to 0.
+			This is used by seekable extensions of the reader *)
+		PROCEDURE Reset*;
+		BEGIN
+			head := 0;  tail := 0;  res := Ok;  received := 0
+		END Reset;
+
+		PROCEDURE CanSetPos*( ): BOOLEAN;
+		BEGIN
+			RETURN FALSE
+		END CanSetPos;
+
+		PROCEDURE SetPos*( pos: Position );
+		BEGIN
+			HALT( 1234 )
+		END SetPos;
+
+	(** Return bytes currently available in input buffer. *)
+		PROCEDURE Available*( ): BufferOffset;
+		VAR n: BufferOffset;
+		BEGIN
+			IF (res = Ok) THEN
+				IF (head = tail) THEN head := 0;  receive( buf^, 0, LEN( buf ), 0, tail, res );  INC( received, tail );
+				ELSIF (tail # LEN( buf )) THEN
+					receive( buf^, tail, LEN( buf ) - tail, 0, n, res );   (* poll *)
+					INC( tail, n );  INC( received, n )
+				END;
+				IF res = EOF THEN res := Ok END  (* ignore EOF here *)
+			END;
+			RETURN tail - head
+		END Available;
+
+	(** Current read position. *)
+		PROCEDURE Pos*( ): Position;
+		BEGIN
+			RETURN received - (tail - head)
+		END Pos;
+
+		(** -- Read raw binary data -- *)
+
+	(** Read one byte. x=0X if no success (e.g. file ended) *)
+		PROCEDURE Char*( VAR x: CHAR );
+		BEGIN
+			IF (head = tail) & (res = Ok) THEN head := 0;  receive( buf^, 0, LEN( buf ), 1, tail, res );  INC( received, tail ) END;
+			IF res = Ok THEN x := buf[head];  INC( head ) ELSE x := 0X END
+		END Char;
+
+	(** Like Read, but return result. Return 0X if no success (e.g. file ended) *)
+		PROCEDURE Get*( ): CHAR;
+		BEGIN
+			IF (head = tail) & (res = Ok) THEN head := 0;  receive( buf^, 0, LEN( buf ), 1, tail, res );  INC( received, tail ) END;
+			IF res = Ok THEN INC( head );  RETURN buf[head - 1] ELSE RETURN 0X END
+		END Get;
+
+	(** Like Get, but leave the byte in the input buffer. *)
+		PROCEDURE Peek*( ): CHAR;
+		BEGIN
+			IF (head = tail) & (res = Ok) THEN
+				head := 0;  receive( buf^, 0, LEN( buf ), 1, tail, res );  INC( received, tail );
+				IF res = EOF THEN  (* ignore EOF here *)
+					res := Ok;  tail := 0; RETURN 0X (* Peek returns 0X at eof *)
+				END
+			END;
+			IF res = Ok THEN RETURN buf[head] ELSE RETURN 0X END
+		END Peek;
+
+	(** Read size bytes into x, starting at ofs.  The len parameter returns the number of bytes that were actually read. *)
+		PROCEDURE Bytes*( VAR x: ARRAY OF CHAR;  ofs, size: BufferOffset;  VAR len: BufferOffset );
+		VAR n: BufferOffset;
+		BEGIN
+			ASSERT ( size >= 0 );
+			len := 0;
+			LOOP
+				n := tail - head;   (* bytes available *)
+				IF n = 0 THEN  (* no data available *)
+					head := 0;
+					IF res = Ok THEN  (* fill buffer *)
+						receive( buf^, 0, LEN( buf ), 1, tail, res );  INC( received, tail )
+					END;
+					IF res # Ok THEN  (* should not be reading from erroneous rider *)
+						WHILE size # 0 DO x[ofs] := 0X;  INC( ofs );  DEC( size ) END;   (* clear rest of buffer *)
+						IF (res = EOF) & (len # 0) THEN res := Ok END;   (* ignore EOF if some data being returned *)
+						EXIT
+					END;
+					n := tail
+				END;
+				IF n > size THEN n := size END;
+				ASSERT ( ofs + n <= LEN( x ) );   (* index check *)
+				SYSTEM.MOVE( ADDRESSOF( buf[head] ), ADDRESSOF( x[ofs] ), n );  INC( head, n );  INC( len, n );
+				IF size = n THEN EXIT END;   (* done *)
+				INC( ofs, n );  DEC( size, n )
+			END
+		END Bytes;
+
+	(** Skip n bytes on the reader. *)
+		PROCEDURE SkipBytes*( n: Position );
+		VAR ch: CHAR;
+		BEGIN
+			WHILE n > 0 DO ch := Get();  DEC( n ) END
+		END SkipBytes;
+
+	(** Read a SHORTINT. *)
+		PROCEDURE RawSInt*( VAR x: SHORTINT );
+		BEGIN
+			x := SYSTEM.VAL( SHORTINT, Get() )
+		END RawSInt;
+
+	(** Read an INTEGER. *)
+		PROCEDURE RawInt*( VAR x: INTEGER );
+		VAR x0, x1: CHAR;
+		BEGIN
+			x0 := Get();  x1 := Get();   (* defined order *)
+			x := ORD( x1 ) * 100H + ORD( x0 )
+		END RawInt;
+
+	(** Read a LONGINT. *)
+		PROCEDURE RawLInt*( VAR x: LONGINT );
+		VAR ignore: BufferOffset;
+		BEGIN
+			Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4, ignore )
+		END RawLInt;
+
+	(** Read a HUGEINT. *)
+		PROCEDURE RawHInt*( VAR x: HUGEINT );
+		VAR ignore: BufferOffset;
+		BEGIN
+			Bytes( SYSTEM.VAL( Bytes8, x ), 0, 8, ignore )
+		END RawHInt;
+
+		(** Read a 64 bit value in network byte order (most significant byte first) *)
+		PROCEDURE Net64*( ): HUGEINT;
+		BEGIN
+			RETURN Net32() * 100000000H + Net32()
+		END Net64;
+
+	(** Read a 32 bit value in network byte order (most significant byte first) *)
+		PROCEDURE Net32*( ): LONGINT;
+		BEGIN
+			RETURN LONG( ORD( Get() ) ) * 1000000H + LONG( ORD( Get() ) ) * 10000H + LONG( ORD( Get() ) ) * 100H + LONG( ORD( Get() ) )
+		END Net32;
+
+	(** Read an unsigned 16bit value in network byte order (most significant byte first) *)
+		PROCEDURE Net16*( ): LONGINT;
+		BEGIN
+			RETURN LONG( ORD( Get() ) ) * 100H + LONG( ORD( Get() ) )
+		END Net16;
+
+	(** Read an unsigned byte *)
+		PROCEDURE Net8*( ): LONGINT;
+		BEGIN
+			RETURN LONG( ORD( Get() ) )
+		END Net8;
+
+	(** Read a SET. *)
+		PROCEDURE RawSet*( VAR x: SET );
+		VAR ignore: BufferOffset;
+		BEGIN
+			Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4, ignore )
+		END RawSet;
+
+	(** Read a BOOLEAN. *)
+		PROCEDURE RawBool*( VAR x: BOOLEAN );
+		BEGIN
+			x := (Get() # 0X)
+		END RawBool;
+
+	(** Read a REAL. *)
+		PROCEDURE RawReal*( VAR x: REAL );
+		VAR ignore: BufferOffset;
+		BEGIN
+			Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4, ignore )
+		END RawReal;
+
+	(** Read a LONGREAL. *)
+		PROCEDURE RawLReal*( VAR x: LONGREAL );
+		VAR ignore: BufferOffset;
+		BEGIN
+			Bytes( SYSTEM.VAL( Bytes8, x ), 0, 8, ignore )
+		END RawLReal;
+
+	(** Read a 0X-terminated string.  If the input string is larger than x, read the full string and assign the truncated 0X-terminated value to x. *)
+		PROCEDURE RawString*( VAR x: ARRAY OF CHAR );
+		VAR i, m: BufferOffset;  ch: CHAR;
+		BEGIN
+			i := 0;  m := LEN( x ) - 1;
+			LOOP
+				ch := Get();   (* also returns 0X on error *)
+				IF ch = 0X THEN EXIT END;
+				IF i < m THEN x[i] := ch;  INC( i ) END
+			END;
+			x[i] := 0X
+		END RawString;
+
+	(** Read a number in a compressed format. *)
+		PROCEDURE RawNum*( VAR x: LONGINT );
+		VAR ch: CHAR;  n, y: LONGINT;
+		BEGIN
+			n := 0;  y := 0;  ch := Get();
+			WHILE ch >= 80X DO INC( y, LSH( LONGINT( ORD( ch ) ) - 128, n ) );  INC( n, 7 );  ch := Get() END;
+			x := ASH( LSH( LONGINT( ORD( ch ) ), 25 ), n - 25 ) + y
+		END RawNum;
+
+	(** Read a size in a compressed format. *)
+		PROCEDURE RawSize*( VAR x: SIZE );
+		VAR ch: CHAR;  n, y: SIZE;
+		BEGIN
+			n := 0;  y := 0;  ch := Get();
+			WHILE ch >= 80X DO INC( y, LSH( SIZE( ORD( ch ) ) - 128, n ) );  INC( n, 7 );  ch := Get() END;
+			x := ASH( LSH( SIZE( ORD( ch ) ), SIZE OF SIZE * 8 - 7 ), n - SIZE OF SIZE * 8 - 7 ) + y
+		END RawSize;
+
+		(** -- Read formatted data (uses Peek for one character lookahead) -- *)
+
+	 (** Read an integer value in decimal or hexadecimal.  If hex = TRUE, recognize the "H" postfix for hexadecimal numbers. *)
+
+		PROCEDURE Int*( VAR x: LONGINT;  hex: BOOLEAN );
+		VAR vd, vh, sgn, d: LONGINT;  ch: CHAR;  ok: BOOLEAN;
+		BEGIN
+			vd := 0;  vh := 0;  sgn := 1;  ok := FALSE;
+			IF Peek() = "-" THEN sgn := -1;  ch := Get() END;
+			LOOP
+				ch := Peek();
+				IF (ch >= "0") & (ch <= "9") THEN d := ORD( ch ) - ORD( "0" )
+				ELSIF hex & (CAP( ch ) >= "A") & (CAP( ch ) <= "F") THEN d := ORD( CAP( ch ) ) - ORD( "A" ) + 10
+				ELSE EXIT
+				END;
+				vd := 10 * vd + d;  vh := 16 * vh + d;   (* ignore overflow *)
+				ch := Get();  ok := TRUE
+			END;
+			IF hex & (CAP( ch ) = "H") THEN  (* optional "H" present *)
+				vd := vh;   (* use the hex value *)
+				ch := Get()
+			END;
+			x := sgn * vd;
+			IF (res = 0) & ~ok THEN res := FormatError END
+		END Int;
+
+
+	(** Return TRUE iff at the end of a line (or file). *)
+		PROCEDURE EOLN*( ): BOOLEAN;
+		VAR ch: CHAR;
+		BEGIN
+			ch := Peek();  RETURN (ch = CR) OR (ch = LF) OR (res # Ok)
+		END EOLN;
+
+	(** Read all characters until the end of the line (inclusive).  If the input string is larger than x, read the full string and assign
+			the truncated 0X-terminated value to x. *)
+		PROCEDURE Ln*( VAR x: ARRAY OF CHAR );
+		VAR i, m: BufferOffset;  ch: CHAR;
+		BEGIN
+			i := 0;  m := LEN( x ) - 1;
+			LOOP
+				ch := Peek();
+				IF (ch = CR) OR (ch = LF) OR (res # Ok) THEN EXIT END;
+				IF i < m THEN x[i] := ch;  INC( i ) END;
+				ch := Get()
+			END;
+			x[i] := 0X;
+			IF ch = CR THEN ch := Get() END;
+			IF Peek() = LF THEN ch := Get() END
+		END Ln;
+
+	(** Read all characters until the end of the line (inclusive) or an <EOT> character.
+			If the input string is larger than x, read the full string and assign the truncated 0X-terminated
+			value to x. *)
+		PROCEDURE LnEOT*( VAR x: ARRAY OF CHAR );
+		VAR i, m: BufferOffset;  ch: CHAR;
+		BEGIN
+			i := 0;  m := LEN( x ) - 1;
+			LOOP
+				ch := Peek();
+				IF (ch = CR) OR (ch = LF) OR (ch = EOT) OR (res # Ok) THEN EXIT END;
+				IF i < m THEN x[i] := ch;  INC( i ) END;
+				ch := Get()
+			END;
+			x[i] := 0X;
+			IF ch = CR THEN ch := Get() END;
+			IF Peek() = LF THEN ch := Get() END;
+			IF ch = EOT THEN ch := Get() END
+		END LnEOT;
+
+	(** Skip over all characters until the end of the line (inclusive). *)
+		PROCEDURE SkipLn*;
+		VAR ch: CHAR;
+		BEGIN
+			LOOP
+				ch := Peek();
+				IF (ch = CR) OR (ch = LF) OR (res # Ok) THEN EXIT END;
+				ch := Get()
+			END;
+			IF ch = CR THEN ch := Get() END;
+			IF Peek() = LF THEN ch := Get() END
+		END SkipLn;
+
+	(** Skip over space and TAB characters. *)
+		PROCEDURE SkipSpaces*;
+		VAR ch: CHAR;
+		BEGIN
+			LOOP
+				ch := Peek();
+				IF (ch # TAB) & (ch # SP) THEN EXIT END;
+				ch := Get()
+			END
+		END SkipSpaces;
+
+	(** Skip over space, TAB and EOLN characters. *)
+		PROCEDURE SkipWhitespace*;
+		VAR ch: CHAR;
+		BEGIN
+			LOOP
+				ch := Peek();
+				IF (ch # SP) & (ch # CR) & (ch # LF) & (ch # TAB) THEN EXIT END;
+				ch := Get()
+			END
+		END SkipWhitespace;
+
+	(** Read a token, consisting of any string of characters terminated by space, TAB or EOLN. *)
+		PROCEDURE Token*( VAR token: ARRAY OF CHAR );
+		VAR j, max: SIZE;  ch: CHAR;
+		BEGIN
+			j := 0;  max := LEN( token ) - 1;
+			LOOP
+				ch := Peek();
+				IF (ch = SP) OR (ch = CR) OR (ch = LF) OR (ch = TAB) OR (res # Ok) THEN EXIT END;
+				IF j < max THEN token[j] := ch;  INC( j ) END;
+				ch := Get()
+			END;
+			token[j] := 0X
+		END Token;
+
+	(** Read an optionally "" or '' enquoted string.  Will not read past the end of a line. *)
+		PROCEDURE String*( VAR string: ARRAY OF CHAR );
+		VAR c, delimiter: CHAR;  i, len: SIZE;
+		BEGIN
+			c := Peek();
+			IF (c # "'") & (c # '"') THEN Token( string )
+			ELSE
+				delimiter := Get();  c := Peek();  i := 0;  len := LEN( string ) - 1;
+				WHILE (i < len) & (c # delimiter) & (c # CR) & (c # LF) & (res = Ok) DO string[i] := Get();  INC( i );  c := Peek() END;
+				IF (c = delimiter) THEN c := Get() END;
+				string[i] := 0X
+			END
+		END String;
+
+		(** First skip whitespace, then read string *)
+		PROCEDURE GetString*(VAR string : ARRAY OF CHAR): BOOLEAN;
+		VAR c: CHAR;
+		BEGIN
+			SkipWhitespace;
+			c := Peek();
+			String(string);
+			RETURN (string[0] # 0X) OR (c = "'") OR (c = '"');
+		END GetString;
+
+		(** First skip whitespace, then read integer *)
+		PROCEDURE GetInteger*(VAR integer : LONGINT; isHexadecimal : BOOLEAN): BOOLEAN;
+		BEGIN
+			SkipWhitespace;
+			Int(integer, isHexadecimal);
+			RETURN res = Ok;
+		END GetInteger;
+
+		(** First skip whitespace, then read a real *)
+		PROCEDURE GetReal*(VAR real: LONGREAL): BOOLEAN;
+		BEGIN
+			SkipWhitespace;
+			real := RC.ScanReal(Get);
+			RETURN res = Ok
+		END GetReal;
+
+		(** First skip whitespace, then read 1 byte character *)
+		PROCEDURE GetChar*(VAR ch : CHAR): BOOLEAN;
+		BEGIN
+			SkipWhitespace;
+			Char(ch);
+			RETURN ch # 0X;
+		END GetChar;
+
+	END Reader;
+
+TYPE
+	(** A special reader that buffers input set by SetString or SetRawString. *)
+	StringReader* = OBJECT (Reader)
+
+		PROCEDURE & InitStringReader*( size: BufferOffset );
+		BEGIN
+			InitReader( Receive, size )
+		END InitStringReader;
+
+		PROCEDURE CanSetPos*( ): BOOLEAN;
+		BEGIN
+			RETURN TRUE
+		END CanSetPos;
+
+	(** Set the reader position *)
+		PROCEDURE SetPos*( pos: Position );
+		BEGIN
+			IF pos > LEN( buf ) THEN pos := LEN( buf ) END;
+			head := BufferOffset( pos );  tail := LEN( buf );  received := LEN( buf );  res := Ok;
+		END SetPos;
+
+		PROCEDURE Receive( VAR buf: ARRAY OF CHAR;  ofs, size, min: BufferOffset;  VAR len: BufferOffset; VAR res: WORD );
+		BEGIN
+			IF min = 0 THEN res := Ok ELSE res := EOF END;
+			len := 0;
+		END Receive;
+
+	(** Set the contents of the string buffer.  The s parameter is a 0X-terminated string. *)
+		PROCEDURE Set*(CONST  s: ARRAY OF CHAR );
+		VAR len: BufferOffset;
+		BEGIN
+			len := 0;
+			WHILE s[len] # 0X DO INC( len ) END;
+			IF len > LEN( buf ) THEN len := LEN( buf ) END;
+			head := 0;  tail := len;  received := len;  res := Ok;
+			IF len > 0 THEN
+				SYSTEM.MOVE( ADDRESSOF( s[0] ), ADDRESSOF( buf[0] ), len )
+			END;
+		END Set;
+
+	(** Set the contents of the string buffer.  The len parameter specifies the size of the buffer s. *)
+		PROCEDURE SetRaw*(CONST s: ARRAY OF CHAR;  ofs, len: BufferOffset );
+		BEGIN
+			IF len > LEN( buf ) THEN len := LEN( buf ) END;
+			head := 0;  tail := len;  received := len;  res := Ok;
+			ASSERT ( (len >= 0) & (ofs + len <= LEN( s )) );   (* index check *)
+			IF len > 0 THEN
+				SYSTEM.MOVE( ADDRESSOF( s[ofs] ), ADDRESSOF( buf[0] ), len )
+			END;
+		END SetRaw;
+
+	END StringReader;
+
+	Bytes2 = ARRAY 2 OF CHAR;
+	Bytes4 = ARRAY 4 OF CHAR;
+	Bytes8 = ARRAY 8 OF CHAR;
+
+VAR
+	months: ARRAY 12 * 4 + 1 OF CHAR;
+
+
+	(** Open a writer to the specified stream sender.  Update must be called after writing to ensure the buffer is written to the stream. *)
+	PROCEDURE OpenWriter*( VAR b: Writer;  send: Sender );
+	BEGIN
+		NEW( b, send, DefaultWriterSize )
+	END OpenWriter;
+
+(** Open a reader from the specified stream receiver. *)
+	PROCEDURE OpenReader*( VAR b: Reader;  receive: Receiver );
+	BEGIN
+		NEW( b, receive, DefaultReaderSize )
+	END OpenReader;
+
+(** Copy the contents of a reader to a writer *)
+	PROCEDURE Copy* (r: Reader; w: Writer);
+	VAR char: CHAR;
+	BEGIN
+		WHILE r.res = Ok DO
+			r.Char (char);
+			IF r.res = Ok THEN w.Char (char) END
+		END;
+	END Copy;
+
+
+BEGIN
+	months := " Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec";
+END Streams.
+
+(**
+Notes:
+o	Any single buffer instance must not be accessed by more than one process concurrently.
+o 	The interface is blocking (synchronous).  If an output buffer is full, it is written with a synchronous write, which returns
+	only when all the data has been written.   If an input buffer is empty, it is read with a synchronous read, which only returns
+	once some data has been read.  The only exception is the Available() procedure, which "peeks" at the input stream
+	and returns 0 if no data is currently available.
+o 	All procedures set res to the error code reported by the lower-level I/O operation (non-zero indicates error).
+	 E.g. closing an underlying TCP connection will result in the Read* procedures returning a non-zero error code.
+o 	res is sticky.  Once it becomes non-zero, it remains non-zero.
+o 	The only way to detect end of file is to attempt to read past the end of file, which returns a non-zero error code.
+o 	All output written to an erroneous buffer is ignored.
+o 	The value returned when reading from an erroneous buffer is undefined, except for the Read procedure, which returns 0X.
+o 	ReadBytes sets the len parameter to the number of bytes that were actually read, e.g. if size = 10, and only 8 bytes are read, len is 8.
+o 	Raw format is little-endian 2's complement integers, IEEE reals and 0X-terminated strings.
+o 	Syntax for ReadInt with hex = FALSE: num = ["-"] digit {digit}. digit = "0".."9".
+o 	Syntax for ReadInt with hex = TRUE: ["-"] hexdigit {hexdigit} ["H"|"h"]. hexdigit = digit | "A".."F" | "a".."f".
+o 	ReadInt with hex = TRUE allows "A".."F" as digits, and looks for a "H" character after the number.
+	If present, the number is interpreted as hexadecimal.  If hexadecimal digits are present, but no "H" flag,
+	the resulting decimal value is undefined.
+o 	ReadInt ignores overflow.
+o 	A Sender sends len bytes from buf at ofs to output and returns res non-zero on error.  It waits until all the data is written,
+	or an error occurs.
+o 	A Receiver receives up to size bytes from input into buf at ofs and returns the number of bytes read in len.
+	It returns res non-zero on error.  It waits until at least min bytes (possibly zero) are available, or an error occurs.
+o 	EOLN and ReadLn recognize the following end-of-line characters: CR, LF and CR/LF.
+o 	To read an unstructured file token-by-token: WHILE (r.res = 0) DO SkipWhitespace; ReadToken END
+o 	To read a line structured file token-by-token: WHILE r.res = 0 DO SkipSpaces; WHILE ~EOLN DO ReadToken; SkipSpaces END END
+o 	A string writer is not flushed when it becomes full, but res is set to a non-zero value.
+o 	Update has no effect on a string writer.
+o 	GetString can be called on a string writer to return the buffer contents and reset it to empty.
+o 	GetString always appends a 0X character to the buffer, but returns the true length (excluding the added 0X) in the len parameter,
+	so it can also be used for binary data that includes 0X characters.
+o 	Receive procedure should set res to EOF when attempting to read past the end of file.
+*)
+
+
+(*
+to do:
+o stream byte count
+o read formatted data
+o reads for all formatted writes
+o write reals
+o low-level version that can be used in kernel (below KernelLog)
+*)

source/Windows.IO64.HostFiles.Mod

@@ -0,0 +1,1279 @@
+MODULE HostFiles;   (*AUTHOR "fof,ejz"; PURPOSE "Windows file system  for WinAos"; *)
+
+IMPORT SYSTEM, Machine, Kernel32, KernelLog, Modules, Kernel, Files, Commands;
+
+CONST
+	PathDelimiter = "\";  BufferSize = 4096;
+	(** File flags *)
+	ReadOnly* = Files.ReadOnly;
+	Directory* = Files.Directory;
+	Hidden* = Files.Hidden;
+	System* = Files.System;
+	Archive* = Files.Archive;
+	Temporary* = Files.Temporary;
+
+	TraceFile = 0;  TraceFileSystem = 1;  TraceCollection = 2;  TraceSearch = 3;  Trace = {};
+	TraceMounting=FALSE;
+	deviceArrival* = 08000H;   (* DBT_DEVICEARRIVAL = 08000H *)
+	deviceRemove* = 08004H;   (* DBT_DEVICEREMOVECOMPLETE = 08004H *)
+
+
+TYPE
+	FileName = ARRAY Kernel32.MaxPath OF CHAR;
+	PFileName = POINTER TO FileName;
+	NotificationProc* = PROCEDURE ( type: LONGINT;  drives: SET );
+	Notification = POINTER TO RECORD
+		p: NotificationProc;
+		next: Notification
+	END;
+
+VAR
+	searchPath: ARRAY 4 * Kernel32.MaxPath OF CHAR;
+	workPath, tempPath: FileName;  notifications: Notification;
+TYPE
+
+	SearchByName = OBJECT
+	VAR sname: FileName;
+		found: File;
+
+		PROCEDURE Init( name: ARRAY OF CHAR );
+		BEGIN
+			found := NIL;  UpperCase( name, sname )
+		END Init;
+
+		PROCEDURE EnumFile( f: ANY;  VAR cont: BOOLEAN );
+		VAR F: File;  fname: FileName;
+		BEGIN
+			F := f( File );  UpperCase( F.fname, fname );
+
+			IF TraceSearch IN Trace THEN KernelLog.String( "Enumerate: " );  KernelLog.String( fname );
+			END;
+			IF sname = fname THEN found := F;  cont := FALSE ELSE cont := TRUE END;
+			IF TraceSearch IN Trace THEN
+				IF cont THEN KernelLog.String( " # " );  ELSE KernelLog.String( " = " );  END;
+				KernelLog.String( sname );  KernelLog.Ln;
+			END;
+		END EnumFile;
+
+	END SearchByName;
+
+	FinalizeFiles = OBJECT
+
+		PROCEDURE EnumFile( f: ANY;  VAR cont: BOOLEAN );
+		VAR F: File;
+		BEGIN
+			F := f( File );  F.Finalize();  cont := TRUE
+		END EnumFile;
+
+	END FinalizeFiles;
+
+	Collection = OBJECT  (* methods in Collection shared by objects Filesystem and File *)
+	VAR oldFiles, newFiles: Kernel.FinalizedCollection;
+		search: SearchByName;
+		fileKey: LONGINT;
+
+		PROCEDURE & Init*;
+		BEGIN
+			NEW( oldFiles );  NEW( newFiles );  NEW( search );  fileKey := -1;
+		END Init;
+
+		PROCEDURE GetNextFileKey( ): LONGINT;
+		BEGIN {EXCLUSIVE}
+			DEC( fileKey );  RETURN fileKey
+		END GetNextFileKey;
+
+		PROCEDURE Register( F: File );
+		BEGIN {EXCLUSIVE}
+			IF TraceCollection IN Trace THEN KernelLog.String( "Collections.Register " );  KernelLog.String( F.fname );  KernelLog.Ln;  END;
+			oldFiles.Add( F, FinalizeFile );  newFiles.Remove( F );  DEC( fileKey );  F.Init( F.fname, F.hfile, fileKey,F.fileSystem );
+		END Register;
+
+		PROCEDURE Unregister( F: File );
+		BEGIN {EXCLUSIVE}
+			IF TraceCollection IN Trace THEN KernelLog.String( "Unregister " );  KernelLog.String( F.fname );  KernelLog.Ln;  END;
+			oldFiles.Remove( F );  newFiles.Add( F, FinalizeFile (* FinalizeFile*) );  F.Init( F.fname, Kernel32.InvalidHandleValue, 0, F.fileSystem );
+		END Unregister;
+
+		PROCEDURE AddNew( F: File );
+		BEGIN {EXCLUSIVE}
+			IF TraceCollection IN Trace THEN KernelLog.String( "Collections.AddNew: " );  KernelLog.String( F.fname );  KernelLog.Ln;  END;
+			newFiles.Add( F, FinalizeFile );
+		END AddNew;
+
+		PROCEDURE AddOld( F: File );
+		BEGIN {EXCLUSIVE}
+			IF TraceCollection IN Trace THEN KernelLog.String( "Collections.AddOld: " );  KernelLog.String( F.fname );  KernelLog.Ln;  END;
+			oldFiles.Add( F, FinalizeFile );
+		END AddOld;
+
+		PROCEDURE ByName( VAR fname: ARRAY OF CHAR ): File;
+		BEGIN {EXCLUSIVE}
+			IF TraceCollection IN Trace THEN KernelLog.String( "Collections.ByName: " );  KernelLog.String( fname );  KernelLog.Ln;  END;
+			search.Init( fname );  oldFiles.Enumerate( search.EnumFile );  RETURN search.found
+		END ByName;
+
+		PROCEDURE ByNameNotGC( VAR fname: ARRAY OF CHAR ): File;
+		BEGIN {EXCLUSIVE}
+			IF TraceCollection IN Trace THEN KernelLog.String( "Collections.ByName: " );  KernelLog.String( fname );  KernelLog.Ln;  END;
+			search.Init( fname );  oldFiles.EnumerateN( search.EnumFile );  RETURN search.found;
+		END ByNameNotGC;
+
+		PROCEDURE Finalize;
+		VAR fin: FinalizeFiles;
+		BEGIN {EXCLUSIVE}
+			IF TraceCollection IN Trace THEN KernelLog.String( "Collections.Finalize " );  KernelLog.Ln;  END;
+			NEW( fin );  newFiles.Enumerate( fin.EnumFile );  newFiles.Clear();  oldFiles.Enumerate( fin.EnumFile );  oldFiles.Clear();
+		END Finalize;
+
+		PROCEDURE FinalizeFile( obj: ANY );
+		VAR F: File;
+		BEGIN
+			F := obj( File );
+			IF TraceCollection IN Trace THEN KernelLog.String( "Collections.FinalizeFile " );  KernelLog.String( F.fname );  KernelLog.Ln;  END;
+			F.Finalize()
+		END FinalizeFile;
+
+	END Collection;
+
+	AliasFileSystem* = OBJECT (Files.FileSystem)
+	VAR fs: WinFileSystem;
+		useprefix*: BOOLEAN;
+
+		PROCEDURE Prefix( CONST name: ARRAY OF CHAR; VAR res: ARRAY OF CHAR );
+		BEGIN
+			IF useprefix & (name # "") THEN Join( prefix, ":", name, res );  ELSE COPY( name, res );  END;
+		END Prefix;
+
+		PROCEDURE & Init*;
+		BEGIN
+			SELF.fs := winFS;  useprefix := TRUE;  INCL( flags, Files.NeedsPrefix );
+		END Init;
+
+		PROCEDURE New0*( name: ARRAY OF CHAR ): Files.File;
+		VAR fname: FileName;  f: Files.File;
+		BEGIN
+			Prefix( name, fname ); f := fs.New0( fname ); IF f # NIL THEN  f.fs := SELF; END;  RETURN f;
+		END New0;
+
+		PROCEDURE Old0*( name: ARRAY OF CHAR ): Files.File;
+		VAR fname: FileName;   f: Files.File;
+		BEGIN
+			Prefix( name, fname );  f :=  fs.Old0( fname ); IF f # NIL THEN  f.fs := SELF; END; RETURN f;
+		END Old0;
+
+		PROCEDURE Delete0*( name: ARRAY OF CHAR;  VAR key: LONGINT; VAR res: WORD );
+		VAR fname: FileName;
+		BEGIN
+			Prefix( name, fname );  fs.Delete0( fname, key, res );
+		END Delete0;
+
+		PROCEDURE Rename0*( old, new: ARRAY OF CHAR;  fold: Files.File;  VAR res: WORD );
+		VAR old0, new0: FileName;
+		BEGIN
+			Prefix( old, old0 );  Prefix( new, new0 );  fs.Rename0( old0, new0, fold, res );
+		END Rename0;
+
+		PROCEDURE Enumerate0*( mask: ARRAY OF CHAR;  flags: SET;  enum: Files.Enumerator );
+		VAR fmask: FileName;
+		BEGIN
+			Prefix( mask, fmask );  fs.Enumerate1( fmask, flags, enum, useprefix );
+		END Enumerate0;
+
+		PROCEDURE FileKey*( name: ARRAY OF CHAR ): LONGINT;
+		VAR fname: FileName;
+		BEGIN
+			Prefix( name, fname );  RETURN fs.FileKey( fname );
+		END FileKey;
+
+		PROCEDURE CreateDirectory0*( name: ARRAY OF CHAR;  VAR res: WORD );
+		VAR fname: FileName;
+		BEGIN
+			Prefix( name, fname );  fs.CreateDirectory0( fname, res );
+		END CreateDirectory0;
+
+		PROCEDURE RemoveDirectory0*( name: ARRAY OF CHAR;  force: BOOLEAN;  VAR key: LONGINT; VAR res: WORD );
+		VAR fname: FileName;
+		BEGIN
+			Prefix( name, fname );  fs.RemoveDirectory0( fname, force, key, res );
+		END RemoveDirectory0;
+
+		PROCEDURE Has*(CONST name: ARRAY OF CHAR; VAR fullName: ARRAY OF CHAR; VAR flags: SET): BOOLEAN;
+		VAR fname: FileName;
+		BEGIN
+			Prefix(name, fname );  RETURN fs.Has(fname, fullName, flags);
+		END Has;
+
+
+	END AliasFileSystem;
+
+	WinFileSystem = OBJECT (* own object for synchronisation of all actions on the (unique) windows file system *)
+	VAR collection: Collection;
+
+		PROCEDURE & Init*;
+		BEGIN
+			NEW( collection );
+		END Init;
+
+		PROCEDURE New0( name: ARRAY OF CHAR ): Files.File;
+		VAR F: File;  fname: FileName;
+		BEGIN {EXCLUSIVE}
+			ConvertChar( name, Files.PathDelimiter, PathDelimiter );
+			IF TraceFileSystem IN Trace THEN KernelLog.String( "New0 " );  KernelLog.String( name );  KernelLog.Ln;  END;
+			F := NIL;
+			IF name = "" THEN  (* temporary file *)
+				NEW( F, name, Kernel32.InvalidHandleValue, 0, SELF ); collection.AddNew( F );
+			ELSIF FullPathName( name, fname ) & CheckPath(fname) THEN
+				NEW( F, fname, Kernel32.InvalidHandleValue, 0, SELF ); collection.AddNew( F );
+			END;
+			IF TraceFileSystem IN Trace THEN KernelLog.String( "failed" );  KernelLog.Ln;  END;
+			RETURN F;
+		END New0;
+
+		PROCEDURE Old0( name: ARRAY OF CHAR ): Files.File;
+		VAR F: File;  hfile: Kernel32.HANDLE;  fname: FileName;
+		BEGIN {EXCLUSIVE}
+			ConvertChar( name, Files.PathDelimiter, PathDelimiter );
+			IF TraceFileSystem IN Trace THEN KernelLog.String( "Old0 " );  KernelLog.String( name );  KernelLog.Ln;  END;
+
+			IF (name # "") & FindFile( name, fname ) THEN
+				hfile := Kernel32.CreateFile( fname, {Kernel32.GenericRead}, {Kernel32.FileShareRead, Kernel32.FileShareWrite}, NIL , Kernel32.OpenExisting, {Kernel32.FileAttributeNormal}, 0 );
+				IF hfile # Kernel32.InvalidHandleValue THEN NEW( F, fname, hfile, collection.GetNextFileKey() , SELF);    collection.AddOld( F );  RETURN F END
+			END;
+			IF TraceFileSystem IN Trace THEN KernelLog.String( "failed" );  KernelLog.Ln;  END;
+			RETURN NIL
+		END Old0;
+
+		PROCEDURE Delete0( name: ARRAY OF CHAR;  VAR key: LONGINT; VAR res: WORD );
+		VAR fname: FileName;  F: File;  ret: Kernel32.BOOL;
+		BEGIN {EXCLUSIVE}
+			ConvertChar( name, Files.PathDelimiter, PathDelimiter );  key := 0;  res := 1;
+			IF FullPathName( name, fname ) THEN
+				F := collection.ByName( fname );
+				IF F # NIL THEN
+					key := F.key;
+					IF F.ToTemp() THEN res := 0 END;
+				ELSE
+					ret := Kernel32.DeleteFile( fname );
+					IF ret # 0 THEN res := 0 END
+				END
+			END
+		END Delete0;
+
+		PROCEDURE Rename0( old, new: ARRAY OF CHAR;  fold: Files.File;  VAR res: WORD );
+		VAR fnold, fnnew: FileName;  Fo, Fn: File;  ret: Kernel32.BOOL;
+		BEGIN {EXCLUSIVE}
+			IF TraceFileSystem IN Trace THEN KernelLog.String( "Rename " );  KernelLog.String( old );  KernelLog.String( " -> " );  KernelLog.String( new );  KernelLog.Ln;  END;
+			ConvertChar( old, Files.PathDelimiter, PathDelimiter );  ConvertChar( new, Files.PathDelimiter, PathDelimiter );  res := 1;
+			IF FullPathName( old, fnold ) & FullPathName( new, fnnew ) THEN
+				Fn := collection.ByName( fnnew );
+				IF Fn # NIL THEN
+					IF ~Fn.ToTemp() THEN RETURN END
+				END;
+				IF fold # NIL THEN
+					Fo := fold( File );
+					IF ~Fo.ToTemp() THEN RETURN END;
+					ret := Kernel32.CopyFile( Fo.tfname^, fnnew, 0 )
+				ELSE ret := Kernel32.MoveFileEx( fnold, fnnew, {Kernel32.MoveFileReplaceExisting, Kernel32.MoveFileCopyAllowed} )
+				END;
+				IF ret # 0 THEN res := 0 END
+			ELSIF TraceFileSystem IN Trace THEN KernelLog.String( "Rename failed :" );  KernelLog.String( fnold );  KernelLog.String( " => " );  KernelLog.String( fnnew );  KernelLog.Ln;
+			END
+		END Rename0;
+
+		PROCEDURE Enumerate1( mask: ARRAY OF CHAR;  flags: SET;  enum: Files.Enumerator;  useprefix: BOOLEAN );
+		VAR i, j: LONGINT;
+			path, pattern: ARRAY 256 OF CHAR;
+			attr: SET;  curPath, longname: FileName;
+
+			PROCEDURE EnumeratePath;
+			VAR h: Kernel32.HANDLE;  FD: Kernel32.FindData;  ft: Kernel32.FileTime;  st: Kernel32.SystemTime;  i, j, t, d: LONGINT;
+			BEGIN
+				i := 0;
+				WHILE curPath[i] # 0X DO INC( i ) END;
+				IF curPath[i - 1] # PathDelimiter THEN curPath[i] := PathDelimiter;  INC( i );  curPath[i] := 0X END;
+				j := i - 1;  h := 0;
+				WHILE pattern[h] # 0X DO curPath[i] := pattern[h];  INC( i );  INC( h ) END;
+				IF h = 0 THEN curPath[i] := "*";  INC( i );  curPath[i] := ".";  INC( i );  curPath[i] := "*";  INC( i ) END;
+				curPath[i] := 0X;
+
+				h := Kernel32.FindFirstFile( curPath, FD );  curPath[j] := 0X;  ConvertChar( curPath, PathDelimiter, Files.PathDelimiter ); FixDriveLetter (curPath);
+				IF h # Kernel32.InvalidHandleValue THEN
+					t := 0;  d := 0;
+					REPEAT
+						IF Files.EnumTime IN flags THEN
+							Kernel32.FileTimeToLocalFileTime( FD.ftLastWriteTime, ft );  Kernel32.FileTimeToSystemTime( ft, st );
+							d := LONG( st.wYear - 1900 ) * 200H + LONG( st.wMonth ) * 20H + LONG( st.wDay );  t := LONG( st.wHour ) * 1000H + LONG( st.wMinute ) * 40H + LONG( st.wSecond );
+						END;
+						Join( curPath, "/", FD.cFileName, longname );
+						IF ~(Kernel32.FileAttributeDirectory IN FD.dwFileAttributes) THEN
+							enum.PutEntry( longname, {}, t, d, HUGEINT(UNSIGNED64( FD.nFileSizeHigh ) * UNSIGNED64( 0x100000000 ) + UNSIGNED64( FD.nFileSizeLow )))
+						ELSIF (FD.cFileName # ".") & (FD.cFileName # "..") THEN
+							enum.PutEntry( longname, {Files.Directory}, t, d, HUGEINT(UNSIGNED64( FD.nFileSizeHigh ) * UNSIGNED64( 0x100000000 ) + UNSIGNED64( FD.nFileSizeLow )))
+						END;
+					UNTIL Kernel32.FindNextFile( h, FD ) = Kernel32.False;
+					Kernel32.FindClose( h )
+				END;
+			END EnumeratePath;
+
+		BEGIN {EXCLUSIVE}
+			COPY( mask, path );  ConvertChar( path, Files.PathDelimiter, PathDelimiter );  attr := Kernel32.GetFileAttributes( path );  path := "";
+			IF (Kernel32.FileAttributeDirectory IN attr) & (~(Kernel32.FileAttributeTemporary IN attr)) THEN COPY( mask, path );  COPY( "*", pattern );  ELSE Files.SplitPath( mask, path, pattern );  END;
+			IF TraceFileSystem IN Trace THEN
+				KernelLog.String( "Enumerate0: " );   KernelLog.String( mask );  KernelLog.String( " :: " );  KernelLog.String( path );  KernelLog.String( " :: " );  KernelLog.String( pattern );  KernelLog.Ln;
+			END;
+
+			IF enum = NIL THEN RETURN
+			END;
+			IF path = "." THEN COPY( workPath, curPath );  EnumeratePath()
+			ELSIF IsLocalPath(path) THEN
+				COPY( workPath, curPath );
+				IF path # "" THEN
+					ConvertChar(curPath, PathDelimiter, Files.PathDelimiter);
+					Files.JoinPath(curPath, path, curPath);
+					ConvertChar( curPath, Files.PathDelimiter, PathDelimiter );
+				END;
+				EnumeratePath();
+				IF ~useprefix THEN
+					i := 0;  j := 0;
+					WHILE searchPath[i] # 0X DO
+						IF searchPath[i] # ";" THEN curPath[j] := searchPath[i];  INC( j )
+						ELSIF j > 0 THEN
+							curPath[j] := 0X;
+							IF curPath # workPath THEN
+								IF path # "" THEN
+									ConvertChar(curPath, PathDelimiter, Files.PathDelimiter);
+									Files.JoinPath(curPath, path, curPath);
+									ConvertChar( curPath, Files.PathDelimiter, PathDelimiter );
+								END;
+								EnumeratePath()
+							END;
+							j := 0
+						END;
+						INC( i )
+					END;
+					IF j > 0 THEN
+						curPath[j] := 0X;
+						IF path # "" THEN
+							ConvertChar(curPath, PathDelimiter, Files.PathDelimiter);
+							Files.JoinPath(curPath, path, curPath);
+							ConvertChar( curPath, Files.PathDelimiter, PathDelimiter );
+						END;
+						IF curPath # workPath THEN EnumeratePath() END
+					END;
+				END;
+			ELSE (* path is an absolute path *)
+				COPY( path, curPath );  ConvertChar( curPath, Files.PathDelimiter, PathDelimiter );  EnumeratePath()
+			END;
+		END Enumerate1;
+
+		PROCEDURE FileKey( name: ARRAY OF CHAR ): LONGINT;
+		VAR fname: FileName;  F: File;
+		BEGIN {EXCLUSIVE}
+			(*RETURN 0;  (* Finalizers may steal file *) *)
+
+			IF name = "" THEN RETURN 0 END;
+
+			IF TraceFileSystem IN Trace THEN KernelLog.String( "FileKey " );  KernelLog.String( name );  KernelLog.Ln;
+			END;
+			ConvertChar( name, Files.PathDelimiter, PathDelimiter );
+			IF FindFile( name, fname ) (* OR FullPathName(name,fname) *) THEN
+				F := collection.ByNameNotGC( fname );
+				IF F # NIL THEN RETURN F.key END
+			ELSIF TraceFileSystem IN Trace THEN KernelLog.String( "not found: " );  KernelLog.String( name );  KernelLog.String( "(" );  KernelLog.String( fname );  KernelLog.String( ")" );  KernelLog.Ln;
+			END;
+			IF TraceFileSystem IN Trace THEN KernelLog.String( "no key: " );  KernelLog.String( name );  KernelLog.String( "(" );  KernelLog.String( fname );  KernelLog.String( ")" );  KernelLog.Ln;  END;
+			RETURN 0
+
+		END FileKey;
+
+		PROCEDURE CreateDirectory0( name: ARRAY OF CHAR;  VAR res: WORD );
+		VAR ret: Kernel32.BOOL;
+		BEGIN {EXCLUSIVE}
+			ConvertChar( name, Files.PathDelimiter, PathDelimiter );  ret := Kernel32.CreateDirectory( name, NIL );
+			IF ret # 0 THEN
+				res := 0;
+			ELSIF Kernel32.GetLastError() = 183 (*ERROR_ALREADY_EXISTS*) THEN
+				res := Files.FileAlreadyExists;
+			ELSE
+				res := 1
+			END
+		END CreateDirectory0;
+
+		PROCEDURE RemoveDirectory0( name: ARRAY OF CHAR;  force: BOOLEAN;  VAR key: LONGINT; VAR res: WORD );
+		VAR ret: Kernel32.BOOL;
+		BEGIN {EXCLUSIVE}
+			ConvertChar( name, Files.PathDelimiter, PathDelimiter );  key := 0;  res := 1;
+			IF ~force THEN
+				ret := Kernel32.RemoveDirectory( name );
+				IF ret # 0 THEN res := 0 END
+			ELSE res := -1
+			END
+		END RemoveDirectory0;
+
+		PROCEDURE Finalize;
+		BEGIN
+			collection.Finalize();
+		END Finalize;
+
+		PROCEDURE Has*(CONST fileName: ARRAY OF CHAR; VAR fullName: ARRAY OF CHAR; VAR flags: SET): BOOLEAN;
+		VAR name: FileName;
+		BEGIN
+			COPY(fileName, name);
+			ConvertChar(name, Files.PathDelimiter, PathDelimiter );
+			IF FindFile(fileName, fullName) THEN
+				flags := FileFlags(Kernel32.GetFileAttributes(fullName));
+				ConvertChar(fullName, PathDelimiter,Files.PathDelimiter);
+				RETURN TRUE
+			ELSE
+				RETURN FALSE
+			END;
+		END Has;
+
+	END WinFileSystem;
+
+	Buffer = POINTER TO RECORD
+		data: ARRAY BufferSize OF CHAR;
+		apos: HUGEINT;
+		len: LONGINT;
+		dirty: BOOLEAN
+	END;
+
+	File* = OBJECT (Files.File)
+	VAR fname: FileName;
+		tfname: PFileName;
+		hfile: Kernel32.HANDLE;
+		buffer: Buffer;
+		fsize, fpos: HUGEINT;
+		fileSystem: WinFileSystem;
+
+		PROCEDURE & Init*( VAR name: ARRAY OF CHAR;  hfile: Kernel32.HANDLE;  key: LONGINT ; fs: WinFileSystem);
+		VAR s: WORDSET;  res: Kernel32.BOOL;
+		BEGIN
+			IF TraceFile IN Trace THEN KernelLog.String( "Init: " );  KernelLog.String( name );  KernelLog.String( " (" );  KernelLog.Int( key, 1 );  KernelLog.String( ")" );  KernelLog.Ln;  END;
+			SELF.key := key;  fpos := 0;  SELF.hfile := hfile;  COPY( name, SELF.fname );  tfname := NIL;
+			IF hfile # Kernel32.InvalidHandleValue THEN
+				ASSERT(Kernel32.GetFileSizeEx(hfile, fsize) # Kernel32.False); 
+				s := Kernel32.GetFileAttributes( name );
+				IF Kernel32.FileAttributeTemporary IN s THEN EXCL( s, Kernel32.FileAttributeTemporary );  res := Kernel32.SetFileAttributes( name, s );  ASSERT( res # 0 );  s := Kernel32.GetFileAttributes( name ) END;
+				flags := FileFlags( s )
+			ELSE flags := {Temporary};  fsize := 0
+			END;
+			IF buffer = NIL THEN NEW( buffer );  END;
+			buffer.apos := -1;  buffer.len := 0;  buffer.dirty := FALSE;
+			fileSystem := fs
+		END Init;
+
+		PROCEDURE Set*( VAR r: Files.Rider;  pos: HUGEINT );
+		VAR size: HUGEINT;
+		BEGIN {EXCLUSIVE}
+			IF hfile # Kernel32.InvalidHandleValue THEN
+				ASSERT( Kernel32.GetFileSizeEx( hfile, size ) # Kernel32.False );   (* maybe Windows has modified the file since last access, but we ignore file changes once the file rider is set *)
+				IF size > fsize THEN fsize := size END;
+			END;
+			r.eof := FALSE;  r.res := 0;  r.file := SELF;  r.fs := fs;
+			IF pos < 0 THEN pos := 0
+			ELSIF pos > fsize THEN pos := fsize
+			END;
+			r.apos := pos DIV BufferSize;  r.bpos := LONGINT( pos MOD BufferSize )
+		END Set;
+
+		PROCEDURE Pos*( VAR r: Files.Rider ): HUGEINT;
+		BEGIN
+			RETURN r.apos * BufferSize + r.bpos
+		END Pos;
+
+		PROCEDURE WriteBuffer;
+		VAR pos: HUGEINT; n: LONGINT; res, b: Kernel32.BOOL;
+		BEGIN
+			ASSERT( buffer.dirty );  ASSERT( buffer.len > 0 );
+			pos := buffer.apos * BufferSize;
+			IF hfile = Kernel32.InvalidHandleValue THEN
+				ASSERT( Temporary IN flags );  NEW( tfname );  TempName( tfname^ );
+				hfile := Kernel32.CreateFile( tfname^, {Kernel32.GenericRead, Kernel32.GenericWrite}, {Kernel32.FileShareRead}, NIL , Kernel32.CreateAlways, {Kernel32.FileAttributeTemporary}, 0 );
+				ASSERT( hfile # Kernel32.InvalidHandleValue );  fpos := 0
+			END;
+			IF fpos # pos THEN ASSERT( Kernel32.SetFilePointerEx( hfile, pos, fpos , Kernel32.FileBegin ) # Kernel32.False ); END;
+			res := Kernel32.WriteFile( hfile, buffer.data, buffer.len, n, NIL );
+			IF (res = Kernel32.False) & ~(ReadOnly IN flags) THEN
+				res := Kernel32.CloseHandle( hfile );
+				IF TraceFile IN Trace THEN KernelLog.String( "closed handle of " );  KernelLog.String( fname );  KernelLog.Ln;  END;
+				hfile :=
+					Kernel32.CreateFile( fname, {Kernel32.GenericRead, Kernel32.GenericWrite}, {Kernel32.FileShareRead, Kernel32.FileShareWrite}, NIL , Kernel32.OpenExisting, {Kernel32.FileAttributeNormal}, 0 );
+				ASSERT( hfile # Kernel32.InvalidHandleValue );
+				ASSERT( Kernel32.SetFilePointerEx( hfile, pos, fpos , Kernel32.FileBegin ) # Kernel32.False );
+				res := Kernel32.WriteFile( hfile, buffer.data, buffer.len, n, NIL )
+			END;
+			ASSERT( (res # Kernel32.False) & (n = buffer.len) );
+			INC( fpos, n );  buffer.dirty := FALSE
+		END WriteBuffer;
+
+		PROCEDURE ReadBuffer( apos: HUGEINT );
+		VAR pos: HUGEINT; n: LONGINT;  res, b: Kernel32.BOOL;
+		BEGIN
+			IF buffer.dirty THEN WriteBuffer() END;
+			pos := apos * BufferSize;
+			IF pos >= fsize THEN buffer.apos := apos;  buffer.len := 0;  RETURN END;
+			IF fpos # pos THEN
+				ASSERT( Kernel32.SetFilePointerEx( hfile, pos, fpos , Kernel32.FileBegin ) # Kernel32.False );
+				IF (fpos # pos) THEN KernelLog.String( "failed to set buffer: " );  KernelLog.String( fname );  KernelLog.Ln END;
+				ASSERT( fpos = pos )
+			END;
+			res := Kernel32.ReadFile( hfile, buffer.data, BufferSize, n, NIL );
+			IF res = 0 THEN KernelLog.String( "read file did not work for: " );  KernelLog.String( fname );  KernelLog.Ln;  END;
+			ASSERT( res # 0 );  INC( fpos, n );  buffer.apos := apos;  buffer.len := n
+		END ReadBuffer;
+
+		PROCEDURE Read*( VAR r: Files.Rider;  VAR x: CHAR );
+		VAR pos: HUGEINT;
+		BEGIN {EXCLUSIVE}
+			pos := r.apos * BufferSize + r.bpos;
+			IF pos < fsize THEN
+				IF buffer.apos # r.apos THEN ReadBuffer( r.apos ) END;
+				x := buffer.data[r.bpos];  INC( pos );  r.apos := pos DIV BufferSize;  r.bpos := LONGINT( pos MOD BufferSize )
+			ELSE
+				x := 0X; r.eof := TRUE
+			END
+		END Read;
+
+		PROCEDURE ReadBytes*( VAR r: Files.Rider;  VAR x: ARRAY OF CHAR;  ofs, len: LONGWORD );
+		VAR pos: HUGEINT; n: LONGWORD;
+		BEGIN {EXCLUSIVE}
+			ASSERT( (ofs + len) <= LEN( x ) );
+			pos := r.apos * BufferSize + r.bpos;
+			WHILE (len > 0) & (pos < fsize) DO
+				IF buffer.apos # r.apos THEN ReadBuffer( r.apos ) END;
+				n := buffer.len - r.bpos;
+				IF (n > 0) THEN
+					IF n > len THEN n := len END;
+					SYSTEM.MOVE( ADDRESSOF( buffer.data[r.bpos] ), ADDRESSOF( x[ofs] ), n );
+					INC( pos, n );  INC( ofs, n );  DEC( len, n );
+					r.apos := pos DIV BufferSize;  r.bpos := LONGINT( pos MOD BufferSize );
+				ELSE
+					pos := fsize;
+				END;
+			END;
+			r.res := len; r.eof := (pos > fsize) OR ((pos = fsize) & (len > 0));
+		END ReadBytes;
+
+		PROCEDURE Write*( VAR r: Files.Rider;  x: CHAR );
+		VAR pos: HUGEINT;
+		BEGIN {EXCLUSIVE}
+			pos := r.apos * BufferSize + r.bpos;
+			IF buffer.apos # r.apos THEN ReadBuffer( r.apos ) END;
+			buffer.data[r.bpos] := x;  INC( pos );
+			IF (r.bpos + 1) > buffer.len THEN buffer.len := r.bpos + 1 END;
+			r.apos := pos DIV BufferSize;  r.bpos := LONGINT( pos MOD BufferSize );
+			IF pos > fsize THEN fsize := pos END;
+			buffer.dirty := TRUE;
+		END Write;
+
+		PROCEDURE WriteBytes*( VAR r: Files.Rider;  CONST x: ARRAY OF CHAR;  ofs, len: LONGWORD );
+		VAR pos: HUGEINT; n: LONGINT;
+		BEGIN {EXCLUSIVE}
+			IF len = 0 THEN RETURN END;
+			ASSERT( (len > 0) & ((ofs + len) <= LEN( x )) );  pos := r.apos * BufferSize + r.bpos;
+			WHILE len > 0 DO
+				IF buffer.apos # r.apos THEN ReadBuffer( r.apos ) END;
+				n := BufferSize - r.bpos;
+				IF n > len THEN n := LONGINT( len ) END; (*! TODO *)
+				SYSTEM.MOVE( ADDRESSOF( x[ofs] ), ADDRESSOF( buffer.data[r.bpos] ), n );
+				IF (r.bpos + n) > buffer.len THEN buffer.len := r.bpos + n END;
+				INC( pos, n );  INC( ofs, n );  DEC( len, n );  r.apos := pos DIV BufferSize;  r.bpos := LONGINT( pos MOD BufferSize );
+				IF pos > fsize THEN fsize := pos END;
+				buffer.dirty := TRUE
+			END
+		END WriteBytes;
+
+		PROCEDURE Length*( ): HUGEINT;
+		BEGIN {EXCLUSIVE}
+			RETURN fsize
+		END Length;
+
+		PROCEDURE GetDate*( VAR t, d: LONGINT );
+		VAR ft, lft: Kernel32.FileTime;  st: Kernel32.SystemTime;  res: Kernel32.BOOL;
+		BEGIN {EXCLUSIVE}
+			res := Kernel32.GetFileTime( hfile, NIL , NIL , ft );
+			(*
+			ASSERT ( res # 0 );   (* <- only if file is not temporary ! *)
+			*)
+			res := Kernel32.FileTimeToLocalFileTime( ft, lft );  res := Kernel32.FileTimeToSystemTime( lft, st );  d := LONG( st.wYear - 1900 ) * 200H + LONG( st.wMonth ) * 20H + LONG( st.wDay );
+			t := LONG( st.wHour ) * 1000H + LONG( st.wMinute ) * 40H + LONG( st.wSecond )
+		END GetDate;
+
+		PROCEDURE SetDate*( t, d: LONGINT );
+		VAR ft, lft: Kernel32.FileTime;  st: Kernel32.SystemTime;  res: Kernel32.BOOL; err: LONGINT;
+		BEGIN {EXCLUSIVE}
+			st.wDay := SHORT( d MOD 20H );  d := ASH( d, -5 );  st.wMonth := SHORT( d MOD 10H );  d := ASH( d, -4 );  st.wYear := SHORT( d MOD 80H ) + 1900;  st.wMilliseconds := 0;
+			st.wSecond := SHORT( t MOD 40H );  t := ASH( t, -6 );  st.wMinute := SHORT( t MOD 40H );  t := ASH( t, -6 );  st.wHour := SHORT( t MOD 20H );  res := Kernel32.SystemTimeToFileTime( st, lft );
+			res := Kernel32.LocalFileTimeToFileTime( lft, ft );  res := Kernel32.SetFileTime( hfile, NIL , NIL , ft );
+			IF res = 0 THEN err := Kernel32.GetLastError(); DebugFile(SELF) END;
+			ASSERT( res # 0 )
+		END SetDate;
+
+		PROCEDURE GetAttributes*(): SET;
+		VAR s: WORDSET;
+		BEGIN
+			s := Kernel32.GetFileAttributes( fname );
+			RETURN FileFlags(s);
+		END GetAttributes;
+
+		PROCEDURE SetAttributes*(a: SET);
+		VAR s: WORDSET;
+		BEGIN
+			s:= WindowsFlags(a);
+			SetFileAttributes(fname,s);
+		END SetAttributes;
+
+		PROCEDURE GetName*( VAR name: ARRAY OF CHAR );
+		VAR i: LONGINT;  ch: CHAR;
+		BEGIN {EXCLUSIVE}
+			COPY( fname, name );  i := 0;  ch := name[0];
+			WHILE ch # 0X DO
+				IF ch = PathDelimiter THEN name[i] := Files.PathDelimiter END;
+				INC( i );  ch := name[i]
+			END
+		END GetName;
+
+		PROCEDURE ToTemp( ): BOOLEAN;
+		VAR tfname: PFileName;  res: Kernel32.BOOL;
+			from, to: ARRAY 256 OF CHAR;
+		BEGIN {EXCLUSIVE}
+			ASSERT( ~(Temporary IN flags) );
+			(*ALEX 2005.12.08*)
+			IF hfile = Kernel32.InvalidHandleValue THEN
+				hfile := Kernel32.CreateFile( fname, {Kernel32.GenericRead}, {Kernel32.FileShareRead, Kernel32.FileShareWrite}, NIL , Kernel32.CreateAlways, {Kernel32.FileAttributeNormal}, 0 );
+			END;
+			IF hfile = Kernel32.InvalidHandleValue THEN
+				hfile := Kernel32.CreateFile( fname, {Kernel32.GenericRead}, {Kernel32.FileShareRead, Kernel32.FileShareWrite}, NIL , Kernel32.OpenExisting, {Kernel32.FileAttributeNormal}, 0 );
+			END;
+			IF buffer.dirty THEN WriteBuffer() END;
+			(*
+			IF hfile # Kernel32.InvalidHandleValue THEN
+			*)
+			ASSERT(hfile # Kernel32.InvalidHandleValue);
+			ASSERT(Kernel32.GetFileSizeEx(hfile, fsize) # Kernel32.False);
+			res := Kernel32.CloseHandle( hfile );
+			 hfile := Kernel32.InvalidHandleValue;
+			(*
+			END;
+			*)
+			NEW( tfname );  TempName( tfname^ );  COPY( fname, from );  COPY( tfname^, to );
+			IF TraceFile IN Trace THEN KernelLog.String( "toTemp: " );  KernelLog.String( fname );  KernelLog.String( " => " );  KernelLog.String( tfname^ );  KernelLog.Ln;  END;
+			IF ~MoveFile( fname, tfname^ ) THEN HALT( 1241 ) (* RETURN FALSE *) END;
+			winFS.collection.Unregister( SELF );
+			hfile := Kernel32.CreateFile( tfname^, {Kernel32.GenericRead, Kernel32.GenericWrite}, {Kernel32.FileShareRead}, NIL , Kernel32.OpenExisting, {Kernel32.FileAttributeTemporary}, 0 );
+			(* IF hfile = Kernel32.InvalidHandleValue THEN RETURN FALSE END; *)
+			ASSERT( hfile # Kernel32.InvalidHandleValue );
+			ASSERT( Kernel32.GetFileSizeEx( hfile, fsize ) # Kernel32.False );
+			SELF.tfname := tfname;
+			COPY( tfname^, fname );
+			RETURN TRUE;
+		END ToTemp;
+
+		PROCEDURE Register0*( VAR res: WORD );
+		VAR F: File;  ret: Kernel32.BOOL;
+			from, to: ARRAY 256 OF CHAR;
+		BEGIN {EXCLUSIVE}
+			IF ~(Temporary IN flags) OR (fname = "") THEN res := 1;  RETURN END;
+			IF buffer.dirty THEN WriteBuffer() END;
+			IF hfile # Kernel32.InvalidHandleValue THEN ret := Kernel32.CloseHandle( hfile );  hfile := Kernel32.InvalidHandleValue END;
+			IF TraceFile IN Trace THEN KernelLog.String( "Register:  existing?: " );  KernelLog.String( fname );  KernelLog.Ln;  END;
+			F := winFS.collection.ByName( fname );
+			IF (TraceFile IN Trace) & (F = NIL ) THEN KernelLog.String( "Register: not existing: " );  KernelLog.String( fname );  KernelLog.Ln;  END;
+			IF (F # NIL ) THEN
+				IF ~F.ToTemp() THEN res := 1;  RETURN END
+			END;   (* registered file stays alive for its users *)
+
+			IF tfname # NIL THEN
+				COPY( tfname^, from );  COPY( fname, to );
+				IF ~MoveFile( tfname^, fname ) THEN
+					(* first try closing file -> for windows versions < 2000 *)
+					res := 1;  RETURN;
+					(* HALT( 1242 )*)
+				END;
+				hfile := Kernel32.CreateFile( fname, {Kernel32.GenericRead, Kernel32.GenericWrite}, {Kernel32.FileShareRead, Kernel32.FileShareWrite}, NIL , Kernel32.OpenExisting, {Kernel32.FileAttributeNormal}, 0 )
+			ELSE hfile := Kernel32.CreateFile( fname, {Kernel32.GenericRead, Kernel32.GenericWrite}, {Kernel32.FileShareRead, Kernel32.FileShareWrite}, NIL , Kernel32.CreateAlways, {Kernel32.FileAttributeNormal}, 0 )
+			END;
+			IF hfile = Kernel32.InvalidHandleValue THEN res := 1;  RETURN END;
+			ASSERT( hfile # Kernel32.InvalidHandleValue );  winFS.collection.Register( SELF );  res := 0
+		END Register0;
+
+		PROCEDURE Update*;
+		BEGIN {EXCLUSIVE}
+			IF buffer.dirty THEN WriteBuffer() END
+		END Update;
+
+		PROCEDURE Finalize*;
+		VAR res: Kernel32.BOOL;
+		BEGIN {EXCLUSIVE}
+			IF TraceFile IN Trace THEN KernelLog.String( "File.Finalize " );  KernelLog.String( fname );  KernelLog.Ln;  END;
+			IF hfile # Kernel32.InvalidHandleValue THEN
+				IF ~(Temporary IN flags) & buffer.dirty THEN WriteBuffer() END;
+
+				res := Kernel32.CloseHandle( hfile );  hfile := Kernel32.InvalidHandleValue;
+				IF (Temporary IN flags) & (tfname # NIL ) THEN
+					res := Kernel32.DeleteFile( tfname^ );
+					(*
+					KernelLog.String("Deleted: "); KernelLog.String(tfname^); KernelLog.Ln;
+					IF res = 0 THEN KernelLog.String("failed!"); KernelLog.Ln; END;
+					*)
+					(* ASSERT ( res # 0 ) *)
+				END;
+				(* ASSERT ( res # 0 ) *)
+
+			END
+		END Finalize;
+
+		PROCEDURE Close*;
+		BEGIN
+			Finalize;
+			fileSystem.collection.oldFiles.Remove(SELF);
+		END Close;
+
+
+	END File;
+VAR
+	winFS: WinFileSystem;   (* must be unique *)
+
+
+	PROCEDURE DebugFile(f: File);
+	BEGIN
+		KernelLog.String("fname = "); KernelLog.String(f.fname); KernelLog.Ln;
+		KernelLog.String("tname = "); IF f.tfname # NIL THEN KernelLog.String(f.tfname^) ELSE KernelLog.String("(NIL)") END; KernelLog.Ln;
+		KernelLog.String("hfile = "); KernelLog.Address(f.hfile); KernelLog.Ln;
+		KernelLog.String("fsize = "); KernelLog.Int(f.fsize, 1); KernelLog.Ln;
+		KernelLog.String("fpos = "); KernelLog.Int(f.fpos, 1); KernelLog.Ln;
+	END DebugFile;
+
+
+	PROCEDURE IsLocalPath(path: ARRAY OF CHAR): BOOLEAN;
+	VAR prefix, name: Files.FileName;
+	BEGIN
+		ConvertChar(path, PathDelimiter, Files.PathDelimiter);
+		Files.SplitName(path, prefix, name);
+		RETURN (prefix = "") & (name[0] # "/")
+	END IsLocalPath;
+
+
+	(* WinAPI functions like e.g. GetCurrentDirectory sometimes yield paths with drive letters in lowercase
+	   which have to be capitalized as they are mapped as filesystems which themselves are case sensitive *)
+	PROCEDURE FixDriveLetter (VAR path: ARRAY OF CHAR);
+	BEGIN
+		IF (LEN (path) >= 2) & (path[0] # 0X) & (path[1] = ':') THEN path[0] := CAP (path[0]) END;
+	END FixDriveLetter;
+
+	PROCEDURE MoveFile( VAR from, to: ARRAY OF CHAR ): BOOLEAN;
+	BEGIN
+		IF Kernel32.MoveFileEx( from, to, {Kernel32.MoveFileReplaceExisting, Kernel32.MoveFileCopyAllowed} ) = Kernel32.False THEN
+			IF Kernel32.CopyFile( from, to, Kernel32.False ) = Kernel32.False THEN
+				IF TraceFile IN Trace THEN KernelLog.String( "could not copy" );  KernelLog.Ln;  END;
+				RETURN FALSE
+			ELSE
+				IF Kernel32.DeleteFile( from ) = Kernel32.False THEN
+				END;
+				RETURN TRUE;   (* warning: Could not delete file ! *)
+			END
+		ELSE RETURN TRUE
+		END
+	END MoveFile;
+
+	PROCEDURE UpperCase( VAR src, dst: ARRAY OF CHAR );
+	VAR i: LONGINT;  ch: CHAR;
+	BEGIN
+		i := 0;  ch := src[0];
+		WHILE ch # 0X DO
+			IF (ch >= "a") & (ch <= "z") THEN ch := CAP( ch ) END;
+			dst[i] := ch;  INC( i );  ch := src[i]
+		END;
+		dst[i] := 0X
+	END UpperCase;
+
+	PROCEDURE TempName( VAR name: ARRAY OF CHAR );
+	VAR temp: FileName;
+		pref: ARRAY 4 OF CHAR;
+		ret: LONGINT;
+	BEGIN
+		ret := Kernel32.GetTempPath( LEN( temp ), temp );  ASSERT( ret > 0 );  pref := "Aos";  ret := Kernel32.GetTempFileName( temp, pref, 0, name ); FixDriveLetter (name); ASSERT( ret # 0 )
+	END TempName;
+
+	PROCEDURE FullPathName( name: ARRAY OF CHAR;  VAR fname: ARRAY OF CHAR ): BOOLEAN;
+	VAR i, fp: LONGINT;
+	BEGIN
+		i := Kernel32.GetFullPathName( name, Kernel32.MaxPath, fname, fp );
+		FixDriveLetter (fname); RETURN i > 0
+	END FullPathName;
+
+	(* convert flags from windows file flags to A2 file flags *)
+	PROCEDURE FileFlags( flags: WORDSET ): SET;
+	VAR s: SET;
+	BEGIN
+		s := {};
+		IF Kernel32.FileAttributeDirectory IN flags THEN INCL( s, Directory ) END;
+		IF Kernel32.FileAttributeReadonly IN flags THEN INCL( s, ReadOnly ) END;
+		IF Kernel32.FileAttributeHidden IN flags THEN INCL( s, Hidden ) END;
+		IF Kernel32.FileAttributeSystem IN flags THEN INCL( s, System ) END;
+		IF Kernel32.FileAttributeArchive IN flags THEN INCL( s, Archive ) END;
+		IF Kernel32.FileAttributeTemporary IN flags THEN INCL( s, Temporary ) END;
+		RETURN s
+	END FileFlags;
+
+	(* convert flags from A2 file flags to windows file flags *)
+	PROCEDURE WindowsFlags(flags: SET): WORDSET;
+	VAR s: WORDSET;
+	BEGIN
+		s := {};
+		IF  Directory IN flags THEN INCL( s,  Kernel32.FileAttributeDirectory) END;
+		IF ReadOnly IN flags THEN INCL( s,  Kernel32.FileAttributeReadonly ) END;
+		IF Hidden IN flags THEN INCL( s,  Kernel32.FileAttributeHidden) END;
+		IF System IN flags THEN INCL( s,  Kernel32.FileAttributeSystem) END;
+		IF Archive IN flags THEN INCL( s,  Kernel32.FileAttributeArchive) END;
+		IF Temporary IN flags THEN INCL( s,  Kernel32.FileAttributeTemporary) END;
+		RETURN s
+	END WindowsFlags;
+
+
+(** Generate a new file system object.  Files.NewVol has volume parameter, Files.Par has mount prefix. *)
+	PROCEDURE NewFS*(context : Files.Parameters);
+	VAR fs: AliasFileSystem;
+	BEGIN
+		IF (Files.This(context.prefix ) = NIL) THEN
+			NEW( fs );  fs.vol := context.vol;  Files.Add( fs, context.prefix );
+		ELSE
+			context.error.String( "HostFiles: " );  context.error.String( context.prefix );  context.error.String( " already in use" );
+			context.error.Ln;
+		 END;
+	END NewFS;
+
+	PROCEDURE Join( a1, a2, a3: ARRAY OF CHAR;  VAR res: ARRAY OF CHAR );
+	VAR i, j: LONGINT;
+	BEGIN
+		i := 0;
+		WHILE (a1[i] # 0X) DO res[j] := a1[i];  INC( i );  INC( j ) END;
+		i := 0;
+		WHILE (a2[i] # 0X) DO res[j] := a2[i];  INC( i );  INC( j ) END;
+		i := 0;
+		WHILE (a3[i] # 0X) DO res[j] := a3[i];  INC( i );  INC( j ) END;
+		res[j] := 0X
+	END Join;
+
+(*ALEX 2005.02.10, fof 071008*)
+	PROCEDURE MountDrive(CONST drive: ARRAY OF CHAR; context : Commands.Context);
+	VAR
+		p: Files.Parameters; namebuf1, namebuf2: FileName;  size, snum, mlen, sysfl: LONGINT;
+		res: WORD; prefix: ARRAY 256 OF CHAR;
+	BEGIN
+		COPY(drive,prefix);
+		size := LEN( namebuf1 );  res := Kernel32.GetVolumeInformation( prefix, namebuf1, size, snum, mlen, sysfl, namebuf2, size );
+		IF res = 0 THEN
+			IF context# NIL THEN
+				context.error.String("Not mounted (no volume information): "); context.error.String(prefix); context.error.Ln;
+				context.error.Update;
+			END;
+		ELSE
+			IF (context = NIL) THEN
+				NEW(context, NIL, NIL, NIL, NIL, NIL);
+			END;
+			NEW(p, context.in, context.arg, context.out, context.error, context.caller);
+			IF TraceMounting THEN
+				context.out.String( "Mounting: " );  context.out.String( drive );
+				context.out.String( " (" );  context.out.String( namebuf1 );  context.out.String( "), fs = " );
+				context.out.String( namebuf2 );  context.out.Ln;
+				context.out.Update;
+			END;
+			prefix[1] := 0X;
+			COPY( prefix, p.prefix );
+			NewFS( p );
+		END;
+	END MountDrive;
+
+	PROCEDURE AutoMountWindowsLogicalDrives( drives: SET );
+	(* fof 090221
+		implemented asynchronously as it blocked execution on A2 startup for a while;
+		now some of the drives may get mounted later in the system,
+		should not be a problem since the search path is handled through windows anyway
+	*)
+	VAR
+		AutoMountObject: OBJECT
+		VAR prefix: ARRAY 4 OF CHAR;  i: LONGINT; drives: SET;
+		PROCEDURE & Init(drives:SET);
+		BEGIN
+			SELF.drives := drives
+		END Init;
+
+		BEGIN {ACTIVE}
+			FOR i := 0 TO MAX( SET ) - 1 DO
+				IF i IN drives THEN
+					prefix := "X:\";  prefix[0] := CHR( ORD( "A" ) + i );
+					MountDrive(prefix, NIL);
+				END;
+			END;
+		END;
+	BEGIN
+		NEW(AutoMountObject,drives);
+	END AutoMountWindowsLogicalDrives;
+
+	PROCEDURE UnmountDrive(CONST drive: ARRAY OF CHAR; context : Commands.Context);
+	VAR this: Files.FileSystem;
+	BEGIN
+		this := Files.This( drive );
+		IF (this # NIL ) & (this IS AliasFileSystem) THEN
+			IF (context # NIL) THEN
+				context.out.String( "Auto Unmount: " );  context.out.String( drive );
+				context.out.String( ":" );  context.out.Ln;
+			ELSE
+				KernelLog.String("Auto Unmount: "); KernelLog.String(drive); KernelLog.String(":"); KernelLog.Ln;
+			END;
+			Files.Remove( this );
+		END;
+	END UnmountDrive;
+
+	PROCEDURE AutoUnmountLogicalDrives( drives: SET );
+	VAR i: LONGINT;
+		prefix: ARRAY 4 OF CHAR;
+	BEGIN
+		FOR i := 0 TO MAX( SET ) - 1 DO
+			IF i IN drives THEN
+				prefix[0] := CHR( ORD( "A" ) + i );  prefix[1] := 0X;
+				UnmountDrive(prefix, NIL);
+			END;
+		END;
+	END AutoUnmountLogicalDrives;
+
+	PROCEDURE Finalization;
+	VAR ft: Files.FileSystemTable;  i: LONGINT;
+	BEGIN
+		Files.GetList( ft );
+		IF ft # NIL THEN
+			FOR i := 0 TO LEN( ft^ ) - 1 DO
+				IF ft[i] IS AliasFileSystem THEN Files.Remove( ft[i] ) END
+			END
+		END;
+		winFS.Finalize;
+	END Finalization;
+
+	PROCEDURE FindFile*( name: ARRAY OF CHAR;  VAR fullname: ARRAY OF CHAR ): BOOLEAN;
+	VAR ret: LONGINT;  fileName: Kernel32.LPSTR;
+	BEGIN
+		ret := Kernel32.SearchPath( workPath, name, NIL , LEN( fullname ), fullname, fileName );
+		IF (ret <= 0) THEN ret := Kernel32.SearchPath( searchPath, name, NIL , LEN( fullname ), fullname, fileName ) END;
+		FixDriveLetter (fullname);
+		RETURN ret > 0;
+	END FindFile;
+
+	PROCEDURE ConvertChar*( VAR name: ARRAY OF CHAR;  from, to: CHAR );
+	VAR i: LONGINT;
+	BEGIN
+		i := 0;
+		WHILE name[i] # 0X DO
+			IF name[i] = from THEN name[i] := to END;
+			INC( i )
+		END
+	END ConvertChar;
+
+	PROCEDURE SetPaths;
+	VAR ret, i, j, k: LONGINT;
+		work, files, temp: ARRAY Kernel32.MaxPath OF CHAR;
+		directories, dirs: ARRAY 4 * Kernel32.MaxPath OF CHAR;
+		dir, sysPath: FileName;
+
+		PROCEDURE SetSysPath(VAR dir: ARRAY OF CHAR);
+		VAR ch: CHAR; i: LONGINT;
+		BEGIN
+			IF (dir[0] = "~") & (dir[1] = PathDelimiter) THEN
+				Kernel32.SetCurrentDirectory( sysPath );
+				i := 2;
+				REPEAT ch := dir[i]; dir[i-2] := ch; INC(i) UNTIL ch = 0X;
+			ELSE
+				Kernel32.SetCurrentDirectory(workPath)
+			END;
+		END SetSysPath;
+
+
+		PROCEDURE AddDir;
+		BEGIN
+			IF k > 0 THEN
+				dir[k] := 0X;
+				IF dir[k - 1] = '"' THEN dir[k - 1] := 0X END;
+				ConvertChar( dir, Files.PathDelimiter, PathDelimiter );
+				SetSysPath(dir);
+				IF Kernel32.SetCurrentDirectory( dir ) # Kernel32.False THEN
+					Kernel32.GetCurrentDirectory( LEN( dir ), dir );  searchPath[i] := ";";  INC( i );  k := 0;
+					WHILE dir[k] # 0X DO searchPath[i] := dir[k];  INC( i );  INC( k ) END
+				END;
+				k := 0
+			END
+		END AddDir;
+
+	BEGIN {EXCLUSIVE}
+		Machine.GetConfig( "Paths.Files", files ); Machine.GetConfig( "Paths.Search", directories );
+		Machine.GetConfig( "Paths.Temp", temp ); Machine.GetConfig( "Paths.Work", work );
+
+		Kernel32.GetCurrentDirectory( LEN( workPath ), workPath );  i := 0;  ret := 0;
+
+		IF files # "" THEN
+			COPY( files, sysPath );
+			IF Kernel32.SetCurrentDirectory( sysPath ) # Kernel32.False THEN ret := Kernel32.GetCurrentDirectory( LEN( sysPath ), sysPath ) END
+		END;
+		IF ret = 0 THEN
+			Kernel32.GetModuleFileName( Kernel32.hInstance, sysPath, LEN( sysPath ) );  j := -1;
+			WHILE sysPath[i] # 0X DO
+				IF sysPath[i] = PathDelimiter THEN j := i END;
+				INC( i )
+			END;
+			i := j + 1;  sysPath[i] := 0X;  COPY( sysPath, searchPath )
+		ELSE
+			WHILE sysPath[i] # 0X DO searchPath[i] := sysPath[i];  INC( i ) END;
+			searchPath[i] := 0X
+		END;
+
+		COPY( directories, dirs );
+		IF dirs[0] = '"' THEN j := 1 ELSE j := 0 END;
+
+		k := 0;
+		WHILE dirs[j] # 0X DO
+			IF (dirs[j] = ";") OR (dirs[j] < " ") THEN AddDir() ELSE dir[k] := dirs[j];  INC( k ) END;
+			INC( j )
+		END;
+		AddDir();  searchPath[i] := 0X;  ret := 0;
+
+		COPY( temp, tempPath );
+		IF tempPath # "" THEN
+			ConvertChar( tempPath, Files.PathDelimiter, PathDelimiter );
+			SetSysPath(tempPath);
+			IF Kernel32.SetCurrentDirectory( tempPath ) # Kernel32.False THEN ret := Kernel32.GetCurrentDirectory( LEN( tempPath ), tempPath ) END
+		END;
+		IF ret = 0 THEN Kernel32.GetTempPath( LEN( tempPath ), tempPath ) END;
+
+		COPY( work, dir );
+		IF dir # "" THEN
+			ConvertChar( dir, Files.PathDelimiter, PathDelimiter );
+			SetSysPath(dir);
+			IF Kernel32.SetCurrentDirectory( dir ) # Kernel32.False THEN Kernel32.GetCurrentDirectory( LEN( workPath ), workPath ) END
+		END;
+		Kernel32.SetCurrentDirectory( workPath );
+	END SetPaths;
+
+	PROCEDURE SameName*( VAR a, b: ARRAY OF CHAR ): BOOLEAN;   (** non-portable *)
+	VAR i, j: LONGINT;
+	BEGIN
+		i := 0;  j := 0;
+		WHILE (a[i] # 0X) & (b[j] # 0X) & (CAP( a[i] ) = CAP( b[j] )) DO INC( i );  INC( j ) END;
+		RETURN (a[i] = 0X) & (b[j] = 0X)
+	END SameName;
+
+	PROCEDURE CheckPath(fullName: ARRAY OF CHAR ): BOOLEAN;
+	VAR i, j: LONGINT;  done: BOOLEAN;
+	BEGIN
+		i := 0;  j := -1;
+		WHILE fullName[i] # 0X DO
+			IF fullName[i] = PathDelimiter THEN j := i END;
+			INC( i )
+		END;
+		IF j > 0 THEN fullName[j] := 0X END;
+		BEGIN {EXCLUSIVE}
+			done := Kernel32.SetCurrentDirectory( fullName ) # Kernel32.False;
+			Kernel32.SetCurrentDirectory( workPath );  RETURN done
+		END;
+	END CheckPath;
+
+	PROCEDURE CheckName*( name: ARRAY OF CHAR ): BOOLEAN;
+	VAR fullName: FileName;  fileNamePart: Kernel32.LPSTR;  ret, i: SIZE;  ch: CHAR;  stream, ok: BOOLEAN;
+	BEGIN
+		ConvertChar( name, Files.PathDelimiter, PathDelimiter );  ret := Kernel32.GetFullPathName( name, Kernel32.MaxPath, fullName, fileNamePart );
+		IF (ret > 0) & CheckPath( fullName ) & (fileNamePart # Kernel32.NULL) THEN
+			ok := TRUE;  stream := FALSE;  i := fileNamePart - ADDRESSOF( fullName );  fullName[i - 1] := 0X;  ch := fullName[i];
+			WHILE (ch # 0X) & ok DO
+				IF ch = ":" THEN
+					IF stream THEN ok := FALSE ELSE stream := TRUE END
+				ELSIF (ch = ":") OR (ch = "\") OR (ch = "?") OR (ch = "|") OR (ch = ">") OR (ch = "<") OR (ch = "/") OR (ch = "*") OR (ch = '"') THEN ok := FALSE;
+				END;
+				(* \ / : * ? " < > | *)
+
+				INC( i );  ch := fullName[i]
+			END
+		ELSE ok := FALSE
+		END;
+		RETURN ok
+	END CheckName;
+
+	PROCEDURE GetAttributes*( file: ARRAY OF CHAR ): WORDSET;   (** non-portable *)
+	VAR attrs: WORDSET;
+	BEGIN
+		ConvertChar( file, Files.PathDelimiter, PathDelimiter );  attrs := Kernel32.GetFileAttributes( file );
+		IF attrs = {0..31} THEN RETURN {} ELSE RETURN attrs END
+	END GetAttributes;
+
+	PROCEDURE SetAttributes*( file: ARRAY OF CHAR;  attrs: WORDSET );   (** non-portable *)
+	BEGIN
+		ConvertChar( file, Files.PathDelimiter, PathDelimiter );  Kernel32.SetFileAttributes( file, attrs )
+	END SetAttributes;
+
+	PROCEDURE SetFileAttributes*( file: ARRAY OF CHAR;  attrs: WORDSET );   (** non-portable *)
+	BEGIN
+		ConvertChar( file, Files.PathDelimiter, PathDelimiter );  Kernel32.SetFileAttributes( file, attrs )
+	END SetFileAttributes;
+
+
+(** Get the current directory. *)
+	PROCEDURE GetWorkingDirectory*( VAR path: ARRAY OF CHAR );
+	BEGIN {EXCLUSIVE}
+		Kernel32.GetCurrentDirectory( Kernel32.MaxPath, workPath );  COPY( workPath, path );  ConvertChar( path, PathDelimiter, Files.PathDelimiter ); FixDriveLetter (path);
+	END GetWorkingDirectory;
+
+(** Change to directory path. *)
+	PROCEDURE ChangeDirectory*( path: ARRAY OF CHAR;  VAR done: BOOLEAN );
+	BEGIN {EXCLUSIVE}
+		ConvertChar( path, Files.PathDelimiter, PathDelimiter );  done := Kernel32.SetCurrentDirectory( path ) # Kernel32.False;  Kernel32.GetCurrentDirectory( Kernel32.MaxPath, workPath );
+	END ChangeDirectory;
+
+(** Get the directory for temporary files. *)
+	PROCEDURE GetTempDirectory*( VAR path: ARRAY OF CHAR );
+	BEGIN
+		COPY( tempPath, path );  ConvertChar( path, PathDelimiter, Files.PathDelimiter )
+	END GetTempDirectory;
+
+(** Compute the relative filename (relative to the working directory). *)
+	PROCEDURE RelFileName*( fileName: ARRAY OF CHAR;  VAR relFileName: ARRAY OF CHAR );
+	VAR i, j, k, p: LONGINT;  fullName: FileName;  fileNamePart: Kernel32.LPSTR;
+	BEGIN
+		IF ~FindFile( fileName, fullName ) THEN  (* file does not exist -> would be created in the current dir *)
+			ConvertChar( fileName, Files.PathDelimiter, PathDelimiter );  Kernel32.GetFullPathName( fileName, Kernel32.MaxPath, fullName, fileNamePart ); FixDriveLetter (fullName);
+		ELSE ConvertChar( fullName, Files.PathDelimiter, PathDelimiter )
+		END;   (* from here on all with PathDelimiter and drive letter *)
+ 		IF CAP( workPath[0] ) # CAP( fullName[0] ) THEN  (* different drive letters -> nothing to be done *)
+			COPY( fullName, relFileName )
+		ELSE
+			i := 0;  j := -1;  p := 0;
+			WHILE CAP( fullName[i] ) = CAP( workPath[i] ) DO
+				IF workPath[i] = PathDelimiter THEN j := i END;
+				INC( i )
+			END;
+			IF workPath[i] = 0X THEN
+				IF fullName[i] # PathDelimiter THEN  (* first part of directories do match *)
+					relFileName[p] := ".";  relFileName[p + 1] := ".";  relFileName[p + 2] := PathDelimiter;  INC( p, 3 );  INC( j );
+					WHILE fullName[j] # 0X DO relFileName[p] := fullName[j];  INC( j );  INC( p ) END
+				ELSE  (* file is in a subdirectory of the current dir *)
+					INC( i );
+					WHILE fullName[i] # 0X DO relFileName[p] := fullName[i];  INC( i );  INC( p ) END
+				END
+			ELSIF j > 2 THEN  (* first part of directories do match *)
+				k := j;  i := j + 1;
+				WHILE workPath[k] # 0X DO
+					IF workPath[k] = PathDelimiter THEN relFileName[p] := ".";  relFileName[p + 1] := ".";  relFileName[p + 2] := PathDelimiter;  INC( p, 3 ) END;
+					INC( k )
+				END;
+				WHILE fullName[i] # 0X DO relFileName[p] := fullName[i];  INC( i );  INC( p ) END
+			ELSE  (* only drive letters match *)
+				i := j;
+				WHILE fullName[i] # 0X DO relFileName[p] := fullName[i];  INC( i );  INC( p ) END
+			END;
+			relFileName[p] := 0X
+		END;
+		ConvertChar( relFileName, PathDelimiter, Files.PathDelimiter )
+	END RelFileName;
+
+	PROCEDURE DeviceNotification*( type: LONGINT;  drives: SET );
+	VAR n: Notification;
+	BEGIN
+		IF type = deviceArrival THEN AutoMountWindowsLogicalDrives( drives );
+		ELSIF type = deviceRemove THEN AutoUnmountLogicalDrives( drives );
+		ELSE
+			(* scan for changes *)
+		END;
+		n := notifications;
+		WHILE(n#NIL) DO
+			n.p(type,drives);
+			n := n.next;
+		END;
+	END DeviceNotification;
+
+	PROCEDURE RegisterNotification*( p: NotificationProc );
+	VAR n: Notification;
+	BEGIN
+		NEW( n );  n.p := p;  n.next := notifications;  notifications := n;
+	END RegisterNotification;
+
+	PROCEDURE Init;
+	VAR
+		i, j: LONGINT;  sysPath: FileName;  p: Files.Parameters;  drives: SET;  fs : Files.FileSystem;
+	BEGIN
+		NEW( winFS );
+
+		NEW( p, NIL, NIL, NIL, NIL, NIL);  p.prefix := "searcher";
+		NewFS( p );
+
+		fs := Files.This(p.prefix);
+		IF (fs # NIL) & (fs IS AliasFileSystem) THEN
+			fs( AliasFileSystem ).useprefix := FALSE;
+			EXCL( fs( AliasFileSystem ).flags, Files.NeedsPrefix );
+		END;
+
+		(* now the file system is installed *)
+
+		drives := Kernel32.GetLogicalDrives();
+		drives := drives - {0,1}; (* do not scan for diskettes *)
+		AutoMountWindowsLogicalDrives( drives );
+
+		Kernel32.GetCurrentDirectory( LEN( workPath ), workPath );  i := 0;  Kernel32.GetModuleFileName( Kernel32.hInstance, sysPath, LEN( sysPath ) );  j := -1;
+		FixDriveLetter (workPath); FixDriveLetter (sysPath);
+		WHILE sysPath[i] # 0X DO
+			IF sysPath[i] = PathDelimiter THEN j := i END;
+			INC( i )
+		END;
+
+		i := j + 1;  sysPath[i] := 0X;  COPY( sysPath, searchPath );  Kernel32.GetTempPath( LEN( tempPath ), tempPath );  Kernel32.SetCurrentDirectory( workPath );
+
+		notifications := NIL;
+	END Init;
+
+	PROCEDURE AddSearchPath*(context: Commands.Context);
+	VAR name,fullName: FileName; i,j: LONGINT; ch : CHAR; ret: LONGINT; fileNamePart: Kernel32.LPSTR;
+	BEGIN
+		IF context.arg.GetString(name) THEN
+			i := 0; j := 0;
+			ConvertChar( name, Files.PathDelimiter, PathDelimiter );
+			ret := Kernel32.GetFullPathName( name, Kernel32.MaxPath, fullName, fileNamePart );
+
+			WHILE(searchPath[i] # 0X) DO
+				INC(i);
+			END;
+
+			searchPath[i] := ";";INC(i);
+			REPEAT
+				ch := fullName[j];
+				searchPath[i] := ch;
+				INC(j);INC(i);
+			UNTIL ch = 0X;
+		END;
+	END AddSearchPath;
+
+	PROCEDURE SetWorkPath*(context: Commands.Context);
+	VAR name: FileName; done: BOOLEAN;
+	BEGIN
+		IF context.arg.GetString(name) THEN
+			ChangeDirectory(name, done); 
+			IF ~done THEN 
+				context.error.String("could not change directory to "); context.error.String(name); context.error.Ln; 
+			END
+		END;
+	END SetWorkPath;
+
+	PROCEDURE Mount*(context : Commands.Context);
+	VAR diskname: ARRAY 256 OF CHAR;
+	BEGIN
+		context.arg.SkipWhitespace;
+		context.arg.String(diskname);
+		MountDrive(diskname, context);
+	END Mount;
+
+	PROCEDURE Unmount*(context : Commands.Context);
+	VAR diskname: ARRAY 256 OF CHAR;
+	BEGIN
+		context.arg.SkipWhitespace;
+		context.arg.String(diskname);
+		UnmountDrive(diskname, context);
+	END Unmount;
+
+BEGIN
+	Init();  Modules.InstallTermHandler( Finalization ); SetPaths;
+END HostFiles.