<> <> DIRECTORY AMBridge USING [GetWorld, GFHFromTV, IsRemote, RemoteGFHFromTV, TVToCardinal], AMEvents USING [Event], AMTypes USING [Class, DynamicParent, Error, Signal, TVType, TypeClass], BBAction USING [Abort, Action, ActionError, ActionId, Event, ForceChange, NextPendingAction, PeekData, TakeData, WaitForChange], BBBreak USING [AddBreakToList, BreakId, BreakIndex, ClearAllBreaks, ClearBreak, CondProc, FindBreakId, NextBreak, NullIndex], BBBugOut USING [SetDefaultPut], BBContext USING [Context, ContextForLocalFrame, ContextForWorld, GetContents, GetDefaultGlobalContext, SetDefaultGlobalContext], BBDisableBreaks USING [DisableBreakPoints], BBFocus USING [GetDefaultActionAndContext, SameLocalFrame, SetDefaultActionAndContext], BBObjectLocation USING [EntryLocation, ExitLocation, GFandPCFromLocation, IsLocationAtLocation, Location, LocationToSource, TVFromLocation], BBSafety USING [Mother], BBVForUserExec USING [DisplayFrame, SourceFromTV, OpenSource, ReportProc], BBVOps USING [LocationFromSelection, SourceError, ViewerFromLocation], Buttons USING [Button, SetDisplayStyle], Commander USING [CommandProc, Register], Containers USING [ChildXBound, ChildYBound], Convert USING [MapValue, ValueToRope], Labels USING [Create, Label, Set], Menus USING [CreateEntry, CreateMenu, InsertMenuEntry, Menu, MenuProc], PrintTV USING [Print, PrintArguments, PutClosure, PutProc], Process USING [Detach], Rope USING [Cat, Fetch, Flatten, FromRefText, Index, Map, ROPE, Size, Text], RTBasic USING [TV], TypeScript USING [Create, PutChar, TS], VFonts USING [CharWidth, FontHeight], ViewerClasses USING [Viewer], ViewerOps USING [ComputeColumn, CreateViewer], VMenus USING [Create, GetDimensions, VButtonList, ViewerList], WorldVM USING [LocalWorld, World, WorldName]; BBVExec: CEDAR PROGRAM IMPORTS AMBridge, AMTypes, BBAction, BBBreak, BBBugOut, BBContext, BBDisableBreaks, BBFocus, BBObjectLocation, BBSafety, BBVForUserExec, BBVOps, Buttons, Commander, Containers, Convert, Labels, Menus, PrintTV, Process, Rope, TypeScript, VFonts, ViewerOps, VMenus, WorldVM SHARES BBBreak = BEGIN OPEN Rope, RTBasic; Action: TYPE = BBAction.Action; BreakId: TYPE = BBBreak.BreakId; BreakIndex: TYPE = BBBreak.BreakIndex; NullIndex: BreakIndex = BBBreak.NullIndex; Context: TYPE = BBContext.Context; Event: TYPE = AMEvents.Event; Location: TYPE = BBObjectLocation.Location; World: TYPE = WorldVM.World; defaultDepth: NAT _ 3; defaultWidth: NAT _ 32; emWidth: INTEGER; emHeight: INTEGER; headLabel: Labels.Label _ NIL; frameLabel: Labels.Label _ NIL; errorLabel: Labels.Label _ NIL; errorMsg: ROPE _ NIL; -- shadows contents of errorLabel container: ViewerClasses.Viewer _ NIL; watchdogProcess: PROCESS _ NIL; labelMax: NAT _ 64; entryOption: BOOL _ FALSE; exitOption: BOOL _ FALSE; oneShotOption: BOOL _ FALSE; allVarsOption: BOOL _ FALSE; abortNextChar: BOOL _ FALSE; emptyName: ROPE _ " "; ts: TypeScript.TS _ NIL; -- the output for various goodies (init in BuildTool) StripExtension: PROC [name: ROPE] RETURNS [Rope.Text] = { pos: INT _ name.Index[0, "."]; RETURN [name.Flatten[0, pos]] }; BuildTool: Commander.CommandProc = TRUSTED { <<[cmd: Handle]>> <<[in, out, err: IO.STREAM, commandLine: ROPE, command: ROPE, propertyList: List.AList]>> x,y: INTEGER _ 0; xmax,ymax: INTEGER _ 0; vMenuY: INTEGER _ 0; list: VMenus.ViewerList _ NIL; AddLabel: PROC [indent: INTEGER _ 0, trail: INTEGER _ 2] RETURNS [Labels.Label] = TRUSTED { <> <> label: Labels.Label _ NIL; x: INTEGER _ 0; y: INTEGER _ ymax; w: INTEGER _ emWidth * labelMax; h: INTEGER _ emHeight; label _ Labels.Create [[name: emptyName, parent: container, border: FALSE, wx: x + indent, wy: y, ww: w, wh: h]]; x _ label.wx + label.ww - 1; y _ label.wy + label.wh - 1 + trail; IF x > xmax THEN xmax _ x; IF y > ymax THEN ymax _ y; RETURN [label] }; AddVMenu: PROC [name: ROPE, specs: VMenus.VButtonList] = TRUSTED { y _ vMenuY; x _ xmax; list _ VMenus.Create[name, specs, container, x, y]; [,,x,y] _ VMenus.GetDimensions[list]; IF x > xmax THEN xmax _ x; IF y > ymax THEN ymax _ y; }; menu: Menus.Menu _ Menus.CreateMenu[lines: 1]; emWidth _ VFonts.CharWidth['M]; emHeight _ VFonts.FontHeight[]; container _ ViewerOps.CreateViewer[ flavor: $Container, info: [name: "BBV", iconic: TRUE, column: right], paint: TRUE]; <> Menus.InsertMenuEntry [menu: menu, entry: Menus.CreateEntry[name: "ResetDefault!", proc: ResetDefaultHit]]; Menus.InsertMenuEntry [menu: menu, entry: Menus.CreateEntry[name: "Stop!", proc: StopHit]]; Menus.InsertMenuEntry [menu: menu, entry: Menus.CreateEntry[name: "Bigger", proc: BiggerHit]]; Menus.InsertMenuEntry [menu: menu, entry: Menus.CreateEntry[name: "Smaller", proc: SmallerHit]]; container.menu _ menu; <> headLabel _ AddLabel[]; <> frameLabel _ AddLabel[indent: 2 * emWidth]; <> xmax _ 0; vMenuY _ ymax; AddVMenu ["Show stack", LIST [[DisplayTopHit, "This frame"], [DisplayStackHit, "Full stack"], [DisplayStackWithArgsHit, " + Args"], [DisplayStackWithVarsHit, " + Vars"]]]; AddVMenu ["Walk stack", LIST [[CurrentActionHit, "Restart"], [NextFrameHit, "Next/Prev"], [NextWithArgsHit, " + Args"], [NextWithVarsHit, " + Vars"]]]; AddVMenu ["Control", LIST [[SourceHit, "Source"], [ProceedHit, "Proceed"], [AbortHit, "Abort"], [NextActionHit, "Next action"]]]; AddVMenu ["Breaks", LIST [[SetBreakHit, "Set"], [ClearBreakHit, "Clear"], [ClearAllBreaksHit, "Clear *"], [OnOffHit, "on/off"]]]; AddVMenu ["Options", LIST [[AllVarsOptionHit, "allVars"], [EntryOptionHit, "Entry"], [ExitOptionHit, "Exit"], [OneShotOptionHit, "1-shot"]]]; AddVMenu ["Display", LIST [[DisplayBreaksHit, "Breaks"], [DisplayActionsHit, "Actions"], [SignalArgsHit, "Signal"]]]; <> ymax _ ymax + 2; errorLabel _ AddLabel[]; <> ymax _ ymax + 2; ts _ TypeScript.Create [info: [parent: container, wx: 0, wy: ymax, ww: 64, wh: 64], paint: FALSE]; Containers.ChildXBound[container, ts]; Containers.ChildYBound[container, ts]; container.openHeight _ ymax + 128; [] _ BBBugOut.SetDefaultPut[putClosure]; Process.Detach[watchdogProcess _ FORK LabelWatcher[]]; }; EntryOptionHit: Menus.MenuProc = { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; ShowOption[viewer, entryOption _ NOT entryOption]; }; ExitOptionHit: Menus.MenuProc = { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; ShowOption[viewer, exitOption _ NOT exitOption]; }; OneShotOptionHit: Menus.MenuProc = { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; abortNextChar _ FALSE; ShowOption[viewer, oneShotOption _ NOT oneShotOption]; }; AllVarsOptionHit: Menus.MenuProc = { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; abortNextChar _ FALSE; ShowOption[viewer, allVarsOption _ NOT allVarsOption]; }; ResetDefaultHit: Menus.MenuProc = TRUSTED { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; abortNextChar _ FALSE; [] _ BBContext.SetDefaultGlobalContext [BBContext.ContextForWorld[WorldVM.LocalWorld[]]]; }; StopHit: Menus.MenuProc = { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; abortNextChar _ TRUE; }; BiggerHit: Menus.MenuProc = TRUSTED { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; container.openHeight _ container.openHeight + 64; ViewerOps.ComputeColumn[container.column]; }; SmallerHit: Menus.MenuProc = TRUSTED { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; container.openHeight _ container.openHeight - 64; ViewerOps.ComputeColumn[container.column]; }; MyNormalBreak: BBBreak.CondProc = TRUSTED { <<[bid: BreakId, lf: TV, data: REF _ NIL] RETURNS [break: BOOL]>> RETURN [TRUE]; }; MyOneShotBreak: BBBreak.CondProc = { <<[bid: BreakId, lf: TV, data: REF _ NIL] RETURNS [break: BOOL]>> bid.enabled _ FALSE; RETURN [TRUE]; }; SetBreakHit: Menus.MenuProc = { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; innerLoc: PROC = { old: BBObjectLocation.Location _ loc; loc _ NIL; SELECT TRUE FROM forceEntry => loc _ BBObjectLocation.EntryLocation[old]; forceExit => loc _ BBObjectLocation.ExitLocation[old]; ENDCASE => loc _ old; }; inner: PROC = { Kvetch["Setting break..."]; msg _ "invalid location"; IF loc = NIL THEN loc _ BBVOps.LocationFromSelection [world ! BBVOps.SourceError => {msg _ reason; CONTINUE}]; IF loc # NIL THEN { proc: TV _ BBObjectLocation.TVFromLocation[loc]; bid: BreakId _ NIL; msg _ BBSafety.Mother[innerLoc]; IF msg # NIL THEN GO TO bye; [] _ BBVOps.ViewerFromLocation [loc ! BBVOps.SourceError => {msg _ reason; GO TO bye}]; IF loc # NIL THEN { bid: BreakId _ BBBreak.AddBreakToList [loc, IF oneShotOption THEN MyOneShotBreak ELSE MyNormalBreak]; KvetchBreak[bid.index, IF oneShotOption THEN " set (oneShot)" ELSE " set"]; RETURN}; EXITS bye => {}}; Kvetch["Break NOT set: ", msg]; }; forceEntry: BOOL _ entryOption; forceExit: BOOL _ exitOption; loc: Location _ NIL; msg: ROPE _ NIL; world: World _ GetCurrentWorld[]; abortNextChar _ FALSE; BBDisableBreaks.DisableBreakPoints[inner]; IF forceEntry AND forceExit AND loc # NIL THEN { forceEntry _ FALSE; BBDisableBreaks.DisableBreakPoints[inner]}; }; ClearBreakHit: Menus.MenuProc = { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; innerLoc: PROC = { old: BBObjectLocation.Location _ loc; loc _ NIL; SELECT TRUE FROM forceEntry => loc _ BBObjectLocation.EntryLocation[old]; forceExit => loc _ BBObjectLocation.ExitLocation[old]; ENDCASE => loc _ old; }; inner: PROC = { Kvetch["Clearing break..."]; IF loc = NIL THEN loc _ BBVOps.LocationFromSelection [world ! BBVOps.SourceError => {msg _ reason; CONTINUE}]; IF loc # NIL THEN msg _ BBSafety.Mother[innerLoc] ELSE IF msg = NIL THEN msg _ "invalid location"; IF loc # NIL THEN { bx: BreakIndex _ BreakFromLocation[loc]; IF bx # NullIndex THEN { [] _ BBBreak.ClearBreak[bx]; KvetchBreak[bx, " cleared"]} ELSE Kvetch["No such break"]; RETURN}; Kvetch["Break NOT found: ", msg]; }; forceEntry: BOOL _ entryOption; forceExit: BOOL _ exitOption; loc: Location _ NIL; msg: ROPE _ NIL; world: World _ GetCurrentWorld[]; abortNextChar _ FALSE; BBDisableBreaks.DisableBreakPoints[inner]; IF forceEntry AND forceExit AND loc # NIL THEN { forceEntry _ FALSE; BBDisableBreaks.DisableBreakPoints[inner]}; }; SourceHit: Menus.MenuProc = TRUSTED { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; inner: PROC = TRUSTED { action: Action _ NIL; ctx: Context _ NIL; tv, gfTV: TV _ NIL; msg: ROPE _ "Source? What source?"; Kvetch["Finding source..."]; [action, ctx] _ BBFocus.GetDefaultActionAndContext[]; [,gfTV, tv] _ BBContext.GetContents[ctx]; IF tv = NIL THEN tv _ gfTV; IF tv = NIL THEN tv _ BBContext.GetContents[BBContext.GetDefaultGlobalContext[]].gf; IF tv # NIL THEN { <> name: ROPE _ NIL; index: INT _ -1; backupPC: BOOL _ FALSE; SELECT TRUE FROM AMTypes.TypeClass[AMTypes.TVType[tv]] # localFrame => {}; action = NIL OR action.kind # break => {}; BBFocus.SameLocalFrame[action.event.frame, tv] => backupPC _ TRUE; ENDCASE; [name, index] _ BBVForUserExec.SourceFromTV[tv, Report, backupPC]; IF name # NIL THEN BBVForUserExec.OpenSource[name, index, 2, Report]; RETURN; }; Kvetch[msg]; }; abortNextChar _ FALSE; BBDisableBreaks.DisableBreakPoints[inner]; }; ClearAllBreaksHit: Menus.MenuProc = { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; inner: PROC = { Kvetch["Clearing breaks..."]; BBBreak.ClearAllBreaks[MyNormalBreak]; BBBreak.ClearAllBreaks[MyOneShotBreak]; BBBreak.ClearAllBreaks[]; Kvetch["All breaks cleared"]; }; abortNextChar _ FALSE; BBDisableBreaks.DisableBreakPoints[inner]; }; OnOffHit: Menus.MenuProc = { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; inner: PROC = { loc: Location _ NIL; msg: ROPE _ "invalid location"; IF mouseButton = red THEN Kvetch["Enabling break..."] ELSE Kvetch["Disabling break..."]; loc _ BBVOps.LocationFromSelection [ ! BBVOps.SourceError => {msg _ reason; CONTINUE}]; IF loc # NIL THEN { bx: BreakIndex _ BreakFromLocation[loc]; bid: BreakId _ BBBreak.FindBreakId[bx]; IF bx # NullIndex AND bid # NIL THEN { bid.enabled _ mouseButton = red; KvetchBreak[bx, IF bid.enabled THEN " enabled" ELSE " disabled"]} ELSE Kvetch["No such break"]; RETURN }; Kvetch["Break NOT found: ", msg]; }; abortNextChar _ FALSE; BBDisableBreaks.DisableBreakPoints[inner]; }; ProceedHit: Menus.MenuProc = { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; action: Action _ GetCurrentAction[]; IF action = NIL THEN RETURN; Kvetch["Proceeding current action..."]; [] _ BBAction.TakeData[action ! ANY => CONTINUE]; Kvetch["Proceeded."]; }; AbortHit: Menus.MenuProc = { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; action: Action _ GetCurrentAction[]; IF action = NIL THEN RETURN; Kvetch["Aborting current action..."]; BBFocus.SetDefaultActionAndContext[NIL, NIL]; BBAction.Abort[action ! ANY => CONTINUE]; Kvetch["Aborted."]; }; DisplayTopHit: Menus.MenuProc = { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; action: Action _ GetCurrentAction[]; ctx: Context _ BBFocus.GetDefaultActionAndContext[].ctx; lf: TV _ BBContext.GetContents[ctx].lf; IF action = NIL OR lf = NIL THEN RETURN; Kvetch["Displaying current frame..."]; DisplayLocalFrame[lf, TRUE, TRUE]; }; NextFrameHit: Menus.MenuProc = { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; delta: INT _ 1; action: Action _ GetCurrentAction[]; IF action = NIL THEN RETURN; IF mouseButton # red THEN delta _ -1; Kvetch["Walking..."]; DisplayLocalFrame[WalkContext[delta]]; }; NextWithArgsHit: Menus.MenuProc = { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; delta: INT _ 1; action: Action _ GetCurrentAction[]; IF action = NIL THEN RETURN; IF mouseButton # red THEN delta _ -1; Kvetch["Walking..."]; DisplayLocalFrame[WalkContext[delta], TRUE]; }; NextWithVarsHit: Menus.MenuProc = { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; delta: INT _ 1; action: Action _ GetCurrentAction[]; IF action = NIL THEN RETURN; IF mouseButton # red THEN delta _ -1; Kvetch["Walking..."]; DisplayLocalFrame[WalkContext[delta], TRUE, TRUE]; }; DisplayBreaksHit: Menus.MenuProc = { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; Kvetch["Displaying breaks..."]; putRope["\n"]; FOR i: BreakIndex _ BBBreak.NextBreak[NullIndex], BBBreak.NextBreak[i] WHILE NOT (i = NullIndex) DO bid: BreakId _ BBBreak.FindBreakId[i]; IF bid # NIL THEN -- display this break with optional verbosity DisplayBreak[bid, mouseButton = blue]; ENDLOOP; Kvetch[]; }; DisplayActionsHit: Menus.MenuProc = { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; Kvetch["Displaying actions..."]; putRope["\n"]; FOR action: Action _ BBAction.NextPendingAction[NIL], BBAction.NextPendingAction[action] WHILE action # NIL DO DisplayAction[action, mouseButton = blue]; ENDLOOP; Kvetch[]; }; DisplayStackHit: Menus.MenuProc = { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; action: Action _ GetCurrentAction[]; IF action = NIL THEN RETURN; Kvetch["Displaying stack..."]; DisplayStack[]; }; DisplayStackWithArgsHit: Menus.MenuProc = { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; action: Action _ GetCurrentAction[]; IF action = NIL THEN RETURN; Kvetch["Displaying stack..."]; DisplayStack[TRUE]; }; DisplayStackWithVarsHit: Menus.MenuProc = { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; action: Action _ GetCurrentAction[]; IF action = NIL THEN RETURN; Kvetch["Displaying stack..."]; DisplayStack[TRUE, TRUE]; }; CurrentActionHit: Menus.MenuProc = { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; context: Context _ NIL; action: Action _ GetCurrentAction[]; IF action = NIL THEN RETURN; Kvetch["Walking to the top..."]; context _ BBContext.ContextForLocalFrame[action.event.frame]; BBFocus.SetDefaultActionAndContext[action, context]; BBAction.ForceChange[]; Kvetch[]; }; NextActionHit: Menus.MenuProc = { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; action: Action _ NIL; context: Context _ NIL; Kvetch["Next action..."]; abortNextChar _ FALSE; [action, context] _ BBFocus.GetDefaultActionAndContext[]; action _ BBAction.NextPendingAction[action]; IF action # NIL THEN IF action.status # pendingOut THEN action _ NIL ELSE context _ BBContext.ContextForLocalFrame[action.event.frame]; BBFocus.SetDefaultActionAndContext[action, context]; BBAction.ForceChange[]; Kvetch[]; }; SignalArgsHit: Menus.MenuProc = TRUSTED { <<[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]>> viewer: ViewerClasses.Viewer _ NARROW[parent]; context: Context _ NIL; sigTV, lfTV: TV _ NIL; tryFrame: BOOL _ TRUE; errmsg: ROPE _ NIL; action: Action _ GetCurrentAction[]; inner: PROC = TRUSTED { sigTV _ AMTypes.Signal[lfTV]; putRope["signal: "]; DisplayTV[sigTV]; putRope[" args: "]; IF tryFrame THEN {PrintTV.PrintArguments[lfTV, putClosure]; putChar['\n]} ELSE DisplayTV[lfTV]; }; IF action = NIL THEN RETURN; [action, context] _ BBFocus.GetDefaultActionAndContext[]; IF action = NIL OR context = NIL THEN RETURN; Kvetch["Signal arguments..."]; lfTV _ BBContext.GetContents[context].lf; sigTV _ AMTypes.Signal [lfTV ! AMTypes.Error => {tryFrame _ FALSE; CONTINUE}; ABORTED => REJECT; ANY => CONTINUE]; IF sigTV = NIL AND action.kind = signal THEN { event: Event _ action.event; WITH e: event SELECT FROM signal => {sigTV _ e.signal; lfTV _ e.args}; ENDCASE; }; IF sigTV = NIL THEN {Kvetch["Signal? What signal?"]; RETURN}; errmsg _ BBSafety.Mother[inner]; IF errmsg = NIL THEN {Kvetch[]; RETURN}; Kvetch["Can't get signal arguments: ", errmsg]; }; <> <> putProc: PrintTV.PutProc = TRUSTED { <<[data: REF, c: CHAR]>> IF abortNextChar THEN { <> abortNextChar _ FALSE; TypeScript.PutChar[ts, '\n]; KvetchMore[" aborted."]; ERROR ABORTED}; TypeScript.PutChar[ts, c]; }; putClosure: PrintTV.PutClosure _ [putProc, NIL]; putChar: PROC [c: CHAR] = {putProc[NIL, c]}; putCharB: PROC [c: CHAR] RETURNS [BOOL] = {putProc[NIL, c]; RETURN [FALSE]}; putRope: PROC [r: ROPE] = {[] _ Rope.Map[base: r, action: putCharB]}; putRopes: PROC [r1,r2,r3,r4,r5,r6: ROPE _ NIL] = { IF r1 # NIL THEN putRope[r1]; IF r2 # NIL THEN putRope[r2]; IF r3 # NIL THEN putRope[r3]; IF r4 # NIL THEN putRope[r4]; IF r5 # NIL THEN putRope[r5]; IF r6 # NIL THEN putRope[r6]; }; putInt: PROC [int: INT] = {Convert.MapValue[putChar, [signed[int]]]}; putCard: PROC [card: LONG CARDINAL] = { Convert.MapValue[putChar, [unsigned[card, 8]]]; putChar['B]; }; DisplayAction: PROC [action: Action, verbose: BOOL _ FALSE] = TRUSTED { event: AMEvents.Event _ NIL; IF action = NIL THEN RETURN; event _ action.event; putRope["Action #"]; putInt[action.id]; SELECT action.status FROM pendingOut => {}; new => putRope[" (new)"]; busy => putRope[" (busy)"]; pendingIn => putRope[" (pendingIn)"]; dead => putRope[" (dead)"]; new => putRope[" (new)"]; ENDCASE => putRope[" (??)"]; putRope[", process = "]; putCard[AMBridge.TVToCardinal[action.event.process]]; IF event.world # WorldVM.LocalWorld[] THEN putRopes[", world = ", WorldVM.WorldName[event.world]]; putChar['\n]; DisplayLocalFrame[event.frame]; WITH e: event SELECT FROM break => IF action.status = pendingOut THEN { ref: REF _ NIL; ref _ BBAction.PeekData[action ! BBAction.ActionError => CONTINUE]; WITH ref SELECT FROM bid: BreakId => DisplayBreak[bid, verbose]; ENDCASE => putRope["break ??"]; }; call => putRopes["callDebugger[", e.msg, "]"]; signal => { putRope["uncaught "]; DisplayTV[e.signal, FALSE]; IF e.args # NIL THEN { putRope["["]; DisplayTV[e.args, FALSE]; putRope["]"]}; }; interrupt => putRope["interrupt"]; unknown => putRopes["???? ", e.why]; ENDCASE; putChar['\n]; }; DisplayBreak: PROC [break: BreakId, verbose: BOOL _ FALSE] = TRUSTED { loc: Location _ break.loc; IF loc = NIL THEN RETURN; putRope["Break #"]; putInt[break.index]; putRope[" in "]; DisplayTV[BBObjectLocation.TVFromLocation[break.loc], FALSE]; putRope[" (source: "]; putInt[BBObjectLocation.LocationToSource[loc].sourceIndex]; IF verbose THEN { gf: TV _ NIL; pc, gfh: CARDINAL _ 0; [gf, pc] _ BBObjectLocation.GFandPCFromLocation[loc]; IF AMBridge.IsRemote[gf] THEN { putRope[", world: "]; putRope[WorldVM.WorldName[AMBridge.GetWorld[gf]]]; gfh _ LOOPHOLE[AMBridge.RemoteGFHFromTV[gf].gfh, CARDINAL]} ELSE gfh _ LOOPHOLE[AMBridge.GFHFromTV[gf], CARDINAL]; putRope[", gfh: "]; putCard[gfh]; putRope[", pc: "]; putCard[pc]; }; putRope[")\n"]; }; DisplayLocalFrame: PROC [lf: TV, args,vars: BOOL _ FALSE] = TRUSTED { IF lf = NIL THEN RETURN; putChar['\n]; BBVForUserExec.DisplayFrame[ frame: lf, put: putClosure, report: Report, args: args, vars: vars, allVars: vars AND allVarsOption]; }; DisplayStack: PROC [args,vars: BOOL _ FALSE] = TRUSTED { current: TV _ NIL; context: Context _ NIL; action: Action _ NIL; [action, context] _ BBFocus.GetDefaultActionAndContext[]; IF action = NIL OR context = NIL THEN RETURN; abortNextChar _ FALSE; current _ BBContext.GetContents[context].lf; WHILE current # NIL DO DisplayLocalFrame[current, args, vars]; current _ AMTypes.DynamicParent[current]; ENDLOOP; }; DisplayTV: PROC [tv: TV, newLine: BOOL _ TRUE] = TRUSTED { PrintTV.Print[tv, putClosure, defaultDepth, defaultWidth]; IF newLine THEN putProc[NIL, '\n]; }; <> WalkContext: PROC [delta: INT _ 1] RETURNS [lf: TV _ NIL] = TRUSTED { current: TV _ NIL; context: Context _ NIL; action: Action _ NIL; [action, context] _ BBFocus.GetDefaultActionAndContext[]; IF action = NIL OR context = NIL THEN RETURN; abortNextChar _ FALSE; current _ BBContext.GetContents[context].lf; IF current = NIL THEN {Kvetch["What current frame?"]; RETURN}; SELECT delta FROM < 0 => { <> lag: TV _ lf _ action.event.frame; -- start at top lagDist: INT _ 0; IF BBFocus.SameLocalFrame[lf, current] THEN lf _ NIL; WHILE lf # NIL DO next: TV _ AMTypes.DynamicParent[lf]; IF abortNextChar THEN { abortNextChar _ FALSE; Kvetch["Walk aborted!"]; ERROR ABORTED}; IF BBFocus.SameLocalFrame[lf, current] THEN { <> lf _ lag; EXIT}; SELECT delta FROM = -1 => lag _ lf; < lagDist => lagDist _ lagDist - 1; ENDCASE => lag _ AMTypes.DynamicParent[lag]; lf _ next; IF next = NIL THEN EXIT; ENDLOOP; }; > 0 => { <> lf _ AMTypes.DynamicParent[current]; WHILE (delta _ delta - 1) > 0 AND lf # NIL DO next: TV _ AMTypes.DynamicParent[lf]; IF abortNextChar THEN { abortNextChar _ FALSE; Kvetch["Walk aborted!"]; ERROR ABORTED}; IF next = NIL THEN EXIT; lf _ next; ENDLOOP; }; ENDCASE; IF lf = NIL THEN {Kvetch["No context change."] ; RETURN}; context _ BBContext.ContextForLocalFrame[lf]; BBFocus.SetDefaultActionAndContext[action, context]; BBAction.ForceChange[]; }; GetCurrentAction: PROC RETURNS [action: Action] = TRUSTED { abortNextChar _ FALSE; action _ BBFocus.GetDefaultActionAndContext[].action; IF action = NIL OR action.status # pendingOut THEN { Kvetch["No current action."]; action _ NIL}; }; GetCurrentWorld: PROC [context: Context _ NIL] RETURNS [world: World] = TRUSTED { abortNextChar _ FALSE; IF context = NIL THEN { context _ BBFocus.GetDefaultActionAndContext[].ctx; IF context = NIL THEN context _ BBContext.GetDefaultGlobalContext[]}; world _ BBContext.GetContents[context].world; IF world = NIL THEN world _ WorldVM.LocalWorld[]; }; ShowOption: PROC [button: Buttons.Button, flag: BOOL] = TRUSTED { IF flag THEN Buttons.SetDisplayStyle[button, $WhiteOnBlack] ELSE Buttons.SetDisplayStyle[button, $BlackOnWhite]; }; BreakFromLocation: PROC [loc: Location] RETURNS [BreakIndex] = { <> IF loc = NIL THEN RETURN [NullIndex]; FOR i: BreakIndex _ BBBreak.NextBreak[NullIndex], BBBreak.NextBreak[i] WHILE NOT (i = NullIndex) DO bid: BreakId _ BBBreak.FindBreakId[i]; IF bid # NIL THEN -- see if this one is the right one IF BBObjectLocation.IsLocationAtLocation[loc, bid.loc] THEN RETURN [i] ENDLOOP; RETURN [NullIndex] }; Kvetch: PROC [msg1,msg2,msg3,msg4: ROPE _ NIL] = TRUSTED { msg: ROPE _ Rope.Cat[msg1,msg2,msg3,msg4]; IF msg = NIL THEN msg _ emptyName; Labels.Set[errorLabel, errorMsg _ msg]; }; KvetchMore: PROC [msg1,msg2,msg3,msg4: ROPE _ NIL] = TRUSTED { msg: ROPE _ Rope.Cat[errorMsg, msg1,msg2,msg3,msg4]; IF msg = NIL THEN msg _ emptyName; Labels.Set[errorLabel, errorMsg _ msg]; }; Report: BBVForUserExec.ReportProc = { Kvetch[msg]; }; KvetchBreak: PROC [break: BreakIndex, msg1,msg2: ROPE _ NIL] = TRUSTED { Kvetch["Break #", RopeFromInt[break], msg1, msg2]; }; RopeFromInt: PROC [int: INT] RETURNS [ROPE] = { RETURN [Convert.ValueToRope[[signed[int]]]]; }; LabelWatcher: PROC = { changeNum: INT _ 0; action, lastAction: Action _ NIL; event: Event _ NIL; maxReportedId: BBAction.ActionId _ 0; ctx, lastCtx: Context _ NIL; max: NAT _ labelMax; buffer: REF TEXT _ NEW[TEXT[max]]; oldDefCtx: Context _ NIL; inner: PROC = TRUSTED { localMax: BBAction.ActionId _ maxReportedId; defCtx: Context _ NIL; changeNum _ BBAction.WaitForChange[changeNum]; IF container.destroyed THEN RETURN; [action, ctx] _ BBFocus.GetDefaultActionAndContext[]; event _ NIL; IF action = NIL OR action.status # pendingOut THEN <> BBFocus.SetDefaultActionAndContext[action _ NIL, ctx _ NIL]; FOR act: Action _ BBAction.NextPendingAction[NIL], BBAction.NextPendingAction[act] WHILE act # NIL DO <> IF act.status # pendingOut THEN LOOP; IF act.id <= maxReportedId THEN EXIT; putRope["\n"]; DisplayAction[act]; IF act.id > localMax THEN localMax _ act.id; IF action = NIL THEN {action _ act; ctx _ NIL}; ENDLOOP; maxReportedId _ localMax; IF action # NIL AND ctx = NIL THEN ctx _ BBContext.ContextForLocalFrame[action.event.frame]; defCtx _ BBContext.GetDefaultGlobalContext[]; IF action # lastAction OR ctx # lastCtx OR defCtx # oldDefCtx THEN { <> addChar: PROC [c: CHAR] = TRUSTED { IF len < max THEN {buffer[len] _ c; len _ len + 1} }; addRope: PROC [r: ROPE] = TRUSTED { FOR i: INT IN [0..r.Size[]) DO addChar[r.Fetch[i]]; ENDLOOP; }; setLabel: PROC [label: Labels.Label] = TRUSTED { msg: ROPE _ NIL; buffer.length _ len; msg _ Rope.FromRefText[buffer]; IF msg.Size[] = 0 THEN msg _ emptyName; Labels.Set[label, msg]; len _ 0; max _ labelMax; }; len: NAT _ 0; putProc: PrintTV.PutProc = TRUSTED {addChar[c]}; world: World _ GetCurrentWorld[ctx]; <> kind: ROPE _ NIL; tv: TV _ NIL; tempCtx: Context _ ctx; max _ labelMax; IF action # NIL AND action.status # dead THEN { <> event: Event _ action.event; SELECT action.kind FROM break => kind _ "break"; signal => kind _ "signal"; other => kind _ "other"; ENDCASE => kind _ "??"; addRope["Action #"]; Convert.MapValue[addChar, [signed[action.id]]]; addRope[", "]; addRope[kind]; IF event # NIL THEN { addRope[", process = "]; Convert.MapValue [addChar, [unsigned[AMBridge.TVToCardinal[event.process], 8]]]; addRope["B"]}; }; IF len = 0 THEN addRope["No action"]; IF world # NIL THEN { addRope[", world = "]; addRope[WorldVM.WorldName[world]]}; setLabel[headLabel]; IF tempCtx = NIL THEN tempCtx _ defCtx; tv _ BBContext.GetContents[tempCtx].lf; IF tv = NIL THEN tv _ BBContext.GetContents[tempCtx].gf; IF tv # NIL THEN PrintTV.Print[tv: tv, put: [putProc]]; setLabel[frameLabel]; BBFocus.SetDefaultActionAndContext[lastAction _ action, lastCtx _ ctx]; oldDefCtx _ defCtx; }; }; each: PROC = TRUSTED { msg: ROPE _ BBSafety.Mother[inner]; IF msg # NIL THEN putRopes["\nBELCH! Error in reporting loop: ", msg, "\n"]; }; WHILE NOT container.destroyed DO BBDisableBreaks.DisableBreakPoints[each ! ABORTED => EXIT]; ENDLOOP; watchdogProcess _ NIL; }; Init: PROC = TRUSTED { IF watchdogProcess # NIL THEN RETURN; Commander.Register[ "bbv", BuildTool, "BBV is an alternative interface to some BugBane commands."]; }; Init[]; END.