BBVExtrasImpl
Warren Teitelman, April 22, 1983 2:53 pm
DIRECTORY
AMTypes USING [DynamicParent, GlobalParent, TypeClass, TVType],
BBAction USING [Action, PeekData],
BBBreak USING [AddBreakToList, BreakId, BreakIndex, ClearBreak, FindBreakId, NullIndex],
BBContext USING [Context, GetContents, FindAction, FindMatchingGlobalFrames],
BBFocus USING [SameLocalFrame],
BBObjectLocation USING [SourceToLocation, EntryLocation, ExitLocation, TVFromLocation, Location],
BBSafety USING [Mother],
BBVForUserExec USING [ReportProc, Severity],
BBVOps USING [ViewerFromLocation, SourceError],
BBVExtras USING [],
Convert USING [ValueToRope],
IO USING [PutF, PutRope, rope, 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],
WorldVM USING [LocalWorld, World]
BBVExtrasImpl: CEDAR PROGRAM
IMPORTS AMTypes, BBAction, BBBreak, BBContext, BBFocus, BBObjectLocation, BBSafety, BBVOps, Convert, IO, MessageWindow, PrintTV, Rope, WorldVM
EXPORTS BBVExtras
SHARES 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];
};
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];
WalkContext:
PUBLIC
PROC [action: Action, context: BBContext.Context, target:
TV ←
NIL, delta:
INT, report: ReportProc]
RETURNS [lf:
TV] = {
current: TV ← NIL;
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};
IF target #
NIL
THEN {
lf ← action.event.frame; -- start at top
UNTIL lf =
NIL
DO
IF BBFocus.SameLocalFrame[lf, target]
THEN
EXIT;
lf ← AMTypes.DynamicParent[lf];
REPEAT
FINISHED => report["not found.", fatal];
ENDLOOP;
}
ELSE
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;
};
DisplayLocalFrame:
PUBLIC PROC [out:
IO.
STREAM, lf:
TV, report: ReportProc, args, vars, allVars, globals, lfAndPc:
BOOL ←
FALSE] = {
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.
};
SetBreakFromPosition:
PUBLIC
PROC [report: ReportProc, viewer: ViewerClasses.Viewer, position:
INT, world: WorldVM.World ←
NIL, entry, exit:
BOOL ←
FALSE]
RETURNS [break: BBBreak.BreakIndex ← BBBreak.NullIndex] = {
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: ROPE ← NIL;
both: BOOL ← entry AND exit;
inner:
PROC = {
break ← BBBreak.AddBreakToList[loc].index;
};
ReportBreak:
PROC[report: ReportProc, break: BBBreak.BreakIndex, msg:
ROPE ←
NIL, entry, exit:
BOOL ←
FALSE] = {
decimal: ROPE ← Convert.ValueToRope[[signed[break]]];
kind: ROPE ← IF entry THEN " (entry)" ELSE IF exit THEN " (exit)" ELSE NIL;
report[Rope.Cat["Break #", decimal, kind, msg], success];
};
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:
BOOL ←
FALSE]
RETURNS [loc: BBObjectLocation.Location ←
NIL] = {
msg: ROPE ← NIL;
inner:
PROC = {
IF viewer = NIL THEN {msg ← "no selected viewer"; RETURN};
{
StripExtension:
PROC [name:
ROPE, stripDir:
BOOL ←
FALSE]
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]];
};
gname: ROPE ← StripExtension[viewer.name, TRUE];
gframe: TV ← NIL;
foundOne: BBContext.FindAction =
TRUSTED {
gframe ← gf;
gname ← name;
RETURN [quit]
};
TRUSTED {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.