home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 10 / Fresh_Fish_10_2352.bin / new / dev / obero / oberon / projectoberonsrc / filedir.mod (.txt) < prev    next >
Oberon Text  |  1994-10-17  |  11KB  |  339 lines
  1. Syntax10.Scn.Fnt
  2. MODULE FileDir;   (*NW 12.1.86 / 23.8.90*)
  3.     IMPORT SYSTEM, Kernel;
  4.     (*File Directory is a B-tree with its root page at DirRootAdr.
  5.         Each entry contains a file name and the disk address of the file's head sector*)
  6.     CONST FnLength*    = 32;
  7.                 SecTabSize*   = 64;
  8.                 ExTabSize*   = 12;
  9.                 SectorSize*   = 1024;
  10.                 IndexSize*   = SectorSize DIV 4;
  11.                 HeaderSize*  = 352;
  12.                 DirRootAdr*  = 29;
  13.                 DirPgSize*   = 24;
  14.                 N = DirPgSize DIV 2;
  15.                 DirMark*    = 9B1EA38DH;
  16.                 HeaderMark* = 9BA71D86H;
  17.                 FillerSize = 52;
  18.     TYPE DiskAdr      = LONGINT;
  19.         FileName*       = ARRAY FnLength OF CHAR;
  20.         SectorTable*    = ARRAY SecTabSize OF DiskAdr;
  21.         ExtensionTable* = ARRAY ExTabSize OF DiskAdr;
  22.         EntryHandler*   = PROCEDURE (name:FileName; sec: DiskAdr; VAR continue: BOOLEAN);
  23.         FileHeader* =
  24.             RECORD (Kernel.Sector)   (*allocated in the first page of each file on disk*)
  25.                 mark*: LONGINT;
  26.                 name*: FileName;
  27.                 aleng*, bleng*: INTEGER;
  28.                 date*, time*: LONGINT;
  29.                 ext*:  ExtensionTable;
  30.                 sec*: SectorTable;
  31.                 fill: ARRAY SectorSize - HeaderSize OF CHAR;
  32.             END ;
  33.         IndexSector* =
  34.             RECORD (Kernel.Sector)
  35.                 x*: ARRAY IndexSize OF DiskAdr
  36.             END ;
  37.         DataSector* =
  38.             RECORD (Kernel.Sector)
  39.                 B*: ARRAY SectorSize OF SYSTEM.BYTE
  40.             END ;
  41.         DirEntry* =  (*B-tree node*)
  42.             RECORD
  43.                 name*: FileName;
  44.                 adr*:  DiskAdr; (*sec no of file header*)
  45.                 p*:    DiskAdr  (*sec no of descendant in directory*)
  46.             END ;
  47.         DirPage*  =
  48.             RECORD (Kernel.Sector)
  49.                 mark*:  LONGINT;
  50.                 m*:     INTEGER;
  51.                 p0*:    DiskAdr;  (*sec no of left descendant in directory*)
  52.                 fill:  ARRAY FillerSize OF CHAR;
  53.                 e*:  ARRAY DirPgSize OF DirEntry
  54.             END ;
  55.     (*Exported procedures: Search, Insert, Delete, Enumerate, Init*)
  56.     PROCEDURE Search*(VAR name: FileName; VAR A: DiskAdr);
  57.         VAR i, L, R: INTEGER; dadr: DiskAdr;
  58.             a: DirPage;
  59.     BEGIN dadr := DirRootAdr;
  60.         LOOP Kernel.GetSector(dadr, a);
  61.             L := 0; R := a.m; (*binary search*)
  62.             WHILE L < R DO
  63.                 i := (L+R) DIV 2;
  64.                 IF name <= a.e[i].name THEN R := i ELSE L := i+1 END
  65.             END ;
  66.             IF (R < a.m) & (name = a.e[R].name) THEN
  67.                 A := a.e[R].adr; EXIT (*found*)
  68.             END ;
  69.             IF R = 0 THEN dadr := a.p0 ELSE dadr := a.e[R-1].p END ;
  70.             IF dadr = 0 THEN A := 0; EXIT  (*not found*) END
  71.         END
  72.     END Search;
  73.     PROCEDURE insert(VAR name: FileName;
  74.                                      dpg0:  DiskAdr;
  75.                                      VAR h: BOOLEAN;
  76.                                      VAR v: DirEntry;
  77.                                      fad:     DiskAdr);
  78.         (*h = "tree has become higher and v is ascending element"*)
  79.         VAR ch: CHAR;
  80.             i, j, L, R: INTEGER;
  81.             dpg1: DiskAdr;
  82.             u: DirEntry;
  83.             a: DirPage;
  84.     BEGIN (*~h*) Kernel.GetSector(dpg0, a);
  85.         L := 0; R := a.m; (*binary search*)
  86.         WHILE L < R DO
  87.             i := (L+R) DIV 2;
  88.             IF name <= a.e[i].name THEN R := i ELSE L := i+1 END
  89.         END ;
  90.         IF (R < a.m) & (name = a.e[R].name) THEN
  91.             a.e[R].adr := fad; Kernel.PutSector(dpg0, a)  (*replace*)
  92.         ELSE (*not on this page*)
  93.             IF R = 0 THEN dpg1 := a.p0 ELSE dpg1 := a.e[R-1].p END ;
  94.             IF dpg1 = 0 THEN (*not in tree, insert*)
  95.                 u.adr := fad; u.p := 0; h := TRUE; j := 0;
  96.                 REPEAT ch := name[j]; u.name[j] := ch; INC(j)
  97.                 UNTIL ch = 0X;
  98.                 WHILE j < FnLength DO u.name[j] := 0X; INC(j) END
  99.             ELSE
  100.                 insert(name, dpg1, h, u, fad)
  101.             END ;
  102.             IF h THEN (*insert u to the left of e[R]*)
  103.                 IF a.m < DirPgSize THEN
  104.                     h := FALSE; i := a.m;
  105.                     WHILE i > R DO DEC(i); a.e[i+1] := a.e[i] END ;
  106.                     a.e[R] := u; INC(a.m)
  107.                 ELSE (*split page and assign the middle element to v*)
  108.                     a.m := N; a.mark := DirMark;
  109.                     IF R < N THEN (*insert in left half*)
  110.                         v := a.e[N-1]; i := N-1;
  111.                         WHILE i > R DO DEC(i); a.e[i+1] := a.e[i] END ;
  112.                         a.e[R] := u; Kernel.PutSector(dpg0, a);
  113.                         Kernel.AllocSector(dpg0, dpg0); i := 0;
  114.                         WHILE i < N DO a.e[i] := a.e[i+N]; INC(i) END
  115.                     ELSE (*insert in right half*)
  116.                         Kernel.PutSector(dpg0, a);
  117.                         Kernel.AllocSector(dpg0, dpg0); DEC(R, N); i := 0;
  118.                         IF R = 0 THEN v := u
  119.                         ELSE v := a.e[N];
  120.                             WHILE i < R-1 DO a.e[i] := a.e[N+1+i]; INC(i) END ;
  121.                             a.e[i] := u; INC(i)
  122.                         END ;
  123.                         WHILE i < N DO a.e[i] := a.e[N+i]; INC(i) END
  124.                     END ;
  125.                     a.p0 := v.p; v.p := dpg0
  126.                 END ;
  127.                 Kernel.PutSector(dpg0, a)
  128.             END
  129.         END
  130.     END insert;
  131.     PROCEDURE Insert*(VAR name: FileName; fad: DiskAdr);
  132.         VAR  oldroot: DiskAdr;
  133.             h: BOOLEAN; U: DirEntry;
  134.             a: DirPage;
  135.     BEGIN h := FALSE;
  136.         insert(name, DirRootAdr, h, U, fad);
  137.         IF h THEN (*root overflow*)
  138.             Kernel.GetSector(DirRootAdr, a);
  139.             Kernel.AllocSector(DirRootAdr, oldroot); Kernel.PutSector(oldroot, a);
  140.             a.mark := DirMark; a.m := 1; a.p0 := oldroot; a.e[0] := U;
  141.             Kernel.PutSector(DirRootAdr, a)
  142.         END
  143.     END Insert;
  144.     PROCEDURE underflow(VAR c: DirPage;  (*ancestor page*)
  145.                                             dpg0:  DiskAdr;
  146.                                             s:     INTEGER;  (*insertion point in c*)
  147.                                             VAR h: BOOLEAN); (*c undersize*)
  148.         VAR i, k: INTEGER;
  149.                 dpg1: DiskAdr;
  150.                 a, b: DirPage;  (*a := underflowing page, b := neighbouring page*)
  151.     BEGIN Kernel.GetSector(dpg0, a);
  152.         (*h & a.m = N-1 & dpg0 = c.e[s-1].p*)
  153.         IF s < c.m THEN (*b := page to the right of a*)
  154.             dpg1 := c.e[s].p; Kernel.GetSector(dpg1, b);
  155.             k := (b.m-N+1) DIV 2; (*k = no. of items available on page b*)
  156.             a.e[N-1] := c.e[s]; a.e[N-1].p := b.p0;
  157.             IF k > 0 THEN
  158.                 (*move k-1 items from b to a, one to c*) i := 0;
  159.                 WHILE i < k-1 DO a.e[i+N] := b.e[i]; INC(i) END ;
  160.                 c.e[s] := b.e[i]; b.p0 := c.e[s].p;
  161.                 c.e[s].p := dpg1; DEC(b.m, k); i := 0;
  162.                 WHILE i < b.m DO b.e[i] := b.e[i+k]; INC(i) END ;
  163.                 Kernel.PutSector(dpg1, b); a.m := N-1+k; h := FALSE
  164.             ELSE (*merge pages a and b, discard b*) i := 0;
  165.                 WHILE i < N DO a.e[i+N] := b.e[i]; INC(i) END ;
  166.                 i := s; DEC(c.m);
  167.                 WHILE i < c.m DO c.e[i] := c.e[i+1]; INC(i) END ;
  168.                 a.m := 2*N; h := c.m < N
  169.             END ;
  170.             Kernel.PutSector(dpg0, a)
  171.         ELSE (*b := page to the left of a*) DEC(s);
  172.             IF s = 0 THEN dpg1 := c.p0 ELSE dpg1 := c.e[s-1].p END ;
  173.             Kernel.GetSector(dpg1, b);
  174.             k := (b.m-N+1) DIV 2; (*k = no. of items available on page b*)
  175.             IF k > 0 THEN
  176.                 i := N-1;
  177.                 WHILE i > 0 DO DEC(i); a.e[i+k] := a.e[i] END ;
  178.                 i := k-1; a.e[i] := c.e[s]; a.e[i].p := a.p0;
  179.                 (*move k-1 items from b to a, one to c*) DEC(b.m, k);
  180.                 WHILE i > 0 DO DEC(i); a.e[i] := b.e[i+b.m+1] END ;
  181.                 c.e[s] := b.e[b.m]; a.p0 := c.e[s].p;
  182.                 c.e[s].p := dpg0; a.m := N-1+k; h := FALSE;
  183.                 Kernel.PutSector(dpg0, a)
  184.             ELSE (*merge pages a and b, discard a*)
  185.                 c.e[s].p := a.p0; b.e[N] := c.e[s]; i := 0;
  186.                 WHILE i < N-1 DO b.e[i+N+1] := a.e[i]; INC(i) END ;
  187.                 b.m := 2*N; DEC(c.m); h := c.m < N
  188.             END ;
  189.             Kernel.PutSector(dpg1, b)
  190.         END
  191.     END underflow;
  192.     PROCEDURE delete(VAR name: FileName;
  193.                                      dpg0: DiskAdr;
  194.                                      VAR h: BOOLEAN;
  195.                                      VAR fad: DiskAdr);
  196.     (*search and delete entry with key name; if a page underflow arises,
  197.         balance with adjacent page or merge; h := "page dpg0 is undersize"*)
  198.         VAR i, L, R: INTEGER;
  199.             dpg1: DiskAdr;
  200.             a: DirPage;
  201.         PROCEDURE del(dpg1: DiskAdr; VAR h: BOOLEAN);
  202.             VAR dpg2: DiskAdr;  (*global: a, R*)
  203.                     b: DirPage;
  204.         BEGIN Kernel.GetSector(dpg1, b); dpg2 := b.e[b.m-1].p;
  205.             IF dpg2 # 0 THEN del(dpg2, h);
  206.                 IF h THEN underflow(b, dpg2, b.m, h); Kernel.PutSector(dpg1, b) END
  207.             ELSE
  208.                 b.e[b.m-1].p := a.e[R].p; a.e[R] := b.e[b.m-1];
  209.                 DEC(b.m); h := b.m < N; Kernel.PutSector(dpg1, b)
  210.             END
  211.         END del;
  212.     BEGIN (*~h*) Kernel.GetSector(dpg0, a);
  213.         L := 0; R := a.m; (*binary search*)
  214.         WHILE L < R DO
  215.             i := (L+R) DIV 2;
  216.             IF name <= a.e[i].name THEN R := i ELSE L := i+1 END
  217.         END ;
  218.         IF R = 0 THEN dpg1 := a.p0 ELSE dpg1 := a.e[R-1].p END ;
  219.         IF (R < a.m) & (name = a.e[R].name) THEN
  220.             (*found, now delete*) fad := a.e[R].adr;
  221.             IF dpg1 = 0 THEN  (*a is a leaf page*)
  222.                 DEC(a.m); h := a.m < N; i := R;
  223.                 WHILE i < a.m DO a.e[i] := a.e[i+1]; INC(i) END
  224.             ELSE del(dpg1, h);
  225.                 IF h THEN underflow(a, dpg1, R, h) END
  226.             END ;
  227.             Kernel.PutSector(dpg0, a)
  228.         ELSIF dpg1 # 0 THEN
  229.             delete(name, dpg1, h, fad);
  230.             IF h THEN underflow(a, dpg1, R, h); Kernel.PutSector(dpg0, a) END
  231.         ELSE (*not in tree*) fad := 0
  232.         END
  233.     END delete;
  234.     PROCEDURE Delete*(VAR name: FileName; VAR fad: DiskAdr);
  235.         VAR h: BOOLEAN; newroot: DiskAdr;
  236.             a: DirPage;
  237.     BEGIN h := FALSE;
  238.         delete(name, DirRootAdr, h, fa