-- Cedar Abstract Machine: interactions with client

-- AMEventsImpl.mesa

-- Andrew Birrell February 16, 1983 4:09 pm
-- Russ Atkinson, April 11, 1983 4:42 pm (RRA: use FastBreak, eliminate UnsafeBreaks)
-- Maxwell, March 31, 1983 8:05 am (search for 'JTM')
-- Paul Rovner April 22, 1983 10:23 am

DIRECTORY
AMBridge   USING[ GetWorld, SetTVFromLC, TVForFrame, TVForPointerReferent,
         TVForReferent, TVForRemoteFrame, TVForRemotePointerReferent,
         TVForRemoteSignal, TVForSignal, TVToCardinal, TVToWordSequence,
         WordSequence, WordSequenceRecord ],
AMBridgeExtras USING[ SetTVFromWordSequence ],
AMEventBooted USING[ BootedNotifier ],
AMEvents   USING[ Event, EventProc, EventRec, Outcome ],
AMEventsExtra  USING[ ],
AMEventsPrivate USING[ ],
AMModel   USING[ Section ],
AMModelLocation USING[ CodeLocation, EntryLocations, ExitLocations ],
AMTypes   USING[ Assign, Class, Domain, Error, New, Range, Size, TV, TVType, Type,
         UnderClass ],
Booting    USING[ Bootee, defaultSwitches, Switches ],
CedarSnapshot  USING[ CheckpointProc, Register, RollbackProc ],
ConvertUnsafe  USING[ ToRope ],
CPSwapDefs   USING[ DebugParameter, ExternalStateVector, SwapInfo ],
FastBreak   USING[ FastBreakHandler, SpecifyDefaultBreakHandler ], -- RRA: new
Frame    USING[ Alloc, Free, GetReturnFrame, GetReturnLink, MyLocalFrame,
         SetReturnFrame, SetReturnLink ],
Inline    USING[ LongCOPY ],
Mopcodes   USING[ op, zBRK, zRET ],
PrincOps    USING[ BytePC, ControlLink, Frame, FrameHandle, FrameSizeIndex, FrameVec,
         GlobalFrame, GlobalFrameHandle, InstWord, MaxParamsInStack,
         NullFrame, NullLink, StateVector, SVPointer ],
Process    USING[ Abort, GetCurrent, Detach ],
ProcessOperations USING[ HandleToIndex, ReadPSB ],
PSB     USING[ PDA ],
Rope     USING[ Equal, ROPE ],
RTTypesBasic  USING[ EquivalentTypes, nullType ],
SDDefs    USING[ sBreak, sCallDebugger, SD, sInterrupt, sSignal, sSignalList,
         sUncaughtSignal ],
TemporarySignals USING[ InformationalSignal ],
WorldVM,
WorldVMExtra  USING[ SwapAndBoot ],
XferTrap    USING[ ReadXTS, WriteXTS ];

AMEventsImpl: MONITOR
IMPORTS AMBridge, AMBridgeExtras, AMModelLocation, AMTypes, CedarSnapshot,
ConvertUnsafe, FastBreak, Frame, Inline, Process, ProcessOperations, Rope, RTTypesBasic,
TemporarySignals, WorldVM, WorldVMExtra, XferTrap
EXPORTS AMEventBooted, AMEvents, AMEventsExtra, AMEventsPrivate =

BEGIN

-- EventProc: TYPE = PROC[data: REF ANY, event: Event] RETURNS[outcome: Outcome];
--
-- Event: TYPE = REF EventRec;
--
-- Eventuality: TYPE = {
-- booted, break, call, signal, interrupt, addrFault, wrProtect, unknown };
--
-- EventRec: TYPE = RECORD[
-- world: World,
-- process: RTBasic.TV,
-- frame: RTBasic.TV,
-- worry: BOOLEAN,
-- detail: SELECT type: Eventuality FROM
-- booted =>  NULL,
-- break =>   [id: BreakID, clientData: REF ANY],
-- call =>   [msg: Rope.ROPE],
-- signal =>  [signal, args: RTBasic.TV ],
-- interrupt =>  NULL,
-- unknown => [why: Rope.ROPE],
-- ENDCASE];
--
-- Outcome: TYPE = RECORD[
-- SELECT type: * FROM
-- proceed =>  [result: RTBasic.TV],
-- quit =>   NULL,
-- retry =>   [frame, result: RTBasic.TV],
-- returnFrom => [frame, result: RTBasic.TV],
-- ENDCASE] ← [proceed[NIL]];
--
-- Stack: TYPE = RECORD[ SEQUENCE length: CARDINAL OF WORD ];


-- ******** Constants ******** --
swapInfoAddr: WorldVM.Address = LOOPHOLE[@PSB.PDA.available, WorldVM.Address];
-- This address is the root of the interface with PilotNub --


-- ******** Global Variables ******** --
actors: Actor ← NIL; -- the list of event watchers
localActor: Actor ← NIL;
clientChanged: CONDITION; -- notified when level, bootCount, running or runCount changes. --
oldCatcher: CatcherProc ← NIL;
oldInterrupt: InterruptProc ← NIL;
oldCallDebugger: CallDebuggerProc ← NIL;
oldBreak: BreakProc ← NIL;

supressUncaughtAborted: BOOL ← TRUE;

informing: BOOL ← TRUE; -- whether to raise the informational signals
wsls: BOOL ← TRUE;

breaks: LIST OF REF BreakRec ← NIL;
bootedNotifierRegistry: BootedNotifierRegistry ← NIL;


-- ******** ERRORS and SIGNALS ******** --
-- PUBLIC
Debugging: PUBLIC --INFORMATIONAL-- SIGNAL = CODE;
Debugged: PUBLIC --INFORMATIONAL-- SIGNAL = CODE;
BadControlLink: PUBLIC ERROR = CODE;
BadArgType: PUBLIC ERROR = CODE;
BadResStack: PUBLIC ERROR = CODE;
Booted: PUBLIC ERROR = CODE;

