Cedar Debugger: global control and access to process facilities
DebugTool.mesa
Andrew Birrell, October 25, 1983 12:37 pm
Russ Atkinson, April 6, 1983 11:54 pm
Paul Rovner, April 14, 1983 3:53 pm
DIRECTORY
AMEvents USING[ BootedNotifier, Kill, StopEvents, GetEvents, RegisterBootedNotifier, Screen, UnRegisterBootedNotifier ],
AMModel
USING[ Class, Context, ContextClass, ContextChildren, ContextName, ContextWorld,
MostRecentNamedContext, RootContext],
AMProcess USING[ Adjust, CallDebugger, Freeze, GetProcesses, GetState, Name, Process, PSBIToTV, State, Thaw, TVToPSBI],
AMTypes USING[ DynamicParent, Error, TV],
Atom USING[ GetPName ],
Buttons USING[ Button, ButtonProc, Create, Destroy, ReLabel, SetDisplayStyle ],
Commander USING[ CommandProc, Register ],
Containers USING[ ChildXBound, ChildYBound, Create ],
IO USING[ EndOf, EndOfStream, Error, GetInt, GetTokenRope, PutChar, PutF, PutRope, RIS, RopeFromROS, ROS, STREAM, Value ],
Labels USING[ Create ],
MBQueue USING[ Create, CreateButton, Flush, Queue, QueueClientAction ],
Process USING[ Abort, Detach ],
PrincOps USING[ PsbIndex ],
PrintTV USING[ Print, PrintArguments, PrintResults, PrintVariables ],
Rope USING[ Cat, Equal, Length, ROPE ],
Rules USING[ Create ],
TypeScript USING[ Create ],
ViewerClasses USING[ Viewer ],
ViewerEvents USING[ EventProc, RegisterEventProc ],
ViewerIO USING[ CreateViewerStreams ],
ViewerOps USING[ DestroyViewer, OpenIcon, PaintViewer, SetOpenHeight ],
ViewerTools USING[ GetContents, MakeNewTextViewer, SetContents, SetSelection],
WorldVM USING[ BadWorld, CurrentIncarnation, GetWorld, Incarnation, LocalWorld, LookupFailed, OtherWorld, World ];
DebugTool:
CEDAR
MONITOR
IMPORTS AMEvents, AMModel, AMProcess, AMTypes, Atom, Buttons, Commander, Containers, IO, Labels, MBQueue, Process, PrintTV, Rope, Rules, TypeScript, ViewerEvents, ViewerIO, ViewerOps, ViewerTools, WorldVM =
BEGIN
-- ******** Creation/Finding viewer for particular world ******** --
Maintains at most one viewer for any world (destroying extras). There are two interfaces:
buttons in an existing viewer, or userExec command line.
The synchronization is messy - it needs a rework someday.
local: ATOM = $Local;
outload: ATOM = $Outload;
remote: ATOM = $Remote;
Debug: Commander.CommandProc = {
[cmd: Commander.Handle]
arg: Rope.ROPE = cmd.commandLine;
in: IO.STREAM = IO.RIS[arg];
token: Rope.ROPE ← NIL;
token ← in.GetTokenRope[ ! IO.EndOfStream => CONTINUE].token;
IF token.Length[] = 0 THEN token ← Atom.GetPName[local];
GetWorldViewer[
class:
SELECT
TRUE
FROM
token.Equal[Atom.GetPName[local],FALSE] => local,
token.Equal[Atom.GetPName[outload],FALSE] => outload,
ENDCASE => remote,
worldName: token,
prev: NIL];
};
ChangeWorld: SelectorNotifier =
TRUSTED {
d: MyData = NARROW[clientData];
IF d.processes # NIL AND NOT DoThaw[d]
THEN RETURN[FALSE]
ELSE
BEGIN
UnWorld[d]; -- so nobody else expects us to have that world --
GetWorldViewer[
class: value,
worldName:
SELECT value
FROM
local => Atom.GetPName[local],
outload => Atom.GetPName[outload],
ENDCASE => ViewerTools.GetContents[d.hostT],
prev: d];
RETURN[TRUE]
END;
};
GetWorldViewer:
PROC[class:
ATOM, worldName: Rope.
ROPE, prev: MyData] = {
d: MyData;
new: BOOL;
[d, new] ← CheckExisting[worldName, prev];
d.class ← class;
IF new
THEN
IF d = prev
THEN SetWorld[d]
ELSE CreateForWorld[d]
ELSE ViewerOps.OpenIcon[d.self];
};
viewers: LIST OF MyData ← NIL;
FindViewer:
ENTRY
PROC[viewer: ViewerClasses.Viewer]
RETURNS[d: MyData] =
BEGIN
FOR old: LIST OF MyData ← viewers, old.rest UNTIL old = NIL
DO IF old.first.self = viewer THEN RETURN[old.first] ENDLOOP;
RETURN[NIL]
END;
CheckExisting:
ENTRY
PROC [worldName: Rope.
ROPE, prev: MyData]
RETURNS[found: MyData, new: BOOL] = TRUSTED {
FOR old: LIST OF MyData ← viewers, old.rest UNTIL old = NIL
DO
IF
NOT old.first.self.destroyed
AND worldName.Equal[old.first.worldName,
FALSE]
THEN {
found ← old.first;
new ← FALSE;
EXIT
};
REPEAT
FINISHED =>
BEGIN
IF prev # NIL
THEN { found ← prev; found.worldName ← worldName; found.world ← NIL }
ELSE {
found ← NEW[MyDataObject ← [worldName: worldName]];
found.action ← NEW[ProcessActions ← ALL[FALSE]];
viewers ← CONS[first: found, rest: viewers];
};
new ← TRUE;
END
ENDLOOP;
IF prev # NIL AND found # prev
THEN Process.Detach[FORK ViewerOps.DestroyViewer[prev.self]];
};
DestroyProc: ViewerEvents.EventProc =
TRUSTED {
PROC [viewer: ViewerClasses.Viewer, event: ViewerEvents.ViewerEvent]
d: MyData = FindViewer[viewer];
IF d # NIL
THEN
BEGIN
MBQueue.Flush[d.mbQueue];
StopFinding[d];
MBQueue.QueueClientAction[d.mbQueue, UnWorld, d];
END;
};
GiveUpFinding: Buttons.ButtonProc = TRUSTED
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
-- NOTE: this button is not serialized with d.mbQueue, but with the Viewers notifier --
BEGIN
d: MyData = NARROW[clientData];
MBQueue.Flush[d.mbQueue];
StopFinding[d];
MBQueue.QueueClientAction[d.mbQueue, UnWorld, d];
END;
UnWorld:
PROC[clientData:
REF
ANY] =
TRUSTED
BEGIN
d: MyData = NARROW[clientData];
d.worldName ← NIL; -- should be inside the monitor, really --
IF d.finding THEN ERROR;
AMEvents.UnRegisterBootedNotifier[BootedNotifier, d.world, d];
IF d.class = remote
THEN AMEvents.StopEvents[d.world];
END;
SetWorld:
PROC[d: MyData] =
TRUSTED {
worldName: Rope.ROPE = d.worldName;
d.self.name ← Rope.Cat["Debug ", worldName];
ViewerOps.PaintViewer[d.self, caption];
SELECT d.class
FROM
local => d.out.PutRope["\n\nPreparing to debug local world ..."];
outload => d.out.PutRope["\n\nOpening debuggee outload file ..."];
ENDCASE => d.out.PutF["\n\nConnecting to remote debuggee \"%g\" ... ", [rope[worldName]] ];
IF StartFinding[d] -- Fork it, so that it can be aborted --
THEN
BEGIN
IF d.class = remote
THEN
BEGIN
giveUpButton: ViewerClasses.Viewer = Buttons.Create[
info: [name: "Click here to give up connection attempt", parent: d.self, border:
TRUE,
wy: d.kidsY+d.buttH, wx: d.maxW],
proc: GiveUpFinding,
clientData: d,
fork: FALSE];
d.world ← JOIN d.finder;
ViewerOps.DestroyViewer[giveUpButton];
END
ELSE d.world ← JOIN d.finder;
END;
IF NOT d.self.destroyed
THEN {
IF d.world = NIL
THEN {
SELECT d.class
FROM
local => d.out.PutRope["failed!"];
outload => d.out.PutRope["there is no outloaded debuggee"];
remote => d.out.PutF["can't contact \"%g\"", [rope[worldName]] ];
ENDCASE => ERROR;
}
ELSE {
d.out.PutRope["ok"];
d.rootContext ← AMModel.RootContext[d.world];
AMEvents.RegisterBootedNotifier[proc: BootedNotifier, world: d.world, clientData: d];
};
};
};
StartFinding:
ENTRY
PROC[d: MyData]
RETURNS[
BOOL] =
TRUSTED
BEGIN
IF d.self.destroyed THEN RETURN[FALSE]; -- else don't do it: we wouldn't get aborted --
d.finder ← FORK Finder[d]; d.finding ← TRUE;
RETURN[TRUE]
END;
StopFinding:
ENTRY
PROC[d: MyData] =
TRUSTED
{ IF d.finding THEN Process.Abort[d.finder] };
Found:
ENTRY
PROC[d: MyData] =
{ d.finding ← FALSE };
Finder:
PROC[d: MyData]
RETURNS[world: WorldVM.World ← NIL] =
TRUSTED{
world ← WorldVM.GetWorld[d.worldName
! WorldVM.LookupFailed, WorldVM.BadWorld, ABORTED => CONTINUE];
IF world # NIL
THEN AMEvents.GetEvents[world, NIL, NIL ! ABORTED => { world ← NIL; CONTINUE }];
Found[d];
};
-- ******** Commands for viewer watching particular world ******** --
FreezeAll: Buttons.ButtonProc = TRUSTED {
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
d: MyData = NARROW[clientData];
IF d.rootContext # NIL AND d.world # WorldVM.LocalWorld[]
THEN
BEGIN
d.out.PutRope["\n\nFreeze all processes ... "];
Merge[d, AMProcess.GetProcesses[LIST[d.rootContext]]];
END
ELSE d.out.PutRope["\n\nYou don't really want to freeze the entire local world!"];
};
FreezeReady: Buttons.ButtonProc = TRUSTED {
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
d: MyData = NARROW[clientData];
IF d.rootContext # NIL AND d.world # WorldVM.LocalWorld[]
THEN
BEGIN
states: LIST OF AMProcess.State;
SELECT
TRUE
FROM
shift, control =>
BEGIN
states ← LIST[waitingML, frameFault, pageFault, writeProtectFault, unknownFault];
d.out.PutRope["\n\nFreeze \"waitingML\" and \"faulted\" processes ... "];
END;
ENDCASE =>
BEGIN
states ← LIST[ready];
d.out.PutRope["\n\nFreeze \"ready\" processes ... "];
END;
Merge[d, AMProcess.GetProcesses[LIST[d.rootContext], states]];
END
ELSE d.out.PutRope["\n\nYou don't really want to freeze the entire local world!"];
};
FreezePSBI: Buttons.ButtonProc = TRUSTED {
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
d: MyData = NARROW[clientData];
IF d.rootContext # NIL
THEN
BEGIN
psbiRope: Rope.ROPE = ViewerTools.GetContents[d.psbiT];
in: IO.STREAM = IO.RIS[psbiRope];
psbi: INT = in.GetInt[! IO.EndOfStream, IO.Error => GOTO bad];
IF NOT in.EndOf[] OR psbi NOT IN [ FIRST[PrincOps.PsbIndex] .. LAST[PrincOps.PsbIndex] ]
THEN GOTO bad
ELSE
BEGIN
p: AMProcess.Process = AMProcess.PSBIToTV[d.world, psbi];
d.out.PutF["\n\nFreeze process %b ... ", [integer[psbi]] ];
AMProcess.Freeze[LIST[p], LIST[d.rootContext]];
Merge[d, LIST[p]];
END;
EXITS bad => d.out.PutRope["\n\nNot a valid PSB index!"]
END
ELSE d.out.PutRope["\n\nNo world!"];
};
FreezeContext: Buttons.ButtonProc = TRUSTED {
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
d: MyData = NARROW[clientData];
CheckContext[d];
IF d.context # NIL
THEN
BEGIN
IF (d.world # WorldVM.LocalWorld[] OR AMModel.ContextClass[d.context.first] # world)
THEN
BEGIN
new: LIST OF AMProcess.Process;
d.out.PutF["\n\nFreeze processes inside \"%g\" ... ", [rope[d.contextName]] ];
new ← AMProcess.GetProcesses[d.context];
IF mouseButton = blue THEN AMProcess.Adjust[new, LIST[d.rootContext]];
Merge[d, new];
END
ELSE d.out.PutRope["\n\nYou don't really want to freeze the entire local world!"];
END;
};
Merge:
PROC[d: MyData, new:
LIST
OF AMProcess.Process] =
TRUSTED
BEGIN
newOne: LIST OF AMProcess.Process ← new;
oldOne: LIST OF AMProcess.Process ← d.processes;
prevOld: LIST OF AMProcess.Process ← NIL;
first: BOOL ← TRUE;
d.out.PutRope["additional frozen processes: "];
-- Merge in new processes. Assumes both lists are sorted --
DO oldBits:
CARDINAL =
IF oldOne =
NIL
THEN LAST[CARDINAL]
ELSE AMProcess.TVToPSBI[oldOne.first].psbi;
newBits: CARDINAL;
IF newOne = NIL THEN EXIT;
newBits ← AMProcess.TVToPSBI[newOne.first].psbi;
SELECT
TRUE
FROM
newBits < oldBits =>
{
this: LIST OF AMProcess.Process = newOne;
IF first THEN first ← FALSE ELSE d.out.PutRope[", "];
d.out.PutF["%b", [integer[newBits]] ];
newOne ← newOne.rest;
this.rest ← oldOne;
IF prevOld = NIL
THEN d.processes ← this
ELSE prevOld.rest ← this;
prevOld ← this;
};
newBits = oldBits =>
newOne ← newOne.rest;
newBits > oldBits =>
{ prevOld ← oldOne; oldOne ← oldOne.rest };
ENDCASE => ERROR;
ENDLOOP;
IF first THEN d.out.PutRope["none"];
CreateButtons[d];
END;
BootedNotifier: AMEvents.BootedNotifier = {
PROC[world: WorldVM.World, clientData: REF]
d: MyData = NARROW[clientData];
MBQueue.Flush[d.mbQueue];
StopFinding[d];
MBQueue.QueueClientAction[d.mbQueue, CleanupButtons, d];
};
CleanupButtons:
PROC[clientData:
REF
ANY] =
TRUSTED
BEGIN
d: MyData = NARROW[clientData];
d.out.PutRope["\n\n~~~~~~ End of session ~~~~~~"];
d.processes ← NIL;
d.action ← NEW[ProcessActions ← ALL[FALSE]];
CreateButtons[d];
END;
ThawAll: Buttons.ButtonProc =
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
{ [] ← DoThaw[clientData] };
DoThaw:
PROC[clientData:
REF
ANY]
RETURNS[
BOOL] =
TRUSTED {
d: MyData = NARROW[clientData];
count: INT = CountActions[d];
d.out.PutRope["\n\nThaw all processes ... "];
IF count # 0
THEN d.out.PutF["there are still %g action areas for frozen processes", [integer[count]] ]
ELSE
BEGIN
AMProcess.Thaw[d.processes];
d.processes ← NIL;
CreateButtons[d];
d.out.PutRope["done"];
END;
RETURN[count=0]
};
ListLoadstate: Buttons.ButtonProc = TRUSTED
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
BEGIN
d: MyData = NARROW[clientData];
Enum:
PROC[c: AMModel.Context]
RETURNS[stop:
BOOL ←
FALSE] =
TRUSTED
BEGIN
d.out.PutChar['\n];
d.out.PutRope[AMModel.ContextName[c]];
END;
d.out.PutRope["\n\nLoadstate:"];
[] ← AMModel.ContextChildren[d.rootContext, Enum];
d.out.PutRope["\nEnd of loadstate"];
END;
ListContext: Buttons.ButtonProc = TRUSTED
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
BEGIN
d: MyData = NARROW[clientData];
level: INT ← 0;
Enum:
PROC[c: AMModel.Context]
RETURNS[stop:
BOOL ←
FALSE] =
TRUSTED
BEGIN
class: AMModel.Class = AMModel.ContextClass[c];
d.out.PutChar['\n];
THROUGH [1..level] DO d.out.PutRope[" "] ENDLOOP;
d.out.PutRope[AMModel.ContextName[c]];
IF class = model
THEN { level ← level+1; [] ← AMModel.ContextChildren[c, Enum]; level ← level-1 };
END;
CheckContext[d];
IF d.context # NIL
THEN
BEGIN
d.out.PutF["\n\nContext \"%g\":", [rope[d.contextName]] ];
IF AMModel.ContextClass[d.context.first] = prog
THEN [] ← Enum[d.context.first]
ELSE [] ← AMModel.ContextChildren[d.context.first, Enum];
d.out.PutRope["\nEnd of context"];
END;
END;
UserScreen: Buttons.ButtonProc = TRUSTED
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
BEGIN
d: MyData = NARROW[clientData];
Process .Detach[FORK AMEvents.Screen[d.world] ];
END;
Continue: Buttons.ButtonProc = TRUSTED
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
BEGIN
d: MyData = NARROW[clientData];
d.out.PutRope["\n\nNot implemented"];
END;
Kill: Buttons.ButtonProc = TRUSTED
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
BEGIN
d: MyData = NARROW[clientData];
Process.Detach[FORK AMEvents.Kill[d.world] ];
END;
Stop: Buttons.ButtonProc = TRUSTED
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
BEGIN
d: MyData = NARROW[clientData];
d.stopCount ← d.stopCount + 1;
END;
ProcessRec: TYPE = RECORD[d: MyData, p: AMProcess.Process, button: Buttons.Button];
ThawThis: Buttons.ButtonProc = TRUSTED {
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
pData: REF ProcessRec = NARROW[clientData];
d: MyData = pData.d;
IF CheckAction[d.action, pData]
THEN
BEGIN
ENABLE UNWIND => EndAction[d.action, pData];
AMProcess.Thaw[LIST[pData.p]];
Buttons.ReLabel[pData.button, "thawed"];
EndAction[d.action, pData];
END
ELSE d.out.PutF["\n\n%g still has an action area", [rope[AMProcess.Name[pData.p]]] ];
};
AdjustThis: Buttons.ButtonProc = TRUSTED {
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
pData: REF ProcessRec = NARROW[clientData];
d: MyData = pData.d;
IF CheckAction[d.action, pData]
THEN
BEGIN
ENABLE UNWIND => EndAction[d.action, pData];
IF mouseButton = blue
THEN
BEGIN
AMProcess.Adjust[LIST[pData.p], LIST[d.rootContext]];
Buttons.ReLabel[pData.button, ProcessLabel[pData.p].label];
END
ELSE
BEGIN
CheckContext[d];
IF d.context # NIL
THEN
BEGIN
AMProcess.Adjust[LIST[pData.p], d.context];
Buttons.ReLabel[pData.button, ProcessLabel[pData.p].label];
END;
END;
EndAction[d.action, pData];
END
ELSE d.out.PutF["\n\n%g still has an action area", [rope[AMProcess.Name[pData.p]]] ];
};
DebugThis: Buttons.ButtonProc = TRUSTED {
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
pData: REF ProcessRec = NARROW[clientData];
d: MyData = pData.d;
label: Rope.ROPE;
stack: AMTypes.TV;
[label, stack] ← ProcessLabel[pData.p]; Buttons.ReLabel[pData.button, label];
IF mouseButton = blue
THEN
BEGIN
IF CheckAction[d.action, pData]
THEN Process.Detach[FORK DoAction[d.action, pData] ]
ELSE d.out.PutF["\n\n%g already has an action area", [rope[AMProcess.Name[pData.p]]] ];
END
ELSE {
d.out.PutF["\n\n%g:", [rope[AMProcess.Name[pData.p]]] ];
Process.Detach[FORK PutStack[d, stack, FALSE --mouseButton=yellow??--] ];
};
};
CountActions:
ENTRY
PROC[d: MyData]
RETURNS[count:
INT ← 0] =
BEGIN
FOR psbi: PrincOps.PsbIndex IN PrincOps.PsbIndex
DO IF d.action[psbi] THEN count ← count+1 ENDLOOP;
END;
CheckAction:
ENTRY
PROC[action:
REF ProcessActions, pData:
REF ProcessRec]
RETURNS[
BOOL] =
TRUSTED
BEGIN
psbi: PrincOps.PsbIndex = AMProcess.TVToPSBI[pData.p].psbi;
IF action[psbi] THEN RETURN[FALSE] ELSE { action[psbi] ← TRUE; RETURN[TRUE] }
END;
EndAction:
ENTRY
PROC[action:
REF ProcessActions, pData:
REF ProcessRec] =
TRUSTED
{ action[AMProcess.TVToPSBI[pData.p].psbi] ← FALSE };
DoAction:
PROC[action:
REF ProcessActions, pData:
REF ProcessRec] =
TRUSTED
BEGIN
ENABLE UNWIND => EndAction[action, pData];
Buttons.SetDisplayStyle[pData.button, $WhiteOnBlack];
AMProcess.CallDebugger[pData.p, ProcessLabel[pData.p].label];
Buttons.SetDisplayStyle[pData.button, $BlackOnWhite];
EndAction[action, pData];
END;
ProcessLabel:
PROC[p: AMProcess.Process]
RETURNS[label: Rope.
ROPE, stack: AMTypes.
TV] =
TRUSTED {
str: IO.STREAM = IO.ROS[];
state: AMProcess.State;
faultData: LONG CARDINAL;
priority: [0..7];
topFrame: BOOL;
[state, faultData, priority, stack, topFrame] ← AMProcess.GetState[p];
IF stack = NIL THEN str.PutF["no frozen frame"] ELSE PrintTV.Print[stack, str];
str.PutF[IF topFrame THEN ", %g" ELSE ", (%g)", [rope[StateRope[state]]] ];
IF state IN [frameFault..unknownFault]
THEN str.PutF["[%b]", [cardinal[faultData]] ];
str.PutF[", %g", [integer[priority]]];
label ← str.RopeFromROS[];
};
PutStack:
PROC[d: MyData, top: AMTypes.
TV, vars:
BOOL] =
{
ENABLE UNWIND => d.out.PutRope["\n ~~~ Unwound ~~~"];
out: IO.STREAM ← d.out;
initStopCount: INT ← d.stopCount;
FOR this: AMTypes.TV ← top, AMTypes.DynamicParent[this] UNTIL this = NIL
DO
IF d.stopCount # initStopCount
THEN { out.PutRope["\n ~~~ Display stopped ~~~"]; RETURN };
PutProc[d, this, vars]
ENDLOOP;
out.PutRope["\n ~~~ End of stack ~~~"];
};
PutProc:
PROC[d: MyData, l: AMTypes.
TV, vars:
BOOL] =
{
ENABLE AMTypes.Error =>
{ IO.PutF[d.out, "\nAMTypes.Error[%g]", [rope[msg]] ]; CONTINUE };
out: IO.STREAM ← d.out;
initStopCount: INT ← d.stopCount;
out.PutRope["\n Procedure: "]; PrintTV.Print[l, out];
IF vars
THEN
BEGIN
out.PutRope["\nArgs:\n"]; PrintTV.PrintArguments[l, out];
out.PutRope["\nVars:\n"]; PrintTV.PrintVariables[l, out];
out.PutRope["\nResults:\n"]; PrintTV.PrintResults[l, out];
END;
};
StateRope:
PROC[state: AMProcess.State]
RETURNS[ Rope.
ROPE ] =
{
RETURN[
SELECT state
FROM
ready => "ready",
waitingSV => "waitingSV",
waitingCV => "waitingCV",
waitingML => "waitingML",
frameFault => "frameFault",
pageFault => "pageFault",
writeProtectFault => "writeProtectFault",
unknownFault => "unknownFault",
uncaughtSignal => "uncaughtSignal",
breakpoint => "breakpoint",
callDebugger => "callDebugger",
dead => "dead",
unknown => "unknown",
ENDCASE => "illegal state!"]
};
CheckContext:
PROC[d: MyData] =
TRUSTED {
contextName: Rope.ROPE = ViewerTools.GetContents[d.contextT];
IF NOT Rope.Equal[contextName, d.contextName, FALSE]
OR d.context = NIL
OR d.world # AMModel.ContextWorld[d.context.first]
OR d.contextIncarnation # WorldVM.CurrentIncarnation[d.world]
THEN {
new: AMModel.Context;
d.context ← NIL;
d.contextIncarnation ← WorldVM.CurrentIncarnation[d.world];
new ←
SELECT
TRUE
FROM
d.world = NIL => NIL,
Rope.Length[contextName] = 0 => d.rootContext
ENDCASE => AMModel.MostRecentNamedContext[contextName, d.rootContext];
IF new # NIL
THEN { d.context ← LIST[new]; d.contextName ← contextName };
};
IF d.context = NIL THEN d.out.PutRope["\n\nInvalid context"];
};
-- ******** Viewer management ******** --
MyData: TYPE = REF MyDataObject;
MyDataObject:
TYPE =
MONITORED
RECORD[
in: IO.STREAM,
out: IO.STREAM,
mbQueue: MBQueue.Queue ← NIL,
self,
kids,
hostT,
contextT,
psbiT,
script: ViewerClasses.Viewer ← NIL,
kidsY: INTEGER ← 0,
finding: BOOL ← FALSE,
stopCount: INT ← 0,
finder: PROCESS RETURNS[WorldVM.World] ← NIL,
worldName: Rope.ROPE,
class: ATOM ← local,
value: REF ATOM ← NIL,
world: WorldVM.World ← NIL,
rootContext: AMModel.Context ← NIL,
contextName: Rope.ROPE ← NIL,
contextIncarnation: WorldVM.Incarnation ← 0,
context: LIST OF AMModel.Context ← NIL,
processes: LIST OF AMProcess.Process ← NIL,
action: REF ProcessActions,
pButtons: LIST OF REF ProcessRec ← NIL,
maxW: INTEGER ← 0,
buttH: INTEGER ← 0,
kidsH: INTEGER ← 0];
ProcessActions: TYPE = ARRAY PrincOps.PsbIndex OF BOOL;
CreateForWorld:
PROC[d: MyData] =
BEGIN
d.mbQueue ← MBQueue.Create[];
MBQueue.QueueClientAction[d.mbQueue, ReallyCreate, d];
END;
ReallyCreate:
PROC[clientData:
REF
ANY] =
-- This is a separate procedure so that it is synchronized with d.mbQueue --
Thus, the buttons can't be invoked until we've finished creating them, and called SetWorld.
{
d: MyData = NARROW[clientData];
v: ViewerClasses.Viewer = Containers.Create[
info: [name: "Debug processes", column: left, scrollable: FALSE, iconic: TRUE]];
child: ViewerClasses.Viewer ← NIL;
x: INTEGER ← 1;
y: INTEGER ← 0;
CommandButton:
PROC[name: Rope.
ROPE, proc: Buttons.ButtonProc, data:
REF
ANY,
newline: BOOL, guarded: BOOL ← FALSE] =
{
child ← MBQueue.CreateButton[
q: d.mbQueue,
info: [name: name, parent: v, border:
TRUE,
wy: y, wx: x, ww: d.maxW],
proc: proc,
clientData: data,
fork: TRUE,
paint: TRUE,
guarded: guarded];
x ← IF newline THEN 1 ELSE child.wx + d.maxW - 1;
y ← IF newline THEN child.wy + child.wh - 1 ELSE child.wy;
};
LabelText:
PROC[name, data: Rope.
ROPE, prev: ViewerClasses.Viewer]
RETURNS[ViewerClasses.Viewer] =
{
child ← ViewerTools.MakeNewTextViewer[
info: [parent: v, wh: d.buttH, ww: 999, scrollable:
FALSE,
data: IF prev = NIL THEN data ELSE ViewerTools.GetContents[prev],
border: FALSE,
wx: x + d.maxW + 2, wy: y],
paint: TRUE ];
Containers.ChildXBound[v, child];
[] ← Buttons.Create[
info: [name: name, parent: v, wh: d.buttH,
border: FALSE, wx: x+1, wy: y],
proc: TextLabelProc, clientData: child, fork: FALSE, paint: TRUE];
x ← 1;
y ← child.wy + child.wh - 1;
RETURN[child]
};
Label:
PROC[name: Rope.
ROPE, newline:
BOOL] =
{
child ← Labels.Create[
info: [name: name, parent: v, border:
FALSE,
wy: y, wx: x+1],
paint: TRUE ];
x ← IF newline THEN 1 ELSE child.wx + d.maxW - 1;
y ← IF newline THEN child.wy + child.wh - 1 ELSE child.wy;
};
Rule:
PROC =
{
child ← Rules.Create[
info: [parent: v, border:
FALSE,
wy: y, wx: 0, ww: v.ww, wh: 1],
paint: TRUE ];
Containers.ChildXBound[v, child];
x ← 1;
y ← child.wy + child.wh + 1;
};
d.self ← v;
{
-- kludge to find max button size! --
temp: Buttons.Button = Buttons.Create[
info: [name: "Loadstate:", parent: v, border:
FALSE,
wx: 0, wy: 0],
proc: NIL, clientData: d, fork: FALSE, paint: FALSE];
d.maxW ← temp.ww;
d.buttH ← temp.wh;
Buttons.Destroy[temp];
};
[child, d.value] ← CreateSelector[q: d.mbQueue,
name: "World:", values: LIST[local, outload, remote],
init: NEW[ATOM𡤍.class],
change: ChangeWorld,
clientData: d, viewer: v, x: x, y: y, w: d.maxW];
x ← child.wx + child.ww + 2;
x ← 1 + 5*(d.maxW-1);
d.hostT ← LabelText["Host:",
IF d.class # remote THEN "Remote debuggee host name" ELSE d.worldName,
d.hostT];
Label["Freeze:", FALSE];
CommandButton["All", FreezeAll, d, FALSE];
CommandButton["Ready", FreezeReady, d, FALSE] ;
CommandButton["Process", FreezePSBI, d, FALSE];
CommandButton["Context", FreezeContext, d, FALSE];
d.contextT ← LabelText["Context:", "Module or config name", d.contextT];
Label["Thaw:", FALSE];
CommandButton["All", ThawAll, d, FALSE];
x ← 1 + 5*(d.maxW-1);
d.psbiT ← LabelText["PsbIndex:", "Freezing an explicit process", d.psbiT];
Label["List:", FALSE];
CommandButton["Loadstate", ListLoadstate, d, FALSE];
CommandButton["Context", ListContext, d, FALSE];
x ← 1 + 5*(d.maxW-1);
Label["Control:", FALSE];
CommandButton["Stop", Stop, d, FALSE];
CommandButton["Kill", Kill, d, FALSE, TRUE];
CommandButton["Continue", Continue, d, FALSE];
CommandButton["Screen", UserScreen, d, TRUE];
y ← y + 3;
Rule[];
d.kidsY ← y;
y ← y + (d.kidsH ← 10*(d.buttH-1) + d.buttH/2);
Rule[];
d.script ← TypeScript.Create[
info: [parent: v, wh: v.ch-y, ww: v.cw,
border: FALSE,
wy: y, wx: 0] ];
Containers.ChildXBound[v, d.script];
Containers.ChildYBound[v, d.script];
[in: d.in, out: d.out] ← ViewerIO.CreateViewerStreams[NIL, d.script];
ViewerOps.SetOpenHeight[v, y + 10 * d.buttH];
ViewerOps.OpenIcon[v];
SetWorld[d];
};
CreateButtons:
PROC[d: MyData] =
TRUSTED {
parent: ViewerClasses.Viewer = d.self;
child: ViewerClasses.Viewer ← NIL;
x: INTEGER ← 1;
y: INTEGER ← 1;
CommandButton:
PROC[name: Rope.
ROPE, proc: Buttons.ButtonProc, data:
REF
ANY,
newline: BOOL] = TRUSTED {
child ← MBQueue.CreateButton[
q: d.mbQueue,
info: [name: name, parent: kids, border:
TRUE,
wy: y, wx: x, ww: IF newline THEN kids.cw - x - 2 ELSE d.maxW],
proc: proc,
clientData: data,
fork: TRUE];
x ← IF newline THEN 1 ELSE child.wx + d.maxW - 1;
y ← IF newline THEN child.wy + child.wh - 1 ELSE child.wy;
};
Label:
PROC[name: Rope.
ROPE, newline:
BOOL] =
TRUSTED
{
child ← Labels.Create[
info: [name: name, parent: kids, border:
FALSE,
wy: y, wx: x+1] ];
x ← IF newline THEN 1 ELSE child.wx + d.maxW - 1;
y ← IF newline THEN child.wy + child.wh - 1 ELSE child.wy;
};
kids: ViewerClasses.Viewer = Containers.Create[
info: [parent: parent, border:
FALSE, scrollable:
TRUE,
wx: 0, wy: d.kidsY, ww: parent.cw, wh: d.kidsH] ];
lastButton: LIST OF REF ProcessRec ← NIL;
IF d.kids # NIL THEN ViewerOps.DestroyViewer[d.kids]; d.kids ← kids;
Containers.ChildXBound[parent, kids];
d.pButtons ← NIL;
FOR p: LIST OF AMProcess.Process ← d.processes, p.rest UNTIL p = NIL
DO pData:
REF ProcessRec =
NEW[ProcessRec ← [d, p.first]];
Label[AMProcess.Name[p.first], FALSE];
CommandButton["Adjust", AdjustThis, pData, FALSE];
CommandButton["Thaw", ThawThis, pData, FALSE];
CommandButton[NIL, DebugThis, pData, TRUE];
Containers.ChildXBound[kids, child];
pData.button ← child;
IF lastButton = NIL
THEN d.pButtons ← lastButton ← CONS[first: pData, rest: NIL]
ELSE { lastButton.rest ← CONS[first: pData, rest: NIL]; lastButton ← lastButton.rest };
ENDLOOP;
FOR b: LIST OF REF ProcessRec ← d.pButtons, b.rest UNTIL b = NIL
DO Buttons.ReLabel[b.first.button, ProcessLabel[b.first.p].label] ENDLOOP;
};
TextLabelProc: Buttons.ButtonProc = {
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
text: ViewerClasses.Viewer = NARROW[clientData];
SELECT mouseButton
FROM
red => ViewerTools.SetSelection[text, NIL];
blue => { ViewerTools.SetContents[text, NIL]; ViewerTools.SetSelection[text, NIL] };
yellow => NULL;
ENDCASE => ERROR;
};
Selector: TYPE = REF SelectorRec;
SelectorRec:
TYPE =
RECORD[
value: REF ATOM,
change: SelectorNotifier,
clientData: REF ANY,
buttons: LIST OF Buttons.Button,
values: LIST OF ATOM ];
SelectorNotifier:
TYPE =
PROC[parent: ViewerClasses.Viewer, clientData: REF ANY, value: ATOM] RETURNS[BOOL];
CreateSelector:
PROC[q: MBQueue.Queue,
name: Rope.ROPE,
values: LIST OF ATOM,
init: REF ATOM ← NIL,
change: SelectorNotifier ← NIL,
clientData: REF ANY ← NIL,
viewer: ViewerClasses.Viewer,
x, y: INTEGER,
w: INTEGER ← 0]
RETURNS[child: ViewerClasses.Viewer, value: REF ATOM] = {
selector: Selector ←
NEW[ SelectorRec ←
[value:
IF init #
NIL
THEN init
ELSE
NEW[
ATOM←values.first],
change: change,
clientData: clientData,
buttons: NIL,
values: values ] ];
last: LIST OF Buttons.Button ← NIL;
value ← selector.value;
child ← Labels.Create[
info: [name: name, parent: viewer, border: FALSE, wx: x+1, wy: y, ww: w] ];
FOR a: LIST OF ATOM ← values, a.rest UNTIL a = NIL
DO child ← MBQueue.CreateButton[
q: q,
info: [name: Atom.GetPName[a.first], parent: viewer, border:
TRUE,
wy: child.wy, wx: child.wx + child.ww - 1, ww: w],
proc: SelectorProc,
clientData: selector,
fork: TRUE,
paint: TRUE];
IF last = NIL
THEN last ← selector.buttons ← CONS[first: child, rest: NIL]
ELSE { last.rest ← CONS[first: child, rest: NIL]; last ← last.rest };
IF a.first = selector.value^ THEN Buttons.SetDisplayStyle[child, $WhiteOnBlack];
ENDLOOP;
};
SelectorProc: Buttons.ButtonProc = {
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
self: Buttons.Button = NARROW[parent];
selector: Selector = NARROW[clientData];
buttons: LIST OF Buttons.Button ← selector.buttons;
FOR a: LIST OF ATOM ← selector.values, a.rest UNTIL a = NIL
DO
IF self = buttons.first
THEN
BEGIN
IF selector.change = NIL OR selector.change[self.parent, selector.clientData, a.first]
THEN
BEGIN
selector.value^ ← a.first;
Buttons.SetDisplayStyle[self, $WhiteOnBlack];
FOR others: LIST OF Buttons.Button ← selector.buttons, others.rest UNTIL others = NIL
DO
IF others.first # self
THEN Buttons.SetDisplayStyle[others.first, $BlackOnWhite]
ENDLOOP;
END;
EXIT
END;
buttons ← buttons.rest;
ENDLOOP;
};
START HERE
[] ← ViewerEvents.RegisterEventProc[DestroyProc, destroy];
Commander.Register[
key: "Debug",
proc: Debug,
doc: "Tool for debugging processes and other worlds"];
BEGIN
-- Open a tool on the outload world if there is one
ENABLE WorldVM.BadWorld => CONTINUE;
TRUSTED{ [] ← WorldVM.OtherWorld[] };
GetWorldViewer[outload, Atom.GetPName[outload], NIL];
END;
END.