DIRECTORY
AMBridge USING [SomeRefFromTV, TVForFrame, TVForReferent, TVToATOM],
AMModel USING [Context, ParentSection, RootContext, Section, SectionClass, SectionName, SectionSource, Source, SourceObj],
AMModelBridge USING [ContextForFrame],
AMModelLocation USING [CodeLocation, EntryLocations],
AMTypes USING [Error, GetEmptyTV, TV, DynamicParent, Procedure, UnderClass, TVType, TVToName],
AMViewerOps USING [ReportProc, SectionFromSelection, ViewerFromSection],
BackStop USING [Call],
Buttons USING [ButtonProc],
Commander USING [CommandProc, Register],
Containers USING [ChildXBound, ChildYBound],
EvalQuote USING [EvalQuoteProc, Register],
FastBreak USING [ClearFastBreak, FastBreakData, FastBreakId, FastBreakProc, SetFastBreak],
InterpreterOps USING [Eval, EvalHead, HelpFatal, NewEvalHead, ParseExpr, Tree],
IO USING [PutFR, PutRope, PutText, STREAM, RopeFromROS, ROS],
Labels USING [Label],
MessageWindow USING [Append], 
PPTreeOps USING [NSons, NthSon, OpName],
PrincOps USING [BytePC, FrameCodeBase, PsbIndex, FrameHandle],
PrincOpsUtils USING [PsbHandleToIndex, ReadPSB, GetReturnFrame],
PrintTV USING [Print, PrintArguments,PrintVariables],
Rope USING [Cat, ROPE, Size, Equal],
SymTab USING [Create, Ref],
TypeScript USING [Create],
VFonts USING [FontHeight],
ViewerClasses USING [Viewer],
ViewerIO USING [CreateViewerStreams],
ViewerOps USING [CreateViewer],
ViewerTools USING [GetContents, GetSelectionContents, SetContents, SetSelection],
VTables USING [Create, GetTableEntry, Install, SetTableEntry, VTable],
WorldVM USING [LocalWorld];
BreakTool: CEDAR MONITOR
IMPORTS AMBridge, AMModel, AMModelBridge, AMModelLocation, AMViewerOps, AMTypes, BackStop, Commander, Containers, EvalQuote, FastBreak, InterpreterOps, IO, MessageWindow, PPTreeOps, PrincOpsUtils, PrintTV, Rope, SymTab, TypeScript, VFonts, ViewerIO, ViewerOps, ViewerTools, VTables, WorldVM
= BEGIN

BytePC: TYPE = PrincOps.BytePC;
CARD: TYPE = LONG CARDINAL;
CodeLocation: TYPE = AMModelLocation.CodeLocation;
CodeLocationList: TYPE = LIST OF CodeLocation;
FrameCodeBase: TYPE = PrincOps.FrameCodeBase;
FrameHandle: TYPE = PrincOps.FrameHandle;
ROPE: TYPE = Rope.ROPE;
Section: TYPE = AMModel.Section;
Source: TYPE = AMModel.Source;
SourceObj: TYPE = AMModel.SourceObj;
STREAM: TYPE = IO.STREAM;
Tree: TYPE = InterpreterOps.Tree;
TV: TYPE = AMTypes.TV;
Viewer: TYPE = ViewerClasses.Viewer;

Location: TYPE = RECORD [
list: CodeLocationList,
where: ROPE];

emHeight: INTEGER; 

headLabel: Labels.Label _ NIL; 
frameLabel: Labels.Label _ NIL;
errorLabel: Labels.Label _ NIL;
container: Viewer _ NIL;

ClientData: TYPE = REF ClientDataRep;
ClientDataRep: TYPE = RECORD [
buttons: VTables.VTable _ NIL,
tab: VTables.VTable _ NIL,
exprViewer: ViewerClasses.Viewer _ NIL,
locViewer: ViewerClasses.Viewer _ NIL,
list: LogBreakList _ NIL,
log: STREAM _ NIL,
in: STREAM _ NIL,
specials: SymTab.Ref _ NIL];

LogBreakList: TYPE = REF LogBreakListRep;
LogBreakListRep: TYPE = RECORD [
next: LogBreakList _ NIL,
busy: INT _ 0,
fastId: FastBreak.FastBreakId _ NIL,
proc: FastBreak.FastBreakProc _ NIL,
code: FrameCodeBase _ [long[NIL]],
pc: BytePC _ [0],
title: ROPE _ NIL,
where: ROPE _ NIL,
tree: Tree _ NIL,
data: ClientData _ NIL];

toolList: LIST OF ClientData _ NIL;

busyProcesses: REF BusyProcesses _ NEW[BusyProcesses _ ALL[FALSE]];

BusyProcesses: TYPE = PACKED ARRAY PrincOps.PsbIndex OF BOOL;

NewContainer: PROC [name: ROPE] RETURNS [Viewer] = TRUSTED {
RETURN [
ViewerOps.CreateViewer [
flavor: $Container,
info: [name: name, column: right, iconic: TRUE, scrollable: FALSE], 
paint: TRUE]];
}; 

NewLogBreakList: PROC RETURNS [LogBreakList] = {
RETURN [NEW[LogBreakListRep _ []]];
};

NewClientData: ENTRY PROC RETURNS [cd: ClientData] = {
cd _ NEW[ClientDataRep _ []];
toolList _ CONS[cd, toolList];
};

