
<<InterpreterTool.mesa>>
<<Russ Atkinson, May 3, 1983 10:48 am>>
<<Paul Rovner, May 31, 1983 2:34 pm>>
<<Stuff left to do>>
<<Features>>
<<&procs if no symbols>>

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, TypeClass, TVType],
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, PutType],
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, IsEmpty, Substr, Length, Fetch],
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, OpenIcon],
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,
globalContext: 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 these guys aren't protected
dormantH: Handle _ NIL;

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];
IF dormantH = NIL
THEN {
h _ NEW[
InterpreterObject
_ [remoteWorld: remoteWorld,
 context: context,
 event: event,
 menuHitQueue: MBQueue.Create[], 
 symTab: SymTab.Create[]]];
NewViewer[h];
}
ELSE {
name: ROPE _ NIL;
h _ dormantH;  -- NOTE unmonitored
dormantH _ NIL;
h.remoteWorld _ remoteWorld;
h.context _ context;
h.event _ event;
IF h.event # NIL
THEN {
IF h.event.world # WorldVM.LocalWorld[] THEN name _ "WORLDSWAP ";
name _ Cat[name, "Event: ", EventToName[h.event]];
}
ELSE name _ Cat["Interp: ", AMModel.ContextName[h.context]];
h.ts.name _ name;
IF h.ts.iconic THEN ViewerOps.OpenIcon[h.ts];
IF h.event # NIL THEN ChangeLines[h.ts, 2] ELSE ChangeLines[h.ts, 1];
h.tsOutStream.PutRope[Cat[name, "\n"]];
};
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;
oldGlobalContext: AMModel.Context = h.globalContext;  -- save globalContext;
oldEvent: AMEvents.Event = h.event;  -- save event;
oldName: ROPE = h.ts.name;  -- save viewer name;
newName: ROPE _ NIL;
IF event.world # WorldVM.LocalWorld[] THEN newName _ "WORLDSWAP ";
newName _ Cat[newName, "Event: ", EventToName[event]];
h.tsOutStream.PutRope
[Cat["***Nesting this InterpreterTool to be a handler for ", newName, "\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.globalContext _ NIL;
h.event _ event;
h.ts.name _ newName;
ViewerOps.PaintViewer[h.ts, caption];
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.ts.name _ oldName;
h.nestingLevel _ h.nestingLevel - 1;
h.event _ oldEvent;
h.globalContext _ oldGlobalContext;
h.context _ oldContext;
h.remoteWorld _ oldRemoteWorld;
ViewerOps.PaintViewer[h.ts, caption];
IF oldEvent = NIL THEN ChangeLines[h.ts, 1];
}
ELSE outcome _ CreateTool[event]; -- if this event is not "under" an interpreter
};  -- end EventHandler

NewViewer: PROC[h: Handle] = {
name: ROPE _ NIL;
[] _ 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 {
IF h.event.world # WorldVM.LocalWorld[] THEN name _ "WORLDSWAP ";
name _ Cat[name, "Event: ", EventToName[h.event]];
}
ELSE name _ Cat["Interp: ", 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];
h.tsOutStream.PutRope[Cat[name, "\n"]];
};

<<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 _ "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]];
reason _ IO.GetOutputStreamRope[s];
};
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[", context: "];
s.PutRope[AMModel.ContextName[event.frame]];
s.PutRope[", process: "];
s.PutTV[event.process];
};
s _ IO.CreateOutputStreamToRope[];
s.PutRope[BBSafety.Mother[inner]];
name _ Cat[name, IO.GetOutputStreamRope[s]];
};

};  -- end EventToName

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;
printType: BOOL _ FALSE;
printVerbose: BOOL _ FALSE;
inner: SAFE PROC = TRUSTED {
IF noResult THEN RETURN;
IF printType THEN {
h.tsOutStream.PutRope["***Printing Type...\n"];
h.tsOutStream.PutType[type: AMTypes.TVType[result], verbose: printVerbose];
RETURN;
};
IF AMTypes.TypeClass[AMTypes.TVType[result]] = globalFrame THEN {
h.tsOutStream.PutRope["***Setting global frame context...\n"];
h.globalContext _ result;
};
h.tsOutStream.PutTV[
tv: result,
depth: (IF printVerbose THEN 100 ELSE 4),
width: (IF printVerbose THEN 100 ELSE 32),
verbose: printVerbose
];
};
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 {ResetBootReturnRequested[h]; 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] THEN LOOP;
IF Fetch[line, Length[line] - 1] = '! THEN {
line _ Substr[base: line, len: Length[line] - 1];
printVerbose _ TRUE;
};
IF Fetch[line, Length[line] - 1] = '? THEN {
line _ Substr[base: line, len: Length[line] - 1];
printType _ TRUE;
};
IF Fetch[line, Length[line] - 1] = '! THEN {
line _ Substr[base: line, len: Length[line] - 1];
printVerbose _ TRUE;
};
line _ Cat[line, "\n"];
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,
 global: h.globalContext,
 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[Cat["***", errorRope, "\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];
};  -- end MainLoop

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.globalContext _ 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;
IF h = dormantH THEN dormantH _ 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;
h.tsOutStream.SetUserAbort[ ! ANY => CONTINUE];
};

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];
dormantH _ h;
};

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];
IF h = dormantH THEN dormantH _ NIL;
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
};

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;
THROUGH [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;
THROUGH [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
WITH prop SELECT FROM
h: Handle => {
IF h.event # NIL THEN RETURN[TRUE];
SetTerminateRequested[h];
IF prop = dormantH THEN dormantH _ NIL;
};
ENDCASE;
};
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;
}; 
};

<<>>
<<START HERE>>

[] _ ViewerEvents.RegisterEventProc[proc: ViewerEvent, event: destroy];

Commander.Register[key: "Interpreter", proc: NewInterpreter, doc: "Create a new interpreter tool"];

UserProfile.CallWhenProfileChanges[SetWorldSwapDebug];

END.