MODULE WMModuleState;
IMPORT
SYSTEM,
Streams,
Modules,
TextUtilities,
WMComponents,
WMEditors,
WMGraphics,
WMStandardComponents,
WMDialogs,
WMWindowManager,
Commands,
WMRectangles,
Kernel;
CONST
MaxString = 64;
MaxArray = 10;
RefreshOff = "Refresh is off";
RefreshOn = "Refresh is on";
TYPE Bytes = Modules.Bytes;
TYPE StateWindow= OBJECT(WMComponents.FormWindow)
VAR
tw-: TextUtilities.TextWriter;
panel : WMStandardComponents.Panel;
out- : WMEditors.Editor;
open : BOOLEAN;
refresh: WMStandardComponents.Button;
refreshOn: BOOLEAN;
timer : Kernel.Timer;
module: Modules.Module;
interval: LONGINT;
autorefresh: WMStandardComponents.Checkbox;
PROCEDURE &New*(title : ARRAY OF CHAR; interval: LONGINT; name: Modules.Name);
VAR toolbar: WMStandardComponents.Panel;
load, clear : WMStandardComponents.Button;
font: WMGraphics.Font;
dx, dy: LONGINT;
bearing : WMRectangles.Rectangle;
label: WMStandardComponents.Label;
BEGIN
NEW(panel); panel.bounds.SetExtents(640, 420); panel.fillColor.Set(WMGraphics.RGBAToColor(255, 255, 255, 255));
NEW(toolbar);
toolbar.bounds.SetHeight(20);
toolbar.alignment.Set(WMComponents.AlignTop);
panel.AddContent(toolbar);
NEW(clear);
clear.alignment.Set(WMComponents.AlignLeft);
clear.SetCaption("Clear");
clear.onClick.Add(ClearText);
font := clear.GetFont();
font.GetStringSize(" Clear ", dx, dy);
clear.bounds.SetWidth(dx);
toolbar.AddContent(clear);
NEW(load);
load.alignment.Set(WMComponents.AlignLeft);
load.SetCaption("Load module");
load.onClick.Add(Load);
font := load.GetFont();
font.GetStringSize(" Load module ", dx, dy);
load.bounds.SetWidth(dx);
toolbar.AddContent(load);
NEW(refresh);
refresh.alignment.Set(WMComponents.AlignLeft);
refresh.SetCaption("Refresh");
refresh.onClick.Add(Refresh);
font := refresh.GetFont();
font.GetStringSize(" Refresh ", dx, dy);
refresh.bounds.SetWidth(dx);
refreshOn := FALSE;
toolbar.AddContent(refresh);
bearing := WMRectangles.MakeRect(3, 3, 3, 3);
NEW(autorefresh);
autorefresh.onClick.Add(RefreshSwitch);
autorefresh.bearing.Set(bearing);
autorefresh.bounds.SetWidth(14);
autorefresh.alignment.Set(WMComponents.AlignRight);
toolbar.AddContent(autorefresh);
autorefresh.state.Set(0);
NEW(label);
font := label.GetFont();
font.GetStringSize(" auto-refresh ", dx, dy);
label.bounds.SetWidth(dx);
label.SetCaption("auto-refresh");
label.textColor.Set(0000000FFH);
label.alignment.Set(WMComponents.AlignRight);
toolbar.AddContent(label);
NEW(out); out.alignment.Set(WMComponents.AlignClient); out.tv.showBorder.Set(TRUE); panel.AddContent(out);
Init(panel.bounds.GetWidth(), panel.bounds.GetHeight(), FALSE);
SetContent(panel);
manager := WMWindowManager.GetDefaultManager();
SetTitle(WMComponents.NewString(title));
WMWindowManager.DefaultAddWindow(SELF);
NEW(tw, out.text);
open := TRUE;
SELF.interval := interval;
NEW(timer);
IF name # "" THEN
out.text.AcquireWrite();
OutState(name);
out.text.ReleaseWrite();
ELSE
Load(NIL, NIL);
END;
END New;
PROCEDURE Close;
BEGIN
open := FALSE;
BEGIN{EXCLUSIVE}
refreshOn := FALSE;
END;
Remove(SELF);
Close^
END Close;
PROCEDURE ClearText(sender, data : ANY);
BEGIN
out.text.AcquireWrite();
out.text.Delete(0, out.text.GetLength());
out.tv.firstLine.Set(0); out.tv.cursor.SetPosition(0);
out.text.ReleaseWrite();
END ClearText;
PROCEDURE Load(sender, data : ANY);
VAR
dr: LONGINT;
name: Modules.Name;
temp: BOOLEAN;
BEGIN
temp := refreshOn;
BEGIN {EXCLUSIVE}
refreshOn := FALSE;
END;
dr := WMDialogs.QueryString("Enter module name", name);
IF dr = WMDialogs.ResOk THEN
out.text.AcquireWrite();
OutState(name);
out.text.ReleaseWrite();
END;
BEGIN {EXCLUSIVE}
refreshOn := temp;
END;
END Load;
PROCEDURE OutState(name: Modules.Name);
VAR
i, refpos: LONGINT;
mod: Modules.Module;
refs: Bytes;
ch: CHAR;
nameDis: Modules.Name;
BEGIN
out.text.Delete(0, out.text.GetLength());
out.tv.firstLine.Set(0); out.tv.cursor.SetPosition(0);
IF name = "" THEN
IF SELF.module = NIL THEN
RETURN;
ELSE
nameDis := module.name;
mod := module;
tw.SetFontStyle({0});
tw.String(nameDis);
tw.SetFontStyle({});
IF mod # NIL THEN
SELF.module := mod;
tw.String(" SB = ");
tw.Hex(mod.sb, 0); tw.Char("H"); tw.Ln();
refs := SYSTEM.VAL(Bytes, mod.refs);
IF (refs # NIL) & (LEN(mod.refs) # 0) THEN
refpos := FindProc(refs, 0);
IF refpos # -1 THEN
REPEAT ch := refs[refpos]; INC(refpos) UNTIL ch = 0X;
Variables(refs, refpos, mod.sb, tw)
END
END
ELSE
tw.String(" not loaded"); tw.Ln();
END;
tw.Update();
END;
ELSE
i := 0; WHILE (name[i] # 0X) & (name[i] # ".") DO INC(i) END; name[i] := 0X;
mod := Modules.root;
WHILE (mod # NIL) & (mod.name # name) DO mod := mod.next END;
nameDis := name;
tw.SetFontStyle({0});
tw.String(nameDis);
tw.SetFontStyle({});
IF mod # NIL THEN
SELF.module := mod;
tw.String(" SB =");
tw.Hex(mod.sb, 0); tw.Char("H"); tw.Ln();
refs := SYSTEM.VAL(Bytes, mod.refs);
IF (refs # NIL) & (LEN(mod.refs) # 0) THEN
refpos := FindProc(refs, 0);
IF refpos # -1 THEN
REPEAT ch := refs[refpos]; INC(refpos) UNTIL ch = 0X;
Variables(refs, refpos, mod.sb, tw)
END
END
ELSE
tw.String(" not loaded"); tw.Ln();
END;
tw.Update();
END;
END OutState;
PROCEDURE RefreshSwitch(sender, data : ANY);
BEGIN
BEGIN {EXCLUSIVE}
refreshOn := ~ refreshOn;
END;
IF refreshOn THEN
refresh.onClick.Remove(Refresh);
ELSE
refresh.onClick.Add(Refresh);
END;
END RefreshSwitch;
PROCEDURE Refresh(sender, data : ANY);
BEGIN
out.text.AcquireWrite();
OutState("");
out.text.ReleaseWrite();
END Refresh;
PROCEDURE SetInterval*(interval: LONGINT);
BEGIN
SELF.interval := interval;
END SetInterval;
PROCEDURE Variables(refs: Bytes; i: LONGINT; base: SYSTEM.ADDRESS; w:Streams.Writer);
VAR
mode, ch: CHAR;
m, type, n, lval, size, tmp1, tdadr: LONGINT;
adr, tmp2: SYSTEM.ADDRESS;
etc: BOOLEAN;
sval: SHORTINT;
ival: INTEGER;
tmp: Bytes;
set: SET;
rval: REAL;
lrval: LONGREAL;
BEGIN
m := LEN(refs^); mode := refs[i]; INC(i);
WHILE (i < m) & (mode >= 1X) & (mode <= 3X) DO
type := ORD(refs[i]); INC(i); etc := FALSE;
IF type > 80H THEN
IF type = 83H THEN type := 15 ELSE DEC(type, 80H) END;
GetNum(refs, i, n)
ELSIF (type = 16H) OR (type = 1DH) THEN
GetNum(refs, i, tdadr); n := 1
ELSE
IF type = 15 THEN n := MaxString ELSE n := 1 END
END;
GetNum(refs, i, tmp1); adr := tmp1;
tw.SetFontColor(00BF00FFH);
w.Char(9X); ch := refs[i]; INC(i);
WHILE ch # 0X DO w.Char(ch); ch := refs[i]; INC(i) END;
tw.SetFontColor(WMGraphics.Black);
w.String(" = ");
tw.SetFontColor(WMGraphics.Blue);
INC(adr, base);
IF n = 0 THEN
SYSTEM.GET(adr+4, n)
END;
IF type = 15 THEN
IF n > MaxString THEN etc := TRUE; n := MaxString END
ELSE
IF n > MaxArray THEN etc := TRUE; n := MaxArray END
END;
IF mode # 1X THEN SYSTEM.GET(adr, adr) END;
IF (adr >= -4) & (adr < 4096) THEN
w.String("NIL reference ("); w.Hex( adr,0); w.String("H )")
ELSE
IF type = 15 THEN
w.Char(22X);
LOOP
IF n = 0 THEN EXIT END;
SYSTEM.GET(adr, ch); INC(adr);
IF (ch < " ") OR (ch > "~") THEN EXIT END;
w.Char(ch); DEC(n)
END;
w.Char(22X); etc := (ch # 0X)
ELSE
CASE type OF
1..4: size := 1
|5: size := 2
|6..7,9,13,14,29: size := 4
|8, 16: size := 8
|22: size := 0; ASSERT(n <= 1)
ELSE
w.String("bad type "); w.Int(type, 1); n := 0
END;
WHILE n > 0 DO
CASE type OF
1,3:
SYSTEM.GET(adr, ch);
IF (ch > " ") & (ch <= "~") THEN w.Char(ch)
ELSE w.Hex( ORD(ch), 0); w.Char("X")
END
|2:
SYSTEM.GET(adr, ch);
IF ch = 0X THEN w.String("FALSE")
ELSIF ch = 1X THEN w.String("TRUE")
ELSE w.Int(ORD(ch), 1)
END
|4:
SYSTEM.GET(adr, sval); w.Int( sval, 1)
|5:
SYSTEM.GET(adr, ival); w.Int( ival, 1)
|6:
SYSTEM.GET(adr, lval); w.Int( lval, 1)
|7:
SYSTEM.GET(adr, rval); w.RawReal(rval)
|8:
SYSTEM.GET(adr, lrval); w.RawLReal(lrval)
|9:
SYSTEM.GET(adr, set); w.Set(set)
|13, 29:
SYSTEM.GET(adr, lval); w.Hex( lval, 0); w.Char("H")
|14:
SYSTEM.GET(adr, lval);
IF lval = 0 THEN w.String("NIL")
ELSE WriteProc(Modules.ThisModuleByAdr(lval), lval, -1, tmp, tmp1, tmp2, w)
END
|16:
w.Hex( SYSTEM.GET32(adr+4), 0);
w.Hex( SYSTEM.GET32(adr), 0)
|22:
w.Hex( tdadr, 0); w.Char("H")
END;
DEC(n); INC(adr, size);
IF n > 0 THEN w.String(", ") END
END
END
END;
IF etc THEN w.String(" ...") END;
w.Ln();
IF i < m THEN mode := refs[i]; INC(i) END
END;
tw.SetFontColor(WMGraphics.Black);
END Variables;
PROCEDURE FindProc(refs: Bytes; ofs: SYSTEM.ADDRESS): LONGINT;
VAR i, m, t, proc: LONGINT; ch: CHAR;
BEGIN
proc := -1; i := 0; m := LEN(refs^);
ch := refs[i]; INC(i);
WHILE (i < m) & ((ch = 0F8X) OR (ch = 0F9X)) DO
GetNum(refs, i, t);
IF t > ofs THEN
ch := 0X
ELSE
IF ch = 0F9X THEN
GetNum(refs, i, t);
INC(i, 3)
END;
proc := i;
REPEAT ch := refs[i]; INC(i) UNTIL ch = 0X;
IF i < m THEN
ch := refs[i]; INC(i);
WHILE (i < m) & (ch >= 1X) & (ch <= 3X) DO
ch := refs[i]; INC(i);
IF (ch >= 81X) OR (ch = 16X) OR (ch = 1DX) THEN
GetNum(refs, i, t)
END;
GetNum(refs, i, t);
REPEAT ch := refs[i]; INC(i) UNTIL ch = 0X;
IF i < m THEN ch := refs[i]; INC(i) END
END
END
END
END;
IF (proc = -1) & (i # 0) THEN proc := i END;
RETURN proc
END FindProc;
PROCEDURE WriteProc(mod: Modules.Module; pc, fp: SYSTEM.ADDRESS; VAR refs: Bytes; VAR refpos: LONGINT; VAR base: SYSTEM.ADDRESS; w: Streams.Writer);
VAR ch: CHAR;
BEGIN
refpos := -1;
IF mod = NIL THEN
w.String("Unknown PC ="); w.Hex(pc,0); w.Char("H");
IF fp # -1 THEN
w.String(" EBP ="); w.Hex(fp, 0); w.Char("H")
END
ELSE
w.String(mod.name);
DEC(pc, SYSTEM.ADR(mod.code[0]));
refs := SYSTEM.VAL(Bytes, mod.refs);
IF (refs # NIL) & (LEN(mod.refs) # 0) THEN
refpos := FindProc(refs, pc);
IF refpos # -1 THEN
w.Char(".");
ch := refs[refpos]; INC(refpos);
IF ch = "$" THEN base := mod.sb ELSE base := fp END;
WHILE ch # 0X DO w.Char(ch); ch := refs[refpos]; INC(refpos) END
END
END;
w.String(" PC = "); w.Address(pc)
END
END WriteProc;
PROCEDURE GetNum(refs: Bytes; VAR i, num: LONGINT);
VAR n, s: LONGINT; x: CHAR;
BEGIN
s := 0; n := 0; x := refs[i]; INC(i);
WHILE ORD(x) >= 128 DO
INC(n, ASH(ORD(x) - 128, s)); INC(s, 7); x := refs[i]; INC(i)
END;
num := n + ASH(ORD(x) MOD 64 - ORD(x) DIV 64 * 64, s)
END GetNum;
BEGIN {ACTIVE}
LOOP
BEGIN {EXCLUSIVE}
AWAIT(refreshOn);
END;
Refresh(NIL, NIL);
timer.Sleep(interval)
END;
END StateWindow;
TYPE WinCollection = POINTER TO ARRAY OF StateWindow;
VAR
stateWins: WinCollection;
nrWins: LONGINT;
PROCEDURE Remove(stateWin: StateWindow);
VAR
i, j: LONGINT;
wins: WinCollection;
BEGIN {EXCLUSIVE}
i := 0;
WHILE (i < LEN(stateWins)) & (stateWins[i] # stateWin) DO
INC(i)
END;
IF stateWins[i] = stateWin THEN
NEW(wins, LEN(stateWins) - 1);
FOR j := 0 TO i - 1 DO
wins[j] := stateWins[j];
END;
FOR j := i + 1 TO LEN(stateWins) - 1 DO
wins[j-1] := stateWins[j];
END;
DEC(nrWins);
stateWins := wins;
ELSE
END;
END Remove;
PROCEDURE Open*(context : Commands.Context);
VAR
interval, i: LONGINT;
name: Modules.Name;
wins: WinCollection;
stateWin: StateWindow;
BEGIN
context.arg.SkipWhitespace; context.arg.String(name);
context.arg.SkipWhitespace; context.arg.Int(interval, FALSE);
IF interval < 1 THEN interval := 2000 END;
NEW(stateWin, "Module State", interval, name);
INC(nrWins);
BEGIN {EXCLUSIVE}
IF stateWins = NIL THEN
NEW(stateWins, 1);
stateWins[0] := stateWin;
ELSE
NEW(wins, LEN(stateWins) + 1);
FOR i := 0 TO LEN(stateWins) - 1 DO
wins[i] := stateWins[i];
END;
wins[LEN(stateWins)] := stateWin;
stateWins := wins;
END;
END;
END Open;
END WMModuleState.
SystemTools.Free WMModuleState ~
WMModuleState.Open ~