Oberon/V2/Files

MODULE Files; (*NW 11.1.86 / 22.1.91*)
	IMPORT SYSTEM, Kernel, FileDir;

	(*A file consists of a sequence of pages. The first page contains the header.
		Part of the header is the page table, an array of disk addresses to the pages.
		A file is referenced through riders each of which indicate a position.*)

	CONST MaxBufs = 4;
		HS = FileDir.HeaderSize;
		SS = FileDir.SectorSize;
		STS = FileDir.SecTabSize;
		XS = FileDir.IndexSize;

	TYPE DiskAdr = LONGINT;
		File* = POINTER TO Handle;
		Buffer = POINTER TO BufferRecord;
		FileHd = POINTER TO FileDir.FileHeader;
		Index = POINTER TO IndexRecord;

		Rider* =
			RECORD eof*: BOOLEAN;
				res*: LONGINT;
				file: File;
				apos, bpos: INTEGER;
				buf: Buffer;
				unused: LONGINT
			END ;

		Handle =
			RECORD next: File;
				aleng, bleng: INTEGER;
				nofbufs: INTEGER;
				modH: BOOLEAN;
				firstbuf: Buffer;
				sechint: DiskAdr;
				name: FileDir.FileName;
				time, date: LONGINT;
				unused: ARRAY 1 OF LONGINT;
				ext: ARRAY FileDir.ExTabSize OF Index;
				sec: FileDir.SectorTable
			END ;

		BufferRecord =
			RECORD apos, lim: INTEGER;
				mod: BOOLEAN;
				next: Buffer;
				data: FileDir.DataSector
			END ;

		IndexRecord =
			RECORD adr: DiskAdr;
				mod: BOOLEAN;
				sec: FileDir.IndexSector
			END ;

		(*aleng * SS + bleng = length (including header)
			apos * SS + bpos = current position
			0 <= bpos <= lim <= SS
			0 <= apos <= aleng < PgTabSize
			(apos < aleng) & (lim = SS) OR (apos = aleng) *)

	VAR root: File; (*list of open files*)

	PROCEDURE Check(VAR s: ARRAY OF CHAR;
			VAR name: FileDir.FileName; VAR res: INTEGER);
		VAR i: INTEGER; ch: CHAR;
	BEGIN ch := s[0]; i := 0;
		IF ("A" <= CAP(ch)) & (CAP(ch) <= "Z") THEN
			LOOP name[i] := ch; INC(i); ch := s[i];
				IF ch = 0X THEN
					WHILE i < FileDir.FnLength DO name[i] := 0X; INC(i) END ;
					res := 0; EXIT
				END ;
				IF ~(("A" <= CAP(ch)) & (CAP(ch) <= "Z")
					OR ("0" <= ch) & (ch <= "9") OR (ch = ".")) THEN res := 3; EXIT
				END ;
				IF i = FileDir.FnLength THEN res := 4; EXIT END ;
			END
		ELSIF ch = 0X THEN name[0] := 0X; res := -1
		ELSE res := 3
		END
	END Check;

	PROCEDURE Old*(name: ARRAY OF CHAR): File;
		VAR i, k, res: INTEGER;
			f: File;
			header: DiskAdr;
			buf: Buffer;
			head: FileHd;
			namebuf: FileDir.FileName;
			inxpg: Index;
	BEGIN f := NIL; Check(name, namebuf, res);
		IF res = 0 THEN
			FileDir.Search(namebuf, header);
			IF header # 0 THEN f := root;
				WHILE (f # NIL) & (f.sec[0] # header) DO f := f.next END ;
				IF f = NIL THEN
					NEW(buf); buf.apos := 0; buf.next := buf; buf.mod := FALSE;
					head := SYSTEM.VAL(FileHd, SYSTEM.ADR(buf.data));
					Kernel.GetSector(header, head^);
					NEW(f); f.aleng := head.aleng; f.bleng := head.bleng;
					f.time := head.time; f.date := head.date;
					IF f.aleng = 0 THEN buf.lim := f.bleng ELSE buf.lim := SS END ;
					f.firstbuf := buf; f.nofbufs := 1; f.name[0] := 0X;
					f.sec := head.sec;
					k := (f.aleng + (XS-STS)) DIV XS; i := 0;
					WHILE i < k DO
						NEW(inxpg); inxpg.adr := head.ext[i]; inxpg.mod := FALSE;
						Kernel.GetSector(inxpg.adr, inxpg.sec); f.ext[i] := inxpg; INC(i)
					END ;
					WHILE i < FileDir.ExTabSize DO f.ext[i] := NIL; INC(i) END ;
					f.sechint := header; f.modH := FALSE; f.next := root; root := f
				END
			END
		END ;
		RETURN f
	END Old;

	PROCEDURE New*(name: ARRAY OF CHAR): File;
		VAR i, res: INTEGER;
			f: File;
			header: DiskAdr;
			buf: Buffer;
			head: FileHd;
			namebuf: FileDir.FileName;
	BEGIN f := NIL; Check(name, namebuf, res);
		IF res <= 0 THEN
			NEW(buf); buf.apos := 0; buf.mod := FALSE; buf.lim := HS; buf.next := buf;
			head := SYSTEM.VAL(FileHd, SYSTEM.ADR(buf.data));
			head.mark := FileDir.HeaderMark;
			head.aleng := 0; head.bleng := HS; head.name := namebuf;
			Kernel.GetClock(head.time, head.date);
			NEW(f); f.aleng := 0; f.bleng := HS; f.modH := TRUE;
			f.time := head.time; f.date := head.date;
			f.firstbuf := buf; f.nofbufs := 1; f.name := namebuf; f.sechint := 0;
			i := 0;
			REPEAT f.ext[i] := NIL; head.ext[i] := 0; INC(i) UNTIL i = FileDir.ExTabSize;
			i := 0;
			REPEAT f.sec[i] := 0; head.sec[i] := 0; INC(i) UNTIL i = STS
		END ;
		RETURN f
	END New;

	PROCEDURE UpdateHeader(f: File; VAR h: FileDir.FileHeader);
		VAR k: INTEGER;
	BEGIN h.aleng := f.aleng; h.bleng := f.bleng;
		h.sec := f.sec; k := (f.aleng + (XS-STS)) DIV XS;
		WHILE k > 0 DO DEC(k); h.ext[k] := f.ext[k].adr END
	END UpdateHeader;

	PROCEDURE ReadBuf(f: File; buf: Buffer; pos: INTEGER);
		VAR sec: DiskAdr;
	BEGIN
		IF pos < STS THEN sec := f.sec[pos]
		ELSE sec := f.ext[(pos-STS) DIV XS].sec.x[(pos-STS) MOD XS]
		END ;
		Kernel.GetSector(sec, buf.data);
		IF pos < f.aleng THEN buf.lim := SS ELSE buf.lim := f.bleng END ;
		buf.apos := pos; buf.mod := FALSE
	END ReadBuf;

	PROCEDURE WriteBuf(f: File; buf: Buffer);
		VAR i, k: INTEGER;
			secadr: DiskAdr; inx: Index;
	BEGIN
		IF buf.apos < STS THEN
			secadr := f.sec[buf.apos];
			IF secadr = 0 THEN
				Kernel.AllocSector(f.sechint, secadr);
				f.modH := TRUE; f.sec[buf.apos] := secadr; f.sechint := secadr
			END ;
			IF buf.apos = 0 THEN
				UpdateHeader(f, SYSTEM.VAL(FileDir.FileHeader, buf.data)); f.modH := FALSE
			END
		ELSE i := (buf.apos - STS) DIV XS; inx := f.ext[i];
			IF inx = NIL THEN
				NEW(inx); inx.adr := 0; inx.sec.x[0] := 0; f.ext[i] := inx; f.modH := TRUE
			END ;
			k := (buf.apos - STS) MOD XS; secadr := inx.sec.x[k];
			IF secadr = 0 THEN
				Kernel.AllocSector(f.sechint, secadr);
				f.modH := TRUE; inx.mod := TRUE; inx.sec.x[k] := secadr; f.sechint := secadr
			END
		END ;
		Kernel.PutSector(secadr, buf.data); buf.mod := FALSE
	END WriteBuf;

	PROCEDURE Buf(f: File; pos: INTEGER): Buffer;
		VAR buf: Buffer;
	BEGIN buf := f.firstbuf;
		LOOP
			IF buf.apos = pos THEN EXIT END ;
			buf := buf.next;
			IF buf = f.firstbuf THEN buf := NIL; EXIT END
		END ;
		RETURN buf
	END Buf;

	PROCEDURE GetBuf(f: File; pos: INTEGER): Buffer;
		VAR buf: Buffer;
	BEGIN buf := f.firstbuf;
		LOOP
			IF buf.apos = pos THEN EXIT END ;
			IF buf.next = f.firstbuf THEN
				IF f.nofbufs < MaxBufs THEN (*allocate new buffer*)
					NEW(buf); buf.next := f.firstbuf.next; f.firstbuf.next := buf;
					INC(f.nofbufs)
				ELSE (*take one of the buffers*) f.firstbuf := buf;
					IF buf.mod THEN WriteBuf(f, buf) END
				END ;
				buf.apos := pos;
				IF pos <= f.aleng THEN ReadBuf(f, buf, pos) END ;
				EXIT
			END ;
			buf := buf.next
		END ;
		RETURN buf
	END GetBuf;

	PROCEDURE Unbuffer(f: File);
	VAR i, k: INTEGER;
		buf: Buffer;
		inx: Index;
		head: FileDir.FileHeader;
	BEGIN buf := f.firstbuf;
		REPEAT
			IF buf.mod THEN WriteBuf(f, buf) END ;
			buf := buf.next
		UNTIL buf = f.firstbuf;
		k := (f.aleng + (XS-STS)) DIV XS; i := 0;
		WHILE i < k DO
			inx := f.ext[i]; INC(i);
			IF inx.mod THEN
				IF inx.adr = 0 THEN
					Kernel.AllocSector(f.sechint, inx.adr); f.sechint := inx.adr; f.modH := TRUE
				END ;
				Kernel.PutSector(inx.adr, inx.sec); inx.mod := FALSE
			END
		END ;
		IF f.modH THEN
			IF f.sec[0] = 0 THEN Kernel.AllocSector(0, f.sec[0]) END ;
			Kernel.GetSector(f.sec[0], head); UpdateHeader(f, head);
			Kernel.PutSector(f.sec[0], head); f.modH := FALSE
		END
	END Unbuffer;

	PROCEDURE Register*(f: File);
	BEGIN
		IF (f # NIL) & (f.name[0] > 0X) THEN
			Unbuffer(f); FileDir.Insert(f.name, f.sec[0]); f.next := root; root := f
		END ;
	END Register;

	PROCEDURE Close*(f: File);
	BEGIN
		IF f # NIL THEN Unbuffer(f) END ;
	END Close;

	PROCEDURE Purge*(f: File);
		VAR a, i, j, k: INTEGER;
			ind: FileDir.IndexSector;
	BEGIN
		IF f # NIL THEN a := f.aleng + 1; f.aleng := 0;
			IF a <= STS THEN i := a
			ELSE i := STS; DEC(a, i);
				j := (a-1) MOD XS; k := (a-1) DIV XS;
				WHILE k >= 0 DO
					Kernel.GetSector(f.ext[k].adr, ind);
					REPEAT DEC(j); Kernel.FreeSector(ind.x[j])
					UNTIL j = 0;
					Kernel.FreeSector(f.ext[k].adr); j := XS; DEC(k)
				END
			END ;
			REPEAT DEC(i); Kernel.FreeSector(f.sec[i])
			UNTIL i = 0
		END
	END Purge;

	PROCEDURE Length*(f: File): LONGINT;
	BEGIN RETURN LONG(f.aleng)*SS + f.bleng - HS
	END Length;

	PROCEDURE GetDate*(f: File; VAR t, d: LONGINT);
	BEGIN t := f.time; d := f.date
	END GetDate;

	PROCEDURE Set*(VAR r: Rider; f: File; pos: LONGINT);
		VAR a, b: INTEGER;
	BEGIN r.eof := FALSE; r.res := 0;
		IF f # NIL THEN
			IF pos < 0 THEN a := 0; b := HS
			ELSIF pos < LONG(f.aleng)*SS + f.bleng - HS THEN
				a := SHORT((pos + HS) DIV SS); b := SHORT((pos + HS) MOD SS);
			ELSE a := f.aleng; b := f.bleng
			END ;
			r.file := f; r.apos := a; r.bpos := b; r.buf := f.firstbuf
		ELSE r.file:= NIL
		END
	END Set;

	PROCEDURE Read*(VAR r: Rider; VAR x: SYSTEM.BYTE);
		VAR buf: Buffer;
	BEGIN
		IF r.apos # r.buf.apos THEN r.buf := GetBuf(r.file, r.apos) END ;
		IF r.bpos < r.buf.lim THEN
			x := r.buf.data.B[r.bpos]; INC(r.bpos)
		ELSIF r.apos < r.file.aleng THEN
			INC(r.apos); buf := Buf(r.file, r.apos);
			IF buf = NIL THEN
				IF r.buf.mod THEN WriteBuf(r.file, r.buf) END ;
				ReadBuf(r.file, r.buf, r.apos)
			ELSE r.buf := buf
			END ;
			x := r.buf.data.B[0]; r.bpos := 1
		ELSE
			x := 0X; r.eof := TRUE
		END
	END Read;

	PROCEDURE ReadBytes*(VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
		VAR src, dst, m: LONGINT; buf: Buffer;
	BEGIN dst := SYSTEM.ADR(x);
		IF LEN(x) < n THEN HALT(25) END ;
		IF r.apos # r.buf.apos THEN r.buf := GetBuf(r.file, r.apos) END ;
		LOOP
			IF n <= 0 THEN EXIT END ;
			src := SYSTEM.ADR(r.buf.data.B) + r.bpos; m := r.bpos + n;
			IF m <= r.buf.lim THEN
				SYSTEM.MOVE(src, dst, n); r.bpos := SHORT(m); r.res := 0; EXIT
			ELSIF r.buf.lim = SS THEN
				m := r.buf.lim - r.bpos;
				IF m > 0 THEN SYSTEM.MOVE(src, dst, m); INC(dst, m); DEC(n, m) END ;
				IF r.apos < r.file.aleng THEN
					INC(r.apos); r.bpos := 0; buf := Buf(r.file, r.apos);
					IF buf = NIL THEN
						IF r.buf.mod THEN WriteBuf(r.file, r.buf) END ;
						ReadBuf(r.file, r.buf, r.apos)
					ELSE r.buf := buf
					END
				ELSE r.res := n; r.eof := TRUE; EXIT
				END
			ELSE m := r.buf.lim - r.bpos;
				IF m > 0 THEN SYSTEM.MOVE(src, dst, m); r.bpos := r.buf.lim END ;
				r.res := n - m; r.eof := TRUE; EXIT
			END
		END
	END ReadBytes;

	PROCEDURE NewExt(f: File);
		VAR i, k: INTEGER; ext: Index;
	BEGIN k := (f.aleng - STS) DIV XS;
		IF k = FileDir.ExTabSize THEN HALT(23) END ;
		NEW(ext); ext.adr := 0; ext.mod := TRUE; f.ext[k] := ext; i := XS;
		REPEAT DEC(i); ext.sec.x[i] := 0 UNTIL i = 0
	END NewExt;

	PROCEDURE Write*(VAR r: Rider; x: SYSTEM.BYTE);
		VAR f: File; buf: Buffer;
	BEGIN
		IF r.apos # r.buf.apos THEN r.buf := GetBuf(r.file, r.apos) END ;
		IF r.bpos >= r.buf.lim THEN
			IF r.bpos < SS THEN
				INC(r.buf.lim); INC(r.file.bleng); r.file.modH := TRUE
			ELSE f := r.file; WriteBuf(f, r.buf); INC(r.apos); buf := Buf(r.file, r.apos);
				IF buf = NIL THEN
					IF r.apos <= f.aleng THEN ReadBuf(f, r.buf, r.apos)
					ELSE r.buf.apos := r.apos; r.buf.lim := 1; INC(f.aleng); f.bleng := 1; f.modH := TRUE;
						IF (f.aleng - STS) MOD XS = 0 THEN NewExt(f) END
					END
				ELSE r.buf := buf
				END ;
				r.bpos := 0
			END
		END ;
		r.buf.data.B[r.bpos] := x; INC(r.bpos); r.buf.mod := TRUE
	END Write;

	PROCEDURE WriteBytes*(VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE;
			n: LONGINT);
		VAR src, dst, m: LONGINT; f: File; buf: Buffer;
	BEGIN src := SYSTEM.ADR(x);
		IF LEN(x) < n THEN HALT(25) END ;
		IF r.apos # r.buf.apos THEN r.buf := GetBuf(r.file, r.apos) END ;
		LOOP
			IF n <= 0 THEN EXIT END ;
			r.buf.mod := TRUE; dst := SYSTEM.ADR(r.buf.data.B) + r.bpos; m := r.bpos + n;
			IF m <= r.buf.lim THEN
				SYSTEM.MOVE(src, dst, n); r.bpos := SHORT(m); EXIT
			ELSIF m <= SS THEN
				SYSTEM.MOVE(src, dst, n); r.bpos := SHORT(m);
				r.file.bleng := SHORT(m); r.buf.lim := SHORT(m); r.file.modH := TRUE; EXIT
			ELSE m := SS - r.bpos;
				IF m > 0 THEN SYSTEM.MOVE(src, dst, m); INC(src, m); DEC(n, m) END ;
				f := r.file; WriteBuf(f, r.buf); INC(r.apos); r.bpos := 0; buf := Buf(f, r.apos);
				IF buf = NIL THEN
					IF r.apos <= f.aleng THEN ReadBuf(f, r.buf, r.apos)
					ELSE r.buf.apos := r.apos; r.buf.lim := 0; INC(f.aleng); f.bleng := 0; f.modH := TRUE;
						IF (f.aleng - STS) MOD XS = 0 THEN NewExt(f) END
					END
				ELSE r.buf := buf
				END
			END
		END
	END WriteBytes;

	PROCEDURE Pos*(VAR r: Rider): LONGINT;
	BEGIN RETURN LONG(r.apos)*SS + r.bpos - HS
	END Pos;

	PROCEDURE Base*(VAR r: Rider): File;
	BEGIN RETURN r.file
	END Base;

	PROCEDURE Delete*(name: ARRAY OF CHAR; VAR res: INTEGER);
		VAR adr: DiskAdr;
			namebuf: FileDir.FileName;
	BEGIN Check(name, namebuf, res);
		IF res = 0 THEN
			FileDir.Delete(namebuf, adr);
			IF adr = 0 THEN res := 2 END
		END
	END Delete;

	PROCEDURE Rename*(old, new: ARRAY OF CHAR; VAR res: INTEGER);
		VAR adr: DiskAdr;
			oldbuf, newbuf: FileDir.FileName;
			head: FileDir.FileHeader;
	BEGIN Check(old, oldbuf, res);
		IF res = 0 THEN
			Check(new, newbuf, res);
			IF res = 0 THEN
				FileDir.Delete(oldbuf, adr);
				IF adr # 0 THEN
					FileDir.Insert(newbuf, adr);
					Kernel.GetSector(adr, head); head.name := newbuf; Kernel.PutSector(adr, head)
				ELSE res := 2
				END
			END
		END
	END Rename;
		
BEGIN Kernel.FileRoot := SYSTEM.ADR(root)
END Files.