Cedar Abstract Machine: interactions with client
AMEventsImpl.mesa
Andrew Birrell October 25, 1983 12:08 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 December 7, 1983 4:32 pm
DIRECTORY
AMBridge USING[ GetWorld, SetTVFromLC, SetTVFromWordSequence, TVForFrame, TVForPointerReferent, TVForReferent, TVForRemoteFrame, TVForRemotePointerReferent, TVForRemoteSignal, TVForSignal, TVToCardinal, TVToWordSequence, WordSequence, WordSequenceRecord ],
AMEvents USING[ BootedNotifier, Event, EventProc, EventRec, Outcome ],
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[ CheckpointProc, RegisterProcs, RollbackProc ],
-- CedarSnapshot USING[ CheckpointProc, Register, RollbackProc ],
ConvertUnsafe USING[ ToRope ],
DebuggerFormat USING[ DebugParameter, ExternalStateVector, SwapInfo ],
DebuggerSwap USING[ CallDebugger ],
FastBreak USING[ FastBreakHandler, SpecifyDefaultBreakHandler ], -- RRA: new
PrincOpsUtils USING[ Alloc, Free, GetReturnFrame, GetReturnLink, PsbHandleToIndex, LongCOPY, MyLocalFrame, ReadPSB, ReadXTS, SetReturnFrame, SetReturnLink, WriteXTS ],
PrincOps USING[ BytePC, ControlLink, Frame, FrameHandle, FrameSizeIndex, FrameVec, GlobalFrame, GlobalFrameHandle, InstWord, MaxParamsInStack, NullFrame, NullLink, op, PDA, sBreak, SD, sSignal, sSignalList, StateVector, SVPointer, zBRK, zRET ],
Process USING[ Abort, GetCurrent, Detach ],
Rope USING[ Equal, ROPE ],
RuntimeError USING[ InformationalSignal, RegisterUncaughtSignalHandler, UCSProc, UNCAUGHT ],
SafeStorage USING[ EquivalentTypes, nullType ],
WorldVM;
AMEventsImpl:
MONITOR
IMPORTS AMBridge, AMModelLocation, AMTypes, --CedarSnapshot,--
Booting, ConvertUnsafe, DebuggerSwap, FastBreak, PrincOpsUtils, Process, Rope, SafeStorage,
RuntimeError, WorldVM
EXPORTS AMEvents, AMEventsPrivate =
BEGIN
EventProc: TYPE = PROC[data: REF ANY, event: Event] RETURNS[outcome: Outcome];
Event: TYPE = REF EventRec;
Eventuality: TYPE = {
break, call, signal, unknown };
EventRec: TYPE = RECORD[
world: World,
session: INT,
process: RTBasic.TV,
frame: RTBasic.TV,
worry: BOOLEAN,
detail: SELECT type: Eventuality FROM
break => [id: BreakID, clientData: REF ANY],
call => [msg: Rope.ROPE],
signal => [signal, args: RTBasic.TV ],
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[@
PrincOps.
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: RuntimeError.UCSProc ← NIL;
oldBreak: PROC ← NIL;
supressUncaughtAborted: BOOL ← TRUE;
informing: BOOL ← TRUE; -- whether to raise the informational signals
wsls: BOOL ← TRUE;
breaks: 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;
EndSession: PUBLIC ERROR = CODE;
DuplicateBreakpoint:
PUBLIC ERROR =
CODE;
Private to this module
KillThisTurkey: ERROR = CODE;
NotImplemented: ERROR = CODE;
BreakNotFound: ERROR = CODE;
-- ******** TYPES ******** --
World: TYPE = WorldVM.World;
TV: TYPE = AMTypes.TV;
Operation:
TYPE = { screen, kill, activate, boot, proceed, quit, init };
-- what to do to client before reading his state --
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[
rest: REF BreakRec ← NIL,
id: BreakID ← NIL,
world: WorldVM.World,
addr: WorldVM.Address,
pc: PrincOps.BytePC,
oldByte: PrincOps.op,
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: DebuggerFormat.SwapInfo ← NULL,
esvAddr: WorldVM.Address ← 0,
esv: DebuggerFormat.ExternalStateVector ← NULL,
paramAddr: WorldVM.Address ← 0,
param: DebuggerFormat.DebugParameter ← NULL,
stateAddr: WorldVM.Address ← 0,
state: PrincOps.StateVector ← NULL ];
BootedNotifierRegistry: TYPE = LIST OF BNRec;
BNRec:
TYPE =
RECORD[proc: AMEvents.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 through the BootedNotifiers.
Having a.users=0 indicates a desire to disconnect from the client. This is notified to the BootedNotifiers 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 Rope.Equal[WorldVM.WorldName[world], "Outload", FALSE]
THEN Booting.RegisterProcs[c: MyCheckpoint, r: MyRollback, clientData: new];
IF world = WorldVM.LocalWorld[]
THEN { localActor ← new; GrabLocalEvents[] }
ELSE Process.Detach[new.listener ← FORK LookAtClient[new, init]];
END
ENDLOOP;
END;
StopEvents:
PUBLIC
PROC[world: World] =
BEGIN
a: Actor;
oldSession: INT;
[a, oldSession] ← EntryStop[world];
FlushBreaks[world];
IF a # NIL THEN CallBootedNotifiers[a.world, oldSession];
END;
EntryStop:
ENTRY
PROC[world: World]
RETURNS[a: Actor, oldSession:
INT] =
BEGIN
ENABLE UNWIND => NULL;
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 };
oldSession ← a.bootCount;
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] =
{
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
ENABLE UNWIND => NULL;
FOR a ← actors, a.next UNTIL a = NIL
DO IF a.world = event.world THEN EXIT ENDLOOP;
IF a # NIL THEN event.session ← a.bootCount;
END;
event: AMEvents.Event = NEW[AMEvents.EventRec ← [detail: 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
ENABLE UNWIND => NULL;
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;
MyCheckpoint:
ENTRY Booting.CheckpointProc =
TRUSTED
BEGIN
ENABLE UNWIND => NULL;
a: Actor = NARROW[clientData];
END;
MyRollback:
ENTRY Booting.RollbackProc =
TRUSTED
BEGIN
ENABLE UNWIND => NULL;
a: Actor = NARROW[clientData];
IF NOT a.running AND a.users # 0
THEN
BEGIN
a.running ← TRUE;
Process.Detach[a.listener ← FORK RunClient[a, boot]];
END;
END;
GetOutcome:
ENTRY
PROC[a: Actor,
which: Operation[screen..activate],
state: PrincOps.SVPointer -- only for which = activate --] =
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 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;
IF which = activate THEN a.param.sv ← state^;
Process.Detach[a.listener ← FORK RunClient[a, which]];
UNTIL a.level = level
DO
IF a.bootCount # bootCount
THEN
ERROR EndSession[];
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
outcome: AMEvents.Outcome;
Unlock:
ENTRY
PROC =
BEGIN
ENABLE UNWIND => NULL;
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;
"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, calls booted-notifiers; 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
ENABLE UNWIND => NULL;
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[DebuggerFormat.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[DebuggerFormat.DebugParameter],
a.paramAddr];
END;
ENDCASE => ERROR;
WorldVM.CopyWrite[a.world, @a.esv,
SIZE[DebuggerFormat.ExternalStateVector],
a.esvAddr];
WorldVM.Go[a.world];
END;
boot => NULL;
ENDCASE => ERROR;
LookAtClient[a, which];
END; -- ENABLE UNWIND --
END; -- RunClient --
LookAtClient:
PROC[a: Actor, which: Operation] =
BEGIN
NotifyHappening:
ENTRY
PROC[event: AMEvents.Event] =
BEGIN
-- Notify return from some call, or some event --
ENABLE UNWIND => NULL;
IF event = NIL
THEN a.level ← a.esv.level ← a.level - 1
ELSE
BEGIN
event.session ← a.bootCount;
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[DebuggerFormat.SwapInfo],
@a.swapInfo];
a.esvAddr ← LOOPHOLE[a.swapInfo.externalStateVector, WorldVM.Address];
WorldVM.CopyRead[a.world, a.esvAddr,
SIZE[DebuggerFormat.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[DebuggerFormat.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 which # init AND a.level # a.esv.level
THEN
BEGIN
client has booted: report to notifiers (but not first time: think of as "endSession").
NotifyBooted:
ENTRY
PROC
RETURNS[oldSession:
INT] =
BEGIN
ENABLE UNWIND => NULL;
oldSession ← a.bootCount;
a.bootCount ← a.bootCount+1;
a.listener ← NIL; BROADCAST clientChanged;
END;
Start:
ENTRY
PROC
RETURNS[ok:
BOOL] =
BEGIN
ENABLE UNWIND => NULL;
IF (ok ← a.users#0) THEN { a.listener ← Process.GetCurrent[]; a.level ← 0 }
END;
FlushBreaks[a.world];
CallBootedNotifiers[a.world, NotifyBooted[]]; -- with "a.running" still locked --
IF NOT Start[] THEN RETURN;
END;
a.esv.level ← a.level;
IF a.esv.reason = return AND a.level > 0 -- return at level 0 is illegal --
THEN -- client is returning from a call -- NotifyHappening[NIL]
ELSE 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 ←
[worry: a.esv.reason=worrybreak, detail: 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 ← [worry: a.esv.reason=worrycall, detail: 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]];
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 = PrincOps.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 PrincOps;
IF wsls THEN oldCatcher ← RuntimeError.RegisterUncaughtSignalHandler[MyCatcher];
oldBreak ← SD[sBreak];
FastBreak.SpecifyDefaultBreakHandler[MyBreak]; -- RRA: first go through fast break handler
SD[sBreak] ← FastBreak.FastBreakHandler;
END;
ReleaseLocalEvents:
INTERNAL
PROC =
BEGIN
OPEN PrincOps;
IF wsls THEN [] ← RuntimeError.RegisterUncaughtSignalHandler[oldCatcher];
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
ENABLE UNWIND => NULL;
IF wsls = yes THEN RETURN;
IF localActor # NIL
THEN
BEGIN
wsls ← yes;
IF wsls
THEN [] ← RuntimeError.RegisterUncaughtSignalHandler[oldCatcher]
ELSE oldCatcher ← RuntimeError.RegisterUncaughtSignalHandler[MyCatcher]
END;
END;
MyCatcher: RuntimeError.UCSProc =
BEGIN
firstSignal: SIGNAL ANY RETURNS ANY = signal; -- to avoid name clash below!
signaller: PrincOps.GlobalFrameHandle;
f: PrincOps.FrameHandle ← PrincOpsUtils.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 = LOOPHOLE[ABORTED]
THEN { TurkeyCatcher[frame]; ERROR KillThisTurkey };
BEGIN
ENABLE RuntimeError.
UNCAUGHT =>
IF signal--arg of catch-phrase-- = firstSignal-- arg of this procedure --
THEN DebuggerSwap.CallDebugger["Recursively uncaught signal"];
LocalEvent[SignalEvent[WorldVM.LocalWorld[], signal, msg], f, NIL];
END;
END;
TurkeyCatcher:
PROC [root: PrincOps.FrameHandle] =
BEGIN
endProcess: PrincOps.ControlLink = root.returnlink;
Caller: PROC = LOOPHOLE[PrincOpsUtils.GetReturnLink[]];
root.returnlink ← [frame[PrincOpsUtils.MyLocalFrame[]]];
PrincOpsUtils.SetReturnFrame[PrincOps.NullFrame];
Caller[ ! KillThisTurkey => CONTINUE];
PrincOpsUtils.SetReturnLink[endProcess];
END;
MyBreak:
PROC =
BEGIN
state: RECORD[ padding: LONG CARDINAL, v: PrincOps.StateVector];
event: AMEvents.Event;
break: BreakID;
state.v ← STATE;
state.v.dest ← PrincOpsUtils.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: PrincOps.op =
IF localFrame.pc MOD 2 = 0 THEN instAddr.evenbyte ELSE instAddr.oddbyte;
IF inst = PrincOps.zBRK
THEN
-- breakpoint must have been set by world-swap debugger -
BEGIN
state.v.dest ← LOOPHOLE[oldBreak];
state.v.source ← LOOPHOLE[PrincOpsUtils.GetReturnLink[]];
RETURN WITH state.v
END;
END
ELSE LocalEvent[event ←
NEW[AMEvents.EventRec←[detail: break[break.id, break.clientData]] ],
PrincOpsUtils.GetReturnFrame[], @state.v, state.v.instbyte = PrincOps.zRET];
state.v.dest ← PrincOpsUtils.GetReturnLink[];
state.v.source ← PrincOps.NullLink;
IF PrincOpsUtils.ReadXTS[] = on THEN PrincOpsUtils.WriteXTS[skip1];
RETURN WITH state.v;
END;
CallDebugger:
PUBLIC
PROC[msg: Rope.
ROPE] =
BEGIN
IF localActor # NIL
THEN LocalEvent[
NEW[AMEvents.EventRec ← [detail: call[msg]] ],
PrincOpsUtils.GetReturnFrame[], NIL]
ELSE DebuggerSwap.CallDebugger["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.session ← localActor.bootCount;
event.process ←
PSBIToTV[PrincOpsUtils.PsbHandleToIndex[PrincOpsUtils.ReadPSB[]], localActor.world];
event.frame ← AMBridge.TVForFrame[f, stack, return, event.type = break];
event.worry ← FALSE;
IF informing THEN RuntimeError.InformationalSignal[Debugging];
outcome ← InvokeEvent[localActor, event];
IF informing THEN RuntimeError.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 ← [worry: TRUE, detail: 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 = SafeStorage.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 ← [detail: 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
ENABLE UNWIND => NULL;
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: REF BreakRec ← breaks, b.rest UNTIL b = NIL
DO x: BreakID = b;
IF x.world = world AND x.addr = addr AND x.pc = pc
THEN RETURN WITH ERROR DuplicateBreakpoint[];
ENDLOOP;
new.oldByte ← WorldVM.SetBreak[world, addr, [pc]]; -- JTM: don't set break until allocations are done! --
new.rest ← breaks; breaks ← new;
END;
ClearBreak:
PUBLIC
ENTRY
PROC[id: BreakID] =
BEGIN
ENABLE UNWIND => NULL;
prev: REF BreakRec ← NIL;
FOR b: REF BreakRec ← breaks, b.rest UNTIL b = NIL
DO
IF b.id = id
THEN
BEGIN
WorldVM.ClearBreak[b.world, b.addr, b.pc, b.oldByte];
IF b = breaks THEN breaks ← b.rest ELSE prev.rest ← b.rest;
b.id ← NIL; -- break circular structure --
EXIT
END
ELSE prev ← b;
REPEAT FINISHED => NULL -- probably from a previous session, abolished by FlushBreaks
ENDLOOP;
END;
FlushBreaks:
ENTRY
PROC[world: World] =
-- called at end of session; breaks have gone away
BEGIN
ENABLE UNWIND => NULL;
prev: REF BreakRec ← NIL;
FOR b: REF BreakRec ← breaks, b.rest UNTIL b = NIL
DO
IF b.world = world
THEN
BEGIN
IF b = breaks THEN breaks ← b.rest ELSE prev.rest ← b.rest;
b.id ← NIL; -- break circular structure --
END
ELSE prev ← b;
REPEAT FINISHED => NULL -- probably from a previous session, abolished by FlushBreaks
ENDLOOP;
END;
NextBreak:
PUBLIC
ENTRY
PROC[world: World, prev: BreakID]
RETURNS[id: BreakID, clientData:
REF
ANY] =
BEGIN
ENABLE UNWIND => NULL;
FOR b: REF BreakRec ← (IF prev = NIL THEN breaks ELSE prev.rest), b.rest UNTIL b = NIL
DO IF b.id = b AND ( b.world = world OR world = NIL ) THEN RETURN[b, b.clientData];
ENDLOOP;
RETURN[NIL,NIL]
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
ENABLE UNWIND => NULL;
FOR b: REF BreakRec ← breaks, b.rest UNTIL b = NIL
DO
IF b.world = world
AND b.addr + b.pc/2 = word
AND b.pc
MOD 2 = byte
THEN
BEGIN
state.instbyte ← b.oldByte;
RETURN[ b ]
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[PrincOpsUtils.MyLocalFrame[]];
argType ← AMTypes.Domain[controlType];
IF (argType = SafeStorage.nullType AND args # NIL)
OR NOT SafeStorage.EquivalentTypes[argType, AMTypes.TVType[args]]
OR (argType # SafeStorage.nullType AND world # AMBridge.GetWorld[args])
THEN ERROR BadArgType[];
argBits ←
IF argType = SafeStorage.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] ← PrincOpsUtils.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 PrincOpsUtils.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 PrincOpsUtils.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 ← PrincOps.
SD[
IF argBits.size > 1
THEN PrincOps.sSignalList
ELSE PrincOps.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 = SafeStorage.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 PrincOpsUtils.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]];
PrincOpsUtils.LongCOPY[from: @state.stk, nwords: resSize, to: @ws[0]];
AMBridge.SetTVFromWordSequence[tv: result, ws: ws]};
END
END;
END;
Kill:
PUBLIC
SAFE
PROC[world: World] =
TRUSTED
BEGIN
state: PrincOps.StateVector;
IF world # WorldVM.LocalWorld[]
THEN [] ← Call[world, kill, @state ! EndSession => CONTINUE];
END;
Screen:
PUBLIC
SAFE
PROC[world: World] =
TRUSTED
BEGIN
state: PrincOps.StateVector;
IF world # WorldVM.LocalWorld[]
THEN [] ← Call[world, screen, @state ! EndSession => CONTINUE];
END;
RegisterBootedNotifier:
PUBLIC
ENTRY
SAFE
PROC
[proc: AMEvents.BootedNotifier, world: WorldVM.World ← NIL, clientData: REF ← NIL] =
TRUSTED{
ENABLE UNWIND => NULL;
bootedNotifierRegistry ← CONS[[proc, world, clientData], bootedNotifierRegistry];
};
UnRegisterBootedNotifier:
PUBLIC
ENTRY
SAFE
PROC
[proc: AMEvents.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, session:
INT] = {
FOR bnr: BootedNotifierRegistry ← bootedNotifierRegistry,
NextBootedNotifier[world, bnr] UNTIL bnr = NIL
DO bnr.first.proc[world, session, 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.