(* OBERON System 3, Release 2.3.

Copyright 1999 ETH Zürich Institute for Computer Systems, 
ETH Center, CH-8092 Zürich. e-mail: oberon@inf.ethz.ch.

This module may be used under the conditions of the general Oberon 
System 3 license contract. The full text can be downloaded from

	"ftp://ftp.inf.ethz.ch/pub/software/Oberon/System3/license.txt;A"

Under the license terms stated it is in particular (a) prohibited to modify
the interface of this module in any way that disagrees with the style
or content of the system and (b) requested to provide all conversions
of the source code to another platform with the name OBERON. *)

MODULE BTrees;	(** portable *) (* ejz,   *)
	IMPORT Files;

(** BTrees is a utility module that manages b-trees with string (64 characters) or longint keys. Each key is linked to
		a longint value (org) which normaly is an offset to where the data for that key is stored. *)

	CONST
		Done* = 0; NotFound* = 1; EntryChanged* = 2; (** res codes *)

		Tag = 2425;
		PageSize = 2*1024;
		BoolSize = 1;
		IntSize = 2;
		LIntSize = 4;

		LInt = 0;
		LIntKeySize = LIntSize;
		LIntPageN = (PageSize-BoolSize-LIntSize-IntSize-LIntSize) DIV (2*(LIntKeySize+2*LIntSize));
		LIntPageSize = LIntSize+BoolSize+IntSize+LIntSize+2*LIntPageN*(LIntKeySize+2*LIntSize);

		Str = 1;
		StrKeySize* = 64; (** The maximum length of a string key. *)
		StrPageN = (PageSize-BoolSize-LIntSize-IntSize-LIntSize) DIV (2*(StrKeySize+2*LIntSize));
		StrPageSize = LIntSize+BoolSize+IntSize+LIntSize+2*StrPageN*(StrKeySize+2*LIntSize);

	TYPE
		Page = POINTER TO PageDesc;
		PageDesc = RECORD
			org: LONGINT; (* pos of this page *)
			p0: LONGINT; (* pos of left page *)
			m: INTEGER; (* number of entries *)
			dirty: BOOLEAN; (* page changed *)
			discard: BOOLEAN; (* TRUE: page is deleted *)
			next: Page (* next page in cache *)
		END;
		Tree* = POINTER TO TreeDesc; (** handle to a b-tree index *)
		TreeDesc = RECORD
			F: Files.File; (* index file *)
			cache: Page; (* list of cached pages *)
			org: LONGINT; (* pos of btree header *)
			root: LONGINT; (* pos of root page *)
			free: LONGINT; (* pos of first free page *)
			class: INTEGER; (* 0: LInt, 1: Str *)
			noCache: INTEGER; (* number of pages in cache *)
			maxCache: INTEGER (* max. number of pages in cache *)
		END;

		Entry = RECORD
			org: LONGINT; (* pos of data for key *)
			p: LONGINT (* pos of right page *)
		END;

		LIntEntry = RECORD (Entry)
			key: LONGINT
		END;
		LIntPage = POINTER TO LIntPageDesc;
		LIntPageDesc = RECORD (PageDesc)
			e: ARRAY 2*LIntPageN OF LIntEntry
		END;
		EnumLIntProc* = PROCEDURE (key, org: LONGINT; VAR cont: BOOLEAN); (** enumerator for longin keys *)

		StrEntry = RECORD (Entry)
			key: ARRAY StrKeySize OF CHAR
		END;
		StrPage = POINTER TO StrPageDesc;
		StrPageDesc = RECORD (PageDesc)
			e: ARRAY 2*StrPageN OF StrEntry
		END;
		EnumStrProc* = PROCEDURE (IN key: ARRAY OF CHAR; org: LONGINT; VAR cont: BOOLEAN); (** enumerator for string keys *)

	VAR
		MINStrKey*, MAXStrKey*: ARRAY StrKeySize OF CHAR; (** first and last string key *)

(* Allocate space for a new page. *)
	PROCEDURE AllocSpace(T: Tree; size: LONGINT): LONGINT;
		VAR
			R: Files.Rider;
			pos: LONGINT;
	BEGIN
		IF T.free > T.org THEN
			pos := T.free; Files.Set(R, T.F, pos);
			Files.ReadLInt(R, T.free) (* next free *)
		ELSE
			pos := Files.Length(T.F); Files.Set(R, T.F, pos);
			WHILE size > 0 DO
				Files.WriteChar(R, 0X); DEC(size)
			END
		END;
		RETURN pos
	END AllocSpace;

	PROCEDURE ToFree(T: Tree; P: Page);
		VAR R: Files.Rider;
	BEGIN
		Files.Set(R, T.F, P.org); Files.WriteLInt(R, T.free);
		Files.Set(R, T.F, T.org);
		Files.WriteInt(R, Tag); Files.WriteInt(R, T.class);
		Files.WriteInt(R, T.maxCache);
		T.free := P.org; Files.WriteLInt(R, T.free)
	END ToFree;

