<> <> <> <> <> <> DIRECTORY AMBridge USING[ GetWorld, SetTVFromLC, SetTVFromWordSequence, TVForFrame, TVForPointerReferent, TVForReferent, TVForRemoteFrame, TVForRemotePointerReferent, TVForRemoteSignal, TVForSignal, TVToCardinal, TVToWordSequence, WordSequence, WordSequenceRecord ], AMEvents USING[ BootedNotifier, Event, EventProc, EventRec, Outcome ], AMEventsPrivate USING[ ], AMModel USING[ Section ], AMModelLocation USING[ CodeLocation, EntryLocations, ExitLocations ], AMTypes USING[ Assign, Class, Domain, Error, New, Range, Size, TV, TVType, Type, UnderClass ], Booting USING[ CheckpointProc, RegisterProcs, RollbackProc ], -- CedarSnapshot USING[ CheckpointProc, Register, RollbackProc ], ConvertUnsafe USING[ ToRope ], DebuggerFormat USING[ DebugParameter, ExternalStateVector, SwapInfo ], DebuggerSwap USING[ CallDebugger ], FastBreak USING[ FastBreakHandler, SpecifyDefaultBreakHandler ], -- RRA: new PrincOpsUtils USING[ Alloc, Free, GetReturnFrame, GetReturnLink, PsbHandleToIndex, LongCOPY, MyLocalFrame, ReadPSB, ReadXTS, SetReturnFrame, SetReturnLink, WriteXTS ], PrincOps USING[ BytePC, ControlLink, Frame, FrameHandle, FrameSizeIndex, FrameVec, GlobalFrame, GlobalFrameHandle, InstWord, MaxParamsInStack, NullFrame, NullLink, op, PDA, sBreak, SD, sSignal, sSignalList, StateVector, SVPointer, zBRK, zRET ], Process USING[ Abort, GetCurrent, Detach ], Rope USING[ Equal, ROPE ], RuntimeError USING[ InformationalSignal, RegisterUncaughtSignalHandler, UCSProc, UNCAUGHT ], SafeStorage USING[ EquivalentTypes, nullType ], WorldVM; AMEventsImpl: MONITOR IMPORTS AMBridge, AMModelLocation, AMTypes, --CedarSnapshot,-- Booting, ConvertUnsafe, DebuggerSwap, FastBreak, PrincOpsUtils, Process, Rope, SafeStorage, RuntimeError, WorldVM EXPORTS AMEvents, AMEventsPrivate = BEGIN <> <<>> <> <<>> <> <> <<>> <> <> <> <> <> <> <> < [id: BreakID, clientData: REF ANY],>> < [msg: Rope.ROPE],>> < [signal, args: RTBasic.TV ],>> < [why: Rope.ROPE],>> <> <<>> <> <> < [result: RTBasic.TV],>> < NULL,>> < [frame, result: RTBasic.TV],>> < [frame, result: RTBasic.TV],>> <> <<>> <> -- ******** Constants ******** -- swapInfoAddr: WorldVM.Address = LOOPHOLE[@PrincOps.PDA.available, WorldVM.Address]; -- This address is the root of the interface with PilotNub -- -- ******** Global Variables ******** -- actors: Actor _ NIL; -- the list of event watchers localActor: Actor _ NIL; clientChanged: CONDITION; -- notified when level, bootCount, running or runCount changes. -- oldCatcher: RuntimeError.UCSProc _ NIL; oldBreak: PROC _ NIL; supressUncaughtAborted: BOOL _ TRUE; informing: BOOL _ TRUE; -- whether to raise the informational signals wsls: BOOL _ TRUE; breaks: REF BreakRec _ NIL; bootedNotifierRegistry: BootedNotifierRegistry _ NIL; -- ******** ERRORS and SIGNALS ******** -- <<>> <> 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; <<>> <> KillThisTurkey: ERROR = CODE; NotImplemented: ERROR = CODE; BreakNotFound: ERROR = CODE; -- ******** TYPES ******** -- World: TYPE = WorldVM.World; TV: TYPE = AMTypes.TV; Operation: TYPE = { screen, kill, activate, boot, proceed, quit, init }; -- what to do to client before reading his state -- BreakID: TYPE = REF BreakRec; -- There may be multiple BreakRec's for a single breakpoint; the first is used as the ID. -- BreakRec: PUBLIC TYPE = RECORD[ rest: REF BreakRec _ NIL, id: BreakID _ NIL, world: WorldVM.World, addr: WorldVM.Address, pc: PrincOps.BytePC, oldByte: PrincOps.op, clientData: REF ANY]; <> Actor: TYPE = REF ActorObject; ActorObject: TYPE = RECORD[ next: Actor, world: World, data: REF ANY, -- data to be passed back to the event proc -- proc: AMEvents.EventProc, -- event notification handler users: INT _ 1, -- reference count on GetEvents/StopEvents -- the remainder is only for world-swap and teledebug clients -- running: BOOL _ TRUE, -- client is running -- listener: PROCESS _ NIL, -- if not NIL, the process looking at the client -- bootCount: INT _ 0, -- incremented when a client session ends -- level: CARDINAL _ 0, -- nesting level of client procedure calls -- -- the remainder is data for interfacing with client -- swapInfo: DebuggerFormat.SwapInfo _ NULL, esvAddr: WorldVM.Address _ 0, esv: DebuggerFormat.ExternalStateVector _ NULL, paramAddr: WorldVM.Address _ 0, param: DebuggerFormat.DebugParameter _ NULL, stateAddr: WorldVM.Address _ 0, state: PrincOps.StateVector _ NULL ]; BootedNotifierRegistry: TYPE = LIST OF BNRec; BNRec: TYPE = RECORD[proc: AMEvents.BootedNotifier, world: WorldVM.World, clientData: REF]; <> <> <> <> <<"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.>> <> <> <> <> <> GetEvents: PUBLIC ENTRY PROC[world: World, data: REF ANY, proc: AMEvents.EventProc] = BEGIN ENABLE UNWIND => NULL; IF proc = NIL THEN IF localActor = NIL OR data # NIL THEN ERROR ELSE {proc _ localActor.proc; data _ localActor.data}; FOR a: Actor _ actors, a.next UNTIL a = NIL DO IF a.world = world THEN {a.users _ a.users+1; a.data _ data; a.proc _ proc; EXIT}; REPEAT FINISHED => -- here to make a new actor BEGIN new: Actor = NEW[ActorObject _ [actors, world, data, proc]]; actors _ new; IF Rope.Equal[WorldVM.WorldName[world], "Outload", FALSE] THEN Booting.RegisterProcs[c: MyCheckpoint, r: MyRollback, clientData: new]; IF world = WorldVM.LocalWorld[] THEN { localActor _ new; GrabLocalEvents[] } ELSE Process.Detach[new.listener _ FORK LookAtClient[new, init]]; END ENDLOOP; END; StopEvents: PUBLIC PROC[world: World] = BEGIN a: Actor; oldSession: INT; [a, oldSession] _ EntryStop[world]; FlushBreaks[world]; IF a # NIL THEN CallBootedNotifiers[a.world, oldSession]; END; EntryStop: ENTRY PROC[world: World] RETURNS[a: Actor, oldSession: INT] = BEGIN ENABLE UNWIND => NULL; prev: Actor _ NIL; FOR a _ actors, a.next UNTIL a = NIL DO IF a.world = world THEN BEGIN a.users _ a.users-1; IF a.users = 0 THEN BEGIN IF a = actors THEN actors _ actors.next ELSE prev.next _ a.next; IF a.listener # NIL THEN { Process.Abort[a.listener]; a.listener _ NIL }; oldSession _ a.bootCount; a.bootCount _ a.bootCount + 1; BROADCAST clientChanged; IF world = WorldVM.LocalWorld[] THEN { localActor _ NIL; ReleaseLocalEvents[] }; END ELSE a _ NIL; EXIT END; prev _ a; ENDLOOP; END; InvokeEvent: PROC[a: Actor, event: AMEvents.Event] RETURNS[AMEvents.Outcome] = { RETURN[ a.proc[a.data, event] ] }; ProvokeProcessEvent: PUBLIC PROC[ p: AMTypes.TV, frame: AMTypes.TV, msg: Rope.ROPE] RETURNS[outcome: AMEvents.Outcome] = BEGIN a: Actor _ NIL; Find: ENTRY PROC = BEGIN ENABLE UNWIND => NULL; FOR a _ actors, a.next UNTIL a = NIL DO IF a.world = event.world THEN EXIT ENDLOOP; IF a # NIL THEN event.session _ a.bootCount; END; event: AMEvents.Event = NEW[AMEvents.EventRec _ [detail: call[msg]] ]; event.frame _ frame; event.world _ AMBridge.GetWorld[p]; event.process _ p; Find[]; RETURN[IF a # NIL THEN InvokeEvent[a, event] ELSE [proceed[NIL]] ] END; -- ******** Events for non-local worlds ******** -- Call: PROC[world: WorldVM.World, which: Operation, state: PrincOps.SVPointer] RETURNS[ok: BOOL] = BEGIN a: Actor _ NIL; Find: ENTRY PROC = BEGIN ENABLE UNWIND => NULL; FOR a _ actors, a.next UNTIL a = NIL DO IF a.world = world THEN EXIT ENDLOOP; END; Find[]; IF a = NIL THEN RETURN[FALSE]; GetOutcome[a, which, state]; RETURN[TRUE] END; MyCheckpoint: ENTRY Booting.CheckpointProc = TRUSTED BEGIN ENABLE UNWIND => NULL; a: Actor = NARROW[clientData]; END; MyRollback: ENTRY Booting.RollbackProc = TRUSTED BEGIN ENABLE UNWIND => NULL; a: Actor = NARROW[clientData]; IF NOT a.running AND a.users # 0 THEN BEGIN a.running _ TRUE; Process.Detach[a.listener _ FORK RunClient[a, boot]]; END; END; GetOutcome: ENTRY PROC[a: Actor, which: Operation[screen..activate], state: PrincOps.SVPointer -- only for which = activate --] = BEGIN <> ENABLE UNWIND => NULL; level: CARDINAL; bootCount: INT; DO IF a.running THEN { WAIT clientChanged; LOOP }; IF a.users = 0 THEN ERROR EndSession[]; level _ a.level; bootCount _ a.bootCount; -- unique ID of this call -- a.esv.level _ a.level _ a.level + 1; EXIT ENDLOOP; a.running _ TRUE; IF which = activate THEN a.param.sv _ state^; Process.Detach[a.listener _ FORK RunClient[a, which]]; UNTIL a.level = level DO IF a.bootCount # bootCount THEN ERROR EndSession[]; WAIT clientChanged; ENDLOOP; IF which = activate THEN state^ _ a.param.sv; a.running _ FALSE; BROADCAST clientChanged; END; RemoteEvent: PROC[a: Actor, level: CARDINAL, bootCount: INT, event: AMEvents.Event] = BEGIN outcome: AMEvents.Outcome; Unlock: ENTRY PROC = BEGIN ENABLE UNWIND => NULL; a.running _ FALSE; BROADCAST clientChanged; END; Lock: ENTRY PROC RETURNS[BOOL] = BEGIN ENABLE UNWIND => NULL; DO IF a.running THEN { WAIT clientChanged; LOOP }; IF a.bootCount # bootCount THEN RETURN[FALSE]; IF a.level # level THEN { WAIT clientChanged; LOOP }; EXIT ENDLOOP; a.running _ TRUE; a.listener _ Process.GetCurrent[]; RETURN[TRUE] END; Unlock[]; outcome _ InvokeEvent[a, event]; IF Lock[] THEN WITH o: outcome SELECT FROM proceed => RunClient[a, proceed]; quit => RunClient[a, quit]; ENDCASE => ERROR NotImplemented[]; END; <<"a.running" is a global exclusive lock. It must be claimed before transferring control to the client. It is released by "RemoteEvent" or "GetOutcome".>> <<"a.bootCount" is incremented when client boots, to indicate failure of outstanding calls, and to intercept resumption from outstanding events.>> <<"a.level" and "esv.level" are used to detect the client booting (when they're unequal).>> <> <> RunClient: PROC[a: Actor, which: Operation] = BEGIN <<"RunClient" transfers control to client, waits (implicitly, inside WVM) until client invokes us, then looks to see why. If client has booted, calls booted-notifiers; if client returns from a call (not necessarily one we invoked), notifies presence of the result; if client has a new event, calls "RemoteEvent" to notify the event.>> Unlock: ENTRY PROC = BEGIN ENABLE UNWIND => NULL; a.running _ FALSE; a.listener _ NIL; BROADCAST clientChanged; END; IF NOT a.running THEN ERROR; BEGIN ENABLE BEGIN ABORTED => { Unlock[]; CONTINUE }; UNWIND => Unlock[]; END; SELECT which FROM proceed, quit => BEGIN a.esv.reason _ IF which = proceed THEN proceed ELSE quit; WorldVM.CopyWrite[a.world, @a.esv, SIZE[DebuggerFormat.ExternalStateVector], a.esvAddr]; IF a.stateAddr # 0 THEN WorldVM.CopyWrite[a.world, @a.state, SIZE[PrincOps.StateVector], a.stateAddr]; WorldVM.Go[a.world]; END; screen, kill, activate => BEGIN SELECT which FROM screen => a.esv.reason _ showscreen; kill => a.esv.reason _ kill; activate => BEGIN a.esv.reason _ call; IF a.paramAddr # 0 THEN WorldVM.CopyWrite[a.world, @a.param, SIZE[DebuggerFormat.DebugParameter], a.paramAddr]; END; ENDCASE => ERROR; WorldVM.CopyWrite[a.world, @a.esv, SIZE[DebuggerFormat.ExternalStateVector], a.esvAddr]; WorldVM.Go[a.world]; END; boot => NULL; ENDCASE => ERROR; LookAtClient[a, which]; END; -- ENABLE UNWIND -- END; -- RunClient -- LookAtClient: PROC[a: Actor, which: Operation] = BEGIN NotifyHappening: ENTRY PROC[event: AMEvents.Event] = BEGIN -- Notify return from some call, or some event -- ENABLE UNWIND => NULL; IF event = NIL THEN a.level _ a.esv.level _ a.level - 1 ELSE BEGIN event.session _ a.bootCount; Process.Detach[FORK RemoteEvent[a, a.level, a.bootCount, event ] ]; END; a.listener _ NIL; BROADCAST clientChanged; END; IF NOT a.running THEN ERROR; -- someone should still have the lock! -- WorldVM.CopyRead[a.world, swapInfoAddr, SIZE[DebuggerFormat.SwapInfo], @a.swapInfo]; a.esvAddr _ LOOPHOLE[a.swapInfo.externalStateVector, WorldVM.Address]; WorldVM.CopyRead[a.world, a.esvAddr, SIZE[DebuggerFormat.ExternalStateVector], @a.esv]; a.paramAddr _ WorldVM.Long[a.world, LOOPHOLE[a.esv.parameter, WorldVM.ShortAddress]]; IF a.paramAddr # 0 THEN WorldVM.CopyRead[a.world, a.paramAddr, SIZE[DebuggerFormat.DebugParameter], @a.param]; a.stateAddr _ WorldVM.Long[a.world, LOOPHOLE[a.esv.state, WorldVM.ShortAddress]]; IF a.stateAddr # 0 THEN WorldVM.CopyRead[a.world, a.stateAddr, SIZE[PrincOps.StateVector], @a.state]; IF which # init AND a.level # a.esv.level THEN BEGIN <> NotifyBooted: ENTRY PROC RETURNS[oldSession: INT] = BEGIN ENABLE UNWIND => NULL; oldSession _ a.bootCount; a.bootCount _ a.bootCount+1; a.listener _ NIL; BROADCAST clientChanged; END; Start: ENTRY PROC RETURNS[ok: BOOL] = BEGIN ENABLE UNWIND => NULL; IF (ok _ a.users#0) THEN { a.listener _ Process.GetCurrent[]; a.level _ 0 } END; FlushBreaks[a.world]; CallBootedNotifiers[a.world, NotifyBooted[]]; -- with "a.running" still locked -- IF NOT Start[] THEN RETURN; END; a.esv.level _ a.level; IF a.esv.reason = return AND a.level > 0 -- return at level 0 is illegal -- THEN -- client is returning from a call -- NotifyHappening[NIL] ELSE BEGIN -- client is invoking us, or is hopelessly confused -- event: AMEvents.Event _ NIL; SELECT a.esv.reason FROM breakpoint, worrybreak => IF a.stateAddr = 0 THEN event _ UnknownEvent["No state for breakpoint"] ELSE BEGIN break: BreakID _ BreakEvent[a.world, @a.state, a.esv.reason=worrybreak]; IF break = NIL THEN event _ UnknownEvent["Unknown breakpoint"] ELSE event _ NEW[AMEvents.EventRec _ [worry: a.esv.reason=worrybreak, detail: break[break.id, break.clientData]] ]; END; explicitcall, worrycall => BEGIN event _ IF a.stateAddr = 0 OR a.state.stkptr = 0 THEN UnknownEvent["No argument for call debugger"] ELSE NEW[AMEvents.EventRec _ [worry: a.esv.reason=worrycall, detail: call[ RopeFromRemote[a.world, WorldVM.Long[a.world, a.state.stk[0]]]]]]; a.state.stkptr _ 0; END; uncaughtsignal => event _ SignalEvent[a.world, a.state.stk[1], a.state.stk[0]]; ENDCASE => event _ UnknownEvent["Unknown entry reason"]; IF a.stateAddr = 0 THEN event.frame _ NIL ELSE event.frame _ AMBridge.TVForRemoteFrame[ [world: a.world, worldIncarnation: WorldVM.CurrentIncarnation[a.world], fh: LOOPHOLE[a.state.dest, WorldVM.ShortAddress]], StackFromState[@a.state], a.state.instbyte = PrincOps.zRET, event.type = break ]; event.world _ a.world; event.process _ PSBIToTV[a.esv.psb, a.world]; NotifyHappening[event]; END; END; -- LookAtClient -- RopeFromRemote: PROC[world: WorldVM.World, addr: WorldVM.Address] RETURNS[ Rope.ROPE ] = -- addr is remote address of a string (or 0) -- BEGIN temp: STRING = [0]; s: STRING = [128]; -- restrict the length to protect ourselves -- min: CARDINAL = SIZE[StringBody[0]]; IF addr = 0 THEN RETURN[NIL]; WorldVM.CopyRead[world: world, from: addr, to: temp, nwords: min]; s.length _ MIN[temp.length, s.maxlength]; WorldVM.CopyRead[world: world, from: addr+min, to: s+min, nwords: SIZE[StringBody[s.length]]-min]; RETURN[ConvertUnsafe.ToRope[s]] END; -- ******** Local events ******** -- GrabLocalEvents: INTERNAL PROC = BEGIN OPEN PrincOps; IF wsls THEN oldCatcher _ RuntimeError.RegisterUncaughtSignalHandler[MyCatcher]; oldBreak _ SD[sBreak]; FastBreak.SpecifyDefaultBreakHandler[MyBreak]; -- RRA: first go through fast break handler SD[sBreak] _ FastBreak.FastBreakHandler; END; ReleaseLocalEvents: INTERNAL PROC = BEGIN OPEN PrincOps; IF wsls THEN [] _ RuntimeError.RegisterUncaughtSignalHandler[oldCatcher]; FastBreak.SpecifyDefaultBreakHandler[oldBreak]; -- RRA: this may cause problems, but they ae no worse than for regular breakpoints that the old handler does not understand. I believe that this procedure is completely useless. SD[sBreak] _ oldBreak; END; WorldSwapLocalSignals: PUBLIC ENTRY PROC[yes: BOOL] = BEGIN ENABLE UNWIND => NULL; IF wsls = yes THEN RETURN; IF localActor # NIL THEN BEGIN wsls _ yes; IF wsls THEN [] _ RuntimeError.RegisterUncaughtSignalHandler[oldCatcher] ELSE oldCatcher _ RuntimeError.RegisterUncaughtSignalHandler[MyCatcher] END; END; MyCatcher: RuntimeError.UCSProc = BEGIN firstSignal: SIGNAL ANY RETURNS ANY = signal; -- to avoid name clash below! signaller: PrincOps.GlobalFrameHandle; f: PrincOps.FrameHandle _ PrincOpsUtils.GetReturnFrame[]; signaller _ f.accesslink; <> f _ LOOPHOLE[f.returnlink, PrincOps.FrameHandle]; IF f.accesslink = signaller THEN f _ LOOPHOLE[f.returnlink, PrincOps.FrameHandle]; IF supressUncaughtAborted AND signal = LOOPHOLE[ABORTED] THEN { TurkeyCatcher[frame]; ERROR KillThisTurkey }; BEGIN ENABLE RuntimeError.UNCAUGHT => IF signal--arg of catch-phrase-- = firstSignal-- arg of this procedure -- THEN DebuggerSwap.CallDebugger["Recursively uncaught signal"]; LocalEvent[SignalEvent[WorldVM.LocalWorld[], signal, msg], f, NIL]; END; END; TurkeyCatcher: PROC [root: PrincOps.FrameHandle] = BEGIN endProcess: PrincOps.ControlLink = root.returnlink; Caller: PROC = LOOPHOLE[PrincOpsUtils.GetReturnLink[]]; root.returnlink _ [frame[PrincOpsUtils.MyLocalFrame[]]]; PrincOpsUtils.SetReturnFrame[PrincOps.NullFrame]; Caller[ ! KillThisTurkey => CONTINUE]; PrincOpsUtils.SetReturnLink[endProcess]; END; MyBreak: PROC = BEGIN state: RECORD[ padding: LONG CARDINAL, v: PrincOps.StateVector]; event: AMEvents.Event; break: BreakID; state.v _ STATE; state.v.dest _ PrincOpsUtils.GetReturnLink[]; break _ BreakEvent[WorldVM.LocalWorld[], @state.v, FALSE]; IF break = NIL THEN BEGIN localFrame: PrincOps.FrameHandle = state.v.dest.frame; globalFrame: PrincOps.GlobalFrameHandle = localFrame.accesslink; codeBase: LONG POINTER = globalFrame.code.longbase; instAddr: LONG POINTER TO PrincOps.InstWord = codeBase + localFrame.pc / 2; inst: PrincOps.op = IF localFrame.pc MOD 2 = 0 THEN instAddr.evenbyte ELSE instAddr.oddbyte; IF inst = PrincOps.zBRK THEN -- breakpoint must have been set by world-swap debugger - BEGIN state.v.dest _ LOOPHOLE[oldBreak]; state.v.source _ LOOPHOLE[PrincOpsUtils.GetReturnLink[]]; RETURN WITH state.v END; END ELSE LocalEvent[event _ NEW[AMEvents.EventRec_[detail: break[break.id, break.clientData]] ], PrincOpsUtils.GetReturnFrame[], @state.v, state.v.instbyte = PrincOps.zRET]; state.v.dest _ PrincOpsUtils.GetReturnLink[]; state.v.source _ PrincOps.NullLink; IF PrincOpsUtils.ReadXTS[] = on THEN PrincOpsUtils.WriteXTS[skip1]; RETURN WITH state.v; END; CallDebugger: PUBLIC PROC[msg: Rope.ROPE] = BEGIN IF localActor # NIL THEN LocalEvent[NEW[AMEvents.EventRec _ [detail: call[msg]] ], PrincOpsUtils.GetReturnFrame[], NIL] ELSE DebuggerSwap.CallDebugger["Call debugger"L]; END; LocalEvent: PROC[event: AMEvents.Event, f: PrincOps.FrameHandle, stack: POINTER TO PrincOps.StateVector, return: BOOL _ FALSE] = BEGIN outcome: AMEvents.Outcome; event.world _ localActor.world; event.session _ localActor.bootCount; event.process _ PSBIToTV[PrincOpsUtils.PsbHandleToIndex[PrincOpsUtils.ReadPSB[]], localActor.world]; event.frame _ AMBridge.TVForFrame[f, stack, return, event.type = break]; event.worry _ FALSE; IF informing THEN RuntimeError.InformationalSignal[Debugging]; outcome _ InvokeEvent[localActor, event]; IF informing THEN RuntimeError.InformationalSignal[Debugged]; WITH o: outcome SELECT FROM proceed => NULL; quit => ERROR ABORTED -- I don't like it, but that's the convention for now --; retry, returnFrom => ERROR NotImplemented[]; ENDCASE => ERROR; END; UnknownEvent: PROC [msg: Rope.ROPE] RETURNS [event: AMEvents.Event] = {event _ NEW[AMEvents.EventRec _ [worry: TRUE, detail: unknown[msg]]]}; -- Checkpoint: ENTRY CedarSnapshot.CheckpointProc = -- { IF localActor # NIL THEN ReleaseLocalEvents[] }; -- Rollback: ENTRY CedarSnapshot.RollbackProc = -- { IF localActor # NIL THEN GrabLocalEvents[] }; -- ******** Subroutines for both local and non-local worlds ******** -- StackFromState: PROC[state: LONG POINTER TO PrincOps.StateVector] RETURNS[stack: AMBridge.WordSequence] = BEGIN stack _ NEW[AMBridge.WordSequenceRecord[state.stkptr]]; FOR i: INT IN [0..stack.size) DO stack[i] _ state.stk[i] ENDLOOP; END; SignalEvent: PROC[world: World, signal, msg: UNSPECIFIED] RETURNS[AMEvents.Event] = BEGIN local: BOOLEAN = (world = WorldVM.LocalWorld[]); sigTV: AMTypes.TV; argType: AMTypes.Type; arg: AMTypes.TV; BEGIN ENABLE AMTypes.Error => GOTO cant; sigTV _ IF local THEN AMBridge.TVForSignal[LOOPHOLE[signal, ERROR ANY RETURNS ANY]] ELSE AMBridge.TVForRemoteSignal[ [world: world, worldIncarnation: WorldVM.CurrentIncarnation[world], sed: signal] ]; argType _ AMTypes.Domain[AMTypes.TVType[sigTV]]; IF argType = SafeStorage.nullType THEN arg _ NIL ELSE IF AMTypes.Size[argType] = 1 THEN { arg _ AMTypes.New[argType, mutable, world]; AMBridge.SetTVFromLC[arg, LOOPHOLE[msg, CARDINAL]] } ELSE arg _ TVForPointer[world, LOOPHOLE[msg, WorldVM.ShortAddress], argType]; EXITS cant => BEGIN sigTV _ AMBridge.TVForReferent[NEW[CARDINAL _ LOOPHOLE[signal, CARDINAL]]]; arg _ AMBridge.TVForReferent[NEW[CARDINAL _ LOOPHOLE[msg, CARDINAL]]]; END; END; RETURN[ NEW[AMEvents.EventRec _ [detail: signal[sigTV, arg]]] ] END; TVForPointer: PROC[world: WorldVM.World, ptr: WorldVM.ShortAddress, type: AMTypes.Type] RETURNS[ tv: AMTypes.TV ] = BEGIN IF world = WorldVM.LocalWorld[] THEN tv _ AMBridge.TVForPointerReferent[LOOPHOLE[ptr, POINTER], type] ELSE tv _ AMBridge.TVForRemotePointerReferent[ [world: world, worldIncarnation: WorldVM.CurrentIncarnation[world], ptr: WorldVM.Long[world, ptr]], type]; END; PSBIToTV: PROC[psbi: CARDINAL, world: WorldVM.World] RETURNS[p: AMTypes.TV] = BEGIN ENABLE AMTypes.Error => { p _ NIL; CONTINUE }; p _ AMTypes.New[CODE[PROCESS], mutable, world]; AMBridge.SetTVFromLC[p, psbi]; END; -- ******** Breakpoints ******** -- BreakAt: PUBLIC PROC[world: WorldVM.World, section: AMModel.Section, clientData: REF ANY] RETURNS[id: BreakID] = { id _ BreakIt[TRUE, world, section, clientData] }; BreakAfter: PUBLIC PROC[world: WorldVM.World, section: AMModel.Section, clientData: REF ANY] RETURNS[id: BreakID] = { id _ BreakIt[FALSE, world, section, clientData] }; BreakIt: PROC[at: BOOL, world: WorldVM.World, section: AMModel.Section, clientData: REF ANY] RETURNS[id: BreakID] = BEGIN list: LIST OF AMModelLocation.CodeLocation; secWorld: WorldVM.World; [secWorld, list] _ IF at THEN AMModelLocation.EntryLocations[section] ELSE AMModelLocation.ExitLocations[section]; id _ NIL; FOR loc: LIST OF AMModelLocation.CodeLocation _ list, list.rest UNTIL loc = NIL DO loc.first.codeBase.out _ FALSE; id _ RealSetBreak[id, world, LOOPHOLE[loc.first.codeBase.longbase], loc.first.pc, clientData]; ENDLOOP; END; FrameBreak: PUBLIC PROC[gf: AMTypes.TV, pc: CARDINAL, clientData: REF ANY] RETURNS[id: BreakID] = BEGIN gfAddr: WorldVM.ShortAddress = AMBridge.TVToCardinal[gf]; world: WorldVM.World = AMBridge.GetWorld[gf]; gfHead: PrincOps.GlobalFrame; WorldVM.CopyRead[world: world, from: WorldVM.Long[world, gfAddr], to: @gfHead, nwords: SIZE[PrincOps.GlobalFrame]]; gfHead.code.out _ FALSE; id _ SetBreak[world, LOOPHOLE[gfHead.code.longbase], pc, clientData]; END; SetBreak: PUBLIC PROC[world: WorldVM.World, addr: WorldVM.Address, pc: CARDINAL, clientData: REF ANY] RETURNS[id: BreakID] = { id _ RealSetBreak[NIL, world, addr, pc, clientData] }; RealSetBreak: ENTRY PROC[id: BreakID, world: WorldVM.World, addr: WorldVM.Address, pc: CARDINAL, clientData: REF ANY] RETURNS[newID: BreakID] = BEGIN ENABLE UNWIND => NULL; new: REF BreakRec = NEW[BreakRec _ [world: world, addr: addr, pc: [pc], oldByte: , clientData: clientData]]; new.id _ newID _ IF id = NIL THEN new ELSE id; FOR b: REF BreakRec _ breaks, b.rest UNTIL b = NIL DO x: BreakID = b; IF x.world = world AND x.addr = addr AND x.pc = pc THEN RETURN WITH ERROR DuplicateBreakpoint[]; ENDLOOP; new.oldByte _ WorldVM.SetBreak[world, addr, [pc]]; -- JTM: don't set break until allocations are done! -- new.rest _ breaks; breaks _ new; END; ClearBreak: PUBLIC ENTRY PROC[id: BreakID] = BEGIN ENABLE UNWIND => NULL; prev: REF BreakRec _ NIL; FOR b: REF BreakRec _ breaks, b.rest UNTIL b = NIL DO IF b.id = id THEN BEGIN WorldVM.ClearBreak[b.world, b.addr, b.pc, b.oldByte]; IF b = breaks THEN breaks _ b.rest ELSE prev.rest _ b.rest; b.id _ NIL; -- break circular structure -- EXIT END ELSE prev _ b; REPEAT FINISHED => NULL -- probably from a previous session, abolished by FlushBreaks ENDLOOP; END; FlushBreaks: ENTRY PROC[world: World] = -- called at end of session; breaks have gone away BEGIN ENABLE UNWIND => NULL; prev: REF BreakRec _ NIL; FOR b: REF BreakRec _ breaks, b.rest UNTIL b = NIL DO IF b.world = world THEN BEGIN IF b = breaks THEN breaks _ b.rest ELSE prev.rest _ b.rest; b.id _ NIL; -- break circular structure -- END ELSE prev _ b; REPEAT FINISHED => NULL -- probably from a previous session, abolished by FlushBreaks ENDLOOP; END; NextBreak: PUBLIC ENTRY PROC[world: World, prev: BreakID] RETURNS[id: BreakID, clientData: REF ANY] = BEGIN ENABLE UNWIND => NULL; FOR b: REF BreakRec _ (IF prev = NIL THEN breaks ELSE prev.rest), b.rest UNTIL b = NIL DO IF b.id = b AND ( b.world = world OR world = NIL ) THEN RETURN[b, b.clientData]; ENDLOOP; RETURN[NIL,NIL] END; BreakEvent: PROC[world: World, state: LONG POINTER TO PrincOps.StateVector, worry: BOOL] RETURNS[break: BreakID] = BEGIN -- JTM: changed BreakEvent to return a BreakID rather than an Event localFrame: PrincOps.Frame; globalFrame: PrincOps.GlobalFrame; word: WorldVM.Address; byte: [0..1]; FindBreak: ENTRY PROC RETURNS[BreakID] = BEGIN ENABLE UNWIND => NULL; FOR b: REF BreakRec _ breaks, b.rest UNTIL b = NIL DO IF b.world = world AND b.addr + b.pc/2 = word AND b.pc MOD 2 = byte THEN BEGIN state.instbyte _ b.oldByte; RETURN[ b ] END; ENDLOOP; -- If we get here, we've hit a break point not recorded in our list -- <> <> -- the cases by looking at the code byte (see the local breakpoint handler). -- state.instbyte _ 0; RETURN[NIL] END; WorldVM.CopyRead[world: world, from: WorldVM.Long[world, LOOPHOLE[state.dest.frame, WorldVM.ShortAddress]], to: @localFrame, nwords: SIZE[PrincOps.Frame] ]; WorldVM.CopyRead[world: world, from: WorldVM.Long[world, LOOPHOLE[localFrame.accesslink, WorldVM.ShortAddress]], to: @globalFrame, nwords: SIZE[PrincOps.GlobalFrame] ]; word _ LOOPHOLE[globalFrame.code.longbase, WorldVM.Address] + localFrame.pc / 2; byte _ localFrame.pc MOD 2; RETURN[FindBreak[]]; END; -- ******** Invoking procedures in client worlds ******** -- Apply: PUBLIC PROC[control, args: AMTypes.TV] RETURNS[result: AMTypes.TV] = BEGIN world: WorldVM.World = AMBridge.GetWorld[control]; local: BOOL = world = WorldVM.LocalWorld[]; controlType: AMTypes.Type = AMTypes.TVType[control]; class: AMTypes.Class _ AMTypes.UnderClass[controlType]; argType: AMTypes.Type; argBits: AMBridge.WordSequence; resType: AMTypes.Type; resSize: CARDINAL; state: PrincOps.StateVector; SELECT class FROM procedure, signal, globalFrame => NULL; error => class _ signal; ENDCASE => ERROR BadControlLink[]; state.dest _ LOOPHOLE[AMBridge.TVToCardinal[control]]; state.source _ LOOPHOLE[PrincOpsUtils.MyLocalFrame[]]; argType _ AMTypes.Domain[controlType]; IF (argType = SafeStorage.nullType AND args # NIL) OR NOT SafeStorage.EquivalentTypes[argType, AMTypes.TVType[args]] OR (argType # SafeStorage.nullType AND world # AMBridge.GetWorld[args]) THEN ERROR BadArgType[]; argBits _ IF argType = SafeStorage.nullType THEN NEW[AMBridge.WordSequenceRecord[0]] ELSE AMBridge.TVToWordSequence[args]; IF argBits.size > PrincOps.MaxParamsInStack OR (class = signal AND argBits.size > 1) THEN BEGIN -- long argument record -- IF NOT local THEN ERROR BadArgType[]; FOR i: PrincOps.FrameSizeIndex IN PrincOps.FrameSizeIndex DO IF argBits.size <= PrincOps.FrameVec[i] THEN { state.stk[0] _ PrincOpsUtils.Alloc[i]; EXIT } REPEAT FINISHED => ERROR--args too big for any frame!-- ENDLOOP; state.stkptr _ 1; IF argBits.size # 0 -- otherwise we'd get a bounds trap -- THEN PrincOpsUtils.LongCOPY[from: @argBits[0], to: LOOPHOLE[state.stk[0],POINTER], nwords: argBits.size]; END ELSE BEGIN -- short argument record -- IF argBits.size # 0 -- otherwise we'd get a bounds trap -- THEN PrincOpsUtils.LongCOPY[from: @argBits[0], to: @state.stk, nwords: argBits.size]; state.stkptr _ argBits.size; END; IF class = signal THEN BEGIN -- really, call the signal handler through SD -- <> IF NOT local THEN ERROR BadControlLink[]; state.stk[1] _ state.stk[0]; -- message -- state.stk[0] _ state.dest; -- signal -- state.stkptr _ 2; state.dest _ PrincOps.SD[IF argBits.size > 1 THEN PrincOps.sSignalList ELSE PrincOps.sSignal]; END; state.instbyte _ 0; IF local THEN { TRANSFER WITH state; state _ STATE } ELSE IF NOT Call[world, activate, @state] THEN ERROR--we aren't debugging that world--; resType _ AMTypes.Range[controlType]; IF resType = SafeStorage.nullType THEN BEGIN IF state.stkptr # 0 THEN ERROR BadResStack[]; result _ NIL END ELSE BEGIN resSize _ AMTypes.Size[resType]; result _ AMTypes.New[type: resType, world: world]; IF resSize > PrincOps.MaxParamsInStack THEN BEGIN -- long result record -- res: AMTypes.TV; IF state.stkptr # 1 THEN ERROR BadResStack[]; res _ TVForPointer[world, LOOPHOLE[state.stk[0],WorldVM.ShortAddress], resType]; AMTypes.Assign[lhs: result, rhs: res]; IF local THEN PrincOpsUtils.Free[LOOPHOLE[state.stk[0]]] ELSE NULL--TEMP?--; END ELSE BEGIN -- short result record -- IF state.stkptr # resSize THEN ERROR BadResStack[]; IF local THEN AMTypes.Assign[lhs: result, rhs: AMBridge.TVForPointerReferent[@state.stk, resType]] ELSE {ws: AMBridge.WordSequence _ NEW[AMBridge.WordSequenceRecord[resSize]]; PrincOpsUtils.LongCOPY[from: @state.stk, nwords: resSize, to: @ws[0]]; AMBridge.SetTVFromWordSequence[tv: result, ws: ws]}; END END; END; Kill: PUBLIC SAFE PROC[world: World] = TRUSTED BEGIN state: PrincOps.StateVector; IF world # WorldVM.LocalWorld[] THEN [] _ Call[world, kill, @state ! EndSession => CONTINUE]; END; Screen: PUBLIC SAFE PROC[world: World] = TRUSTED BEGIN state: PrincOps.StateVector; IF world # WorldVM.LocalWorld[] THEN [] _ Call[world, screen, @state ! EndSession => CONTINUE]; END; RegisterBootedNotifier: PUBLIC ENTRY SAFE PROC [proc: AMEvents.BootedNotifier, world: WorldVM.World _ NIL, clientData: REF _ NIL] = TRUSTED{ ENABLE UNWIND => NULL; bootedNotifierRegistry _ CONS[[proc, world, clientData], bootedNotifierRegistry]; }; UnRegisterBootedNotifier: PUBLIC ENTRY SAFE PROC [proc: AMEvents.BootedNotifier, world: WorldVM.World _ NIL, clientData: REF _ NIL] = TRUSTED{ ENABLE UNWIND => NULL; prev: BootedNotifierRegistry _ NIL; FOR this: BootedNotifierRegistry _ bootedNotifierRegistry, this.rest UNTIL this = NIL DO IF this.first.proc = proc AND (world = NIL OR world = this.first.world) AND (clientData = NIL OR clientData = this.first.clientData) THEN {IF prev = NIL THEN bootedNotifierRegistry _ this.rest ELSE prev.rest _ this.rest} ELSE prev _ this; ENDLOOP; }; CallBootedNotifiers: PROC[world: WorldVM.World, session: INT] = { FOR bnr: BootedNotifierRegistry _ bootedNotifierRegistry, NextBootedNotifier[world, bnr] UNTIL bnr = NIL DO bnr.first.proc[world, session, bnr.first.clientData]; ENDLOOP; }; NextBootedNotifier: ENTRY PROC[world: WorldVM.World, bnr: BootedNotifierRegistry] RETURNS[next: BootedNotifierRegistry _ NIL--nomore--] = { ENABLE UNWIND => NULL; FOR this: BootedNotifierRegistry _ bnr.rest, this.rest UNTIL this = NIL DO IF this.first.world = NIL OR world = this.first.world THEN RETURN[this]; ENDLOOP; }; <> --CedarSnapshot.Register[c: Checkpoint, r: Rollback];-- END.