BBVExtrasImpl
Warren Teitelman, April 22, 1983 2:53 pm
DIRECTORY
AMBridge USING [GetWorld],
AMTypes USING [DynamicParent, GlobalParent, TypeClass, TVType],
BBAction USING [Action, PeekData],
BBBreak USING [AddBreakToList, BreakId, BreakIndex, ClearBreak, ClearAllBreaks, FindBreakId, NextBreak, NullIndex],
BBContext USING [Context, GetContents, FindAction, FindMatchingGlobalFrames],
BBFocus USING [SameLocalFrame],
BBObjectLocation USING [LocationToSource, SourceToLocation, EntryLocation, ExitLocation, TVFromLocation, Location],
BBSafety USING [Mother],
BBVForUserExec USING [ClearBreak, OpenSource, ReportProc, Severity, SourceFromTV],
BBVOps USING [ViewerFromLocation, SourceError],
BBVExtras USING [],
Convert USING [ValueToRope],
IO USING [PutF, PutRope, int, rope, tv, ROPE, STREAM, TV, ROS, GetOutputStreamRope],
MessageWindow USING [Clear],
PrintTV USING [PutClosure, PutProc, Print, PrintArguments, PrintVariables],
Rope USING [Cat, Find, Concat, Text, Length, Fetch, Flatten],
ViewerClasses USING [Viewer],
ViewerTools USING [FindExistingViewer],
WorldVM USING [LocalWorld, World, WorldName]
;
BBVExtrasImpl: CEDAR PROGRAM
IMPORTS AMBridge, AMTypes, BBAction, BBBreak, BBContext, BBFocus, BBObjectLocation, BBSafety, BBVForUserExec, BBVOps, Convert, IO, MessageWindow, PrintTV, Rope, ViewerTools, WorldVM
EXPORTS BBVExtras
SHARES IO
= BEGIN OPEN IO;
ReportProc: TYPE = BBVForUserExec.ReportProc;
Action: TYPE = BBAction.Action;
TV: TYPE = IO.TV;
ShowBreakPoint: PUBLIC PROCEDURE [break: BBBreak.BreakIndex, report: ReportProc] = {
Report: ReportProc = {Report[msg, severity]};
breakId: BBBreak.BreakId;
IF break = BBBreak.NullIndex THEN RETURN;
breakId ← BBBreak.FindBreakId[break];
IF breakId # NIL THEN
[] ← BBVOps.ViewerFromLocation[breakId.loc ! BBVOps.SourceError => {report[reason, fatal]; CONTINUE}];
[name, index] ← BBVForUserExec.SourceFromTV[
tv: BBObjectLocation.TVFromLocation[breakId.loc],
report: Report];
IF name # NIL THEN BBVForUserExec.OpenSource[name: name, index: index, report: Report];
};
ClearSelectedBreakPoint: PUBLIC PROC [world: WorldVM.World, report: ReportProc] = TRUSTED { -- unsafe discrimination
MessageWindow.Clear[];
[] ← BBVForUserExec.ClearBreak[report: report, world: world];
};
ClearActionBreakPoint: PUBLIC PROC [action: Action, report: ReportProc] = TRUSTED { -- unsafe discrimination
bx: BBBreak.BreakIndex;
MessageWindow.Clear[];
IF action = NIL THEN {report["Not an action, no break cleared.", fatal]; RETURN};
WITH e: action.event SELECT FROM
break => {
WITH BBAction.PeekData[action] SELECT FROM
breakID: BBBreak.BreakId => bx ← breakID.index;
ENDCASE => GOTO Bogus;
};
ENDCASE => GOTO Bogus;
report["Clearing break...", comment];
[] ← BBBreak.ClearBreak[bx];
report[Rope.Concat["Break #", Convert.ValueToRope[[signed[bx]]]], success];
EXITS
Bogus => report["No breakpoint associated with this action.", fatal];
};
ClearAllBreaks: PUBLIC PROC [report: ReportProc] ={
report["Clearing breaks...", comment];
BBBreak.ClearAllBreaks[];
report["All breaks cleared", success];
};
ShowSource: PUBLIC PROC [tv: TV, report: ReportProc, onlyIfAlreadyOpen: BOOLFALSE] = {
IF tv # NIL THEN
{-- we have a live one!
name: ROPE;
viewer: ViewerClasses.Viewer;
index: INT;
[name, index] ← BBVForUserExec.SourceFromTV[tv, report];
IF name = NIL THEN RETURN
ELSE IF NOT onlyIfAlreadyOpen THEN NULL
ELSE IF (viewer ← ViewerTools.FindExistingViewer[name]) = NIL OR viewer.iconic THEN RETURN;
BBVForUserExec.OpenSource[name: name, index: index, report: report];
-- it would be nice if we could print the source without having to steal the input focus.
};
};
WalkContext: PUBLIC PROC [action: Action, context: BBContext.Context, delta: INT, report: ReportProc] RETURNS [lf: TV] = {
current: TVNIL;
IF action = NIL OR context = NIL THEN {report["No context!", fatal]; RETURN};
current ← BBContext.GetContents[context].lf;
IF current = NIL THEN {report["What current frame?", fatal]; RETURN};
SELECT delta FROM
= 0 => { -- start at top
lf ← action.event.frame;
};
< 0 => { -- advance one frame "later" in frame order
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 BBFocus.SameLocalFrame[lf, current] THEN
{-- found it! (or something close)
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 => { -- advance one frame "earlier" in frame order
lf ← AMTypes.DynamicParent[current];
WHILE (delta ← delta - 1) > 0 AND lf # NIL DO
next: TV ← AMTypes.DynamicParent[lf];
IF next = NIL THEN EXIT;
lf ← next;
ENDLOOP;
IF lf = NIL THEN report["Can't go any further.", warning];
};
ENDCASE;
};
ListBreaks: PUBLIC PROC [out: IO.STREAM] = {
oneFound: BOOLFALSE;
FOR i: BBBreak.BreakIndex ← BBBreak.NextBreak[BBBreak.NullIndex], BBBreak.NextBreak[i] WHILE NOT (i = BBBreak.NullIndex) DO
bid: BBBreak.BreakId ← BBBreak.FindBreakId[i];
IF bid # NIL THEN -- display this break
{oneFound ← TRUE; PrintBreak[out, bid]};
ENDLOOP;
IF NOT oneFound THEN out.PutF["*nNo Breaks set."];
};
PrintBreak: PUBLIC PROC [out: IO.STREAM, break: BBBreak.BreakId] = TRUSTED {
bbtv: TV = BBObjectLocation.TVFromLocation[break.loc];
world: WorldVM.World = WorldVM.LocalWorld[];
out.PutF["*nBreak #%d in %g", int[break.index], tv[bbtv]];
IF world # AMBridge.GetWorld[bbtv] THEN
out.PutF[", in %g,", rope[WorldVM.WorldName[AMBridge.GetWorld[bbtv]]]];
out.PutF[" (source: %d)\n", int[BBObjectLocation.LocationToSource[break.loc].sourceIndex]];
};
DisplayLocalFrame: PUBLIC PROC [out: IO.STREAM, lf: TV, report: ReportProc, args, vars, allVars, globals, lfAndPc: BOOLFALSE] = {
StreamToPutClosure: PROC [stream: STREAM] RETURNS[PrintTV.PutClosure] = {
RETURN[PrintTV.PutClosure[proc: LOOPHOLE[stream.streamProcs.putChar, PrintTV.PutProc], data: stream]];
};
s: STREAM = IO.ROS[];
r: ROPE;
i: INT;
put: PrintTV.PutClosure;
IF lf = NIL THEN RETURN;
MessageWindow.Clear[];
following cloned from BBVOpsImpl.DisplayFrame
report["Displaying frame...", comment];
IF AMTypes.TypeClass[AMTypes.TVType[lf]] # localFrame THEN
{report["Not a local frame!", fatal]; RETURN};
PrintTV.Print[tv: lf, put: StreamToPutClosure[s], depth: 1, verbose: lfAndPc]; -- to get the lf and pc
r ← s.GetOutputStreamRope[];
i ← Rope.Find[s1: r, s2: "("];
out.PutF["%g", rope[r]];
put ← StreamToPutClosure[out];
IF args THEN
{out.PutRope["\nA- "];
PrintTV.PrintArguments[tv: lf, put: put, breakBetweenItems: TRUE];
};
IF vars THEN
{out.PutRope["\nV- "];
PrintTV.PrintVariables[tv: lf, put: put, all: allVars, breakBetweenItems: TRUE];
};
IF globals THEN
{out.PutRope["\nG- "];
PrintTV.PrintVariables[tv: AMTypes.GlobalParent[lf], put: put];
};
out.PutRope["\n"];
report[NIL, success];
MessageWindow.Clear[]; -- to clear out the displaying frame message.
};
ReportBreak: PROC
[report: ReportProc, break: BBBreak.BreakIndex, msg: ROPENIL, entry, exit: BOOLFALSE] = {
decimal: ROPE ← Convert.ValueToRope[[signed[break]]];
kind: ROPEIF entry THEN " (entry)" ELSE IF exit THEN " (exit)" ELSE NIL;
lagLagMsg ← lagMsg;
lagMsg ← msg ← Rope.Cat["Break #", decimal, kind, msg];
lagMsg ← msg ← Rope.Cat["Break #", decimal, kind, msg];
report[Rope.Cat["Break #", decimal, kind, msg], success];
};
StripExtension: PROC [name: ROPE, stripDir: BOOLFALSE] RETURNS [Rope.Text] = {
pos: INT ← name.Length[];
start: INT ← 0;
WHILE (pos ← pos - 1) >= 0 DO
IF name.Fetch[pos] = '. THEN EXIT;
ENDLOOP;
IF pos < 0 THEN pos ← name.Length[];
IF stripDir THEN
{start ← pos-1;
WHILE start > 0 DO
SELECT name.Fetch[start ← start - 1] FROM
'/, '\\, '[, '], '<, '> =>
{start ← start + 1; EXIT};
ENDCASE;
ENDLOOP;
};
RETURN [name.Flatten[start, pos-start]];
};
SetBreakFromPosition: PUBLIC PROC [report: ReportProc, viewer: ViewerClasses.Viewer, position: INT, world: WorldVM.World ← NIL, entry, exit: BOOLFALSE]
RETURNS [break: BBBreak.BreakIndex ← BBBreak.NullIndex] = TRUSTED {
set a new breakpoint at the current selection
returns BBBreak.NullIndex if not successful
world = NIL => use LocalWorld
entry forces entry-point breakpoint, exit goes to the end
(can set both entry & exit breakpoints)
loc: BBObjectLocation.Location ← NIL;
msg: ROPENIL;
both: BOOL ← entry AND exit;
inner: PROC = TRUSTED {
break ← BBBreak.AddBreakToList[loc].index;
};
report["Setting break...", comment];
loc ← LocationFromSelection[report, viewer, position, world, entry, exit];
IF loc # NIL THEN {
msg ← BBSafety.Mother[inner];
IF msg # NIL THEN GO TO noGood;
ReportBreak[report, break, " set.", entry, exit];
IF NOT both THEN RETURN;
loc ← BBObjectLocation.ExitLocation[loc];
IF loc = NIL THEN GO TO noGood;
msg ← BBSafety.Mother[inner];
IF msg # NIL THEN GO TO noGood;
ReportBreak[report, break, " set.", FALSE, exit];
RETURN;
EXITS noGood => {};
};
IF msg = NIL THEN msg ← "no such location";
report[Rope.Concat["Break not set: ", msg], fatal];
};
LocationFromSelection: PROC [report: ReportProc, viewer: ViewerClasses.Viewer, pos: INT, world: WorldVM.World ← NIL, entry, exit: BOOLFALSE] RETURNS [loc: BBObjectLocation.Location ← NIL] = TRUSTED {
msg: ROPENIL;
inner: PROC = TRUSTED {
IF viewer = NIL THEN {msg ← "no selected viewer"; RETURN};
{
gname: ROPE ← StripExtension[viewer.name, TRUE];
gframe: TVNIL;
foundOne: BBContext.FindAction = TRUSTED {
gframe ← gf;
gname ← name;
RETURN [quit]
};
BBContext.FindMatchingGlobalFrames
[IF world = NIL THEN WorldVM.LocalWorld[] ELSE world,
gname, foundOne];
IF gframe # NIL THEN
{-- we found such a frame!
loc ← BBObjectLocation.SourceToLocation[gframe, pos];
IF loc = NIL THEN {msg ← "no such location"; RETURN};
SELECT TRUE FROM
entry => loc ← BBObjectLocation.EntryLocation[loc];
exit => loc ← BBObjectLocation.ExitLocation[loc];
ENDCASE;
[] ← BBObjectLocation.TVFromLocation[loc];
RETURN;
};
msg ← Rope.Cat[gname, " not found"];
};
};
err: ROPE ← BBSafety.Mother[inner];
IF err = NIL THEN err ← msg;
IF err # NIL THEN report[err, fatal];
};
END.