gistfile1.pas

	PROCEDURE DefaultTrapViewer;
		VAR len, ref, end, x, a, b, c: INTEGER; mod: Module;
			name: Name; out: ARRAY 1024 OF SHORTCHAR;

		PROCEDURE WriteString (s: ARRAY OF SHORTCHAR);
			VAR i: INTEGER;
		BEGIN
			i := 0;
			WHILE (len < LEN(out) - 1) & (s[i] # 0X) DO out[len] := s[i]; INC(i); INC(len) END
		END WriteString;

		PROCEDURE WriteHex (x, n: INTEGER);
			VAR i, y: INTEGER;
		BEGIN
			IF len + n < LEN(out) THEN
				i := len + n - 1;
				WHILE i >= len DO
					y := x MOD 16; x := x DIV 16;
					IF y > 9 THEN y := y + (ORD("A") - ORD("0") - 10) END;
					out[i] := SHORT(CHR(y + ORD("0"))); DEC(i)
				END;
				INC(len, n)
			END
		END WriteHex;

		PROCEDURE WriteLn;
		BEGIN
			IF len < LEN(out) - 1 THEN out[len] := 0DX; INC(len) END
		END WriteLn;

	BEGIN
		len := 0;
		IF err = 129 THEN WriteString("invalid with")
		ELSIF err = 130 THEN WriteString("invalid case")
		ELSIF err = 131 THEN WriteString("function without return")
		ELSIF err = 132 THEN WriteString("type guard")
		ELSIF err = 133 THEN WriteString("implied type guard")
		ELSIF err = 134 THEN WriteString("value out of range")
		ELSIF err = 135 THEN WriteString("index out of range")
		ELSIF err = 136 THEN WriteString("string too long")
		ELSIF err = 137 THEN WriteString("stack overflow")
		ELSIF err = 138 THEN WriteString("integer overflow")
		ELSIF err = 139 THEN WriteString("division by zero")
		ELSIF err = 140 THEN WriteString("infinite real result")
		ELSIF err = 141 THEN WriteString("real underflow")
		ELSIF err = 142 THEN WriteString("real overflow")
		ELSIF err = 143 THEN WriteString("undefined real result")
		ELSIF err = 200 THEN WriteString("keyboard interrupt")
		ELSIF err = 202 THEN WriteString("illegal instruction:  ");
			WriteHex(val, 4)
		ELSIF err = 203 THEN WriteString("illegal memory read [ad = ");
			WriteHex(val, 8); WriteString("]")
		ELSIF err = 204 THEN WriteString("illegal memory write [ad = ");
			WriteHex(val, 8); WriteString("]")
		ELSIF err = 205 THEN WriteString("illegal execution [ad = ");
			WriteHex(val, 8); WriteString("]")
		ELSIF err < 0 THEN WriteString("exception #"); WriteHex(-err, 2)
		ELSE err := err DIV 100 * 256 + err DIV 10 MOD 10 * 16 + err MOD 10;
			WriteString("trap #"); WriteHex(err, 3)
		END;
		a := pc; b := fp; c := 12;
		REPEAT
			WriteLn; WriteString("- ");
			mod := 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
					WriteString(mod.name); ref := mod.refs;
					REPEAT GetRefProc(ref, end, name) UNTIL (end = 0) OR (a < end);
					IF a < end THEN
						WriteString("."); WriteString(name)
					END
				ELSE
					WriteString("("); WriteString(mod.name); WriteString(")")
				END;
				WriteString("  ")
			END;
			WriteString("(pc="); WriteHex(a, 8);
			WriteString(", fp="); WriteHex(b, 8); WriteString(")");
			IF (b >= sp) & (b < stack) THEN
				S.GET(b+4, a);	(* stacked pc *)
				S.GET(b, b);	(* dynamic link *)
				DEC(c)
			ELSE c := 0
			END
		UNTIL c = 0;
		out[len] := 0X;
		x := WinApi.MessageBoxA(0, out, "BlackBox", {})
	END DefaultTrapViewer;