<> <> <> 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]]]; < 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; <> <> <> <> <> <> <> <> <> <> <>> <> <> <> <> <> <> <<<< link =>>> <> <> <> <> <<>>>> <>> <> <> <> <> < AppendString[s, "none[]"];>> <> <<>> <> 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.