BuildTool: Commander.CommandProc = TRUSTED {
container: Viewer _ NewContainer["BreakTool"]; 
data: ClientData _ NewClientData[];
tab: VTables.VTable _ VTables.Create[rows: 1, columns: 7, parent: container, x: 2, y: 2];
viewer: Viewer _ NIL;

emHeight _ VFonts.FontHeight[];    


VTables.SetTableEntry
[table: tab, column: 0, name: "Set", proc: SetBreakProc, clientData: data]; 
VTables.SetTableEntry
[table: tab, column: 1, name: "Clear", proc: ClearProc, clientData: data]; 
VTables.SetTableEntry
[table: tab, column: 2, name: "Clear *", proc: ClearStarProc, clientData: data]; 
VTables.SetTableEntry
[table: tab, column: 3, name: "List *", proc: ListStarProc, clientData: data]; 
VTables.SetTableEntry
[table: tab, column: 4, name: "Eval", proc: EvalProc, clientData: data];
VTables.SetTableEntry
[table: tab, column: 5, name: "EvalSel", proc: EvalSelectionProc, clientData: data];
VTables.Install[tab, FALSE];
data.buttons _ tab;
tab _ VTables.Create [
rows: 2, columns: 2, parent: container, x: tab.wx, y: tab.wy + tab.wh - 1];
VTables.SetTableEntry
[table: tab, row: 1, column: 0, name: "Expr:",
proc: SelectExprProc, useMaxSize: FALSE, clientData: data]; 
data.exprViewer _ ViewerOps.CreateViewer[
flavor: $Text,
info: [parent: tab, ww: 380, wh: 64, scrollable: TRUE, border: FALSE],
paint: FALSE];
VTables.SetTableEntry
[table: tab, row: 1, column: 1, flavor: $Viewer, clientData: data.exprViewer];
VTables.Install[tab, FALSE];
data.tab _ tab;

data.specials _ SymTab.Create[];
EvalQuote.Register["&abort", EvqAbort, data.specials, data];
EvalQuote.Register["&break", EvqBreak, data.specials, data];
EvalQuote.Register["&break1", EvqBreak1, data.specials, data];
EvalQuote.Register["&do", EvqDo, data.specials, data];
EvalQuote.Register["&empty", EvqEmpty, data.specials, data];
EvalQuote.Register["&evq", EvqEvq, data.specials, data];
EvalQuote.Register["&msg", EvqMsg, data.specials, data];
EvalQuote.Register["&print", EvqPrint, data.specials, data];
EvalQuote.Register["&prog", EvqProg, data.specials, data];
EvalQuote.Register["&result", EvqResult, data.specials, data];
EvalQuote.Register["&stack", EvqStack, data.specials, data];

data.locViewer _ VTables.GetTableEntry[tab, 0, 1];
viewer _ TypeScript.Create[
[name: "BreakTool.ts", wy: tab.wy+tab.wh+4, parent: container, border: FALSE], FALSE];
[data.in, data.log] _ ViewerIO.CreateViewerStreams [
name: "BreakTool.ts", viewer: viewer, backingFile: "BreakTool.ts", editedStream: FALSE];
Containers.ChildXBound[container, viewer];
Containers.ChildYBound[container, viewer];
}; 

Break: ERROR = CODE;
Break1: ERROR = CODE;  -- break and clear break
EvalError: ERROR [msg: ROPE] = CODE;
LocalQuit: ERROR [errmsg: ROPE] = CODE;
Throw: ERROR [rtnTV: TV] = CODE;

BreakProc: FastBreak.FastBreakProc = TRUSTED {
list: LogBreakList _ ListFromData[data];
useOldBreak _ FALSE;
IF list # NIL THEN {
clearIt: BOOL _ FALSE;
{ENABLE UNWIND => ReleaseList[list];
tv: TV _ AMBridge.TVForFrame[frame];
[] _ EvalTree[list.data, list.tree, tv
! Break => {useOldBreak _ TRUE; CONTINUE};
Break1 => {useOldBreak _ TRUE; clearIt _ TRUE; CONTINUE}
];
};
ReleaseList[list];
IF clearIt THEN [] _ ClearBreak[list.data, list];
};
};

SetBreakProc: Buttons.ButtonProc = TRUSTED {
viewer: ViewerClasses.Viewer _ NARROW[parent];
data: ClientData _ NARROW[clientData];
expr: ROPE _ NIL;
loc: Location;
why: ROPE _ NIL;
[loc, why] _ LocationFromSelection[];
IF loc.list # NIL THEN  {
tree: Tree _ NIL;
list: LogBreakList _ NewLogBreakList[];
expr _ ViewerTools.GetContents[data.exprViewer];
list.title _ expr;
list.where _ loc.where;
IF (list.tree _ LocalParse[data, expr]) = NIL THEN GO TO oops;
list.data _ data;
list.next _ data.list;
data.list _ list;
AddBreakToList[list: list, loc: loc, condProc: BreakProc]; 
Report[data, "\nSet break in ", list.where];
Report[data, "\n  (expr: ", list.title, ")"];
RETURN
EXITS oops => {
Report[data, "\nCan't set break, invalid expr:\n  ", expr, "\n"];
RETURN}};
Report[data, "\nCan't set break, ", why, "\n"];  
}; 

exprNumber: INT _ 0;
LocalParse: PROC [data: ClientData, expr: ROPE] RETURNS [tree: Tree _ NIL] = TRUSTED {
expr _ IO.PutFR["&%g _ %g", [integer[exprNumber _ exprNumber + 1]], [rope[expr]]];
tree _ InterpreterOps.ParseExpr[expr, data.log ! LocalQuit => CONTINUE];
};

ClearProc: Buttons.ButtonProc = TRUSTED {
viewer: ViewerClasses.Viewer _ NARROW[parent];
data: ClientData _ NARROW[clientData];
loc: Location;
why: ROPE;
[loc, why] _ LocationFromSelection[];
IF why # NIL THEN {Report[data, "\nBreak not found, ", why, "."]; RETURN};
IF BreakFromLocation[loc, data] = NIL THEN {
Report[data, "\nNo such break set."];
RETURN;
};
DO
list: LogBreakList = BreakFromLocation[loc, data];
IF list = NIL THEN EXIT;
IF ClearBreak[data, list]
THEN Report[data, "\nBreak cleared from ", list.where]
ELSE {Report[data, "\nBreak busy, not cleared."]; EXIT};
ENDLOOP;
RETURN;
}; 

ClearStarProc: Buttons.ButtonProc = {
viewer: ViewerClasses.Viewer _ NARROW[parent];
data: ClientData _ NARROW[clientData];
IF data.list = NIL THEN {
Report[data, "\nNo breaks to clear."];
RETURN};
Report[data, "\nClearing current breaks:"];
FOR list: LogBreakList _ data.list, list.next UNTIL list = NIL DO
IF ClearBreak[data, list]
THEN Report[data, "\nBreak cleared from ", list.where]
ELSE Report[data, "\nBreak busy, not cleared."];
ENDLOOP;
}; 

