Dev/Mod/Debug.odc

MODULE DevDebug; (* SP410 *)
(**
	project	= "BlackBox"
	organization	= "www.oberon.ch"
	contributors	= "Oberon microsystems"
	version	= "System/Rsrc/About"
	copyright	= "System/Rsrc/About"
	license	= "Docu/BB-License"
	changes	= "
	- 20111211, Fyodor Tkachov, L.import; switched from National to i21sysCharacters
	- 20100331, Fyodor Tkachov, Trap window content is now formed using remappings via Dev/Rsrc/Strings.odc, whereas hyperlinks in the Trap window correctly show the instruction that caused the trap even if keyword conversions were used  
	- 20080215, Fyodor Tkachov, reviewed
	- 20050626, Fyodor Tkachov, russification edited
	- 20050430, Ivan Goryachev, russification
	- YYYYMMDD, nn, ...
	"
	issues	= "
	- ...
	"

**)

	IMPORT SYSTEM,
		Kernel, Strings, Dates, Files, Fonts, Services, Ports, Stores, Converters,
		Models, Views, Controllers, Properties, Dialog, Containers, Controls,
		HostFonts, Windows, HostFiles, StdDialog, StdFolds, StdLinks,
		TextModels, TextMappers, TextControllers, TextViews, TextRulers, StdLog,
		DevCommanders, i21sysCharacters, i21sysVocabulary;
	
	CONST
		mm = Ports.mm; pt = Ports.point;
		mProc = 4;
		refViewSize = 9 * Ports.point;
		
		heap = 1; source = 2; module = 3; modules = 4;	(* RefView types *)
		open = 1; undo = 2; update = 3;	(* RefView commands *)
		
		(* additional scanner types *)
		import = 100; smodule = 101; semicolon = 102; becomes  = 103; stop = 104; comEnd = 105;

	TYPE
		Name = Kernel.Name;
		ArrayPtr = POINTER TO EXTENSIBLE RECORD
			last, t, first: INTEGER;	(* gc header *)
			len: ARRAY 16 OF INTEGER	(* dynamic array length table *)
		END;
		RefView = POINTER TO RECORD (Views.View)
			type: SHORTINT;
			command: SHORTINT;
			back: RefView;
			adr: INTEGER;
			desc: Kernel.Type;
			ptr: ArrayPtr;
			name: Name
		END;
		
		Action = POINTER TO RECORD (Services.Action)
			text: TextModels.Model
		END;
		
		Cluster = POINTER TO RECORD [untagged]	(* must correspond to Kernel.Cluster *)
			size: INTEGER;
			next: Cluster
		END;
		
	
	VAR
		out: TextMappers.Formatter;
		loadErrors: ARRAY 10, 64 OF SHORTCHAR;
		path: ARRAY 4 OF Ports.Point;
		empty: Name;


	PROCEDURE NewRuler (): TextRulers.Ruler;
		CONST mm = Ports.mm; pt = Ports.point;
		VAR r: TextRulers.Ruler;
	BEGIN
		r := TextRulers.dir.New(NIL);
		TextRulers.SetRight(r, 140 * mm);
		TextRulers.AddTab(r, 4 * mm); TextRulers.AddTab(r, 34 * mm); TextRulers.AddTab(r, 80 * mm);
		RETURN r
	END NewRuler;

	PROCEDURE NewModRuler (): TextRulers.Ruler;
		CONST mm = Ports.mm; pt = Ports.point;
		VAR r: TextRulers.Ruler;
	BEGIN
		r := TextRulers.dir.New(NIL);
		IF Dialog.platform DIV 10 = 2 THEN	(* mac *)
			TextRulers.SetRight(r, 154 * mm);
			TextRulers.AddTab(r, 48 * mm); TextRulers.MakeRightTab(r);
			TextRulers.AddTab(r, 64 * mm); TextRulers.MakeRightTab(r);
			TextRulers.AddTab(r, 76 * mm); TextRulers.AddTab(r, 115 * mm)
		ELSE
			TextRulers.SetRight(r, 144 * mm);
			TextRulers.AddTab(r, 48 * mm); TextRulers.MakeRightTab(r);
			TextRulers.AddTab(r, 64 * mm); TextRulers.MakeRightTab(r);
			TextRulers.AddTab(r, 76 * mm); TextRulers.AddTab(r, 110 * mm)
		END;
		RETURN r
	END NewModRuler;

	PROCEDURE OpenViewer (t: TextModels.Model; title: Views.Title; ruler:TextRulers.Ruler);
		VAR v: TextViews.View; c: Containers.Controller;
	BEGIN
		Dialog.MapString(title, title);
		v := TextViews.dir.New(t);
		v.SetDefaults(ruler, TextViews.dir.defAttr);
		c := v.ThisController();
		IF c # NIL THEN
			c.SetOpts(c.opts - {Containers.noFocus, Containers.noSelection} + {Containers.noCaret})
		END;
		Views.OpenAux(v, title)
	END OpenViewer;
	
	PROCEDURE OpenFold (hidden: ARRAY OF CHAR);
		VAR fold: StdFolds.Fold; t: TextModels.Model; w: TextMappers.Formatter;
	BEGIN
		Dialog.MapString(hidden, hidden);
		t := TextModels.CloneOf(StdLog.buf);
		w.ConnectTo(t); w.WriteString(hidden);
		fold := StdFolds.dir.New(StdFolds.expanded, "", t);
		out.WriteView(fold)
	END OpenFold;
	
	PROCEDURE CloseFold (collaps: BOOLEAN);
		VAR fold: StdFolds.Fold; m: TextModels.Model;
	BEGIN
		fold := StdFolds.dir.New(StdFolds.expanded, "", NIL);
		out.WriteView(fold);
		IF collaps THEN fold.Flip(); m := out.rider.Base(); out.SetPos(m.Length()) END
	END CloseFold;
	
	PROCEDURE WriteHex (n: INTEGER);
	BEGIN
		out.WriteIntForm(n, TextMappers.hexadecimal, 9, "0", TextMappers.showBase)
	END WriteHex;
	
	PROCEDURE WriteString (adr, len, base: INTEGER; zterm: BOOLEAN);
		CONST beg = 0; char = 1; code = 2;
		VAR ch: SHORTCHAR; val, mode: SHORTINT; str: ARRAY 16 OF CHAR;
	BEGIN
		mode := beg;
		IF base = 2 THEN SYSTEM.GET(adr, val) ELSE SYSTEM.GET(adr, ch); val := ORD(ch) END;
		IF zterm & (val = 0) THEN out.WriteSString('""')
		ELSE
			REPEAT
				IF (val >= ORD(" ")) & (val < 7FH) OR (val > 0A0H) & (val < 256) THEN
					IF mode # char THEN
						IF mode = code THEN out.WriteSString(", ") END;
						out.WriteChar(22X); mode := char
					END;
					out.WriteChar(SHORT(CHR(val)))
				ELSE
					IF mode = char THEN out.WriteChar(22X) END;
					IF mode # beg THEN out.WriteSString(", ") END;
					mode := code; Strings.IntToStringForm(val, Strings.hexadecimal, 1, "0", FALSE, str);
					IF str[0] > "9" THEN out.WriteChar("0") END;
					out.WriteString(str); out.WriteChar("X")
				END;
				INC(adr, base); DEC(len);
				IF base = 2 THEN SYSTEM.GET(adr, val) ELSE SYSTEM.GET(adr, ch); val := ORD(ch) END
			UNTIL (len = 0) OR zterm & (val = 0)
		END;
		IF mode = char THEN out.WriteChar(22X) END
	END WriteString;
	
	PROCEDURE IsIdent (s: ARRAY OF CHAR): BOOLEAN;
		VAR i: SHORTINT; ch: CHAR;
	BEGIN
		ch := s[0];
		IF i21sysCharacters.IsFirstIdentChar(ch) THEN
			i := 1; ch := s[1];
			WHILE i21sysCharacters.IsIdentChar(ch) DO (* все вызовы под охраной: строка оканчивается на 0X *)
				INC(i); ch := s[i]
			END;
			RETURN (s[i] = 0X) & (i < 256)
		ELSE RETURN FALSE
		END
	END IsIdent;
	
	PROCEDURE OutString (s: ARRAY OF CHAR);
		VAR str: Dialog.String;
	BEGIN
		Dialog.MapString(s, str);
		out.WriteString(str);
	END OutString;

	(* -------------------  variable display ------------------- *)
	
	PROCEDURE FormOf (t: Kernel.Type): SHORTCHAR;
	BEGIN
		IF SYSTEM.VAL(INTEGER, t) DIV 256 = 0 THEN
			RETURN SHORT(CHR(SYSTEM.VAL(INTEGER, t)))
		ELSE
			RETURN SHORT(CHR(16 + t.id MOD 4))
		END
	END FormOf;
	
	PROCEDURE LenOf (t: Kernel.Type; ptr: ArrayPtr): INTEGER;
	BEGIN
		IF t.size # 0 THEN RETURN t.size
		ELSIF ptr # NIL THEN RETURN ptr.len[t.id DIV 16 MOD 16 - 1]
		ELSE RETURN 0
		END
	END LenOf;
	
	PROCEDURE SizeOf (t: Kernel.Type; ptr: ArrayPtr): INTEGER;
	BEGIN
		CASE FormOf(t) OF
		| 0BX: RETURN 0
		| 1X, 2X, 4X: RETURN 1
		| 3X, 5X: RETURN 2
		| 8X, 0AX: RETURN 8
		| 11X: RETURN t.size
		| 12X: RETURN LenOf(t, ptr) * SizeOf(t.base[0], ptr)
		ELSE RETURN 4
		END
	END SizeOf;

	PROCEDURE WriteName (t: Kernel.Type; ptr: ArrayPtr);
		VAR name: Kernel.Name; f: SHORTCHAR;
	BEGIN
		f := FormOf(t);
		CASE f OF
		| 0X: OutString("#Dev:Unknown")
		| 1X: out.WriteSString("BOOLEAN")
		| 2X: out.WriteSString("SHORTCHAR")
		| 3X: out.WriteSString("CHAR")
		| 4X: out.WriteSString("BYTE")
		| 5X: out.WriteSString("SHORTINT")
		| 6X: out.WriteSString("INTEGER")
		| 7X: out.WriteSString("SHORTREAL")
		| 8X: out.WriteSString("REAL")
		| 9X: out.WriteSString("SET")
		| 0AX: out.WriteSString("LONGINT")
		| 0BX: out.WriteSString("ANYREC")
		| 0CX: out.WriteSString("ANYPTR")
		| 0DX: out.WriteSString("POINTER")
		| 0EX: out.WriteSString("PROCEDURE")
		| 0FX: out.WriteSString("STRING")
		| 10X..13X:
			IF (t.mod # NIL) & (t.id DIV 256 # 0) & (t.mod.refcnt >= 0) THEN
				Kernel.GetTypeName(t, name);
				IF name = "!" THEN
					IF f = 11X THEN out.WriteSString("RECORD")
					ELSIF f = 12X THEN out.WriteSString("ARRAY")
					ELSE OutString("#Dev:Unknown")
					END
				ELSE
					out.WriteSString(t.mod.name); out.WriteChar("."); out.WriteSString(name)
				END
			ELSIF f = 11X THEN
				IF t.mod # NIL THEN out.WriteSString(t.mod.name); out.WriteChar(".") END;
				out.WriteSString("RECORD"); 
			ELSIF f = 12X THEN
				out.WriteSString("ARRAY "); out.WriteInt(LenOf(t, ptr)); t := t.base[0];
				WHILE (FormOf(t) = 12X) & ((t.id DIV 256 = 0) OR (t.mod = NIL) OR (t.mod.refcnt < 0)) DO
					out.WriteSString(", "); out.WriteInt(LenOf(t, ptr)); t := t.base[0]
				END;
				out.WriteSString(" OF "); WriteName(t, ptr)
			ELSIF f = 13X THEN
				out.WriteSString("POINTER")
			ELSE
				out.WriteSString("PROCEDURE")
			END
		| 20X: out.WriteSString("COM.IUnknown")
		| 21X: out.WriteSString("COM.GUID")
		| 22X: out.WriteSString("COM.RESULT")
		ELSE OutString("#Dev:UnknownFormat"); out.WriteInt(ORD(f))
		END
	END WriteName;
	
	PROCEDURE WriteGuid (a: INTEGER);
	
		PROCEDURE Hex (a: INTEGER);
			VAR x: SHORTCHAR;
		BEGIN
			SYSTEM.GET(a, x);
			out.WriteIntForm(ORD(x), TextMappers.hexadecimal, 2, "0", FALSE)
		END Hex;
		
	BEGIN
		out.WriteChar("{");
		Hex(a + 3); Hex(a + 2); Hex(a + 1); Hex(a);
		out.WriteChar("-");
		Hex(a + 5); Hex(a + 4);
		out.WriteChar("-");
		Hex(a + 7); Hex(a + 6);
		out.WriteChar("-");
		Hex(a + 8);
		Hex(a + 9);
		out.WriteChar("-");
		Hex(a + 10);
		Hex(a + 11);
		Hex(a + 12);
		Hex(a + 13);
		Hex(a + 14);
		Hex(a + 15);
		out.WriteChar("}")
	END WriteGuid;
	
	PROCEDURE^ ShowVar (
		ad, ind: INTEGER; f, c: SHORTCHAR; desc: Kernel.Type; ptr: ArrayPtr; back: RefView; VAR name, sel: Name);
	
	PROCEDURE^ NewRefView (type, command: SHORTINT; adr: INTEGER; back: RefView;
												desc: Kernel.Type; ptr: ArrayPtr; name: Name): RefView;

	PROCEDURE^ InsertRefView (type, command: SHORTINT; adr: INTEGER; back: RefView;
												desc: Kernel.Type; ptr: ArrayPtr; name: Name);

	PROCEDURE ShowRecord (a, ind: INTEGER; desc: Kernel.Type; back: RefView; VAR sel: Name);
		VAR dir: Kernel.Directory; obj: Kernel.Object; name: Kernel.Name; i, j, n: INTEGER; base: Kernel.Type;
	BEGIN
		WriteName(desc, NIL); out.WriteTab;
		IF desc.mod.refcnt >= 0 THEN
			OpenFold("#Dev:Fields");
			n := desc.id DIV 16 MOD 16; j := 0;
			WHILE j <= n DO
				base := desc.base[j];
				IF base # NIL THEN
					dir := base.fields; i := 0;
					WHILE i < dir.num DO
						obj := SYSTEM.VAL(Kernel.Object, SYSTEM.ADR(dir.obj[i]));
						Kernel.GetObjName(base.mod, obj, name);
						ShowVar(a + obj.offs, ind, FormOf(obj.struct), 1X, obj.struct, NIL, back, name, sel);
						INC(i)
					END
				END;
				INC(j)
			END;
			out.WriteSString("   "); CloseFold((ind > 1) OR (sel # ""))
		ELSE
			OutString("#Dev:Unloaded")
		END
	END ShowRecord;
	
	PROCEDURE ShowArray (a, ind: INTEGER; desc: Kernel.Type; ptr: ArrayPtr; back: RefView; VAR sel: Name);
		VAR f: SHORTCHAR; i, n, m, size, len: INTEGER; name: Kernel.Name; eltyp, t: Kernel.Type;
			vi: SHORTINT; vs: BYTE; str: Dialog.String;
			
	BEGIN
		WriteName(desc, ptr); out.WriteTab;
		len := LenOf(desc, ptr); eltyp := desc.base[0]; f := FormOf(eltyp); size := SizeOf(eltyp, ptr);
		IF (f = 2X) OR (f = 3X) THEN	(* string *)
			n := 0; m := len;
			IF f = 2X THEN
				REPEAT SYSTEM.GET(a + n, vs); INC(n) UNTIL (n = 32) OR (n = len) OR (vs = 0);
				REPEAT DEC(m); SYSTEM.GET(a + m, vs) UNTIL (m = 0) OR (vs # 0)
			ELSE
				REPEAT SYSTEM.GET(a + n * 2, vi); INC(n) UNTIL (n = 32) OR (n = len) OR (vi = 0);
				REPEAT DEC(m); SYSTEM.GET(a + m * 2, vi) UNTIL (m = 0) OR (vi # 0)
			END;
			WriteString(a, n, size, TRUE);
			INC(m, 2);
			IF m > len THEN m := len END;
			IF m > n THEN
				out.WriteSString("   "); OpenFold("...");
				out.WriteLn;
				WriteString(a, m, size, FALSE);
				IF m < len THEN out.WriteSString(", ..., 0X") END;
				out.WriteSString("   "); CloseFold(TRUE)
			END
		ELSE
			t := eltyp;
			WHILE FormOf(t) = 12X DO t := t.base[0] END;
			IF FormOf(t) # 0X THEN
				OpenFold("#Dev:Elements");
				i := 0;
				WHILE i < len DO
					Strings.IntToString(i, str);
					name := "[" + SHORT(str$) + "]";
					ShowVar(a, ind, f, 1X, eltyp, ptr, back, name, sel);
					INC(i); INC(a, size)
				END;
				out.WriteSString("   "); CloseFold(TRUE)
			END
		END
	END ShowArray;
	
	PROCEDURE ShowProcVar (a: INTEGER);
		VAR vli, n, ref: INTEGER; m: Kernel.Module; name: Kernel.Name;
	BEGIN
		SYSTEM.GET(a, vli);
		Kernel.SearchProcVar(vli, m, vli);
		IF m = NIL THEN
			IF vli = 0 THEN out.WriteSString("NIL")
			ELSE WriteHex(vli)
			END
		ELSE
			IF m.refcnt >= 0 THEN
				out.WriteSString(m.name); ref := m.refs;
				REPEAT Kernel.GetRefProc(ref, n, name) UNTIL (n = 0) OR (vli < n);
				IF vli < n THEN out.WriteChar("."); out.WriteSString(name) END
			ELSE
				OutString("#Dev:ProcInUnloadedMod");
				out.WriteSString(m.name); out.WriteSString(" !!!")
			END
		END
	END ShowProcVar;

	PROCEDURE ShowPointer (a: INTEGER; f: SHORTCHAR; desc: Kernel.Type; back: RefView; VAR sel: Name);
		VAR adr, x: INTEGER; ptr: ArrayPtr; c: Cluster; btyp: Kernel.Type;
	BEGIN
		SYSTEM.GET(a, adr);
		IF f = 13X THEN btyp := desc.base[0] ELSE btyp := NIL END;
		IF adr = 0 THEN out.WriteSString("NIL")
		ELSIF f = 20X THEN
			out.WriteChar("["); WriteHex(adr); out.WriteChar("]");
			out.WriteChar(" "); c := SYSTEM.VAL(Cluster, Kernel.Root());
			WHILE (c # NIL) & ((adr < SYSTEM.VAL(INTEGER, c)) OR (adr >= SYSTEM.VAL(INTEGER, c) + c.size)) DO c := c.next END;
			IF c # NIL THEN
				ptr := SYSTEM.VAL(ArrayPtr, adr);
				InsertRefView(heap, open, adr, back, btyp, ptr, sel)
			END
		ELSE
			IF (f = 13X) OR (f = 0CX) THEN x := adr - 4 ELSE x := adr END;
			IF ((adr < -4) OR (adr >= 65536)) & Kernel.IsReadable(x, adr + 16) THEN
				out.WriteChar("["); WriteHex(adr); out.WriteChar("]");
				IF (f = 13X) OR (f = 0CX) THEN
					out.WriteChar(" "); c := SYSTEM.VAL(Cluster, Kernel.Root());
					WHILE (c # NIL) & ((adr < SYSTEM.VAL(INTEGER, c)) OR (adr >= SYSTEM.VAL(INTEGER, c) + c.size)) DO
						c := c.next
					END;
					IF c # NIL THEN
						ptr := SYSTEM.VAL(ArrayPtr, adr);
						IF (f = 13X) & (FormOf(btyp) = 12X) THEN	(* array *)
							adr := SYSTEM.ADR(ptr.len[btyp.id DIV 16 MOD 16]) 
						END;
						InsertRefView(heap, open, adr, back, btyp, ptr, sel)
					ELSE OutString("#Dev:IllegalPointer");
					END
				END
			ELSE OutString("#Dev:IllegalAddress"); WriteHex(adr)
			END
		END
	END ShowPointer;
	
	PROCEDURE ShowSelector (ref: RefView);
		VAR b: RefView; n: SHORTINT; a, a0: TextModels.Attributes;
	BEGIN
		b := ref.back; n := 1;
		IF b # NIL THEN
			WHILE (b.name = ref.name) & (b.back # NIL) DO INC(n); b := b.back END;
			ShowSelector(b);
			IF n > 1 THEN out.WriteChar("(") END;
			out.WriteChar(".")
		END;
		out.WriteSString(ref.name);
		IF ref.type = heap THEN out.WriteChar("^") END;
		IF n > 1 THEN
			out.WriteChar(")");
			a0 := out.rider.attr; a := TextModels.NewOffset(a0, 2 * Ports.point);
			out.rider.SetAttr(a);
			out.WriteInt(n); out.rider.SetAttr(a0)
		END;
	END ShowSelector;
	
	PROCEDURE ShowVar (
		ad, ind: INTEGER; f, c: SHORTCHAR; desc: Kernel.Type; ptr: ArrayPtr; back: RefView; VAR name, sel: Name
	);
		VAR i, j, vli, a, ref: INTEGER; tsel: Name; a0: TextModels.Attributes;
			vc: SHORTCHAR; vsi: BYTE; vi: SHORTINT; vr: SHORTREAL; vlr: REAL; vs: SET;
	BEGIN
		out.WriteLn; out.WriteTab; i := 0;
		WHILE i < ind DO out.WriteSString("  "); INC(i) END;
		a := ad; i := 0; j := 0;
		IF sel # "" THEN
			WHILE sel[i] # 0X DO tsel[i] := sel[i]; INC(i) END;
			IF (tsel[i-1] # ":") & (name[0] # "[") THEN tsel[i] := "."; INC(i) END
		END;
		WHILE name[j] # 0X DO tsel[i] := name[j]; INC(i); INC(j) END;
		tsel[i] := 0X;
		a0 := out.rider.attr;
		IF c = 3X THEN	(* varpar *)
			SYSTEM.GET(ad, a);
			out.rider.SetAttr(TextModels.NewStyle(a0, {Fonts.italic}))
		END;
		IF name[0] # "[" THEN out.WriteChar(".") END;
		out.WriteSString(name);
		out.rider.SetAttr(a0);
		out.WriteTab;
		IF (c = 3X) & (a >= 0) & (a < 65536) THEN 
			out.WriteTab; out.WriteSString("NIL VARPAR");
		ELSIF f = 11X THEN
			Kernel.GetTypeName(desc, name);
			IF (c = 3X) & (name[0] # "!") THEN SYSTEM.GET(ad + 4, desc) END;	(* dynamic type *)
			ShowRecord(a, ind + 1, desc, back, tsel)
		ELSIF (c = 3X) & (f = 0BX) THEN	(* VAR anyrecord *)
			SYSTEM.GET(ad + 4, desc);
			ShowRecord(a, ind + 1, desc, back, tsel)
		ELSIF f = 12X THEN
			IF (desc.size = 0) & (ptr = NIL) THEN SYSTEM.GET(ad, a) END;	(* dyn array val par *)
			IF ptr = NIL THEN ptr := SYSTEM.VAL(ArrayPtr, ad - 8) END;
			ShowArray(a, ind + 1, desc, ptr, back, tsel)
		ELSE
			IF desc = NIL THEN desc := SYSTEM.VAL(Kernel.Type, ORD(f)) END;
			WriteName(desc, NIL); out.WriteTab;
			CASE f OF
			| 0X: (* SYSTEM.GET(a, vli); WriteHex(vli) *)
			| 1X: SYSTEM.GET(a, vc); 
				IF vc = 0X THEN out.WriteSString("FALSE")
				ELSIF vc = 1X THEN out.WriteSString("TRUE")
				ELSE OutString("#Dev:Undefined"); out.WriteInt(ORD(vc))
				END
			| 2X: WriteString(a, 1, 1, FALSE)
			| 3X: WriteString(a, 1, 2, FALSE)
			| 4X: SYSTEM.GET(a, vsi); out.WriteInt(vsi)
			| 5X: SYSTEM.GET(a, vi); out.WriteInt(vi)
			| 6X: SYSTEM.GET(a, vli); out.WriteInt(vli)
			| 7X: SYSTEM.GET(a, vli);
					IF BITS(vli) * {23..30} = {23..30} THEN
						IF BITS(vli) = {23..30} THEN out.WriteString("inf")
						ELSIF BITS(vli) = {23..31} THEN out.WriteString("-inf")
						ELSE out.WriteString("nan  ("); WriteHex(vli); out.WriteString(")")
						END
					ELSE
						SYSTEM.GET(a, vr); out.WriteReal(vr)
					END
			| 8X: IF Kernel.littleEndian THEN SYSTEM.GET(a, vli); SYSTEM.GET(a + 4, i)
					ELSE SYSTEM.GET(a + 4, vli); SYSTEM.GET(a, i)
					END;
					IF BITS(i) * {20..30} = {20..30} THEN
						IF (BITS(i) = {20..30}) & (vli = 0) THEN out.WriteString("inf")
						ELSIF (BITS(i) = {20..31}) & (vli = 0) THEN out.WriteString("-inf")
						ELSE out.WriteString("nan  ("); out.WriteIntForm(i, TextMappers.hexadecimal, 8, "0", TextMappers.hideBase);
							WriteHex(vli); out.WriteString(")")
						END
					ELSE
						SYSTEM.GET(a, vlr); out.WriteReal(vlr)
					END
			| 9X: SYSTEM.GET(a, vs); out.WriteSet(vs)
			| 0AX: IF Kernel.littleEndian THEN SYSTEM.GET(a, vli); SYSTEM.GET(a + 4, i)
					ELSE SYSTEM.GET(a + 4, vli); SYSTEM.GET(a, i)
					END;
					IF (vli >= 0) & (i = 0) OR (vli < 0) & (i = -1) THEN out.WriteInt(vli)
					ELSE out.WriteIntForm(i, TextMappers.hexadecimal, 8, "0", TextMappers.hideBase); WriteHex(vli)
					END
			| 0CX, 0DX, 13X, 20X: ShowPointer(a, f, desc, back, tsel)
			| 0EX, 10X: ShowProcVar(a)
			| 0FX: WriteString(a, 256, 1, TRUE)
			| 21X: WriteGuid(a)
			| 22X: SYSTEM.GET(a, vli); WriteHex(vli)
			ELSE 
			END
		END
	END ShowVar;
	
	PROCEDURE WriteTimeStamp (ts: ARRAY OF SHORTINT);
		VAR d: Dates.Date; t: Dates.Time; str: ARRAY 64 OF CHAR;
	BEGIN
		IF ts[0] = 0 THEN
			out.WriteSString("      "); OutString("#Dev:Linked")
		ELSE
			d.year := ts[0]; d.month := ts[1]; d.day := ts[2];
			t.hour := ts[3]; t.minute := ts[4]; t.second := ts[5];
			Dates.DateToString(d, Dates.short, str);
			out.WriteString(str); out.WriteString("  ");
			Dates.TimeToString(t, str);
			out.WriteString(str); 
		END
	END WriteTimeStamp;

	PROCEDURE ShowModules;
		VAR m, m1: Kernel.Module; a0: TextModels.Attributes; n, h, t, h1: ARRAY 256 OF CHAR;
	BEGIN
		a0 := out.rider.attr;
		out.rider.SetAttr(TextModels.NewStyle(a0, {Fonts.italic}));
		OutString("#Dev:ModuleName"); out.WriteTab;
		OutString("#Dev:BytesUsed"); out.WriteTab;
		OutString("#Dev:Clients"); out.WriteTab;
		OutString("#Dev:Compiled"); out.WriteTab;
		OutString("#Dev:Loaded");
		out.rider.SetAttr(a0); out.WriteTab; out.WriteTab;
		out.rider.SetAttr(TextModels.NewStyle(out.rider.attr, {Fonts.underline}));
		out.rider.SetAttr(TextModels.NewColor(out.rider.attr, Ports.blue));
		out.WriteView(StdLinks.dir.NewLink("DevDebug.UpdateModules"));
		OutString("#Dev:Update");
		out.WriteView(StdLinks.dir.NewLink(""));
		out.rider.SetAttr(a0); out.WriteLn;
		m := Kernel.modList;
		WHILE m # NIL DO
			IF m.refcnt >= 0 THEN
				n := m.name$; Kernel.SplitName(n, h, t);
				m1 := Kernel.modList; h1 := "*";
				WHILE (m1 # m) & (h1 # h) DO
					IF m1.refcnt >= 0 THEN n := m1.name$; Kernel.SplitName(n, h1, t) END;
					m1 := m1.next
				END;
				IF h1 # h THEN
					out.WriteLn;
					m1 := m;
					WHILE m1 # NIL DO
						n := m1.name$; Kernel.SplitName(n, h1, t);
						IF (h1 = h) & (m1.refcnt >= 0) THEN
							out.WriteSString(m1.name); out.WriteTab;
							out.WriteIntForm(m1.csize + m1.dsize + m1.rsize, 10, 6, TextModels.digitspace, TextMappers.hideBase);
							out.WriteTab;
							out.WriteIntForm(m1.refcnt, 10, 3, TextModels.digitspace, TextMappers.hideBase);
							out.WriteTab;
							WriteTimeStamp(m1.compTime);
							out.WriteTab;
							WriteTimeStamp(m1.loadTime);
							out.WriteLn
						END;
						m1 := m1.next
					END
				END
			END;
			m := m.next
		END
	END ShowModules;
	
	PROCEDURE ShowGlobals (mod: Kernel.Module);
		VAR ref, x: INTEGER; m, f: SHORTCHAR; name: ARRAY 256 OF CHAR; mname: Kernel.Name; 
			d: Kernel.Type; v: RefView; a0: TextModels.Attributes;
	BEGIN
		IF mod # NIL THEN
			out.WriteSString(mod.name);
			out.WriteTab; out.WriteTab; out.WriteTab;
			a0 := out.rider.attr;
			out.rider.SetAttr(TextModels.NewStyle(out.rider.attr, {Fonts.underline}));
			out.rider.SetAttr(TextModels.NewColor(out.rider.attr, Ports.blue));
			name := "DevDebug.UpdateGlobals('" + mod.name + "')";
			out.WriteView(StdLinks.dir.NewLink(name));
			OutString("#Dev:Update");
			out.WriteView(StdLinks.dir.NewLink(""));
			out.rider.SetAttr(a0); out.WriteLn;
			ref := mod.refs; Kernel.GetRefProc(ref, x, mname);	(* get body *)
			IF x # 0 THEN
				v := NewRefView (module, open, 0, NIL, NIL, NIL, mod.name);
				Kernel.GetRefVar(ref, m, f, d, x, mname);
				WHILE m = 1X DO
					ShowVar(mod.data + x, 0, f, m, d, NIL, v, mname, empty);
					Kernel.GetRefVar(ref, m, f, d, x, mname)
				END
			END;
			out.WriteLn
		END
	END ShowGlobals;
	
	PROCEDURE ShowObject (adr: INTEGER);
		VAR eltyp: Kernel.Type; ptr: ArrayPtr; desc: ARRAY 64 OF INTEGER; i, n, lev, elsize: INTEGER;
	BEGIN
		SYSTEM.GET(adr - 4, eltyp);
		IF ODD(SYSTEM.VAL(INTEGER, eltyp) DIV 2) THEN
			DEC(SYSTEM.VAL(INTEGER, eltyp), 2);
			ptr := SYSTEM.VAL(ArrayPtr, adr);
			elsize := eltyp.size;
			IF (eltyp.mod.name = "Kernel") & (eltyp.fields.num = 1) THEN
				eltyp := eltyp.fields.obj[0].struct
			END;
			n := (ptr.last - ptr.first) DIV elsize + 1;
			lev := (ptr.first - adr - 12) DIV 4; i := 0;
			WHILE lev > 0 DO	(* dynamic levels *)
				DEC(lev);
				desc[i] := ptr.len[lev]; n := n DIV desc[i]; INC(i);	(* size *)
				desc[i] := 0; INC(i);	(* module *)
				desc[i] := 2; INC(i);	(* id *)
				desc[i] := SYSTEM.ADR(desc[i+1]); INC(i)	(* desc *)
			END;
			IF n > 1 THEN	(* static level *)
				desc[i] := n; INC(i);	(* size *)
				desc[i] := 0; INC(i);	(* module *)
				desc[i] := 2; INC(i);	(* id *)
			ELSE DEC(i)
			END;
			desc[i] := SYSTEM.VAL(INTEGER, eltyp);	(* desc *)
			ShowArray(ptr.first, 1, SYSTEM.VAL(Kernel.Type, SYSTEM.ADR(desc)), ptr, NIL, empty);
			out.WriteLn
		ELSE ShowRecord(adr, 1, eltyp, NIL, empty)
		END;
	END ShowObject;
	
	PROCEDURE ShowPtrDeref (ref: RefView);
		VAR b: RefView;
	BEGIN
		ShowSelector(ref); b := ref.back;
		IF b # NIL THEN
			out.WriteChar(" ");
			InsertRefView(b.type, undo, b.adr, b.back, b.desc, b.ptr, b.name)
		END;
		out.WriteLn; out.WriteLn;
		out.WriteChar("["); WriteHex(ref.adr); out.WriteChar("]"); out.WriteTab;
		IF ref.desc = NIL THEN
			ShowObject(ref.adr)
		ELSIF FormOf(ref.desc) = 12X THEN
			ShowArray(ref.adr, 1, ref.desc, ref.ptr, ref, empty)
		ELSE
			ShowRecord(ref.adr, 1, Kernel.TypeOf(SYSTEM.VAL(ANYPTR, ref.ptr)), ref, empty)
		END;
		out.WriteLn
	END ShowPtrDeref;
	
	PROCEDURE RefCh (VAR ref: INTEGER; VAR ch: SHORTCHAR);
	BEGIN
		SYSTEM.GET(ref, ch); INC(ref)
	END RefCh;
	
	PROCEDURE RefNum (VAR ref: INTEGER; VAR x: INTEGER);
		VAR s, n: INTEGER; ch: SHORTCHAR;
	BEGIN
		s := 0; n := 0; RefCh(ref, ch);
		WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, s) ); INC(s, 7); RefCh(ref, ch) END;
		x := n + ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s)
	END RefNum;
	
	PROCEDURE RefName (VAR ref: INTEGER; VAR n: Kernel.Name);
		VAR i: INTEGER; ch: SHORTCHAR;
	BEGIN
		i := 0; RefCh(ref, ch);
		WHILE ch # 0X DO n[i] := ch; INC(i); RefCh(ref, ch) END;
		n[i] := 0X
	END RefName;
	
	PROCEDURE SourcePos* ( mod: Kernel.Module; codePos: INTEGER ): INTEGER;
		VAR ref, pos, ad, d: INTEGER; ch: SHORTCHAR; name: Kernel.Name;
	BEGIN
		IF mod # NIL THEN	(* mf, 12.02.04 *)
			ref := mod.refs; pos := 0; ad := 0; SYSTEM.GET( ref, ch );
			WHILE ch # 0X DO
				WHILE (ch > 0X) & (ch < 0FCX) DO
					INC( ad, LONG( ORD( ch ) ) ); INC( ref ); RefNum( ref, d );
					IF ad > codePos THEN RETURN pos END;
					INC(pos, d); SYSTEM.GET( ref, ch ) 
				END;
				IF ch = 0FCX THEN
					INC(ref); RefNum(ref, d); RefName(ref, name); SYSTEM.GET(ref, ch);
					IF (d > codePos) & (pos > 0) THEN RETURN pos END
				END;
				WHILE ch >= 0FDX DO	(* skip variables *)
					INC(ref); RefCh(ref, ch);
					IF ch = 10X THEN INC(ref, 4) END;
					RefNum(ref, d); RefName(ref, name); SYSTEM.GET(ref, ch)
				END
			END
		END;
		RETURN -1
	END SourcePos;
	
	PROCEDURE Scan (VAR s: TextMappers.Scanner);
	BEGIN
		s.Scan;
		IF s.type = TextMappers.string THEN
			IF       i21sysVocabulary.IsImport(  s.string ) THEN s.type := import
			ELSIF i21sysVocabulary.IsModule( s.string ) THEN s.type := smodule
			ELSIF s.string = "THEN" THEN s.type := stop
			ELSIF s.string = "OF" THEN s.type := stop
			ELSIF s.string = "DO" THEN s.type := stop
			ELSIF s.string = "END" THEN s.type := stop
			ELSIF s.string = "ELSE" THEN s.type := stop
			ELSIF s.string = "ELSIF" THEN s.type := stop
			ELSIF s.string = "UNTIL" THEN s.type := stop
			ELSIF s.string = "TO" THEN s.type := stop
			ELSIF s.string = "BY" THEN s.type := stop
			END
		ELSIF s.type = TextMappers.char THEN
			IF s.char = ";" THEN s.type := semicolon
			ELSIF s.char = "|" THEN s.type := stop
			ELSIF s.char = ":" THEN
				IF s.rider.char = "=" THEN s.rider.Read; s.type := becomes END
			ELSIF s.char = "(" THEN
				IF s.rider.char = "*" THEN
					s.rider.Read;
					REPEAT Scan(s) UNTIL (s.type = TextMappers.eot) OR (s.type = comEnd);
					Scan(s)
				END
			ELSIF s.char = "*" THEN
				IF s.rider.char = ")" THEN s.rider.Read; s.type := comEnd END
			END
		END	
	END Scan;
	
	PROCEDURE ShowSourcePos (name: Name; adr: INTEGER);
		VAR loc: Files.Locator; fname: Files.Name; v: Views.View; m: Models.Model; conv: Converters.Converter;
			c: Containers.Controller; beg, end, p: INTEGER; s: TextMappers.Scanner; w: Windows.Window;
			n: ARRAY 256 OF CHAR;
	BEGIN
		(* search source by name heuristic *)
		n := name$; StdDialog.GetSubLoc(n, "Mod", loc, fname);
		v := Views.OldView(loc, fname); m := NIL;
		IF v # NIL THEN
			Views.Open(v, loc, fname, NIL);
			m := v.ThisModel();
			IF ~(m IS TextModels.Model) THEN m := NIL END
		END;
		IF m = NIL THEN
			(* search in open windows *)
			w := Windows.dir.First();
			WHILE (w # NIL) & (m = NIL) DO
				v := w.doc.ThisView();
				m := v.ThisModel();
				IF m # NIL THEN
					WITH m: TextModels.Model DO
						s.ConnectTo(m); s.SetPos(0);
						REPEAT
							REPEAT s.Scan;
							UNTIL s.rider.eot OR (s.type = TextMappers.string) & i21sysVocabulary.IsModule( s.string );
							s.Scan;
						UNTIL s.rider.eot OR (s.type = TextMappers.string) & (s.string = name);
						IF ~s.rider.eot THEN Windows.dir.Select(w, Windows.eager)
						ELSE m := NIL
						END
					ELSE m := NIL
					END
				END;
				w := Windows.dir.Next(w)
			END
		END;
		IF m = NIL THEN
			(* ask user for source file *)
			conv := NIL; v := Views.Old( Views.ask, loc, fname, conv );
			IF v # NIL THEN
				Views.Open( v, loc, fname, conv );
				m := v.ThisModel();
				IF ~( m IS TextModels.Model ) THEN m := NIL END
			END
		END;
		IF m # NIL THEN
			(* mark error position in text *)
			WITH m: TextModels.Model DO
				IF  i21sysVocabulary.language # ''  THEN
					i21sysVocabulary.ConvertText( m, m ); (* now m is the compiled English version *)
				END;
				beg := SourcePos ( Kernel.ThisMod( n ), adr ); (* in the English version *)
				
				IF beg >= 0 THEN
					IF beg > m.Length () THEN beg := m.Length () - 10 END;
					s.ConnectTo( m ); s.SetPos( beg );
					Scan( s ); beg := s.start; end := beg + 3;
					IF s.type = stop THEN end := s.Pos() - 1
					ELSE
						WHILE ( s.type # TextMappers.eot ) & ( s.type # stop ) & ( s.type # semicolon ) DO
							end := s.Pos() - 1; Scan(s)
						END
					END;
					IF  i21sysVocabulary.language # ''  THEN
						beg := i21sysVocabulary.OriginalPos( beg );
						end := i21sysVocabulary.OriginalPos( end );
					END;
					
					v( TextViews.View ).ShowRange( beg, end, TextViews.any );
					c := v( TextViews.View ).ThisController();
					c( TextControllers.Controller ).SetSelection( beg, end )
				END
			END
		ELSE Dialog.ShowParamMsg("#Dev:SourcefileNotFound", n, "", "")
		END
	END ShowSourcePos;
			
	(* -------------------  RefView ------------------- *)
	
	PROCEDURE (v: RefView) Internalize (VAR rd: Stores.Reader);
		VAR s: Stores.Store; thisVersion: INTEGER;
	BEGIN
		v.Internalize^(rd); IF rd.cancelled THEN RETURN END;
		rd.ReadVersion(0, 0, thisVersion); IF rd.cancelled THEN RETURN END;
		v.command := open;
		rd.ReadSInt(v.type);
		IF v.type = source THEN
			rd.ReadInt(v.adr);
			rd.ReadSString(v.name)
		ELSIF v.type = module THEN
			rd.ReadSString(v.name)
		ELSIF v.type # modules THEN
			v.type := 0
		END
	END Internalize;

	PROCEDURE (v: RefView) Externalize (VAR wr: Stores.Writer);
		VAR t: SHORTINT;
	BEGIN
		v.Externalize^(wr);
		wr.WriteVersion(0);
		t := v.type;
		IF v.command # open THEN t := 0 END;
		wr.WriteSInt(t);
		IF t = source THEN
			wr.WriteInt(v.adr);
			wr.WriteSString(v.name)
		ELSIF t = module THEN
			wr.WriteSString(v.name)
		END
	END Externalize;

	PROCEDURE (v: RefView) CopyFromSimpleView (source: Views.View);
	BEGIN
		(* v.CopyFrom^(source); *)
		WITH source: RefView DO
			v.type := source.type; v.command := source.command; v.adr := source.adr; v.back := source.back;
			v.desc := source.desc; v.ptr := source.ptr; v.name := source.name$;
		END
	END CopyFromSimpleView;

	PROCEDURE (v: RefView) Restore (f: Views.Frame; l, t, r, b: INTEGER);
	BEGIN
		f.DrawPath(path, 4, Ports.fill, Ports.blue, Ports.closedPoly)
	END Restore;
	
	PROCEDURE (v: RefView) GetBackground (VAR color: Ports.Color);
	BEGIN
		color := Ports.background
	END GetBackground;

	PROCEDURE (v: RefView) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View);
		VAR t, t0: TextModels.Model; m: Models.Model; x, y: INTEGER;
			isDown, new: BOOLEAN; mo: SET; script: Stores.Operation;
	BEGIN
		WITH msg: Controllers.TrackMsg DO
			IF v.type > 0 THEN
				REPEAT
					f.MarkRect( 0, 0, refViewSize, refViewSize, Ports.fill, Ports.hilite, Ports.show );
					IF v.command = undo THEN Dialog.ShowStatus("#Dev:ShowPrecedingObject")
					ELSIF v.command = update THEN Dialog.ShowStatus("#Dev:UpdateWindow")
					ELSIF v.type = module THEN Dialog.ShowStatus("#Dev:ShowGlobalVariables")
					ELSIF v.type = source THEN Dialog.ShowStatus("#Dev:ShowSourcePosition")
					ELSIF v.type = heap THEN Dialog.ShowStatus("#Dev:ShowReferencedObject")
					END;
					REPEAT
						f.Input(x, y, mo, isDown)
					UNTIL (x < 0) OR (x > refViewSize) OR (y < 0) OR (y > refViewSize) OR ~isDown;
					f.MarkRect(0, 0, refViewSize, refViewSize, Ports.fill, Ports.hilite, Ports.hide);
					Dialog.ShowStatus("");
					WHILE isDown & ((x < 0) OR (x > refViewSize) OR (y < 0) OR (y > refViewSize)) DO
						f.Input(x, y, mo, isDown)
					END
				UNTIL ~isDown;
				IF (x >= 0) & (x <= refViewSize) & (y >= 0) & (y <= refViewSize) THEN
					IF v.type = source THEN ShowSourcePos(v.name, v.adr)
					ELSE
						m := v.context.ThisModel();
						new := (v.command = open) & (v.back = NIL)
							OR (Controllers.modify IN msg.modifiers) & (v.command # update)
							OR ~(m IS TextModels.Model) ;
						IF new THEN
							t := TextModels.CloneOf(StdLog.buf); t0 := NIL
						ELSE
							t0 := m(TextModels.Model); t := TextModels.CloneOf(t0);
						END;
						out.ConnectTo(t);
						IF v.type = heap THEN  ShowPtrDeref(v)
						ELSIF v.type = module THEN ShowGlobals(Kernel.ThisLoadedMod(v.name))
						ELSIF v.type = modules THEN ShowModules
						END;
						out.ConnectTo(NIL);
						IF new THEN
							OpenViewer(t, "#Dev:Variables", NewRuler())
						ELSE
							Models.BeginScript(t0, "#Dev:Change", script);
							t0.Delete(0, t0.Length()); t0.Insert(0, t, 0, t.Length());
							Models.EndScript(t0, script)
						END
					END
				END
			END
		| msg: Controllers.PollCursorMsg DO
			msg.cursor := Ports.refCursor
		ELSE
		END
	END HandleCtrlMsg;


	PROCEDURE (v: RefView) HandlePropMsg (VAR msg: Properties.Message);
	BEGIN
		WITH msg: Properties.Preference DO
			WITH msg: Properties.ResizePref DO msg.fixed := TRUE
			| msg: Properties.SizePref DO msg.w := refViewSize; msg.h := refViewSize
			| msg: Properties.FocusPref DO msg.hotFocus := TRUE
			ELSE
			END
		ELSE
		END
	END HandlePropMsg;
	
	PROCEDURE NewRefView (type, command: SHORTINT; adr: INTEGER; back: RefView;
												desc: Kernel.Type; ptr: ArrayPtr; name: Name): RefView;
		VAR v: RefView;
	BEGIN
		NEW(v); v.type := type; v.command := command; v.adr := adr; v.back := back;
		v.desc := desc; v.ptr := ptr; v.name := name$;
		RETURN v
	END NewRefView;

	PROCEDURE InsertRefView (type, command: SHORTINT; adr: INTEGER; back: RefView;
												desc: Kernel.Type; ptr: ArrayPtr; name: Name);
		VAR v: RefView; a0: TextModels.Attributes;
	BEGIN
		v := NewRefView(type, command, adr, back, desc, ptr, name);
		a0 := out.rider.attr;
		out.rider.SetAttr(TextModels.NewOffset(a0, Ports.point));
		out.WriteView(v);
		out.rider.SetAttr(a0)
	END InsertRefView;
	
	PROCEDURE HeapRefView* (adr: INTEGER; name: ARRAY OF CHAR): Views.View;
		VAR n: Name; ptr: ArrayPtr;
	BEGIN
		n := SHORT(name$);
		ptr := SYSTEM.VAL(ArrayPtr, adr);
		RETURN NewRefView(heap, open, adr, NIL, NIL, ptr, n)
	END HeapRefView;
	
	(* ----------------------------------------- *)

	PROCEDURE GetMod (VAR mod: Kernel.Module);
		VAR c: TextControllers.Controller; s: TextMappers.Scanner; beg, end: INTEGER;
	BEGIN
		mod := NIL;
		c := TextControllers.Focus();
		IF (c # NIL) & c.HasSelection() THEN
			c.GetSelection(beg, end);
			s.ConnectTo(c.text); s.SetPos(beg); s.Scan;
			IF s.type = TextMappers.string THEN
				mod := Kernel.ThisMod(s.string);
				IF mod = NIL THEN
					Dialog.ShowParamMsg("#Dev:ModuleNotFound", s.string, "", "")
				END				
			ELSE Dialog.ShowMsg("#Dev:NoModuleNameSelected")
			END
		ELSE Dialog.ShowMsg("#Dev:NoSelectionFound")
		END
	END GetMod;

	PROCEDURE ShowLoadedModules*;
	BEGIN
		out.ConnectTo(TextModels.CloneOf(StdLog.buf));
		ShowModules;
		OpenViewer(out.rider.Base(), "#Dev:LoadedModules", NewModRuler());
		out.ConnectTo(NIL)
	END ShowLoadedModules;
	
	PROCEDURE UpdateModules*;
		VAR t, t0: TextModels.Model; script: Stores.Operation;
	BEGIN
		t0 := TextViews.FocusText();
		Models.BeginScript(t0, "#Dev:Change", script);
		t := TextModels.CloneOf(t0);
		out.ConnectTo(t);
		ShowModules;
		(*Stores.InitDomain(t, t0.domain);*) Stores.Join(t, t0);	(* not efficient to init domain before writing *)
		t0.Delete(0, t0.Length()); t0.Insert(0, t, 0, t.Length());
		Models.EndScript(t0, script);
		out.ConnectTo(NIL)
	END UpdateModules;

	PROCEDURE ShowGlobalVariables*;
		VAR mod: Kernel.Module;
	BEGIN
		GetMod(mod);
		IF mod # NIL THEN
			out.ConnectTo(TextModels.CloneOf(StdLog.buf));
			ShowGlobals(mod);
			OpenViewer(out.rider.Base(), "#Dev:Variables", NewRuler());
			out.ConnectTo(NIL)
		END
	END ShowGlobalVariables;
	
	PROCEDURE UpdateGlobals* (name: ARRAY OF CHAR);
		VAR t, t0: TextModels.Model; script: Stores.Operation; mod: Kernel.Module; n: Kernel.Name;
	BEGIN
		n := SHORT(name$); mod := Kernel.ThisLoadedMod(n);
		IF mod # NIL THEN
			t0 := TextViews.FocusText();
			Models.BeginScript(t0, "#Dev:Change", script);
			t := TextModels.CloneOf(t0);
			out.ConnectTo(t);
			ShowGlobals(mod);
			(*Stores.InitDomain(t, t0.domain);*) Stores.Join(t, t0);	(* not efficient to init domain before writing *)
			t0.Delete(0, t0.Length()); t0.Insert(0, t, 0, t.Length());
			Models.EndScript(t0, script);
			out.ConnectTo(NIL)
		END
	END UpdateGlobals;

	PROCEDURE ShowHeapObject* (adr: INTEGER; title: ARRAY OF CHAR);
	BEGIN
		out.ConnectTo(TextModels.CloneOf(StdLog.buf));
		IF title # "" THEN
			out.WriteString(title); out.WriteLn; out.WriteLn
		END;
		out.WriteChar("["); WriteHex(adr); out.WriteChar("]"); out.WriteTab;
		ShowObject(adr);
		out.WriteLn;
		OpenViewer(out.rider.Base(), "#Dev:HeapObject", NewRuler());
		out.ConnectTo(NIL)
	END ShowHeapObject;
	
	PROCEDURE ShowViewState*;
		VAR ops: Controllers.PollOpsMsg;
	BEGIN
		Controllers.PollOps(ops);
		IF ops.singleton # NIL THEN
			ShowHeapObject(SYSTEM.VAL(INTEGER, ops.singleton), "")
		END
	END ShowViewState;
	
	
	PROCEDURE UnloadMod (name: TextMappers.String; VAR ok: BOOLEAN);
		VAR mod: Kernel.Module; str: Dialog.String; n: Kernel.Name;
	BEGIN
		n := SHORT(name$); mod := Kernel.ThisLoadedMod(n);
		IF mod # NIL THEN
			Dialog.ShowParamStatus("#Dev:Unloading", name, "", "");
			Kernel.UnloadMod(mod);
			IF mod.refcnt < 0 THEN
				Dialog.MapParamString("#Dev:Unloaded", name, "", "", str);
				StdLog.String(str); StdLog.Ln
			ELSE
				Dialog.ShowParamMsg("#Dev:UnloadingFailed", name, "", "");
				ok := FALSE
			END
		ELSE
			Dialog.ShowParamMsg("#Dev:NotFound", name, "", "");
			ok := FALSE;
		END
	END UnloadMod;
	
	PROCEDURE Unload*;
		VAR t: TextModels.Model; s: TextMappers.Scanner; ok: BOOLEAN;
	BEGIN
		t := TextViews.FocusText();
		IF t # NIL THEN
			s.ConnectTo(t); s.SetPos(0);
			REPEAT Scan(s) UNTIL (s.type = smodule) OR s.rider.eot;
			IF (s.type = smodule) THEN
				Scan(s);
				IF (s.type = TextMappers.string) & IsIdent(s.string) THEN
					ok := TRUE; UnloadMod(s.string, ok);
					IF ok THEN
						Dialog.ShowStatus("#Dev:Ok");
					END;
					Controls.Relink
				ELSE
					Dialog.ShowMsg("#Dev:NoModNameFound");
				END
			ELSE
				Dialog.ShowMsg("#Dev:NoModNameFound");
			END
		END
	END Unload;
	
	PROCEDURE UnloadList(beg, end: INTEGER; c: TextControllers.Controller);
		VAR s: TextMappers.Scanner; res: INTEGER; ok, num: BOOLEAN; linked: ARRAY 16 OF CHAR;
	BEGIN
		s.ConnectTo(c.text); s.SetPos(beg); s.Scan; ok := TRUE; num := FALSE;
		WHILE (s.start < end) & (s.type # TextMappers.invalid) DO
			Dialog.MapString("#Dev:Linked", linked);
			IF (s.type = TextMappers.string) & (s.string # linked) THEN
				IF num & ((s.string = "AM") OR (s.string = "PM")) THEN s.Scan (* skip am & pm *)
				ELSIF IsIdent(s.string) THEN UnloadMod(s.string, ok); s.Scan
				ELSE s.type := TextMappers.invalid
				END
			ELSE
				(* skip numbers to allow selection of list of loaded modules *)
				num := TRUE; s.Scan
			END
		END;
		IF ok THEN Dialog.ShowStatus("#Dev:Ok") END;
		Controls.Relink
	END UnloadList;

	PROCEDURE UnloadModuleList*;
		VAR c: TextControllers.Controller; s: TextMappers.Scanner; res, beg, end: INTEGER;
			ok, num: BOOLEAN; linked: ARRAY 16 OF CHAR;
	BEGIN
		c := TextControllers.Focus();
		IF (c # NIL) & c.HasSelection() THEN
			c.GetSelection(beg, end);
			UnloadList(beg, end, c)
		END
	END UnloadModuleList;

	PROCEDURE UnloadThis*;
		VAR p: DevCommanders.Par; beg, end: INTEGER; c: TextControllers.Controller;
	BEGIN
		p := DevCommanders.par;
		IF p # NIL THEN
			DevCommanders.par := NIL;
			beg := p.beg; end := p.end;
			c := TextControllers.Focus();
			IF c # NIL THEN UnloadList(beg, end, c) END
		ELSE Dialog.ShowMsg("#Dev:NoTextViewFound")
		END
	END UnloadThis;

	PROCEDURE Execute*;
		VAR beg, end, start, res, i: INTEGER; done: BOOLEAN;
			c: TextControllers.Controller; s: TextMappers.Scanner; cmd: Dialog.String;
	BEGIN
		c := TextControllers.Focus();
		IF (c # NIL) & c.HasSelection() THEN
			c.GetSelection(beg, end);
			s.ConnectTo(c.text); s.SetPos(beg); s.Scan; TextMappers.ScanQualIdent(s, cmd, done);
			IF done THEN
				Dialog.Call(cmd, " ", res)
			ELSIF s.type = TextMappers.string THEN
				Dialog.Call(s.string, " ", res)
			ELSE
				Dialog.ShowMsg("#Dev:StringExpected")
			END
		ELSE Dialog.ShowMsg("#Dev:NoSelectionFound")
		END
	END Execute;

	PROCEDURE ShowStack;
		VAR ref, end, i, j, x, a, b, c: INTEGER; m, f: SHORTCHAR; mod: Kernel.Module; name, sel: Kernel.Name;
			d: Kernel.Type;
	BEGIN
		a := Kernel.pc; b := Kernel.fp; c := 100;
		REPEAT
			mod := Kernel.modList;
			WHILE (mod # NIL) & ((a < mod.code) OR (a >= mod.code + mod.csize)) DO mod := mod.next END;
			IF mod # NIL THEN
				DEC(a, mod.code);
				IF mod.refcnt >= 0 THEN
					InsertRefView(module, open, 0, NIL, NIL, NIL, mod.name);
					out.WriteChar(" "); out.WriteSString(mod.name); 
					ref := mod.refs;
					REPEAT Kernel.GetRefProc(ref, end, name) UNTIL (end = 0) OR (a < end);
					IF a < end THEN
						out.WriteChar("."); out.WriteSString(name);
						sel := mod.name$; i := 0;
						WHILE sel[i] # 0X DO INC(i) END;
						sel[i] := "."; INC(i); j := 0;
						WHILE name[j] # 0X DO sel[i] := name[j]; INC(i); INC(j) END;
						sel[i] := ":"; sel[i+1] := 0X;
						out.WriteSString("   ["); WriteHex(a);  out.WriteSString("] ");
						i := SourcePos(mod, 0);
						IF i >= 0 THEN
							InsertRefView( source, open, a, NIL, NIL, NIL, mod.name );
						END;
						IF name # "$$" THEN
							Kernel.GetRefVar(ref, m, f, d, x, name);
							WHILE m # 0X DO
								ShowVar(b + x, 0, f, m, d, NIL, NIL, name, sel);
								Kernel.GetRefVar(ref, m, f, d, x, name);
							END
						END;
						out.WriteLn
					ELSE out.WriteSString(".???"); out.WriteLn
					END
				ELSE
					out.WriteChar("("); out.WriteSString(mod.name);
					out.WriteSString(")   (pc="); WriteHex(a);
					out.WriteSString(",  fp="); WriteHex(b); out.WriteChar(")");
					out.WriteLn
				END
			ELSE
				out.WriteSString("<system>   (pc="); WriteHex(a);
				out.WriteSString(",  fp="); WriteHex(b); out.WriteChar(")");
				out.WriteLn
			END;
			IF (b >= Kernel.fp) & (b < Kernel.stack) THEN
				SYSTEM.GET(b+4, a);	(* stacked pc *)
				SYSTEM.GET(b, b);	(* dynamic link *)
				DEC(a); DEC(c)
			ELSE c := 0
			END
		UNTIL c = 0
	END ShowStack;

	PROCEDURE (a: Action) Do;	(* delayed trap window open *)
	BEGIN
		Kernel.SetTrapGuard(TRUE);
		OpenViewer(a.text, "#Dev:Trap", NewRuler());
		Kernel.SetTrapGuard(FALSE);
	END Do;
	
	PROCEDURE GetTrapMsg(OUT msg: ARRAY OF CHAR);
		VAR ref, end, a: INTEGER; mod: Kernel.Module; name: Kernel.Name; head, tail, errstr: ARRAY 32 OF CHAR;
			key: ARRAY 128 OF CHAR;
	BEGIN
		a := Kernel.pc; mod := Kernel.modList;
		WHILE (mod # NIL) & ((a < mod.code) OR (a >= mod.code + mod.csize)) DO mod := mod.next END;
		IF mod # NIL THEN
			DEC(a, mod.code); ref := mod.refs;
			REPEAT Kernel.GetRefProc(ref, end, name) UNTIL (end = 0) OR (a < end);
			IF a < end THEN
				Kernel.SplitName (mod.name$, head, tail);
				IF head = "" THEN head := "System" END;
				Strings.IntToString(Kernel.err, errstr);
				key := tail + "." + name + "." + errstr;
				Dialog.MapString("#" + head + ":" + key, msg);
				(* IF key # msg THEN out.WriteString(" " + msg) END; *)
				IF key = msg THEN msg := "" END;
			END
		END
	END GetTrapMsg;

	PROCEDURE Trap;
		VAR a0: TextModels.Attributes; prop: Properties.StdProp; action: Action;
		 	msg: ARRAY 512 OF CHAR;
		
		PROCEDURE Write ( msg: ARRAY OF CHAR );
			VAR  msg1: ARRAY 512 OF CHAR;
		BEGIN
			Dialog.MapString( "#Dev:"+msg, msg1 );
			out.WriteString( msg1 )
		END Write;
	
	BEGIN
		out.ConnectTo(TextModels.CloneOf(StdLog.buf));
		a0 := out.rider.attr;
		out.rider.SetAttr(TextModels.NewWeight(a0, Fonts.bold));
		IF      Kernel.err = 129 THEN Write("invalid WITH")
		ELSIF Kernel.err = 130 THEN Write("invalid CASE")
		ELSIF Kernel.err = 131 THEN Write("function without RETURN")
		ELSIF Kernel.err = 132 THEN Write("type guard")
		ELSIF Kernel.err = 133 THEN Write("implied type guard")
		ELSIF Kernel.err = 134 THEN Write("value out of range")
		ELSIF Kernel.err = 135 THEN Write("index out of range")
		ELSIF Kernel.err = 136 THEN Write("string too long")
		ELSIF Kernel.err = 137 THEN Write("stack overflow")
		ELSIF Kernel.err = 138 THEN Write("integer overflow")
		ELSIF Kernel.err = 139 THEN Write("division by zero")
		ELSIF Kernel.err = 140 THEN Write("infinite real result")
		ELSIF Kernel.err = 141 THEN Write("real underflow")
		ELSIF Kernel.err = 142 THEN Write("real overflow")
		ELSIF Kernel.err = 143 THEN
			Write("undefined real result  (");
			out.WriteIntForm(Kernel.val MOD 10000H, TextMappers.hexadecimal, 4, "0", TextMappers.hideBase); out.WriteSString(", ");
			out.WriteIntForm(Kernel.val DIV 10000H, TextMappers.hexadecimal, 3, "0", TextMappers.hideBase); out.WriteChar(")")
		ELSIF Kernel.err = 144 THEN Write("not a number")
		ELSIF Kernel.err = 200 THEN Write("keyboard interrupt")
		ELSIF Kernel.err = 201 THEN Write("NIL dereference")
		ELSIF Kernel.err = 202 THEN
			out.WriteSString("illegal instruction: ");
			out.WriteIntForm(Kernel.val, TextMappers.hexadecimal, 5, "0", TextMappers.showBase)
		ELSIF Kernel.err = 203 THEN
			IF (Kernel.val >= -4) & (Kernel.val < 65536) THEN out.WriteSString("NIL dereference (read)")
			ELSE out.WriteSString("illegal memory read (ad = "); WriteHex(Kernel.val); out.WriteChar(")")
			END
		ELSIF Kernel.err = 204 THEN
			IF (Kernel.val >= -4) & (Kernel.val < 65536) THEN out.WriteSString("NIL dereference (write)")
			ELSE out.WriteSString("illegal memory write (ad = "); WriteHex(Kernel.val); out.WriteChar(")")
			END
		ELSIF Kernel.err = 205 THEN
			IF (Kernel.val >= -4) & (Kernel.val < 65536) THEN out.WriteSString("NIL procedure call")
			ELSE out.WriteSString("illegal execution (ad = "); WriteHex(Kernel.val); out.WriteChar(")")
			END
		ELSIF Kernel.err = 257      THEN out.WriteSString("out of memory")
		ELSIF Kernel.err = 10001H THEN out.WriteSString("bus error")
		ELSIF Kernel.err = 10002H THEN out.WriteSString("address error")
		ELSIF Kernel.err = 10007H THEN out.WriteSString("fpu error")
		ELSIF Kernel.err < 0 THEN
			out.WriteSString("Exception "); out.WriteIntForm(-Kernel.err, TextMappers.hexadecimal, 3, "0", TextMappers.showBase)
		ELSE
			Write("TRAP "); out.WriteInt(Kernel.err);
			IF      Kernel.err = 126   THEN Write("  (not yet implemented)")
			ELSIF Kernel.err = 125   THEN Write("  (call of obsolete procedure)")
			ELSIF Kernel.err >= 100 THEN Write("  (invariant violated)")
			ELSIF Kernel.err >= 60   THEN Write("  (postcondition violated)")
			ELSIF Kernel.err >= 20   THEN Write("  (precondition violated)")
			END
		END;
		
		GetTrapMsg(msg);
		IF msg # "" THEN out.WriteLn; out.WriteString(msg) END;

		out.WriteLn; out.rider.SetAttr(a0);
		out.WriteLn; ShowStack;
		NEW(action); action.text := out.rider.Base();
		Services.DoLater(action, Services.now);
		out.ConnectTo(NIL)
	END Trap;

BEGIN
	Kernel.InstallTrapViewer(Trap);
	empty := "";
	path[0].x := refViewSize DIV 2; path[0].y := 0;
	path[1].x := refViewSize; path[1].y := refViewSize DIV 2;
	path[2].x := refViewSize DIV 2; path[2].y := refViewSize;
	path[3].x := 0; path[3].y := refViewSize DIV 2
END DevDebug.