Oberon/V2/FileDir
< Oberon
MODULE FileDir; (*NW 12.1.86 / 23.8.90*)
IMPORT SYSTEM, Kernel;
(*File Directory is a B-tree with its root page at DirRootAdr.
Each entry contains a file name and the disk address of the file's head sector*)
CONST FnLength* = 32;
SecTabSize* = 64;
ExTabSize* = 12;
SectorSize* = 1024;
IndexSize* = SectorSize DIV 4;
HeaderSize* = 352;
DirRootAdr* = 29;
DirPgSize* = 24;
N = DirPgSize DIV 2;
DirMark* = 9B1EA38DH;
HeaderMark* = 9BA71D86H;
FillerSize = 52;
TYPE DiskAdr = LONGINT;
FileName* = ARRAY FnLength OF CHAR;
SectorTable* = ARRAY SecTabSize OF DiskAdr;
ExtensionTable* = ARRAY ExTabSize OF DiskAdr;
EntryHandler* = PROCEDURE (name:FileName; sec: DiskAdr; VAR continue: BOOLEAN);
FileHeader* =
RECORD (Kernel.Sector) (*allocated in the first page of each file on disk*)
mark*: LONGINT;
name*: FileName;
aleng*, bleng*: INTEGER;
date*, time*: LONGINT;
ext*: ExtensionTable;
sec*: SectorTable;
fill: ARRAY SectorSize - HeaderSize OF CHAR;
END ;
IndexSector* =
RECORD (Kernel.Sector)
x*: ARRAY IndexSize OF DiskAdr
END ;
DataSector* =
RECORD (Kernel.Sector)
B*: ARRAY SectorSize OF SYSTEM.BYTE
END ;
DirEntry* = (*B-tree node*)
RECORD
name*: FileName;
adr*: DiskAdr; (*sec no of file header*)
p*: DiskAdr (*sec no of descendant in directory*)
END ;
DirPage* =
RECORD (Kernel.Sector)
mark*: LONGINT;
m*: INTEGER;
p0*: DiskAdr; (*sec no of left descendant in directory*)
fill: ARRAY FillerSize OF CHAR;
e*: ARRAY DirPgSize OF DirEntry
END ;
PROCEDURE Search*(VAR name: FileName; VAR A: DiskAdr);
VAR i, j, L, R: INTEGER; dadr: DiskAdr;
a: DirPage;
BEGIN dadr := DirRootAdr;
LOOP Kernel.GetSector(dadr, a);
L := 0; R := a.m; (*binary search*)
WHILE L < R DO
i := (L+R) DIV 2;
IF name <= a.e[i].name THEN R := i ELSE L := i+1 END
END ;
IF (R < a.m) & (name = a.e[R].name) THEN
A := a.e[R].adr; EXIT (*found*)
END ;
IF R = 0 THEN dadr := a.p0 ELSE dadr := a.e[R-1].p END ;
IF dadr = 0 THEN A := 0; EXIT (*not found*) END
END
END Search;
PROCEDURE insert(VAR name: FileName; dpg0: DiskAdr;
VAR h: BOOLEAN; VAR v: DirEntry; fad: DiskAdr);
(*h = "tree has become higher and v is ascending element"*)
VAR ch: CHAR;
i, j, L, R: INTEGER;
dpg1: DiskAdr;
u: DirEntry;
a: DirPage;
BEGIN (*~h*) Kernel.GetSector(dpg0, a);
L := 0; R := a.m; (*binary search*)
WHILE L < R DO
i := (L+R) DIV 2;
IF name <= a.e[i].name THEN R := i ELSE L := i+1 END
END ;
IF (R < a.m) & (name = a.e[R].name) THEN
a.e[R].adr := fad; Kernel.PutSector(dpg0, a) (*replace*)
ELSE (*not on this page*)
IF R = 0 THEN dpg1 := a.p0 ELSE dpg1 := a.e[R-1].p END ;
IF dpg1 = 0 THEN (*not in tree, insert*)
u.adr := fad; u.p := 0; h := TRUE; j := 0;
REPEAT ch := name[j]; u.name[j] := ch; INC(j)
UNTIL ch = 0X;
WHILE j < FnLength DO u.name[j] := 0X; INC(j) END
ELSE
insert(name, dpg1, h, u, fad)
END ;
IF h THEN (*insert u to the left of e[R]*)
IF a.m < DirPgSize THEN
h := FALSE; i := a.m;
WHILE i > R DO DEC(i); a.e[i+1] := a.e[i] END ;
a.e[R] := u; INC(a.m)
ELSE (*split page and assign the middle element to v*)
a.m := N; a.mark := DirMark;
IF R < N THEN (*insert in left half*)
v := a.e[N-1]; i := N-1;
WHILE i > R DO DEC(i); a.e[i+1] := a.e[i] END ;
a.e[R] := u; Kernel.PutSector(dpg0, a);
Kernel.AllocSector(dpg0, dpg0); i := 0;
WHILE i < N DO a.e[i] := a.e[i+N]; INC(i) END
ELSE (*insert in right half*)
Kernel.PutSector(dpg0, a);
Kernel.AllocSector(dpg0, dpg0); DEC(R, N); i := 0;
IF R = 0 THEN v := u
ELSE v := a.e[N];
WHILE i < R-1 DO a.e[i] := a.e[N+1+i]; INC(i) END ;
a.e[i] := u; INC(i)
END ;
WHILE i < N DO a.e[i] := a.e[N+i]; INC(i) END
END ;
a.p0 := v.p; v.p := dpg0
END ;
Kernel.PutSector(dpg0, a)
END
END
END insert;
PROCEDURE Insert*(VAR name: FileName; fad: DiskAdr);
VAR oldroot: DiskAdr;
h: BOOLEAN; U: DirEntry;
a: DirPage;
BEGIN h := FALSE;
insert(name, DirRootAdr, h, U, fad);
IF h THEN (*root overflow*)
Kernel.GetSector(DirRootAdr, a);
Kernel.AllocSector(DirRootAdr, oldroot); Kernel.PutSector(oldroot, a);
a.mark := DirMark; a.m := 1; a.p0 := oldroot; a.e[0] := U;
Kernel.PutSector(DirRootAdr, a)
END
END Insert;
PROCEDURE underflow(VAR c: DirPage; (*ancestor page*)
dpg0: DiskAdr; s: INTEGER; (*insertion point in c*) VAR h: BOOLEAN); (*c undersize*)
VAR i, k: INTEGER;
dpg1: DiskAdr;
a, b: DirPage; (*a := underflowing page, b := neighbouring page*)
BEGIN Kernel.GetSector(dpg0, a);
(*h & a.m = N-1 & dpg0 = c.e[s-1].p*)
IF s < c.m THEN (*b := page to the right of a*)
dpg1 := c.e[s].p; Kernel.GetSector(dpg1, b);
k := (b.m-N+1) DIV 2; (*k = no. of items available on page b*)
a.e[N-1] := c.e[s]; a.e[N-1].p := b.p0;
IF k > 0 THEN
(*move k-1 items from b to a, one to c*) i := 0;
WHILE i < k-1 DO a.e[i+N] := b.e[i]; INC(i) END ;
c.e[s] := b.e[i]; b.p0 := c.e[s].p;
c.e[s].p := dpg1; DEC(b.m, k); i := 0;
WHILE i < b.m DO b.e[i] := b.e[i+k]; INC(i) END ;
Kernel.PutSector(dpg1, b); a.m := N-1+k; h := FALSE
ELSE (*merge pages a and b, discard b*) i := 0;
WHILE i < N DO a.e[i+N] := b.e[i]; INC(i) END ;
i := s; DEC(c.m);
WHILE i < c.m DO c.e[i] := c.e[i+1]; INC(i) END ;
a.m := 2*N; h := c.m < N
END ;
Kernel.PutSector(dpg0, a)
ELSE (*b := page to the left of a*) DEC(s);
IF s = 0 THEN dpg1 := c.p0 ELSE dpg1 := c.e[s-1].p END ;
Kernel.GetSector(dpg1, b);
k := (b.m-N+1) DIV 2; (*k = no. of items available on page b*)
IF k > 0 THEN
i := N-1;
WHILE i > 0 DO DEC(i); a.e[i+k] := a.e[i] END ;
i := k-1; a.e[i] := c.e[s]; a.e[i].p := a.p0;
(*move k-1 items from b to a, one to c*) DEC(b.m, k);
WHILE i > 0 DO DEC(i); a.e[i] := b.e[i+b.m+1] END ;
c.e[s] := b.e[b.m]; a.p0 := c.e[s].p;
c.e[s].p := dpg0; a.m := N-1+k; h := FALSE;
Kernel.PutSector(dpg0, a)
ELSE (*merge pages a and b, discard a*)
c.e[s].p := a.p0; b.e[N] := c.e[s]; i := 0;
WHILE i < N-1 DO b.e[i+N+1] := a.e[i]; INC(i) END ;
b.m := 2*N; DEC(c.m); h := c.m < N
END ;
Kernel.PutSector(dpg1, b)
END
END underflow;
PROCEDURE delete(VAR name: FileName; dpg0: DiskAdr; VAR h: BOOLEAN;
VAR fad: DiskAdr);
(*search and delete entry with key name; if a page underflow arises,
balance with adjacent page or merge; h := "page dpg0 is undersize"*)
VAR i, j, k, L, R: INTEGER;
dpg1: DiskAdr;
a: DirPage;
PROCEDURE del(dpg1: DiskAdr; VAR h: BOOLEAN);
VAR dpg2: DiskAdr; (*global: a, R*)
b: DirPage;
BEGIN Kernel.GetSector(dpg1, b); dpg2 := b.e[b.m-1].p;
IF dpg2 # 0 THEN del(dpg2, h);
IF h THEN underflow(b, dpg2, b.m, h); Kernel.PutSector(dpg1, b) END
ELSE
b.e[b.m-1].p := a.e[R].p; a.e[R] := b.e[b.m-1];
DEC(b.m); h := b.m < N; Kernel.PutSector(dpg1, b)
END
END del;
BEGIN (*~h*) Kernel.GetSector(dpg0, a);
L := 0; R := a.m; (*binary search*)
WHILE L < R DO
i := (L+R) DIV 2;
IF name <= a.e[i].name THEN R := i ELSE L := i+1 END
END ;
IF R = 0 THEN dpg1 := a.p0 ELSE dpg1 := a.e[R-1].p END ;
IF (R < a.m) & (name = a.e[R].name) THEN
(*found, now delete*) fad := a.e[R].adr;
IF dpg1 = 0 THEN (*a is a leaf page*)
DEC(a.m); h := a.m < N; i := R;
WHILE i < a.m DO a.e[i] := a.e[i+1]; INC(i) END
ELSE del(dpg1, h);
IF h THEN underflow(a, dpg1, R, h) END
END ;
Kernel.PutSector(dpg0, a)
ELSIF dpg1 # 0 THEN
delete(name, dpg1, h, fad);
IF h THEN underflow(a, dpg1, R, h); Kernel.PutSector(dpg0, a) END
ELSE (*not in tree*) fad := 0
END
END delete;
PROCEDURE Delete*(VAR name: FileName; VAR fad: DiskAdr);
VAR h: BOOLEAN; newroot: DiskAdr;
a: DirPage;
BEGIN h := FALSE;
delete(name, DirRootAdr, h, fad);
IF h THEN (*root underflow*)
Kernel.GetSector(DirRootAdr, a);
IF (a.m = 0) & (a.p0 # 0) THEN
newroot := a.p0; Kernel.GetSector(newroot, a);
Kernel.PutSector(DirRootAdr, a) (*discard newroot*)
END
END
END Delete;
PROCEDURE enumerate(VAR prefix: ARRAY OF CHAR; dpg: DiskAdr;
proc: EntryHandler; VAR continue: BOOLEAN);
VAR i, j, diff: INTEGER; dpg1: DiskAdr; a: DirPage;
BEGIN Kernel.GetSector(dpg, a); i := 0;
WHILE (i < a.m) & continue DO
j := 0;
LOOP
IF prefix[j] = 0X THEN diff := 0; EXIT END ;
diff := ORD(a.e[i].name[j]) - ORD(prefix[j]);
IF diff # 0 THEN EXIT END ;
INC(j)
END ;
IF i = 0 THEN dpg1 := a.p0 ELSE dpg1 := a.e[i-1].p END ;
IF diff >= 0 THEN (*matching prefix*)
IF dpg1 # 0 THEN enumerate(prefix, dpg1, proc, continue) END ;
IF diff = 0 THEN
IF continue THEN proc(a.e[i].name, a.e[i].adr, continue) END
ELSE continue := FALSE
END
END ;
INC(i)
END ;
IF continue & (i > 0) & (a.e[i-1].p # 0) THEN
enumerate(prefix, a.e[i-1].p, proc, continue)
END
END enumerate;
PROCEDURE Enumerate*(prefix: ARRAY OF CHAR; proc: EntryHandler);
VAR b: BOOLEAN;
BEGIN b := TRUE; enumerate(prefix, DirRootAdr, proc, b)
END Enumerate;
PROCEDURE Init;
VAR k: INTEGER;
A: ARRAY 2000 OF DiskAdr;
PROCEDURE MarkSectors;
VAR L, R, i, j, n: INTEGER; x: DiskAdr;
hd: FileHeader;
B: IndexSector;
PROCEDURE sift(L, R: INTEGER);
VAR i, j: INTEGER; x: DiskAdr;
BEGIN j := L; x := A[j];
LOOP i := j; j := 2*j + 1;
IF (j+1 < R) & (A[j] < A[j+1]) THEN INC(j) END ;
IF (j >= R) OR (x > A[j]) THEN EXIT END ;
A[i] := A[j]
END ;
A[i] := x
END sift;
BEGIN L := k DIV 2; R := k; (*heapsort*)
WHILE L > 0 DO DEC(L); sift(L, R) END ;
WHILE R > 0 DO
DEC(R); x := A[0]; A[0] := A[R]; A[R] := x; sift(L, R)
END ;
WHILE L < k DO
Kernel.GetSector(A[L], hd);
IF hd.aleng < SecTabSize THEN j := hd.aleng + 1;
REPEAT DEC(j); Kernel.MarkSector(hd.sec[j]) UNTIL j = 0
ELSE j := SecTabSize;
REPEAT DEC(j); Kernel.MarkSector(hd.sec[j]) UNTIL j = 0;
n := (hd.aleng - SecTabSize) DIV 256; i := 0;
WHILE i <= n DO
Kernel.MarkSector(hd.ext[i]);
Kernel.GetSector(hd.ext[i], B); (*index sector*)
IF i < n THEN j := 256 ELSE j := (hd.aleng - SecTabSize) MOD 256 + 1 END ;
REPEAT DEC(j); Kernel.MarkSector(B.x[j]) UNTIL j = 0;
INC(i)
END
END ;
INC(L)
END
END MarkSectors;
PROCEDURE TraverseDir(dpg: DiskAdr);
VAR i, j: INTEGER; a: DirPage;
BEGIN Kernel.GetSector(dpg, a); Kernel.MarkSector(dpg); i := 0;
WHILE i < a.m DO
A[k] := a.e[i].adr; INC(k); INC(i);
IF k = 2000 THEN MarkSectors; k := 0 END
END ;
IF a.p0 # 0 THEN
TraverseDir(a.p0); i := 0;
WHILE i < a.m DO
TraverseDir(a.e[i].p); INC(i)
END
END
END TraverseDir;
BEGIN Kernel.ResetDisk; k := 0;
TraverseDir(DirRootAdr); MarkSectors
END Init;
BEGIN Init
END FileDir.