home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 10 / Fresh_Fish_10_2352.bin / new / dev / obero / oberon / projectoberonsrc / files.mod (.txt) < prev    next >
Oberon Text  |  1994-10-17  |  16KB  |  484 lines
  1. Syntax10.Scn.Fnt
  2. MODULE Files;  (*NW 11.1.86 / 22.9.93*)
  3.     IMPORT SYSTEM, Kernel, FileDir;
  4.     (*A file consists of a sequence of pages. The first page
  5.         contains the header. Part of the header is the page table, an array
  6.         of disk addresses to the pages. A file is referenced through riders.
  7.         A rider indicates a current position and refers to a file*)
  8.     CONST MaxBufs    = 4;
  9.                 HS         = FileDir.HeaderSize;
  10.                 SS         = FileDir.SectorSize;
  11.                 STS        = FileDir.SecTabSize;
  12.                 XS         = FileDir.IndexSize;
  13.     TYPE  DiskAdr = LONGINT;
  14.                 File*   = POINTER TO Handle;
  15.                 Buffer   = POINTER TO BufferRecord;
  16.                 FileHd  = POINTER TO FileDir.FileHeader;
  17.                 Index  = POINTER TO IndexRecord;
  18.         Rider* =
  19.             RECORD eof*: BOOLEAN;
  20.                 res*: LONGINT;
  21.                 file: File;
  22.                 apos, bpos: INTEGER;
  23.                 buf: Buffer;
  24.                 unused: LONGINT
  25.             END ;
  26.         Handle =
  27.             RECORD next: File;
  28.                 aleng, bleng: INTEGER;
  29.                 nofbufs: INTEGER;
  30.                 modH: BOOLEAN;
  31.                 firstbuf: Buffer;
  32.                 sechint: DiskAdr;
  33.                 name: FileDir.FileName;
  34.                 time, date: LONGINT;
  35.                 unused: ARRAY 1 OF LONGINT;
  36.                 ext:  ARRAY FileDir.ExTabSize OF Index;
  37.                 sec: FileDir.SectorTable
  38.             END ;
  39.         BufferRecord =
  40.             RECORD apos, lim: INTEGER;
  41.                 mod: BOOLEAN;
  42.                 next: Buffer;
  43.                 data: FileDir.DataSector
  44.             END ;
  45.         IndexRecord =
  46.             RECORD adr: DiskAdr;
  47.                 mod: BOOLEAN;
  48.                 sec: FileDir.IndexSector
  49.             END ;
  50.         (*aleng * SS + bleng = length (including header)
  51.             apos * SS + bpos = current position
  52.             0 <= bpos <= lim <= SS
  53.             0 <= apos <= aleng < PgTabSize
  54.             (apos < aleng) & (lim = SS) OR (apos = aleng) *)
  55.     VAR root: File;  (*list of open files*)
  56.     (*Exported procedure:
  57.         Old, New, Register, Close, Purge, Length, GetDate,
  58.         Set, Read, ReadBytes, Write, WriteBytes, Pos, Base,
  59.         Rename, Delete*)
  60.     PROCEDURE Check(VAR s: ARRAY OF CHAR;
  61.                                             VAR name: FileDir.FileName; VAR res: INTEGER);
  62.         VAR i: INTEGER; ch: CHAR;
  63.     BEGIN ch := s[0]; i := 0;
  64.         IF ("A" <= CAP(ch)) & (CAP(ch) <= "Z") THEN
  65.             LOOP name[i] := ch; INC(i); ch := s[i];
  66.                 IF ch = 0X THEN
  67.                     WHILE i < FileDir.FnLength DO name[i] := 0X; INC(i) END ;
  68.                     res := 0; EXIT
  69.                 END ;
  70.                 IF ~(("A" <= CAP(ch)) & (CAP(ch) <= "Z")
  71.                     OR ("0" <= ch) & (ch <= "9") OR (ch = ".")) THEN res := 3; EXIT
  72.                 END ;
  73.                 IF i = FileDir.FnLength THEN res := 4; EXIT END ;
  74.             END
  75.         ELSIF ch = 0X THEN name[0] := 0X; res := -1
  76.         ELSE res := 3
  77.         END
  78.     END Check;
  79.     PROCEDURE Old*(name: ARRAY OF CHAR): File;
  80.         VAR i, k, res: INTEGER;
  81.             f: File;
  82.             header: DiskAdr;
  83.             buf: Buffer;
  84.             head: FileHd;
  85.             namebuf: FileDir.FileName;
  86.             inxpg: Index;
  87.     BEGIN f := NIL; Check(name, namebuf, res);
  88.         IF res = 0 THEN
  89.             FileDir.Search(namebuf, header);
  90.             IF header # 0 THEN f := root;
  91.                 WHILE (f # NIL) & (f.sec[0] # header) DO f := f.next END ;
  92.                 IF f = NIL THEN
  93.                     NEW(buf); buf.apos := 0; buf.next := buf; buf.mod := FALSE;
  94.                     head := SYSTEM.VAL(FileHd, SYSTEM.ADR(buf.data));
  95.                     Kernel.GetSector(header, head^);
  96.                     NEW(f); f.aleng := head.aleng; f.bleng := head.bleng;
  97.                     f.time := head.time; f.date := head.date;
  98.                     IF f.aleng = 0 THEN buf.lim := f.bleng ELSE buf.lim := SS END ;
  99.                     f.firstbuf := buf; f.nofbufs := 1; f.name[0] := 0X;
  100.                     f.sec := head.sec;
  101.                     k := (f.aleng + (XS-STS)) DIV XS; i := 0;
  102.                     WHILE i < k DO
  103.                         NEW(inxpg); inxpg.adr := head.ext[i]; inxpg.mod := FALSE;
  104.                         Kernel.GetSector(inxpg.adr, inxpg.sec); f.ext[i] := inxpg; INC(i)
  105.                     END ;
  106.                     WHILE i < FileDir.ExTabSize DO f.ext[i] := NIL; INC(i) END ;
  107.                     f.sechint := header; f.modH := FALSE; f.next := root; root := f 
  108.                 END
  109.             END
  110.         END ;
  111.         RETURN f
  112.     END Old;
  113.     PROCEDURE New*(name: ARRAY OF CHAR): File;
  114.         VAR i, res: INTEGER;
  115.             f: File;
  116.             buf: Buffer;
  117.             head: FileHd;
  118.             namebuf: FileDir.FileName;
  119.     BEGIN f := NIL; Check(name, namebuf, res);
  120.         IF res <= 0 THEN
  121.             NEW(buf); buf.apos := 0; buf.mod := TRUE; buf.lim := HS; buf.next := buf;
  122.             head := SYSTEM.VAL(FileHd, SYSTEM.ADR(buf.data));
  123.             head.mark := FileDir.HeaderMark;
  124.             head.aleng := 0; head.bleng := HS; head.name := namebuf;
  125.             Kernel.GetClock(head.time, head.date);
  126.             NEW(f); f.aleng := 0; f.bleng := HS; f.modH := TRUE;
  127.             f.time := head.time; f.date := head.date;
  128.             f.firstbuf := buf; f.nofbufs := 1; f.name := namebuf; f.sechint := 0;
  129.             i := 0;
  130.             REPEAT f.ext[i] := NIL; head.ext[i] := 0; INC(i) UNTIL i = FileDir.ExTabSize;
  131.             i := 0;
  132.             REPEAT f.sec[i] := 0; head.sec[i] := 0; INC(i) UNTIL i = STS
  133.         END ;
  134.         RETURN f
  135.     END New;
  136.     PROCEDURE UpdateHeader(f: File; VAR h: FileDir.FileHeader);
  137.         VAR k: INTEGER;
  138.     BEGIN h.aleng := f.aleng; h.bleng := f.bleng;
  139.         h.sec := f.sec; k := (f.aleng + (XS-STS)) DIV XS;
  140.         WHILE k > 0 DO DEC(k); h.ext[k] := f.ext[k].adr END
  141.     END UpdateHeader;
  142.     PROCEDURE ReadBuf(f: File; buf: Buffer; pos: INTEGER);
  143.         VAR sec: DiskAdr;
  144.     BEGIN
  145.         IF pos < STS THEN sec := f.sec[pos]
  146.         ELSE sec := f.ext[(pos-STS) DIV XS].sec.x[(pos-STS) MOD XS]
  147.         END ;
  148.         Kernel.GetSector(sec, buf.data);
  149.         IF pos < f.aleng THEN buf.lim := SS ELSE buf.lim := f.bleng END ;
  150.         buf.apos := pos; buf.mod := FALSE
  151.     END ReadBuf;
  152.     PROCEDURE WriteBuf(f: File; buf: Buffer);
  153.         VAR i, k: INTEGER;
  154.             secadr: DiskAdr; inx: Index;
  155.     BEGIN
  156.         IF buf.apos < STS THEN
  157.             secadr := f.sec[buf.apos];
  158.             IF secadr = 0 THEN
  159.                 Kernel.AllocSector(f.sechint, secadr);
  160.                 f.modH := TRUE; f.sec[buf.apos] := secadr; f.sechint := secadr
  161.             END ;
  162.             IF buf.apos = 0 THEN
  163.                 UpdateHeader(f, SYSTEM.VAL(FileDir.FileHeader, buf.data)); f.modH := FALSE
  164.             END
  165.         ELSE i := (buf.apos - STS) DIV XS; inx := f.ext[i];
  166.             IF inx = NIL THEN
  167.                 NEW(inx); inx.adr := 0; inx.sec.x[0] := 0; f.ext[i] := inx; f.modH := TRUE
  168.             END ;
  169.             k := (buf.apos - STS) MOD XS; secadr := inx.sec.x[k];
  170.             IF secadr = 0 THEN
  171.                 Kernel.AllocSector(f.sechint, secadr);
  172.                 f.modH := TRUE; inx.mod := TRUE; inx.sec.x[k] := secadr; f.sechint := secadr
  173.             END
  174.         END ;
  175.         Kernel.PutSector(secadr, buf.data); buf.mod := FALSE
  176.     END WriteBuf;
  177.     PROCEDURE Buf(f: File; pos: INTEGER): Buffer;
  178.         VAR buf: Buffer;
  179.     BEGIN buf := f.firstbuf;
  180.         LOOP
  181.             IF buf.apos = pos THEN EXIT END ;
  182.             buf := buf.next;
  183.             IF buf = f.firstbuf THEN buf := NIL; EXIT END
  184.         END ;
  185.         RETURN buf
  186.     END Buf;
  187.     PROCEDURE GetBuf(f: File; pos: INTEGER): Buffer;
  188.         VAR buf: Buffer;
  189.     BEGIN buf := f.firstbuf;
  190.         LOOP
  191.             IF buf.apos = pos THEN EXIT END ;
  192.             IF buf.next = f.firstbuf THEN
  193.                 IF f.nofbufs < MaxBufs THEN (*allocate new buffer*)
  194.                     NEW(buf); buf.next := f.firstbuf.next; f.firstbuf.next := buf;
  195.                     INC(f.nofbufs)
  196.                 ELSE (*take one of the buffers*) f.firstbuf := buf;
  197.                     IF buf.mod THEN WriteBuf(f, buf) END
  198.                 END ;
  199.                 buf.apos := pos;
  200.                 IF pos <= f.aleng THEN ReadBuf(f, buf, pos) END ;
  201.                 EXIT
  202.             END ;
  203.             buf := buf.next
  204.         END ;
  205.         RETURN buf
  206.     END GetBuf;
  207.     PROCEDURE Unbuffer(f: File);
  208.         VAR i, k: INTEGER;
  209.             buf: Buffer;
  210.             inx: Index;
  211.             head: FileDir.FileHeader;
  212.     BEGIN buf := f.firstbuf;
  213.         REPEAT
  214.             IF buf.mod THEN WriteBuf(f, buf) END ;
  215.             buf := buf.next
  216.         UNTIL buf = f.firstbuf;
  217.         k := (f.aleng + (XS-STS)) DIV XS; i := 0;
  218.         WHILE i < k DO
  219.             inx := f.ext[i]; INC(i);
  220.             IF inx.mod THEN
  221.                 IF inx.adr = 0 THEN
  222.                     Kernel.AllocSector(f.sechint, inx.adr); f.sechint := inx.adr; f.modH := TRUE
  223.                 END ;
  224.                 Kernel.PutSector(inx.adr, inx.sec); inx.mod := FALSE
  225.             END
  226.         END ;
  227.         IF f.modH THEN
  228.             Kernel.GetSector(f.sec[0], head); UpdateHeader(f, head);
  229.             Kernel.PutSector(f.sec[0], head); f.modH := FALSE
  230.         END
  231.     END Unbuffer;
  232.     PROCEDURE Register*(f: File);
  233.     BEGIN
  234.         IF (f # NIL) & (f.name[0] > 0X) THEN
  235.             Unbuffer(f); FileDir.Insert(f.name, f.sec[0]); f.name[0] := 0X; f.next := root; root := f
  236.         END ;
  237.     END Register;
  238.     PROCEDURE Close*(f: File);
  239.     BEGIN
  240.         IF f # NIL THEN Unbuffer(f) END ;
  241.     END Close;
  242.     PROCEDURE Purge*(f: File);
  243.         VAR a, i, j, k: INTEGER;
  244.             ind: FileDir.IndexSector;
  245.     BEGIN
  246.         IF f # NIL THEN a := f.aleng + 1; f.aleng := 0; f.bleng := HS;
  247.             IF a <= STS THEN i := a
  248.             ELSE i := STS; DEC(a, i);
  249.                 j := (a-1) MOD XS + 1; k := (a-1) DIV XS + 1;
  250.                 REPEAT DEC(k); Kernel.GetSector(f.ext[k].adr, ind);
  251.                     REPEAT DEC(j); Kernel.FreeSector(ind.x[j]) UNTIL j = 0;
  252.                     Kernel.FreeSector(f.ext[k].adr); j := XS
  253.                 UNTIL k = 0
  254.             END ;
  255.             REPEAT DEC(i); Kernel.FreeSector(f.sec[i]); f.sec[i] := 0
  256.             UNTIL i = 0;
  257.             f.nofbufs := 1