MODULE PCDebug;
IMPORT
SYSTEM, Machine, KernelLog, Modules;
CONST
NotImplemented* = 0;
NotOptimized* = 1;
TYPE
List = POINTER TO RECORD
pc: SYSTEM.ADDRESS;
next: List
END;
VAR
pclist: List;
Hex: ARRAY 17 OF CHAR;
PROCEDURE ReadNum (VAR pos: SYSTEM.ADDRESS; VAR i: LONGINT);
VAR n: LONGINT; s: SHORTINT; x: CHAR;
BEGIN
s := 0; n := 0; SYSTEM.GET(pos, x); INC(pos);
WHILE ORD(x) >= 128 DO INC(n, ASH(ORD(x) - 128, s)); INC(s, 7); SYSTEM.GET(pos, x); INC(pos) END;
i := n + ASH(ORD(x) MOD 64 - ORD(x) DIV 64 * 64, s)
END ReadNum;
PROCEDURE WriteString*(str: ARRAY OF CHAR; VAR name: ARRAY OF CHAR; VAR pos: LONGINT);
VAR i: LONGINT;
BEGIN
i := 0;
WHILE (str[i] # 0X) & (pos < LEN(name)-1) DO
name[pos] := str[i]; INC(i); INC(pos)
END;
name[pos] := 0X
END WriteString;
PROCEDURE WriteHex*(val: SYSTEM.ADDRESS; VAR name: ARRAY OF CHAR; VAR pos: LONGINT);
VAR i: LONGINT;
BEGIN
INC(pos, 8); i := 1;
WHILE i <= 8 DO
IF (pos-i < LEN(name)-1) THEN name[pos-i] := Hex[val MOD 16] END;
val := val DIV 16; INC(i)
END;
name[pos] := 0X
END WriteHex;
PROCEDURE GetProcedure*(pc: SYSTEM.ADDRESS; VAR name: ARRAY OF CHAR);
VAR mod: Modules.Module; refpos, limit, refstart: SYSTEM.ADDRESS; ch, ch0: CHAR; i, procstart: LONGINT;
BEGIN
i := 0;
mod := Modules.ThisModuleByAdr(pc);
IF mod = NIL THEN
WriteString("NIL PC = ", name, i); WriteHex(pc, name, i)
ELSE
WriteString(mod.name, name, i); WriteString(".", name, i);
IF (SYSTEM.VAL(LONGINT, mod.refs) # 0) & (LEN(mod.refs) # 0) THEN
refstart := 0; refpos := SYSTEM.ADR(mod.refs[0]);
limit := refpos + LEN(mod.refs);
LOOP
SYSTEM.GET(refpos, ch); INC(refpos);
IF refpos >= limit THEN EXIT END;
IF ch = 0F8X THEN
ReadNum(refpos, procstart);
IF pc < SYSTEM.ADR(mod.code[0]) + procstart THEN EXIT END;
refstart := refpos;
REPEAT SYSTEM.GET(refpos, ch); INC(refpos) UNTIL ch = 0X;
ELSIF ch = 0F9X THEN
ReadNum(refpos, procstart);
IF pc < SYSTEM.ADR(mod.code[0]) + procstart THEN EXIT END;
INC(refpos, 1+1+1+1);
refstart := refpos;
REPEAT SYSTEM.GET(refpos, ch); INC(refpos) UNTIL ch = 0X;
ELSIF ch < 0F8X THEN
INC(refpos);
ReadNum(refpos, procstart);
REPEAT SYSTEM.GET(refpos, ch); INC(refpos) UNTIL ch = 0X;
END
END;
refpos := refstart;
IF refpos # 0 THEN
SYSTEM.GET(refpos, ch); INC(refpos); ch0 := ch;
WHILE ch # 0X DO name[i] := ch; INC(i); SYSTEM.GET(refpos, ch); INC(refpos) END;
name[i] := 0X
END
END;
WriteString(" PC = ", name, i); WriteHex(pc-SYSTEM.ADR(mod.code[0]), name, i); WriteString("H", name, i)
END
END GetProcedure;
PROCEDURE GetTypeName*(p: ANY; VAR name: ARRAY OF CHAR);
VAR ch: CHAR; i, tag: LONGINT;
BEGIN
IF p = NIL THEN COPY("NIL", name)
ELSE
SYSTEM.GET(SYSTEM.VAL(LONGINT, p)-4, tag);
IF (tag # 0) & (tag MOD 16 = 8) THEN
SYSTEM.GET(tag-4, tag);
INC(tag, 16);
SYSTEM.GET(tag, ch); i := 0;
WHILE (ch # 0X) & (i < LEN(name)-1) DO
name[i] := ch; INC(i); SYSTEM.GET(tag+i, ch)
END;
name[i] := 0X
ELSE
COPY("wrong tag", name)
END
END
END GetTypeName;
PROCEDURE ToDo*(class: LONGINT);
VAR pc, bp: SYSTEM.ADDRESS; p, q: List; name: ARRAY 64 OF CHAR;
BEGIN {EXCLUSIVE}
bp := Machine.CurrentBP ();
SYSTEM.GET (bp + SYSTEM.SIZEOF(SYSTEM.ADDRESS), pc);
p := pclist;
WHILE (p.next # NIL) & (p.next.pc < pc) DO p := p.next END;
IF (p.next = NIL) OR (p.next.pc # pc) THEN
NEW(q); q.pc := pc; q.next := p.next; p.next := q;
KernelLog.Ln;
CASE class OF
| NotImplemented: KernelLog.String(" unimplemented at ")
| NotOptimized: KernelLog.String(" not optimized at ")
END;
GetProcedure(pc, name); KernelLog.String(name);
END;
IF class = NotImplemented THEN
HALT(MAX(INTEGER))
END
END ToDo;
PROCEDURE ResetToDo*;
BEGIN
NEW(pclist); pclist.next := NIL;
END ResetToDo;
BEGIN
Hex := "0123456789ABCDEF"
END PCDebug.
(*
08.02.02 prk use Aos instead of Oberon modules
22.01.02 prk ToDo list moved to PCDebug
25.03.01 prk renamed, was Debug.Mod
*)