<> <> <> <> <> <> <> 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 { <<[data: FastBreakData, frame: PrincOps.FrameHandle, sv: PrincOps.SVPointer]>> <> <> 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}; <> 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}; <> 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]; }; <> 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]; <> 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 { <> 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 = { <<[head: EvalHead, tree: Tree, target: Type _ nullType, data: REF _ NIL]>> <> ERROR ABORTED; }; EvqBreak: EvalQuote.EvalQuoteProc = { <<[head: EvalHead, tree: Tree, target: Type _ nullType, data: REF _ NIL]>> <> 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]>> <> ERROR Break1; }; EvqDo: EvalQuote.EvalQuoteProc = { <<[head: EvalHead, tree: Tree, target: Type _ nullType, data: REF _ NIL]>> <> 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]>> <> 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]>> <> 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]>> <> 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]>> <> 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]>> <> 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]>> <> 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]; }; <> <> <<1st argument - V or T - for verbose(V) or terse (default terse)>> <> <> <<2nd argument - starting procedure (default EvaluateImpl.EvalApply)>> <> <<3rd arument - ending procedure (defaul CommandToolImpl.CommandToolBase)>> <> <<>> EvqStack: EvalQuote.EvalQuoteProc = TRUSTED { <<[head: EvalHead, tree: Tree, target: Type _ nullType, data: REF _ NIL]>> <> 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]; <<-- second argument should be Procedure name>> arg2: Tree _ GetArg[tree, 2]; <<-- as should third argument>> 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. <> <> <<>>