-- 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.