MODULE SqlDB;
(**
	project	= "BlackBox"
	organization	= "www.oberon.ch"
	contributors	= "Oberon microsystems"
	version	= "System/Rsrc/About"
	copyright	= "System/Rsrc/About"
	license	= "Docu/BB-License"
	changes	= "
	- 20070414, mf, Compile: expansion of 'native' designators corrected
	- 20141027, center #19, full Unicode support for Component Pascal identifiers added
	- 20151125, center #87, adding support for LONGINT in SqlDrivers.Table
	"
	issues	= "
	- ...
	"

**)
	
	IMPORT SYSTEM, Kernel, Log, Strings, Dates, Meta, Dialog, Services, SqlDrivers;

	(*
		The following framework-defined types are handled by this module, in
		addition to the data types of the language itself:
		Dialog.Currency
		Dialog.List
		Dialog.Combo
		Dates.Date
		Dates.Time
		SqlDB.Blob
	*)

	CONST
		names* = -1; types = -2;
		converted* = 1; truncated* = 2; overflow* = 3; incompatible* = 4; noData* = 5;
		sync* = FALSE; async* = TRUE;
		showErrors* = TRUE; hideErrors* = FALSE;
		readOp = -10; clearOp = -11; openOp = -12; beginOp = -13; endOp = -14;
		commitOp = -15; rollbackOp = -16; callOp = -17; tcallOp = -18;
		update = 2; guardCheck = 4;
		varLen = 48;
		maxOperations = 20;

	TYPE
		Database* = POINTER TO ABSTRACT RECORD
			res*: INTEGER;
			async*: BOOLEAN;
			showErrors*: BOOLEAN
		END;

		Table* = POINTER TO ABSTRACT RECORD
			base-: Database;
			rows*, columns*: INTEGER;
			res*: INTEGER;
			strictNotify*: BOOLEAN	(* strict notification *)
		END;

		String* = POINTER TO ARRAY OF CHAR;

		Row* = RECORD
			fields*: POINTER TO ARRAY OF String;
		END;

		Blob* = RECORD
			len*: INTEGER;
			data*: POINTER TO ARRAY OF BYTE	(* not 0X terminated **)
		END;

		Command* = PROCEDURE (p: ANYPTR);
		TableCommand* = PROCEDURE (t: Table; p: ANYPTR);


		Range = POINTER TO RECORD	(* list of pending update notifications *)
			next: Range;
			adr0, adr1: INTEGER	(* address range belonging to an interactor that has been modified *)
		END;

		StdDatabase = POINTER TO RECORD (Database)
			queue: Elem;	(* list of tasks *)
			tail: Elem;	(* first element of low priority part in queue *)
			range: Range;	(* list of pending notifications *)
			lastRange: Range; (* the last element in the list of ranges - allows for search optimization *)
			action: Action;	(* action which executes queue elements & ranges *)
			id: INTEGER;	(* timestamp of actually executing command *)
			executing: BOOLEAN;
			driver: SqlDrivers.Driver
		END;

		StdTable = POINTER TO RECORD (Table)
			table: SqlDrivers.Table;	(* current result table *)
			db: StdDatabase;	(* = base(StdDatabase) *)
			srows: INTEGER;	(* safe copy of rows *)
			id: INTEGER	(* table creation id *)
		END;

		Elem = POINTER TO RECORD	(* async operations are put into queues of such elements *)
			next: Elem;	(* list of tasks *)
			op: INTEGER;
			table: StdTable;
			statement: String;
			item: Meta.Item;
			cmd: Command;
			tcmd: TableCommand;
			par: ANYPTR
		END;

		Action = POINTER TO RECORD (Services.Action)
			database: StdDatabase	(* database # NIL *)
		END;

		Statement = RECORD	(* representation of one SQL statement *)
			buf: ARRAY 1024 OF CHAR;	(* valid if idx < LEN(buf) *)
			ext: String;	(* valid if idx >= LEN(buf) *)
			idx: INTEGER;	(* actual length without 0X *)
			blobs, last: SqlDrivers.Blob	(* blob parameters *)
		END;

		CurrencyValue = RECORD (Meta.Value)
			value: Dialog.Currency
		END;

		DateValue = RECORD (Meta.Value)
			value: Dates.Date
		END;

		TimeValue = RECORD (Meta.Value)
			value: Dates.Time
		END;

		StringValue = RECORD (Meta.Value)
			value: String
		END;

		BlobValue = RECORD (Meta.Value)
			value: Blob
		END;

		RowValue = RECORD (Meta.Value)
			value: Row
		END;


	VAR
		debug*: BOOLEAN;
		dummy: Meta.Item;	(* remains undefined *)
		ptr: POINTER TO RECORD END;	(* used for ptr field in contructed items *)
		nullStr: ARRAY 5 OF CHAR;


	(* error handling *)

	PROCEDURE WriteString (s: ARRAY OF CHAR);
	BEGIN
		IF debug THEN Log.String(s); Log.Ln END
	END WriteString;


	(** Table interface **)

	PROCEDURE (t: Table) InitBase* (base: Database), NEW;
	BEGIN
		ASSERT(base # NIL, 20); ASSERT((t.base = NIL) OR (t.base = base), 21);
		t.base := base
	END InitBase;

	PROCEDURE (t: Table) Exec* (statement: ARRAY OF CHAR), NEW, ABSTRACT;
	PROCEDURE (t: Table) Available* (): BOOLEAN, NEW, ABSTRACT;
	PROCEDURE (t: Table) Read* (row: INTEGER; VAR data: ANYREC), NEW, ABSTRACT;
	PROCEDURE (t: Table) Clear*, NEW, ABSTRACT;
	PROCEDURE (t: Table) Call* (command: TableCommand; par: ANYPTR), NEW, ABSTRACT;


	(** Database interface **)

	PROCEDURE (d: Database) Exec* (statement: ARRAY OF CHAR), NEW, ABSTRACT;
	PROCEDURE (d: Database) Commit*, NEW, ABSTRACT;
	PROCEDURE (d: Database) Rollback*, NEW, ABSTRACT;
	PROCEDURE (d: Database) Call* (command: Command; par: ANYPTR), NEW, ABSTRACT;
	PROCEDURE (d: Database) NewTable* (): Table, NEW, ABSTRACT;


	(* statement expansion *)

	PROCEDURE ReadPath (IN s: ARRAY OF CHAR; OUT t: ARRAY OF CHAR; VAR i: INTEGER; VAR ch: CHAR);
		VAR j: INTEGER;
	BEGIN	(* extract the designator that describes a global variable *)
		j := 0;
		IF Strings.IsIdentStart(ch) THEN
			REPEAT
				t[j] := ch; INC(j);
				INC(i); ch := s[i]
			UNTIL ~Strings.IsIdent(ch) & (ch # ".")
		END;
		t[j] := 0X
	END ReadPath;

	PROCEDURE AddStr (IN s: ARRAY OF CHAR; native: BOOLEAN; max: INTEGER; VAR t: Statement);
		VAR i, len: INTEGER; e: String; ch: CHAR;
	BEGIN	(* append a string to a statement *)
		IF (t.idx + max < LEN(t.buf)) & (t.ext = NIL) THEN
			i := 0; ch := s[0];
			WHILE (i < max) & (ch # 0X) DO
				t.buf[t.idx] := ch; INC(t.idx);
				IF (ch = "'") & ~native THEN t.buf[t.idx] := "'"; INC(t.idx) END;
				INC(i); ch := s[i]
			END
		ELSE
			IF t.ext = NIL THEN
				len := LEN(t.buf); REPEAT len := len * 4 UNTIL t.idx + max < len;
				NEW(t.ext, len); t.buf[t.idx] := 0X; t.ext^ := t.buf$
			ELSIF t.idx + max >= LEN(t.ext^) THEN
				len := LEN(t.ext^); REPEAT len := len * 4 UNTIL t.idx + max < len;
				NEW(e, len); t.ext[t.idx] := 0X; e^ := t.ext^$; t.ext := e
			END;
			i := 0; ch := s[0];
			WHILE (i < max) & (ch # 0X) DO
				t.ext[t.idx] := ch; INC(t.idx);
				IF (ch = "'") & ~native THEN t.ext[t.idx] := "'"; INC(t.idx) END;
				INC(i); ch := s[i]
			END
		END
	END AddStr;

	PROCEDURE AddChar (ch: CHAR; VAR t: Statement);
		VAR e: String;
	BEGIN	(* append a character to a statement *)
		IF (t.idx < LEN(t.buf) - 1) & (t.ext = NIL) THEN
			t.buf[t.idx] := ch; INC(t.idx)
		ELSE
			IF t.ext = NIL THEN
				NEW(t.ext, 4 * LEN(t.buf)); t.buf[t.idx] := 0X; t.ext^ := t.buf$
			ELSIF t.idx = LEN(t.ext^) - 1 THEN
				NEW(e, 4 * LEN(t.ext^)); t.ext[t.idx] := 0X; e^ := t.ext^$; t.ext := e
			END;
			t.ext[t.idx] := ch; INC(t.idx)
		END
	END AddChar;

	PROCEDURE RealToString (x: SHORTREAL; minPrec: SHORTINT; OUT s: ARRAY OF CHAR);
		VAR y: REAL; res: INTEGER;
	BEGIN
		(* find the shortest string that can represent the number as a string *)
		(* this is a hack to avoid conversion problems between binary and textual representations *)
		REPEAT
			Strings.RealToStringForm(x, minPrec, 0, 0, " ", s);
			Strings.StringToReal(s, y, res);
			INC(minPrec)
		UNTIL x = SHORT(y)
	END RealToString;

	PROCEDURE LongToString (x: LONGINT; scale: INTEGER; OUT s: ARRAY OF CHAR);
		VAR d: ARRAY 24 OF CHAR; i, j: INTEGER;
	BEGIN
		i := 0; j := 0;
		IF x < 0 THEN s[0] := "-"; i := 1; x := -x END;
		REPEAT d[j] := CHR(x MOD 10 + ORD("0")); INC(j); x := x DIV 10 UNTIL x = 0;
		WHILE j <= scale DO d[j] := "0"; INC(j) END;
		WHILE j > scale DO DEC(j); s[i] := d[j]; INC(i) END;
		IF j > 0 THEN s[i] := "."; INC(i) END;
		WHILE j > 0 DO DEC(j); s[i] := d[j]; INC(i) END;
		s[i] := 0X
	END LongToString;

	PROCEDURE AddItem (d: StdDatabase; item: Meta.Item; native: BOOLEAN; VAR s: Statement);
		TYPE Ptr = POINTER TO ARRAY [1] MAX(INTEGER) DIV 2 OF CHAR;
		VAR base: Meta.Item; ok: BOOLEAN; i, len, res: INTEGER; h: ARRAY 64 OF CHAR;
			mod, typ: Meta.Name; dc: CurrencyValue; dv: DateValue; dt: TimeValue; p: Ptr;
			sc: Meta.Scanner; x, y: REAL; z: SHORTREAL; prec: SHORTINT;
			bv: BlobValue; blob: SqlDrivers.Blob;
	BEGIN	(* read the value represented by an item, translate it into a string, and append this string to a statement *)
		CASE item.typ OF
		| Meta.byteTyp, Meta.sIntTyp, Meta.intTyp:
			Strings.IntToString(item.IntVal(), h); AddStr(h, FALSE, 12, s)
		| Meta.longTyp:
			Strings.IntToString(item.LongVal(), h); AddStr(h, FALSE, 24, s)
		| Meta.sRealTyp:
			z := SHORT(item.RealVal()); prec := 7;
			(* find the shortest string that can represent the number as a string *)
			(* this is a hack to avoid conversion problems between binary and textual representations *)
			REPEAT
				Strings.RealToStringForm(z, prec, 0, 0, " ", h);
				Strings.StringToReal(h, y, res);
				INC(prec)
			UNTIL (z = SHORT(y)) OR (prec = 10);
			AddStr(h, FALSE, 20, s)
		| Meta.realTyp:
			x := item.RealVal(); prec := 16;
			(* find the shortest string that can represent the number as a string *)
			(* this is a hack to avoid conversion problems between binary and textual representations *)
			REPEAT
				Strings.RealToStringForm(x, prec, 0, 0, " ", h);
				Strings.StringToReal(h, y, res);
				INC(prec)
			UNTIL (x = y) OR (prec = 19);
			AddStr(h, FALSE, 28, s)
		| Meta.boolTyp:
			IF item.BoolVal() THEN AddChar("1", s) ELSE AddChar("0", s) END
		| Meta.arrTyp:
			IF item.BaseTyp() = Meta.charTyp THEN	(* string *)
				p := SYSTEM.VAL(Ptr, item.adr);
				IF ~native THEN AddChar("'", s) END;
				AddStr(p^, native, item.Len(), s);
				IF ~native THEN AddChar("'", s) END
			ELSE	(* array of basic type *)
				len := item.Len(); ASSERT(len > 0, 100);
				item.Index(0, base); AddItem(d, base, native, s); i := 1;
				WHILE i < len DO
					AddChar(",", s); AddChar(" ", s);
					item.Index(i, base); AddItem(d, base, native, s);
					INC(i)
				END
			END
		| Meta.recTyp:
			item.GetTypeName(mod, typ);
			IF (mod = "Dialog") & (typ = "Currency") THEN
				item.GetVal(dc, ok); ASSERT(ok, 101);
				LongToString(dc.value.val, dc.value.scale, h); AddStr(h, FALSE, 24, s);
			ELSIF (mod = "Dialog") & (typ = "List") THEN
				item.Lookup("index", base);
				AddItem(d, base, native, s)
			ELSIF (mod = "Dialog") & (typ = "Combo") THEN
				item.Lookup("item", base);
				AddItem(d, base, native, s)
			ELSIF (mod = "Dates") & (typ = "Date") THEN
				item.GetVal(dv, ok); ASSERT(ok, 101);
				IF (dv.value.year = 0) & (dv.value.month = 0) & (dv.value.day = 0) THEN
					AddStr(nullStr, FALSE, 4, s)
				ELSE
					IF ~native THEN AddChar("'", s) END;
					Strings.IntToString(dv.value.year, h);
					AddStr(h, FALSE, 8, s); AddChar("/", s);
					Strings.IntToStringForm(dv.value.month, Strings.decimal, 2, "0", FALSE, h);
					AddStr(h, FALSE, 4, s); AddChar("/", s);
					Strings.IntToStringForm(dv.value.day, Strings.decimal, 2, "0", FALSE, h);
					AddStr(h, FALSE, 4, s);
					IF ~native THEN AddChar("'", s) END
				END
			ELSIF (mod = "Dates") & (typ = "Time") THEN
				item.GetVal(dt, ok); ASSERT(ok, 101);
				IF ~native THEN AddChar("'", s) END;
				Strings.IntToString(dt.value.hour, h); AddStr(h, native, 8, s); AddChar(":", s);
				Strings.IntToString(dt.value.minute, h); AddStr(h, native, 8, s); AddChar(":", s);
				Strings.IntToString(dt.value.second, h); AddStr(h, native, 8, s);
				IF ~native THEN AddChar("'", s) END
			ELSIF (mod = "SqlDB") & (typ = "Blob") THEN
				item.GetVal(bv, ok); ASSERT(ok, 101);
				AddStr(d.driver.blobStr, FALSE, LEN(d.driver.blobStr), s);
				NEW(blob); blob.len := bv.value.len; blob.data := bv.value.data;
				IF s.last = NIL THEN s.blobs := blob ELSE s.last.next := blob END;
				s.last := blob
			ELSE
				sc.ConnectTo(item);
				sc.Scan; ASSERT(~sc.eos, 22);
				AddItem(d, sc.this, native, s); sc.Scan;
				WHILE ~sc.eos DO
					AddChar(",", s); AddChar(" ", s);
					AddItem(d, sc.this, native, s); sc.Scan
				END
			END
		| Meta.ptrTyp:
			item.Deref(base); AddItem(d, base, native, s)
		ELSE HALT(21)
		END
	END AddItem;

	PROCEDURE Compile (d: StdDatabase; IN s: ARRAY OF CHAR; OUT t: Statement);
		VAR i: INTEGER; ch: CHAR; path: ARRAY varLen OF CHAR; quoted, native: BOOLEAN; item: Meta.Item; 
	BEGIN	(* expand designators in an SQL statement by their current values, yielding a correct SQL statement *)
		i := 0; ch := s[0]; t.idx := 0; t.ext := NIL; quoted := FALSE;
		WHILE ch # 0X DO
			IF (ch = ":") & ~quoted & (s[i+1] # "\") THEN
				(* ":\" does not trigger Meta substitution, in order to allow for Windows path names such as in
					"SELECT * FROM C:\directory\databaseName.tableName"
				*)
				INC(i); ch := s[i];
				IF ch = "!" THEN native := TRUE; INC(i); ch := s[i] ELSE native := FALSE END;
				ReadPath(s, path, i, ch); ASSERT(path # "", 20);
				Meta.LookupPath(path, item); ASSERT(item.Valid(), 21); ASSERT(item.obj = Meta.varObj, 22);
				AddItem(d, item, native, t)
			ELSE
				IF ch = "'" THEN quoted := ~quoted END;
				AddChar(ch, t);
				INC(i); ch := s[i]
			END
		END
	END Compile;

	PROCEDURE Execute (d: StdDatabase; VAR s: Statement);
	BEGIN
		IF s.ext # NIL THEN
			s.ext[s.idx] := 0X; d.driver.BeginExec(s.ext^, s.blobs, d.async, d.showErrors, d.res)
		ELSE
			s.buf[s.idx] := 0X; d.driver.BeginExec(s.buf, s.blobs, d.async, d.showErrors, d.res)
		END
	END Execute;


	(* item manipulation *)

	PROCEDURE LookupItem (OUT i: Meta.Item; VAR r: ANYREC; async: BOOLEAN);
		VAR type: Kernel.Type; mod: Kernel.Module; attr: Kernel.ItemAttr;
	BEGIN	(* create a meta item for a global variable passed as VAR parameter *)
		attr.obj := Meta.varObj;
		attr.typ := Meta.recTyp;
		attr.vis := Meta.exported;
		attr.adr := SYSTEM.ADR(r);
		attr.mod := NIL;
		attr.desc := SYSTEM.VAL(Kernel.Type, SYSTEM.TYP(r));
		attr.ptr := NIL;
		attr.ext := NIL;
		IF async THEN	(* check for global variable *)
			mod := Kernel.modList;
			WHILE (mod # NIL) & ((attr.adr < mod.data) OR (attr.adr >= mod.data + mod.dsize)) DO mod := mod.next END;
			ASSERT(mod # NIL, 24);	(* trap if variable was not found in any module *)
			attr.mod := mod
		ELSE
			attr.mod := NIL
		END;
		Meta.GetThisItem(attr, i)
	END LookupItem;

	PROCEDURE ReadItem (item: Meta.Item; t: StdTable; row: INTEGER; VAR col: INTEGER);
		VAR i, len: INTEGER; long: LONGINT; base: Meta.Item; s: Meta.Scanner; mod, typ: Meta.Name; ok: BOOLEAN;
			r: REAL; date: DateValue; time: TimeValue; cy: CurrencyValue; str: StringValue;
			blob: BlobValue; rw: RowValue; tab: SqlDrivers.Table;
	BEGIN	(* read a value from a result table, and copy it to a global variable represented by a meta item *)
		tab := t.table; tab.res := 0;
		CASE item.typ OF
		| Meta.boolTyp:
			tab.ReadInteger(row, col, i);
			IF i = 0 THEN item.PutBoolVal(FALSE) ELSE item.PutBoolVal(TRUE) END;
			INC(col)
		| Meta.byteTyp, Meta.sIntTyp, Meta.intTyp:
			tab.ReadInteger(row, col, i);
			IF (item.typ = Meta.byteTyp) & ((i < MIN(BYTE)) OR (i > MAX(BYTE)))
				OR (item.typ = Meta.sIntTyp) & ((i < MIN(SHORTINT)) OR (i > MAX(SHORTINT))) THEN
				i := 0; tab.res := overflow
			END;
			item.PutIntVal(i); INC(col)
		| Meta.longTyp:
			tab.ReadLong(row, col, long);
			item.PutLongVal(long); INC(col)
		| Meta.sRealTyp, Meta.realTyp:
			tab.ReadReal(row, col, r);
			IF (item.typ = Meta.sRealTyp) & ((r < MIN(SHORTREAL)) OR (r > MAX(SHORTREAL))) THEN
				r := 0; tab.res := overflow
			END;
			item.PutRealVal(r); INC(col)
		| Meta.arrTyp:
			IF item.BaseTyp() = Meta.charTyp THEN
				tab.ReadString(row, col, SYSTEM.THISARRAY(item.adr, item.Len()));
				INC(col)
			ELSE
				i := 0; len := item.Len();
				WHILE i # len DO
					item.Index(i, base); ReadItem(base, t, row, col);
					INC(i)
				END
			END
		| Meta.recTyp:
			item.GetTypeName(mod, typ);
			IF (mod = "Dialog") & (typ = "Currency") THEN
				tab.ReadCurrency(row, col, cy.value);
				item.PutVal(cy, ok); ASSERT(ok, 100);
				INC(col)
			ELSIF (mod = "Dialog") & (typ = "List") THEN
				item.Lookup("index", base);
				ReadItem(base, t, row, col)
			ELSIF (mod = "Dialog") & (typ = "Combo") THEN
				item.Lookup("item", base);
				ReadItem(base, t, row, col)
			ELSIF (mod = "Dates") & (typ = "Date") THEN
				tab.ReadDate(row, col, date.value);
				item.PutVal(date, ok); ASSERT(ok, 100);
				INC(col)
			ELSIF (mod = "Dates") & (typ = "Time") THEN
				tab.ReadTime(row, col, time.value);
				item.PutVal(time, ok); ASSERT(ok, 100);
				INC(col)
			ELSIF (mod = "SqlDB") & (typ = "Blob") THEN
				tab.ReadBlob(row, col, blob.value.len, blob.value.data);
				item.PutVal(blob, ok); ASSERT(ok, 100);
				INC(col)
			ELSE
				IF (mod = "SqlDB") & (typ = "Row") THEN
					item.GetVal(rw, ok); ASSERT(ok, 100);
					IF (rw.value.fields = NIL) OR (LEN(rw.value.fields^) # t.columns - col) THEN
						NEW(rw.value.fields, t.columns - col);
						item.PutVal(rw, ok); ASSERT(ok, 100)
					END
				END;
				s.ConnectTo(item);
				s.Scan; WHILE ~s.eos DO ReadItem(s.this, t, row, col); s.Scan END
			END
		| Meta.ptrTyp:
			item.GetBaseType(base);
			IF (base.typ = Meta.arrTyp) & (base.BaseTyp() = Meta.charTyp) THEN
				item.GetVal(str, ok); ASSERT(ok, 100);
				IF row = types THEN tab.ReadType(col, str.value)
				ELSIF row = names THEN tab.ReadName(col, str.value)
				ELSE tab.ReadVarString(row, col, str.value)
				END;
				item.PutVal(str, ok); ASSERT(ok, 101);
				INC(col)
			ELSE
				item.Deref(base);
				ASSERT(base.obj = Meta.varObj, 23);
				ReadItem(base, t, row, col)
			END
		| Meta.procTyp:	(* skip *)
		ELSE HALT(22)
		END;
		IF tab.res > t.res THEN t.res := tab.res END
	END ReadItem;

	PROCEDURE ClearItem (item: Meta.Item);
		VAR s: Meta.Scanner; ok: BOOLEAN; base: Meta.Item; len, i: INTEGER;
	BEGIN	(* zero a global variable represented by a meta item *)
		ASSERT(item.Valid(), 20);
		IF item.vis = Meta.exported THEN
			CASE item.typ OF
			| Meta.byteTyp, Meta.sIntTyp, Meta.intTyp:
				item.PutIntVal(0)
			| Meta.longTyp:
				item.PutLongVal(0)
			| Meta.sRealTyp, Meta.realTyp:
				item.PutRealVal(0)
			| Meta.boolTyp:
				item.PutBoolVal(FALSE)
			| Meta.arrTyp:
				IF item.BaseTyp() = Meta.charTyp THEN
					item.PutStringVal("", ok); ASSERT(ok, 22)
				ELSE
					i := 0; len := item.Len();
					WHILE i # len DO
						item.Index(i, base); ClearItem(base);
						INC(i)
					END
				END
			| Meta.recTyp:
				s.ConnectTo(item);
				s.Scan; WHILE ~s.eos DO ClearItem(s.this); s.Scan END
			| Meta.ptrTyp:
				item.Deref(base);
				IF base.obj = Meta.varObj THEN ClearItem(base) END
			END
		END
	END ClearItem;


	(* notification *)

	PROCEDURE NotifyLater (d: StdDatabase; adr0, adr1: INTEGER);
		VAR r: Range;
	BEGIN	(* register an address range for later notification via an action *)
		r := d.range; 
		IF r = NIL THEN
			Services.DoLater(d.action, Services.now)
		ELSE
			IF (d.lastRange # NIL) & (d.lastRange.adr1 < adr0) THEN 
				r := NIL
			ELSE
				WHILE (r # NIL) & ((r.adr1 < adr0) OR (r.adr0 > adr1)) DO r := r.next END
			END
		END;
		IF r # NIL THEN
			r.adr0 := MIN(r.adr0, adr0); r.adr1 := MAX(r.adr1, adr1)
		ELSE
			NEW(r); r.adr0 := adr0; r.adr1 := adr1;
			r.next := d.range; d.range := r;
			d.lastRange := r
		END
	END NotifyLater;

	PROCEDURE Update (d: StdDatabase);
		VAR r: Range;
	BEGIN	(* notify an address range immediately *)
		r := d.range;
		WHILE r # NIL DO
			Dialog.Notify(r.adr0, r.adr1, {update});
			r := r.next
		END;
		IF d.range # NIL THEN Dialog.Notify(0, 0, {guardCheck}) END;	(* check only once, after all updates *)
		d.range := NIL
	END Update;


	(* delayed operations *)

	PROCEDURE DoRead (t: StdTable; row: INTEGER; VAR item: Meta.Item);
		VAR col: INTEGER;
	BEGIN
		WriteString("DoRead");
		ASSERT(t.columns > 0, 20);
		IF row < t.rows THEN
			col := 0; t.res := 0;
			ReadItem(item, t, row, col);
		ELSE
			ClearItem(item);
			t.res := noData
		END;
		IF t.strictNotify THEN
			Dialog.Notify(item.adr, item.adr + item.Size(), {update, guardCheck});
		ELSE
			NotifyLater(t.db, item.adr, item.adr + item.Size())
		END
	END DoRead;

	PROCEDURE DoClear (t: StdTable);
	BEGIN
		WriteString("DoClear");
		IF (t.table # NIL) & (t.db.driver # NIL) THEN
			t.table.Close; t.table := NIL
		END;
		t.res := 0; t.rows := 0; t.columns := 0; t.srows := 0
	END DoClear;

	PROCEDURE DoEndOpen (d: StdDatabase);
		VAR res: INTEGER;
	BEGIN
		WriteString("DoEndOpen");
		ASSERT(d.driver.Ready(), 100);
		d.driver.EndOpen(res);
		d.res := res
	END DoEndOpen;

	PROCEDURE DoBeginExec (d: StdDatabase; t: StdTable; VAR statement: ARRAY OF CHAR);
		VAR res: INTEGER; s: Statement;
	BEGIN
		WriteString("DoBeginExec");
		Compile(d, statement, s);
		IF debug THEN		
			IF s.ext # NIL THEN
				s.ext[s.idx] := 0X; WriteString(s.ext^)
			ELSE
				s.buf[s.idx] := 0X; WriteString(s.buf)
			END
		END;
		IF t # NIL THEN DoClear(t) END;
		Execute(d, s);
		IF t # NIL THEN t.res := d.res END
	END DoBeginExec;

	PROCEDURE DoEndExec (d: StdDatabase; t: StdTable);
		VAR dt: SqlDrivers.Table; rows, columns: INTEGER;
	BEGIN
		IF d.res = 0 THEN
			WriteString("DoEndExec");
			ASSERT(d.driver.Ready(), 100);
			d.driver.EndExec(dt, rows, columns, d.res);
			IF t # NIL THEN
				t.rows := rows; t.srows := rows; t.columns := columns;
				t.table := dt; t.res := d.res;
				IF t.strictNotify THEN
					Dialog.Notify(SYSTEM.ADR(t^), SYSTEM.ADR(t^) + 4, {update, guardCheck})
				ELSE
					NotifyLater(t.db, SYSTEM.ADR(t^), SYSTEM.ADR(t^) + 4)
				END
			ELSE
				ASSERT(columns = 0, 21);
			END
		END
	END DoEndExec;

	PROCEDURE DoCommit (d: StdDatabase; accept: BOOLEAN);
	BEGIN
		WriteString("DoCommit");
		d.driver.Commit(accept, d.res)
	END DoCommit;


	(* serialization *)

	PROCEDURE Reset (d: StdDatabase);
		VAR e: Elem;
	BEGIN	(* trap cleanup *)
		e := d.queue; d.queue := NIL; d.range := NIL; d.tail := NIL;
		WHILE e # NIL DO
			IF e.table # NIL THEN e.table.Clear END;
			IF e.item.Valid() THEN ClearItem(e.item) END;
			e := e.next
		END
	END Reset;

	PROCEDURE Process (d: StdDatabase);
		VAR e: Elem; operations: INTEGER;
	BEGIN	(* this is the heart of the processing of asynchronous operations *)
		WriteString("start processing");
		operations := 0;
		WHILE (d.queue # NIL) & (operations < maxOperations) & d.driver.Ready() DO
			e := d.queue; d.queue := e.next; d.tail := d.queue; INC(operations);
			CASE e.op OF
			| openOp: DoEndOpen(d)
			| beginOp: DoBeginExec(d, e.table, e.statement^)
			| endOp: DoEndExec(d, e.table)
			| commitOp: DoCommit(d, TRUE)
			| rollbackOp: DoCommit(d, FALSE)
			| clearOp: DoClear(e.table)
			| callOp: INC(d.id); e.cmd(e.par)
			| tcallOp: INC(d.id); e.table.id := d.id; e.tcmd(e.table, e.par)
			ELSE DoRead(e.table, e.op, e.item)
			END;
			d.tail := NIL
		END;
		WriteString("stop processing")
	END Process;

	PROCEDURE (a: Action) Do;
		VAR d: StdDatabase;
	BEGIN	(* async operations are advanced by an action, which belongs to the database object *)
		d := a.database;
		IF d.executing THEN	(* trapped *)
			Reset(d)
		ELSIF (d.queue # NIL) OR (d.range # NIL) THEN
			Services.DoLater(a, Services.now);
			d.executing := TRUE;
			Process(d);
			Update(d)
		END;
		d.executing := FALSE
	END Do;

	PROCEDURE Put (d: StdDatabase; op: INTEGER; t: StdTable; s: ARRAY OF CHAR;
								VAR i: Meta.Item; cmd: Command; tcmd: TableCommand; par: ANYPTR);
		VAR e, h, k: Elem;
	BEGIN	(* put a SQL statement into a queue for later async processing *)
		NEW(e); e.op := op; e.table := t; e.item := i; e.cmd := cmd; e.tcmd := tcmd; e.par := par;
		IF s # "" THEN NEW(e.statement, LEN(s)); e.statement^ := s$ END;
		h := d.queue;
		IF h = NIL THEN Services.DoLater(d.action, Services.now) END;	(* start process *)
		IF h = d.tail THEN
			e.next := h; d.queue := e
		ELSIF op >= clearOp THEN	(* clear, read: insert after last op on same table *)
			k := NIL;
			WHILE h # d.tail DO
				IF h.table = t THEN k := h END;
				h := h.next
			END;
			IF k = NIL THEN e.next := d.queue; d.queue := e
			ELSE e.next := k.next; k.next := e
			END
		ELSE
			WHILE h.next # d.tail DO h := h.next END;
			e.next := h.next; h.next := e
		END
	END Put;

	PROCEDURE Synch (d: StdDatabase; op: INTEGER; t: StdTable): BOOLEAN;
		(* check whether it is necessary to enqueue this operation *)
		(* TRUE if Put would insert at beginning of queue *)
		VAR h: Elem;
	BEGIN
		h := d.queue;
		IF h = d.tail THEN
			RETURN TRUE
		ELSIF op >= clearOp THEN
			WHILE (h # d.tail) & (h.table # t) DO h := h.next END;
			RETURN h = d.tail
		ELSE
			RETURN FALSE
		END
	END Synch;
	

	(* StdTable *)

	PROCEDURE (t: StdTable) Exec (statement: ARRAY OF CHAR);
	BEGIN
		WriteString("Table Exec");
		ASSERT(t.db.driver # NIL, 100); ASSERT(statement # "", 20);
		ASSERT(~t.db.executing OR (t.id >= t.db.id), 21);
		IF Synch(t.db, beginOp, t) THEN DoBeginExec(t.db, t, statement)
		ELSE Put(t.db, beginOp, t, statement, dummy, NIL, NIL, NIL)
		END;
		IF Synch(t.db, endOp, t) & t.db.driver.Ready() THEN DoEndExec(t.db, t)
		ELSE Put(t.db, endOp, t, "", dummy, NIL, NIL, NIL)
		END
	END Exec;

	PROCEDURE (t: StdTable) Available (): BOOLEAN;
	BEGIN
		RETURN Synch(t.db, readOp, t)
	END Available;

	PROCEDURE (t: StdTable) Read (row: INTEGER; VAR data: ANYREC);
		VAR item: Meta.Item;
	BEGIN
		WriteString("Read");
		ASSERT((row >= 0) OR (data IS Row) & (row >= -2), 21);
		ASSERT(~t.db.executing OR (t.id >= t.db.id), 25);
		IF Synch(t.db, readOp, t) THEN
			LookupItem(item, data, FALSE);
			DoRead(t, row, item)
		ELSE
			LookupItem(item, data, TRUE);
			Put(t.db, row, t, "", item, NIL, NIL, NIL)
		END
	END Read;

	PROCEDURE (t: StdTable) Clear;
	BEGIN
		WriteString("Clear");
		ASSERT(~t.db.executing OR (t.id >= t.db.id), 20);
		IF Synch(t.db, clearOp, t) THEN DoClear(t)
		ELSE Put(t.db, clearOp, t, "", dummy, NIL, NIL, NIL)
		END
	END Clear;

	PROCEDURE (t: StdTable) Call (command: TableCommand; par: ANYPTR);
	BEGIN
		WriteString("Table Call");
		ASSERT(command # NIL, 20);
		ASSERT(~t.db.executing OR (t.id >= t.db.id), 21);
		IF Synch(t.db, tcallOp, t) THEN command(t, par)
		ELSE Put(t.db, tcallOp, t, "", dummy, NIL, command, par)
		END
	END Call;


	(* StdDatabase *)

	PROCEDURE (d: StdDatabase) Exec (statement: ARRAY OF CHAR);
	BEGIN
		WriteString("Exec");
		ASSERT(d.driver # NIL, 100); ASSERT(statement # "", 20);
		IF Synch(d, beginOp, NIL) THEN DoBeginExec(d, NIL, statement)
		ELSE Put(d, beginOp, NIL, statement, dummy, NIL, NIL, NIL)
		END;
		IF Synch(d, endOp, NIL) & d.driver.Ready() THEN DoEndExec(d, NIL)
		ELSE Put(d, endOp, NIL, "", dummy, NIL, NIL, NIL)
		END
	END Exec;

	PROCEDURE (d: StdDatabase) Commit;
	BEGIN
		WriteString("Commit");
		IF Synch(d, commitOp, NIL) THEN DoCommit(d, TRUE)
		ELSE Put(d, commitOp, NIL, "", dummy, NIL, NIL, NIL)
		END
	END Commit;

	PROCEDURE (d: StdDatabase) Rollback;
	BEGIN
		WriteString("Rollback");
		IF Synch(d, rollbackOp, NIL) THEN DoCommit(d, FALSE)
		ELSE Put(d, rollbackOp, NIL, "", dummy, NIL, NIL, NIL)
		END
	END Rollback;

	PROCEDURE (d: StdDatabase) Call (command: Command; par: ANYPTR);
	BEGIN
		WriteString("Call");
		ASSERT(command # NIL, 20);
		IF Synch(d, callOp, NIL) THEN command(par)
		ELSE Put(d, callOp, NIL, "", dummy, command, NIL, par)
		END
	END Call;

	PROCEDURE (d: StdDatabase) NewTable (): Table;
		VAR t: StdTable;
	BEGIN
		ASSERT(d.driver # NIL, 100);
		NEW(t);
		t.res := 0; t.rows := 0; t.columns := 0; t.strictNotify := FALSE;
		t.table := NIL; t.srows := 0; t.id := d.id;
		t.InitBase(d); t.db := d;
		d.res := 0;
		RETURN t
	END NewTable;


	PROCEDURE OpenDatabase* (protocol, id, password, datasource: ARRAY OF CHAR;
													async, showErrors: BOOLEAN; OUT d: Database; OUT res: INTEGER);
		VAR driver: SqlDrivers.Driver; sd: StdDatabase;
	BEGIN
		WriteString("OpenDatabase");
		ASSERT(protocol # "", 20);
		SqlDrivers.Open(protocol, id, password, datasource, async, showErrors, driver, res);
		IF res = 0 THEN
			ASSERT(driver # NIL, 100);
			NEW(sd); sd.driver := driver; sd.queue := NIL; sd.tail := NIL;
			sd.async := async; sd.showErrors := showErrors;
			NEW(sd.action); sd.action.database := sd;
			IF driver.Ready() THEN DoEndOpen(sd)
			ELSE Put(sd, openOp, NIL, "", dummy, NIL, NIL, NIL)
			END;
			sd.res := 0; d := sd
		ELSE
			d := NIL
		END
	END OpenDatabase;

BEGIN
	NEW(ptr);
	nullStr := "null"
END SqlDB.
