-- Cedar Abstract Machine: interactions with client -- AMEventsImpl.mesa -- Andrew Birrell February 16, 1983 4:09 pm -- Russ Atkinson, April 11, 1983 4:42 pm (RRA: use FastBreak, eliminate UnsafeBreaks) -- Maxwell, March 31, 1983 8:05 am (search for 'JTM') -- Paul Rovner April 22, 1983 10:23 am DIRECTORY AMBridge USING[ GetWorld, SetTVFromLC, TVForFrame, TVForPointerReferent, TVForReferent, TVForRemoteFrame, TVForRemotePointerReferent, TVForRemoteSignal, TVForSignal, TVToCardinal, TVToWordSequence, WordSequence, WordSequenceRecord ], AMBridgeExtras USING[ SetTVFromWordSequence ], AMEventBooted USING[ BootedNotifier ], AMEvents USING[ Event, EventProc, EventRec, Outcome ], AMEventsExtra USING[ ], AMEventsPrivate USING[ ], AMModel USING[ Section ], AMModelLocation USING[ CodeLocation, EntryLocations, ExitLocations ], AMTypes USING[ Assign, Class, Domain, Error, New, Range, Size, TV, TVType, Type, UnderClass ], Booting USING[ Bootee, defaultSwitches, Switches ], CedarSnapshot USING[ CheckpointProc, Register, RollbackProc ], ConvertUnsafe USING[ ToRope ], CPSwapDefs USING[ DebugParameter, ExternalStateVector, SwapInfo ], FastBreak USING[ FastBreakHandler, SpecifyDefaultBreakHandler ], -- RRA: new Frame USING[ Alloc, Free, GetReturnFrame, GetReturnLink, MyLocalFrame, SetReturnFrame, SetReturnLink ], Inline USING[ LongCOPY ], Mopcodes USING[ op, zBRK, zRET ], PrincOps USING[ BytePC, ControlLink, Frame, FrameHandle, FrameSizeIndex, FrameVec, GlobalFrame, GlobalFrameHandle, InstWord, MaxParamsInStack, NullFrame, NullLink, StateVector, SVPointer ], Process USING[ Abort, GetCurrent, Detach ], ProcessOperations USING[ HandleToIndex, ReadPSB ], PSB USING[ PDA ], Rope USING[ Equal, ROPE ], RTTypesBasic USING[ EquivalentTypes, nullType ], SDDefs USING[ sBreak, sCallDebugger, SD, sInterrupt, sSignal, sSignalList, sUncaughtSignal ], TemporarySignals USING[ InformationalSignal ], WorldVM, WorldVMExtra USING[ SwapAndBoot ], XferTrap USING[ ReadXTS, WriteXTS ]; AMEventsImpl: MONITOR IMPORTS AMBridge, AMBridgeExtras, AMModelLocation, AMTypes, CedarSnapshot, ConvertUnsafe, FastBreak, Frame, Inline, Process, ProcessOperations, Rope, RTTypesBasic, TemporarySignals, WorldVM, WorldVMExtra, XferTrap EXPORTS AMEventBooted, AMEvents, AMEventsExtra, AMEventsPrivate = BEGIN -- EventProc: TYPE = PROC[data: REF ANY, event: Event] RETURNS[outcome: Outcome]; -- -- Event: TYPE = REF EventRec; -- -- Eventuality: TYPE = { -- booted, break, call, signal, interrupt, addrFault, wrProtect, unknown }; -- -- EventRec: TYPE = RECORD[ -- world: World, -- process: RTBasic.TV, -- frame: RTBasic.TV, -- worry: BOOLEAN, -- detail: SELECT type: Eventuality FROM -- booted => NULL, -- break => [id: BreakID, clientData: REF ANY], -- call => [msg: Rope.ROPE], -- signal => [signal, args: RTBasic.TV ], -- interrupt => NULL, -- unknown => [why: Rope.ROPE], -- ENDCASE]; -- -- Outcome: TYPE = RECORD[ -- SELECT type: * FROM -- proceed => [result: RTBasic.TV], -- quit => NULL, -- retry => [frame, result: RTBasic.TV], -- returnFrom => [frame, result: RTBasic.TV], -- ENDCASE] _ [proceed[NIL]]; -- -- Stack: TYPE = RECORD[ SEQUENCE length: CARDINAL OF WORD ]; -- ******** Constants ******** -- swapInfoAddr: WorldVM.Address = LOOPHOLE[@PSB.PDA.available, WorldVM.Address]; -- This address is the root of the interface with PilotNub -- -- ******** Global Variables ******** -- actors: Actor _ NIL; -- the list of event watchers localActor: Actor _ NIL; clientChanged: CONDITION; -- notified when level, bootCount, running or runCount changes. -- oldCatcher: CatcherProc _ NIL; oldInterrupt: InterruptProc _ NIL; oldCallDebugger: CallDebuggerProc _ NIL; oldBreak: BreakProc _ NIL; supressUncaughtAborted: BOOL _ TRUE; informing: BOOL _ TRUE; -- whether to raise the informational signals wsls: BOOL _ TRUE; breaks: LIST OF REF BreakRec _ NIL; bootedNotifierRegistry: BootedNotifierRegistry _ NIL; -- ******** ERRORS and SIGNALS ******** -- -- PUBLIC Debugging: PUBLIC --INFORMATIONAL-- SIGNAL = CODE; Debugged: PUBLIC --INFORMATIONAL-- SIGNAL = CODE; BadControlLink: PUBLIC ERROR = CODE; BadArgType: PUBLIC ERROR = CODE; BadResStack: PUBLIC ERROR = CODE; Booted: PUBLIC ERROR = CODE; -- Private to this module KillThisTurkey: ERROR = CODE; NotImplemented: ERROR = CODE; DuplicateBreakpoint: ERROR = CODE; BreakNotFound: ERROR = CODE; -- ******** TYPES ******** -- World: TYPE = WorldVM.World; TV: TYPE = AMTypes.TV; Operation: TYPE = { screen, kill, activate, boot, proceed, quit }; -- what to do to client beforereading his state -- CatcherProc: TYPE = PROC[msg, signal: UNSPECIFIED, frame: PrincOps.FrameHandle]; InterruptProc: TYPE = PROC; CallDebuggerProc: TYPE = PROC[s: STRING]; BreakProc: TYPE = PROC; BreakID: TYPE = REF BreakRec; -- There may be multiple BreakRec's for a single breakpoint; the first is used as the ID. -- BreakRec: PUBLIC TYPE = RECORD[ id: BreakID _ NIL, world: WorldVM.World, addr: WorldVM.Address, pc: PrincOps.BytePC, oldByte: Mopcodes.op, flushed: BOOL _ FALSE, -- world has booted since break was set -- clientData: REF ANY]; -- Management of event watchers ("Actor") for each world Actor: TYPE = REF ActorObject; ActorObject: TYPE = RECORD[ next: Actor, world: World, data: REF ANY, -- data to be passed back to the event proc -- proc: AMEvents.EventProc, -- event notification handler users: INT _ 1, -- reference count on GetEvents/StopEvents -- the remainder is only for world-swap and teledebug clients -- running: BOOL _ TRUE, -- client is running -- listener: PROCESS _ NIL, -- if not NIL, the process looking at the client -- bootCount: INT _ 0, -- incremented when a client session ends -- level: CARDINAL _ 0, -- nesting level of client procedure calls -- -- the remainder is data for interfacing with client -- swapInfo: CPSwapDefs.SwapInfo _ NULL, esvAddr: WorldVM.Address _ 0, esv: CPSwapDefs.ExternalStateVector _ NULL, paramAddr: WorldVM.Address _ 0, param: CPSwapDefs.DebugParameter _ NULL, stateAddr: WorldVM.Address _ 0, state: PrincOps.StateVector _ NULL, bootee: Booting.Bootee _ NULL, -- to avoid a long arg record in FORK in GetOutcome! -- switches: Booting.Switches _ NULL ]; BootedNotifierRegistry: TYPE = LIST OF BNRec; BNRec: TYPE = RECORD[proc: AMEventBooted.BootedNotifier, world: WorldVM.World, clientData: REF]; -- Locking for fields in an ActorObject: -- Immutable: a.world, a.data, a.proc. -- Inside monitor: a.next, a.users, a.running, a.listener, a.bootCount -- By claiming "running": a.swapInfo, a.esvAddr, a.esv, a.paramAddr, a.param, a.stateAddr, a.state -- "a.level" is altered with the monitor and a.running claimed, so it may be read either inside the monitor or by claiming a.running. -- There are three sources of synchronisation problems: -- ensuring that only one process transfers control to the client at a time, -- the client booting, -- someone calling "StopEvents". -- The a.running field provides mutual exclusion on transferring to the client. -- The a.bootCount field indicates when the client has booted. This is notified to the public by an event of type "booted". -- Having a.users=0 indicates a desire to disconnect from the client. This is notified by an event of type "booted" and by aborting a.listener. -- Note that we never access the client with our monitor locked: local events require access to our monitor, but access to a remote client involves unbounded delays. GetEvents: PUBLIC ENTRY PROC[world: World, data: REF ANY, proc: AMEvents.EventProc] = BEGIN ENABLE UNWIND => NULL; IF proc = NIL THEN IF localActor = NIL OR data # NIL THEN ERROR ELSE {proc _ localActor.proc; data _ localActor.data}; FOR a: Actor _ actors, a.next UNTIL a = NIL DO IF a.world = world THEN {a.users _ a.users+1; a.data _ data; a.proc _ proc; EXIT}; REPEAT FINISHED => -- here to make a new actor BEGIN new: Actor = NEW[ActorObject _ [actors, world, data, proc]]; actors _ new; IF world = WorldVM.LocalWorld[] THEN { localActor _ new; GrabLocalEvents[] } ELSE Process.Detach[new.listener _ FORK LookAtClient[new, TRUE]]; END ENDLOOP; END; StopEvents: PUBLIC PROC[world: World] = BEGIN a: Actor = EntryStop[world]; IF a # NIL THEN [] _ InvokeEvent[a, NEW[AMEvents.EventRec _ [a.world,NIL,NIL,FALSE,booted[]]]]; END; EntryStop: ENTRY PROC[world: World] RETURNS[a: Actor] = BEGIN prev: Actor _ NIL; FOR a _ actors, a.next UNTIL a = NIL DO IF a.world = world THEN BEGIN a.users _ a.users-1; IF a.users = 0 THEN BEGIN IF a = actors THEN actors _ actors.next ELSE prev.next _ a.next; IF a.listener # NIL THEN { Process.Abort[a.listener]; a.listener _ NIL }; a.bootCount _ a.bootCount + 1; BROADCAST clientChanged; IF world = WorldVM.LocalWorld[] THEN { localActor _ NIL; ReleaseLocalEvents[] }; END ELSE a _ NIL; EXIT END; prev _ a; ENDLOOP; END; InvokeEvent: PROC[a: Actor, event: AMEvents.Event] RETURNS[AMEvents.Outcome] = { IF event.type = booted THEN CallBootedNotifiers[event.world]; RETURN[ a.proc[a.data, event] ] }; ProvokeProcessEvent: PUBLIC PROC[ p: AMTypes.TV, frame: AMTypes.TV, msg: Rope.ROPE] RETURNS[outcome: AMEvents.Outcome] = BEGIN a: Actor _ NIL; Find: ENTRY PROC = BEGIN FOR a _ actors, a.next UNTIL a = NIL DO IF a.world = event.world THEN EXIT ENDLOOP; END; event: AMEvents.Event = NEW[AMEvents.EventRec _ [,,,FALSE,call[msg]] ]; event.frame _ frame; event.world _ AMBridge.GetWorld[p]; event.process _ p; Find[]; RETURN[IF a # NIL THEN InvokeEvent[a, event] ELSE [proceed[NIL]] ] END; -- ******** Events for non-local worlds ******** -- Call: PROC[world: WorldVM.World, which: Operation, state: PrincOps.SVPointer] RETURNS[ok: BOOL] = BEGIN a: Actor _ NIL; Find: ENTRY PROC = BEGIN FOR a _ actors, a.next UNTIL a = NIL DO IF a.world = world THEN EXIT ENDLOOP; END; Find[]; IF a = NIL THEN RETURN[FALSE]; GetOutcome[a, which, state, ,]; RETURN[TRUE] END; Boot: PUBLIC SAFE PROC[boot: Booting.Bootee, switches: Booting.Switches _ Booting.defaultSwitches] = TRUSTED BEGIN state: PrincOps.StateVector; a: Actor _ NIL; Find: ENTRY PROC = BEGIN FOR a _ actors, a.next UNTIL a = NIL DO IF Rope.Equal[WorldVM.WorldName[a.world], "Outload", FALSE] THEN EXIT ENDLOOP; END; Find[]; IF a = NIL THEN WorldVMExtra.SwapAndBoot[boot, switches] ELSE GetOutcome[a, boot, @state, boot, switches ! Booted => CONTINUE]; END; GetOutcome: ENTRY PROC[a: Actor, which: Operation[screen..boot], state: PrincOps.SVPointer -- only for which = activate --, who: Booting.Bootee, switches: Booting.Switches -- only for which = boot --] = BEGIN -- Perform call (or UserScreen, or Kill) and get result. ENABLE UNWIND => NULL; level: CARDINAL; bootCount: INT; DO IF a.running THEN { WAIT clientChanged; LOOP }; IF a.users = 0 THEN ERROR Booted[]; -- read as "ERROR EndSession[]" -- level _ a.level; bootCount _ a.bootCount; -- unique ID of this call -- a.esv.level _ a.level _ a.level + 1; EXIT ENDLOOP; a.running _ TRUE; SELECT which FROM activate => a.param.sv _ state^; boot => { a.bootee _ who; a.switches _ switches }; ENDCASE => NULL; Process.Detach[a.listener _ FORK RunClient[a, which]]; UNTIL a.level = level DO IF a.bootCount # bootCount THEN ERROR Booted[]; WAIT clientChanged; ENDLOOP; IF which = activate THEN state^ _ a.param.sv; a.running _ FALSE; BROADCAST clientChanged; END; RemoteEvent: PROC[a: Actor, level: CARDINAL, bootCount: INT, event: AMEvents.Event] = BEGIN IF event.type = booted THEN BEGIN Start: ENTRY PROC RETURNS[ok: BOOL] = { IF (ok _ a.users#0) THEN { a.listener _ Process.GetCurrent[]; a.level _ 0 } }; Stop: ENTRY PROC = { a.listener _ NIL }; [] _ InvokeEvent[a, event]; -- with "a.running" still locked -- IF Start[] THEN LookAtClient[a, TRUE ! ABORTED => { Stop[]; CONTINUE }; UNWIND => Stop[] ]; END ELSE BEGIN outcome: AMEvents.Outcome; Unlock: ENTRY PROC = BEGIN a.running _ FALSE; BROADCAST clientChanged; END; Lock: ENTRY PROC RETURNS[BOOL] = BEGIN ENABLE UNWIND => NULL; DO IF a.running THEN { WAIT clientChanged; LOOP }; IF a.bootCount # bootCount THEN RETURN[FALSE]; IF a.level # level THEN { WAIT clientChanged; LOOP }; EXIT ENDLOOP; a.running _ TRUE; a.listener _ Process.GetCurrent[]; RETURN[TRUE] END; Unlock[]; outcome _ InvokeEvent[a, event]; IF Lock[] THEN WITH o: outcome SELECT FROM proceed => RunClient[a, proceed]; quit => RunClient[a, quit]; ENDCASE => ERROR NotImplemented[]; END; END; -- "a.running" is a global exclusive lock. It must be claimed before transferring control to the client. It is released by "RemoteEvent" or "GetOutcome". -- "a.bootCount" is incremented when client boots, to indicate failure of outstanding calls, and to intercept resumption from outstanding events. -- "a.level" and "esv.level" are used to detect the client booting (when they're unequal). -- a.level is incremented when making a call, to allow detection of which "return" corresponds to this call. -- TEMP: PilotNub believes that calls are nested. PilotNub doesn't alter esv.level, so we can't match up a return with the appropriate call correctly. Instead, we increment a.level (and esv.level) before making a call, and inside "RunClient" we decrement them when we notice a return. Thus, outside of "RunClient", we can pretend that a.level (and esv.level) are a unique ID for a call. This kludge can be removed someday be changing PilotNub's handling of calls/returns. Note that there are cases where this kludge doesn't give the right answer; hard luck. RunClient: PROC[a: Actor, which: Operation] = BEGIN -- "RunClient" transfers control to client, waits (implicitly, inside WVM) until client invokes us, then looks to see why. If client has booted, notifies "booted" event; if client returns from a call (not necessarily one we invoked), notifies presence of the result; if client has a new event, calls "RemoteEvent" to notify the event. Unlock: ENTRY PROC = BEGIN a.running _ FALSE; a.listener _ NIL; BROADCAST clientChanged; END; IF NOT a.running THEN ERROR; BEGIN ENABLE BEGIN ABORTED => { Unlock[]; CONTINUE }; UNWIND => Unlock[]; END; SELECT which FROM proceed, quit => BEGIN a.esv.reason _ IF which = proceed THEN proceed ELSE quit; WorldVM.CopyWrite[a.world, @a.esv, SIZE[CPSwapDefs.ExternalStateVector], a.esvAddr]; IF a.stateAddr # 0 THEN WorldVM.CopyWrite[a.world, @a.state, SIZE[PrincOps.StateVector], a.stateAddr]; WorldVM.Go[a.world]; END; screen, kill, activate => BEGIN SELECT which FROM screen => a.esv.reason _ showscreen; kill => a.esv.reason _ kill; activate => BEGIN a.esv.reason _ call; IF a.paramAddr # 0 THEN WorldVM.CopyWrite[a.world, @a.param, SIZE[CPSwapDefs.DebugParameter], a.paramAddr]; END; ENDCASE => ERROR; WorldVM.CopyWrite[a.world, @a.esv, SIZE[CPSwapDefs.ExternalStateVector], a.esvAddr]; WorldVM.Go[a.world]; END; boot => WorldVMExtra.SwapAndBoot[a.bootee, a.switches]; ENDCASE => ERROR; LookAtClient[a, FALSE]; END; -- ENABLE UNWIND -- END; -- RunClient -- LookAtClient: PROC[a: Actor, init: BOOL] = BEGIN NotifyHappening: ENTRY PROC[event: AMEvents.Event] = BEGIN -- Notify return from some call, or some event -- IF event = NIL THEN a.level _ a.esv.level _ a.level - 1 ELSE BEGIN IF event.type = booted THEN a.bootCount _ a.bootCount+1; Process.Detach[FORK RemoteEvent[a, a.level, a.bootCount, event ] ]; END; a.listener _ NIL; BROADCAST clientChanged; END; IF NOT a.running THEN ERROR; -- someone should still have the lock! -- WorldVM.CopyRead[a.world, swapInfoAddr, SIZE[CPSwapDefs.SwapInfo], @a.swapInfo]; a.esvAddr _ LOOPHOLE[a.swapInfo.externalStateVector, WorldVM.Address]; WorldVM.CopyRead[a.world, a.esvAddr, SIZE[CPSwapDefs.ExternalStateVector], @a.esv]; a.paramAddr _ WorldVM.Long[a.world, LOOPHOLE[a.esv.parameter, WorldVM.ShortAddress]]; IF a.paramAddr # 0 THEN WorldVM.CopyRead[a.world, a.paramAddr, SIZE[CPSwapDefs.DebugParameter], @a.param]; a.stateAddr _ WorldVM.Long[a.world, LOOPHOLE[a.esv.state, WorldVM.ShortAddress]]; IF a.stateAddr # 0 THEN WorldVM.CopyRead[a.world, a.stateAddr, SIZE[PrincOps.StateVector], @a.state]; IF init THEN a.esv.level _ a.level; SELECT TRUE FROM a.level # a.esv.level => BEGIN -- client has booted: report as an event (but not first time: think of as "endSession"). FlushBreaks[a.world]; NotifyHappening[ NEW[AMEvents.EventRec _ [a.world,NIL,NIL,FALSE,booted[]]] ]; END; a.esv.reason = return AND a.level > 0-- return at level 0 is illegal -- => BEGIN -- client is returning from a call -- NotifyHappening[NIL]; END; ENDCASE => BEGIN -- client is invoking us, or is hopelessly confused -- event: AMEvents.Event _ NIL; SELECT a.esv.reason FROM breakpoint, worrybreak => IF a.stateAddr = 0 THEN event _ UnknownEvent["No state for breakpoint"] ELSE BEGIN break: BreakID _ BreakEvent[a.world, @a.state, a.esv.reason=worrybreak]; IF break = NIL THEN event _ UnknownEvent["Unknown breakpoint"] ELSE event _ NEW[AMEvents.EventRec _ [,,,a.esv.reason=worrybreak,break[break.id, break.clientData]] ]; END; explicitcall, worrycall => BEGIN event _ IF a.stateAddr = 0 OR a.state.stkptr = 0 THEN UnknownEvent["No argument for call debugger"] ELSE NEW[AMEvents.EventRec _ [,,,a.esv.reason=worrycall,call[ RopeFromRemote[a.world, WorldVM.Long[a.world, a.state.stk[0]]]]]]; a.state.stkptr _ 0; END; uncaughtsignal => event _ SignalEvent[a.world, a.state.stk[1], a.state.stk[0]]; interrupt => event _ NEW[AMEvents.EventRec _ [,,,FALSE,interrupt[]]]; ENDCASE => event _ UnknownEvent["Unknown entry reason"]; IF a.stateAddr = 0 THEN event.frame _ NIL ELSE event.frame _ AMBridge.TVForRemoteFrame[ [world: a.world, worldIncarnation: WorldVM.CurrentIncarnation[a.world], fh: LOOPHOLE[a.state.dest, WorldVM.ShortAddress]], StackFromState[@a.state], a.state.instbyte = Mopcodes.zRET, event.type = break ]; event.world _ a.world; event.process _ PSBIToTV[a.esv.psb, a.world]; NotifyHappening[event]; END; END; -- LookAtClient -- RopeFromRemote: PROC[world: WorldVM.World, addr: WorldVM.Address] RETURNS[ Rope.ROPE ] = -- addr is remote address of a string (or 0) -- BEGIN temp: STRING = [0]; s: STRING = [128]; -- restrict the length to protect ourselves -- min: CARDINAL = SIZE[StringBody[0]]; IF addr = 0 THEN RETURN[NIL]; WorldVM.CopyRead[world: world, from: addr, to: temp, nwords: min]; s.length _ MIN[temp.length, s.maxlength]; WorldVM.CopyRead[world: world, from: addr+min, to: s+min, nwords: SIZE[StringBody[s.length]]-min]; RETURN[ConvertUnsafe.ToRope[s]] END; -- ******** Local events ******** -- GrabLocalEvents: INTERNAL PROC = BEGIN OPEN SDDefs; oldCatcher _ SD[sUncaughtSignal]; IF wsls THEN SD[sUncaughtSignal] _ MyCatcher; oldInterrupt _ SD[sInterrupt]; -- SD[sInterrupt] _ MyInterrupt; oldCallDebugger _ SD[sCallDebugger]; -- SD[sCallDebugger] _ MyCallDebugger; oldBreak _ SD[sBreak]; FastBreak.SpecifyDefaultBreakHandler[MyBreak]; -- RRA: first go through fast break handler SD[sBreak] _ FastBreak.FastBreakHandler; END; ReleaseLocalEvents: INTERNAL PROC = BEGIN OPEN SDDefs; SD[sUncaughtSignal] _ oldCatcher; SD[sInterrupt] _ oldInterrupt; SD[sCallDebugger] _ oldCallDebugger; FastBreak.SpecifyDefaultBreakHandler[oldBreak]; -- RRA: this may cause problems, but they ae no worse than for regular breakpoints that the old handler does not understand. I believe that this procedure is completely useless. SD[sBreak] _ oldBreak; END; WorldSwapLocalSignals: PUBLIC ENTRY PROC[yes: BOOL] = BEGIN OPEN SDDefs; wsls _ yes; IF localActor # NIL THEN BEGIN IF wsls THEN SD[sUncaughtSignal] _ MyCatcher ELSE SD[sCallDebugger] _ oldCallDebugger; END; END; MyCatcher: CatcherProc = BEGIN signaller: PrincOps.GlobalFrameHandle; f: PrincOps.FrameHandle _ Frame.GetReturnFrame[]; signaller _ f.accesslink; -- The call stack below here is: Signaller, [Signaller,] offender f _ LOOPHOLE[f.returnlink, PrincOps.FrameHandle]; IF f.accesslink = signaller THEN f _ LOOPHOLE[f.returnlink, PrincOps.FrameHandle]; IF supressUncaughtAborted AND signal = ABORTED THEN { TurkeyCatcher[frame]; ERROR KillThisTurkey }; LocalEvent[SignalEvent[WorldVM.LocalWorld[], signal, msg], f, NIL]; END; TurkeyCatcher: PROC [root: PrincOps.FrameHandle] = BEGIN endProcess: PrincOps.ControlLink = root.returnlink; Caller: PROC = LOOPHOLE[Frame.GetReturnLink[]]; root.returnlink _ [frame[Frame.MyLocalFrame[]]]; Frame.SetReturnFrame[PrincOps.NullFrame]; Caller[ ! KillThisTurkey => CONTINUE]; Frame.SetReturnLink[endProcess]; END; MyInterrupt: InterruptProc = BEGIN LocalEvent[NEW[AMEvents.EventRec _ [,,,,interrupt[]] ], Frame.GetReturnFrame[], NIL]; END; MyCallDebugger: CallDebuggerProc = BEGIN LocalEvent[NEW[AMEvents.EventRec _ [,,,,call[ConvertUnsafe.ToRope[s]]] ], Frame.GetReturnFrame[], NIL]; END; MyBreak: BreakProc = BEGIN state: RECORD[ padding: LONG CARDINAL, v: PrincOps.StateVector]; event: AMEvents.Event; break: BreakID; state.v _ STATE; state.v.dest _ Frame.GetReturnLink[]; break _ BreakEvent[WorldVM.LocalWorld[], @state.v, FALSE]; IF break = NIL THEN BEGIN localFrame: PrincOps.FrameHandle = state.v.dest.frame; globalFrame: PrincOps.GlobalFrameHandle = localFrame.accesslink; codeBase: LONG POINTER = globalFrame.code.longbase; instAddr: LONG POINTER TO PrincOps.InstWord = codeBase + localFrame.pc / 2; inst: Mopcodes.op = IF localFrame.pc MOD 2 = 0 THEN instAddr.evenbyte ELSE instAddr.oddbyte; IF inst = Mopcodes.zBRK THEN -- breakpoint must have been set by world-swap debugger - BEGIN state.v.dest _ LOOPHOLE[oldBreak]; state.v.source _ LOOPHOLE[Frame.GetReturnLink[]]; RETURN WITH state.v END; END ELSE LocalEvent[event _ NEW[AMEvents.EventRec _ [,,,FALSE,break[break.id, break.clientData]] ], Frame.GetReturnFrame[], @state.v, state.v.instbyte = Mopcodes.zRET]; state.v.dest _ Frame.GetReturnLink[]; state.v.source _ PrincOps.NullLink; IF XferTrap.ReadXTS[] = on THEN XferTrap.WriteXTS[skip1]; RETURN WITH state.v; END; CallDebugger: PUBLIC PROC[msg: Rope.ROPE] = BEGIN IF localActor # NIL THEN LocalEvent[NEW[AMEvents.EventRec _ [,,,,call[msg]] ], Frame.GetReturnFrame[], NIL] ELSE (LOOPHOLE[SDDefs.SD[SDDefs.sCallDebugger], CallDebuggerProc])["Call debugger"L]; END; LocalEvent: PROC[event: AMEvents.Event, f: PrincOps.FrameHandle, stack: POINTER TO PrincOps.StateVector, return: BOOL _ FALSE] = BEGIN outcome: AMEvents.Outcome; event.world _ localActor.world; event.process _ PSBIToTV[ProcessOperations.HandleToIndex[ProcessOperations.ReadPSB[]], localActor.world]; event.frame _ AMBridge.TVForFrame[f, stack, return, event.type = break]; event.worry _ FALSE; IF informing THEN TemporarySignals.InformationalSignal[Debugging]; outcome _ InvokeEvent[localActor, event]; IF informing THEN TemporarySignals.InformationalSignal[Debugged]; WITH o: outcome SELECT FROM proceed => NULL; quit => ERROR ABORTED -- I don't like it, but that's the convention for now --; retry, returnFrom => ERROR NotImplemented[]; ENDCASE => ERROR; END; UnknownEvent: PROC [msg: Rope.ROPE] RETURNS [event: AMEvents.Event] = {event _ NEW[AMEvents.EventRec _ [,,,TRUE,unknown[msg]]]}; Checkpoint: ENTRY CedarSnapshot.CheckpointProc = { IF localActor # NIL THEN ReleaseLocalEvents[] }; Rollback: ENTRY CedarSnapshot.RollbackProc = { IF localActor # NIL THEN GrabLocalEvents[] }; -- ******** Subroutines for both local and non-local worlds ******** -- StackFromState: PROC[state: LONG POINTER TO PrincOps.StateVector] RETURNS[stack: AMBridge.WordSequence] = BEGIN stack _ NEW[AMBridge.WordSequenceRecord[state.stkptr]]; FOR i: INT IN [0..stack.size) DO stack[i] _ state.stk[i] ENDLOOP; END; SignalEvent: PROC[world: World, signal, msg: UNSPECIFIED] RETURNS[AMEvents.Event] = BEGIN local: BOOLEAN = (world = WorldVM.LocalWorld[]); sigTV: AMTypes.TV; argType: AMTypes.Type; arg: AMTypes.TV; BEGIN ENABLE AMTypes.Error => GOTO cant; sigTV _ IF local THEN AMBridge.TVForSignal[LOOPHOLE[signal, ERROR ANY RETURNS ANY]] ELSE AMBridge.TVForRemoteSignal[ [world: world, worldIncarnation: WorldVM.CurrentIncarnation[world], sed: signal] ]; argType _ AMTypes.Domain[AMTypes.TVType[sigTV]]; IF argType = RTTypesBasic.nullType THEN arg _ NIL ELSE IF AMTypes.Size[argType] = 1 THEN { arg _ AMTypes.New[argType, mutable, world]; AMBridge.SetTVFromLC[arg, LOOPHOLE[msg, CARDINAL]] } ELSE arg _ TVForPointer[world, LOOPHOLE[msg, WorldVM.ShortAddress], argType]; EXITS cant => BEGIN sigTV _ AMBridge.TVForReferent[NEW[CARDINAL _ LOOPHOLE[signal, CARDINAL]]]; arg _ AMBridge.TVForReferent[NEW[CARDINAL _ LOOPHOLE[msg, CARDINAL]]]; END; END; RETURN[ NEW[AMEvents.EventRec _ [,,,FALSE,signal[sigTV, arg]] ] ] END; TVForPointer: PROC[world: WorldVM.World, ptr: WorldVM.ShortAddress, type: AMTypes.Type] RETURNS[ tv: AMTypes.TV ] = BEGIN IF world = WorldVM.LocalWorld[] THEN tv _ AMBridge.TVForPointerReferent[LOOPHOLE[ptr, POINTER], type] ELSE tv _ AMBridge.TVForRemotePointerReferent[ [world: world, worldIncarnation: WorldVM.CurrentIncarnation[world], ptr: WorldVM.Long[world, ptr]], type]; END; PSBIToTV: PROC[psbi: CARDINAL, world: WorldVM.World] RETURNS[p: AMTypes.TV] = BEGIN ENABLE AMTypes.Error => { p _ NIL; CONTINUE }; p _ AMTypes.New[CODE[PROCESS], mutable, world]; AMBridge.SetTVFromLC[p, psbi]; END; -- ******** Breakpoints ******** -- BreakAt: PUBLIC PROC[world: WorldVM.World, section: AMModel.Section, clientData: REF ANY] RETURNS[id: BreakID] = { id _ BreakIt[TRUE, world, section, clientData] }; BreakAfter: PUBLIC PROC[world: WorldVM.World, section: AMModel.Section, clientData: REF ANY] RETURNS[id: BreakID] = { id _ BreakIt[FALSE, world, section, clientData] }; BreakIt: PROC[at: BOOL, world: WorldVM.World, section: AMModel.Section, clientData: REF ANY] RETURNS[id: BreakID] = BEGIN list: LIST OF AMModelLocation.CodeLocation; secWorld: WorldVM.World; [secWorld, list] _ IF at THEN AMModelLocation.EntryLocations[section] ELSE AMModelLocation.ExitLocations[section]; id _ NIL; FOR loc: LIST OF AMModelLocation.CodeLocation _ list, list.rest UNTIL loc = NIL DO loc.first.codeBase.out _ FALSE; id _ RealSetBreak[id, world, LOOPHOLE[loc.first.codeBase.longbase], loc.first.pc, clientData]; ENDLOOP; END; FrameBreak: PUBLIC PROC[gf: AMTypes.TV, pc: CARDINAL, clientData: REF ANY] RETURNS[id: BreakID] = BEGIN gfAddr: WorldVM.ShortAddress = AMBridge.TVToCardinal[gf]; world: WorldVM.World = AMBridge.GetWorld[gf]; gfHead: PrincOps.GlobalFrame; WorldVM.CopyRead[world: world, from: WorldVM.Long[world, gfAddr], to: @gfHead, nwords: SIZE[PrincOps.GlobalFrame]]; gfHead.code.out _ FALSE; id _ SetBreak[world, LOOPHOLE[gfHead.code.longbase], pc, clientData]; END; SetBreak: PUBLIC PROC[world: WorldVM.World, addr: WorldVM.Address, pc: CARDINAL, clientData: REF ANY] RETURNS[id: BreakID] = { id _ RealSetBreak[NIL, world, addr, pc, clientData] }; RealSetBreak: ENTRY PROC[id: BreakID, world: WorldVM.World, addr: WorldVM.Address, pc: CARDINAL, clientData: REF ANY] RETURNS[newID: BreakID] = BEGIN new: REF BreakRec = NEW[BreakRec _ [world: world, addr: addr, pc: [pc], oldByte: , clientData: clientData]]; new.id _ newID _ IF id = NIL THEN new ELSE id; FOR b: LIST OF REF BreakRec _ breaks, b.rest UNTIL b = NIL DO x: BreakID = b.first; IF x.world = world AND x.addr = addr AND x.pc = pc THEN RETURN WITH ERROR DuplicateBreakpoint[]; ENDLOOP; breaks _ CONS[first: new, rest: breaks]; new.oldByte _ WorldVM.SetBreak[world, addr, [pc]]; -- JTM: don't set break until allocations are done! -- END; ClearBreak: PUBLIC ENTRY PROC[id: BreakID] = BEGIN prev: LIST OF REF BreakRec _ NIL; FOR b: LIST OF REF BreakRec _ breaks, b.rest UNTIL b = NIL DO IF b.first.id = id THEN BEGIN IF b = breaks THEN breaks _ b.rest ELSE prev.rest _ b.rest; IF NOT b.first.flushed THEN WorldVM.ClearBreak[b.first.world, b.first.addr, b.first.pc, b.first.oldByte]; b.first.id _ NIL; -- break circular structure -- EXIT END ELSE prev _ b; REPEAT FINISHED => RETURN WITH ERROR BreakNotFound[] ENDLOOP; END; FlushBreaks: ENTRY PROC[world: World] = BEGIN FOR b: LIST OF REF BreakRec _ breaks, b.rest UNTIL b = NIL DO IF b.first.world = world THEN b.first.flushed _ TRUE ENDLOOP; END; BreakEvent: PROC[world: World, state: LONG POINTER TO PrincOps.StateVector, worry: BOOL] RETURNS[break: BreakID] = BEGIN -- JTM: changed BreakEvent to return a BreakID rather than an Event localFrame: PrincOps.Frame; globalFrame: PrincOps.GlobalFrame; word: WorldVM.Address; byte: [0..1]; FindBreak: ENTRY PROC RETURNS[BreakID] = BEGIN FOR b: LIST OF REF BreakRec _ breaks, b.rest UNTIL b = NIL DO x: REF BreakRec = b.first; IF x.world = world AND x.addr + x.pc/2 = word AND x.pc MOD 2 = byte AND NOT x.flushed THEN BEGIN state.instbyte _ x.oldByte; RETURN[ b.first ] END; ENDLOOP; -- If we get here, we've hit a break point not recorded in our list -- -- This is either a world-swap breakpoint, or a race where we cleared the break point after the -- process hit it. If it's the race, we can fix it by retrying the instruction. We can distinguish -- the cases by looking at the code byte (see the local breakpoint handler). -- state.instbyte _ 0; RETURN[NIL] END; WorldVM.CopyRead[world: world, from: WorldVM.Long[world, LOOPHOLE[state.dest.frame, WorldVM.ShortAddress]], to: @localFrame, nwords: SIZE[PrincOps.Frame] ]; WorldVM.CopyRead[world: world, from: WorldVM.Long[world, LOOPHOLE[localFrame.accesslink, WorldVM.ShortAddress]], to: @globalFrame, nwords: SIZE[PrincOps.GlobalFrame] ]; word _ LOOPHOLE[globalFrame.code.longbase, WorldVM.Address] + localFrame.pc / 2; byte _ localFrame.pc MOD 2; RETURN[FindBreak[]]; END; -- ******** Invoking procedures in client worlds ******** -- Apply: PUBLIC PROC[control, args: AMTypes.TV] RETURNS[result: AMTypes.TV] = BEGIN world: WorldVM.World = AMBridge.GetWorld[control]; local: BOOL = world = WorldVM.LocalWorld[]; controlType: AMTypes.Type = AMTypes.TVType[control]; class: AMTypes.Class _ AMTypes.UnderClass[controlType]; argType: AMTypes.Type; argBits: AMBridge.WordSequence; resType: AMTypes.Type; resSize: CARDINAL; state: PrincOps.StateVector; SELECT class FROM procedure, signal, globalFrame => NULL; error => class _ signal; ENDCASE => ERROR BadControlLink[]; state.dest _ LOOPHOLE[AMBridge.TVToCardinal[control]]; state.source _ LOOPHOLE[Frame.MyLocalFrame[]]; argType _ AMTypes.Domain[controlType]; IF (argType = RTTypesBasic.nullType AND args # NIL) OR NOT RTTypesBasic.EquivalentTypes[argType, AMTypes.TVType[args]] OR (argType # RTTypesBasic.nullType AND world # AMBridge.GetWorld[args]) THEN ERROR BadArgType[]; argBits _ IF argType = RTTypesBasic.nullType THEN NEW[AMBridge.WordSequenceRecord[0]] ELSE AMBridge.TVToWordSequence[args]; IF argBits.size > PrincOps.MaxParamsInStack OR (class = signal AND argBits.size > 1) THEN BEGIN -- long argument record -- IF NOT local THEN ERROR BadArgType[]; FOR i: PrincOps.FrameSizeIndex IN PrincOps.FrameSizeIndex DO IF argBits.size <= PrincOps.FrameVec[i] THEN { state.stk[0] _ Frame.Alloc[i]; EXIT } REPEAT FINISHED => ERROR--args too big for any frame!-- ENDLOOP; state.stkptr _ 1; IF argBits.size # 0 -- otherwise we'd get a bounds trap -- THEN Inline.LongCOPY[from: @argBits[0], to: LOOPHOLE[state.stk[0],POINTER], nwords: argBits.size]; END ELSE BEGIN -- short argument record -- IF argBits.size # 0 -- otherwise we'd get a bounds trap -- THEN Inline.LongCOPY[from: @argBits[0], to: @state.stk, nwords: argBits.size]; state.stkptr _ argBits.size; END; IF class = signal THEN BEGIN -- really, call the signal handler through SD -- -- SignalHandler: PROC[signal: SIGNAL, message: UNSPECIFIED] IF NOT local THEN ERROR BadControlLink[]; state.stk[1] _ state.stk[0]; -- message -- state.stk[0] _ state.dest; -- signal -- state.stkptr _ 2; state.dest _ SDDefs.SD[IF argBits.size > 1 THEN SDDefs.sSignalList ELSE SDDefs.sSignal]; END; state.instbyte _ 0; IF local THEN { TRANSFER WITH state; state _ STATE } ELSE IF NOT Call[world, activate, @state] THEN ERROR--we aren't debugging that world--; resType _ AMTypes.Range[controlType]; IF resType = RTTypesBasic.nullType THEN BEGIN IF state.stkptr # 0 THEN ERROR BadResStack[]; result _ NIL END ELSE BEGIN resSize _ AMTypes.Size[resType]; result _ AMTypes.New[type: resType, world: world]; IF resSize > PrincOps.MaxParamsInStack THEN BEGIN -- long result record -- res: AMTypes.TV; IF state.stkptr # 1 THEN ERROR BadResStack[]; res _ TVForPointer[world, LOOPHOLE[state.stk[0],WorldVM.ShortAddress], resType]; AMTypes.Assign[lhs: result, rhs: res]; IF local THEN Frame.Free[LOOPHOLE[state.stk[0]]] ELSE NULL--TEMP?--; END ELSE BEGIN -- short result record -- IF state.stkptr # resSize THEN ERROR BadResStack[]; IF local THEN AMTypes.Assign[lhs: result, rhs: AMBridge.TVForPointerReferent[@state.stk, resType]] ELSE {ws: AMBridge.WordSequence _ NEW[AMBridge.WordSequenceRecord[resSize]]; Inline.LongCOPY[from: @state.stk, nwords: resSize, to: @ws[0]]; AMBridgeExtras.SetTVFromWordSequence[tv: result, ws: ws]}; END END; END; Kill: PUBLIC PROC[world: World] = BEGIN state: PrincOps.StateVector; IF world # WorldVM.LocalWorld[] THEN [] _ Call[world, kill, @state ! Booted => CONTINUE]; END; Screen: PUBLIC SAFE PROC[world: World] = TRUSTED BEGIN state: PrincOps.StateVector; IF world # WorldVM.LocalWorld[] THEN [] _ Call[world, screen, @state ! Booted => CONTINUE]; END; RegisterBootedNotifier: PUBLIC ENTRY SAFE PROC [proc: AMEventBooted.BootedNotifier, world: WorldVM.World _ NIL, clientData: REF _ NIL] = TRUSTED{ ENABLE UNWIND => NULL; bootedNotifierRegistry _ CONS[[proc, world, clientData], bootedNotifierRegistry]; }; UnRegisterBootedNotifier: PUBLIC ENTRY SAFE PROC [proc: AMEventBooted.BootedNotifier, world: WorldVM.World _ NIL, clientData: REF _ NIL] = TRUSTED{ ENABLE UNWIND => NULL; prev: BootedNotifierRegistry _ NIL; FOR this: BootedNotifierRegistry _ bootedNotifierRegistry, this.rest UNTIL this = NIL DO IF this.first.proc = proc AND (world = NIL OR world = this.first.world) AND (clientData = NIL OR clientData = this.first.clientData) THEN {IF prev = NIL THEN bootedNotifierRegistry _ this.rest ELSE prev.rest _ this.rest} ELSE prev _ this; ENDLOOP; }; CallBootedNotifiers: PROC[world: WorldVM.World] = { FOR bnr: BootedNotifierRegistry _ bootedNotifierRegistry, NextBootedNotifier[world, bnr] UNTIL bnr = NIL DO bnr.first.proc[world, bnr.first.clientData]; ENDLOOP; }; NextBootedNotifier: ENTRY PROC[world: WorldVM.World, bnr: BootedNotifierRegistry] RETURNS[next: BootedNotifierRegistry _ NIL--nomore--] = { ENABLE UNWIND => NULL; FOR this: BootedNotifierRegistry _ bnr.rest, this.rest UNTIL this = NIL DO IF this.first.world = NIL OR world = this.first.world THEN RETURN[this]; ENDLOOP; }; -- START HERE CedarSnapshot.Register[c: Checkpoint, r: Rollback]; END.