Syntax10.Scn.FntSyntax10i.Scn.FnthStampElemsAlloc18 Dec 95"zSyntax10b.Scn.Fnt        8FoldElemsNew|8  8  8*-88A8Y8O88 *fe8$8q:888E8@8f88e88 ;88.8*8.88  * "8   8.88.8@8 88 8~8(88i8(8a8t8  J q8 8??MODULE ISFiles (* mah 10.1.95, MK  ATTENTION: ugly & inefficient code *); (* error to fix: ReadNext findet das letzte Element nicht 11.7.95 *) IMPORT DAFiles, SYS := SYSTEM, Out; CONST ReadOnly* = 1; ReadWrite* = 2; ok* = 0; errAccessMode* = 1; errIllegalKey* = 2; errDiskFull* = 3; errRecNotFound* = 4; nil = -1; pageOrder = 2; pageCount = pageOrder * 2 + 1; cacheSize = 10; TYPE ByteArr = POINTER TO ARRAY OF SYS.BYTE; FirstBlock = RECORD totEntries: LONGINT; keySize, dataSize: INTEGER; END; Block = RECORD numEntries: LONGINT; blockNum: LONGINT; ref: ARRAY pageCount OF LONGINT; data: ByteArr; key: ByteArr; END; File* = POINTER TO FileDesc; FileDesc* = RECORD status-: INTEGER; totEntries-: LONGINT; f: DAFiles.File; inWork: BOOLEAN; block: POINTER TO ARRAY OF SYS.BYTE; keySize, dataSize, i: INTEGER; mode: INTEGER; lastkey, k, d: ByteArr; p, q: Block; datanew, keynew: ARRAY cacheSize OF ByteArr; lastNewBlock: LONGINT; pchanged: BOOLEAN; END; PROCEDURE AllocBlock (f: File; VAR b: Block); BEGIN IF f.i = cacheSize THEN NEW (b.data, f.dataSize * pageCount); NEW (b.key, f.keySize * pageCount) ELSE b.data := f.datanew[f.i]; b.key := f.keynew[f.i]; INC (f.i) END END AllocBlock; PROCEDURE NewBlock (f: File) : LONGINT; (* searches for a new block on the DAFile *)  BEGIN REPEAT DAFiles.Read (f.f, f.lastNewBlock, f.block^); INC (f.lastNewBlock) UNTIL f.f.status = DAFiles.errIllegalKey; DEC (f.lastNewBlock); RETURN f.lastNewBlock END NewBlock; PROCEDURE WriteBlock (f: File; ds, ks: INTEGER; VAR b: Block); VAR off: INTEGER; adr: LONGINT; BEGIN off := 12 + 4 * pageCount; adr := SYS.ADR (f.block[0]); SYS.MOVE (SYS.ADR (b.numEntries), adr, off); SYS.MOVE (SYS.ADR (b.data[0]), adr + off, ds * pageCount); SYS.MOVE (SYS.ADR (b.key[0]), adr + off + ds * pageCount, ks * pageCount); DAFiles.Write (f.f, b.blockNum, f.block^) END WriteBlock; PROCEDURE ReadBlock (f: File; ds, ks: INTEGER; VAR b: Block; num: INTEGER); VAR off: INTEGER; adr: LONGINT; BEGIN DAFiles.Read (f.f, num, f.block^); ASSERT (f.f.status = DAFiles.ok); IF b.data = NIL THEN AllocBlock (f, b) END; off := 12 + 4 * pageCount; adr := SYS.ADR (f.block[0]); SYS.MOVE (adr, SYS.ADR (b.numEntries), off); SYS.MOVE (adr + off, SYS.ADR (b.data[0]), ds * pageCount); SYS.MOVE (adr + off + ds * pageCount, SYS.ADR (b.key[0]), ks * pageCount); END ReadBlock; PROCEDURE GetSize (f: File); (* determines keySize and dataSize of f *) VAR off: INTEGER; adr: LONGINT; i: INTEGER; first: FirstBlock; BEGIN DAFiles.Read (f.f, 0, first); ASSERT (f.f.status = DAFiles.ok); f.keySize := first.keySize; f.dataSize := first.dataSize; f.totEntries := first.totEntries; NEW (f.p.data, f.dataSize * pageCount); NEW (f.p.key, f.keySize * pageCount); NEW (f.q.data, f.dataSize * pageCount); NEW (f.q.key, f.keySize * pageCount); FOR i := 0 TO 9 DO NEW (f.datanew[i], f.dataSize * pageCount); NEW (f.keynew[i], f.keySize * pageCount) END; ReadBlock (f, f.dataSize, f.keySize, f.p, 1) END GetSize; PROCEDURE Compare (a, b: LONGINT; len: INTEGER): INTEGER; (* returns 0 if the two memory blocks beginning with the adresses a and b and length len are equal *)  VAR i: INTEGER; ch1, ch2: SYS.BYTE; BEGIN i := 0; SYS.GET (a, ch1); SYS.GET (b, ch2); WHILE (i < len) & (ch1 = ch2) DO INC (i); SYS.GET (a + i, ch1); SYS.GET (b + i, ch2) END; IF i = len THEN RETURN 0 END; RETURN SYS.VAL (SHORTINT, ch1) - SYS.VAL (SHORTINT, ch2) END Compare; PROCEDURE Pos (VAR key: ARRAY OF SYS.BYTE; VAR b: Block; VAR found: BOOLEAN; VAR i: LONGINT; ks: INTEGER); (* finds position of element defined by key in block b *)  VAR j, k: LONGINT; BEGIN i := 1; j := b.numEntries; WHILE i <= j DO k := (i + j) DIV 2; IF Compare (SYS.ADR (b.key[k * ks]), SYS.ADR (key[0]), ks) < 0 THEN i := k + 1 ELSE j := k - 1 END END; found := (i <= b.numEntries) & (Compare (SYS.ADR (b.key[i * ks]), SYS.ADR (key[0]), ks) = 0) END Pos; PROCEDURE Copy (VAR src, dst: Block; ks, ds, s0, d0, n: LONGINT); BEGIN IF s0 > d0 THEN WHILE n > 0 DO SYS.MOVE (SYS.ADR (src.data[0]) + s0 * ds, SYS.ADR (dst.data[0]) + d0 * ds, ds); SYS.MOVE (SYS.ADR (src.key[0]) + s0 * ks, SYS.ADR (dst.key[0]) + d0 * ks, ks); dst.ref[d0] := src.ref[s0]; INC (d0); INC (s0); DEC (n) END ELSE WHILE n > 0 DO DEC (n); dst.ref[d0 + n] := src.ref[s0 + n]; SYS.MOVE (SYS.ADR (src.data[0]) + (s0 + n) * ds, SYS.ADR (dst.data[0]) + (d0 + n) * ds, ds); SYS.MOVE (SYS.ADR (src.key[0]) + (s0 + n) * ks, SYS.ADR (dst.key[0]) + (d0 + n) * ks, ks) END END END Copy; PROCEDURE SetData (VAR b: Block; off: LONGINT; ks, ds: INTEGER; VAR key, data: ARRAY OF SYS.BYTE); BEGIN SYS.MOVE (SYS.ADR (key[0]), SYS.ADR (b.key[off * ks]), ks); SYS.MOVE (SYS.ADR (data[0]), SYS.ADR (b.data[off * ds]), ds) END SetData; PROCEDURE GetData (VAR b: Block; off: LONGINT; ks, ds: INTEGER; VAR key, data: ARRAY OF SYS.BYTE); BEGIN SYS.MOVE (SYS.ADR (b.key[off * ks]), SYS.ADR (key[0]), ks); SYS.MOVE (SYS.ADR (b.data[off * ds]), SYS.ADR (data[0]), ds) END GetData; PROCEDURE Create* (name: ARRAY OF CHAR; keySize, dataSize: INTEGER) : File; VAR f: File; i: INTEGER; BEGIN NEW (f); f.f := DAFiles.Create (name, (keySize + dataSize + 4) * pageCount + 12); IF f.f = NIL THEN RETURN NIL END; f.totEntries := 0; f.status := ok; f.lastNewBlock := 2; f.keySize := keySize; f.dataSize := dataSize; f.mode := ReadWrite; NEW (f.block, (f.keySize + f.dataSize + 4) * pageCount + 12); f.p.numEntries := 0; f.p.ref[0] := nil; f.p.blockNum := 1; NEW (f.p.data, dataSize * pageCount); NEW (f.p.key, keySize * pageCount); NEW (f.q.data, dataSize * pageCount); NEW (f.q.key, keySize * pageCount); FOR i := 0 TO 9 DO NEW (f.datanew[i], dataSize * pageCount); NEW (f.keynew[i], keySize * pageCount) END; NEW (f.k, keySize); NEW (f.d, dataSize); f.pchanged := TRUE; f.inWork := FALSE; f.i := 0; RETURN f END Create; PROCEDURE Open* (name: ARRAY OF CHAR; mode: INTEGER) : File; VAR f: File; BEGIN NEW (f); f.f := DAFiles.Open (name, mode); f.status := ok; f.lastNewBlock := 2; IF f.f = NIL THEN RETURN NIL END; NEW (f.block, f.f.entrySize); f.mode := mode; GetSize (f); NEW (f.k, f.keySize); NEW (f.d, f.dataSize); f.inWork := FALSE; f.i := 0; RETURN f END Open; PROCEDURE Write* (f: File; VAR key, data: ARRAY OF SYS.BYTE); VAR k: LONGINT; ovfl, init, exists: BOOLEAN; ref: LONGINT; k1, k2: POINTER TO RECORD x: LONGINT END; PROCEDURE Insert (VAR key, data: ARRAY OF SYS.BYTE; VAR p: Block; VAR ovfl: BOOLEAN; VAR found: BOOLEAN; ks, ds: INTEGER); VAR i: LONGINT; q: Block; BEGIN IF init THEN q := f.q; init := FALSE ELSE q.data := NIL END; Pos (key, p, found, i, ks); IF found THEN (* replace *) SetData (p, i, ks, ds, key, data); ovfl := FALSE; WriteBlock (f, f.dataSize, f.keySize, p) ELSIF p.ref[0] = nil THEN (* leaf *) ref := nil; ovfl := TRUE ELSE ReadBlock (f, f.dataSize, f.keySize, q, SHORT (p.ref[i-1])); Insert (key, data, q, ovfl, found, ks, ds) END; IF ovfl THEN (* insert e in p *) IF p.numEntries < 2 * pageOrder THEN (* insert *) Copy (p, p, ks, ds, i, i + 1, p.numEntries - i + 1); SetData (p, i, ks, ds, key, data); p.ref[i] := ref; INC (p.numEntries); ovfl := FALSE ELSE (* split and propagate overflow *) IF q.data = NIL THEN AllocBlock (f, q) END; q.numEntries := pageOrder; p.numEntries := pageOrder; IF i <= pageOrder THEN (* insert in lower half *) Copy (p, q, ks, ds, pageOrder, 0, pageOrder + 1); Copy (p, p, ks, ds, i, i + 1, pageOrder - i); SetData (p, i, ks, ds, key, data); p.ref[i] := ref ELSE (* insert in upper half *) Out.F ("berlauf : #", i); Copy (p, q, ks, ds, pageOrder + 1, 0 , i - pageOrder - 1); Copy (p, q, ks, ds, i, i - pageOrder, 2 * pageOrder - i + 1); SetData (q, i- pageOrder - 1, ks, ds, key, data); q.ref[i - pageOrder - 1] := ref END; q.blockNum := NewBlock(f); Out.F ("$$Neuer Block: #$$", q.blockNum); GetData (q, 0, ks, ds, key, data); ref := q.blockNum; WriteBlock (f, f.dataSize, f.keySize, q) END; WriteBlock (f, f.dataSize, f.keySize, p) END END Insert; BEGIN (* Write *) IF f.mode # ReadWrite THEN f.status := errAccessMode; RETURN ELSE f.status := ok END; IF ~f.inWork THEN f.i := 0; f.inWork := TRUE ELSE HALT (102) END; ref := nil; init := TRUE; Insert (key, data, f.p, ovfl, exists, f.keySize, f.dataSize); IF ovfl THEN k := NewBlock(f); f.p.blockNum := k; Out.F ("$$First Neuer Block: #$$", k); WriteBlock (f, f.dataSize, f.keySize, f.p); f.p.numEntries := 1; f.p.ref[0] := k; f.p.blockNum := 1; SYS.PUT (SYS.ADR (k1), SYS.ADR (key)); SYS.PUT (SYS.ADR (k2), SYS.ADR (data)); Out.F2 ("key = #, data = #", k1.x, k2.x); SetData (f.p, 1, f.keySize, f.dataSize, key, data); GetData (f.p, 1, f.keySize, f.dataSize, key, data); SYS.PUT (SYS.ADR (k1), SYS.ADR (key)); SYS.PUT (SYS.ADR (k2), SYS.ADR (data)); Out.F2 ("key = #, data = #", k1.x, k2.x); f.p.ref[1] := ref; f.pchanged := TRUE END; IF ~exists THEN INC (f.totEntries) END; f.inWork := FALSE END Write; PROCEDURE Read* (f: File; VAR key, data: ARRAY OF SYS.BYTE); VAR i: LONGINT; found: BOOLEAN; k1, k2: POINTER TO RECORD x: LONGINT END; BEGIN f.status := ok; IF f.lastkey = NIL THEN NEW (f.lastkey, f.keySize) END; SYS.MOVE (SYS.ADR (key[0]), SYS.ADR (f.lastkey[0]), f.keySize); Pos (key, f.p, found, i, f.keySize); Out.F ("$Read: #", i); IF found THEN Out.String ("found") ELSE Out.String ("not found") END; IF found THEN GetData (f.p, i, f.keySize, f.dataSize, key, data) ;SYS.PUT (SYS.ADR (k1), SYS.ADR (key)); SYS.PUT (SYS.ADR (k2), SYS.ADR (data)); Out.F2 ("key = #, data = #", k1.x, k2.x); ELSIF f.p.ref[0] # nil THEN Out.F ("ReadBlock von: #", f.p.ref[i - 1]); ReadBlock (f, f.dataSize, f.keySize, f.q, SHORT (f.p.ref[i - 1])); LOOP Pos (key, f.q, found, i, f.keySize); IF found THEN GetData (f.q, i, f.keySize, f.dataSize, key, data); EXIT ELSIF f.q.ref[0] # nil THEN ReadBlock (f, f.dataSize, f.keySize, f.q, SHORT (f.q.ref[i - 1])) ELSE f.status := errIllegalKey; f.lastkey := NIL; EXIT END END ELSE f.status := errIllegalKey; f.lastkey := NIL END END Read; PROCEDURE ReadNext* (f: File; VAR key, data: ARRAY OF SYS.BYTE); VAR i: LONGINT; found: BOOLEAN; q: Block; BEGIN IF f.lastkey = NIL THEN f.status := errRecNotFound; RETURN END; f.lastkey[LEN (f.lastkey^) - 1] := SYS.VAL (SHORTINT, f.lastkey[LEN (f.lastkey^) - 1]) + 1; f.status := ok; SYS.MOVE (SYS.ADR (f.lastkey[0]), SYS.ADR (key[0]), f.keySize); Pos (f.lastkey^, f.p, found, i, f.keySize); IF found THEN GetData (f.p, i, f.keySize, f.dataSize, key, data) ELSIF f.p.ref[0] # nil THEN ReadBlock (f, f.dataSize, f.keySize, q, SHORT (f.p.ref[i - 1])); LOOP Pos (f.lastkey^, q, found, i, f.keySize); IF found THEN GetData (q, i, f.keySize, f.dataSize, key, data); EXIT ELSIF q.ref[0] # nil THEN ReadBlock (f, f.dataSize, f.keySize, q, SHORT (q.ref[i - 1])) ELSE GetData (q, i, f.keySize, f.dataSize, f.lastkey^, data); IF Compare (SYS.ADR (f.lastkey[0]), SYS.ADR (key[0]), SHORT (LEN (f.lastkey^))) < 0 THEN f.status := errRecNotFound END; SYS.MOVE (SYS.ADR (f.lastkey[0]), SYS.ADR (key[0]), f.keySize); EXIT END END ELSE f.status := errIllegalKey; f.lastkey := NIL END END ReadNext; PROCEDURE Restart* (f: File); VAR i: INTEGER; BEGIN f.status := ok; IF f.lastkey = NIL THEN NEW (f.lastkey, f.keySize) END; FOR i := 0 TO f.keySize - 1 DO f.lastkey[i] := 0 END END Restart; PROCEDURE Close* (f: File); VAR first: FirstBlock; BEGIN first.keySize := f.keySize; first.dataSize := f.dataSize; first.totEntries := f.totEntries; DAFiles.Write (f.f, 0, first); IF f.pchanged THEN WriteBlock (f, f.dataSize, f.keySize, f.p); f.pchanged := FALSE END; DAFiles.Close (f.f) END Close; PROCEDURE Delete* (f: File; VAR key: ARRAY OF SYS.BYTE); VAR ufl, init, exists: BOOLEAN; num: LONGINT; PROCEDURE Del (key: ARRAY OF SYS.BYTE; VAR p: Block; VAR ufl: BOOLEAN; VAR found: BOOLEAN; ks, ds: INTEGER); VAR dirty: BOOLEAN; i: LONGINT; a, b: Block; PROCEDURE Adjust (VAR a, p, b: Block; i: LONGINT); VAR d: LONGINT; BEGIN (* assert: a.len = N-1 OR b.len = N-1 *) SYS.MOVE (SYS.ADR (p.data[i*f.dataSize]), SYS.ADR (b.data[0]), f.dataSize); SYS.MOVE (SYS.ADR (p.key[i*f.keySize]), SYS.ADR (b.key[0]), f.keySize); IF (a.numEntries + b.numEntries < 2*pageOrder) THEN (* merge a + b => a *) Copy (b, a, ks, ds, 0, a.numEntries + 1, b.numEntries + 1); a.numEntries := 2 * pageOrder; Copy (p, p, ks, ds, i + 1, i, p.numEntries - i); DEC (p.numEntries) ELSE (* a and b remain *) IF a.numEntries = pageOrder-1 THEN d := (b.numEntries - a.numEntries) DIV 2; Copy (b, a, ks, ds, 0, a.numEntries+1, d); Copy (b, b, ks, ds, d, 0, b.numEntries-d+1); DEC (b.numEntries, d); INC (a.numEntries, d) ELSE d := (a.numEntries - b.numEntries) DIV 2; Copy (a, a, ks, ds, 0, d, b.numEntries + 1); Copy (a, b, ks, ds, a.numEntries - d + 1, 0, d); INC (b.numEntries, d); DEC (a.numEntries, d) END; SYS.MOVE (SYS.ADR (b.data[0]) , SYS.ADR (p.data[i * f.dataSize]), f.dataSize); SYS.MOVE (SYS.ADR (b.key[0]) , SYS.ADR (p.key[i * f.keySize]), f.keySize); WriteBlock (f, f.dataSize, f.keySize, b) END; WriteBlock (f, f.dataSize, f.keySize, a) END Adjust; PROCEDURE SwapBiggest (VAR p: Block; VAR key, data: ARRAY OF SYS.BYTE; VAR ufl: BOOLEAN); VAR dirty : BOOLEAN; a,b: Block; BEGIN dirty := FALSE; IF p.ref[0] = nil THEN (* leaf *) GetData (p, p.numEntries, ks, ds, key, data); DEC(p.numEntries); dirty := TRUE ELSE (* inner node *) ReadBlock (f, f.dataSize, f.keySize, b, SHORT (p.ref[p.numEntries])); SwapBiggest (b, key, data, ufl); IF ufl THEN ReadBlock (f, f.dataSize, f.keySize, a, SHORT (p.ref[p.numEntries-1])); Adjust (a, p, b, p.numEntries); dirty := TRUE END END; ufl := p.numEntries < pageOrder; IF dirty & ~ufl THEN WriteBlock (f, f.dataSize, f.keySize, p) END END SwapBiggest; BEGIN (* Del *) Pos (key, p, found, i, ks); dirty := FALSE; IF p.ref[0] = nil THEN (* leaf *) IF found THEN Copy (p, p, ks, ds, i + 1, i, p.numEntries - i); DEC(p.numEntries); dirty := TRUE END ELSE (* inner node *) IF found THEN ReadBlock(f, f.dataSize, f.keySize, a, SHORT (p.ref[i-1])); GetData (p, i, ks, ds, f.k^, f.d^); SwapBiggest (a, f.k^ , f.d^, ufl); dirty := TRUE; SetData (p, i, ks, ds, f.k^, f.d^); IF ufl THEN ReadBlock (f, f.dataSize, f.keySize, b, SHORT (p.ref[i])) END ELSIF i = 1 THEN ReadBlock (f, f.dataSize, f.keySize, a, SHORT (p.ref[0])); Del (key, a, ufl, found, ks, ds); IF ufl THEN ReadBlock (f, f.dataSize, f.keySize, b, SHORT (p.ref[1])) END ELSE DEC (i); ReadBlock (f, f.dataSize, f.keySize, b, SHORT (p.ref[i])); Del(key, b, ufl, found, ks, ds); IF ufl THEN ReadBlock (f, f.dataSize, f.keySize, a, SHORT (p.ref[i-1])) END END; IF ufl THEN Adjust (a, p, b,i); dirty := TRUE END END; ufl := (p.numEntries < pageOrder) & (p.blockNum # 1); IF dirty & ~ufl THEN WriteBlock (f, f.dataSize, f.keySize, p) END; END Del; BEGIN IF f.mode # ReadWrite THEN f.status := errAccessMode; RETURN ELSE f.status := ok END; IF ~ f.inWork THEN f.i := 0; f.inWork := TRUE ELSE HALT (101) END; init := TRUE; Del (key, f.p, ufl, exists, f.keySize, f.dataSize); IF exists THEN DEC (f.totEntries) END; IF (f.p.numEntries = 0) & (f.p.ref[0] # nil) THEN num := f.p.blockNum; ReadBlock (f, f.dataSize, f.keySize, f.p, SHORT (f.p.ref[0])); IF f.lastNewBlock > num THEN f.lastNewBlock := num; DAFiles.Delete (f.f, num) END; f.p.blockNum := 1; f.pchanged := TRUE END; f.inWork := FALSE END Delete; END ISFiles.