ListStarProc: Buttons.ButtonProc = {
viewer: ViewerClasses.Viewer _ NARROW[parent];
data: ClientData _ NARROW[clientData];
IF data.list = NIL THEN {
Report[data, "\nNo current breaks."];
RETURN};
Report[data, "\nCurrent breaks:"];
FOR list: LogBreakList _ data.list, list.next UNTIL list = NIL DO
kind: ROPE _ NIL;
IF list.fastId = NIL THEN LOOP;
SELECT list.proc FROM
BreakProc => kind _ "\n  Break in ";
ENDCASE => LOOP;
Report[data, kind, list.where];
Report[data, "\n    (expr: ", list.title, ")"];
ENDLOOP;
}; 

EvalProc: Buttons.ButtonProc = TRUSTED {
viewer: ViewerClasses.Viewer _ NARROW[parent];
data: ClientData _ NARROW[clientData];
expr: ROPE _ ViewerTools.GetContents[data.exprViewer];
EvalAndPrint[expr, data];
}; 

EvalAndPrint: PROC [expr: ROPE, cdata: ClientData] = TRUSTED {
rtns: TV _ NIL;
err: ROPE _ NIL;
[rtns, err] _ EvalRope[cdata, expr];
IF err # NIL THEN {Report[cdata, "\nError in ", expr, " !!!!\n  ", err]; RETURN};
Report[cdata, "\nEval of ", expr, " =>\n  "];
IF rtns = AMTypes.GetEmptyTV[]
THEN Report[cdata, "{empty result}"]
ELSE PrintTV.Print[rtns, cdata.log];
};

EvalSelectionProc: Buttons.ButtonProc = TRUSTED {
viewer: ViewerClasses.Viewer _ NARROW[parent];
data: ClientData _ NARROW[clientData];
expr: ROPE _ ViewerTools.GetSelectionContents[];
IF expr.Size[] = 0 THEN RETURN;
ViewerTools.SetContents[data.exprViewer, expr];
EvalAndPrint[expr, data];
}; 

SelectExprProc: Buttons.ButtonProc = TRUSTED {
viewer: ViewerClasses.Viewer _ NARROW[parent];
data: ClientData _ NARROW[clientData];
ViewerTools.SetSelection[data.exprViewer, NIL];
};


Report: PROC [data: ClientData, r1,r2,r3,r4: ROPE _ NIL] = TRUSTED {
IF r1 # NIL THEN {IO.PutRope[data.log, r1]};
IF r2 # NIL THEN {IO.PutRope[data.log, r2]};
IF r3 # NIL THEN {IO.PutRope[data.log, r3]};
IF r4 # NIL THEN {IO.PutRope[data.log, r4]};
};

EvalRope: PROC
[data: ClientData, expr: ROPE] RETURNS [rtns: TV, err: ROPE] = {
tree: Tree _ NIL;
err _ NIL;
rtns _ NIL;
tree _ LocalParse[data, expr];
[rtns, err] _ EvalTree[data, tree, NIL];
};

lagErr: ROPE _ NIL;
LocalHelpFatal: InterpreterOps.HelpFatal = {
lagErr _ msg;
ERROR LocalQuit [msg];
};

EvalTree: PROC [data: ClientData, tree: Tree, tv: TV _ NIL] RETURNS [rtns: TV, err: ROPE] = TRUSTED {
ctx: AMModel.Context = IF tv = NIL
THEN AMModel.RootContext[WorldVM.LocalWorld[]]
ELSE AMModelBridge.ContextForFrame[tv];
head: InterpreterOps.EvalHead
_ InterpreterOps.NewEvalHead[ctx, data.specials, [NIL, NIL], [LocalHelpFatal, data]];
savedMsg: ROPE;
eval: PROC = TRUSTED {
ENABLE {
Throw => {rtns _ rtnTV; toDo _ throw; CONTINUE};
Break => {toDo _ break; CONTINUE};
LocalQuit => {savedMsg _ errmsg; toDo _ error; CONTINUE}
};
rtns _ InterpreterOps.Eval[tree, head];
};
toDo: {normal, error, throw, break} _ normal;
err _ NIL;
IF tree = NIL THEN RETURN [NIL, "invalid expression"];
err _ BackStop.Call[eval];
SELECT toDo FROM
error => ERROR EvalError[savedMsg];
break => ERROR Break;
ENDCASE;
};

BreakFromLocation: PROC [loc: Location, clientData: ClientData] RETURNS [LogBreakList] = TRUSTED {
IF loc.list = NIL THEN RETURN [NIL];
FOR list: LogBreakList _ clientData.list, list.next WHILE list # NIL DO
FOR each: CodeLocationList _ loc.list, each.rest WHILE each # NIL DO
IF each.first.pc = list.pc AND each.first.codeBase = list.code THEN 
RETURN [list];
ENDLOOP;
ENDLOOP; 
RETURN [NIL];
};

AddBreakToList: PROC [list: LogBreakList, loc: Location, condProc: FastBreak.FastBreakProc] = TRUSTED {
first: BOOL _ TRUE;
FOR each: CodeLocationList _ loc.list, each.rest WHILE each # NIL DO
IF NOT first THEN {
new: LogBreakList _ NEW[LogBreakListRep _ list^];
list.next _ new;
list _ new;
};
list.where _ loc.where;
list.code _ each.first.codeBase;
list.pc _ each.first.pc;
list.proc _ condProc;
list.fastId _ FastBreak.SetFastBreak[list.code.longbase, list.pc, condProc, LOOPHOLE[list]];
first _ FALSE;
ENDLOOP;
};

