DIRECTORY
AMBridge USING [GetWorld, RemoteFHFromTV, FHFromTV, TVForReferent],
AMEventBooted USING [BootedNotifier, RegisterBootedNotifier, UnRegisterBootedNotifier],
AMEvents USING [BreakID, Event, Outcome, EventProc, GetEvents, BreakAt, ClearBreak, Debugging, Debugged, Booted, StopEvents],
AMModel USING [ContextName, ContextWorld, Section, Context],
AMModelLocation USING [CodeLocation, EntryLocations],
AMTypes USING [DynamicParent, Error],
AMViewerOps USING [SourceError, ViewerFromSection, SectionFromSelection, SourceFromTV, OpenSource, ReportProc],
Atom USING [GetPropFromList],
BBSafety USING [Mother],
Commander USING [CommandProc, Register, CommandObject, Handle],
Convert USING [ValueToRope],
Interpreter USING [ContextForWorld, ContextForLocalFrame, AbortProc, Evaluate],
IO USING [PutRope, PutChar, STREAM, CreateOutputStreamToRope, GetOutputStreamRope, GetSequence, GetChar, Close, ResetUserAbort, SetUserAbort, Reset, PutTV, PutSignal],
List USING [PutAssoc],
MBQueue USING [Queue, Create, CreateMenuEntry],
Menus USING [MenuProc, Menu, InsertMenuEntry, ChangeNumberOfLines],
PrintTV USING [PutClosure, Print, PutProc, PrintArguments, PrintVariables],
Process USING [Detach, SetPriority, GetPriority, Priority, priorityNormal],
ProcessProps USING [AddPropList, GetPropList],
Rope USING [ROPE, Cat, Equal, IsEmpty],
RTBasic USING [TV],
SymTab USING [Create, Ref, Store],
TiogaOps USING [GetSelection, ViewerDoc, SelectPoint, LastLocWithin],
TypeScript USING [TS, Create, Destroy],
ViewerClasses USING [Viewer],
ViewerEvents USING [EventProc, RegisterEventProc],
ViewerIO USING [CreateViewerStreams],
ViewerOps USING [DestroyViewer, AddProp, FetchProp, PaintViewer, EstablishViewerPosition],
UserProfile USING [ProfileChangedProc, Boolean, CallWhenProfileChanges],
WorldVM USING [WorldName, LocalWorld, World];
InterpreterTool:
MONITOR
-- protects individual interpreters
LOCKS h.LOCK USING h: Handle
IMPORTS AMBridge, AMEventBooted, AMEvents, AMModel, AMModelLocation, AMTypes, AMViewerOps, Atom, BBSafety, Commander, Convert, Interpreter, IO, List, MBQueue, Menus, PrintTV, Process, ProcessProps, Rope, SymTab, TiogaOps, TypeScript, UserProfile, ViewerEvents, ViewerIO, ViewerOps, WorldVM
= BEGIN OPEN Interpreter, Rope, RTBasic;
Handle: TYPE = REF InterpreterObject; -- one per viewer
InterpreterObject:
PUBLIC
TYPE =
MONITORED
RECORD [
remoteWorld: WorldVM.World, -- NIL => local only in this nest
context: AMModel.Context ← NIL,
event: AMEvents.Event ← NIL,
nestingLevel: NAT ← 0,
symTab: SymTab.Ref ← NIL,
nextVarIndex: INT ← 0,
ts: TypeScript.TS ← NIL,
tsInStream: IO.STREAM ← NIL,
tsOutStream: IO.STREAM ← NIL,
Stuffable: CONDITION,
menuHitQueue: MBQueue.Queue ← NIL,
terminateRequested: BOOL ← FALSE,
proceedRequested: BOOL ← FALSE,
abortRequested: BOOL ← FALSE,
stopRequested: BOOL ← FALSE,
bootReturnRequested: BOOL ← FALSE,
bootedWorld: WorldVM.World ← NIL,
stuffAble: BOOL ← TRUE
];
BreakIndex: TYPE = INT;
nullBreakIndex: BreakIndex = 0;
nextBI: BreakIndex ← 1; -- BEWARE that this guy isn't protected
BreakObject: TYPE = RECORD[index: BreakIndex, breakID: AMEvents.BreakID, world: WorldVM.World, section: AMModel.Section];
Break:
TYPE =
REF BreakObject;
NewInterpreter: Commander.CommandProc =
TRUSTED{
PROC [cmd: Commander.Handle]
Process.Detach[LOOPHOLE[FORK CreateTool[NIL--no event--], PROCESS]];
};
CreateTool:
PROC[event: AMEvents.Event]
RETURNS[outcome: AMEvents.Outcome] = TRUSTED{
h: Handle;
context: AMModel.Context =
IF event = NIL THEN ContextForWorld[] ELSE ContextForLocalFrame[event.frame];
remoteWorld: WorldVM.World ← NIL;
oldPriority: Process.Priority ← Process.GetPriority[];
Process.SetPriority[Process.priorityNormal];
IF context = NIL THEN ERROR;
IF WorldVM.LocalWorld[] # AMModel.ContextWorld[context]
THEN remoteWorld ← AMModel.ContextWorld[context];
h ←
NEW[
InterpreterObject
← [remoteWorld: remoteWorld,
context: context,
event: event,
menuHitQueue: MBQueue.Create[],
symTab: SymTab.Create[]]];
NewViewer[h];
IF remoteWorld #
NIL
THEN
AMEventBooted.RegisterBootedNotifier[BootReturnRequested, remoteWorld, h];
outcome ← MainLoop[h];
IF remoteWorld #
NIL
THEN
AMEventBooted.UnRegisterBootedNotifier[BootReturnRequested, remoteWorld, h];
Process.SetPriority[oldPriority];
};
EventHandler: AMEvents.EventProc = {
PROC[data: REF ANY, event: AMEvents.Event] RETURNS[outcome: AMEvents.Outcome]
h: Handle ← NIL;
nestingLevel: NAT; -- that of saved interp status
context: AMModel.Context;
IF event.type = booted THEN RETURN[[quit[]]];
context ← ContextForLocalFrame[event.frame];
First, ask if this event is occurring under an interpreter. Ifso, nest the interpreter.
NOTE assumption of order in FindInProgressEvaluation
[h, nestingLevel] ← FindInProgressEvaluation[];
IF h #
NIL
AND h.nestingLevel = nestingLevel
THEN { --
if this event is "under" an interpreter
[PROCESS, nestingLevel] is in Evaluate, i.e. this event is occurring under an interpreter. Nest the event.
oldRemoteWorld: WorldVM.World = h.remoteWorld; -- save remoteWorld;
oldContext: AMModel.Context = h.context; -- save context;
oldEvent: AMEvents.Event = h.event; -- save event;
h.tsOutStream.PutRope
[Cat["***Nesting this InterpreterTool to be a handler for ",
EventToName[event], "\n"]];
IF oldEvent = NIL THEN ChangeLines[h.ts, 2];
IF oldRemoteWorld =
NIL
THEN
h.remoteWorld
←
IF WorldVM.LocalWorld[] = AMModel.ContextWorld[context]
THEN NIL
ELSE AMModel.ContextWorld[context]
ELSE {
-- some lower event of this tool is for a remote world
IF WorldVM.LocalWorld[] # AMModel.ContextWorld[context]
AND oldRemoteWorld # AMModel.ContextWorld[context]
THEN ERROR;
};
h.context ← context;
h.event ← event;
h.nestingLevel ← h.nestingLevel + 1;
IF oldRemoteWorld =
NIL
AND h.remoteWorld #
NIL
THEN
AMEventBooted.RegisterBootedNotifier
[BootReturnRequested, h.remoteWorld, h];
Now do the recursive call of MainLoop.
outcome ← MainLoop[h];
Return from recursive call of MainLoop. Now pop h's state (i.e. restore h).
IF oldRemoteWorld =
NIL
AND h.remoteWorld #
NIL
THEN
AMEventBooted.UnRegisterBootedNotifier
[BootReturnRequested, h.remoteWorld, h];
h.nestingLevel ← h.nestingLevel - 1;
h.event ← oldEvent;
h.context ← oldContext;
h.remoteWorld ← oldRemoteWorld;
IF oldEvent = NIL THEN ChangeLines[h.ts, 1];
}
ELSE outcome ← CreateTool[event]; -- if this event is not "under" an interpreter
};
NewViewer:
PROC[h: Handle] = {
name: ROPE;
[] ← SymTab.Store
[h.symTab, "&H",
AMBridge.TVForReferent[
NEW[Handle ← h]
! AMTypes.Error => CONTINUE]];
[] ← SymTab.Store
[h.symTab, "&WalkStack",
AMBridge.TVForReferent
[NEW[PROC[nFrames: INT ← 1, h: Handle ← NIL] ← WalkStack]
! AMTypes.Error => CONTINUE]];
[] ← SymTab.Store
[h.symTab, "&ShowFrame",
AMBridge.TVForReferent
[NEW[PROC[h: Handle ← NIL] ← ShowFrame]
! AMTypes.Error => CONTINUE]];
[] ← SymTab.Store
[h.symTab, "&Source",
AMBridge.TVForReferent
[NEW[PROC[h: Handle ← NIL] ← Source]
! AMTypes.Error => CONTINUE]];
[] ← SymTab.Store
[h.symTab, "&SetBreak",
AMBridge.TVForReferent
[NEW[PROC[h: Handle ← NIL] ← SetBreak]
! AMTypes.Error => CONTINUE]];
[] ← SymTab.Store
[h.symTab, "&ClearBreak",
AMBridge.TVForReferent
[NEW[PROC[h: Handle ← NIL] ← ClearBreak]
! AMTypes.Error => CONTINUE]];
IF h.event #
NIL
THEN name ← Cat["Event handler for ", EventToName[h.event]]
ELSE name ← Cat["Interpreter for context ", AMModel.ContextName[h.context]];
h.ts ← TypeScript.Create
[info: [name: name, column: right, iconic: FALSE]];
CreateInterpreterMenu[h];
ViewerOps.AddProp[h.ts, $InterpreterHandle, h];
[h.tsInStream, h.tsOutStream] ← ViewerIO.CreateViewerStreams[name: NIL, viewer: h.ts];
Won't raise any signals.
EventToName:
PROC[event: AMEvents.Event]
RETURNS[name:
ROPE ←
NIL] = {
reason: ROPE;
s: IO.STREAM ← NIL;
WITH e: event
SELECT
FROM
booted => reason ← "Booted";
break => {
-- [id: BreakID, clientData: REF ANY]
break: Break ← NIL;
IF e.clientData # NIL THEN break ← NARROW[e.clientData, Break ! ANY => CONTINUE];
IF break =
NIL
THEN reason ← Cat["Unknown breakpoint ", " hit."]
ELSE reason ← Cat["Breakpoint # ", Convert.ValueToRope[[signed[break
.index]]],
" hit."];
};
call => reason ← Cat["Call: ", e.msg];
signal => {
-- [signal, args: RTBasic.TV ]
inner: SAFE PROC = TRUSTED {s.PutSignal[e.signal, e.args]};
s ← IO.CreateOutputStreamToRope[];
s.PutRope[BBSafety.Mother[inner]];
name ← IO.GetOutputStreamRope[s];
RETURN;
};
interrupt => reason ← "Interrupt";
unknown => reason ← Cat["Unknown: ", e.why]; -- client bug; psbi and frame are valid.
ENDCASE => ERROR;
name ← Cat[reason, ", world: ", WorldVM.WorldName[event.world]];
{ inner:
SAFE
PROC =
TRUSTED {s.PutRope[AMModel.ContextName[event.frame]]};
s ← IO.CreateOutputStreamToRope[];
s.PutRope[BBSafety.Mother[inner]];
name ← Cat[name, ", context: ", IO.GetOutputStreamRope[s]];
};
};
CreateInterpreterMenu:
PROC[h: Handle] = {
menu: Menus.Menu ← h.ts.menu;
Menus.InsertMenuEntry
[menu: menu,
line: 0,
entry: MBQueue.CreateMenuEntry
[q: h.menuHitQueue, name: "STOP!", proc: StopHit, clientData: h]];
Menus.InsertMenuEntry
[menu: menu,
line: 0,
entry: MBQueue.CreateMenuEntry
[q: h.menuHitQueue, name: "SetBreak", proc: SetBreakHit, clientData: h]];
Menus.InsertMenuEntry
[menu: menu,
line: 0,
entry: MBQueue.CreateMenuEntry
[q: h.menuHitQueue, name: "ClearBreak(s)", proc: ClearBreakHit, clientData: h]];
Menus.InsertMenuEntry
[menu: menu,
line: 1,
entry: MBQueue.CreateMenuEntry
[q: h.menuHitQueue, name: "WalkStack", proc: WalkStackHit, clientData: h]];
Menus.InsertMenuEntry
[menu: menu,
line: 1,
entry: MBQueue.CreateMenuEntry
[q: h.menuHitQueue, name: "ShowFrame", proc: ShowFrameHit, clientData: h]];
Menus.InsertMenuEntry
[menu: menu,
line: 1,
entry: MBQueue.CreateMenuEntry
[q: h.menuHitQueue, name: "Proceed", proc: ProceedHit, clientData: h]];
Menus.InsertMenuEntry
[menu: menu,
line: 1,
entry: MBQueue.CreateMenuEntry
[q: h.menuHitQueue, name: "Abort", proc: AbortHit, clientData: h]];
Menus.InsertMenuEntry
[menu: menu,
line: 1,
entry: MBQueue.CreateMenuEntry
[q: h.menuHitQueue, name: "Source", proc: SourceHit, clientData: h]];
IF h.event # NIL THEN ChangeLines[h.ts, 2] ELSE ViewerOps.PaintViewer[h.ts, menu];
};
ChangeLines:
PROC[v: ViewerClasses.Viewer, nLines:
NAT] = {
Menus.ChangeNumberOfLines[v.menu, nLines];
ViewerOps.EstablishViewerPosition[v, v.wx, v.wy, v.ww, v.wh];
flushes viewer cache STOPGAP 'till a viewers bug is fixed
ViewerOps.PaintViewer[v, all];
};
Read/Eval/Print loop. FORK'd for each interpreter viewer. Called recursively if an error is raised during interpretation.
MainLoop:
PROC[h: Handle]
RETURNS[outcome: AMEvents.Outcome ← [proceed[NIL]]] = {
somethingHappened: BOOL ← TRUE;
h.tsOutStream.PutChar['\n];
UNTIL WasTerminateRequested[h] -- the interpreter viewer was destroyed
DO
line: ROPE ← NIL;
result: TV ← NIL;
noResult: BOOL ← TRUE;
errorRope: ROPE ← NIL;
prompt:
ROPE
← Cat["&",
Convert.ValueToRope[[signed[NextVarIndex[h, somethingHappened]]]],
" ← "];
leader: ROPE ← NIL;
inner: SAFE PROC = TRUSTED {IF NOT noResult THEN h.tsOutStream.PutTV[result];};
brq: BOOL;
brqWorld: WorldVM.World ← NIL;
somethingHappened ← FALSE;
IF WasProceedRequested[h]
THEN {
ResetProceedRequested[h];
IF h.event #
NIL
THEN {
IF h.nestingLevel = 0 THEN {SetDormant[h]; h.event ← NIL};
RETURN;
};
};
IF WasAbortRequested[h]
THEN {
ResetAbortRequested[h];
IF h.nestingLevel > 0
THEN RETURN[[quit[]]] -- RETURN => event proc returns
ELSE IF h.event # NIL THEN {SetDormant[h]; h.event ← NIL; RETURN[[quit[]]]};
};
[brq, brqWorld] ← WasBootReturnRequested[h];
IF brq
THEN {
IF brqWorld = h.remoteWorld
THEN {
-- RETURN => event proc returns
IF h.nestingLevel = 0 THEN {SetDormant[h]; h.event ← NIL};
RETURN[[quit[]]];
}
ELSE ResetBootReturnRequested[h];
};
FOR i: NAT IN [0..h.nestingLevel) DO leader ← Cat[leader, "<***>"]; ENDLOOP;
h.tsOutStream.PutRope[leader ! ANY => CONTINUE];
h.tsOutStream.PutRope[prompt ! ANY => CONTINUE];
line ← PullLine[h
!
ABORTED,
UNWIND => {
h.tsInStream.Reset[ ! ANY => CONTINUE];
h.tsOutStream.PutRope[" XXX\n" ! ANY => CONTINUE];
h.tsInStream.ResetUserAbort[ ! ANY => CONTINUE];
CONTINUE;
};
AMEvents.Debugging, AMEvents.Debugged => REJECT;
ANY => {
h.tsInStream.Reset[ ! ANY => CONTINUE];
h.tsOutStream.PutRope[" XXX\n" ! ANY => CONTINUE];
h.tsInStream.ResetUserAbort[ ! ANY => CONTINUE];
CONTINUE;
};
];
SetStuffable[h];
IF IsEmpty[line] OR Equal[line, "\n"] THEN LOOP;
somethingHappened ← TRUE;
ResetStopRequested[h];
{
-- open for call on ProcessProps.AddPropList
inner:
SAFE
PROC =
TRUSTED{
[result, errorRope, noResult]
← Interpreter.Evaluate
[rope: Cat[prompt, line],
context: h.context,
symTab: h.symTab,
abort: [abortProc, h]
! AMEvents.Booted => {errorRope ← " XXX (client world booted)\n"; CONTINUE};
ABORTED, UNWIND => {errorRope ← " XXX\n"; CONTINUE};
];
};
ch: Commander.Handle
=
NEW
[Commander.CommandObject
← [in: h.tsInStream,
out: h.tsOutStream,
err: h.tsOutStream,
commandLine: line,
command: "←",
propertyList: NIL]];
ProcessProps.AddPropList[
propList:
List.PutAssoc
[key: $CommanderHandle,
val: ch,
aList:
List.PutAssoc[
key: $InterpreterHandle,
val: h,
aList:
List.PutAssoc[
key: $InterpreterNestingLevel,
val: NEW[NAT ← h.nestingLevel],
aList: NIL]]],
inner: inner
];
}; -- close for call on ProcessProps.AddPropList
IF errorRope #
NIL
THEN
h.tsOutStream.PutRope
[
IF errorRope #
NIL
THEN Cat["***", errorRope, "\n"]
ELSE "*** XXX\n" ! ANY => CONTINUE]
ELSE h.tsOutStream.PutRope[Cat[BBSafety.Mother[inner], "\n"] ! ANY => CONTINUE];
ENDLOOP;
Here if the interpreter viewer was destroyed. h.tsInStream will have been closed.
IF h.nestingLevel > 0 THEN RETURN[[quit[]]] ELSE Finalize[h];
};
abortProc: Interpreter.AbortProc =
TRUSTED {
PROC [data: REF] RETURNS [abort: BOOL];
RETURN[WasStopRequested[NARROW[data, Handle]]];
};
FindInProgressEvaluation:
PROC
RETURNS[h: Handle ←
NIL, nestingLevel:
NAT ← 0] = {
hn: Handle
= NARROW[Atom.GetPropFromList[ProcessProps.GetPropList[], $InterpreterHandle]];
rn:
REF NAT
= NARROW[Atom.GetPropFromList[ProcessProps.GetPropList[], $InterpreterNestingLevel]];
IF hn # NIL AND rn # NIL THEN RETURN[hn, rn^];
};
GetHandlePlease:
PROC
RETURNS[Handle] = {
r: REF ANY = Atom.GetPropFromList[ProcessProps.GetPropList[], $InterpreterHandle];
RETURN[NARROW[r, Handle]];
};
Finalize:
PROC [h: Handle] = {
Here to finalize an InterpreterObject (e.g. to break circular structures, close streams)
h.tsOutStream.PutRope["\n\n ~~~~~~~~~~~~~TERMINATED~~~~~~~~~~~~~ \n\n" ! ANY => CONTINUE];
h.context ← NIL;
h.event ← NIL;
h.symTab ← NIL;
IF h.ts # NIL THEN TypeScript.Destroy[h.ts ! ANY => CONTINUE];
h.ts ← NIL;
h.tsInStream ← NIL;
IF h.tsOutStream # NIL THEN h.tsOutStream.Close[! ANY => CONTINUE];
h.tsOutStream ← NIL;
h.menuHitQueue ← NIL;
h.ts ← NIL;
};
printOneChar:
SAFE PROC [data:
REF, c:
CHAR] =
TRUSTED {
NARROW[data, IO.STREAM].PutChar[c ! ANY => CONTINUE];
};
NextVarIndex:
ENTRY
PROC[h: Handle, somethingHappened:
BOOL]
RETURNS[
INT] = {
ENABLE UNWIND => NULL;
IF NOT somethingHappened THEN RETURN[h.nextVarIndex];
RETURN[h.nextVarIndex ← h.nextVarIndex + 1];
};
ResetStopRequested:
ENTRY
PROC[h: Handle] = {
ENABLE UNWIND => NULL;
h.stopRequested ← FALSE;
};
SetStopRequested:
ENTRY
PROC[h: Handle] = {
ENABLE UNWIND => NULL;
h.stopRequested ← TRUE;
};
WasStopRequested:
ENTRY
PROC[h: Handle]
RETURNS[
BOOL] = {
ENABLE UNWIND => NULL;
RETURN[h.stopRequested];
};
StuffIt:
ENTRY PROC[h: Handle, rope:
ROPE] = {
ENABLE UNWIND => NULL;
UNTIL h.stuffAble DO WAIT h.Stuffable; ENDLOOP;
h.stuffAble ← FALSE;
h.tsInStream.Reset[];
IF IsEmpty[rope] THEN RETURN;
IF TiogaOps.GetSelection[].viewer = h.ts THEN TiogaOps.SelectPoint[viewer: h.ts, caret: TiogaOps.LastLocWithin[TiogaOps.ViewerDoc[h.ts]]];
h.ts.class.notify[h.ts, LIST[rope]];
};
SetStuffable:
ENTRY
PROC[h: Handle] = {
ENABLE UNWIND => NULL;
h.stuffAble ← TRUE;
NOTIFY h.Stuffable;
};
SetDormant:
ENTRY
PROC[h: Handle] = {
ENABLE UNWIND => NULL;
h.tsOutStream.PutRope["\n~~~~~~~~~~~~~~~~~~~~~\n" ! ANY => CONTINUE];
ChangeLines[h.ts, 0];
};
SetProceedRequested:
ENTRY
PROC[h: Handle] = {
ENABLE UNWIND => NULL;
h.proceedRequested ← TRUE;
};
ResetProceedRequested:
ENTRY
PROC[h: Handle] = {
ENABLE UNWIND => NULL;
h.proceedRequested ← FALSE;
};
WasProceedRequested:
ENTRY
PROC[h: Handle]
RETURNS[
BOOL] = {
ENABLE UNWIND => NULL;
RETURN[h.proceedRequested];
};
SetBootReturnRequested:
ENTRY
PROC[h: Handle, world: WorldVM.World] = {
ENABLE UNWIND => NULL;
h.bootReturnRequested ← TRUE;
h.bootedWorld ← world;
};
ResetBootReturnRequested:
ENTRY
PROC[h: Handle] = {
ENABLE UNWIND => NULL;
h.bootReturnRequested ← FALSE;
};
WasBootReturnRequested:
ENTRY
PROC[h: Handle]
RETURNS[yes: BOOL, world: WorldVM.World] = {
ENABLE UNWIND => NULL;
RETURN[h.bootReturnRequested, h.bootedWorld];
};
SetAbortRequested:
ENTRY
PROC[h: Handle] = {
ENABLE UNWIND => NULL;
h.abortRequested ← TRUE;
};
ResetAbortRequested:
ENTRY
PROC[h: Handle] = {
ENABLE UNWIND => NULL;
h.abortRequested ← FALSE;
};
WasAbortRequested:
ENTRY
PROC[h: Handle]
RETURNS[
BOOL] = {
ENABLE UNWIND => NULL;
RETURN[h.abortRequested];
};
SetTerminateRequested:
ENTRY
PROC[h: Handle] = {
ENABLE UNWIND => NULL;
IF h.tsInStream # NIL THEN h.tsInStream.Close[! ANY => CONTINUE];
h.terminateRequested ← TRUE;
};
WasTerminateRequested:
ENTRY
PROC[h: Handle]
RETURNS[
BOOL] = {
ENABLE UNWIND => NULL;
RETURN[h.terminateRequested];
};
PullLine:
PROC[h: Handle]
RETURNS[line:
ROPE ←
NIL] = {
line ← h.tsInStream.GetSequence[];
[] ← h.tsInStream.GetChar[]; -- heave the CR
line ← Cat[line, "\n"];
};
StopHit: Menus.MenuProc =
TRUSTED {
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
SetStopRequested[NARROW[clientData, Handle]];
};
NextBreakIndex:
PROC
RETURNS[bi: BreakIndex] = {
bi ← nextBI;
nextBI ← nextBI + 1;
};
SectionsMatch:
PROC [s1, s2: AMModel.Section]
RETURNS[
BOOL] = {
w1, w2: WorldVM.World;
cl1, cl2: LIST OF AMModelLocation.CodeLocation;
[w1, cl1] ← AMModelLocation.EntryLocations[s1];
[w2, cl2] ← AMModelLocation.EntryLocations[s2];
IF w1 # w2 THEN RETURN[FALSE];
FOR cl:
LIST
OF AMModelLocation.CodeLocation ← cl1, cl.rest
UNTIL cl =
NIL
DO
IF cl2 = NIL OR cl.first # cl2.first THEN RETURN[FALSE];
cl2 ← cl2.rest
ENDLOOP;
RETURN[TRUE];
};
HighlightBreakPoint:
PROC [break: Break, err:
IO.
STREAM] = {
report: AMViewerOps.ReportProc =
-- [msg: ROPE, severity: Severity]
TRUSTED {err.PutRope[msg]};
IF break #
NIL
THEN
[] ← AMViewerOps.ViewerFromSection[break.section, report
! AMViewerOps.SourceError => {err.PutRope[reason]; CONTINUE}];
};
SetBreakHit: Menus.MenuProc =
TRUSTED {
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
h: Handle = NARROW[clientData, Handle];
StuffIt[h, Cat[" ---- &SetBreak[h: &H]\n"]];
};
SetBreak:
PROC[h: Handle ←
NIL] = {
break: Break ← NIL;
msg: ROPE ← NIL;
world: WorldVM.World;
inner:
SAFE
PROC =
TRUSTED {
section: AMModel.Section ← NIL;
warning: REF;
h.tsOutStream.PutRope["Setting break..."];
[section, warning] ← AMViewerOps.SectionFromSelection[world];
IF warning = NIL THEN h.tsOutStream.PutRope["(possible source version mismatch)"];
break ← NEW[BreakObject ← [index: 0, breakID: NIL, world: world, section: section]];
break.breakID ← AMEvents.BreakAt[world, section, break];
break.index ← NextBreakIndex[];
};
IF h = NIL THEN h ← GetHandlePlease[];
world ← IF h.event # NIL THEN h.event.world ELSE AMModel.ContextWorld[h.context];
msg ← BBSafety.Mother[inner];
IF msg =
NIL
AND break #
NIL
THEN {h.tsOutStream.PutRope[Cat["Break #",
Convert.ValueToRope[[signed[break.index]]],
" set."]];
HighlightBreakPoint[break: break, err: h.tsOutStream];
RETURN};
IF msg =
NIL
THEN msg ← "can't, most likely because it already is set here.";
h.tsOutStream.PutRope[msg];
IF break # NIL THEN HighlightBreakPoint[break: break, err: h.tsOutStream];
};
ClearBreakHit: Menus.MenuProc =
TRUSTED {
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
h: Handle = NARROW[clientData, Handle];
StuffIt[h, Cat[" ---- &ClearBreak[h: &H]\n"]];
};
ClearBreak:
PROC [h: Handle ←
NIL] =
TRUSTED {
msg, err: ROPE ← NIL;
break: Break ← NIL;
inner:
SAFE
PROC =
TRUSTED {
IF h.event #
NIL
THEN
WITH e: h.event
SELECT
FROM
break => {
AMEvents.ClearBreak[e.id];
break ← NARROW[e.clientData, Break ! ANY => CONTINUE];
IF break = NIL THEN err ← "I didn't place this break but I cleared it anyhow";
};
ENDCASE;
err ← "not a break event";
};
IF h = NIL THEN h ← GetHandlePlease[];
h.tsOutStream.PutRope["Clearing break..."];
msg ← BBSafety.Mother[inner];
IF msg #
NIL
THEN {h.tsOutStream.PutRope[Cat["Break not cleared: ", msg]]; RETURN}
ELSE IF break = NIL THEN {h.tsOutStream.PutRope[err]; RETURN};
h.tsOutStream.PutRope[Cat["Break #", Convert.ValueToRope[[signed[break.index]]], " cleared."]];
};
WalkStackHit: Menus.MenuProc =
TRUSTED {
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
h: Handle = NARROW[clientData, Handle];
StuffIt[h,
Cat[" ---- &WalkStack[nFrames: ",
SELECT mouseButton FROM red => "1", yellow => "0", blue => "-1"
ENDCASE => ERROR,
", h: &H]\n"]];
};
WalkStack:
PROC[nFrames:
INT ← 1, h: Handle ←
NIL] = {
inner:
SAFE
PROC =
TRUSTED {
put: PrintTV.PutClosure;
put ← [proc: printOneChar, data: h.tsOutStream];
IF h.event = NIL OR h.event.frame = NIL THEN RETURN;
WalkContext[h, nFrames];
PrintTV.Print[tv: h.context, put: put, depth: 1, verbose: TRUE];
};
IF h = NIL THEN h ← GetHandlePlease[];
h.tsOutStream.PutRope[BBSafety.Mother[inner]];
};
WalkContext:
ENTRY
PROC[h: Handle, n:
INT] = {
ENABLE UNWIND => NULL;
SELECT n
FROM
= 0 => h.context ← ContextForLocalFrame[h.event.frame];
> 0 => {
next: TV ← NIL;
this: TV ← h.context;
FOR i:
NAT
IN [1..n]
DO
this ← AMTypes.DynamicParent[this];
IF this = NIL THEN {h.tsOutStream.PutRope["Can't go any further..."]; EXIT};
next ← this;
ENDLOOP;
IF next # NIL THEN h.context ← ContextForLocalFrame[next];
};
< 0 => {
this: TV ← h.context;
prev: TV ← h.event.frame;
FOR i:
NAT
IN [1..-n]
DO
t: TV;
IF FHBits[prev] = FHBits[this]
THEN {
h.tsOutStream.PutRope["Can't go any further."];
h.context ← ContextForLocalFrame[prev];
RETURN};
t ← AMTypes.DynamicParent[prev];
UNTIL FHBits[t] = FHBits[this]
DO prev ← t; t ← AMTypes.DynamicParent[prev] ENDLOOP;
this ← prev;
ENDLOOP;
h.context ← ContextForLocalFrame[prev];
};
ENDCASE;
};
FHBits:
PROC[lf:
TV]
RETURNS[fhBits:
CARDINAL] = {
local: BOOL = AMBridge.GetWorld[lf] = WorldVM.LocalWorld[];
fhBits ←
IF local
THEN LOOPHOLE[AMBridge.FHFromTV[lf], CARDINAL]
ELSE LOOPHOLE[AMBridge.RemoteFHFromTV[lf].fh, CARDINAL];
};
ShowFrameHit: Menus.MenuProc =
TRUSTED {
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
h: Handle = NARROW[clientData, Handle];
StuffIt[h, Cat[" ---- &ShowFrame[h: &H]\n"]];
};
ProceedHit: Menus.MenuProc =
TRUSTED {
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
h: Handle = NARROW[clientData, Handle];
SetProceedRequested[h];
h.tsInStream.SetUserAbort[];
StuffIt[h, "\n"];
};
AbortHit: Menus.MenuProc =
TRUSTED {
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
h: Handle = NARROW[clientData, Handle];
SetAbortRequested[h];
h.tsInStream.SetUserAbort[];
StuffIt[h, "\n"];
};
BootReturnRequested: AMEventBooted.BootedNotifier =
TRUSTED {
PROC[world: WorldVM.World, clientData: REF]
h: Handle = NARROW[clientData, Handle];
SetBootReturnRequested[h, world];
IF h.tsInStream #
NIL
THEN {
h.tsInStream.SetUserAbort[ ! ANY => CONTINUE];
StuffIt[h, "\n" ! ANY => CONTINUE];
};
};
SourceHit: Menus.MenuProc =
TRUSTED {
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
h: Handle = NARROW[clientData, Handle];
StuffIt[h, Cat[" ---- &Source[h: &H]\n"]];
};
Source:
PROC [h: Handle ←
NIL] = {
name: ROPE;
index: INT;
report: AMViewerOps.ReportProc =
-- [msg: ROPE, severity: Severity]
TRUSTED {h.tsOutStream.PutRope[msg]};
IF h = NIL THEN h ← GetHandlePlease[];
[name, index] ← AMViewerOps.SourceFromTV[h.context, report];
IF name # NIL THEN AMViewerOps.OpenSource[name: name, index: index, report: report];
};
ViewerEvent: ViewerEvents.EventProc =
TRUSTED {
PROC [viewer: ViewerClasses.Viewer, event: ViewerEvent, before: BOOL]
RETURNS[abort: BOOL ← FALSE] ;
SELECT event
FROM
destroy => {
prop: REF ← ViewerOps.FetchProp[viewer, $InterpreterHandle];
IF prop #
NIL
THEN {
IF NARROW[prop, Handle].event # NIL THEN RETURN[TRUE];
SetTerminateRequested[NARROW[prop, Handle]];
};
};
ENDCASE;
};
ShowFrame:
PROC [h: Handle ←
NIL] = {
put: PrintTV.PutClosure;
lf: TV;
IF h = NIL THEN h ← GetHandlePlease[];
put ← [proc: printOneChar, data: h.tsOutStream];
IF h.event = NIL OR h.event.frame = NIL THEN RETURN;
lf ← h.context;
PrintTV.Print[tv: lf, put: put, depth: 1, verbose: TRUE];
h.tsOutStream.PutRope["\nArguments--\n"];
PrintTV.PrintArguments[tv: lf, put: put, breakBetweenItems: TRUE];
h.tsOutStream.PutRope["\nVariables--\n"];
PrintTV.PrintVariables[tv: lf, put: put, all:
TRUE, breakBetweenItems:
TRUE];
out.PutRope["\nG- "];
PrintTV.PrintVariables[tv: AMTypes.GlobalParent[lf], put: put];
};
worldSwapDebug: BOOL;
SetWorldSwapDebug:
-- NOTE ENTRY-- UserProfile.ProfileChangedProc =
TRUSTED {
[reason: ProfileChangeReason]
NOTE ENABLE UNWIND => NULL;
wsd: BOOL = UserProfile.Boolean[key: "WorldSwapDebug", default: FALSE];
IF reason = firstTime
THEN {
worldSwapDebug ← wsd;
IF
NOT worldSwapDebug
THEN AMEvents.GetEvents[WorldVM.LocalWorld[], NIL, EventHandler];
RETURN;
};
IF wsd # worldSwapDebug
THEN {
-- user changed his WorldSwapDebug profile entry
IF
NOT wsd
THEN AMEvents.GetEvents[WorldVM.LocalWorld[], NIL, EventHandler]
ELSE AMEvents.StopEvents[WorldVM.LocalWorld[]];
worldSwapDebug ← wsd;
};
};