-- Private to this module
KillThisTurkey: ERROR = CODE;
NotImplemented: ERROR = CODE;
DuplicateBreakpoint: ERROR = CODE;
BreakNotFound: ERROR = CODE;


-- ******** TYPES ******** --
World: TYPE = WorldVM.World;
TV: TYPE = AMTypes.TV;

Operation: TYPE = { screen, kill, activate, boot, proceed, quit };
-- what to do to client beforereading his state --
CatcherProc: TYPE = PROC[msg, signal: UNSPECIFIED, frame: PrincOps.FrameHandle];
InterruptProc: TYPE = PROC;
CallDebuggerProc: TYPE = PROC[s: STRING];
BreakProc: TYPE = PROC;
BreakID: TYPE = REF BreakRec;

-- There may be multiple BreakRec's for a single breakpoint; the first is used as the ID. --
BreakRec: PUBLIC TYPE = RECORD[
id: BreakID ← NIL,
world: WorldVM.World,
addr: WorldVM.Address,
pc: PrincOps.BytePC,
oldByte: Mopcodes.op,
flushed: BOOL ← FALSE, -- world has booted since break was set --
clientData: REF ANY];

-- Management of event watchers ("Actor") for each world
Actor: TYPE = REF ActorObject;
ActorObject: TYPE = RECORD[
next: Actor,
world: World,
data: REF ANY, -- data to be passed back to the event proc --
proc: AMEvents.EventProc, -- event notification handler
users: INT ← 1, -- reference count on GetEvents/StopEvents
-- the remainder is only for world-swap and teledebug clients --
running: BOOL ← TRUE, -- client is running --
listener: PROCESS ← NIL, -- if not NIL, the process looking at the client --
bootCount: INT ← 0, -- incremented when a client session ends --
level: CARDINAL ← 0, -- nesting level of client procedure calls --
-- the remainder is data for interfacing with client --
swapInfo: CPSwapDefs.SwapInfo ← NULL,
esvAddr: WorldVM.Address ← 0,
esv: CPSwapDefs.ExternalStateVector ← NULL,
paramAddr: WorldVM.Address ← 0,
param: CPSwapDefs.DebugParameter ← NULL,
stateAddr: WorldVM.Address ← 0,
state: PrincOps.StateVector ← NULL,
bootee: Booting.Bootee ← NULL, -- to avoid a long arg record in FORK in GetOutcome! --
switches: Booting.Switches ← NULL ];

BootedNotifierRegistry: TYPE = LIST OF BNRec;
BNRec: TYPE = RECORD[proc: AMEventBooted.BootedNotifier,
world: WorldVM.World,
clientData: REF];


-- Locking for fields in an ActorObject:
-- Immutable: a.world, a.data, a.proc.
-- Inside monitor: a.next, a.users, a.running, a.listener, a.bootCount
-- By claiming "running": a.swapInfo, a.esvAddr, a.esv, a.paramAddr, a.param, a.stateAddr, a.state
-- "a.level" is altered with the monitor and a.running claimed, so it may be read either inside the monitor or by claiming a.running.

-- There are three sources of synchronisation problems:
-- ensuring that only one process transfers control to the client at a time,
-- the client booting,
-- someone calling "StopEvents".
-- The a.running field provides mutual exclusion on transferring to the client.
-- The a.bootCount field indicates when the client has booted. This is notified to the public by an event of type "booted".
-- Having a.users=0 indicates a desire to disconnect from the client. This is notified by an event of type "booted" and by aborting a.listener.

-- Note that we never access the client with our monitor locked: local events require access to our monitor, but access to a remote client involves unbounded delays.

GetEvents: PUBLIC ENTRY PROC[world: World, data: REF ANY, proc: AMEvents.EventProc] =
BEGIN
ENABLE UNWIND => NULL;
IF proc = NIL
THEN IF localActor = NIL OR data # NIL
THEN ERROR ELSE {proc ← localActor.proc; data ← localActor.data};
FOR a: Actor ← actors, a.next UNTIL a = NIL
DO IF a.world = world
THEN {a.users ← a.users+1; a.data ← data; a.proc ← proc; EXIT};
REPEAT FINISHED => -- here to make a new actor
BEGIN
new: Actor = NEW[ActorObject ← [actors, world, data, proc]];
actors ← new;
IF world = WorldVM.LocalWorld[]
THEN { localActor ← new; GrabLocalEvents[] }
ELSE Process.Detach[new.listener ← FORK LookAtClient[new, TRUE]];
END
ENDLOOP;
END;

StopEvents: PUBLIC PROC[world: World] =
BEGIN
a: Actor = EntryStop[world];
IF a # NIL
THEN [] ← InvokeEvent[a, NEW[AMEvents.EventRec ← [a.world,NIL,NIL,FALSE,booted[]]]];
END;

EntryStop: ENTRY PROC[world: World] RETURNS[a: Actor] =
BEGIN
prev: Actor ← NIL;
FOR a ← actors, a.next UNTIL a = NIL
DO IF a.world = world
THEN BEGIN
a.users ← a.users-1;
IF a.users = 0
THEN BEGIN
IF a = actors THEN actors ← actors.next ELSE prev.next ← a.next;
IF a.listener # NIL THEN { Process.Abort[a.listener]; a.listener ← NIL };
a.bootCount ← a.bootCount + 1; BROADCAST clientChanged;
IF world = WorldVM.LocalWorld[]
THEN { localActor ← NIL; ReleaseLocalEvents[] };
END
ELSE a ← NIL;
EXIT
END;
prev ← a;
ENDLOOP;
END;

InvokeEvent: PROC[a: Actor, event: AMEvents.Event]
RETURNS[AMEvents.Outcome] =
{ IF event.type = booted THEN CallBootedNotifiers[event.world];
RETURN[ a.proc[a.data, event] ] };