ClearBreak: ENTRY PROC [data: ClientData, list: LogBreakList] RETURNS [cleared: BOOL _ FALSE] = TRUSTED {
ENABLE UNWIND => NULL;
lag: LogBreakList _ NIL; 
IF list = NIL OR list.fastId = NIL OR list.busy # 0 THEN RETURN;
FOR each: LogBreakList _ data.list, each.next WHILE each # NIL DO
IF each = list THEN {
IF lag = NIL THEN data.list _ each.next ELSE lag.next _ each.next;
[] _ FastBreak.ClearFastBreak[list.fastId, list.proc, LOOPHOLE[list]];
list.fastId _ NIL;
cleared _ TRUE;
EXIT};
ENDLOOP;
}; 

ListFromData: ENTRY PROC [data: FastBreak.FastBreakData] RETURNS [list: LogBreakList] = TRUSTED {
self: PrincOps.PsbIndex _ PrincOpsUtils.PsbHandleToIndex[PrincOpsUtils.ReadPSB[]];
FOR tool: LIST OF ClientData _ toolList, tool.rest WHILE tool # NIL DO
FOR each: LogBreakList _ tool.first.list, each.next WHILE each # NIL DO
IF LOOPHOLE[each, FastBreak.FastBreakData] = data THEN {
IF busyProcesses[self] THEN RETURN [NIL];
each.busy _ each.busy + 1;
busyProcesses[self] _ TRUE;
RETURN [each];
};
ENDLOOP;
ENDLOOP;
RETURN [NIL];
};

ReleaseList: ENTRY PROC [list: LogBreakList] = TRUSTED {
self: PrincOps.PsbIndex _ PrincOpsUtils.PsbHandleToIndex[PrincOpsUtils.ReadPSB[]];
IF list # NIL THEN {
list.busy _ list.busy - 1;
busyProcesses[self] _ FALSE;
};
};

ClarkKent: AMViewerOps.ReportProc = {
MessageWindow.Append[msg, TRUE];
};

LocationFromSelection: PROC RETURNS [loc: Location, why: ROPE] = TRUSTED {
inner: PROC = TRUSTED {
source: Source _ NIL;
locationList: CodeLocationList _ NIL;
pos: INT;
parentName: ROPE;
section: Section _ AMViewerOps.SectionFromSelection[].section;
parent: Section _ section;
IF AMModel.SectionClass[section] = statement THEN
parent _ AMModel.ParentSection[section];
parentName _ AMModel.SectionName[parent];
IF AMModel.SectionClass[parent] = proc THEN {
DO
parent _ AMModel.ParentSection[parent];
IF AMModel.SectionClass[parent] # proc THEN EXIT;
ENDLOOP;
parentName _ Rope.Cat[AMModel.SectionName[parent], ".", parentName];
}; 
source _ AMModel.SectionSource[section];
WITH source SELECT FROM
entire: REF SourceObj[entire] => pos _ -1;
field: REF SourceObj[field] => {
pos _ field.firstCharIndex;
[] _ AMViewerOps.ViewerFromSection[section, ClarkKent];
};
ENDCASE;
locationList _ AMModelLocation.EntryLocations[section].list;
loc _ [
list: locationList,
where: IO.PutFR["%g (pos: %g)", [rope[parentName]], [integer[pos]]]];
};
why _ BackStop.Call[inner];
IF why = NIL AND loc.list = NIL THEN why _ "no such location";
};

GetArg: PROC [tree: Tree, which: NAT] RETURNS [son: Tree _ NIL] = {
args: Tree _ PPTreeOps.NthSon[tree, 2];
IF PPTreeOps.OpName[args] = list
THEN {IF which IN [1..PPTreeOps.NSons[args]] THEN
son _ PPTreeOps.NthSon[args, which]}
ELSE IF which = 1 THEN son _ args;
};

NArgs: PROC [tree: Tree] RETURNS [sons: NAT _ 0] = {
args: Tree _ PPTreeOps.NthSon[tree, 2];
IF args = NIL THEN RETURN [0];
IF PPTreeOps.OpName[args] = list
THEN sons _ PPTreeOps.NSons[args]
ELSE sons _ 1;
};

AtomicWrite: ENTRY PROC [to: STREAM, rope: ROPE] = {
ENABLE UNWIND => NULL;
IO.PutRope[to, rope];
};


EvqAbort: EvalQuote.EvalQuoteProc = {
ERROR ABORTED;
};

EvqBreak: EvalQuote.EvalQuoteProc = {
cd: ClientData = NARROW[data];
FOR i: NAT IN [1..NArgs[tree]] DO
arg: Tree _ GetArg[tree, i];
return _ InterpreterOps.Eval [
arg, head
! Throw => {return _ rtnTV; EXIT}];
ENDLOOP;
ERROR Break;
};

EvqBreak1: EvalQuote.EvalQuoteProc = {
ERROR Break1;
};

EvqDo: EvalQuote.EvalQuoteProc = {
cd: ClientData = NARROW[data];
DO
FOR i: NAT IN [1..NArgs[tree]] DO
arg: Tree _ GetArg[tree, i];
return _ InterpreterOps.Eval [
arg, head
! Throw => {return _ rtnTV; GO TO done}];
ENDLOOP;
ENDLOOP;
EXITS done => {};
};

EvqEmpty: EvalQuote.EvalQuoteProc = {
cd: ClientData = NARROW[data];
FOR i: NAT IN [1..NArgs[tree]] DO
arg: Tree _ GetArg[tree, i];
return _ InterpreterOps.Eval [
arg, head
! Throw => {return _ rtnTV; EXIT}];
ENDLOOP;
RETURN [AMTypes.GetEmptyTV[]];
};

EvqEvq: EvalQuote.EvalQuoteProc = TRUSTED {
cd: ClientData = NARROW[data];
FOR i: NAT IN [1..NArgs[tree]] DO
arg: Tree _ GetArg[tree, i];
return _ InterpreterOps.Eval [
arg, head
! Throw => {return _ rtnTV; EXIT}];
ENDLOOP;
return _ AMBridge.TVForReferent[NEW[REF _ return]];
};

