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.