DIRECTORY
AMBridge USING [FHFromTV, GetWorld, RemoteFHFromTV, TVForReferent, TVForSignal, TVToCardinal, TVToLI, TVForType],
AMEvents USING [BootedNotifier, BreakAt, BreakID, ClearBreak, Debugged, Debugging, Event, EventProc, GetEvents, NextBreak, Outcome, RegisterBootedNotifier, StopEvents, UnRegisterBootedNotifier],
AMEventsPrivate USING [DuplicateBreakpoint],
AMMiniModel USING [GetInterfaceRecord],
AMModel USING [Context, ContextName, ContextWorld, MostRecentNamedContext, RootContext, Section, Source, SectionSource],
AMModelBridge USING [ContextForFrame],
AMModelLocation USING [EntryLocations],
AMTypes USING [DynamicParent, Error, TypeClass, TVType, TV, GetEmptyTV, TVToName, Type],
AMViewerOps USING [ReportProc, SectionFromSelection, SourceFromTV, ViewerFromSection],
Atom USING [GetPropFromList],
BackStop USING [Call],
Commander USING [CommandObject, CommandProc, Handle, Register],
EvalQuote USING [EvalQuoteProc, Register],
FileViewerOps USING [OpenSource],
Interpreter USING [AbortProc, Evaluate],
InterpreterOps USING [Tree, WorldFromHead, TreeToName, GetArg, Eval, RegisterTV],
InterpreterToolPrivate USING [Handle, InterpreterObject, Break, BreakObject, BreakIndex, nullBreakIndex],
IO USING [Close, RopeFromROS, GetLineRope, int, Put, PutChar, PutR, PutRope, Reset, rope, ROS, STREAM, card, PutF],
List USING [PutAssoc],
MBQueue USING [Create, CreateMenuEntry, Queue],
Menus USING [ChangeNumberOfLines, InsertMenuEntry, Menu, MenuProc],
PrincOps USING [BytePC],
PrintTV USING [Print, PrintArguments, PrintType, PrintVariables, PrintSignal],
Process USING [Detach, SetPriority, GetPriority, Priority, priorityNormal, Abort, GetCurrent],
ProcessProps USING [AddPropList, GetPropList],
Rope USING [Cat, Fetch, IsEmpty, Length, ROPE, Substr],
SafeStorage USING [NarrowRefFault],
SymTab USING [Create, Ref, Fetch],
TiogaOps USING [GetSelection, LastLocWithin, SelectPoint, ViewerDoc],
TypeScript USING [TS, Create, Destroy],
ViewerClasses USING [Viewer],
ViewerEvents USING [EventProc, RegisterEventProc],
ViewerIO USING [CreateViewerStreams],
ViewerOps USING [AddProp, DestroyViewer, EstablishViewerPosition, FetchProp, OpenIcon, PaintViewer],
UserProfile USING [Boolean, CallWhenProfileChanges, ProfileChangedProc],
WorldVM USING [GetWorld, LocalWorld, World, WorldName];
InterpreterToolImpl:
MONITOR
-- protects individual interpreters
LOCKS h.LOCK USING h: Handle
IMPORTS AMBridge, AMEvents, AMEventsPrivate, AMMiniModel, AMModel, AMModelBridge, AMModelLocation, AMTypes, AMViewerOps, Atom, BackStop, Commander, EvalQuote, FileViewerOps, Interpreter, InterpreterOps, IO, List, MBQueue, Menus, PrintTV, Process, ProcessProps, Rope, SafeStorage, SymTab, TiogaOps, TypeScript, UserProfile, ViewerEvents, ViewerIO, ViewerOps, WorldVM
EXPORTS InterpreterToolPrivate -- nextBI
= BEGIN OPEN Interpreter, Rope;
TV: TYPE = AMTypes.TV;
Type: TYPE = AMTypes.Type;
Handle: TYPE = InterpreterToolPrivate.Handle; -- one per viewer
InterpreterObject: TYPE = InterpreterToolPrivate.InterpreterObject;
BreakIndex: TYPE = InterpreterToolPrivate.BreakIndex;
nullBreakIndex: BreakIndex = InterpreterToolPrivate.nullBreakIndex;
nextBI: PUBLIC BreakIndex ← 1; -- BEWARE that these guys aren't protected
dormantH: Handle ← NIL;
BreakObject: TYPE = InterpreterToolPrivate.BreakObject;
Break:
TYPE = InterpreterToolPrivate.Break;
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 AMModel.RootContext[WorldVM.LocalWorld[]] ELSE AMModelBridge.ContextForFrame[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[],
readEvalPrintProcess: Process.GetCurrent[]]];
NewViewer[h];
}
ELSE {
name: ROPE ← NIL;
h ← dormantH; -- NOTE unmonitored
dormantH ← NIL;
h.remoteWorld ← remoteWorld;
h.context ← context;
h.event ← event;
h.readEvalPrintProcess ← Process.GetCurrent[];
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 AMEvents.RegisterBootedNotifier[BootReturnRequested, remoteWorld, h];
outcome ← MainLoop[h];
IF remoteWorld #
NIL
THEN AMEvents.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 = AMModelBridge.ContextForFrame[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
AMEvents.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
AMEvents.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] = {
ENABLE AMTypes.Error => CONTINUE;
name: ROPE ← NIL;
InterpreterOps.RegisterTV
[name: "&H",
tv: AMBridge.TVForReferent[NEW[Handle ← h]],
help: "this interpretertool's handle",
symTab: h.symTab];
InterpreterOps.RegisterTV
[name: "&depth",
tv: AMBridge.TVForReferent[NEW[INT ← 4]],
help: "printing depth for this interpretertool",
symTab: h.symTab];
InterpreterOps.RegisterTV
[name: "&width",
tv: AMBridge.TVForReferent[NEW[INT ← 32]],
help: "printing width for this interpretertool",
symTab: h.symTab];
InterpreterOps.RegisterTV
[name: "&WalkStack",
tv: AMBridge.TVForReferent
[NEW[PROC[nFrames: INT ← 1, h: Handle ← NIL] ← WalkStack]],
help: "set a local frame context (eventhandler)",
symTab: h.symTab];
InterpreterOps.RegisterTV
[name: "&slf",
tv: AMBridge.TVForReferent
[NEW[PROC[nFrames: INT ← 1, h: Handle ← NIL] ← WalkStack]],
help: "set a local frame context (eventhandler)",
symTab: h.symTab];
InterpreterOps.RegisterTV
[name: "&ShowFrame",
tv: AMBridge.TVForReferent
[NEW[PROC[h: Handle ← NIL] ← ShowFrame]],
help: "show the current lf context (eventhandler)",
symTab: h.symTab];
InterpreterOps.RegisterTV
[name: "&Source",
tv: AMBridge.TVForReferent
[NEW[PROC[h: Handle ← NIL] ← Source]],
help: "show source loc of current lf context (eventhandler)",
symTab: h.symTab];
InterpreterOps.RegisterTV
[name: "&SetBreak",
tv: AMBridge.TVForReferent
[NEW[PROC[h: Handle ← NIL] ← SetBreak]],
help: "set break at selected source loc",
symTab: h.symTab];
InterpreterOps.RegisterTV
[name: "&ClearBreak",
tv: AMBridge.TVForReferent
[
NEW[
PROC[h: Handle ←
NIL, breakIndex: BreakIndex ← nullBreakIndex]
← ClearBreak]],
help: "clear specified break",
symTab: h.symTab];
InterpreterOps.RegisterTV
[name: "&ClearAllBreaks",
tv: AMBridge.TVForReferent
[NEW[PROC[h: Handle ← NIL] ← ClearAllBreaks]],
help: "clear all breaks",
symTab: h.symTab];
InterpreterOps.RegisterTV
[name: "&ListBreaks",
tv: AMBridge.TVForReferent
[NEW[PROC[h: Handle ← NIL] ← ListBreaks]],
help: "list all breaks",
symTab: h.symTab];
EvalQuote.Register["&sgf", SetGlobalFrameHelper, h.symTab, h];
InterpreterOps.RegisterTV
[name: "&sgf",
tv: AMBridge.TVForReferent
[NEW[PROC[progName: ROPE, h: Handle ← NIL] ← SetGlobalFrameContext]],
help: "&sgf[rope]\tset context to be that for the given module",
symTab: h.symTab];
EvalQuote.Register["&gf", GlobalFrameHelper, h.symTab, h];
InterpreterOps.RegisterTV
[name: "&gf",
tv: AMBridge.TVForReferent
[NEW[PROC[progName: ROPE, h: Handle ← NIL] RETURNS[TV] ← GlobalFrameContext]],
help: "&gf[rope]\tget the given module's context",
symTab: h.symTab];
EvalQuote.Register["&sw", SetWorldHelper, h.symTab, h];
InterpreterOps.RegisterTV
[name: "&sw",
tv: AMBridge.TVForReferent
[NEW[PROC[worldName: ROPE, h: Handle ← NIL] ← SetWorldContext]],
help: "&sw[rope]\tset context to be that for the given world",
symTab: h.symTab];
EvalQuote.Register["&sir", SetIRHelper, h.symTab, h];
InterpreterOps.RegisterTV
[name: "&sir",
tv: AMBridge.TVForReferent
[NEW[PROC[interfaceName: ROPE, h: Handle ← NIL] ← SetIRContext]],
help: "&sir[rope]\tset context to be that for the given IR",
EvalQuote.Register["&type", TypeHelper, h.symTab, h];
InterpreterOps.RegisterTV
[name: "&type",
tv: AMBridge.TVForReferent
[NEW[PROC[expr: ROPE, h: Handle ← NIL] RETURNS[Type] ← TypeGetter]],
help: "&type[expr]\tget the type of the given expr",
symTab: h.symTab];
EvalQuote.Register["&ir", IRHelper, h.symTab, h];
InterpreterOps.RegisterTV
[name: "&ir",
tv: AMBridge.TVForReferent
[NEW[PROC[interfaceName: ROPE, h: Handle ← NIL] RETURNS[TV] ← IRContext]],
help: "&ir[rope]\tget the given IR",
symTab: h.symTab];
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
break => {
-- [id: BreakID, clientData: REF ANY]
break: Break ← NIL;
IF e.clientData #
NIL
THEN break ←
NARROW[e.clientData, Break
! SafeStorage.NarrowRefFault => CONTINUE];
IF break =
NIL
THEN reason ← "Unknown breakpoint hit."
ELSE reason ← Cat["Breakpoint # ", IO.PutR[IO.int[break.index]], " hit."];
};
call => reason ← Cat["Call: ", e.msg];
signal => {
-- [signal, args: TV ]
inner:
SAFE
PROC =
TRUSTED {
PrintTV.PrintSignal[e.signal, e.args, s];
IF AMTypes.TypeClass[AMTypes.TVType[e.signal]] = cardinal
THEN
AMEvents gave up on symbols; get the error message for BackStop.Call
[] ← AMBridge.TVForSignal[
LOOPHOLE[AMBridge.TVToCardinal[e.signal],
ERROR ANY RETURNS ANY]];
};
s ← IO.ROS[];
s.PutRope[BackStop.Call[inner]];
reason ← IO.RopeFromROS[s];
};
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: "];
PrintTV.Print[event.process, s];
};
s ← IO.ROS[];
s.PutRope[BackStop.Call[inner]];
name ← Cat[name, IO.RopeFromROS[s]];
};
}; -- end EventToName
CreateInterpreterMenu:
PROC[h: Handle] = {
menu: Menus.Menu ← h.ts.menu;
InsME:
PROC[line:
NAT, name:
ROPE, proc: Menus.MenuProc] = {
Menus.InsertMenuEntry
[menu: menu,
line: line,
entry: MBQueue.CreateMenuEntry
[q: h.menuHitQueue, name: name, proc: proc, clientData: h]];
};
InsME[line: 0, name: "STOP!", proc: StopHit];
InsME[line: 0, name: "SetBreak", proc: SetBreakHit];
InsME[line: 0, name: "ClearBreak(s)", proc: ClearBreakHit];
InsME[line: 0, name: "ListBreaks", proc: ListBreaksHit];
InsME[line: 1, name: "WalkStack", proc: WalkStackHit];
InsME[line: 1, name: "ShowFrame", proc: ShowFrameHit];
InsME[line: 1, name: "Proceed", proc: ProceedHit];
InsME[line: 1, name: "Abort", proc: AbortHit];
InsME[line: 1, name: "Source", proc: SourceHit];
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["&", IO.PutR[IO.int[NextVarIndex[h, somethingHappened]]], " ← "];
leader: ROPE ← NIL;
printType: BOOL ← FALSE;
depth: INT ← 4;
width: INT ← 32;
inner:
SAFE
PROC =
TRUSTED {
IF noResult THEN RETURN;
IF printType
THEN {
h.tsOutStream.PutRope["***Printing Type...\n"];
PrintTV.PrintType[
put: h.tsOutStream,
type: AMTypes.TVType[result],
depth: depth,
width: width,
verbose: depth > 4
];
}
ELSE PrintTV.Print[
put: h.tsOutStream,
tv: result,
depth: depth,
width: width,
verbose: depth > 4
];
};
brq: BOOL;
brqWorld: WorldVM.World ← NIL;
depth ← AMBridge.TVToLI[
NARROW[SymTab.Fetch[h.symTab, "&depth"].val,
TV]
! AMTypes.Error => CONTINUE];
width ← AMBridge.TVToLI[
NARROW[SymTab.Fetch[h.symTab, "&width"].val,
TV]
! AMTypes.Error => CONTINUE];
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 ← h.tsInStream.GetLineRope[
!
ABORTED, UNWIND => GOTO handleAborted;
AMEvents.Debugging, AMEvents.Debugged => REJECT;
ANY => GOTO handleAborted;
];
EXITS handleAborted => {
h.tsInStream.Reset[ ! ANY => CONTINUE];
h.tsOutStream.PutRope[" XXX\n" ! ANY => CONTINUE];
};
};
SetStuffable[h];
IF line.IsEmpty[] THEN LOOP;
UNTIL line.IsEmpty[]
-- strip postfix !'s and ?'s
DO
ch: CHAR ← line.Fetch[line.Length[] - 1];
SELECT ch
FROM
'! => {depth ← depth + 1; width ← width + width};
'? => printType ← TRUE;
ENDCASE => EXIT;
line ← Rope.Substr[base: line, len: line.Length[] - 1];
ENDLOOP;
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: IF h.globalContext # NIL THEN h.globalContext ELSE h.context,
symTab: h.symTab,
abort: [abortProc, h]
! 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:
List.PutAssoc[
key: $InterpreterSymTab,
val: h.symTab,
aList: NIL
]]]],
inner: inner
];
}; -- close for call on ProcessProps.AddPropList
DO
IF errorRope.Length[] # 0
THEN h.tsOutStream.PutRope[Cat["***", errorRope, "\n"] ! ANY => CONTINUE]
ELSE h.tsOutStream.PutRope
[Cat[BackStop.Call[inner
!
ABORTED => {errorRope ← " XXX\n";
LOOP}],
"\n"] ! ANY => CONTINUE];
EXIT;
ENDLOOP;
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:
PUBLIC 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;
};
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;
IF h.readEvalPrintProcess # NIL THEN Process.Abort[h.readEvalPrintProcess];
};
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;
abort: BOOL ← FALSE;
h.readEvalPrintProcess ← NIL;
h.tsOutStream.PutRope["\n~~~~~~~~~~~~~~~~~~~~~\n" ! ANY => CONTINUE];
ChangeLines[h.ts, 0 ! ANY => {abort ← TRUE; CONTINUE}];
IF NOT abort THEN 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];
};
StopHit: Menus.MenuProc =
TRUSTED {
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
SetStopRequested[NARROW[clientData, Handle]];
};
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]};
inner:
SAFE
PROC =
TRUSTED{
[] ← AMViewerOps.ViewerFromSection[break.section, report];
}; -- yekk.
msg: ROPE ← BackStop.Call[inner];
IF msg # NIL THEN err.PutRope[msg];
};
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
! AMEventsPrivate.DuplicateBreakpoint => {break ← NIL; CONTINUE}];
IF break # NIL THEN {break.index ← nextBI; nextBI ← nextBI + 1};
};
IF h = NIL THEN h ← GetHandlePlease[];
world ← IF h.event # NIL THEN h.event.world ELSE AMModel.ContextWorld[h.context];
msg ← BackStop.Call[inner];
IF msg.Length[] = 0
AND break #
NIL
THEN {
h.tsOutStream.Put[IO.rope["Break #"], IO.int[break.index], IO.rope[" set."]];
HighlightBreakPoint[break: break, err: h.tsOutStream];
RETURN;
};
IF msg.Length[] # 0
THEN break ←
NIL
ELSE msg ← "a break is already set here.";
Could, I suppose, redefine DuplicateBreakpoint to pass the old BreakID, but I'm getting tired of this. PDR
h.tsOutStream.PutRope[msg];
};
ListBreaksHit: Menus.MenuProc =
TRUSTED {
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
h: Handle = NARROW[clientData, Handle];
StuffIt[h, Cat[" ---- &ListBreaks[h: &H]\n"]];
};
SetGlobalFrameContext:
PROC[progName:
ROPE, h: Handle ←
NIL] =
TRUSTED {
ERROR -- defined only for &help; the evalquote proc does the work
};
GlobalFrameContext:
PROC[progName:
ROPE, h: Handle ←
NIL]
RETURNS[
TV] =
TRUSTED {
ERROR -- defined only for &help; the evalquote proc does the work
};
SetWorldContext:
PROC[worldName:
ROPE, h: Handle ←
NIL] =
TRUSTED {
ERROR -- defined only for &help; the evalquote proc does the work
};
SetIRContext:
PROC[interfaceName:
ROPE, h: Handle ←
NIL] =
TRUSTED {
ERROR -- defined only for &help; the evalquote proc does the work
};
IRContext:
PROC[interfaceName:
ROPE, h: Handle ←
NIL]
RETURNS[
TV] =
TRUSTED {
ERROR -- defined only for &help; the evalquote proc does the work
};
TypeGetter:
PROC[expr:
ROPE, h: Handle ←
NIL]
RETURNS[Type] =
TRUSTED {
ERROR -- defined only for &help; the evalquote proc does the work
};
ListBreaks:
PROC [h: Handle ←
NIL] =
TRUSTED {
msg: ROPE ← NIL;
inner:
SAFE
PROC =
TRUSTED {
id: AMEvents.BreakID ← NIL;
clientData: REF;
DO
world: WorldVM.World
= IF h.event # NIL THEN h.event.world ELSE AMModel.ContextWorld[h.context];
[id, clientData] ← AMEvents.NextBreak[world: world, prev: id];
IF id = NIL THEN EXIT;
WITH clientData
SELECT
FROM
b: Break => {
source: AMModel.Source = AMModel.SectionSource[b.section];
pc: PrincOps.BytePC = AMModelLocation.EntryLocations[b.section].list.first.pc;
firstCharIndex: INT ← 0;
WITH s: source
SELECT
FROM
field => firstCharIndex ← s.firstCharIndex;
ENDCASE;
IF b.world # world THEN {h.tsOutStream.PutRope["DISASTER"]; ERROR};
h.tsOutStream.Put[IO.rope[" Break #"], IO.int[b.index], IO.rope[" at "]];
h.tsOutStream.Put[IO.rope[source.fileName], IO.rope["["], IO.int[firstCharIndex]];
h.tsOutStream.PutRope["], bytePC = "];
h.tsOutStream.PutF["%b", IO.card[pc]];
h.tsOutStream.PutRope["\n"];
};
ENDCASE;
ENDLOOP;
};
START HERE
IF h = NIL THEN h ← GetHandlePlease[];
h.tsOutStream.PutRope["Listing all breaks for this world...\n"];
msg ← BackStop.Call[inner];
IF msg #
NIL
THEN h.tsOutStream.PutRope[Cat["Error: ", msg]]
ELSE h.tsOutStream.PutRope["...Done.\n"];
};
ClearBreakHit: Menus.MenuProc =
TRUSTED {
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
h: Handle = NARROW[clientData, Handle];
IF mouseButton = red THEN StuffIt[h, Cat[" ---- &ClearBreak[h: &H]\n"]]
ELSE IF mouseButton = blue THEN StuffIt[h, Cat[" ---- &ClearAllBreaks[h: &H]\n"]];
};
ClearAllBreaks:
PROC [h: Handle ←
NIL] =
TRUSTED {
msg: ROPE ← NIL;
inner:
SAFE
PROC =
TRUSTED {
id: AMEvents.BreakID ← NIL;
clientData: REF;
DO
world: WorldVM.World
= IF h.event # NIL THEN h.event.world ELSE AMModel.ContextWorld[h.context];
[id, clientData] ← AMEvents.NextBreak[world: world, prev: id];
IF id = NIL THEN EXIT;
WITH clientData
SELECT
FROM
b: Break => {
IF b.world # world THEN {h.tsOutStream.PutRope["DISASTER"]; ERROR};
AMEvents.ClearBreak[b.breakID];
h.tsOutStream.Put[IO.rope[" Break #"], IO.int[b.index], IO.rope[" cleared.\n"]];
};
ENDCASE;
ENDLOOP;
};
START HERE
IF h = NIL THEN h ← GetHandlePlease[];
h.tsOutStream.PutRope["Clearing all breaks...\n"];
msg ← BackStop.Call[inner];
IF msg #
NIL
THEN h.tsOutStream.PutRope[Cat["Error: ", msg]]
ELSE h.tsOutStream.PutRope["...Done.\n"];
};
ClearBreak:
PROC [h: Handle ←
NIL, breakIndex: BreakIndex ← nullBreakIndex] =
TRUSTED {
msg, err: ROPE ← NIL;
break: Break ← NIL;
inner:
SAFE
PROC =
TRUSTED {
IF breakIndex = nullBreakIndex
THEN {
-- clear the break that caused this event
IF h.event =
NIL
THEN err ← "not an event handler"
ELSE
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"
ELSE breakIndex ← break.index;
};
ENDCASE => err ← "not a break event";
}
ELSE {
-- clear the specified break
id: AMEvents.BreakID ← NIL;
clientData: REF;
DO
world: WorldVM.World
= IF h.event # NIL THEN h.event.world ELSE AMModel.ContextWorld[h.context];
[id, clientData] ← AMEvents.NextBreak[world: world, prev: id];
IF id = NIL THEN {err ← "No break found with the specified index"; EXIT};
WITH clientData
SELECT
FROM
b: Break => {
IF b.world # world THEN {h.tsOutStream.PutRope["DISASTER"]; ERROR};
IF b.index = breakIndex
THEN {
break ← b;
AMEvents.ClearBreak[b.breakID];
};
};
ENDCASE;
ENDLOOP;
};
};
START HERE
IF h = NIL THEN h ← GetHandlePlease[];
h.tsOutStream.PutRope["Clearing break..."];
msg ← BackStop.Call[inner];
IF msg #
NIL
THEN h.tsOutStream.PutRope[Cat["Break not cleared: ", msg]]
ELSE IF break = NIL THEN h.tsOutStream.PutRope[err]
ELSE h.tsOutStream.Put[IO.rope["Break #"], IO.int[breakIndex], IO.rope[" 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 => "-1000", blue => "-1"
ENDCASE => ERROR,
", h: &H]\n"]];
};
WalkStack:
PROC[nFrames:
INT ← 1, h: Handle ←
NIL] = {
inner:
SAFE
PROC =
TRUSTED {
IF h.event = NIL OR h.event.frame = NIL THEN RETURN;
WalkContext[h, nFrames];
PrintTV.Print[tv: h.context, put: h.tsOutStream, depth: 1, verbose: TRUE];
};
IF h = NIL THEN h ← GetHandlePlease[];
h.tsOutStream.PutRope[BackStop.Call[inner]];
};
WalkContext:
ENTRY
PROC[h: Handle, n:
INT] = {
ENABLE UNWIND => NULL;
h.globalContext ← NIL;
SELECT n
FROM
> 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 ← AMModelBridge.ContextForFrame[next];
};
< -999 => h.context ← AMModelBridge.ContextForFrame[h.event.frame];
< 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 ← AMModelBridge.ContextForFrame[prev];
RETURN};
t ← AMTypes.DynamicParent[prev];
UNTIL FHBits[t] = FHBits[this]
DO prev ← t; t ← AMTypes.DynamicParent[prev] ENDLOOP;
this ← prev;
ENDLOOP;
h.context ← AMModelBridge.ContextForFrame[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];
Process.Abort[h.readEvalPrintProcess];
StuffIt[h, "\n"];
};
AbortHit: Menus.MenuProc =
TRUSTED {
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
h: Handle = NARROW[clientData, Handle];
SetAbortRequested[h];
Process.Abort[h.readEvalPrintProcess];
StuffIt[h, "\n"];
};
BootReturnRequested: AMEvents.BootedNotifier =
TRUSTED {
PROC[world: WorldVM.World, clientData: REF]
h: Handle = NARROW[clientData, Handle];
SetBootReturnRequested[h, world];
IF h.tsInStream #
NIL
THEN {
Process.Abort[h.readEvalPrintProcess];
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 FileViewerOps.OpenSource[fileName: name, index: index, feedBack: h.tsOutStream];
};
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] = {
lf: TV;
depth: INT ← 4;
width: INT ← 32;
IF h = NIL THEN h ← GetHandlePlease[];
IF h.event = NIL OR h.event.frame = NIL OR h.globalContext # NIL THEN RETURN;
depth ← AMBridge.TVToLI[
NARROW[SymTab.Fetch[h.symTab, "&depth"].val,
TV]
! AMTypes.Error => CONTINUE];
width ← AMBridge.TVToLI[
NARROW[SymTab.Fetch[h.symTab, "&width"].val,
TV]
! AMTypes.Error => CONTINUE];
lf ← h.context;
PrintTV.Print[tv: lf, put: h.tsOutStream, depth: 1, verbose: TRUE];
h.tsOutStream.PutRope["\nArguments--\n"];
PrintTV.PrintArguments[tv: lf, put: h.tsOutStream, depth: depth, width: width, breakBetweenItems: TRUE];
h.tsOutStream.PutRope["\nVariables--\n"];
PrintTV.PrintVariables[tv: lf, put: h.tsOutStream, depth: depth, width: width, 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;
};
};