AMEventsImpl.mesa
Copyright © 1984 by Xerox Corporation. All rights reserved.
Andrew Birrell October 25, 1983 12:08 pm
Russ Atkinson, December 13, 1984 5:06:12 pm PST
Maxwell, March 31, 1983 8:05 am (search for 'JTM')
Paul Rovner January 12, 1984 11:17 am
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 ],
ConvertUnsafe USING[ ToRope ],
DebuggerFormat USING[ DebugParameter, ExternalStateVector, SwapInfo ],
DebuggerSwap USING[ CallDebugger ],
FastBreak USING[ FastBreakHandler, SpecifyDefaultBreakHandler ],
PrincOps USING[ BytePC, ControlLink, Frame, FrameHandle, FrameSizeIndex, FrameVec, GlobalFrame, GlobalFrameHandle, InstWord, MaxParamsInStack, NullFrame, NullLink, op, PDA, sBreak, SD, sSignal, sSignalList, StateVector, SVPointer, zBRK, zRET ],
PrincOpsUtils USING[ Alloc, Free, GetReturnFrame, GetReturnLink, PsbHandleToIndex, LongCOPY, MyLocalFrame, ReadPSB, ReadXTS, SetReturnFrame, SetReturnLink, WriteXTS ],
Process USING[ Abort, GetCurrent, Detach ],
Rope USING[ Equal, ROPE ],
RuntimeError USING [ InformationalSignal, RegisterUncaughtSignalHandler, UCSProc, UNCAUGHT ],
SafeStorage USING[ EquivalentTypes, nullType ],
WorldVM USING [Address, ClearBreak, CopyRead, CopyWrite, CurrentIncarnation, Go, LocalWorld, Long, SetBreak, ShortAddress, World, WorldName];
AMEventsImpl:
MONITOR
IMPORTS AMBridge, AMModelLocation, AMTypes, Booting, ConvertUnsafe, DebuggerSwap, FastBreak, PrincOpsUtils, Process, Rope, RuntimeError, SafeStorage, WorldVM
EXPORTS AMEvents, AMEventsPrivate = {
Address: TYPE = WorldVM.Address;
DebugParameter: TYPE = DebuggerFormat.DebugParameter;
Event: TYPE = AMEvents.Event;
EventProc: TYPE = AMEvents.EventProc;
ExternalStateVector: TYPE = DebuggerFormat.ExternalStateVector;
ROPE: TYPE = Rope.ROPE;
Section: TYPE = AMModel.Section;
StateVector: TYPE = PrincOps.StateVector;
StateVectorPtr: TYPE = LONG POINTER TO StateVector;
SVPointer: TYPE = PrincOps.SVPointer;
TV: TYPE = AMTypes.TV;
Type: TYPE = AMTypes.Type;
World: TYPE = WorldVM.World;
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: Address =
LOOPHOLE[@PrincOps.
PDA.available, 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;
This is TRUE to kill off processes that do not have a base frame that catches ABORTED and flush out the process. This makes it easier to kill off processes. You can set this FALSE to find processes that are being aborted when you don't think that they are.
crashOnRecursiveAppearance:
BOOL ←
FALSE;
RRA: We can set this to TRUE to carsh when a signal appears to be recursive. Experience has shown that signals appear to be recursive more often than they are recursive, however.
informing:
BOOL ←
TRUE;
Whether to raise the informational signals. You have to remember that ANY handles informational signals, so you probably want to use RuntimeError.UNCAUGHT to handle errors that others will not handle.
wsls:
BOOL ←
TRUE;
If TRUE, will world-swap uncaught local signals, instead of sending them to the registered handler. This is useful before the handler is established, or when the handler is buggy.
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 ******** --
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: World,
addr: Address,
pc: PrincOps.BytePC,
oldByte: PrincOps.op,
clientData: REF];
Management of event watchers ("Actor") for each world
Actor: TYPE = REF ActorObject;
ActorObject:
TYPE =
RECORD[
common fields
next: Actor,
world: World,
data: REF, -- data to be passed back to the event proc
proc: 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: Address ← 0,
esv: ExternalStateVector ← NULL,
paramAddr: Address ← 0,
param: DebugParameter ← NULL,
stateAddr: Address ← 0,
state: StateVector ← NULL ];
BootedNotifierRegistry: TYPE = LIST OF BNRec;
BNRec:
TYPE =
RECORD[proc: AMEvents.BootedNotifier,
world: 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, proc: EventProc] = {
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
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]];
}
ENDLOOP;
};
StopEvents:
PUBLIC
PROC [world: World] = {
a: Actor;
oldSession: INT;
[a, oldSession] ← EntryStop[world];
FlushBreaks[world];
IF a # NIL THEN CallBootedNotifiers[a.world, oldSession];
};
EntryStop:
ENTRY
PROC [world: World]
RETURNS [a: Actor, oldSession:
INT] = {
ENABLE UNWIND => NULL;
prev: Actor ← NIL;
FOR a ← actors, a.next
UNTIL a =
NIL DO
IF a.world = world
THEN {
a.users ← a.users-1;
IF a.users = 0
THEN {
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[];
};
}
ELSE a ← NIL;
EXIT
};
prev ← a;
ENDLOOP;
};
InvokeEvent:
PROC [a: Actor, event: Event]
RETURNS [AMEvents.Outcome] = {
RETURN[ a.proc[a.data, event] ];
};
ProvokeProcessEvent:
PUBLIC
PROC [ p:
TV, frame:
TV, msg:
ROPE]
RETURNS [outcome: AMEvents.Outcome] = {
a: Actor ← NIL;
Find:
ENTRY
PROC = {
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;
};
event: 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]] ]
};
******** Events for non-local worlds ******** --
Call:
PROC [world: World, which: Operation, state: SVPointer]
RETURNS [ok:
BOOL] = {
a: Actor ← NIL;
Find:
ENTRY
PROC = {
ENABLE UNWIND => NULL;
FOR a ← actors, a.next UNTIL a = NIL DO IF a.world = world THEN EXIT ENDLOOP;
};
Find[];
IF a = NIL THEN RETURN[FALSE];
GetOutcome[a, which, state];
RETURN[TRUE]
};
MyCheckpoint:
ENTRY Booting.CheckpointProc =
TRUSTED {
ENABLE UNWIND => NULL;
a: Actor = NARROW[clientData];
};
MyRollback:
ENTRY Booting.RollbackProc =
TRUSTED {
ENABLE UNWIND => NULL;
a: Actor = NARROW[clientData];
IF
NOT a.running
AND a.users # 0
THEN {
a.running ← TRUE;
Process.Detach[a.listener ← FORK RunClient[a, boot]];
};
};
GetOutcome:
ENTRY
PROC [a: Actor, which: Operation[screen..activate], state: SVPointer
-- only for which = activate --] = {
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;
};
RemoteEvent:
PROC [a: Actor, level:
CARDINAL, bootCount:
INT, event: Event] = {
outcome: AMEvents.Outcome;
Unlock:
ENTRY
PROC = {
ENABLE UNWIND => NULL;
a.running ← FALSE;
BROADCAST clientChanged;
};
Lock:
ENTRY
PROC
RETURNS [
BOOL] = {
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]
};
Unlock[];
outcome ← InvokeEvent[a, event];
IF Lock[]
THEN
WITH o: outcome
SELECT
FROM
proceed => RunClient[a, proceed];
quit => RunClient[a, quit];
ENDCASE => ERROR NotImplemented[];
};
Some locking notes
"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] = {
"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 = {
ENABLE UNWIND => NULL;
a.running ← FALSE;
a.listener ← NIL;
BROADCAST clientChanged;
};
IF NOT a.running THEN ERROR;
{
ENABLE {
ABORTED => { Unlock[]; CONTINUE };
UNWIND => Unlock[];
};
SELECT which
FROM
proceed, quit => {
a.esv.reason ← IF which = proceed THEN proceed ELSE quit;
WorldVM.CopyWrite[a.world, @a.esv, SIZE[ExternalStateVector], a.esvAddr];
IF a.stateAddr # 0
THEN
WorldVM.CopyWrite[a.world, @a.state, SIZE[StateVector], a.stateAddr];
WorldVM.Go[a.world];
};
screen, kill, activate => {
SELECT which
FROM
screen => a.esv.reason ← showscreen;
kill => a.esv.reason ← kill;
activate => {
a.esv.reason ← call;
IF a.paramAddr # 0
THEN
WorldVM.CopyWrite[a.world, @a.param, SIZE[DebugParameter], a.paramAddr];
};
ENDCASE => ERROR;
WorldVM.CopyWrite[a.world, @a.esv, SIZE[ExternalStateVector], a.esvAddr];
WorldVM.Go[a.world];
};
boot => NULL;
ENDCASE => ERROR;
LookAtClient[a, which];
}; -- ENABLE UNWIND --
}; -- RunClient --
LookAtClient:
PROC [a: Actor, which: Operation] = {
NotifyHappening:
ENTRY
PROC [event: Event] = {
Notify return from some call, or some event --
ENABLE UNWIND => NULL;
IF event =
NIL
THEN a.level ← a.esv.level ← a.level - 1
ELSE {
event.session ← a.bootCount;
Process.Detach[FORK RemoteEvent[a, a.level, a.bootCount, event ] ];
};
a.listener ← NIL;
BROADCAST clientChanged;
};
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, Address];
WorldVM.CopyRead[a.world, a.esvAddr, SIZE[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[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[StateVector], @a.state];
IF which # init
AND a.level # a.esv.level
THEN {
client has booted: report to notifiers (but not first time: think of as "endSession").
NotifyBooted:
ENTRY
PROC
RETURNS [oldSession:
INT] = {
ENABLE UNWIND => NULL;
oldSession ← a.bootCount;
a.bootCount ← a.bootCount+1;
a.listener ← NIL; BROADCAST clientChanged;
};
Start:
ENTRY
PROC
RETURNS [ok:
BOOL] = {
ENABLE UNWIND => NULL;
IF (ok ← a.users#0) THEN { a.listener ← Process.GetCurrent[]; a.level ← 0 }
};
FlushBreaks[a.world];
CallBootedNotifiers[a.world, NotifyBooted[]]; -- with "a.running" still locked --
IF NOT Start[] THEN RETURN;
};
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 {
client is invoking us, or is hopelessly confused --
event: Event ← NIL;
SELECT a.esv.reason
FROM
breakpoint, worrybreak =>
IF a.stateAddr = 0
THEN event ← UnknownEvent["No state for breakpoint"]
ELSE {
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]] ];
};
explicitcall, worrycall => {
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;
};
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];
};
}; -- LookAtClient --
RopeFromRemote:
PROC [world: World, addr: Address]
RETURNS [
ROPE] = {
addr is remote address of a string (or 0)
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]]
};
******** Local events ******** --
GrabLocalEvents:
INTERNAL
PROC = {
IF wsls THEN oldCatcher ← RuntimeError.RegisterUncaughtSignalHandler[MyCatcher];
oldBreak ← PrincOps.SD[PrincOps.sBreak];
FastBreak.SpecifyDefaultBreakHandler[MyBreak]; -- RRA: first go through fast break handler
PrincOps.SD[PrincOps.sBreak] ← FastBreak.FastBreakHandler;
};
ReleaseLocalEvents:
INTERNAL
PROC = {
IF wsls THEN [] ← RuntimeError.RegisterUncaughtSignalHandler[oldCatcher];
FastBreak.SpecifyDefaultBreakHandler[oldBreak];
RRA: this may cause problems, but they are no worse than for regular breakpoints that the old handler does not understand. I believe that this procedure is completely useless.
PrincOps.SD[PrincOps.sBreak] ← oldBreak;
};
WorldSwapLocalSignals:
PUBLIC
ENTRY
PROC [yes:
BOOL] = {
ENABLE UNWIND => NULL;
IF wsls = yes THEN RETURN;
IF localActor #
NIL THEN {
wsls ← yes;
IF wsls
THEN [] ← RuntimeError.RegisterUncaughtSignalHandler[oldCatcher]
ELSE oldCatcher ← RuntimeError.RegisterUncaughtSignalHandler[MyCatcher]
};
};
MyCatcher: RuntimeError.UCSProc = {
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;
};
{
ENABLE RuntimeError.
UNCAUGHT =>
IF crashOnRecursiveAppearance
THEN
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];
};
};
TurkeyCatcher:
PROC [root: PrincOps.FrameHandle] = {
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];
};
MyBreak:
PROC = {
state: RECORD[ padding: LONG CARDINAL, v: StateVector];
event: Event;
break: BreakID;
state.v ← STATE;
state.v.dest ← PrincOpsUtils.GetReturnLink[];
break ← BreakEvent[WorldVM.LocalWorld[], @state.v, FALSE];
IF break =
NIL
THEN {
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
state.v.dest ← LOOPHOLE[oldBreak];
state.v.source ← LOOPHOLE[PrincOpsUtils.GetReturnLink[]];
RETURN WITH state.v
};
}
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;
};
CallDebugger:
PUBLIC
PROC [msg:
ROPE] = {
IF localActor #
NIL
THEN LocalEvent[
NEW[AMEvents.EventRec ← [detail: call[msg]] ], PrincOpsUtils.GetReturnFrame[], NIL]
ELSE DebuggerSwap.CallDebugger["Call debugger"];
};
LocalEvent:
PROC [event: Event, f: PrincOps.FrameHandle, stack: SVPointer, return:
BOOL ←
FALSE] = {
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;
};
UnknownEvent:
PROC [msg:
ROPE]
RETURNS [event: Event] = {
event ← NEW[AMEvents.EventRec ← [worry: TRUE, detail: unknown[msg]]];
};
******** Subroutines for both local and non-local worlds ******** --
StackFromState:
PROC [state: StateVectorPtr]
RETURNS [stack: AMBridge.WordSequence] = {
stack ← NEW[AMBridge.WordSequenceRecord[state.stkptr]];
FOR i: INT IN [0..stack.size) DO stack[i] ← state.stk[i] ENDLOOP;
};
SignalEvent:
PROC [world: World, signal, msg:
UNSPECIFIED]
RETURNS [Event] = {
local: BOOL = (world = WorldVM.LocalWorld[]);
sigTV: TV;
argType: Type;
arg: TV;
{
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 => {
sigTV ← AMBridge.TVForReferent[NEW[CARDINAL ← LOOPHOLE[signal, CARDINAL]]];
arg ← AMBridge.TVForReferent[NEW[CARDINAL ← LOOPHOLE[msg, CARDINAL]]];
};
};
RETURN[ NEW[AMEvents.EventRec ← [detail: signal[sigTV, arg]]] ]
};
TVForPointer:
PROC [world: World, ptr: WorldVM.ShortAddress, type: Type]
RETURNS [tv:
TV] = {
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];
};
PSBIToTV:
PROC [psbi:
CARDINAL, world: World]
RETURNS [p:
TV] = {
ENABLE AMTypes.Error => { p ← NIL; CONTINUE };
p ← AMTypes.New[CODE[PROCESS], mutable, world];
AMBridge.SetTVFromLC[p, psbi];
};
******** Breakpoints ******** --
BreakAt:
PUBLIC
PROC [world: World, section: Section, clientData:
REF]
RETURNS [id: BreakID] = {
id ← BreakIt[TRUE, world, section, clientData];
};
BreakAfter:
PUBLIC
PROC [world: World, section: Section, clientData:
REF]
RETURNS [id: BreakID] = {
id ← BreakIt[FALSE, world, section, clientData];
};
BreakIt:
PROC [at:
BOOL, world: World, section: Section, clientData:
REF]
RETURNS [id: BreakID] = {
list: LIST OF AMModelLocation.CodeLocation;
secWorld: World;
[secWorld, list] ←
IF at
THEN AMModelLocation.EntryLocations[section]
ELSE AMModelLocation.ExitLocations[section];
id ← NIL;
FOR loc:
LIST
OF AMModelLocation.CodeLocation ← list, loc.rest
UNTIL loc =
NIL DO
loc.first.codeBase.out ← FALSE;
id ← RealSetBreak[id, world, LOOPHOLE[loc.first.codeBase.longbase], loc.first.pc, clientData];
ENDLOOP;
};
FrameBreak:
PUBLIC
PROC [gf:
TV, pc:
CARDINAL, clientData:
REF]
RETURNS [id: BreakID] = {
gfAddr: WorldVM.ShortAddress = AMBridge.TVToCardinal[gf];
world: 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];
};
SetBreak:
PUBLIC
PROC [world: World, addr: Address, pc:
CARDINAL, clientData:
REF]
RETURNS [id: BreakID] = {
id ← RealSetBreak[NIL, world, addr, pc, clientData];
};
RealSetBreak:
ENTRY
PROC [id: BreakID, world: World, addr: Address, pc:
CARDINAL, clientData:
REF]
RETURNS [newID: BreakID] = {
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;
};
ClearBreak:
PUBLIC
ENTRY
PROC [id: BreakID] = {
ENABLE UNWIND => NULL;
prev: REF BreakRec ← NIL;
FOR b:
REF BreakRec ← breaks, b.rest
UNTIL b =
NIL DO
IF b.id = id
THEN {
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
}
ELSE prev ← b;
REPEAT FINISHED => NULL -- probably from a previous session, abolished by FlushBreaks
ENDLOOP;
};
FlushBreaks:
ENTRY
PROC [world: World] = {
called at end of session; breaks have gone away
ENABLE UNWIND => NULL;
prev: REF BreakRec ← NIL;
FOR b:
REF BreakRec ← breaks, b.rest
UNTIL b =
NIL DO
IF b.world = world
THEN {
IF b = breaks THEN breaks ← b.rest ELSE prev.rest ← b.rest;
b.id ← NIL; -- break circular structure --
}
ELSE prev ← b;
REPEAT FINISHED => NULL -- probably from a previous session, abolished by FlushBreaks
ENDLOOP;
};
NextBreak:
PUBLIC
ENTRY
PROC [world: World, prev: BreakID]
RETURNS [id: BreakID, clientData:
REF] = {
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]
};
BreakEvent:
PROC [world: World, state: StateVectorPtr, worry:
BOOL]
RETURNS [break: BreakID] = {
JTM: changed BreakEvent to return a BreakID rather than an Event
localFrame: PrincOps.Frame;
globalFrame: PrincOps.GlobalFrame;
word: Address;
byte: [0..1];
FindBreak:
ENTRY
PROC
RETURNS [BreakID] = {
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 {
state.instbyte ← b.oldByte;
RETURN[ b ]
};
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]
};
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, Address] + localFrame.pc / 2;
byte ← localFrame.pc MOD 2;
RETURN[FindBreak[]];
};
******** Invoking procedures in client worlds ******** --
Apply:
PUBLIC
PROC [control, args:
TV]
RETURNS [result:
TV] = {
world: World = AMBridge.GetWorld[control];
local: BOOL = world = WorldVM.LocalWorld[];
controlType: Type = AMTypes.TVType[control];
class: AMTypes.Class ← AMTypes.UnderClass[controlType];
argType: Type;
argBits: AMBridge.WordSequence;
resType: Type;
resSize: CARDINAL;
state: StateVector;
dstPtr: LONG POINTER ← @state.stk;
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 {
-- 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;
dstPtr ← LOOPHOLE[state.stk[0], POINTER];
}
ELSE {
-- short argument record --
state.stkptr ← argBits.size;
};
IF argBits.size # 0
THEN
otherwise we'd get a bounds trap
PrincOpsUtils.LongCOPY[from: @argBits[0], to: dstPtr, nwords: argBits.size];
IF class = signal
THEN {
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];
};
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 {
IF state.stkptr # 0 THEN ERROR BadResStack[];
result ← NIL
}
ELSE {
resSize ← AMTypes.Size[resType];
result ← AMTypes.New[type: resType, world: world];
IF resSize > PrincOps.MaxParamsInStack
THEN {
long result record
res: 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?--;
}
ELSE {
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]};
}
};
};
Kill:
PUBLIC
SAFE
PROC [world: World] =
TRUSTED {
state: StateVector;
IF world # WorldVM.LocalWorld[]
THEN
[] ← Call[world, kill, @state ! EndSession => CONTINUE];
};
Screen:
PUBLIC
SAFE
PROC [world: World] =
TRUSTED {
state: StateVector;
IF world # WorldVM.LocalWorld[]
THEN
[] ← Call[world, screen, @state ! EndSession => CONTINUE];
};
RegisterBootedNotifier:
PUBLIC
ENTRY
SAFE
PROC [proc: AMEvents.BootedNotifier, world: World ←
NIL, clientData:
REF ←
NIL] =
TRUSTED{
ENABLE UNWIND => NULL;
bootedNotifierRegistry ← CONS[[proc, world, clientData], bootedNotifierRegistry];
};
UnRegisterBootedNotifier:
PUBLIC
ENTRY
SAFE
PROC [proc: AMEvents.BootedNotifier, world: 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: 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: 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;
};
}.