EvqMsg: EvalQuote.EvalQuoteProc = TRUSTED {
cd: ClientData = NARROW[data];
buffer: STREAM = IO.ROS[];
FOR i: NAT IN [1..NArgs[tree]] DO
arg: Tree _ GetArg[tree, i];
ref: REF _ NIL;
return _ InterpreterOps.Eval [
arg, head
! Throw => {return _ rtnTV; EXIT}];
ref _ AMBridge.SomeRefFromTV[return ! AMTypes.Error => CONTINUE];
WITH ref SELECT FROM
refRope: REF ROPE => IF refRope # NIL THEN IO.PutRope[buffer, refRope^];
refRefText: REF REF TEXT =>
IF refRefText # NIL AND refRefText^ # NIL THEN IO.PutText[buffer, refRefText^];
ENDCASE => 
IF return # AMTypes.GetEmptyTV[] THEN PrintTV.Print[return, buffer];
ENDLOOP;
AtomicWrite[cd.log, IO.RopeFromROS[buffer]];
};

EvqPrint: EvalQuote.EvalQuoteProc = {
cd: ClientData = NARROW[data];
buffer: STREAM = IO.ROS[];
FOR i: NAT IN [1..NArgs[tree]] DO
arg: Tree _ GetArg[tree, i];
return _ InterpreterOps.Eval [
arg, head
! Throw => {return _ rtnTV; EXIT}];
IF return # AMTypes.GetEmptyTV[] THEN PrintTV.Print[return, buffer];
ENDLOOP;
AtomicWrite[cd.log, IO.RopeFromROS[buffer]];
};

EvqProg: EvalQuote.EvalQuoteProc = {
cd: ClientData = NARROW[data];
FOR i: NAT IN [1..NArgs[tree]] DO
arg: Tree _ GetArg[tree, i];
return _ InterpreterOps.Eval [
arg, head
! Throw => {return _ rtnTV; EXIT}];
ENDLOOP;
};

EvqResult: EvalQuote.EvalQuoteProc = {
cd: ClientData = NARROW[data];
FOR i: NAT IN [1..NArgs[tree]] DO
arg: Tree _ GetArg[tree, i];
return _ InterpreterOps.Eval [
arg, head
! Throw => {return _ rtnTV; EXIT}];
ENDLOOP;
ERROR Throw[return];
};



