-- AMProcessBasicImpl.mesa -- Andrew Birrell, January 27, 1983 4:15 pm DIRECTORY AMProcess USING[ State ], AMProcessBasic USING[ Frozen, GFTable ], CPSwapDefs USING[ ProcessState ], Environment, Frame, Inline, Mopcodes, PageMap, PrincOps, Process USING[ Pause ], ProcessInternal USING[ DisableInterrupts, EnableInterrupts], ProcessOperations, PSB, SDDefs USING[ SD ], Space, SpecialSpace USING[ MakeProcedureResident, MakeResident ], TrapSupport USING[ opTrapTable ], WorldVM, WVMPrivate, VMMapLog USING[ PatchTable, PatchTableEntry, PatchTableEntryPointer ]; AMProcessBasicImpl: MONITOR IMPORTS Frame, Inline, PageMap, Process, ProcessInternal, ProcessOperations, Space, SpecialSpace, WorldVM, WVMPrivate EXPORTS AMProcessBasic SHARES PageMap--GetF-- = BEGIN -- ******** ******** ******** ******** ******** -- -- Innocent reader beware! This module contains very delicate code. Much of it is -- executed with interrupts disabled. When disabled, the following constraints are -- obeyed: all code is resident, all data is resident, no procedure calls (except to INLINEs). -- Consider very carefully before modifying any of this module. -- ******** ******** ******** ******** ******** -- PSBI: TYPE = PSB.PsbIndex; -- ******** Part 1: Aborting ******** -- zTrapME: Mopcodes.op = 176B; zTrapMRE: Mopcodes.op = 177B; --AMProcessBasic.--Abort: PUBLIC PROC[world: WorldVM.World, psbi: PSBI] = BEGIN state: AMProcess.State; frozen: BOOL; processFrame: PrincOps.FrameHandle; trapFrame: POINTER TO local PrincOps.Frame = AbortFrame[]; -- lock out anyone else from modifying victim process -- Set[psbi]; [frozen: frozen, state: state, processFrame: processFrame] _ InfoFromPSB[world, psbi, FALSE ! UNWIND => Frame.Free[trapFrame]]; IF state = dead THEN { Frame.Free[trapFrame]; RETURN }; -- now, world and psbi are locked -- [] _ GetPSB[psbi, world, TRUE]; IF frozen OR world # local THEN { Unlock[world]; Frame.Free[trapFrame] } ELSE BEGIN ENABLE UNWIND => Clear[psbi]; SetPsbFrame[world, psbi, trapFrame]; trapFrame.returnlink.frame _ processFrame; -- disable process's timeout so it doesn't change queues during Dequeue. PSB.PDA[PSB.PDA.timeout][psbi] _ PSB.NoTimeout; --TEMP until microcode uses timeout vector: PSB.PDA.block[psbi].--timeout--mds _ PSB.NoTimeout; Unlock[world]; IF (state = waitingCV OR state = waitingML) AND NOT frozen THEN Dequeue[world, psbi, processFrame]; END; -- world is unlocked and process has been requeued from any CV or ML queue -- Clear[psbi]; END--DoAbort--; Dequeue: PROC[world: WorldVM.World, psbi: PSBI, frame: PrincOps.FrameHandle] = BEGIN -- Only implemented for world = local -- -- This procedure will remove a process from a CV or ML queue and requeue it onto ready list. -- The process must already have bee forced into a trap so it will not return from the -- frame where it was waiting. -- World is not frozen at entry, nor at exit. style: { ME, MRE }; wordAddr: LONG POINTER; offset: [0..1]; op, trap: Mopcodes.op; queue: LONG POINTER TO PSB.Queue; -- set the tangle-trap DO code: LONG POINTER = frame.accesslink.code.longbase; pc: PrincOps.BytePC _ [frame.pc-1]; Fetch: PROC = BEGIN word: PrincOps.InstWord; wordAddr _ code + pc / 2; offset _ pc MOD 2; word _ wordAddr^; op _ IF offset = 0 THEN word.evenbyte ELSE word.oddbyte; END; Fetch[]; SELECT op FROM Mopcodes.zME => { style _ ME; trap _ zTrapME }; Mopcodes.zMRE => { style _ MRE; trap _ zTrapMRE }; Mopcodes.zMXW => BEGIN style _ MRE; trap _ zTrapMRE; THROUGH [1..1000] DO pc _ [pc + OpcodeLengths[op]]; Fetch[]; IF op = Mopcodes.zMRE THEN EXIT; REPEAT FINISHED => ERROR ENDLOOP; END; zTrapME, zTrapMRE => { Process.Pause[1]; LOOP --obscure: some other process being patched at same place--}; ENDCASE => { Clear[psbi]; RETURN }; -- process will become ready by itself -- IF Patch[addr: wordAddr, offset: offset, byte: trap] = op THEN EXIT; -- otherwise, someone else is patching, so look again! -- ENDLOOP; -- call copy of victim's frame, to evaluate queue pointers -- BEGIN newFrame: PrincOps.FrameHandle; state: PrincOps.StateVector; fsi: CARDINAL _ LOOPHOLE[frame-1, POINTER TO CARDINAL]^; size: CARDINAL; IF fsi >= PrincOps.LargeReturnSlot THEN BEGIN size _ LOOPHOLE[frame-2, POINTER TO CARDINAL]^; FOR i: PrincOps.FrameSizeIndex IN PrincOps.FrameSizeIndex DO IF size <= PrincOps.FrameVec[i] THEN { newFrame _ Frame.Alloc[fsi _ i]; EXIT }; REPEAT FINISHED => ERROR ENDLOOP; END ELSE { size _ PrincOps.FrameVec[fsi]; newFrame _ Frame.Alloc[fsi] }; Inline.LongCOPY[from: frame, to: newFrame, nwords: PrincOps.FrameVec[fsi]]; newFrame.returnlink.frame _ Frame.MyLocalFrame[]; IF style = ME THEN LOOPHOLE[newFrame, PROC[BOOL]][FALSE] ELSE LOOPHOLE[newFrame, PROC][]; state _ STATE; SELECT TRUE FROM (style = ME AND state.stkptr = 1) => queue _ LOOPHOLE[state.stk[0],POINTER]; (style = MRE AND state.stkptr = 2) => queue _ LOOPHOLE[state.stk[1],POINTER]; (style = ME AND state.stkptr = 2) => queue _ LOOPHOLE[Environment.Long[any[low: state.stk[0], high: state.stk[1]]]]; (style = MRE AND state.stkptr = 4) => queue _ LOOPHOLE[Environment.Long[any[low: state.stk[2], high: state.stk[3]]]]; ENDCASE => ERROR; -- Beware if the queue should be in the victim's local frame! -- BEGIN queueCard: LONG CARDINAL = LOOPHOLE[queue]; frameBase: LONG CARDINAL = LOOPHOLE[LONG[newFrame]]; IF queueCard > frameBase AND queueCard <= frameBase + size THEN queue _ queue - frameBase + LOOPHOLE[LONG[frame],LONG CARDINAL]; END; END; -- remove the tangle trap -- IF Patch[addr: wordAddr, offset: offset, byte: op] # trap THEN ERROR; -- Transfer the process to the ready list if it's still on the queue -- BEGIN handle: PSB.PsbHandle = ProcessOperations.IndexToHandle[psbi]; queuePage: Environment.PageNumber = LOOPHOLE[queue, LONG CARDINAL] / Environment.wordsPerPage; THROUGH [1..50] -- garbage check -- DO [] _ queue^; -- queue may be non-resident -- ProcessInternal.DisableInterrupts[]; IF PageMap.GetF[queuePage].flags # PageMap.flagsVacant THEN EXIT; ProcessInternal.EnableInterrupts[]; REPEAT FINISHED => ERROR ENDLOOP; -- now disabled, with queue swapped in -- IF OnQueue[world, psbi, queue] THEN ProcessOperations.EnableAndRequeue[queue, @PSB.PDA.ready, handle] ELSE ProcessInternal.EnableInterrupts[]; END; END--Dequeue--; AbortFrame: PROC RETURNS[ POINTER TO local PrincOps.Frame ] = BEGIN state: RECORD[a, b: UNSPECIFIED, v: PrincOps.StateVector]; psbi: PSBI; Caller: PROC[PrincOps.FrameHandle] = LOOPHOLE[Frame.GetReturnFrame[]]; Caller[Frame.MyLocalFrame[]]; -- execution resumes in the victim process -- state.v _ STATE; psbi _ ProcessOperations.HandleToIndex[ProcessOperations.ReadPSB[]]; Wait[psbi]; -- now the initiating process has finished with the victim's frames -- IF PSB.PDA.block[psbi].flags.abort THEN BEGIN -- now read trapee's op-code, to distinguish ME from MRE -- caller: PrincOps.FrameHandle = Frame.GetReturnFrame[]; code: LONG POINTER = caller.accesslink.code.longbase; pc: PrincOps.BytePC = [caller.pc-1]; wordAddr: LONG POINTER = code + pc / 2; offset: [0..1] = pc MOD 2; word: PrincOps.InstWord = wordAddr^; op: Mopcodes.op = IF offset = 0 THEN word.evenbyte ELSE word.oddbyte; -- In the ME case, we handle aborted; otherwise MRE handles it -- IF op = Mopcodes.zME OR op = zTrapME THEN { PSB.PDA.block[psbi].flags.abort _ FALSE; ERROR ABORTED }; END; state.v.dest.frame _ Frame.GetReturnFrame[]; state.v.source _ PrincOps.NullLink; RETURN WITH state.v; END; TrapME: PROC = BEGIN state: RECORD[a, b: UNSPECIFIED, v: PrincOps.StateVector]; state.v _ STATE; state.v.instbyte _ Mopcodes.zME; Trap[@state.v]; RETURN WITH state.v; END; TrapMRE: PROC = BEGIN state: RECORD[a, b: UNSPECIFIED, v: PrincOps.StateVector]; state.v _ STATE; state.v.instbyte _ Mopcodes.zMRE; Trap[@state.v]; RETURN WITH state.v END; Trap: PROC[v: PrincOps.SVPointer] = INLINE -- MUST be INLINE, since it assumes it's in the trap handler's local frame -- BEGIN trapee: PrincOps.FrameHandle = Frame.GetReturnFrame[]; IF trapee.returnlink.frame.accesslink = Frame.MyGlobalFrame[] THEN BEGIN v.instbyte _ 0; v.dest _ trapee.returnlink; Frame.Free[trapee]; END ELSE v.dest.frame _ trapee; END; OpcodeLengths: PACKED ARRAY [0..255] OF [0..3] = -- copied from Traps.mesa -- [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 3, 2, 2, 2, 3, 0, 0, 0, 1, 1, 1, 1, 1, 2, 1, 1, 1, 2, 3, 3, 2, 1, 2, 1, 2, 2, 2, 2, 2, 2, 2, 1, 1, 2, 3, 2, 3, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 1, 1, 1, 2, 2, 1, 1, 1, 2, 1, 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 2, 3, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 2, 1, 1, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 1, 1, 1, 2, 2, 2, 0, 2, 2, 1, 0]; -- ******** Part 2: Freezing and process information ******** -- qFreeze: PSB.FaultIndex = 3; freezeQueue: LONG POINTER TO PSB.Queue = @PSB.PDA.fault[qFreeze].queue; GFTable: TYPE = AMProcessBasic.GFTable; --AMProcessBasic.--Info: PUBLIC PROC[world: WorldVM.World, psbi: PSBI, freeze: BOOL, -- freeze at boundary of filter thaw: BOOL, -- unfreeze if not in filter fullStatus: BOOL, -- whether to distinguish fault and ready queues -- filter: GFTable, -- interesting global frames -- wantedStates: PACKED ARRAY AMProcess.State OF BOOL -- interesting states --] RETURNS[ state: AMProcess.State _ dead, faultData: LONG CARDINAL _ 0, priority: PSB.Priority _ 0, frame: PrincOps.FrameHandle _ NIL, frozenFrame: PrincOps.FrameHandle _ NIL, topFrame: PrincOps.FrameHandle _ NIL -- current frame of process --] = BEGIN -- Delicate! -- If process is dead, returns [dead, 0, NIL] -- Returns state, but if not "fullStatus" treats fault and ready queues as "unknown". -- If "fullStatus", returns "faultData" from fault state vector, if any. -- Returns "frame" as first frame in stack scan that's inside the filter (or first, if filter=NIL); -- If no such frame, then frame _ NIL. -- If "freeze", freezes process at "frame", unless earlier frame in stack scan is already frozen; -- If "freeze" and "thaw", freezes process at "frame", then thaws any earlier frozen frame. frozen: BOOL; processFrame, prevFrame, freezeTrap: PrincOps.FrameHandle; restOfStack: PrincOps.ControlLink; -- lock out anyone else from modifying victim process -- Set[psbi]; restOfStack _ GetFreezee[world, psbi]; freezeTrap _ Freezer[world]; [priority, frozen, state, processFrame] _ InfoFromPSB[world, psbi, fullStatus]; IF state = dead THEN RETURN; -- now, world and psbi are locked -- IF NOT wantedStates[state] THEN { Unlock[world]; Clear[psbi]; RETURN }; [frame, prevFrame] _ ApplyFilter[world, [frame[processFrame]], filter, [frame[freezeTrap]] ! UNWIND => { Unlock[world]; Clear[psbi] } ]; frozenFrame _ IF restOfStack = PrincOps.NullLink THEN NIL ELSE IF frozen THEN GetLink[world, restOfStack.frame].frame ELSE restOfStack.frame; topFrame _ SELECT TRUE FROM frozen, freezeTrap=processFrame => frozenFrame, ENDCASE => processFrame; SELECT TRUE FROM frame # freezeTrap AND frame # NIL => BEGIN -- A victim frame was found, and it's in unfrozen territory. IF freeze THEN BEGIN -- freeze here -- IF frame = processFrame THEN SetPsbFrame[world, psbi, freezeTrap] ELSE SetLink[world, prevFrame, [frame[freezeTrap]]]; Unlock[world]; IF restOfStack # PrincOps.NullLink THEN BEGIN tail: PrincOps.FrameHandle _ frame; DO next: PrincOps.FrameHandle = GetLink[world, tail].frame; IF next = freezeTrap THEN EXIT; tail _ next; ENDLOOP; SetLink[world, tail, restOfStack]; END; SetFreezee[world, psbi, [frame[frame]]]; frozenFrame _ frame; END ELSE Unlock[world]; END; frame = freezeTrap => BEGIN -- If there is a victim, it must be inside the frozen territory. [frame, prevFrame] _ ApplyFilter[world, restOfStack, filter, PrincOps.NullLink ! UNWIND => { Unlock[world]; Clear[psbi] } ]; IF frame # NIL AND frame # restOfStack.frame AND (NOT frozen OR frame # frozenFrame) AND freeze AND thaw THEN BEGIN -- A victim was found, and we must contract the frozen territory. SetLink[world, prevFrame, [frame[freezeTrap]]]; Unfreeze[world, psbi, processFrame, restOfStack]; SetFreezee[world, psbi, [frame[frame]]]; frozenFrame _ frame; END ELSE Unlock[world]; END; ENDCASE => Unlock[world]; -- clean up -- Clear[psbi]; END--Info--; Thaw: PUBLIC PROC[world: WorldVM.World, psbi: PSB.PsbIndex] = BEGIN processFrame: PrincOps.FrameHandle; restOfStack: PrincOps.ControlLink; Set[psbi]; restOfStack _ GetFreezee[world, psbi]; IF restOfStack # PrincOps.NullLink THEN BEGIN processFrame _ InfoFromPSB[world, psbi, FALSE].processFrame; -- locks world -- Unfreeze[world, psbi, processFrame, restOfStack]; -- unlocks world -- END; Clear[psbi]; END; FreezingPoint: PROC RETURNS[ POINTER TO local PrincOps.Frame ] = BEGIN state: RECORD[a, b: UNSPECIFIED, v: PrincOps.StateVector]; Caller: PROC[PrincOps.FrameHandle] = LOOPHOLE[Frame.GetReturnFrame[]]; Caller[Frame.MyLocalFrame[]]; -- The rest of this procedure is magic. It is simultaneously on the stack of several processes. ProcessInternal.DisableInterrupts[]; DO state.v _ STATE; FreezeTrapFrame[@state.v]; ProcessOperations.EnableAndRequeue[@PSB.PDA.ready, freezeQueue, ProcessOperations.ReadPSB[]]; ProcessInternal.DisableInterrupts[]; ENDLOOP; END; FreezeTrapFrame: PROC[sv: POINTER TO PrincOps.StateVector] = BEGIN -- executed with interrupts disabled -- state: RECORD[a, b: UNSPECIFIED, v: PrincOps.StateVector]; Caller: PROC = LOOPHOLE[Frame.GetReturnFrame[]]; psbi: PSBI = ProcessOperations.HandleToIndex[ProcessOperations.ReadPSB[]]; state.v _ sv^; Frame.SetReturnLink[freezees[psbi]]; freezees[psbi] _ [frame[Frame.MyLocalFrame[]]]; Caller[]; state.v.dest.frame _ Frame.GetReturnFrame[]; state.v.source _ PrincOps.NullLink; RETURN WITH state.v; END; YouShouldNotBeLookingHere: PROC RETURNS[ POINTER TO local PrincOps.Frame ] = BEGIN Caller: PROC[PrincOps.FrameHandle] = LOOPHOLE[Frame.GetReturnFrame[]]; DummyReturnLink: PROC = {ERROR}; -- PrincOps.NullLink breaks FrameImpl.ValidateFrame Frame.SetReturnLink[LOOPHOLE[DummyReturnLink]]; Caller[FreezingPoint[]]; ERROR END; freezerAddr: POINTER TO POINTER TO local PrincOps.Frame = LOOPHOLE[@(SDDefs.SD[205B])]; freezeesAddr: POINTER TO LONG POINTER TO AMProcessBasic.Frozen = LOOPHOLE[@(SDDefs.SD[206B])]; AllocFreezees: PROC RETURNS[data: LONG POINTER TO AMProcessBasic.Frozen] = BEGIN freezeesSpace: Space.Handle = Space.Create[ (SIZE[AMProcessBasic.Frozen] + Space.wordsPerPage - 1) / Space.wordsPerPage, Space.virtualMemory]; Space.Map[freezeesSpace]; SpecialSpace.MakeResident[freezeesSpace]; data _ Space.LongPointer[freezeesSpace]; data^ _ ALL[PrincOps.NullLink]; END; freezees: PUBLIC LONG POINTER TO AMProcessBasic.Frozen _ freezeesAddr^ _ AllocFreezees[]; freezer: PUBLIC POINTER TO local PrincOps.Frame _ freezerAddr^ _ YouShouldNotBeLookingHere[]; Unfreeze: PROC[world: WorldVM.World, psbi: PSB.PsbIndex, processFrame: PrincOps.FrameHandle, restOfStack: PrincOps.ControlLink] = BEGIN -- On entry process and world are locked. On exit, only process is locked. -- freezeTrap: PrincOps.FrameHandle = Freezer[world]; IF processFrame = freezeTrap THEN BEGIN SetPsbFrame[world, psbi, restOfStack.frame]; [] _ OnQueue[world, psbi, freezeQueue, TRUE]; END ELSE BEGIN tail: PrincOps.FrameHandle _ processFrame; DO next: PrincOps.FrameHandle = GetLink[world, tail].frame; IF next = freezeTrap THEN EXIT; tail _ next; ENDLOOP; SetLink[world, tail, restOfStack]; END; Unlock[world]; SetFreezee[world, psbi, PrincOps.NullLink]; END; ApplyFilter: PROC[world: WorldVM.World, link: PrincOps.ControlLink, filter: GFTable, stopAt: PrincOps.ControlLink ] RETURNS[ frame, prevFrame: PrincOps.FrameHandle] = INLINE BEGIN -- "filter" is resident; world is locked. -- -- "frame" _ the first frame whose global frame inside the filter (or NIL if no such frame). -- If "frame" is not NIL and not "processFrame", prevFrame _ frame with returnlink "frame". frame _ link.frame; IF filter = NIL THEN RETURN; IF world = local THEN DO IF stopAt = [frame[frame]] THEN EXIT; IF AddrBad[frame] OR AddrBad[frame.accesslink] THEN { frame _ NIL; EXIT }; IF filter[frame.accesslink.gfi] THEN EXIT; IF frame.returnlink = PrincOps.NullLink OR frame.returnlink.proc THEN { frame _ NIL; EXIT }; prevFrame _ frame; frame _ frame.returnlink.frame; ENDLOOP ELSE [frame, prevFrame] _ ApplyRemoteFilter[world, link, filter, stopAt] END; ApplyRemoteFilter: PROC[world: WorldVM.World, link: PrincOps.ControlLink, filter: GFTable, stopAt: PrincOps.ControlLink ] RETURNS[ frame, prevFrame: PrincOps.FrameHandle] = BEGIN frame _ link.frame; DO ENABLE WorldVM.AddressFault => { frame _ NIL; EXIT }; fHeader: PrincOps.Frame; gHeader: PrincOps.GlobalFrame; IF stopAt = [frame[frame]] THEN EXIT; WorldVM.CopyRead[world: world, from: WorldVM.Long[world, LOOPHOLE[frame] ], to: @fHeader, nwords: SIZE[PrincOps.Frame] ]; WorldVM.CopyRead[world: world, from: WorldVM.Long[world, LOOPHOLE[fHeader.accesslink] ], to: @gHeader, nwords: SIZE[PrincOps.GlobalFrame] ]; IF filter[gHeader.gfi] THEN EXIT; IF fHeader.returnlink = PrincOps.NullLink OR fHeader.returnlink.proc THEN { frame _ NIL; EXIT }; prevFrame _ frame; frame _ fHeader.returnlink.frame; ENDLOOP; END; ReturnLink: PUBLIC PROC[world: WorldVM.World, frame: PrincOps.FrameHandle, psbi: PSB.PsbIndex _ PSB.PsbNull] RETURNS[link: PrincOps.ControlLink] = -- This returns the "virtual" return link: the one that would be there if the process was not frozen. -- BEGIN freezer: POINTER TO local PrincOps.Frame = Freezer[world]; link _ GetLink[world, frame]; IF link # [frame[freezer]] THEN RETURN; IF psbi # PSB.PsbNull THEN { Set[psbi]; link _ GetFreezee[world, psbi] } ELSE FOR psbi IN PSB.PsbIndex DO Set[psbi]; IF (link _ GetFreezee[world, psbi]) # PrincOps.NullLink THEN BEGIN state: AMProcess.State; processFrame: PrincOps.FrameHandle; [state: state, processFrame: processFrame] _ InfoFromPSB[world, psbi, FALSE]; IF state # dead THEN BEGIN ENABLE UNWIND => Clear[psbi]; other: PrincOps.ControlLink _ [frame[processFrame]]; Unlock[world]; UNTIL other = [frame[freezer]] OR other.indirect OR other.proc DO IF other.frame = frame THEN GOTO found; other _ GetLink[world, frame]; ENDLOOP; END; END; Clear[psbi]; REPEAT found => NULL; FINISHED => ERROR ENDLOOP; Clear[psbi]; END; GetFreezee: PROC[world: WorldVM.World, psbi: PSBI] RETURNS[PrincOps.ControlLink] = { RETURN[ IF world = local THEN freezees[psbi] ELSE LOOPHOLE[WorldVM.Read[world, Freezees[world] + psbi]] ] }; SetFreezee: PROC[world: WorldVM.World, psbi: PSBI, freezee: PrincOps.ControlLink] = { WorldVM.Write[world, Freezees[world] + psbi, LOOPHOLE[freezee] ] }; Freezees: PROC[world: WorldVM.World] RETURNS[ WorldVM.Address ] = { RETURN[ LOOPHOLE[WorldVM.LongRead[world, WorldVM.Long[world, LOOPHOLE[freezeesAddr]]]] ] }; Freezer: PROC[world: WorldVM.World] RETURNS[POINTER TO local PrincOps.Frame] = { RETURN[ IF world = local THEN freezer ELSE LOOPHOLE[WorldVM.Read[world, WorldVM.Long[world, LOOPHOLE[freezerAddr]]]] ] }; -- ******** Part 3: common subroutines ******** -- GetLink: PROC[world: WorldVM.World, frame: PrincOps.FrameHandle] RETURNS[PrincOps.ControlLink] = INLINE { RETURN[IF world = local THEN frame.returnlink ELSE GetRemoteLink[world, frame] ] }; GetRemoteLink: PROC[world: WorldVM.World, frame: PrincOps.FrameHandle] RETURNS[PrincOps.ControlLink] = BEGIN fHeader: PrincOps.Frame; WorldVM.CopyRead[world: world, from: WorldVM.Long[world, LOOPHOLE[frame] ], to: @fHeader, nwords: SIZE[PrincOps.Frame] ]; RETURN[fHeader.returnlink] END; SetLink: PROC[world: WorldVM.World, frame: PrincOps.FrameHandle, link: PrincOps.ControlLink] = INLINE { IF world = local THEN frame.returnlink _ link ELSE SetRemoteLink[world, frame, link] }; SetRemoteLink: PROC[world: WorldVM.World, frame: PrincOps.FrameHandle, link: PrincOps.ControlLink] = BEGIN fHeader: PrincOps.Frame; WorldVM.CopyRead[world: world, from: WorldVM.Long[world, LOOPHOLE[frame] ], to: @fHeader, nwords: SIZE[PrincOps.Frame] ]; fHeader.returnlink _ link; WorldVM.CopyWrite[world: world, from: @fHeader, to: WorldVM.Long[world, LOOPHOLE[frame] ], nwords: SIZE[PrincOps.Frame] ]; END; SetPsbFrame: PROC[world: WorldVM.World, psbi: PSBI, trapFrame: PrincOps.FrameHandle] = INLINE BEGIN -- on entry and exit, world and psbi are locked. IF world = local THEN BEGIN IF PSB.PDA.block[psbi].link.vector THEN PSB.PDA[PSB.PDA.block[psbi].context.state].frame _ LOOPHOLE[trapFrame] ELSE PSB.PDA.block[psbi].context.frame _ trapFrame; END ELSE SetRemotePsbFrame[world, psbi, trapFrame]; END; SetRemotePsbFrame: PROC[world: WorldVM.World, psbi: PSBI, trapFrame: PrincOps.FrameHandle] = BEGIN -- on entry and exit, world and psbi are locked. psb: PSB.ProcessStateBlock _ GetPSB[psbi, world]; IF psb.link.vector THEN BEGIN stateAddr: WorldVM.Address = LOOPHOLE[PSB.PDA, WorldVM.Address] + LOOPHOLE[psb.context.state, CARDINAL]; state: PrincOps.StateVector; WorldVM.CopyRead[world: world, from: stateAddr, to: @state, nwords: SIZE[PrincOps.StateVector] ]; state.frame _ LOOPHOLE[trapFrame]; WorldVM.CopyWrite[world: world, from: @state, to: stateAddr, nwords: SIZE[PrincOps.StateVector] ]; END ELSE BEGIN psb.context.frame _ trapFrame; WorldVM.CopyWrite[world: world, from: @psb, to: PsbAddr[world, psbi], nwords: SIZE[PSB.ProcessStateBlock] ]; END; END; InfoFromPSB: PROC[world: WorldVM.World, psbi: PSBI, fullStatus: BOOL] RETURNS[ priority: PSB.Priority, frozen: BOOL, state: AMProcess.State, processFrame: PrincOps.FrameHandle ] = BEGIN psb: PSB.ProcessStateBlock; -- prevent victim from proceeding -- Lock[world]; -- Also disables interrupts and stops processor timeout scan if world = local -- BEGIN ENABLE UNWIND => { Unlock[world]; Clear[psbi] }; psb _ GetPSB[psbi, world]; priority _ psb.link.priority; -- get status -- IF LOOPHOLE[psb.flags.available, CPSwapDefs.ProcessState].state = dead THEN { Unlock[world]; Clear[psbi]; state _ dead; RETURN }; frozen _ OnQueue[world, psbi, freezeQueue]; SELECT TRUE FROM psb.link.failed => state _ waitingML; psb.flags.waiting => state _ waitingCV; fullStatus => state _ GetQueueState[psbi, world]; ENDCASE => state _ unknown; -- get context -- IF psb.link.vector THEN BEGIN state: PrincOps.StateVector; stateAddr: WorldVM.Address = LOOPHOLE[PSB.PDA, WorldVM.Address] + LOOPHOLE[psb.context.state, CARDINAL]; IF world = local -- avoid making a procedure call to non-resident code! -- THEN Inline.LongCOPY[from: LOOPHOLE[stateAddr], to: @state, nwords: SIZE[PrincOps.StateVector] ] ELSE WorldVM.CopyRead[world: world, from: stateAddr, to: @state, nwords: SIZE[PrincOps.StateVector] ]; processFrame _ state.frame; END ELSE processFrame _ psb.context.frame; END--UNWIND catch--; END; GetQueueState: PROC[psbi: CARDINAL, world: WorldVM.World] RETURNS[AMProcess.State] = INLINE BEGIN IF OnQueue[world, psbi, @PSB.PDA.ready] THEN RETURN[ready]; FOR q: PSB.FaultIndex IN PSB.FaultIndex DO IF OnQueue[world, psbi, @(PSB.PDA.fault[q].queue)] THEN SELECT q FROM PSB.qFrameFault => RETURN[frameFault]; PSB.qPageFault, PSB.qPageFault+4 => RETURN[pageFault]; -- "+4" for software queues PSB.qWriteProtectFault, PSB.qWriteProtectFault+4 => RETURN[writeProtectFault]; qFreeze => RETURN[ready]; ENDCASE => RETURN[unknownFault]; ENDLOOP; RETURN[unknown] END; OnQueue: PROC[world: WorldVM.World, psbi: PSBI, queueHandle: PSB.QueueHandle, remove: BOOL _ FALSE] RETURNS[BOOL] = INLINE BEGIN IF world = local THEN BEGIN tail, prev: PSBI; IF queueHandle^ = PSB.QueueEmpty THEN RETURN[FALSE]; prev _ tail _ queueHandle.tail; THROUGH [FIRST[PSBI]..LAST[PSBI]+1] -- garbage protection -- DO next: PSBI = PSB.PDA.block[prev].link.next; IF next = psbi THEN BEGIN IF remove THEN ProcessOperations.Requeue[queueHandle, @PSB.PDA.ready, ProcessOperations.IndexToHandle[psbi]]; RETURN[TRUE] END; prev _ next; IF prev = tail THEN RETURN[FALSE]; ENDLOOP; RETURN[FALSE] -- actually, the queue is thoroughly mangled! -- END ELSE RETURN[ OnRemoteQueue[world, psbi, LOOPHOLE[queueHandle], remove] ]; END; OnRemoteQueue: PROC[world: WorldVM.World, psbi: PSBI, queueHandle: WorldVM.Address, remove: BOOL] RETURNS[BOOL] = BEGIN dest: LONG POINTER TO PSB.Queue = IF remove THEN @PSB.PDA.ready ELSE NIL; queue: PSB.Queue; tail, prev: PSBI; WorldVM.CopyRead[world: world, from: LOOPHOLE[queueHandle, WorldVM.Address], to: @queue, nwords: SIZE[PSB.Queue]]; IF queue = PSB.QueueEmpty THEN RETURN[FALSE]; prev _ tail _ queue.tail; THROUGH [FIRST[PSBI]..LAST[PSBI]+1] -- garbage protection -- DO psb: PSB.ProcessStateBlock _ GetPSB[prev, world]; IF psb.link.next = psbi THEN BEGIN IF dest # NIL THEN BEGIN this: PSB.ProcessStateBlock _ GetPSB[psbi, world]; newQueue: PSB.Queue; WorldVM.CopyRead[world: world, from: LOOPHOLE[dest, WorldVM.Address], to: @newQueue, nwords: SIZE[PSB.Queue]]; -- dequeue -- psb.link.next _ this.link.next; IF queue.tail = psbi THEN queue.tail _ IF prev = psbi THEN PSB.PsbNull ELSE prev; -- enqueue -- IF newQueue.tail = PSB.PsbNull THEN this.link.next _ newQueue.tail _ psbi ELSE BEGIN -- scan queue for correct priority position -- tempPSBI: PSBI _ newQueue.tail; temp: PSB.ProcessStateBlock _ GetPSB[tempPSBI, world]; IF temp.link.priority >= this.link.priority THEN newQueue.tail _ psbi ELSE -- search until we find the correct priority -- DO next: PSB.ProcessStateBlock _ GetPSB[temp.link.next, world]; IF this.link.priority > next.link.priority THEN EXIT; tempPSBI _ temp.link.next; temp _ next; ENDLOOP; this.link.next _ temp.link.next; temp.link.next _ psbi; WorldVM.CopyWrite[world: world, from: @temp, to: PsbAddr[world, tempPSBI], nwords: SIZE[PSB.ProcessStateBlock]]; END; -- copy back -- WorldVM.CopyWrite[world: world, from: @psb, to: PsbAddr[world, prev], nwords: SIZE[PSB.ProcessStateBlock]]; WorldVM.CopyWrite[world: world, from: @this, to: PsbAddr[world, psbi], nwords: SIZE[PSB.ProcessStateBlock]]; WorldVM.CopyWrite[world: world, from: @queue, to: LOOPHOLE[queueHandle, WorldVM.Address], nwords: SIZE[PSB.Queue]]; WorldVM.CopyWrite[world: world, from: @newQueue, to: LOOPHOLE[dest, WorldVM.Address], nwords: SIZE[PSB.Queue]]; END; RETURN[TRUE] END; prev _ psb.link.next; IF prev = tail THEN RETURN[FALSE]; ENDLOOP; RETURN[FALSE] -- actually, the queue is thoroughly mangled! -- END; GetPSB: PROC[psbi: PSBI, world: WorldVM.World, abort: BOOL _ FALSE] RETURNS[PSB.ProcessStateBlock] = INLINE BEGIN IF world = local THEN BEGIN IF abort THEN PSB.PDA.block[psbi].flags.abort _ TRUE; RETURN[ PSB.PDA.block[psbi] ] END ELSE RETURN[ GetRemotePSB[psbi, world, abort] ] END; GetRemotePSB: PROC[psbi: PSBI, world: WorldVM.World, abort: BOOL] RETURNS[psb: PSB.ProcessStateBlock] = BEGIN psbAddr: WorldVM.Address = PsbAddr[world, psbi]; WorldVM.CopyRead[world: world, from: psbAddr, to: @psb, nwords: SIZE[PSB.ProcessStateBlock]]; IF abort THEN BEGIN psb.flags.abort _ TRUE; WorldVM.CopyWrite[world: world, from: @psb, to: psbAddr, nwords: SIZE[PSB.ProcessStateBlock]]; END; END; PsbAddr: PROC[world: WorldVM.World, psbi: PSBI] RETURNS[ WorldVM.Address ] = { RETURN[ LOOPHOLE[PSB.PDA, WorldVM.Address] + psbi*SIZE[PSB.ProcessStateBlock] ] }; -- Synchronisation -- untangling: REF PACKED ARRAY PSBI OF BOOL = NEW[PACKED ARRAY PSBI OF BOOL _ ALL[FALSE] ]; finishedUntangling: CONDITION _ [timeout:0]; Set: ENTRY PROC[psbi: PSBI] = { WHILE untangling[psbi] DO WAIT finishedUntangling ENDLOOP; untangling[psbi] _ TRUE }; Wait: ENTRY PROC[psbi: PSBI] = INLINE { WHILE untangling[psbi] DO WAIT finishedUntangling ENDLOOP }; Clear: ENTRY PROC[psbi: PSBI] = { untangling[psbi] _ FALSE; BROADCAST finishedUntangling }; -- Access to client memory with client stopped -- local: WorldVM.World = WorldVM.LocalWorld[]; Lock: PROC[world: WorldVM.World] = { IF world = local THEN ProcessInternal.DisableInterrupts[] ELSE WorldVM.Lock[world] }; Unlock: PROC[world: WorldVM.World] = INLINE { IF world = local THEN ProcessInternal.EnableInterrupts[] ELSE WorldVM.Unlock[world] }; AddrBad: PROC[addr: LONG POINTER] RETURNS[BOOL] = INLINE { OPEN a: LOOPHOLE[addr, num Environment.Long]; IF a.highbits >= 256 THEN RETURN[TRUE]; RETURN[ PageMap.GetF[a.highbits*256 + a.lowbits/256].flags = PageMap.flagsVacant ] }; -- Patching code temporarily stolen from WVMImpl -- Patch: PROC[addr: LONG POINTER, offset: [0..1], byte: Mopcodes.op] RETURNS[oldByte: Mopcodes.op] = { RETURN[ WVMPatch[WorldVM.LocalWorld[], LOOPHOLE[addr], offset, byte] ] }; -- Procesdure almost copied from WVMImpl -- PatchTableFull: ERROR = CODE; WVMPatch: ENTRY PROC[world: WorldVM.World, addr: WorldVM.Address, offset: [0..1], byte: Mopcodes.op] RETURNS[oldByte: Mopcodes.op] = BEGIN OPEN WorldVM; ENABLE UNWIND => NULL; value: PrincOps.InstWord; -- new memory word contents -- patch: Address = WVMPrivate.PatchTable[world]; header: VMMapLog.PatchTable; base: Address = patch + SIZE[VMMapLog.PatchTable]; free: CARDINAL; pti: CARDINAL; entry: VMMapLog.PatchTableEntry; CopyRead[world: world, from: patch, to: @header, nwords: SIZE[VMMapLog.PatchTable]]; free _ LOOPHOLE[header.limit]; FOR pti _ 0, pti + SIZE[VMMapLog.PatchTableEntry] UNTIL pti = LOOPHOLE[header.limit, CARDINAL] DO CopyRead[world: world, from: base+pti, to: @entry, nwords: SIZE[VMMapLog.PatchTableEntry]]; IF entry.address = NIL THEN free _ pti; IF LOOPHOLE[entry.address, Address] = addr THEN EXIT; REPEAT FINISHED => { pti _ free; entry.address _ NIL } ENDLOOP; IF pti = LOOPHOLE[header.limit, CARDINAL] AND header.limit = header.maxLimit THEN ERROR PatchTableFull[]; value _ IF LOOPHOLE[entry.address, Address] = addr THEN entry.value ELSE LOOPHOLE[Read[world, addr]]; oldByte _ IF offset=0 THEN value.evenbyte ELSE value.oddbyte; IF offset=0 THEN value.evenbyte _ byte ELSE value.oddbyte _ byte; entry.value _ value; entry.address _ LOOPHOLE[addr]; IF world = local THEN LocalEntry[from: entry, to: LOOPHOLE[base, LONG POINTER] + pti] ELSE CopyWrite[world: world, from: @entry, to: base+pti, nwords: SIZE[VMMapLog.PatchTableEntry]]; IF pti = LOOPHOLE[header.limit, CARDINAL] THEN -- extend table -- BEGIN header.limit _ LOOPHOLE[pti + SIZE[VMMapLog.PatchTableEntry]]; CopyWrite[world: world, from: @header, to: patch, nwords: SIZE[VMMapLog.PatchTable]]; END; -- Now we've done the patch table. Next, fix real memory. -- IF world = local THEN LocalPatch[LOOPHOLE[addr, LONG POINTER], entry.value] ELSE BEGIN n: WVMPrivate.PageNumber; w: [0..WVMPrivate.pageSize); h: WVMPrivate.PageHandle; d: REF WVMPrivate.PageData; [n, w, h, d] _ PageFromAddr[world, addr, --coreOnly:-- TRUE]; IF h # NIL THEN -- swapped in, so patch it -- BEGIN d[w] _ entry.value; WVMPrivate.WriteAndReleasePage[h--, clean--]; END; END; END; LocalEntry: INTERNAL PROC[from: VMMapLog.PatchTableEntry, to: LONG POINTER TO VMMapLog.PatchTableEntry] = BEGIN -- Unfortunately, we can't synchronize with the swapper. ProcessInternal.DisableInterrupts[]; to^ _ from; -- assume our local frame and patch table are resident. ProcessInternal.EnableInterrupts[]; END; LocalPatch: INTERNAL PROC[addr: LONG POINTER, value: CARDINAL] = BEGIN -- patch given address in our real memory, cleanly. page: Space.PageNumber = Space.PageFromLongPointer[addr]; oldVal, newVal: PageMap.Value; UNTIL addr^ = value -- in practice, only once! DO ProcessInternal.DisableInterrupts[]; newVal _ oldVal _ PageMap.GetF[page]; IF oldVal.flags # PageMap.flagsVacant THEN BEGIN newVal.flags.writeProtected _ FALSE; [] _ PageMap.SetF[page, newVal]; addr^ _ value; --write the word! [] _ PageMap.SetF[page, oldVal]; END; ProcessInternal.EnableInterrupts[]; ENDLOOP; END; PageFromAddr: PROC[world: WorldVM.World, addr: WorldVM.Address, coreOnly: BOOLEAN _ FALSE] RETURNS[n: WVMPrivate.PageNumber, w: [0..WVMPrivate.pageSize), h: WVMPrivate.PageHandle, d: REF WVMPrivate.PageData] = BEGIN n _ addr / WVMPrivate.pageSize; w _ addr - n * LONG[WVMPrivate.pageSize]; [d, h] _ WVMPrivate.GetPage[world, n, coreOnly]; END; SpecialSpace.MakeProcedureResident[Info]; SpecialSpace.MakeProcedureResident[Dequeue]; SpecialSpace.MakeProcedureResident[LocalPatch]; SpecialSpace.MakeProcedureResident[LocalEntry]; TrapSupport.opTrapTable.main[zTrapME] _ LOOPHOLE[TrapME]; TrapSupport.opTrapTable.main[zTrapMRE] _ LOOPHOLE[TrapMRE]; END.