(* Force write back of a page. *)
	PROCEDURE WriteLIntPage(T: Tree; p: LIntPage);
		VAR
			R: Files.Rider;
			i: LONGINT;
	BEGIN
		ASSERT(p.org <= Files.Length(T.F));
		Files.Set(R, T.F, p.org);
		Files.WriteLInt(R, p.org);
		Files.WriteInt(R, p.m);
		Files.WriteBool(R, p.discard);
		Files.WriteLInt(R, p.p0);
		FOR i := 0 TO p.m-1 DO
			Files.WriteLInt(R, p.e[i].key);
			Files.WriteLInt(R, p.e[i].org);
			Files.WriteLInt(R, p.e[i].p)
		END;
		p.dirty := FALSE
	END WriteLIntPage;

(* Allocate a new (memory) page. *)
	PROCEDURE NewLIntPage(T: Tree): LIntPage;
		VAR
			p0, pm, pp: Page;
			p: LIntPage;
	BEGIN
		NEW(p); INC(T.noCache);
		IF T.noCache > T.maxCache THEN
			pp := NIL; pm := NIL; p0 := T.cache;
			WHILE p0 # NIL DO
				pp := pm; pm := p0; p0 := p0.next
			END;
			IF pm.dirty THEN
				WriteLIntPage(T, pm(LIntPage))
			END;
			IF pp # NIL THEN
				pp.next := pm.next
			ELSE
				T.cache := pm.next
			END;
			T.noCache := T.maxCache
		END;
		p.next := T.cache; T.cache := p;
		p.m := 0; p.p0 := -1; p.org := -1;
		p.dirty := TRUE; p.discard := FALSE;
		RETURN p
	END NewLIntPage;

