<> <> <> <> <> <> <> 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; <> <<>> <> <<>> <> <> <<>> <> <> <> <> <> <> <> < [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: Address = LOOPHOLE[@PrincOps.PDA.available, Address]; <> <<******** 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; <> CrashOnRecursiveAppearance: PUBLIC BOOL _ FALSE; <> Informing: PUBLIC BOOL _ TRUE; <> Wsls: PUBLIC BOOL _ TRUE; <> breaks: REF BreakRec _ NIL; bootedNotifierRegistry: BootedNotifierRegistry _ NIL; IsGuestProcess: PROC [] RETURNS [isGuest: BOOL] _ FalseProc; GuestProcs: REF AMEventsBackdoor.GuestProcsRec _ NEW[AMEventsBackdoor.GuestProcsRec _ [FalseProc]] ; <<******** 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: PUBLIC ERROR = CODE; NotImplemented: PUBLIC ERROR = CODE; BreakNotFound: PUBLIC ERROR = CODE; <<******** TYPES ******** -->> Operation: TYPE = { screen, kill, activate, boot, proceed, quit, init }; <> BreakID: TYPE = REF BreakRec; <> BreakRec: PUBLIC TYPE = RECORD[ rest: REF BreakRec _ NIL, id: BreakID _ NIL, world: World, addr: Address, pc: PrincOps.BytePC, oldByte: PrincOps.op, clientData: REF]; <> 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 => { <> 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 --] = { <> 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[]; }; <> <<"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] = { <<"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] = { <> 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 { <> 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 { <> 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] = { <> 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]; <> 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; <> <> 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 { <> 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; <> <> <> <> 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]]; <> 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] = { <> 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] = { <> 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; <> 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 <> PrincOpsUtils.LongCopy[from: @argBits[0], to: dstPtr, nwords: argBits.size]; IF class = signal THEN { <> <> 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 { <> 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 { <> 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; }; <> RegisterGuestProcs: PUBLIC PROC [newProcs: REF AMEventsBackdoor.GuestProcsRec] = { GuestProcs _ newProcs; IsGuestProcess _ newProcs.IsGuestProcess; }; <> FalseProc: PROC RETURNS [isGuest: BOOL] = { isGuest _ FALSE; }; }. <<>> <<>> <<>> <> <> <<>> <> <> <> <<>> <> <> <<>> <<>> <<>> <<>>