CDebugStack.mesa
Edited by Sweet, 9-Jul-83 0:06:50
Sweet June 11, 1986 10:41:57 am PDT
DIRECTORY
CDebugDefs USING [CDCopyRead, GetFrameName, Handle, StackBottom, StackState],
CodeDefs USING [CCNull, codeType, StackIndex, StackItem, StackNull],
IO USING [PutF, PutRope, RopeFromROS, ROS, STREAM],
RESOut USING [
Complain, PCr, PDecimal, PNext, PNextNull,
PNull, PRope],
Rope USING [ROPE],
STDebugDefs USING [ShowLinks, TableBase],
Symbols USING [ContextLevel, lZ],
Table USING [Base];
CDebugStack: PROGRAM
IMPORTS CDebugDefs, IO, RESOut, STDebugDefs
EXPORTS CDebugDefs =
BEGIN OPEN CodeDefs, CDebugDefs, RESOut;
ROPE: TYPE = Rope.ROPE;
Handle: TYPE = CDebugDefs.Handle;
PutStackState: PUBLIC PROCEDURE [h: Handle] =
BEGIN OPEN CodeDefs;
sip: StackIndex;
sir: StackItem;
cb: Table.Base = STDebugDefs.TableBase[h, codeType];
first: BOOLEAN ← TRUE;
name: ROPE;
PCr[h];
PRope[h, "Stack["]; PRope[h, IF StackState[h] THEN "ON" ELSE "OFF"];
PRope[h, "]: "];
sip ← StackBottom[h];
IF sip = StackNull THEN {PRope[h, "empty"]; RETURN};
WHILE sip # StackNull DO
ros: IO.STREAM ← IO.ROS[]; -- should reuse instead of get new inside loop
CDCopyRead[h: h, to: @sir, from: @cb[sip], nwords: SIZE[StackItem]];
ros.PutF["(%d) ", [cardinal[LONG[LOOPHOLE[sip, CARDINAL]]]]];
WITH sir SELECT FROM
mark => ros.PutRope["Mark"];
onStack => ros.PutRope["OnStk"];
inTemp => GetFrameName[h: h, s: ros, level: tLevel, wd: tOffset, wSize: 1];
inLink => ros.PutF["LK %d", [cardinal[link]]];
const => ros.PutF["=%d=", [cardinal[bb.value]]];
ENDCASE;
name ← ros.RopeFromROS[];
IF first THEN {PRope[h, name]; first ← FALSE}
ELSE PNext[h, name];
sip ← sir.uplink;
ENDLOOP;
END;
lastSti: StackIndex ← StackNull;
PutAsStack: PUBLIC PROCEDURE [h: Handle, sti: StackIndex] =
BEGIN
sir: StackItem;
cb: Table.Base = STDebugDefs.TableBase[h, codeType];
ros: IO.STREAM ← IO.ROS[];
name: ROPE;
IF sti = StackNull THEN RETURN;
h.lastSti ← sti;
CDCopyRead[h: h, to: @sir, from: @cb[sti], nwords: SIZE[StackItem]];
PCr[h];
PRope[h, "cb["]; PDecimal[h, LOOPHOLE[sti]]; PRope[h, "] - "];
IF sir.free THEN PRope[h, "FREE!"]
ELSE
WITH sir SELECT FROM
mark =>
BEGIN
PRope[h, "mark - label: "];
PNull[h, label, CCNull];
END;
onStack =>
BEGIN
PRope[h, "onStack"];
IF alsoLink THEN ros.PutF["LK %d", [cardinal[tOffset]]]
ELSE IF tLevel # Symbols.lZ THEN
GetFrameName[h: h, s: ros, level: tLevel, wd: tOffset, wSize: 1]
ELSE GO TO noBackup;
name ← ros.RopeFromROS[];
PNext[h, name];
EXITS
noBackup => NULL;
END;
inTemp =>
BEGIN
PRope[h, "offStack"];
GetFrameName[h: h, s: ros, level: tLevel, wd: tOffset, wSize: 1];
name ← ros.RopeFromROS[];
PNext[h, name];
END;
inLink =>
BEGIN
PRope[h, "offStack"];
ros.PutF["LK %d", [cardinal[link]]];
name ← ros.RopeFromROS[];
PNext[h, name];
END;
ENDCASE;
IF STDebugDefs.ShowLinks[h] THEN
BEGIN
PNextNull[h, "downlink", sir.downlink, StackNull];
PNextNull[h, "uplink", sir.uplink, StackNull];
END;
END;
GetBackup: PUBLIC PROC [h: Handle, s: LONG STRING, backup: StackBackup] =
BEGIN OPEN String;
Alias: PROCEDURE [wd: CARDINAL, lvl: Symbols.ContextLevel] =
BEGIN OPEN String;
AppendString[s, " ("];
GetFrameName[s: s, wd: wd, level: lvl, wSize: 1];
AppendChar[s, ')];
END;
s.length ← 0;
WITH bb: backup SELECT FROM
frame =>
BEGIN
AppendString[s, "frame[tOff:"]; AppendDecimal[s, bb.tOffset];
AppendString[s, ", tLvl:"]; AppendDecimal[s, bb.tLevel];
AppendChar[s, ']];
Alias[bb.tOffset, bb.tLevel];
END;
<< link =>
BEGIN
AppendString[s, "link["]; AppendDecimal[s, bb.link];
AppendChar[s, ']];
END;
>>
const =>
BEGIN
AppendString[s, "const["]; AppendDecimal[s, bb.value];
AppendChar[s, ']];
END;
none => AppendString[s, "none[]"];
ENDCASE;
END;
PutStackDown: PUBLIC PROCEDURE [h: Handle] =
BEGIN
sir: StackItem;
cb: Table.Base = STDebugDefs.TableBase[h, codeType];
IF h.lastSti = StackNull THEN GO TO invalid;
CDCopyRead[h: h, to: @sir, from: @cb[h.lastSti], nwords: SIZE[StackItem]];
IF sir.free THEN GO TO invalid
ELSE PutAsStack[h, sir.downlink];
EXITS
invalid => RESOut.Complain[h, "no valid last stack index"];
END;
PutStackUp: PUBLIC PROCEDURE [h: Handle] =
BEGIN
sir: StackItem;
cb: Table.Base = STDebugDefs.TableBase[h, codeType];
IF lastSti = StackNull THEN GO TO invalid;
CDCopyRead[h: h, to: @sir, from: @cb[h.lastSti], nwords: SIZE[StackItem]];
IF sir.free THEN GO TO invalid
ELSE PutAsStack[h, sir.uplink];
EXITS
invalid =>
RESOut.Complain[h, "no valid last stack index"];
END;
END.