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[];
build up the menu
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;
Create the specials table and register the &-procs
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 {
[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.
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 {
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
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 {
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
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 = {
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
viewer: ViewerClasses.Viewer ← NARROW[parent];
data: ClientData ← NARROW[clientData];
IF data.list =
NIL
THEN {
Report[data, "\nNo breaks to clear."];
RETURN};
actually clear the breaks
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 = {
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
viewer: ViewerClasses.Viewer ← NARROW[parent];
data: ClientData ← NARROW[clientData];
IF data.list =
NIL
THEN {
Report[data, "\nNo current breaks."];
RETURN};
actually clear the breaks
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 {
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
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 {
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
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 {
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
viewer: ViewerClasses.Viewer ← NARROW[parent];
data: ClientData ← NARROW[clientData];
ViewerTools.SetSelection[data.exprViewer, NIL];
};
utility procs
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 {
... returns the first breakpoint index for the given location. There can be multiple breakpoints for a given location, remember.
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];
If we are recursive here, then we DON'T want to take the breakpoint.
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 = {
[msg: ROPE, severity: Severity]
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 {
try to find the module name as well
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];
};
The EvalQuote procs
EvqAbort: EvalQuote.EvalQuoteProc = {
[head: EvalHead, tree: Tree, target: Type ← nullType, data: REF ← NIL]
RETURNS [return: TV]
ERROR ABORTED;
};
EvqBreak: EvalQuote.EvalQuoteProc = {
[head: EvalHead, tree: Tree, target: Type ← nullType, data: REF ← NIL]
RETURNS [return: TV]
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 = {
[head: EvalHead, tree: Tree, target: Type ← nullType, data: REF ← NIL]
RETURNS [return: TV]
ERROR Break1;
};
EvqDo: EvalQuote.EvalQuoteProc = {
[head: EvalHead, tree: Tree, target: Type ← nullType, data: REF ← NIL]
RETURNS [return: TV]
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 = {
[head: EvalHead, tree: Tree, target: Type ← nullType, data: REF ← NIL]
RETURNS [return: TV]
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 {
[head: EvalHead, tree: Tree, target: Type ← nullType, data: REF ← NIL]
RETURNS [return: TV]
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 {
[head: EvalHead, tree: Tree, target: Type ← nullType, data: REF ← NIL]
RETURNS [return: TV]
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 = {
[head: EvalHead, tree: Tree, target: Type ← nullType, data: REF ← NIL]
RETURNS [return: TV]
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 = {
[head: EvalHead, tree: Tree, target: Type ← nullType, data: REF ← NIL]
RETURNS [return: TV]
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 = {
[head: EvalHead, tree: Tree, target: Type ← nullType, data: REF ← NIL]
RETURNS [return: TV]
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];
};
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
EvqStack: EvalQuote.EvalQuoteProc =
TRUSTED {
[head: EvalHead, tree: Tree, target: Type ← nullType, data: REF ← NIL]
RETURNS [return: TV]
buffer: STREAM = IO.ROS[];
start: TV;
er1: ROPE;
end: TV;
terseTV: TV;
verbose: BOOL;
er2: ROPE;
I want my...
mtv: TV;
startProc, endProc: Rope.ROPE ← NIL;
cd: ClientData = NARROW[data];
cd.list.where contains a list of the procedures where breakpoints occurred
from most recent to least recent
lf: FrameHandle ← PrincOpsUtils.GetReturnFrame[];
first argument should be V or T
arg1: Tree ← GetArg[tree, 1];
-- second argument should be Procedure name
arg2: Tree ← GetArg[tree, 2];
-- as should third argument
arg3: Tree ← GetArg[tree, 3];
this will be an atom
[terseTV,er1] ← EvalTree[cd, arg1];
verbose ← terseTV # NIL AND AMBridge.TVToATOM[terseTV] # $T;
and the next two will either be atoms or names of procedures
[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;
at this point startProc is the starting procedure
[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;
and endProc is the ending procedure if end=$E
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];
now start to print out the call stack till you get to arg3
UNTIL ((mtv=
NIL)
OR (Rope.Equal[AMTypes.TVToName[AMTypes.Procedure[mtv]], endProc]) )
DO
and lastly, print it out
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];
wind your way back up the call stack
};
mtv ← AMTypes.DynamicParent[mtv];
ENDLOOP;
AtomicWrite[cd.log, IO.RopeFromROS[buffer]];
};
Commander.Register[
"BreakTool", BuildTool, "provides support for logging and conditional breakpoints."]
END.