ProvokeProcessEvent: PUBLIC PROC[
p: AMTypes.TV,
frame: AMTypes.TV,
msg: Rope.ROPE]
RETURNS[outcome: AMEvents.Outcome] =
BEGIN
a: Actor ← NIL;
Find: ENTRY PROC =
BEGIN
FOR a ← actors, a.next UNTIL a = NIL
DO IF a.world = event.world THEN EXIT ENDLOOP;
END;
event: AMEvents.Event = NEW[AMEvents.EventRec ← [,,,FALSE,call[msg]] ];
event.frame ← frame;
event.world ← AMBridge.GetWorld[p];
event.process ← p;
Find[];
RETURN[IF a # NIL THEN InvokeEvent[a, event] ELSE [proceed[NIL]] ]
END;



-- ******** Events for non-local worlds ******** --

Call: PROC[world: WorldVM.World, which: Operation, state: PrincOps.SVPointer]
RETURNS[ok: BOOL] =
BEGIN
a: Actor ← NIL;
Find: ENTRY PROC =
BEGIN
FOR a ← actors, a.next UNTIL a = NIL
DO IF a.world = world THEN EXIT ENDLOOP;
END;
Find[];
IF a = NIL THEN RETURN[FALSE];
GetOutcome[a, which, state, ,];
RETURN[TRUE]
END;

Boot: PUBLIC SAFE PROC[boot: Booting.Bootee, switches: Booting.Switches ← Booting.defaultSwitches] = TRUSTED
BEGIN
state: PrincOps.StateVector;
a: Actor ← NIL;
Find: ENTRY PROC =
BEGIN
FOR a ← actors, a.next UNTIL a = NIL
DO IF Rope.Equal[WorldVM.WorldName[a.world], "Outload", FALSE] THEN EXIT ENDLOOP;
END;
Find[];
IF a = NIL
THEN WorldVMExtra.SwapAndBoot[boot, switches]
ELSE GetOutcome[a, boot, @state, boot, switches ! Booted => CONTINUE];
END;

GetOutcome: ENTRY PROC[a: Actor,
which: Operation[screen..boot],
state: PrincOps.SVPointer -- only for which = activate --,
who: Booting.Bootee, switches: Booting.Switches -- only for which = boot --] =
BEGIN
-- Perform call (or UserScreen, or Kill) and get result.
ENABLE UNWIND => NULL;
level: CARDINAL;
bootCount: INT;
DO IF a.running THEN { WAIT clientChanged; LOOP };
IF a.users = 0 THEN ERROR Booted[]; -- read as "ERROR EndSession[]" --
level ← a.level; bootCount ← a.bootCount; -- unique ID of this call --
a.esv.level ← a.level ← a.level + 1;
EXIT
ENDLOOP;
a.running ← TRUE;
SELECT which FROM
activate => a.param.sv ← state^;
boot => { a.bootee ← who; a.switches ← switches };
ENDCASE => NULL;
Process.Detach[a.listener ← FORK RunClient[a, which]];
UNTIL a.level = level
DO IF a.bootCount # bootCount THEN ERROR Booted[];
WAIT clientChanged;
ENDLOOP;
IF which = activate THEN state^ ← a.param.sv;
a.running ← FALSE; BROADCAST clientChanged;
END;

RemoteEvent: PROC[a: Actor, level: CARDINAL, bootCount: INT, event: AMEvents.Event] =
BEGIN
IF event.type = booted
THEN BEGIN
Start: ENTRY PROC RETURNS[ok: BOOL] =
{ IF (ok ← a.users#0) THEN { a.listener ← Process.GetCurrent[]; a.level ← 0 } };
Stop: ENTRY PROC =
{ a.listener ← NIL };
[] ← InvokeEvent[a, event]; -- with "a.running" still locked --
IF Start[]
THEN LookAtClient[a, TRUE ! ABORTED => { Stop[]; CONTINUE }; UNWIND => Stop[] ];
END
ELSE BEGIN
outcome: AMEvents.Outcome;
Unlock: ENTRY PROC =
BEGIN
a.running ← FALSE;
BROADCAST clientChanged;
END;
Lock: ENTRY PROC RETURNS[BOOL] =
BEGIN
ENABLE UNWIND => NULL;
DO IF a.running THEN { WAIT clientChanged; LOOP };
IF a.bootCount # bootCount THEN RETURN[FALSE];
IF a.level # level THEN { WAIT clientChanged; LOOP };
EXIT
ENDLOOP;
a.running ← TRUE;
a.listener ← Process.GetCurrent[];
RETURN[TRUE]
END;
Unlock[];
outcome ← InvokeEvent[a, event];
IF Lock[]
THEN WITH o: outcome SELECT FROM
proceed => RunClient[a, proceed];
quit => RunClient[a, quit];
ENDCASE => ERROR NotImplemented[];
END;
END;


-- "a.running" is a global exclusive lock. It must be claimed before transferring control to the client. It is released by "RemoteEvent" or "GetOutcome".
-- "a.bootCount" is incremented when client boots, to indicate failure of outstanding calls, and to intercept resumption from outstanding events.
-- "a.level" and "esv.level" are used to detect the client booting (when they're unequal).
-- a.level is incremented when making a call, to allow detection of which "return" corresponds to this call.
-- TEMP: PilotNub believes that calls are nested. PilotNub doesn't alter esv.level, so we can't match up a return with the appropriate call correctly. Instead, we increment a.level (and esv.level) before making a call, and inside "RunClient" we decrement them when we notice a return. Thus, outside of "RunClient", we can pretend that a.level (and esv.level) are a unique ID for a call. This kludge can be removed someday be changing PilotNub's handling of calls/returns. Note that there are cases where this kludge doesn't give the right answer; hard luck.

RunClient: PROC[a: Actor, which: Operation] =
BEGIN
-- "RunClient" transfers control to client, waits (implicitly, inside WVM) until client invokes us, then looks to see why. If client has booted, notifies "booted" event; if client returns from a call (not necessarily one we invoked), notifies presence of the result; if client has a new event, calls "RemoteEvent" to notify the event.
Unlock: ENTRY PROC =
BEGIN
a.running ← FALSE;
a.listener ← NIL;
BROADCAST clientChanged;
END;
IF NOT a.running THEN ERROR;
BEGIN
ENABLE
BEGIN
ABORTED => { Unlock[]; CONTINUE };
UNWIND => Unlock[];
END;
SELECT which FROM
proceed, quit =>
BEGIN
a.esv.reason ← IF which = proceed THEN proceed ELSE quit;
WorldVM.CopyWrite[a.world, @a.esv, SIZE[CPSwapDefs.ExternalStateVector],
a.esvAddr];
IF a.stateAddr # 0
THEN WorldVM.CopyWrite[a.world, @a.state, SIZE[PrincOps.StateVector],
a.stateAddr];
WorldVM.Go[a.world];
END;
screen, kill, activate =>
BEGIN
SELECT which FROM
screen => a.esv.reason ← showscreen;
kill => a.esv.reason ← kill;
activate =>
BEGIN
a.esv.reason ← call;
IF a.paramAddr # 0
THEN WorldVM.CopyWrite[a.world, @a.param, SIZE[CPSwapDefs.DebugParameter],
a.paramAddr];
END;
ENDCASE => ERROR;
WorldVM.CopyWrite[a.world, @a.esv, SIZE[CPSwapDefs.ExternalStateVector],
a.esvAddr];
WorldVM.Go[a.world];
END;
boot => WorldVMExtra.SwapAndBoot[a.bootee, a.switches];
ENDCASE => ERROR;
LookAtClient[a, FALSE];
END; -- ENABLE UNWIND --
END; -- RunClient --

LookAtClient: PROC[a: Actor, init: BOOL] =
BEGIN
NotifyHappening: ENTRY PROC[event: AMEvents.Event] =
BEGIN
-- Notify return from some call, or some event --
IF event = NIL
THEN a.level ← a.esv.level ← a.level - 1
ELSE BEGIN
IF event.type = booted THEN a.bootCount ← a.bootCount+1;
Process.Detach[FORK RemoteEvent[a, a.level, a.bootCount, event ] ];
END;
a.listener ← NIL;
BROADCAST clientChanged;
END;
IF NOT a.running THEN ERROR; -- someone should still have the lock! --
WorldVM.CopyRead[a.world, swapInfoAddr, SIZE[CPSwapDefs.SwapInfo],
@a.swapInfo];
a.esvAddr ← LOOPHOLE[a.swapInfo.externalStateVector, WorldVM.Address];
WorldVM.CopyRead[a.world, a.esvAddr, SIZE[CPSwapDefs.ExternalStateVector],
@a.esv];
a.paramAddr ← WorldVM.Long[a.world,
LOOPHOLE[a.esv.parameter, WorldVM.ShortAddress]];
IF a.paramAddr # 0
THEN WorldVM.CopyRead[a.world, a.paramAddr, SIZE[CPSwapDefs.DebugParameter],
@a.param];
a.stateAddr ← WorldVM.Long[a.world,
LOOPHOLE[a.esv.state, WorldVM.ShortAddress]];
IF a.stateAddr # 0
THEN WorldVM.CopyRead[a.world, a.stateAddr, SIZE[PrincOps.StateVector],
@a.state];
IF init THEN a.esv.level ← a.level;
SELECT TRUE FROM
a.level # a.esv.level =>
BEGIN
-- client has booted: report as an event (but not first time: think of as "endSession").
FlushBreaks[a.world];
NotifyHappening[ NEW[AMEvents.EventRec ← [a.world,NIL,NIL,FALSE,booted[]]] ];
END;
a.esv.reason = return AND a.level > 0-- return at level 0 is illegal -- =>
BEGIN
-- client is returning from a call --
NotifyHappening[NIL];
END;
ENDCASE =>
BEGIN
-- client is invoking us, or is hopelessly confused --
event: AMEvents.Event ← NIL;
SELECT a.esv.reason FROM
breakpoint, worrybreak =>
IF a.stateAddr = 0
THEN event ← UnknownEvent["No state for breakpoint"]
ELSE BEGIN
break: BreakID ← BreakEvent[a.world, @a.state, a.esv.reason=worrybreak];
IF break = NIL
THEN event ← UnknownEvent["Unknown breakpoint"]
ELSE event ← NEW[AMEvents.EventRec ←
[,,,a.esv.reason=worrybreak,break[break.id, break.clientData]] ];
END;
explicitcall, worrycall =>
BEGIN
event ← IF a.stateAddr = 0 OR a.state.stkptr = 0
THEN UnknownEvent["No argument for call debugger"]
ELSE NEW[AMEvents.EventRec ← [,,,a.esv.reason=worrycall,call[
RopeFromRemote[a.world, WorldVM.Long[a.world, a.state.stk[0]]]]]];
a.state.stkptr ← 0;
END;
uncaughtsignal =>
event ← SignalEvent[a.world, a.state.stk[1], a.state.stk[0]];
interrupt =>
event ← NEW[AMEvents.EventRec ← [,,,FALSE,interrupt[]]];
ENDCASE =>
event ← UnknownEvent["Unknown entry reason"];
IF a.stateAddr = 0
THEN event.frame ← NIL
ELSE event.frame ← AMBridge.TVForRemoteFrame[
[world: a.world,
worldIncarnation: WorldVM.CurrentIncarnation[a.world],
fh: LOOPHOLE[a.state.dest, WorldVM.ShortAddress]],
StackFromState[@a.state],
a.state.instbyte = Mopcodes.zRET,
event.type = break ];
event.world ← a.world;
event.process ← PSBIToTV[a.esv.psb, a.world];
NotifyHappening[event];
END;
END; -- LookAtClient --

RopeFromRemote: PROC[world: WorldVM.World, addr: WorldVM.Address]
RETURNS[ Rope.ROPE ] =
-- addr is remote address of a string (or 0) --
BEGIN
temp: STRING = [0];
s: STRING = [128]; -- restrict the length to protect ourselves --
min: CARDINAL = SIZE[StringBody[0]];
IF addr = 0 THEN RETURN[NIL];
WorldVM.CopyRead[world: world, from: addr, to: temp, nwords: min];
s.length ← MIN[temp.length, s.maxlength];
WorldVM.CopyRead[world: world, from: addr+min, to: s+min,
nwords: SIZE[StringBody[s.length]]-min];
RETURN[ConvertUnsafe.ToRope[s]]
END;




-- ******** Local events ******** --

GrabLocalEvents: INTERNAL PROC =
BEGIN
OPEN SDDefs;
oldCatcher ← SD[sUncaughtSignal]; IF wsls THEN SD[sUncaughtSignal] ← MyCatcher;
oldInterrupt ← SD[sInterrupt]; -- SD[sInterrupt] ← MyInterrupt;
oldCallDebugger ← SD[sCallDebugger]; -- SD[sCallDebugger] ← MyCallDebugger;
oldBreak ← SD[sBreak];
FastBreak.SpecifyDefaultBreakHandler[MyBreak]; -- RRA: first go through fast break handler
SD[sBreak] ← FastBreak.FastBreakHandler;
END;

ReleaseLocalEvents: INTERNAL PROC =
BEGIN
OPEN SDDefs;
SD[sUncaughtSignal] ← oldCatcher;
SD[sInterrupt] ← oldInterrupt;
SD[sCallDebugger] ← oldCallDebugger;
FastBreak.SpecifyDefaultBreakHandler[oldBreak]; -- RRA: this may cause problems, but they ae no worse than for regular breakpoints that the old handler does not understand. I believe that this procedure is completely useless.
SD[sBreak] ← oldBreak;
END;

WorldSwapLocalSignals: PUBLIC ENTRY PROC[yes: BOOL] =
BEGIN
OPEN SDDefs;
wsls ← yes;
IF localActor # NIL
THEN BEGIN
IF wsls
THEN SD[sUncaughtSignal] ← MyCatcher
ELSE SD[sCallDebugger] ← oldCallDebugger;
END;
END;

MyCatcher: CatcherProc =
BEGIN
signaller: PrincOps.GlobalFrameHandle;
f: PrincOps.FrameHandle ← Frame.GetReturnFrame[];
signaller ← f.accesslink;
-- The call stack below here is: Signaller, [Signaller,] offender
f ← LOOPHOLE[f.returnlink, PrincOps.FrameHandle];
IF f.accesslink = signaller THEN f ← LOOPHOLE[f.returnlink, PrincOps.FrameHandle];
IF supressUncaughtAborted AND signal = ABORTED
THEN { TurkeyCatcher[frame]; ERROR KillThisTurkey };
LocalEvent[SignalEvent[WorldVM.LocalWorld[], signal, msg],
f, NIL];
END;

TurkeyCatcher: PROC [root: PrincOps.FrameHandle] =
BEGIN
endProcess: PrincOps.ControlLink = root.returnlink;
Caller: PROC = LOOPHOLE[Frame.GetReturnLink[]];
root.returnlink ← [frame[Frame.MyLocalFrame[]]];
Frame.SetReturnFrame[PrincOps.NullFrame];
Caller[ ! KillThisTurkey => CONTINUE];
Frame.SetReturnLink[endProcess];
END;

MyInterrupt: InterruptProc =
BEGIN
LocalEvent[NEW[AMEvents.EventRec ← [,,,,interrupt[]] ],
Frame.GetReturnFrame[], NIL];
END;

MyCallDebugger: CallDebuggerProc =
BEGIN
LocalEvent[NEW[AMEvents.EventRec ← [,,,,call[ConvertUnsafe.ToRope[s]]] ],
Frame.GetReturnFrame[], NIL];
END;

MyBreak: BreakProc =
BEGIN
state: RECORD[ padding: LONG CARDINAL, v: PrincOps.StateVector];
event: AMEvents.Event;
break: BreakID;
state.v ← STATE;
state.v.dest ← Frame.GetReturnLink[];
break ← BreakEvent[WorldVM.LocalWorld[], @state.v, FALSE];
IF break = NIL
THEN BEGIN
localFrame: PrincOps.FrameHandle = state.v.dest.frame;
globalFrame: PrincOps.GlobalFrameHandle = localFrame.accesslink;
codeBase: LONG POINTER = globalFrame.code.longbase;
instAddr: LONG POINTER TO PrincOps.InstWord = codeBase + localFrame.pc / 2;
inst: Mopcodes.op =
IF localFrame.pc MOD 2 = 0 THEN instAddr.evenbyte ELSE instAddr.oddbyte;
IF inst = Mopcodes.zBRK
THEN -- breakpoint must have been set by world-swap debugger -
BEGIN
state.v.dest ← LOOPHOLE[oldBreak];
state.v.source ← LOOPHOLE[Frame.GetReturnLink[]];
RETURN WITH state.v
END;
END
ELSE LocalEvent[event ← NEW[AMEvents.EventRec ←
[,,,FALSE,break[break.id, break.clientData]] ],
Frame.GetReturnFrame[], @state.v, state.v.instbyte = Mopcodes.zRET];
state.v.dest ← Frame.GetReturnLink[];
state.v.source ← PrincOps.NullLink;
IF XferTrap.ReadXTS[] = on THEN XferTrap.WriteXTS[skip1];
RETURN WITH state.v;
END;

CallDebugger: PUBLIC PROC[msg: Rope.ROPE] =
BEGIN
IF localActor # NIL
THEN LocalEvent[NEW[AMEvents.EventRec ← [,,,,call[msg]] ],
Frame.GetReturnFrame[], NIL]
ELSE (LOOPHOLE[SDDefs.SD[SDDefs.sCallDebugger], CallDebuggerProc])["Call debugger"L];
END;

LocalEvent: PROC[event: AMEvents.Event, f: PrincOps.FrameHandle,
stack: POINTER TO PrincOps.StateVector,
return: BOOL ← FALSE] =
BEGIN
outcome: AMEvents.Outcome;
event.world ← localActor.world;
event.process ←
PSBIToTV[ProcessOperations.HandleToIndex[ProcessOperations.ReadPSB[]], localActor.world];
event.frame ← AMBridge.TVForFrame[f, stack, return, event.type = break];
event.worry ← FALSE;
IF informing THEN TemporarySignals.InformationalSignal[Debugging];
outcome ← InvokeEvent[localActor, event];
IF informing THEN TemporarySignals.InformationalSignal[Debugged];
WITH o: outcome SELECT FROM
proceed => NULL;
quit => ERROR ABORTED -- I don't like it, but that's the convention for now --;
retry, returnFrom => ERROR NotImplemented[];
ENDCASE => ERROR;
END;

UnknownEvent: PROC [msg: Rope.ROPE] RETURNS [event: AMEvents.Event] =
{event ← NEW[AMEvents.EventRec ← [,,,TRUE,unknown[msg]]]};

Checkpoint: ENTRY CedarSnapshot.CheckpointProc =
{ IF localActor # NIL THEN ReleaseLocalEvents[] };

Rollback: ENTRY CedarSnapshot.RollbackProc =
{ IF localActor # NIL THEN GrabLocalEvents[] };




-- ******** Subroutines for both local and non-local worlds ******** --

StackFromState: PROC[state: LONG POINTER TO PrincOps.StateVector]
RETURNS[stack: AMBridge.WordSequence] =
BEGIN
stack ← NEW[AMBridge.WordSequenceRecord[state.stkptr]];
FOR i: INT IN [0..stack.size) DO stack[i] ← state.stk[i] ENDLOOP;
END;

SignalEvent: PROC[world: World, signal, msg: UNSPECIFIED]
RETURNS[AMEvents.Event] =
BEGIN
local: BOOLEAN = (world = WorldVM.LocalWorld[]);
sigTV: AMTypes.TV;
argType: AMTypes.Type;
arg: AMTypes.TV;
BEGIN
ENABLE AMTypes.Error => GOTO cant;
sigTV ← IF local
THEN AMBridge.TVForSignal[LOOPHOLE[signal, ERROR ANY RETURNS ANY]]
ELSE AMBridge.TVForRemoteSignal[
[world: world,
worldIncarnation: WorldVM.CurrentIncarnation[world],
sed: signal] ];
argType ← AMTypes.Domain[AMTypes.TVType[sigTV]];
IF argType = RTTypesBasic.nullType
THEN arg ← NIL
ELSE IF AMTypes.Size[argType] = 1
THEN { arg ← AMTypes.New[argType, mutable, world];
AMBridge.SetTVFromLC[arg, LOOPHOLE[msg, CARDINAL]] }
ELSE arg ← TVForPointer[world, LOOPHOLE[msg, WorldVM.ShortAddress], argType];
EXITS cant =>
BEGIN
sigTV ← AMBridge.TVForReferent[NEW[CARDINAL ← LOOPHOLE[signal, CARDINAL]]];
arg ← AMBridge.TVForReferent[NEW[CARDINAL ← LOOPHOLE[msg, CARDINAL]]];
END;
END;
RETURN[ NEW[AMEvents.EventRec ← [,,,FALSE,signal[sigTV, arg]] ] ]
END;

TVForPointer: PROC[world: WorldVM.World, ptr: WorldVM.ShortAddress, type: AMTypes.Type]
RETURNS[ tv: AMTypes.TV ] =
BEGIN
IF world = WorldVM.LocalWorld[]
THEN tv ← AMBridge.TVForPointerReferent[LOOPHOLE[ptr, POINTER], type]
ELSE tv ← AMBridge.TVForRemotePointerReferent[
[world: world,
worldIncarnation: WorldVM.CurrentIncarnation[world],
ptr: WorldVM.Long[world, ptr]],
type];
END;

PSBIToTV: PROC[psbi: CARDINAL, world: WorldVM.World] RETURNS[p: AMTypes.TV] =
BEGIN
ENABLE AMTypes.Error => { p ← NIL; CONTINUE };
p ← AMTypes.New[CODE[PROCESS], mutable, world];
AMBridge.SetTVFromLC[p, psbi];
END;




-- ******** Breakpoints ******** --

BreakAt: PUBLIC PROC[world: WorldVM.World, section: AMModel.Section, clientData: REF ANY]
RETURNS[id: BreakID] =
{ id ← BreakIt[TRUE, world, section, clientData] };

BreakAfter: PUBLIC PROC[world: WorldVM.World, section: AMModel.Section, clientData: REF ANY]
RETURNS[id: BreakID] =
{ id ← BreakIt[FALSE, world, section, clientData] };

BreakIt: PROC[at: BOOL, world: WorldVM.World, section: AMModel.Section, clientData: REF ANY]
RETURNS[id: BreakID] =
BEGIN
list: LIST OF AMModelLocation.CodeLocation;
secWorld: WorldVM.World;
[secWorld, list] ←
IF at
THEN AMModelLocation.EntryLocations[section]
ELSE AMModelLocation.ExitLocations[section];
id ← NIL;
FOR loc: LIST OF AMModelLocation.CodeLocation ← list, list.rest UNTIL loc = NIL
DO loc.first.codeBase.out ← FALSE;
id ← RealSetBreak[id, world, LOOPHOLE[loc.first.codeBase.longbase], loc.first.pc, clientData];
ENDLOOP;
END;

FrameBreak: PUBLIC PROC[gf: AMTypes.TV, pc: CARDINAL, clientData: REF ANY]
RETURNS[id: BreakID] =
BEGIN
gfAddr: WorldVM.ShortAddress = AMBridge.TVToCardinal[gf];
world: WorldVM.World = AMBridge.GetWorld[gf];
gfHead: PrincOps.GlobalFrame;
WorldVM.CopyRead[world: world,
from: WorldVM.Long[world, gfAddr],
to: @gfHead,
nwords: SIZE[PrincOps.GlobalFrame]];
gfHead.code.out ← FALSE;
id ← SetBreak[world, LOOPHOLE[gfHead.code.longbase], pc, clientData];
END;

SetBreak: PUBLIC PROC[world: WorldVM.World,
addr: WorldVM.Address, pc: CARDINAL,
clientData: REF ANY]
RETURNS[id: BreakID] =
{ id ← RealSetBreak[NIL, world, addr, pc, clientData] };

RealSetBreak: ENTRY PROC[id: BreakID,
world: WorldVM.World,
addr: WorldVM.Address, pc: CARDINAL,
clientData: REF ANY]
RETURNS[newID: BreakID] =
BEGIN
new: REF BreakRec =
NEW[BreakRec ← [world: world, addr: addr, pc: [pc], oldByte: , clientData: clientData]];
new.id ← newID ← IF id = NIL THEN new ELSE id;
FOR b: LIST OF REF BreakRec ← breaks, b.rest UNTIL b = NIL
DO x: BreakID = b.first;
IF x.world = world AND x.addr = addr AND x.pc = pc
THEN RETURN WITH ERROR DuplicateBreakpoint[];
ENDLOOP;
breaks ← CONS[first: new, rest: breaks];
new.oldByte ← WorldVM.SetBreak[world, addr, [pc]]; -- JTM: don't set break until allocations are done! --
END;

ClearBreak: PUBLIC ENTRY PROC[id: BreakID] =
BEGIN
prev: LIST OF REF BreakRec ← NIL;
FOR b: LIST OF REF BreakRec ← breaks, b.rest UNTIL b = NIL
DO IF b.first.id = id
THEN BEGIN
IF b = breaks THEN breaks ← b.rest ELSE prev.rest ← b.rest;
IF NOT b.first.flushed
THEN WorldVM.ClearBreak[b.first.world, b.first.addr, b.first.pc, b.first.oldByte];
b.first.id ← NIL; -- break circular structure --
EXIT
END
ELSE prev ← b;
REPEAT FINISHED => RETURN WITH ERROR BreakNotFound[]
ENDLOOP;
END;

FlushBreaks: ENTRY PROC[world: World] =
BEGIN
FOR b: LIST OF REF BreakRec ← breaks, b.rest UNTIL b = NIL
DO IF b.first.world = world THEN b.first.flushed ← TRUE ENDLOOP;
END;

BreakEvent: PROC[world: World, state: LONG POINTER TO PrincOps.StateVector, worry: BOOL]
RETURNS[break: BreakID] =
BEGIN -- JTM: changed BreakEvent to return a BreakID rather than an Event
localFrame: PrincOps.Frame;
globalFrame: PrincOps.GlobalFrame;
word: WorldVM.Address;
byte: [0..1];
FindBreak: ENTRY PROC RETURNS[BreakID] =
BEGIN
FOR b: LIST OF REF BreakRec ← breaks, b.rest UNTIL b = NIL
DO x: REF BreakRec = b.first;
IF x.world = world AND x.addr + x.pc/2 = word AND x.pc MOD 2 = byte
AND NOT x.flushed
THEN BEGIN
state.instbyte ← x.oldByte;
RETURN[ b.first ]
END;
ENDLOOP;
-- If we get here, we've hit a break point not recorded in our list --
-- This is either a world-swap breakpoint, or a race where we cleared the break point after the
-- process hit it. If it's the race, we can fix it by retrying the instruction. We can distinguish
-- the cases by looking at the code byte (see the local breakpoint handler). --
state.instbyte ← 0;
RETURN[NIL]
END;
WorldVM.CopyRead[world: world,
from: WorldVM.Long[world, LOOPHOLE[state.dest.frame, WorldVM.ShortAddress]],
to: @localFrame, nwords: SIZE[PrincOps.Frame] ];
WorldVM.CopyRead[world: world,
from: WorldVM.Long[world, LOOPHOLE[localFrame.accesslink, WorldVM.ShortAddress]],
to: @globalFrame, nwords: SIZE[PrincOps.GlobalFrame] ];
word ← LOOPHOLE[globalFrame.code.longbase, WorldVM.Address] + localFrame.pc / 2;
byte ← localFrame.pc MOD 2;
RETURN[FindBreak[]];
END;




-- ******** Invoking procedures in client worlds ******** --

Apply: PUBLIC PROC[control, args: AMTypes.TV]
RETURNS[result: AMTypes.TV] =
BEGIN
world: WorldVM.World = AMBridge.GetWorld[control];
local: BOOL = world = WorldVM.LocalWorld[];
controlType: AMTypes.Type = AMTypes.TVType[control];
class: AMTypes.Class ← AMTypes.UnderClass[controlType];
argType: AMTypes.Type;
argBits: AMBridge.WordSequence;
resType: AMTypes.Type;
resSize: CARDINAL;
state: PrincOps.StateVector;
SELECT class FROM
procedure, signal, globalFrame => NULL;
error => class ← signal;
ENDCASE => ERROR BadControlLink[];
state.dest ← LOOPHOLE[AMBridge.TVToCardinal[control]];
state.source ← LOOPHOLE[Frame.MyLocalFrame[]];
argType ← AMTypes.Domain[controlType];
IF (argType = RTTypesBasic.nullType AND args # NIL)
OR NOT RTTypesBasic.EquivalentTypes[argType, AMTypes.TVType[args]]
OR (argType # RTTypesBasic.nullType AND world # AMBridge.GetWorld[args])
THEN ERROR BadArgType[];
argBits ← IF argType = RTTypesBasic.nullType
THEN NEW[AMBridge.WordSequenceRecord[0]]
ELSE AMBridge.TVToWordSequence[args];
IF argBits.size > PrincOps.MaxParamsInStack
OR (class = signal AND argBits.size > 1)
THEN BEGIN -- long argument record --
IF NOT local THEN ERROR BadArgType[];
FOR i: PrincOps.FrameSizeIndex IN PrincOps.FrameSizeIndex
DO IF argBits.size <= PrincOps.FrameVec[i]
THEN { state.stk[0] ← Frame.Alloc[i]; EXIT }
REPEAT FINISHED => ERROR--args too big for any frame!--
ENDLOOP;
state.stkptr ← 1;
IF argBits.size # 0 -- otherwise we'd get a bounds trap --
THEN Inline.LongCOPY[from: @argBits[0],
to: LOOPHOLE[state.stk[0],POINTER],
nwords: argBits.size];
END
ELSE BEGIN -- short argument record --
IF argBits.size # 0 -- otherwise we'd get a bounds trap --
THEN Inline.LongCOPY[from: @argBits[0], to: @state.stk, nwords: argBits.size];
state.stkptr ← argBits.size;
END;
IF class = signal
THEN BEGIN -- really, call the signal handler through SD --
-- SignalHandler: PROC[signal: SIGNAL, message: UNSPECIFIED]
IF NOT local THEN ERROR BadControlLink[];
state.stk[1] ← state.stk[0]; -- message --
state.stk[0] ← state.dest; -- signal --
state.stkptr ← 2;
state.dest ← SDDefs.SD[IF argBits.size > 1
THEN SDDefs.sSignalList
ELSE SDDefs.sSignal];
END;
state.instbyte ← 0;
IF local
THEN { TRANSFER WITH state; state ← STATE }
ELSE IF NOT Call[world, activate, @state] THEN ERROR--we aren't debugging that world--;
resType ← AMTypes.Range[controlType];
IF resType = RTTypesBasic.nullType
THEN BEGIN
IF state.stkptr # 0 THEN ERROR BadResStack[];
result ← NIL
END
ELSE BEGIN
resSize ← AMTypes.Size[resType];
result ← AMTypes.New[type: resType, world: world];
IF resSize > PrincOps.MaxParamsInStack
THEN BEGIN -- long result record --
res: AMTypes.TV;
IF state.stkptr # 1 THEN ERROR BadResStack[];
res ← TVForPointer[world, LOOPHOLE[state.stk[0],WorldVM.ShortAddress], resType];
AMTypes.Assign[lhs: result, rhs: res];
IF local THEN Frame.Free[LOOPHOLE[state.stk[0]]] ELSE NULL--TEMP?--;
END
ELSE BEGIN -- short result record --
IF state.stkptr # resSize THEN ERROR BadResStack[];
IF local
THEN AMTypes.Assign[lhs: result,
rhs: AMBridge.TVForPointerReferent[@state.stk, resType]]
ELSE {ws: AMBridge.WordSequence ← NEW[AMBridge.WordSequenceRecord[resSize]];
Inline.LongCOPY[from: @state.stk, nwords: resSize, to: @ws[0]];
AMBridgeExtras.SetTVFromWordSequence[tv: result, ws: ws]};
END
END;
END;

Kill: PUBLIC PROC[world: World] =
BEGIN
state: PrincOps.StateVector;
IF world # WorldVM.LocalWorld[]
THEN [] ← Call[world, kill, @state ! Booted => CONTINUE];
END;

Screen: PUBLIC SAFE PROC[world: World] = TRUSTED
BEGIN
state: PrincOps.StateVector;
IF world # WorldVM.LocalWorld[]
THEN [] ← Call[world, screen, @state ! Booted => CONTINUE];
END;

RegisterBootedNotifier: PUBLIC ENTRY SAFE PROC
[proc: AMEventBooted.BootedNotifier, world: WorldVM.World ← NIL, clientData: REF ← NIL] =
TRUSTED{
ENABLE UNWIND => NULL;
bootedNotifierRegistry ← CONS[[proc, world, clientData], bootedNotifierRegistry];
};

UnRegisterBootedNotifier: PUBLIC ENTRY SAFE PROC
[proc: AMEventBooted.BootedNotifier, world: WorldVM.World ← NIL, clientData: REF ← NIL] =
TRUSTED{
ENABLE UNWIND => NULL;
prev: BootedNotifierRegistry ← NIL;
FOR this: BootedNotifierRegistry ← bootedNotifierRegistry, this.rest UNTIL this = NIL
DO IF this.first.proc = proc
AND (world = NIL OR world = this.first.world)
AND (clientData = NIL OR clientData = this.first.clientData)
THEN {IF prev = NIL THEN bootedNotifierRegistry ← this.rest ELSE prev.rest ← this.rest}
ELSE prev ← this;
ENDLOOP;
};

CallBootedNotifiers: PROC[world: WorldVM.World] = {
FOR bnr: BootedNotifierRegistry ← bootedNotifierRegistry,
NextBootedNotifier[world, bnr] UNTIL bnr = NIL
DO bnr.first.proc[world, bnr.first.clientData];
ENDLOOP;
};

NextBootedNotifier: ENTRY PROC[world: WorldVM.World, bnr: BootedNotifierRegistry]
RETURNS[next: BootedNotifierRegistry ← NIL--nomore--] = {
ENABLE UNWIND => NULL;
FOR this: BootedNotifierRegistry ← bnr.rest, this.rest UNTIL this = NIL
DO IF this.first.world = NIL OR world = this.first.world THEN RETURN[this];
ENDLOOP;
};

-- START HERE

CedarSnapshot.Register[c: Checkpoint, r: Rollback];

END.