-- VMMgr>SpaceImplA.mesa (last edited by Levin on October 26, 1982 9:44 am)
-- Note: There is another version of SpaceImpl for UtilityPilot which should
-- track changes to this module.
-- Implementation Notes:
-- All client processes which wish to enter the Space Monitor MUST enter it via
-- EnterSpace[]. There must be no other client-callable ENTRY procedures.
-- The routines herein must have this organization: first, check for all client
-- errors, and raise an ERROR if any; then, make changes to the VM databases, etc.
-- The MONITORLOCK of SpaceImplA/B "spaceLock" protects all VMMgr data, including
-- the Hierarchy and Projection data bases and the MapLog. That is, those
-- facilities are only accessed from within the Space monitor, and so are not
-- themselves MONITORs, but rely on the serialization provided by spaceLock.
-- This makes the calls to those facilities faster.
-- In doing arithmetic involving subtraction of page numbers, the programmer must
-- take care that no result is ever less than zero, since they are all CARDINALs.
-- Things to Consider:
-- GetAttributes could be augmented by operations for accessing individual space
-- attributes, avoiding unnecessary disk accesses, if performance requirements so
-- dictate.
DIRECTORY
CachedRegion USING [
activate, Apply, createSwapUnits, deactivate, Desc, flush, startForceOut,
kill, Mapped, Operation, Outcome, pageTop, pin, unpin, wait],
CachedSpace USING [Desc, Handle, handleNull, handleVM, Level, SizeSwapUnit],
Environment USING [Long, maxPagesInMDS, wordsPerPage],
File USING [Capability, Error, ErrorType, Permissions, read, Unknown, write],
Hierarchy USING [
Delete, FindFirstWithin, GetDescriptor, GetInterval, Insert, Touch, Update,
ValidSpaceOrSwapUnit],
Inline USING [BITAND, BITNOT, LongMult],
PrincOps USING [BytePC, ControlLink, EPRange, GlobalFrameHandle, PrefixHandle],
PrincOpsRuntime USING [GFT],
Process USING [GetPriority, Priority, SetPriority],
ProcessPriorities USING [priorityPageFaultLow],
Projection USING [
DeleteSwapUnits, ForceOut, Get, Merge, Split, Touch, TranslateLevel],
Runtime USING [GlobalFrame],
RuntimeInternal USING [Codebase],
Space USING [
defaultBase, defaultWindow, ErrorType, Handle, PageCount, PageNumber,
PageOffset, WindowOrigin, wordsPerPage],
SpaceExtras USING [],
SpaceImplInternal USING [
InitializeSpaceImplB, Interval, Level, RegionD, SpaceD, spaceLock,
UnmapInternal],
SpecialSpace USING [],
Transaction USING [Handle, InvalidHandle, nullHandle],
TransactionState USING [WithdrawFromTransaction],
Utilities USING [PageFromLongPointer],
VM USING [Interval, PageCount],
VMMPrograms USING [],
Volume USING [ID, InsufficientSpace, Unknown];
SpaceImplA: MONITOR LOCKS SpaceImplInternal.spaceLock
IMPORTS
CachedRegion, File, Hierarchy, Inline, Process, Projection, Runtime,
RuntimeInternal, SpaceImplInternal, Transaction, TransactionState, Utilities,
Volume
EXPORTS Space, SpaceExtras, SpaceImplInternal, SpecialSpace, VMMPrograms
SHARES File --USING [Capability.permissions]-- =
BEGIN OPEN Space, SpaceImplInternal;
Handle: PUBLIC TYPE = CachedSpace.Handle;
AlignType: TYPE = {code, powerOf2, none};
ChildrenSelf: TYPE = {children, self};
--~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Space monitor data:
--~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Public Data:
Error: PUBLIC ERROR [type: ErrorType] = CODE;
InsufficientSpace: PUBLIC ERROR [available: PageCount] = CODE;
mds: PUBLIC Handle;
nullHandle: PUBLIC Handle ← CachedSpace.handleNull;
nullTransactionHandle: PUBLIC Transaction.Handle ← Transaction.nullHandle;
virtualMemory: PUBLIC Handle ← CachedSpace.handleVM;
-- Private Data:
countVM: VM.PageCount;
handleMDS: CachedSpace.Handle;
intervalMDS: Interval;
--SpaceImplInternal.-- spaceLock: PUBLIC MONITORLOCK; -- (private to SpaceImpl#)
largestPowerOf2Cardinal: CARDINAL = (LAST[CARDINAL]/2) + 1; -- assumes binary representation for CARDINALs.
maxPagesInCodeBlock: PageCount = Environment.maxPagesInMDS;
Bug: PRIVATE --PROGRAMMING-- ERROR [type: BugType] = CODE; -- not to be caught by client;
BugType: TYPE = {
deleteBadSpace, funnyAlignment, funnySignal, funnyErrorState, funnyOutcome,
noCreateDecision};
--~~~~~~~~~~~~~~~~~~~~
-- Initialization
--~~~~~~~~~~~~~~~~~~~~
InitializeSpace: PUBLIC PROCEDURE [countVM: VM.PageCount, handleMDS: Handle] = {
InitializeInternal[countVM, handleMDS]}; -- (just to change the parameter names.)
InitializeInternal: PROCEDURE [ctVM: VM.PageCount, handMDS: Handle] =
BEGIN
countVM ← ctVM; -- copy params into globals..
mds ← (handleMDS ← handMDS);
intervalMDS ← Hierarchy.GetInterval[handleMDS].interval;
InitializeSpaceImplB[countVM];
END;
--~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- SpecialSpace implementation
--~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--~~~~~~~~~~~~~~~~~~~~
-- Monitor externals
--~~~~~~~~~~~~~~~~~~~~
ActivateProc: PUBLIC --EXTERNAL-- PROCEDURE [
proc: --PrincOps.ControlLink-- UNSPECIFIED] = {
Activate[GetHandle[Utilities.PageFromLongPointer[Code[proc]]]]};
ActivateSwapUnit: PUBLIC --EXTERNAL-- PROCEDURE [page: Space.PageNumber] = {
Activate[GetHandle[page]]};
Code: --EXTERNAL-- PROCEDURE [proc: PrincOps.ControlLink]
RETURNS [code: LONG POINTER --TO code-- ] =
-- Returns pointer to first word of procedure's code.
BEGIN
OutermostProcOf: PROCEDURE [link: PrincOps.ControlLink]
RETURNS [PrincOps.ControlLink] = INLINE
BEGIN
WHILE link.indirect AND ~link.proc DO link ← link.link↑; ENDLOOP;
IF ~link.proc THEN Error[invalidParameters];
RETURN[link]
END;
codeBase: LONG PrincOps.PrefixHandle =
RuntimeInternal.Codebase[Runtime.GlobalFrame[proc ← OutermostProcOf[proc]]];
evi: CARDINAL = PrincOpsRuntime.GFT[proc.gfi].epbias*PrincOps.EPRange + proc.ep;
startPC: PrincOps.BytePC = codeBase.entry[evi].initialpc;
RETURN[codeBase + LOOPHOLE[startPC, CARDINAL]];
END;
CreateAligned: PUBLIC --EXTERNAL-- PROCEDURE [
size: Space.PageCount, parent: Space.Handle, alignment: Space.PageCount ← 0]
RETURNS [newSpace: Space.Handle] =
-- Create a space which begins at a page within virtual memory which is an
-- integral multiple of the smallest power of two not less than the given
-- size. (Thus if size is already a power of two, the beginning page number
-- will have at least as many low-order zero bits as does size.)
{RETURN[CreateAny[size, parent, defaultBase, --alignType:-- powerOf2, alignment]]};
CreateForCode: PUBLIC --EXTERNAL-- PROCEDURE [
size: PageCount, parent: Handle, base: PageOffset]
RETURNS [newSpace: Space.Handle] =
-- Creates a space guaranteed not to cross a 64KW boundary.
{RETURN[CreateAny[size, parent, base, --alignType:-- code]]};
DeactivateProc: PUBLIC --EXTERNAL-- PROCEDURE [
proc: --PrincOps.ControlLink-- UNSPECIFIED] = {
Deactivate[GetHandle[Utilities.PageFromLongPointer[Code[proc]]]]};
DeactivateSwapUnit: PUBLIC --EXTERNAL-- PROCEDURE [page: Space.PageNumber] = {
Deactivate[GetHandle[page]]};
MakeCodeResident: PUBLIC --EXTERNAL-- PROCEDURE [frame: PROGRAM] = {
MakeResident[
GetHandle[Utilities.PageFromLongPointer[RuntimeInternal.Codebase[frame]]]]};
MakeCodeSwappable: PUBLIC --EXTERNAL-- PROCEDURE [frame: PROGRAM] = {
MakeSwappable[
GetHandle[Utilities.PageFromLongPointer[RuntimeInternal.Codebase[frame]]]]};
MakeGlobalFrameResident: PUBLIC --EXTERNAL-- PROCEDURE [frame: PROGRAM] = {
gf: PrincOps.GlobalFrameHandle = LOOPHOLE[frame];
IF gf.alloced THEN RETURN;
MakeResident[
GetHandle[Utilities.PageFromLongPointer[gf]]]};
MakeGlobalFrameSwappable: PUBLIC --EXTERNAL-- PROCEDURE [frame: PROGRAM] = {
gf: PrincOps.GlobalFrameHandle = LOOPHOLE[frame];
IF gf.alloced THEN RETURN;
MakeSwappable[
GetHandle[Utilities.PageFromLongPointer[gf]]]};
MakeProcedureResident: PUBLIC --EXTERNAL-- PROCEDURE [
proc: --PrincOps.ControlLink-- UNSPECIFIED] = {
MakeResident[GetHandle[Utilities.PageFromLongPointer[Code[proc]]]]};
MakeProcedureSwappable: PUBLIC --EXTERNAL-- PROCEDURE [
proc: --PrincOps.ControlLink-- UNSPECIFIED] = {
MakeSwappable[GetHandle[Utilities.PageFromLongPointer[Code[proc]]]]};
MakeResident: PUBLIC --EXTERNAL-- PROCEDURE [space: Handle] =
-- OK to make an already-resident space resident.
BEGIN
MakeResidentInternal: INTERNAL PROCEDURE[] =
BEGIN
Pinnable: PROCEDURE [regionD: RegionD] RETURNS [BOOLEAN] = {
RETURN[
regionD.state IN CachedRegion.Mapped
AND regionD.levelMapped <= space.level]};
spaceD: SpaceD;
validSpace, validSwapUnit: BOOLEAN;
[validSpace, validSwapUnit] ← Hierarchy.GetDescriptor[@spaceD, space];
IF validSwapUnit THEN Error[notApplicableToSwapUnit]
ELSE IF ~validSpace THEN Error[invalidHandle];
IF ~ForAllRegions[spaceD.interval, Pinnable] THEN
Error[invalidMappingOperation];
spaceD.pinned ← TRUE;
Hierarchy.Update[@spaceD];
ApplyToInterval[spaceD.interval, CachedRegion.pin]
END;
EnterSpace[MakeResidentInternal];
END;
MakeSwappable: PUBLIC --EXTERNAL-- PROCEDURE [space: Handle] =
BEGIN
MakeSwappableInternal: INTERNAL PROCEDURE[] =
BEGIN
spaceD: SpaceD;
validSpace, validSwapUnit: BOOLEAN;
[validSpace, validSwapUnit] ← Hierarchy.GetDescriptor[@spaceD, space];
IF validSwapUnit THEN Error[notApplicableToSwapUnit]
ELSE IF ~validSpace THEN Error[invalidHandle];
IF ~spaceD.pinned THEN Error[invalidMappingOperation];
spaceD.pinned ← FALSE;
Hierarchy.Update[@spaceD];
ApplyToInterval[spaceD.interval, CachedRegion.unpin]
END;
EnterSpace[MakeSwappableInternal];
END;
--~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Space implementation:
--~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--~~~~~~~~~~~~~~~~~~~~
-- Monitor externals
--~~~~~~~~~~~~~~~~~~~~
Activate: PUBLIC --EXTERNAL-- SAFE PROCEDURE [space: Handle] = TRUSTED
BEGIN
ActivateInternal: INTERNAL PROCEDURE[] = {
IF ~ApplyToSpace[space, CachedRegion.activate].validHandle THEN
Error[invalidHandle]};
EnterSpace[ActivateInternal];
END;
Create: PUBLIC --EXTERNAL-- PROCEDURE [
size: PageCount, parent: Handle, base: PageOffset] RETURNS [Handle] = {
RETURN[CreateAny[size, parent, base, --alignType:-- none]]};
CreateAny: --EXTERNAL-- PROCEDURE [
size: PageCount, parent: Handle, base: PageOffset, alignType: AlignType, alignSize: PageCount ← 0]
RETURNS [newSpace: Handle] =
BEGIN
CreateAnyInternal: INTERNAL PROCEDURE[] =
BEGIN
validSpace, validSwapUnit: BOOLEAN;
page: PageNumber; -- the start of the new space.
regionD: RegionD;
spaceDParent: SpaceD;
[validSpace, validSwapUnit] ← Hierarchy.GetDescriptor[
@spaceDParent, parent];
IF validSwapUnit THEN Error[notApplicableToSwapUnit]
ELSE IF ~validSpace THEN Error[invalidHandle];
IF parent.level >= LAST[Level] THEN Error[spaceTreeTooDeep];
IF spaceDParent.hasSwapUnits THEN Error[notApplicableToSwapUnit];
IF size = 0 OR (alignType = code AND size > maxPagesInCodeBlock)
OR (alignType = powerOf2 AND MAX[size, alignSize] > largestPowerOf2Cardinal) THEN
Error[invalidParameters];
IF base ~= defaultBase THEN --explicit base given--
BEGIN
regionD ← Projection.Get[page ← parent.page + base]; -- so page IN regionD.interval
IF size > (regionD.interval.page + regionD.interval.count) - page
OR base >= spaceDParent.interval.count OR regionD.level ~= parent.level
OR
(alignType = code
AND page/maxPagesInCodeBlock ~=
(page + size - 1)/maxPagesInCodeBlock) THEN
Error[invalidParameters];
END
ELSE --create anywhere--
BEGIN
alignment: CARDINAL; -- for alignType=powerOf2.
pwr2BdyMask: WORD; -- for alignType=powerOf2.
countMax: PageCount ← 0; -- largest suitable interval in space (in case none found).
codeBdyMask: WORD = LOOPHOLE[-(maxPagesInCodeBlock - 1) - 1, WORD]; -- (compile-time constant)
HoleNotFound: INTERNAL PROCEDURE [
reg: RegionD --, alignType, alignment-- ]
RETURNS [notFound: BOOLEAN --, page, countmax-- ] =
-- Looks for a hole in reg of a suitable size and alignment. If found,
-- notFound=FALSE and page is set; If notFound=TRUE, countmax is set
-- to the size of the largest suitable interval.
BEGIN
IF reg.level ~= parent.level THEN RETURN[notFound: TRUE]
ELSE --can not have swap units--
BEGIN OPEN r: reg.interval;
endRegion: PageNumber = r.page + r.count;
SELECT alignType FROM
code =>
BEGIN
firstBdy: PageNumber = Inline.BITAND[
r.page + maxPagesInCodeBlock, codeBdyMask]; --overflow is ok, yields 0
IF endRegion <= firstBdy OR firstBdy = 0 THEN
-- region ends before first boundary..
{
IF size <= r.count THEN {page ← r.page; RETURN[notFound: FALSE]}
ELSE {
countMax ← MAX[countMax, r.count]; RETURN[notFound: TRUE]}}
ELSE --first opportunity ends at first code boundary--
{
IF size <= firstBdy - r.page THEN {
page ← r.page; RETURN[notFound: FALSE]}
ELSE {countMax ← MAX[countMax, firstBdy - r.page]}};
-- Try after first code boundary:
IF Inline.BITAND[endRegion, codeBdyMask] ~= firstBdy THEN
-- region contains a whole CodeBlock..
{page ← firstBdy; RETURN[notFound: FALSE]}
ELSE --region contains exactly one code boundary--
IF firstBdy - r.page >= endRegion - firstBdy THEN
-- first chunk is larger..
{
IF size <= firstBdy - r.page THEN {
page ← r.page; RETURN[notFound: FALSE]}
ELSE {
countMax ← MAX[countMax, firstBdy - r.page];
RETURN[notFound: TRUE]}}
ELSE -- second chunk is larger..
{
IF size <= endRegion - firstBdy THEN {
page ← firstBdy; RETURN[notFound: FALSE]}
ELSE {
countMax ← MAX[countMax, endRegion - firstBdy];
RETURN[notFound: TRUE]}};
END;
powerOf2 =>
BEGIN
page ← Inline.BITAND[r.page + (alignment-1), pwr2BdyMask]; --overflow is ok, yields 0.
IF endRegion <= page OR page = 0 THEN RETURN[notFound: TRUE] -- region ends before first boundary..
ELSE --starting page is in region--
{
IF size <= endRegion - page THEN RETURN[notFound: FALSE]
ELSE {
countMax ← MAX[countMax, endRegion - page];
RETURN[notFound: TRUE]}}
END;
none => {
IF size <= r.count THEN {page ← r.page; RETURN[notFound: FALSE]}
ELSE {countMax ← MAX[countMax, r.count]; RETURN[notFound: TRUE]}}
ENDCASE => ERROR Bug[funnyAlignment];
END;
-- ERROR Bug[noCreateDecision]; ++ (generates compiler warning)
END --HoleNotFound-- ;
IF alignType = powerOf2 THEN {
IF alignSize = 0 THEN alignSize ← size;
FOR alignment ← 1, alignment*2 UNTIL alignment >= alignSize DO NULL ENDLOOP;
pwr2BdyMask ← Inline.BITNOT[alignment - 1]};
IF ForAllRegions[
[
spaceDParent.pageRover,
spaceDParent.interval.count -
(spaceDParent.pageRover - spaceDParent.interval.page)], HoleNotFound]
THEN
IF ForAllRegions[
[
spaceDParent.interval.page,
spaceDParent.pageRover - spaceDParent.interval.page], HoleNotFound]
THEN RETURN WITH ERROR InsufficientSpace[available: countMax];
spaceDParent.pageRover ← page + size; -- pageRover=interval.page+interval.count is ok
Hierarchy.Update[@spaceDParent]; -- (update pageRover.)
END --create anywhere-- ;
regionD ← Projection.Get[page]; -- so page IN regionD.interval
ApplyToInterval[regionD.interval, CachedRegion.flush]; -- assure that the Projection is current (and disable client refs while changing).
newSpace ← [SUCC[parent.level], page];
Hierarchy.Insert[newSpace, size];
Projection.Split[page];
Projection.Split[page + size];
Projection.TranslateLevel[pageMember: page, delta: 1];
END;
EnterSpace[CreateAnyInternal];
END;
CreateUniformSwapUnits: PUBLIC --EXTERNAL-- PROCEDURE [
size: PageCount, parent: Handle] =
BEGIN
CreateUniformSwapUnitsInternal: INTERNAL PROCEDURE[] =
BEGIN
spaceDParent: SpaceD;
validSpace, validSwapUnit: BOOLEAN;
[validSpace, validSwapUnit] ← Hierarchy.GetDescriptor[
@spaceDParent, parent];
IF validSwapUnit THEN Error[notApplicableToSwapUnit]
ELSE IF ~validSpace THEN Error[invalidHandle];
IF parent.level < LAST[Level] THEN
IF Hierarchy.FindFirstWithin[
[parent.level + 1, parent.page], spaceDParent.interval.count] ~=
CachedSpace.handleNull THEN Error[spaceNotUnitary]; -- no children allowed.
IF spaceDParent.hasSwapUnits THEN Error[spaceNotUnitary];
IF size = 0 OR ~(size IN CachedSpace.SizeSwapUnit) THEN
Error[invalidParameters];
spaceDParent.hasSwapUnits ← TRUE;
spaceDParent.sizeSwapUnit ← size;
Hierarchy.Update[@spaceDParent];
ApplyToInterval[spaceDParent.interval, CachedRegion.createSwapUnits];
END;
EnterSpace[CreateUniformSwapUnitsInternal];
END;
Deactivate: PUBLIC --EXTERNAL-- SAFE PROCEDURE [space: Handle] = TRUSTED
BEGIN
DeactivateInternal: INTERNAL PROCEDURE[] = {
IF ~ApplyToSpace[space, CachedRegion.deactivate].validHandle THEN
Error[invalidHandle]};
EnterSpace[DeactivateInternal];
END;
Delete: PUBLIC --EXTERNAL-- PROCEDURE [space: Handle] = {
DeleteAny[space, self]};
DeleteAny: --EXTERNAL-- PROCEDURE [space: Handle, which: ChildrenSelf] =
BEGIN
DeleteAnyInternal: INTERNAL PROCEDURE[] =
BEGIN
level, topLevel: Level;
DeleteIfLeaf: INTERNAL PROCEDURE [regionD: RegionD] RETURNS [BOOLEAN] =
-- Implicit parameter: level.
-- Assume level>0 (i.e. space~=virtualMemory)
BEGIN
IF regionD.level = level THEN
-- Region described by regionD corresponds to a leaf space.
BEGIN
leafSpaceD: SpaceD;
mergeLeft, mergeRight: BOOLEAN;
descParent: SpaceD;
intervalParent: Interval;
pageNext: PageNumber = regionD.interval.page + regionD.interval.count;
flushInterval: Interval ← regionD.interval; -- assume no merging
IF ~Hierarchy.GetDescriptor[
@leafSpaceD, [level, regionD.interval.page]].validSpace THEN
ERROR Bug[deleteBadSpace];
[] ← Hierarchy.GetDescriptor[
@descParent, [level - 1, regionD.interval.page]];
intervalParent ← descParent.interval;
IF leafSpaceD.transaction ~= nullTransactionHandle THEN
TransactionState.WithdrawFromTransaction[
leafSpaceD.transaction, Handle[level, regionD.interval.page] !
Transaction.InvalidHandle => CONTINUE];
IF regionD.interval.page > FIRST[PageNumber] THEN -- left neighbor exists.
BEGIN
leftNeighbor: RegionD = Projection.Get[regionD.interval.page - 1];
mergeLeft ←
(regionD.interval.page ~= intervalParent.page
AND leftNeighbor.level < regionD.level);
IF mergeLeft THEN
flushInterval ← [
flushInterval.page - leftNeighbor.interval.count,
flushInterval.count + leftNeighbor.interval.count];
IF descParent.pageRover > regionD.interval.page THEN -- pageRover should be updated.
BEGIN
IF descParent.level = leftNeighbor.level THEN
descParent.pageRover ← MAX[
leftNeighbor.interval.page, intervalParent.page]
ELSE descParent.pageRover ← regionD.interval.page;
Hierarchy.Update[@descParent];
END;
END
ELSE
BEGIN -- no left neighbor.
mergeLeft ← FALSE;
descParent.pageRover ← regionD.interval.page;
Hierarchy.Update[@descParent];
END;
IF pageNext < CachedRegion.pageTop THEN
BEGIN
rightNeighbor: RegionD = Projection.Get[pageNext];
mergeRight ←
(pageNext ~= intervalParent.page + intervalParent.count
AND rightNeighbor.level < regionD.level);
IF mergeRight THEN
flushInterval.count ←
flushInterval.count + rightNeighbor.interval.count;
END
ELSE mergeRight ← FALSE; -- no right neighbor.
IF regionD.state IN CachedRegion.Mapped
AND regionD.levelMapped = regionD.level THEN
-- BEGIN
-- spaceD: SpaceD;
-- [] ← Hierarchy.GetDescriptor[@spaceD, [regionD.level, regionD.interval.page]];
-- spaceD should be equal to leafSpaceD, unnecessary procedure call (GetDescriptor) is commented out.
UnmapInternal[@leafSpaceD];
-- END;
-- make sure Projection is current (and prevent client refs
-- while changing). (Flush this region and any required neighbors.)
ApplyToInterval[flushInterval, CachedRegion.flush];
IF regionD.hasSwapUnits THEN
Projection.DeleteSwapUnits[regionD.interval.page];
Hierarchy.Delete[[regionD.level, regionD.interval.page]];
-- At this point, the properties of the current region must match
-- the properties of any adjacent regions with which it will coalesce.
Projection.TranslateLevel[pageMember: regionD.interval.page, delta: -1];
IF mergeLeft THEN Projection.Merge[regionD.interval.page];
IF mergeRight THEN Projection.Merge[pageNext];
END;
RETURN[TRUE]; -- "keep going"
END;
levelLeaves: Level ← space.level;
MaxLevel: PROCEDURE [regionD: RegionD] RETURNS [BOOLEAN] = {
levelLeaves ← MAX[levelLeaves, regionD.level]; RETURN[TRUE]}; -- "keep going"
validSpace, validSwapUnit: BOOLEAN;
spaceD: SpaceD;
interval: Interval;
[validSpace, validSwapUnit] ← Hierarchy.GetDescriptor[@spaceD, space];
IF validSwapUnit THEN Error[notApplicableToSwapUnit]
ELSE IF ~validSpace THEN Error[invalidHandle];
interval ← spaceD.interval;
IF space.level <= handleMDS.level
AND handleMDS.page IN [interval.page..interval.page + interval.count) THEN
Error[invalidParameters]; -- don't delete the MDS!
[] ← ForAllRegions[interval, MaxLevel]; -- levelLeaves ← max region level, region in interval
topLevel ←
IF which = children THEN space.level + 1 --delete only children--
ELSE space.level --delete children and self-- ;
FOR level DECREASING IN [topLevel..levelLeaves] DO
[] ← ForAllRegions[interval, DeleteIfLeaf]; ENDLOOP;
IF which = children THEN -- delete uniform swap units of self:
BEGIN
ApplyToInterval[interval, CachedRegion.flush];
Projection.DeleteSwapUnits[interval.page];
spaceD.hasSwapUnits ← FALSE;
Hierarchy.Update[@spaceD];
END;
END;
EnterSpace[DeleteAnyInternal];
END;
DeleteSwapUnits: PUBLIC --EXTERNAL-- PROCEDURE [space: Handle] = {
DeleteAny[space, children]};
ForceOut: PUBLIC --EXTERNAL-- PROCEDURE [space: Handle] =
BEGIN
ForceOutInternal: INTERNAL PROCEDURE[] = {
IF ~ApplyToSpace[space, CachedRegion.startForceOut].validHandle THEN
Error[invalidHandle];
[] ← ApplyToSpace[space, CachedRegion.wait]};
EnterSpace[ForceOutInternal];
END;
GetAttributes: PUBLIC --EXTERNAL-- SAFE PROCEDURE [space: Handle]
RETURNS [
parent, lowestChild, nextSibling: Handle, base: PageOffset, size: PageCount,
mapped: BOOLEAN] = TRUSTED
BEGIN
GetAttributesInternal: INTERNAL PROCEDURE[] =
BEGIN
spaceD: CachedSpace.Desc;
validSpace, validSwapUnit: BOOLEAN;
interval: Interval;
[validSpace, validSwapUnit, interval] ← Hierarchy.GetInterval[space];
IF ~(validSpace OR validSwapUnit) THEN Error[invalidHandle];
IF space.level = 0 THEN {parent ← nextSibling ← nullHandle; base ← 0}
ELSE
BEGIN
intervalParent: Interval = Hierarchy.GetInterval[
[space.level - 1, interval.page]].interval;
pageNext: PageNumber = interval.page + interval.count;
countNext: PageCount =
intervalParent.page + intervalParent.count - pageNext;
parent ← [space.level - 1, intervalParent.page];
nextSibling ←
IF validSwapUnit THEN
IF pageNext < intervalParent.page + intervalParent.count THEN [
space.level, pageNext] -- next swap unit
ELSE nullHandle
ELSE --validSpace-- Hierarchy.FindFirstWithin[
[space.level, pageNext], countNext];
base ← interval.page - intervalParent.page;
END;
[] ← Hierarchy.GetDescriptor[@spaceD, space]; -- (gets desc of parent space if this is a swap unit handle)
lowestChild ←
IF validSwapUnit THEN nullHandle
ELSE --validSpace--
IF spaceD.hasSwapUnits THEN [space.level + 1, space.page] -- first swap unit
ELSE --~hasSwapUnits--
IF space.level < LAST[Level] THEN Hierarchy.FindFirstWithin[
[space.level + 1, space.page], interval.count]
ELSE --handle.level=LAST[Level]-- nullHandle;
size ← interval.count;
mapped ← IF validSwapUnit THEN FALSE ELSE spaceD.state = mapped;
END;
EnterSpace[GetAttributesInternal];
END;
GetHandle: PUBLIC --EXTERNAL-- SAFE PROCEDURE [page: PageNumber]
RETURNS [space: Handle] = TRUSTED
BEGIN
GetHandleInternal: INTERNAL PROCEDURE[] =
BEGIN
regionD: CachedRegion.Desc;
handleLevel: CARDINAL; -- (not a CachedSpace.Level, since a swap unit may have handle.level = LAST[Level]+1)
IF page >= countVM THEN Error[invalidParameters];
regionD ← Projection.Get[page]; -- (gets level of parent space if swap units)
handleLevel ← regionD.level + (IF regionD.hasSwapUnits THEN 1 ELSE 0);
space ← [
handleLevel, Hierarchy.GetInterval[[handleLevel, page]].interval.page];
END;
EnterSpace[GetHandleInternal];
END;
GetWindow: PUBLIC --EXTERNAL-- SAFE PROCEDURE [space: Handle]
RETURNS [window: WindowOrigin] = TRUSTED
BEGIN
GetWindowInternal: INTERNAL PROCEDURE[] =
BEGIN
mappingSpaceD: SpaceD;
regionD: RegionD;
validSpace, validSwapUnit: BOOLEAN;
[validSpace, validSwapUnit] ← Hierarchy.GetDescriptor[@mappingSpaceD, space];
IF ~validSpace AND ~validSwapUnit THEN Error[invalidHandle];
regionD ← Projection.Get[space.page]; -- works even if swap units
IF ~(regionD.state IN CachedRegion.Mapped) THEN Error[noWindow];
IF regionD.levelMapped ~= space.level THEN
[] ← Hierarchy.GetDescriptor[
@mappingSpaceD, Handle[level: regionD.levelMapped, page: space.page]];
window ←
IF mappingSpaceD.dataOrFile = data THEN defaultWindow
ELSE [
[
mappingSpaceD.window.file.fID,
IF mappingSpaceD.writeProtected THEN File.read ELSE File.read + File.write],
mappingSpaceD.window.base+space.page-mappingSpaceD.interval.page];
END;
EnterSpace[GetWindowInternal];
END;
Kill: PUBLIC --EXTERNAL-- PROCEDURE [space: Handle] =
BEGIN
KillInternal: INTERNAL PROCEDURE[] =
BEGIN
validSpace, validSwapUnit: BOOLEAN;
interval: Interval;
[validSpace, validSwapUnit, interval] ← Hierarchy.GetInterval[space];
IF ~validSpace AND ~validSwapUnit THEN Error[invalidHandle];
ApplyToInterval[interval, CachedRegion.kill];
END;
EnterSpace[KillInternal];
END;
LongPointer: PUBLIC --EXTERNAL-- SAFE PROCEDURE [space: Handle]
RETURNS [pointer: LONG POINTER] = TRUSTED
BEGIN
LongPointerInternal: INTERNAL PROCEDURE[] = {
IF ~Hierarchy.ValidSpaceOrSwapUnit[space] THEN Error[invalidHandle];
pointer ← LongPointerFromPage[space.page]};
EnterSpace[LongPointerInternal];
END;
LongPointerFromPage: PUBLIC --EXTERNAL-- SAFE PROCEDURE [page: PageNumber]
RETURNS [LONG POINTER] = TRUSTED {
RETURN[LOOPHOLE[Inline.LongMult[page, Environment.wordsPerPage]]]};
PageFromLongPointer: PUBLIC --EXTERNAL-- SAFE PROCEDURE [lp: LONG POINTER]
RETURNS [page: PageNumber] = TRUSTED {
OPEN LOOPHOLE[lp, num Environment.Long];
IF lp = NIL THEN ERROR Error[invalidParameters]
ELSE RETURN[highbits*256 + lowbits/256]};
Pointer: PUBLIC --EXTERNAL-- SAFE PROCEDURE [space: Handle]
RETURNS [pointer: POINTER] = TRUSTED
BEGIN
PointerInternal: INTERNAL PROCEDURE[] =
BEGIN
IF ~Hierarchy.ValidSpaceOrSwapUnit[space] THEN Error[invalidHandle];
IF space.level <= handleMDS.level
OR ~(space.page IN [intervalMDS.page..intervalMDS.page + intervalMDS.count))
THEN Error[invalidParameters];
pointer ← LOOPHOLE[(space.page - intervalMDS.page)*wordsPerPage];
END;
EnterSpace[PointerInternal];
END;
VMPageNumber: PUBLIC --EXTERNAL-- SAFE PROCEDURE [space: Handle]
RETURNS [page: PageNumber] = TRUSTED
BEGIN
VMPageNumberInternal: INTERNAL PROCEDURE[] = {
IF ~Hierarchy.ValidSpaceOrSwapUnit[space] THEN Error[invalidHandle];
page ← space.page};
EnterSpace[VMPageNumberInternal];
END;
--~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- The Only VMMgr ENTRY Procedure:
--~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--SpaceImplInternal.--
EnterSpace: PUBLIC --EXTERNAL-- PROCEDURE [internalProc: PROCEDURE[]] =
-- Enters the Space monitor and calls internalProc. internalProc may freely
-- signal or not catch signals from below (but should catch UNWIND from
-- EnterSpace if appropriate).
-- All client processes which wish to enter the Space Monitor MUST enter
-- via this procedure.
-- This procedure, internalProc, and all procedures that all internalProc's
-- call must be Cached Descriptor.
-- In order to avoid being deadlocked on a stateVector, we must transiently
-- change the caller's priority to a reserved level and have a state vector
-- allocated for it (in the bootmesa file). The order of operations is
-- critical and non-intuitively different for entering and leaving. On
-- entering, the priority must be changed after we begin executing
-- CachedDescriptor code (so the VMHelper can swap us in if necessary)
-- and after we have entered the Space monitor (so only one process can
-- claim the reserved state vector), and before we Wait on CONDITION or
-- attempt to enter any lower-level monitor (note that Process.SetPriority
-- is not a monitor entry!). On leaving, the priority must be changed after
-- we have exited the Space monitor (since Process.SetPriority may voluntarily
-- give up our state vector which some other process could snarf up by page
-- faulting), and while we are still standing on cached descriptor code (so
-- the VMHelper can swap us in if necessary).
BEGIN
EnterSpaceEntry: ENTRY PROCEDURE [internalProc: PROCEDURE[]] = INLINE
BEGIN
SignalType: TYPE = {
fileError, fileUnknown, spaceError, spaceInsufficientSpace,
transactionInvalidHandle, volumeUnknown, volumeInsufficientSpace};
signalType: SignalType;
unknownFile: File.Capability;
fileErrorType: File.ErrorType;
spaceAvailable: Space.PageCount;
spaceErrorType: Space.ErrorType;
unknownVolume: Volume.ID;
Process.SetPriority[ProcessPriorities.priorityPageFaultLow]; -- SetPriority is *not* a monitor entry.
--scope of SomeError--
BEGIN
internalProc[
!
File.Error --[type]-- => {
fileErrorType ← type; signalType ← fileError; GO TO SomeError};
File.Unknown --[file]-- => {
unknownFile ← file; signalType ← fileUnknown; GO TO SomeError};
--Space.--
Error --[type]-- => {
spaceErrorType ← type; signalType ← spaceError; GO TO SomeError};
--Space.--
InsufficientSpace --[available]-- => {
spaceAvailable ← available;
signalType ← spaceInsufficientSpace;
GO TO SomeError};
Transaction.InvalidHandle => {
signalType ← transactionInvalidHandle; GO TO SomeError};
Volume.Unknown --[volume]-- => {
unknownVolume ← volume; signalType ← volumeUnknown; GO TO SomeError};
Volume.InsufficientSpace => {
signalType ← volumeInsufficientSpace; GO TO SomeError}];
EXITS
SomeError =>
BEGIN
Process.SetPriority[priorityPrev];
SELECT signalType FROM
fileError => RETURN WITH ERROR File.Error[fileErrorType];
fileUnknown => RETURN WITH ERROR File.Unknown[unknownFile];
spaceError => RETURN WITH ERROR --Space.-- Error[spaceErrorType];
spaceInsufficientSpace =>
RETURN WITH ERROR --Space.-- InsufficientSpace[spaceAvailable];
transactionInvalidHandle =>
RETURN WITH ERROR Transaction.InvalidHandle;
volumeUnknown => RETURN WITH ERROR Volume.Unknown[unknownVolume];
volumeInsufficientSpace => RETURN WITH ERROR Volume.InsufficientSpace;
ENDCASE => Bug[funnySignal];
END;
END; --scope of SomeError--
END; --EnterSpaceEntry--
priorityPrev: Process.Priority = Process.GetPriority[];
EnterSpaceEntry[internalProc]; -- (priority changed inside.)
Process.SetPriority[priorityPrev]; -- now that we've exited the monitor.
END; --EnterSpace--
--~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Monitor internal procedures:
--~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--SpaceImplInternal.--
NotePinned: PUBLIC SIGNAL [levelMax: Level, page: PageNumber] = CODE;
--SpaceImplInternal.--
ApplyToInterval: PUBLIC INTERNAL PROCEDURE [
interval: Interval, operation: CachedRegion.Operation] =
-- Performs, in ascending order, operation (successfully) for each
-- swap unit of each region of interval (exactly as required by CachedRegion.Apply).
-- May raise NotePinned (only if operation.action=unmap).
-- for operation=writeProtect, flush, remap, and unmap, interval must
-- start and end on a region boundary! (restriction of CachedRegion.Apply)
BEGIN
page, pageNext: PageNumber;
outcome: CachedRegion.Outcome;
FOR page ← interval.page, pageNext WHILE page < interval.page + interval.count
DO -- for each swap unit in interval..
DO --REPEAT operation UNTIL outcome=ok or notePinned--
[outcome, pageNext] ← CachedRegion.Apply[page, operation];
WITH outcome SELECT FROM
ok => EXIT;
notePinned -- [levelMax] -- =>
BEGIN SIGNAL NotePinned[levelMax, page]; EXIT END;
regionDMissing => Projection.Touch[page];
regionDDirty => Projection.ForceOut[page];
retry => NULL; -- go around again
spaceDMissing -- [level] -- => Hierarchy.Touch[[level, page]];
-- error -- ENDCASE => ERROR Bug[funnyOutcome];
ENDLOOP;
ENDLOOP;
END;
--SpaceImplInternal.--
ApplyToSpace: PUBLIC INTERNAL PROCEDURE [
handle: Handle, operation: CachedRegion.Operation]
RETURNS [validHandle: BOOLEAN] =
BEGIN
validSpace, validSwapUnit: BOOLEAN;
interval: Interval;
[validSpace, validSwapUnit, interval] ← Hierarchy.GetInterval[handle];
validHandle ← validSpace OR validSwapUnit;
IF validHandle THEN ApplyToInterval[interval, operation];
END;
--SpaceImplInternal.--
ForAllRegions: PUBLIC INTERNAL PROCEDURE [
interval: Interval, Predicate: PROCEDURE [RegionD] RETURNS [true: BOOLEAN]]
RETURNS [BOOLEAN] =
-- Returns as soon as Predicate returns FALSE.
BEGIN
page: PageNumber;
regionD: RegionD;
FOR page ← interval.page, regionD.interval.page + regionD.interval.count WHILE
page < interval.page + interval.count DO
regionD ← Projection.Get[page];
IF ~Predicate[regionD] THEN RETURN[FALSE]
ENDLOOP;
RETURN[TRUE]
END;
END.
LOG
(For earlier log entries see Pilot 3.0 archive version.)
January 25, 1980 1:50 PM Knutsen Use new ErrorType's.
January 28, 1980 10:54 AM Forrest Action: Made SpaceImpl take starting parameters and
eliminated InitSpace; copied in (most) of LongPtr<=>Page from UtilitiesImpl.
February 25, 1980 6:04 PM Knutsen AR3594: CreateUSU[spaceWithSU] raised wrong signal.
AR1935: use Projection.DeleteSwapUnits. Renumbered the Internal errors.
April 16, 1980 10:09 AM Knutsen Remap must always wait for operation complete to avoid
having the file deleted out from under the swapping operation.
DeleteIfLeaf must avoid walking off the ends of VM. Converted
SpaceImpl[] into InitializeSpace[] AGAIN!
April 17, 1980 1:03 PM Gobbel Added transaction handles.
April 21, 1980 6:01 PM Gobbel Implemented Space.Copy.
May 19, 1980 5:42 PM Gobbel FrameOps=>Frame, ControlDefs => PrincOps.
May 21, 1980 2:31 PM Gobbel Mesa 6 change: f.code.longbase replaced by RuntimeInternal.CodeBase[frame]
in SpaceForCode.
June 16, 1980 5:12 PM Gobbel Transaction operations added.
June 19, 1980 2:27 PM Gobbel Created SpaceImplA from parts of old SpaceImpl.
August 7, 1980 1:06 PM Knutsen Moved initialization relevant to SpaceImplB to there. Moved
ApplyToInterval, etc. here. GetWindow returns current
writeProtected-ness. Implement MakeGlobalFrame*, MakeProcedure*, etc.
September 8, 1980 4:14 PM Knutsen Delete now does WithdrawFromTransaction.
September 11, 1980 1:15 PM Gobbel Imported TransactionState.
October 10, 1980 9:09 PM Fay Fixed DeleteIfLeaf to correctly recognize a leaf space
with no right neighbor.
January 23, 1981 9:54 AM Knutsen Implemented CreateAligned. Fixed MakeProcedure*. Process priority.
January 27, 1981 1:47 PM Knutsen Use EnterSpace (moved here). Helper moved to SpaceImplB.
January 30, 1981 11:25 AM Knutsen Code[] wrongly thought startPC was a byte PC.
February 13, 1981 12:24 PM Knutsen EnterSpace must release lock before resetting priority.
February 18, 1981 12:20 PM Knutsen Pass countVM to InitializeSpaceImplB.
March 4, 1981 11:08 AM Yokota Added four procedures defined in SpaceExtras - Activate(Deactivate)Proc(SwapUnit).
March 9, 1981 11:31 AM Yokota pageRover in the parent space descriptor is updated for a child space deletion.
4-Feb-82 13:17:13 Levin Fix bug in CreateAny in alignment logic for powerOf2.
16-Feb-82 17:44:12 Levin Fix Code[] to handle nested procedures properly. Also
fix MakeGlobalFrame{Resident|Swappable} to ignore frames
allocated in the frame heap.
June 4, 1982 9:56 am Levin Fix another bug in CreateAny in alignment logic for powerOf2
August 26, 1982 11:15 am Levin Make things SAFE.
August 26, 1982 3:55 pm Levin Add alignSize logic to CreateAny; exploit in CreateAligned.
October 26, 1982 9:44 am Levin Change GetWindow to work reasonably on subspaces of mapped spaces.