EvqStack: EvalQuote.EvalQuoteProc = TRUSTED {
buffer: STREAM = IO.ROS[];
start: TV;
er1: ROPE;
end: TV;
terseTV: TV;
verbose: BOOL;
er2: ROPE;
mtv: TV;
startProc, endProc: Rope.ROPE _ NIL;
cd: ClientData = NARROW[data];
lf: FrameHandle _ PrincOpsUtils.GetReturnFrame[];
arg1: Tree _ GetArg[tree, 1];
arg2: Tree _ GetArg[tree, 2];
arg3: Tree _ GetArg[tree, 3];
[terseTV,er1]  _ EvalTree[cd, arg1];
verbose _ terseTV # NIL AND AMBridge.TVToATOM[terseTV] # $T;
[start,er1]  _ EvalTree[cd, arg2];
mtv _ AMBridge.TVForFrame[lf];
IF start # NIL THEN SELECT AMTypes.UnderClass[AMTypes.TVType[start]] FROM  
atom => NULL;
procedure =>  startProc _ AMTypes.TVToName[start];
ENDCASE => ERROR;
[end,er2]  _ EvalTree[cd, arg3];
IF end # NIL THEN SELECT AMTypes.UnderClass[AMTypes.TVType[end]] FROM  
atom => NULL;
procedure =>  endProc _ AMTypes.TVToName[end];
ENDCASE => ERROR;


UNTIL ((mtv=NIL)  OR  (startProc=NIL)  OR  (Rope.Equal[AMTypes.TVToName[AMTypes.Procedure[mtv]], startProc]) ) DO
mtv _ AMTypes.DynamicParent[mtv];
ENDLOOP;
IF (mtv#NIL) THEN mtv _ AMTypes.DynamicParent[mtv];
UNTIL ((mtv=NIL)  OR  (Rope.Equal[AMTypes.TVToName[AMTypes.Procedure[mtv]], endProc]) ) DO
IO.PutRope[buffer,"\n"];
PrintTV.Print[mtv, buffer];
IF verbose THEN {
IO.PutRope[buffer,"\nArguments--\n"];
PrintTV.PrintArguments[tv: mtv, put: buffer];
buffer.PutRope["\nVariables--\n"];
PrintTV.PrintVariables[tv: mtv, put: buffer];
};
mtv _ AMTypes.DynamicParent[mtv];
ENDLOOP;
AtomicWrite[cd.log, IO.RopeFromROS[buffer]];
};



Commander.Register[
"BreakTool", BuildTool, "provides support for logging and conditional breakpoints."]

END.


BBreakTool.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Spreitzer, August 2, 1985 9:21:26 pm PDT
Russ Atkinson (RRA) August 23, 1985 2:55:44 pm PDT
Kent, June 18, 1986 3:29:50 pm PDT
Jack Kent, August 8, 1986 9:25:33 am PDT
Mike Spreitzer October 20, 1986 6:42:11 pm PDT
build up the menu  
Create the specials table and register the &-procs
[data: FastBreakData, frame: PrincOps.FrameHandle, sv: PrincOps.SVPointer]
RETURNS [useOldBreak: BOOL _ FALSE]
The following routine is a conditional break proc.  It evaluates an expression and breaks if the expression raises Break.
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
actually clear the breaks
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
actually clear the breaks
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
utility procs
... returns the first breakpoint index for the given location.  There can be multiple breakpoints for a given location, remember.
If we are recursive here, then we DON'T want to take the breakpoint.
[msg: ROPE, severity: Severity]
try to find the module name as well
The EvalQuote procs
[head: EvalHead, tree: Tree, target: Type _ nullType, data: REF _ NIL]
RETURNS [return: TV]
[head: EvalHead, tree: Tree, target: Type _ nullType, data: REF _ NIL]
RETURNS [return: TV]
[head: EvalHead, tree: Tree, target: Type _ nullType, data: REF _ NIL]
RETURNS [return: TV]
[head: EvalHead, tree: Tree, target: Type _ nullType, data: REF _ NIL]
RETURNS [return: TV]
[head: EvalHead, tree: Tree, target: Type _ nullType, data: REF _ NIL]
RETURNS [return: TV]
[head: EvalHead, tree: Tree, target: Type _ nullType, data: REF _ NIL]
RETURNS [return: TV]
[head: EvalHead, tree: Tree, target: Type _ nullType, data: REF _ NIL]
RETURNS [return: TV]
[head: EvalHead, tree: Tree, target: Type _ nullType, data: REF _ NIL]
RETURNS [return: TV]
[head: EvalHead, tree: Tree, target: Type _ nullType, data: REF _ NIL]
RETURNS [return: TV]
[head: EvalHead, tree: Tree, target: Type _ nullType, data: REF _ NIL]
RETURNS [return: TV]
walk the stack and print it out
unlike the other interpreted breaktool commands - Evqstack takes three arguments
1st argument - V or T - for verbose(V)  or terse (default terse)
using the former, the contents of call frames as well as procedure names
are displayed
2nd argument - starting procedure (default EvaluateImpl.EvalApply)
procedures warmer than this one in call-stack will not be displayed
3rd arument - ending procedure (defaul CommandToolImpl.CommandToolBase)
procedures  cooler than this one in call-stack will not be displayed

[head: EvalHead, tree: Tree, target: Type _ nullType, data: REF _ NIL]
RETURNS [return: TV]
I want my...
cd.list.where contains a list of the procedures where breakpoints occurred
from most recent to least recent
first argument should be V or T
-- second argument should be Procedure name
-- as should third argument
this will be an atom
and the next two will either be atoms or names of procedures
at this point startProc is the starting procedure
and endProc is the ending procedure if end=$E
now start to print out the call stack till you get to arg3 
and lastly, print it out
wind your way back up the call stack
Jack Kent, August 8, 1986 9:23:42 am PDT
changes to: DIRECTORY

ΚW˜
codeš
œ™Kšœ
Οm
œ1™<K™(K™2K™"K™(K™.—K˜š
Οk	˜	Kšœ	žœ6˜DKšœžœm˜zKšœžœ˜&Kšœžœ ˜5Kšœžœžœ:˜^Kšœžœ7˜HKšœ	žœ˜Kšœžœ˜Kšœ
žœ˜(Kšœžœ˜,Kšœ
žœ˜*Kšœ
žœK˜ZKšœžœ;˜OKšžœ
žœžœžœ˜=Kšœžœ	˜Kšœžœ˜Kšœ
žœ˜(Kšœ	žœ0˜>Kšœžœ-˜@Kšœžœ(˜5Kšœžœžœ˜$Kšœžœ˜Kšœžœ
˜Kšœžœ˜Kšœžœ
˜Kšœ	žœ˜%Kšœ
žœ˜Kšœžœ@˜QKšœžœ9˜FKšœžœ˜—
headšœžœ
ž˜Kšžœ‘
žœˆ
˜’Kšœž˜K˜Kšœžœ˜Kšžœžœžœ
žœ
˜Kšœžœ ˜2Kšœžœžœ
žœ˜.Kšœžœ˜-Kšœ
žœ˜)Kšžœžœžœ
˜Kšœ	žœ˜ Kšœžœ˜Kšœžœ˜$Kšžœžœžœ
žœ
˜Kšœžœ˜!Kšžœžœžœ
˜Kšœžœ˜$K˜šœ
žœžœ˜Kš
œ˜Kšœžœ˜
—K˜Kšœ
žœ˜K˜Kšœžœ˜Kšœžœ
˜Kšœžœ
˜Kšœžœ
˜K˜Kšœžœžœ˜%šœžœžœ˜Kšœžœ
˜Kšœžœ
˜Kšœ#žœ
˜'Kšœ"žœ
˜&Kšœžœ
˜Kšœžœž˜Kšœžœž˜Kšœžœ˜K˜—Kšœžœžœ˜)šœžœžœ˜ Kšœžœ
˜Kšœžœ˜Kšœ žœ
˜$Kšœ žœ
˜$Kšœžœ˜"Kš
œ˜Kšœžœžœ
˜Kšœžœžœ
˜Kšœ
žœ
˜Kšœžœ˜K˜—Kšœ
žœ
žœžœ
˜#K˜Kšœžœ1˜CK˜šœžœžœ
žœžœ
žœ
˜=K˜—š
Οnœžœžœžœžœ˜<šžœ˜š
œ˜K˜Kšœ*žœžœ˜DKšœžœ˜——K˜K˜—šŸœžœ
žœ˜0Kšžœžœ˜#Kš
œ˜K˜—šŸ
œžœ
žœ
žœ˜6Kšœžœ˜Kšœžœ˜Kš
œ˜K˜—šœ#žœ˜,K˜/K˜#K˜YKšœžœ
˜K˜K˜#K˜Kš
œ™K˜˜K˜L—˜K˜K—˜K˜Q—˜K˜O—˜K˜H—˜K˜T—Kšœžœ˜K˜˜K˜K—˜˜.Kšœ"žœ˜<——š
œ)˜)Kš
œ˜Kšœ1žœ
žœ˜FKšœžœ˜—˜Kš
œN˜N—Kšœžœ˜K˜K˜Kš
œ2™2K˜ Kš
œ<˜<Kš
œ<˜<Kš
œ>˜>Kš
œ6˜6Kš
œ<˜<Kš
œ8˜8Kš
œ8˜8Kš
œ<˜<Kš
œ:˜:Kš
œ>˜>Kš
œ<˜<K˜K˜2š
œ˜KšœGžœžœ˜V—š
œ4˜4KšœQžœ˜X—Kš
œ*˜*Kš
œ*˜*K˜K˜—Kšœžœžœ
˜KšœžœžœΟc˜/Kšœžœžœžœ
˜$Kšœžœ
žœžœ
˜'Kšœžœ	žœžœ
˜ K˜šœ%žœ˜.Kš
œJ™JKšžœžœžœ
™#Kš
œy™yKš
œ(˜(Kšœžœ
˜šžœžœ
žœ˜Kšœ	žœžœ
˜šœ
žœ
žœ˜$Kšœžœ˜$š
œ&˜&šœžœžœ˜*Kšœžœžœžœ
˜8Kš
œ˜——K˜—Kš
œ˜Kšžœ	žœ"˜1K˜—K˜K˜—šœ#žœ˜,Kš
œN™NKšœžœ	˜.Kšœžœ
˜&Kšœžœžœ
˜Kš
œ˜Kšœžœžœ
˜Kš
œ%˜%šžœžœ
žœ˜Kšœ
žœ
˜K˜'K˜0K˜Kš
œ˜Kš
žœ(žœ
žœ
žœ
žœ˜>K˜K˜K˜Kš
œ;˜;Kš
œ,˜,Kš
œ-˜-Kš
ž˜šžœ
˜Kš
œA˜AKšžœ˜	——K˜1K˜K˜—Kšœžœ˜šŸ
œžœžœžœžœžœ˜VKšœžœI˜RKšœ>žœ˜HK˜K˜—šœ žœ˜)Kš
œN™NKšœžœ	˜.Kšœžœ
˜&K˜Kšœžœ
˜
K˜%Kšžœžœ
žœ1žœ˜Jšžœ žœ
žœ˜,Kš
œ%˜%Kšžœ
˜K˜—š
ž˜Kš
œ2˜2Kšžœžœ
žœ
žœ
˜šžœ˜Kšžœ2˜6Kšžœ.žœ˜8—Kšžœ
˜—Kšžœ
˜K˜K˜—˜%Kš
œN™NKšœžœ	˜.Kšœžœ
˜&šžœ
žœ
žœ˜K˜&Kšžœ˜—Kš
œ™K˜+šžœ+žœžœ
ž˜Ašžœ˜Kšžœ2˜6Kšžœ,˜0—Kšžœ
˜—Kš
œ˜K˜—˜$Kš
œN™NKšœžœ	˜.Kšœžœ
˜&šžœ
žœ
žœ˜K˜%Kšžœ˜—Kš
œ™K˜"šžœ+žœžœ
ž˜AKšœžœžœ
˜Kšžœžœ
žœ
žœ
˜šžœž˜Kš
œ$˜$Kšžœžœ
˜—Kš
œ˜Kš
œ/˜/Kšžœ
˜—Kš
œ˜K˜—šœžœ˜(Kš
œN™NKšœžœ	˜.Kšœžœ
˜&Kšœžœ,˜6K˜K˜K˜—šŸœžœžœžœ˜>Kšœžœžœ
˜Kšœžœžœ
˜Kš
œ$˜$Kšžœžœ
žœ8žœ˜QK˜-šžœ˜Kšžœ ˜$Kšžœ ˜$—K˜K˜—šœ(žœ˜1Kš
œN™NKšœžœ	˜.Kšœžœ
˜&Kšœžœ&˜0Kšžœžœ
žœ
˜K˜/K˜K˜K˜—šœ%žœ˜.Kš
œN™NKšœžœ	˜.Kšœžœ
˜&Kšœ*žœ˜/K˜K˜—Kš
œ
™
K˜š
Ÿœžœ!žœžœžœ˜DKšžœžœ
žœ˜,Kšžœžœ
žœ˜,Kšžœžœ
žœ˜,Kšžœžœ
žœ˜,K˜K˜—šŸœž˜Kš	œžœžœžœžœ˜@Kšœ
žœ
˜Kšœžœ
˜
Kšœžœ
˜Kš
œ˜Kšœ#žœ˜(K˜K˜—Kšœžœžœ
˜˜,K˜
Kšžœ˜K˜K˜—šŸœžœ$žœžœžœžœžœžœ˜ešœžœž˜"Kšžœ*˜.Kšžœ#˜'—˜Kšœ2žœžœ˜U—Kšœ
žœ
˜šœžœžœ˜šžœ˜Kšœ&žœ˜0Kšœžœ˜"Kšœ/žœ
˜8K˜—Kš
œ'˜'Kš
œ˜—K˜-Kšœžœ
˜
Kš
žœžœ
žœ
žœžœ˜6Kš
œ˜šžœž˜Kšœ	žœ˜#Kšœ	žœ˜Kšžœ
˜—K˜K˜—šŸœžœ)žœžœ˜bKš
œ
™
Kš
žœžœ
žœ
žœžœ˜$šžœ1žœžœ
ž˜Gšžœ.žœžœ
ž˜Dšžœžœ!žœ
˜DKšžœ˜—Kšžœ
˜—Kšžœ˜	—Kšžœžœ˜
K˜K˜—šŸœžœJžœ˜gKšœžœžœ
˜šžœ.žœžœ
ž˜Dšžœ
žœžœ˜Kšœžœ˜1K˜K˜K˜—Kš
œ˜Kš
œ ˜ Kš
œ˜Kš
œ˜KšœLžœ˜\Kšœžœ
˜Kšžœ
˜—K˜K˜—šŸ
œžœ
žœ(žœžœžœžœ˜iKšžœ
žœžœ
˜Kšœžœ˜Kšžœžœ
žœžœ
žœžœ
žœ
˜@šžœ+žœžœ
ž˜Ašžœ
žœ˜Kšžœžœ
žœžœ˜BKšœ6žœ˜FKšœžœ
˜Kšœ
žœ
˜Kšžœ˜—Kšžœ
˜—K˜K˜—š
Ÿœžœ
žœ!žœžœ˜aKš
œR˜Ršžœžœ
žœ"žœžœ
ž˜Fšžœ1žœžœ
ž˜Gšžœ
žœ'žœ˜8šžœžœ
žœžœ˜)Kš
œD™D—K˜Kšœžœ
˜Kšžœ˜K˜—Kšžœ
˜—Kšžœ
˜—Kšžœžœ˜
K˜K˜—šŸœžœ
žœžœ˜8Kš
œR˜Ršžœžœ
žœ˜Kš
œ˜Kšœžœ
˜K˜—K˜K˜—š
œ%˜%Kš
œ™Kšœžœ˜ Kš
œ˜K˜—šŸœžœžœžœ˜Jšœžœžœ˜Kšœžœ
˜Kšœ!žœ
˜%Kšœžœ
˜	Kšœžœ
˜Kš
œ>˜>Kš
œ˜šžœ+ž˜1Kš
œ(˜(—Kš
œ)˜)šžœ%žœ˜-Kš
œ#™#š
ž˜Kš
œ'˜'Kšžœ%žœ
žœ
˜1Kšžœ
˜—Kš
œD˜DKš
œ˜—Kš
œ(˜(šžœžœ
ž˜Kšœžœ˜*šœžœ˜ Kš
œ˜Kš
œ7˜7K˜—Kšžœ
˜—Kš
œ<˜<š
œ˜Kš
œ˜Kšœžœ<˜E—K˜—Kš
œ˜Kš
žœžœ
žœžœ
žœ˜>K˜K˜—š
Ÿœžœžœžœžœ˜CK˜'šžœ˜ šžœžœžœž˜1K˜$—Kšžœ
žœžœ˜"—K˜K˜—šŸœžœžœžœ	˜4K˜'Kšžœžœ
žœ
žœ˜šžœ˜ Kšžœ˜!Kšžœ
˜—K˜K˜—š
Ÿœžœ
žœžœžœ˜4Kšžœ
žœžœ
˜Kšžœ˜K˜K˜—š
œ™K˜š
œ%˜%Kšœ<žœžœ
™FKšžœ
žœ
™Kšžœ
žœ
˜K˜K˜—š
œ%˜%Kšœ<žœžœ
™FKšžœ
žœ
™Kšœžœ˜šžœžœ
žœž˜!Kš
œ˜š
œ˜K˜	Kšœžœ˜#—Kšžœ
˜—Kšžœ˜K˜K˜—š
œ&˜&Kšœ<žœžœ
™FKšžœ
žœ
™Kšžœ˜
K˜K˜—š
œ"˜"Kšœ<žœžœ
™FKšžœ
žœ
™Kšœžœ˜š
ž˜šžœžœ
žœž˜!Kš
œ˜š
œ˜K˜	Kšœžœ
žœ˜)—Kšžœ
˜—Kšžœ
˜—Kšžœ˜K˜K˜—š
œ%˜%Kšœ<žœžœ
™FKšžœ
žœ
™Kšœžœ˜šžœžœ
žœž˜!Kš
œ˜š
œ˜K˜	Kšœžœ˜#—Kšžœ
˜—Kšžœ˜K˜K˜—šœ"žœ˜+Kšœ<žœžœ
™FKšžœ
žœ
™Kšœžœ˜šžœžœ
žœž˜!Kš
œ˜š
œ˜K˜	Kšœžœ˜#—Kšžœ
˜—Kšœ žœ
žœ˜3K˜K˜—šœ"žœ˜+Kšœ<žœžœ
™FKšžœ
žœ
™Kšœžœ˜Kšœžœžœ
žœ˜šžœžœ
žœž˜!Kš
œ˜Kšœžœžœ
˜š
œ˜K˜	Kšœžœ˜#—Kšœ7žœ˜Ašžœžœ
ž˜Kš
œ	žœ
žœžœžœ
žœ
žœ˜Hšœžœ
žœ
žœ˜Kšžœžœ
žœžœ
žœ
žœ˜O—šžœ˜Kšžœžœ˜D——Kšžœ
˜—Kšœžœ˜,K˜K˜—š
œ%˜%Kšœ<žœžœ
™FKšžœ
žœ
™Kšœžœ˜Kšœžœžœ
žœ˜šžœžœ
žœž˜!Kš
œ˜š
œ˜K˜	Kšœžœ˜#—Kšžœžœ˜DKšžœ
˜—Kšœžœ˜,K˜K˜—š
œ$˜$Kšœ<žœžœ
™FKšžœ
žœ
™Kšœžœ˜šžœžœ
žœž˜!Kš
œ˜š
œ˜K˜	Kšœžœ˜#—Kšžœ
˜—K˜K˜—š
œ&˜&Kšœ<žœžœ
™FKšžœ
žœ
™Kšœžœ˜šžœžœ
žœž˜!Kš
œ˜š
œ˜K˜	Kšœžœ˜#—Kšžœ
˜—Kšžœ˜K˜K˜K˜K˜—Kš
œ™Kš
œP™P™@K™HK™
—™BK™C—™GK™D—K™šœ$žœ˜-Kšœ<žœžœ
™FKšžœ
žœ
™Kšœžœžœ
žœ˜Kšœžœ
˜
Kšœžœ
˜
Kšœžœ
˜Kšœ	žœ
˜Kšœ	žœ
˜Kšœžœ
˜
Kš
œ™Kšœžœ
˜Kšœžœžœ
˜$Kšœžœ˜Kš
œJ™JKš
œ ™ Kš
œ1˜1Kš
œ™Kš
œ˜K™+Kš
œ˜K™Kš
œ˜Kš
œ™Kš
œ$˜$Kšœžœ
žœ!˜<Kš
œ<™<Kš
œ"˜"Kš
œ˜š
žœ	žœ
žœ
žœ+žœ˜KKšœžœ
˜
Kš
œ2˜2—Kšžœžœ
˜Kš
œ1™1Kš
œ ˜ š
žœžœ
žœ
žœ)žœ˜GKšœžœ
˜
Kš
œ.˜.—Kšžœžœ
˜Kš
œ-™-K˜K˜šžœžœžœ
žœžœFž˜qJš
œ!˜!—Jšžœ
˜Jšžœžœžœ"˜3J™;šžœžœžœDž˜ZJš
œ™Jšžœ˜Jš
œ˜šžœ	žœ˜Jšžœ#˜%Kš
œ-˜-Kš
œ"˜"Kš
œ-˜-Kš
œ$™$—K˜Kš
œ!˜!—Kšžœ
˜Kšœžœ˜,J˜K˜—K˜K˜—˜K˜TK˜—Kšžœ
˜K˜K˜—™(KšœΟr	™—K™—…—Ox­