(* Read page at offset org. *)
	PROCEDURE ReadLIntPage(T: Tree; org: LONGINT; VAR p: LIntPage);
		VAR
			R: Files.Rider;
			p0: Page;
			i: LONGINT;
	BEGIN
		IF org < 0 THEN
			p := NIL; RETURN
		END;
		p0 := T.cache;
		WHILE (p0 # NIL) & (p0.org # org) DO
			p0 := p0.next
		END;
		IF p0 = NIL THEN
			p := NewLIntPage(T);
			Files.Set(R, T.F, org);
			Files.ReadLInt(R, p.org); ASSERT(p.org = org);
			Files.ReadInt(R, p.m);
			Files.ReadBool(R, p.discard); ASSERT(~p.discard);
			Files.ReadLInt(R, p.p0);
			FOR i := 0 TO p.m-1 DO
				Files.ReadLInt(R, p.e[i].key);
				Files.ReadLInt(R, p.e[i].org);
				Files.ReadLInt(R, p.e[i].p)
			END;
			p.dirty := FALSE
		ELSE
			p := p0(LIntPage);
			IF (p.next = NIL) & (p # T.cache) THEN
				p0 := T.cache;
				WHILE p0.next # p DO
					p0 := p0.next
				END;
				p0.next := NIL;
				p.next := T.cache; T.cache := p
			END				
		END
	END ReadLIntPage;

(** Search for key in T. If the key could be found res = Done else res = NotFound. *) 
	PROCEDURE SearchLInt*(T: Tree; key: LONGINT; VAR org: LONGINT; VAR res: INTEGER);
		VAR
			i, L, R: LONGINT;
			a: LIntPage;
	BEGIN
		ASSERT(T.class = LInt);
		ReadLIntPage(T, T.root, a);
		LOOP 
			L := 0; R := a.m;
			WHILE L < R DO
				i := (L+R) DIV 2;
				IF key <= a.e[i].key THEN
					R := i
				ELSE
					L := i+1
				END
			END;
			IF (R < a.m) & (a.e[R].key = key) THEN
				res := Done; org := a.e[R].org;
				RETURN
			END;
			IF R = 0 THEN
				ReadLIntPage(T, a.p0, a)
			ELSE
				ReadLIntPage(T, a.e[R-1].p, a)
			END;
			IF a = NIL THEN
				res := NotFound; org := -1;
				RETURN
			END
		END	
	END SearchLInt;

	PROCEDURE insertLInt(T: Tree; key, org: LONGINT; a: LIntPage; VAR h: BOOLEAN; VAR v: LIntEntry; VAR res: INTEGER);
		VAR
			i, L, R: LONGINT;
			b: LIntPage;
			u: LIntEntry;
	BEGIN
		L := 0; R := a.m;
		WHILE L < R DO
			i := (L+R) DIV 2;
			IF key <= a.e[i].key THEN
				R := i
			ELSE
				L := i+1
			END
		END;
		IF (R < a.m) & (a.e[R].key = key) THEN
			res := EntryChanged;
			a.dirty := TRUE; a.e[R].org := org
		ELSE
			IF R = 0 THEN
				ReadLIntPage(T, a.p0, b)
			ELSE
				ReadLIntPage(T, a.e[R-1].p, b)
			END;
			IF b = NIL THEN
				res := Done;
				u.p := -1; h := TRUE;
				u.key := key; u.org := org
			ELSE
				insertLInt(T, key, org, b, h, u, res)
			END;
			IF h THEN
				ReadLIntPage(T, a.org, a); (* ensure a is still cached *)
				a.dirty := TRUE;
				IF a.m < 2*LIntPageN 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
					b := NewLIntPage(T);
					b.dirty := TRUE; b.org := AllocSpace(T, LIntPageSize);
					IF R < LIntPageN THEN
						i := LIntPageN-1; v := a.e[i];
						WHILE i > R DO
							DEC(i); a.e[i+1] := a.e[i]
						END;
						a.e[R] := u;
						i := 0;
						WHILE i < LIntPageN DO
							b.e[i] := a.e[i+LIntPageN]; INC(i)
						END
					ELSE
						DEC(R, LIntPageN);
						i := 0;
						IF R = 0 THEN
							v := u
						ELSE
							v := a.e[LIntPageN];
							WHILE i < R-1 DO
								b.e[i] := a.e[i+LIntPageN+1]; INC(i)
							END;
							b.e[i] := u; INC(i)
						END;
						WHILE i < LIntPageN DO
							b.e[i] := a.e[i+LIntPageN]; INC(i)
						END
					END;
					a.m := LIntPageN; b.m := LIntPageN;
					b.p0 := v.p; v.p := b.org
				END
			END
		END
	END insertLInt;

(** Insert a new key into T. If a new key was inserted, res = Done else res = EntryChanged. *)
	PROCEDURE InsertLInt*(T: Tree; key, org: LONGINT; VAR res: INTEGER);
		VAR
			u: LIntEntry;
			r, q: LIntPage;
			h: BOOLEAN;
	BEGIN
		ASSERT(T.class = LInt);
		h := FALSE; u.p := -1;
		ReadLIntPage(T, T.root, r);
		insertLInt(T, key, org, r, h, u, res);
		IF h THEN
			ReadLIntPage(T, T.root, q);
			q.dirty := TRUE; q.org := AllocSpace(T, LIntPageSize);
			r := NewLIntPage(T);
			r.m := 1; r.dirty := TRUE;
			r.org := T.root; r.p0 := q.org;
			r.e[0] := u
		END
	END InsertLInt;

	PROCEDURE underflowLInt(T: Tree; c, a: LIntPage; s: LONGINT; VAR h: BOOLEAN);
		VAR
			b: LIntPage;
			i, k: LONGINT;
	BEGIN
		IF s < c.m THEN
			ReadLIntPage(T, c.e[s].p, b); k := (b.m-LIntPageN+1) DIV 2;
			ReadLIntPage(T, a.org, a); (* ensure a is still cached *)
			ReadLIntPage(T, c.org, c); (* ensure c is still cached *)
			a.dirty := TRUE; c.dirty := TRUE;
			a.e[LIntPageN-1] := c.e[s]; a.e[LIntPageN-1].p := b.p0;
			IF k > 0 THEN
				i := 0;
				WHILE i < k-1 DO
					a.e[i+LIntPageN] := b.e[i]; INC(i)
				END;
				c.e[s] := b.e[k-1]; b.p0 := c.e[s].p;
				c.e[s].p := b.org; b.m := b.m-SHORT(k);
				b.dirty := TRUE; i := 0;
				WHILE i < b.m DO
					b.e[i] := b.e[i+k]; INC(i)
				END;
				a.m := LIntPageN-1+SHORT(k); h := FALSE
			ELSE
				i := 0;
				WHILE i < LIntPageN DO
					a.e[i+LIntPageN] := 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*LIntPageN; h := c.m < LIntPageN
			END
		ELSE
			DEC(s);
			IF s = 0 THEN
				ReadLIntPage(T, c.p0, b)
			ELSE
				ReadLIntPage(T, c.e[s-1].p, b)
			END;
			ReadLIntPage(T, a.org, a); (* ensure a is still cached *)
			ReadLIntPage(T, c.org, c); (* ensure c is still cached *)
			k := (b.m-LIntPageN+1) DIV 2; b.dirty := TRUE;
			IF k > 0 THEN
				a.dirty := TRUE; c.dirty := TRUE;
				i := LIntPageN-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;
				b.m := b.m-SHORT(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 := a.org; a.m := LIntPageN-1+SHORT(k); h := FALSE
			ELSE
				c.dirty := TRUE;
				c.e[s].p := a.p0; b.e[LIntPageN] := c.e[s]; i := 0;
				WHILE i < LIntPageN-1 DO
					b.e[i+LIntPageN+1] := a.e[i]; INC(i)
				END;
				b.m := 2*LIntPageN; DEC(c.m); h := c.m < LIntPageN
			END
		END
	END underflowLInt;
	
	PROCEDURE deleteLInt(T: Tree; key: LONGINT; a: LIntPage; VAR h: BOOLEAN; VAR res: INTEGER);
		VAR
			i, L, R: LONGINT;
			q: LIntPage;
		PROCEDURE del(p: LIntPage; VAR h: BOOLEAN);
			VAR
				k: LONGINT;
				q: LIntPage;
		BEGIN
			k := p.m-1; ReadLIntPage(T, p.e[k].p, q);
			IF q # NIL THEN
				del(q, h);
				IF h THEN underflowLInt(T, p, q, p.m, h) END
			ELSE
				p.dirty := TRUE; a.dirty := TRUE;
				p.e[k].p := a.e[R].p; a.e[R] := p.e[k];
				DEC(p.m); h := p.m < LIntPageN
			END
		END del;
	BEGIN
		L := 0; R := a.m;
		WHILE L < R DO
			i := (L+R) DIV 2;
			IF key <= a.e[i].key THEN
				R := i
			ELSE
				L := i+1
			END
		END ;
		IF R = 0 THEN
			ReadLIntPage(T, a.p0, q)
		ELSE
			ReadLIntPage(T, a.e[R-1].p, q)
		END;
		IF (R < a.m) & (a.e[R].key = key) THEN
			res := Done;
			IF q = NIL THEN
				a.dirty := TRUE;
				DEC(a.m); h := a.m < LIntPageN; i := R;
				WHILE i < a.m DO
					a.e[i] := a.e[i+1]; INC(i)
				END
			ELSE
				del(q, h);
				IF h THEN underflowLInt(T, a, q, R, h) END
			END
		ELSIF q # NIL THEN
			deleteLInt(T, key, q, h, res);
			IF h THEN underflowLInt(T, a, q, R, h) END
		END
	END deleteLInt;

(** Delete key from T. If key was deleted res = Done else res = NotFound. *)
	PROCEDURE DeleteLInt*(T: Tree; key: LONGINT; VAR res: INTEGER);
		VAR
			p: Page;
			r, r0: LIntPage;
			h: BOOLEAN;
	BEGIN
		ASSERT(T.class = LInt); res := NotFound;
		ReadLIntPage(T, T.root, r);
		deleteLInt(T, key, r, h, res);
		IF (res = Done) & h THEN
			ReadLIntPage(T, T.root, r);
			IF r.m = 0 THEN
				IF r.p0 >= 0 THEN
					p := T.cache;
					WHILE p # NIL DO
						IF p.dirty THEN
							WriteLIntPage(T, p(LIntPage))
						END;
						p := p.next
					END;
					ReadLIntPage(T, r.p0, r0);
					r.org := r0.org; r.dirty := TRUE; r.discard := TRUE; r.next := NIL;
					WriteLIntPage(T, r); ToFree(T, r);
					r0.org := T.root; r0.dirty := TRUE; r0.next := NIL;
					T.cache := r0; T.noCache := 1
				END
			END
		END
	END DeleteLInt;

	PROCEDURE enumerateLInt(T: Tree; p: LIntPage; min, max: LONGINT; enum: EnumLIntProc; VAR cont: BOOLEAN);
		VAR
			key, lkey, i: LONGINT;
			q: LIntPage;
	BEGIN
		IF p # NIL THEN
			lkey := MIN(LONGINT); i := 0;
			WHILE (i < p.m) & (lkey < max) DO
				key := p.e[i].key;
				IF key >= min THEN
					IF key > min THEN
						IF i = 0 THEN
							ReadLIntPage(T, p.p0, q)
						ELSE
							ReadLIntPage(T, p.e[i-1].p, q)
						END;
						enumerateLInt(T, q, min, max, enum, cont)
					END;
					IF cont & (key <= max) THEN
						enum(key, p.e[i].org, cont)
					END
				END;
				lkey := key; INC(i)
			END;
			IF cont & (lkey < max) THEN
				ReadLIntPage(T, p.e[p.m-1].p, q);
				enumerateLInt(T, q, min, max, enum, cont)
			END
		END
	END enumerateLInt;

(** Enumerate all keys in T witch range from min upto max (key >= min) & (key <= max). *)
	PROCEDURE EnumLInt*(T: Tree; min, max: LONGINT; enum: EnumLIntProc);
		VAR
			r: LIntPage;
			cont: BOOLEAN;
	BEGIN
		ASSERT(T.class = LInt);
		ReadLIntPage(T, T.root, r);
		IF r.m > 0 THEN
			cont := TRUE;
			enumerateLInt(T, r, min, max, enum, cont)
		END
	END EnumLInt;

	PROCEDURE minLIntKey(T: Tree; p: LIntPage; VAR key: LONGINT);
	BEGIN
		IF p # NIL THEN
			key := p.e[0].key;
			ReadLIntPage(T, p.p0, p);
			minLIntKey(T, p, key)
		END
	END minLIntKey;

(** Searches the smallest key used in T. *)
	PROCEDURE MinLIntKey*(T: Tree; VAR key: LONGINT; VAR res: INTEGER);
		VAR r: LIntPage;
	BEGIN
		ASSERT(T.class = LInt);
		ReadLIntPage(T, T.root, r);
		IF r.m > 0 THEN
			minLIntKey(T, r, key); res := Done
		ELSE
			key := MAX(LONGINT); res := NotFound
		END
	END MinLIntKey;

	PROCEDURE maxLIntKey(T: Tree; p: LIntPage; VAR key: LONGINT);
	BEGIN
		IF (p # NIL) & (p.m > 0) THEN
			key := p.e[p.m-1].key;
			ReadLIntPage(T, p.e[p.m-1].p, p);
			maxLIntKey(T, p, key)
		END
	END maxLIntKey;

(** Searches the biggest key used in T. *)
	PROCEDURE MaxLIntKey*(T: Tree; VAR key: LONGINT; VAR res: INTEGER);
		VAR r: LIntPage;
	BEGIN
		ASSERT(T.class = LInt);
		ReadLIntPage(T, T.root, r);
		IF r.m > 0 THEN
			maxLIntKey(T, r, key); res := Done
		ELSE
			key := MIN(LONGINT); res := NotFound
		END	
	END MaxLIntKey;

(** Create a new b-tree with longint keys. The tree is written to F starting at org.
		cache gives the minumum number of keys which should fit into the page cache. *)
	PROCEDURE NewLInt*(F: Files.File; org: LONGINT; cache: INTEGER): Tree;
		VAR
			T: Tree;
			R: Files.Rider;
	BEGIN
		NEW(T);
		T.maxCache := (cache+2*LIntPageN-1) DIV (2*LIntPageN);
		IF T.maxCache < 4 THEN
			T.maxCache := 4
		END;
		T.F := F; T.org := org;
		Files.Set(R, F, org);
		Files.WriteInt(R, Tag); Files.WriteInt(R, LInt);
		Files.WriteInt(R, T.maxCache);
		T.free := -1; Files.WriteLInt(R, T.free);
		T.root := AllocSpace(T, LIntPageSize);
		T.class := LInt; T.noCache := 0;
		T.cache := NewLIntPage(T);
		T.cache.dirty := TRUE;
		T.cache.org := T.root;
		RETURN T
	END NewLInt;

(* Force write back of a page. *)
	PROCEDURE WriteStrPage(T: Tree; p: StrPage);
		VAR
			R: Files.Rider;
			i: LONGINT;
	BEGIN
		ASSERT(p.org <= Files.Length(T.F));
		Files.Set(R, T.F, p.org);
		Files.WriteLInt(R, p.org);
		Files.WriteInt(R, p.m);
		Files.WriteBool(R, p.discard);
		Files.WriteLInt(R, p.p0);
		FOR i := 0 TO p.m-1 DO
			Files.WriteFixString(R, p.e[i].key, StrKeySize);
			Files.WriteLInt(R, p.e[i].org);
			Files.WriteLInt(R, p.e[i].p)
		END;
		p.dirty := FALSE
	END WriteStrPage;

(* Allocate a new (memory) page. *)
	PROCEDURE NewStrPage(T: Tree): StrPage;
		VAR
			p0, pm, pp: Page;
			p: StrPage;
	BEGIN
		NEW(p); INC(T.noCache);
		IF T.noCache > T.maxCache THEN
			pp := NIL; pm := NIL; p0 := T.cache;
			WHILE p0 # NIL DO
				pp := pm; pm := p0; p0 := p0.next
			END;
			IF pm.dirty THEN
				WriteStrPage(T, pm(StrPage))
			END;
			IF pp # NIL THEN
				pp.next := pm.next
			ELSE
				T.cache := pm.next
			END;
			T.noCache := T.maxCache
		END;
		p.next := T.cache; T.cache := p;
		p.m := 0; p.p0 := -1; p.org := -1;
		p.dirty := TRUE; p.discard := FALSE;
		RETURN p
	END NewStrPage;

(* Read page at offset org. *)
	PROCEDURE ReadStrPage(T: Tree; org: LONGINT; VAR p: StrPage);
		VAR
			R: Files.Rider;
			p0: Page;
			i: LONGINT;
	BEGIN
		IF org < 0 THEN
			p := NIL; RETURN
		END;
		p0 := T.cache;
		WHILE (p0 # NIL) & (p0.org # org) DO
			p0 := p0.next
		END;
		IF p0 = NIL THEN
			p := NewStrPage(T);
			Files.Set(R, T.F, org);
			Files.ReadLInt(R, p.org); ASSERT(p.org = org);
			Files.ReadInt(R, p.m);
			Files.ReadBool(R, p.discard); ASSERT(~p.discard);
			Files.ReadLInt(R, p.p0);
			FOR i := 0 TO p.m-1 DO
				Files.ReadFixString(R, p.e[i].key, StrKeySize);
				Files.ReadLInt(R, p.e[i].org);
				Files.ReadLInt(R, p.e[i].p)
			END;
			p.dirty := FALSE
		ELSE
			p := p0(StrPage);
			IF (p.next = NIL) & (p # T.cache) THEN
				p0 := T.cache;
				WHILE p0.next # p DO
					p0 := p0.next
				END;
				p0.next := NIL;
				p.next := T.cache; T.cache := p
			END
		END
	END ReadStrPage;

(** Search for key in T. If the key could be found res = Done else res = NotFound. *)
	PROCEDURE SearchStr*(T: Tree; IN key: ARRAY OF CHAR; VAR org: LONGINT; VAR res: INTEGER);
		VAR
			i, L, R: LONGINT;
			a: StrPage;
			sKey: ARRAY StrKeySize OF CHAR;
	BEGIN
		ASSERT(T.class = Str);  sKey := key;
		ReadStrPage(T, T.root, a);
		LOOP 
			L := 0; R := a.m;
			WHILE L < R DO
				i := (L+R) DIV 2;
				IF sKey <= a.e[i].key THEN
					R := i
				ELSE
					L := i+1
				END
			END;
			IF (R < a.m) & (a.e[R].key = sKey) THEN
				res := Done; org := a.e[R].org;
				RETURN
			END;
			IF R = 0 THEN
				ReadStrPage(T, a.p0, a)
			ELSE
				ReadStrPage(T, a.e[R-1].p, a)
			END;
			IF a = NIL THEN
				res := NotFound; org := -1;
				RETURN
			END
		END
	END SearchStr;

	PROCEDURE insertStr(T: Tree; VAR key: ARRAY OF CHAR; org: LONGINT; a: StrPage; VAR h: BOOLEAN; VAR v: StrEntry; VAR res: INTEGER);
		VAR
			i, L, R: LONGINT;
			b: StrPage;
			u: StrEntry;
	BEGIN
		L := 0; R := a.m;
		WHILE L < R DO
			i := (L+R) DIV 2;
			IF key <= a.e[i].key THEN
				R := i
			ELSE
				L := i+1
			END
		END;
		IF (R < a.m) & (a.e[R].key = key) THEN
			res := EntryChanged;
			a.dirty := TRUE; a.e[R].org := org
		ELSE
			IF R = 0 THEN
				ReadStrPage(T, a.p0, b)
			ELSE
				ReadStrPage(T, a.e[R-1].p, b)
			END;
			IF b = NIL THEN
				res := Done;
				u.p := -1; h := TRUE;
				 u.key := key; u.org := org
			ELSE
				insertStr(T, key, org, b, h, u, res)
			END;
			IF h THEN
				ReadStrPage(T, a.org, a); (* ensure a is still cached *)
				a.dirty := TRUE;
				IF a.m < 2*StrPageN 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
					b := NewStrPage(T);
					b.dirty := TRUE; b.org := AllocSpace(T, StrPageSize);
					IF R < StrPageN THEN
						i := StrPageN-1; v := a.e[i];
						WHILE i > R DO
							DEC(i); a.e[i+1] := a.e[i]
						END;
						a.e[R] := u;
						i := 0;
						WHILE i < StrPageN DO
							b.e[i] := a.e[i+StrPageN]; INC(i)
						END
					ELSE
						DEC(R, StrPageN);
						i := 0;
						IF R = 0 THEN
							v := u
						ELSE
							v := a.e[StrPageN];
							WHILE i < R-1 DO
								b.e[i] := a.e[i+StrPageN+1]; INC(i)
							END;
							b.e[i] := u; INC(i)
						END;
						WHILE i < StrPageN DO
							b.e[i] := a.e[i+StrPageN]; INC(i)
						END
					END;
					a.m := StrPageN; b.m := StrPageN;
					b.p0 := v.p; v.p := b.org
				END
			END
		END
	END insertStr;

(** Insert a new key into T. If a new key was inserted, res = Done else res = EntryChanged. *)
	PROCEDURE InsertStr*(T: Tree; IN key: ARRAY OF CHAR; org: LONGINT; VAR res: INTEGER);
		VAR
			u: StrEntry;
			r, q: StrPage;
			h: BOOLEAN;
			sKey: ARRAY StrKeySize OF CHAR;
	BEGIN
		ASSERT(T.class = Str);  sKey := key;
		h := FALSE; u.p := -1;
		ReadStrPage(T, T.root, r);
		insertStr(T, sKey, org, r, h, u, res);
		IF h THEN
			ReadStrPage(T, T.root, q);
			q.dirty := TRUE; q.org := AllocSpace(T, StrPageSize);
			r := NewStrPage(T);
			r.m := 1; r.dirty := TRUE;
			r.org := T.root; r.p0 := q.org;
			r.e[0] := u
		END
	END InsertStr;

	PROCEDURE underflowStr(T: Tree; c, a: StrPage; s: LONGINT; VAR h: BOOLEAN);
		VAR
			b: StrPage;
			i, k: LONGINT;
	BEGIN
		IF s < c.m THEN
			ReadStrPage(T, c.e[s].p, b); k := (b.m-StrPageN+1) DIV 2;
			ReadStrPage(T, a.org, a); (* ensure a is still cached *)
			ReadStrPage(T, c.org, c); (* ensure c is still cached *)
			a.dirty := TRUE; c.dirty := TRUE;
			a.e[StrPageN-1] := c.e[s]; a.e[StrPageN-1].p := b.p0;
			IF k > 0 THEN
				i := 0;
				WHILE i < k-1 DO
					a.e[i+StrPageN] := b.e[i]; INC(i)
				END;
				c.e[s] := b.e[k-1]; b.p0 := c.e[s].p;
				c.e[s].p := b.org; b.m := b.m-SHORT(k);
				b.dirty := TRUE; i := 0;
				WHILE i < b.m DO
					b.e[i] := b.e[i+k]; INC(i)
				END;
				a.m := StrPageN-1+SHORT(k); h := FALSE
			ELSE
				i := 0;
				WHILE i < StrPageN DO
					a.e[i+StrPageN] := 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*StrPageN; h := c.m < StrPageN
			END
		ELSE
			DEC(s);
			IF s = 0 THEN
				ReadStrPage(T, c.p0, b)
			ELSE
				ReadStrPage(T, c.e[s-1].p, b)
			END;
			ReadStrPage(T, a.org, a); (* ensure a is still cached *)
			ReadStrPage(T, c.org, c); (* ensure c is still cached *)
			k := (b.m-StrPageN+1) DIV 2; b.dirty := TRUE;
			IF k > 0 THEN
				a.dirty := TRUE; c.dirty := TRUE;
				i := StrPageN-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;
				b.m := b.m-SHORT(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 := a.org; a.m := StrPageN-1+SHORT(k); h := FALSE
			ELSE
				c.dirty := TRUE;
				c.e[s].p := a.p0; b.e[StrPageN] := c.e[s]; i := 0;
				WHILE i < StrPageN-1 DO
					b.e[i+StrPageN+1] := a.e[i]; INC(i)
				END;
				b.m := 2*StrPageN; DEC(c.m); h := c.m < StrPageN
			END
		END
	END underflowStr;
	
	PROCEDURE deleteStr(T: Tree; VAR key: ARRAY OF CHAR; a: StrPage; VAR h: BOOLEAN; VAR res: INTEGER);
		VAR
			i, L, R: LONGINT;
			q: StrPage;
		PROCEDURE del(p: StrPage; VAR h: BOOLEAN);
			VAR
				k: LONGINT;
				q: StrPage;
		BEGIN
			k := p.m-1; ReadStrPage(T, p.e[k].p, q);
			IF q # NIL THEN
				del(q, h);
				IF h THEN underflowStr(T, p, q, p.m, h) END
			ELSE
				p.dirty := TRUE; a.dirty := TRUE;
				p.e[k].p := a.e[R].p; a.e[R] := p.e[k];
				DEC(p.m); h := p.m < StrPageN
			END
		END del;
	BEGIN
		L := 0; R := a.m;
		WHILE L < R DO
			i := (L+R) DIV 2;
			IF key <= a.e[i].key THEN
				R := i
			ELSE
				L := i+1
			END
		END ;
		IF R = 0 THEN
			ReadStrPage(T, a.p0, q)
		ELSE
			ReadStrPage(T, a.e[R-1].p, q)
		END;
		IF (R < a.m) & (a.e[R].key = key) THEN
			res := Done;
			IF q = NIL THEN
				a.dirty := TRUE;
				DEC(a.m); h := a.m < StrPageN; i := R;
				WHILE i < a.m DO
					a.e[i] := a.e[i+1]; INC(i)
				END
			ELSE
				del(q, h);
				IF h THEN underflowStr(T, a, q, R, h) END
			END
		ELSIF q # NIL THEN
			deleteStr(T, key, q, h, res);
			IF h THEN underflowStr(T, a, q, R, h) END
		END
	END deleteStr;

(** Delete key from T. If key was deleted res = Done else res = NotFound. *)
	PROCEDURE DeleteStr*(T: Tree; IN key: ARRAY OF CHAR; VAR res: INTEGER);
		VAR
			p: Page;
			r, r0: StrPage;
			sKey: ARRAY StrKeySize OF CHAR;
			h: BOOLEAN;
	BEGIN
		ASSERT(T.class = Str);  sKey := key; res := NotFound;
		ReadStrPage(T, T.root, r);
		deleteStr(T, sKey, r, h, res);
		IF (res = Done) & h THEN
			ReadStrPage(T, T.root, r);
			IF r.m = 0 THEN
				IF r.p0 >= 0 THEN
					p := T.cache;
					WHILE p # NIL DO
						IF p.dirty THEN
							WriteStrPage(T, p(StrPage))
						END;
						p := p.next
					END;
					ReadStrPage(T, r.p0, r0);
					r.org := r0.org; r.dirty := TRUE; r.discard := TRUE; r.next := NIL;
					WriteStrPage(T, r); ToFree(T, r);
					r0.org := T.root; r0.dirty := TRUE; r0.next := NIL;
					T.cache := r0; T.noCache := 1
				END
			END
		END
	END DeleteStr;

	PROCEDURE enumerateStr(T: Tree; p: StrPage; IN min, max: ARRAY OF CHAR; enum: EnumStrProc; VAR cont: BOOLEAN);
		VAR
			key, lkey: ARRAY StrKeySize OF CHAR;
			q: StrPage;
			i: LONGINT;
	BEGIN
		IF p # NIL THEN
			 lkey := MINStrKey; i := 0;
			WHILE (i < p.m) & (lkey < max) DO
				 key := p.e[i].key;
				IF key >= min THEN
					IF key > min THEN
						IF i = 0 THEN
							ReadStrPage(T, p.p0, q)
						ELSE
							ReadStrPage(T, p.e[i-1].p, q)
						END;
						enumerateStr(T, q, min, max, enum, cont)
					END;
					IF cont & (key <= max) THEN
						enum(key, p.e[i].org, cont)
					END
				END;
				 lkey := key; INC(i)
			END;
			IF cont & (lkey < max) THEN
				ReadStrPage(T, p.e[p.m-1].p, q);
				enumerateStr(T, q, min, max, enum, cont)
			END
		END
	END enumerateStr;

(** Enumerate all keys in T witch range from min upto max (key >= min) & (key <= max). *)
	PROCEDURE EnumStr*(T: Tree; IN min, max: ARRAY OF CHAR; enum: EnumStrProc);
		VAR
			r: StrPage;
			cont: BOOLEAN;
	BEGIN
		ASSERT(T.class = Str);
		ReadStrPage(T, T.root, r);
		IF r.m > 0 THEN
			cont := TRUE;
			enumerateStr(T, r, min, max, enum, cont)
		END
	END EnumStr;

	PROCEDURE minStrKey(T: Tree; p: StrPage; VAR key: ARRAY OF CHAR);
	BEGIN
		IF p # NIL THEN
			 key := p.e[0].key;
			ReadStrPage(T, p.p0, p);
			minStrKey(T, p, key)
		END
	END minStrKey;

(** Searches the smallest key used in T. *)
	PROCEDURE MinStrKey*(T: Tree; VAR key: ARRAY OF CHAR; VAR res: INTEGER);
		VAR r: StrPage;
	BEGIN
		ASSERT(T.class = LInt);
		ReadStrPage(T, T.root, r);
		IF r.m > 0 THEN
			minStrKey(T, r, key); res := Done
		ELSE
			res := NotFound
		END
	END MinStrKey;

	PROCEDURE maxStrKey(T: Tree; p: StrPage; VAR key: ARRAY OF CHAR);
	BEGIN
		IF (p # NIL) & (p.m > 0) THEN
			 key := p.e[p.m-1].key;
			ReadStrPage(T, p.e[p.m-1].p, p);
			maxStrKey(T, p, key)
		END
	END maxStrKey;

(** Searches the biggest key used in T. *)
	PROCEDURE MaxStrKey*(T: Tree; VAR key: ARRAY OF CHAR; VAR res: INTEGER);
		VAR r: StrPage;
	BEGIN
		ASSERT(T.class = LInt);
		ReadStrPage(T, T.root, r);
		IF r.m > 0 THEN
			maxStrKey(T, r, key); res := Done
		ELSE
			res := NotFound
		END	
	END MaxStrKey;

(** Create a new b-tree with string keys. The tree is written to F starting at org.
		cache gives the minumum number of keys which should fit into the page cache. *)
	PROCEDURE NewStr*(F: Files.File; org: LONGINT; cache: INTEGER): Tree;
		VAR
			T: Tree;
			R: Files.Rider;
	BEGIN
		NEW(T);
		T.maxCache := (cache+2*StrPageN-1) DIV (2*StrPageN);
		IF T.maxCache < 4 THEN
			T.maxCache := 4
		END;
		T.F := F; T.org := org;
		Files.Set(R, F, org);
		Files.WriteInt(R, Tag); Files.WriteInt(R, Str);
		Files.WriteInt(R, T.maxCache);
		T.free := -1; Files.WriteLInt(R, T.free);
		T.root := AllocSpace(T, StrPageSize);
		T.class := Str; T.noCache := 0;
		T.cache := NewStrPage(T);
		T.cache.dirty := TRUE;
		T.cache.org := T.root;
		RETURN T
	END NewStr;

(** Reopen the b-tree written to F starting at org. *)
	PROCEDURE Old*(F: Files.File; org: LONGINT): Tree;
		VAR
			T: Tree;
			R: Files.Rider;
			tag: INTEGER;
	BEGIN
		NEW(T); T.F := F; T.org := org;
		Files.Set(R, F, org);
		Files.ReadInt(R, tag); ASSERT(tag = Tag); Files.ReadInt(R, T.class);
		Files.ReadInt(R, T.maxCache); Files.ReadLInt(R, T.free);
		IF T.maxCache < 4 THEN T.maxCache := 4 END;
		T.root := Files.Pos(R); T.noCache := 0; T.cache := NIL;		
		RETURN T
	END Old;

(** Flush the page-cache of T to disk. *)
	PROCEDURE Flush*(T: Tree);
		VAR
			R: Files.Rider;
			p: Page;
	BEGIN
		Files.Set(R, T.F, T.org);
		Files.WriteInt(R, Tag); Files.WriteInt(R, T.class);
		Files.WriteInt(R, T.maxCache); Files.WriteLInt(R, T.free);
		p := T.cache;
		WHILE p # NIL DO
			IF p.dirty THEN
				CASE T.class OF
					LInt: WriteLIntPage(T, p(LIntPage))
					|Str: WriteStrPage(T, p(StrPage))
				END
			END;
			p := p.next
		END;
		Files.Close(T.F)
	END Flush;

(** Return the file used by T. *)
	PROCEDURE Base*(T: Tree): Files.File;
	BEGIN
		RETURN T.F
	END Base;

	PROCEDURE Init();
		VAR i: LONGINT;
	BEGIN
		FOR i := 0 TO StrKeySize-2 DO
			MINStrKey[i] := 0X;
			MAXStrKey[i] := 0FFX
		END;
		MINStrKey[StrKeySize-1] := 0X;
		MAXStrKey[StrKeySize-1] := 0X
	END Init;

BEGIN
	Init()
END BTrees.
