AMEventsImpl.mesa
Copyright © 1984, 1985 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) April 17, 1985 7:03:07 pm PST
Andrew Birrell October 25, 1983 12:08 pm
Maxwell, March 31, 1983 8:05 am (search for 'JTM')
Paul Rovner January 12, 1984 11:17 am
Bob Hagmann November 26, 1985 1:42:36 pm PST
DIRECTORY
AMBridge USING [ GetWorld, SetTVFromLC, SetTVFromWordSequence, TVForFrame, TVForPointerReferent, TVForReferent, TVForRemoteFrame, TVForRemotePointerReferent, TVForRemoteSignal, TVForSignal, TVToCardinal, TVToWordSequence, WordSequence, WordSequenceRecord ],
AMEvents USING [ BootedNotifier, Event, EventProc, EventRec, Outcome ],
AMEventsBackdoor USING [GuestProcsRec],
AMEventsBackdoorExtra USING [ActorObject],
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, AMEventsBackdoor, AMEventsBackdoorExtra = {
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: PUBLIC Actor ← NIL; -- the list of event watchers
LocalActor: PUBLIC Actor ← NIL;
clientChanged: CONDITION; -- notified when level, bootCount, running or runCount changes.
oldCatcher: RuntimeError.UCSProc ← NIL;
oldBreak: PROC ← NIL;
SupressUncaughtAborted:
PUBLIC 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:
PUBLIC 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:
PUBLIC 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:
PUBLIC 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;
IsGuestProcess: PROC [] RETURNS [isGuest: BOOL] ← FalseProc;
GuestProcs: REF AMEventsBackdoor.GuestProcsRec ← NEW[AMEventsBackdoor.GuestProcsRec ← [FalseProc]] ;
******** 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;
Some low level errors
KillThisTurkey: PUBLIC ERROR = CODE;
NotImplemented: PUBLIC ERROR = CODE;
BreakNotFound: PUBLIC 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 AMEventsBackdoorExtra.ActorObject;
BootedNotifierRegistry: TYPE = LIST OF BNRec;
BNRec:
TYPE =
RECORD[proc: AMEvents.BootedNotifier,
world: World,
clientData: REF];
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[AMEventsBackdoorExtra.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];
};
};
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 ← LOOPHOLE[PrincOps.SD[PrincOps.sBreak]];
FastBreak.SpecifyDefaultBreakHandler[MyBreak]; -- RRA: first go through fast break handler
PrincOps.SD[PrincOps.sBreak] ← LOOPHOLE[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] ← LOOPHOLE[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;
returnFrame: PrincOps.FrameHandle ← PrincOpsUtils.GetReturnFrame[];
f: PrincOps.FrameHandle;
guestDebug: BOOL = IsGuestProcess[];
originalFMark: BOOL;
signaller ← returnFrame.accesslink;
originalFMark ← returnFrame.mark;
IF guestDebug
THEN returnFrame.mark ←
FALSE;
We discovered that while walking the stack, the debugger got confused by the caller's frame (which is part of the signal machinery). It thought it was a signal (?), and by turning the mark off, this fixed the problem. What the side effects of this are, I have no idea. Done only for guests. rbh
The call stack below here is: Signaller, [Signaller,] offender
f ← LOOPHOLE[returnFrame.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"];
debugLocally: BOOL;
IF guestDebug
THEN {
GuestProcs.disableGuest[TRUE];
debugLocally ← GuestProcs.guestLocalEvent[SignalEvent[ WorldVM.LocalWorld[], signal, msg], f, NIL, FALSE];
IF debugLocally
THEN {
returnFrame.mark ← originalFMark;
LocalEvent[SignalEvent[ WorldVM.LocalWorld[], signal, msg], f, NIL];
};
GuestProcs.disableGuest[FALSE];
}
ELSE {
returnFrame.mark ← originalFMark;
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;
guestDebug: BOOL = IsGuestProcess[];
IF guestDebug THEN GuestProcs.disableGuest[TRUE];
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[]];
IF guestDebug THEN GuestProcs.disableGuest[FALSE];
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];
IF guestDebug THEN GuestProcs.disableGuest[FALSE];
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:
PUBLIC 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];
};
breakpointHack: {mostRecent, leastRecent, all} ← all;
RRA: breakpointHack controls the setting of breakpoints in code for identical sections
mostRecent sets the breakpoint in the most recently loaded location
leastRecent sets the breakpoint in the least recently loaded location
all sets the breakpoint in all locations corresponding to the section
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;
IF list #
NIL
THEN
SELECT breakpointHack
FROM
mostRecent => list.rest ← NIL;
leastRecent => WHILE list.rest # NIL DO list ← list.rest; ENDLOOP;
ENDCASE;
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] ← LOOPHOLE[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] ← LOOPHOLE[state.dest]; -- signal --
state.stkptr ← 2;
state.dest ← LOOPHOLE[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;
};
Exported to AMEventsBackdoor
RegisterGuestProcs:
PUBLIC
PROC [newProcs:
REF AMEventsBackdoor.GuestProcsRec] = {
GuestProcs ← newProcs;
IsGuestProcess ← newProcs.IsGuestProcess;
};
default IsGuestProcess is FalseProc
FalseProc:
PROC
RETURNS [isGuest:
BOOL] = {
isGuest ← FALSE;
};
}.
Bob Hagmann March 18, 1985 10:40:50 am PST
changes to: DIRECTORY, IsGuestProcess, GuestProcs, MyCatcher, NextBootedNotifier, RegisterGuestProcs, MyBreak
Bob Hagmann November 21, 1985 11:45:54 am PST
add disableGuest call before RETURN WITH state.v from world-swap debugger breakpoint
changes to: MyBreak
Bob Hagmann November 26, 1985 1:42:37 pm PST
created AMEventsBackdoorExtra and exported to it