-- Transport Mechanism Filestore - heap file management --

-- [Idun]<WServices>MS>StableStorageImpl.mesa

-- Andrew Birrell	10-Jun-81 10:18:09
-- Randy Gobbel		29-Jun-82 16:38:42
-- Mark Johnson		19-May-81 13:30:37

DIRECTORY
  Bitmap USING [Clear, MapIndex, Set, Test],
  Inline USING [LowHalf],
  ObjectDir,
  ObjectDirInternal,
  Policy USING [AmountOfFreeHeap, GapExists],
  Process USING [DisableTimeout],
  StableStorage,
  VMDefs USING [FileHandle, FullAddress, MarkStartWait, Page, PageAddress,
    PageIndex, PageNumber, pageSize, RemapPage];

StableStorageImpl: MONITOR
  IMPORTS Bitmap, Inline, Policy, Process, VMDefs EXPORTS ObjectDir--.Client--,
    StableStorage =
BEGIN OPEN ObjectDirInternal, StableStorage;

Client: TYPE = ObjectDirInternal.Client;
ClientObject: PUBLIC TYPE = ObjectDirInternal.ClientObject;

notClaimed: CONDITION;
segmentBecomesFree: CONDITION;

 -- Variables for use in debugger
 debugClient: Client;
 debugSeg: SegmentIndex;
 debugPage: VMDefs.PageNumber;

Address: PROCEDURE [of: SegmentIndex, client: Client] RETURNS [VMDefs.FullAddress] =
  BEGIN OPEN client;
  RETURN[[
    page: [
      file: handle,
      page: (of - ((of+VMDefs.pageSize)/VMDefs.pageSize)*headerSize)*segmentSize],
    word: FIRST[VMDefs.PageIndex]]];
  END;

Segment: PROCEDURE [page: VMDefs.PageNumber]
  RETURNS [seg: SegmentIndex] =
  {segmentOrdinal: CARDINAL = Inline.LowHalf[page / segmentSize];
  seg _
    segmentOrdinal +
    ((segmentOrdinal+segmentsPerPage)/segmentsPerPage)*headerSize};

FindSegment: INTERNAL PROCEDURE [near: SegmentIndex, client: Client]
  RETURNS [new: SegmentIndex] =
  BEGIN OPEN client;
  -- find 'nearest' free segment;
  high: Bitmap.MapIndex _ MIN[
    near+(IF near+1 MOD VMDefs.pageSize = 0 THEN headerSize ELSE 1),
    segmentCeiling];
  low: Bitmap.MapIndex _
    (IF near > headerSize+1 THEN
      near - (IF (near-headerSize) MOD VMDefs.pageSize = 0 THEN headerSize+1 ELSE 1)
    ELSE headerSize+1);
  DO
    IF ~Bitmap.Test[freeMap, high] THEN {new _ high; EXIT};
    IF ~Bitmap.Test[freeMap, low] THEN {new _ low; EXIT};
    high _ MIN[
      high + (IF high+1 MOD VMDefs.pageSize = 0 THEN headerSize ELSE 1),
      segmentCeiling];
    low _
      (IF low > headerSize+1 THEN
        low -
	  (IF (low-headerSize) MOD VMDefs.pageSize = 0 THEN headerSize+1 ELSE 1)
      ELSE headerSize+1);
    ENDLOOP;
  Bitmap.Set[freeMap, new];
  freeCount _ freeCount - 1;
  Policy.AmountOfFreeHeap[(freeCount*100 + segmentCount/2)/segmentCount];
  END;

RecordAllocation: INTERNAL PROCEDURE [client: Client, seg: SegmentIndex] =
  BEGIN OPEN client;
  page: CARDINAL = seg/VMDefs.pageSize;
  chainPage: VMDefs.PageNumber =
    page*2 + (IF chain.header[page].serialNumber MOD 2 = 0 THEN 0 ELSE 1);
  chain.header[page].serialNumber _ chain.header[page].serialNumber + 1;
  VMDefs.RemapPage[
    LOOPHOLE[@chain.header[page], VMDefs.Page],
    [chainHandle, chainPage]];
  VMDefs.MarkStartWait[LOOPHOLE[@chain.header[page], VMDefs.Page]];
  END;

FirstSegment: PUBLIC ENTRY PROCEDURE [client: Client]
  RETURNS [VMDefs.FullAddress] =
  BEGIN RETURN[Address[client.chain.header[0].chainHead, client]] END;

InsertFirstSegment: PUBLIC ENTRY PROCEDURE [client: Client]
  RETURNS [VMDefs.FullAddress] =
  BEGIN OPEN client;
  new: SegmentIndex = FindSegment[chain.header[0].chainHead, client];
  chain.next[new] _ chain.header[0].chainHead;
  RecordAllocation[client, new];
  chain.header[0].chainHead _ new;
  RecordAllocation[client, 0];
  RETURN[Address[new, client]];
  END;

NoMorePages: PUBLIC ERROR = CODE;

NextPage: PUBLIC ENTRY PROCEDURE [given: VMDefs.FullAddress, client: Client]
  RETURNS [VMDefs.FullAddress] =
  BEGIN OPEN client;
  ENABLE UNWIND => NULL;
  IF given.page.page = lastPage.page THEN ERROR NoMorePages[]
  ELSE
    IF given.page.page MOD segmentSize < segmentSize - 1 THEN
      BEGIN
      given.page.page _ given.page.page + 1;
      given.word _ FIRST[VMDefs.PageIndex];
      RETURN[given]
      END
    ELSE
      BEGIN
      seg: SegmentIndex = Segment[given.page.page];
      IF chain.next[seg] # noSegment THEN RETURN[Address[chain.next[seg], client]]
      ELSE ERROR UnexpectedChaining[];
      END;
  END;


-- Writer page allocation --

LastPageWrong: ERROR = CODE;

NewWriterPage: PUBLIC ENTRY PROCEDURE [client: Client]
  RETURNS [new: VMDefs.FullAddress] =
  BEGIN OPEN client;  -- see comment beside 'FreeSegment' --
  UNTIL freeCount >= 2 DO WAIT segmentBecomesFree ENDLOOP;
  lastWritten _ FindSegment[lastWritten, client];
  chain.next[lastWritten] _ noSegment;
  new _ Address[lastWritten, client];
  IF new.page.page = lastPage.page THEN ERROR LastPageWrong[];
  END;

UnexpectedChaining: ERROR = CODE;

NextWriterPage: PUBLIC ENTRY PROCEDURE [given: VMDefs.FullAddress, client: Client]
  RETURNS [new: VMDefs.FullAddress] = {new _ InnerNextWriterPage[given, client]};

InnerNextWriterPage: INTERNAL PROCEDURE [given: VMDefs.FullAddress, client: Client]
  RETURNS [new: VMDefs.FullAddress] =
  BEGIN OPEN client;
  ENABLE UNWIND => NULL;
  IF given.page.page MOD segmentSize < segmentSize - 1 THEN
    BEGIN
    given.page.page _ given.page.page + 1;
    given.word _ FIRST[VMDefs.PageIndex];
    new _ given;
    END
  ELSE
    BEGIN
    current: SegmentIndex = Segment[given.page.page];
    IF chain.next[current] # noSegment THEN ERROR UnexpectedChaining[]
    ELSE
      BEGIN  -- see comment beside 'FreeSegment' --
      UNTIL freeCount >= 2 DO WAIT segmentBecomesFree ENDLOOP;
      lastWritten _ FindSegment[current, client];
      chain.next[lastWritten] _ noSegment;
      chain.next[current] _ lastWritten;
      RecordAllocation[client, current];
      new _ Address[lastWritten, client];
      END;
    END;
  IF new.page.page = lastPage.page THEN ERROR LastPageWrong[];
  END;

CommitObject: PUBLIC ENTRY PROCEDURE
  [start, end: VMDefs.PageAddress, client: Client] =
  BEGIN OPEN client;
  CheckForUnwrittenAllocation[client];  --beware of single-page writers--
  chain.next[lastChained] _ Segment[start.page];
  RecordAllocation[client, lastChained];
  lastChained _ Segment[end.page];
  lastPage _ end;
  Policy.GapExists[];
  END;

ObjectAbandoned: PUBLIC ENTRY PROCEDURE
  [start: VMDefs.PageAddress, client: Client] =
  BEGIN OPEN client;
  head: SegmentIndex _ Segment[start.page];
  WHILE head # noSegment DO
    BEGIN
    old: SegmentIndex = head;
    head _ chain.next[head];
    AddToFreeList[old, client];
    END;
    ENDLOOP;
  BROADCAST segmentBecomesFree;
  END;

CheckForUnwrittenAllocation: INTERNAL PROCEDURE [client: Client] = INLINE
  BEGIN OPEN client;
  -- wait if single-page writer hasn't put its data into the single page --
  WHILE unwrittenAllocation DO WAIT notClaimed ENDLOOP;
  END;

ClaimSinglePage: PUBLIC ENTRY PROCEDURE [client: Client]
  RETURNS [next: VMDefs.PageAddress] =
  BEGIN OPEN client;
  -- single-page writer wants a single page --
  WHILE claimed DO WAIT notClaimed ENDLOOP;
  claimed _ TRUE;
  next _ claimedPage _ InnerNextWriterPage[[page: lastPage, word: 0], client].page;
  -- don't set "unwrittenAllocation" before here, to avoid deadlock with
  -- compactor if InnerNextWriterPage needs to wait to allocate a page
  unwrittenAllocation _ TRUE;
  END;

CommitedSinglePage: PUBLIC ENTRY PROCEDURE [client: Client] =
  BEGIN OPEN client;
  IF claimedPage.page MOD segmentSize = 0 THEN  -- claimedPage was chained onto lastChained --
    BEGIN
    lastChained _ Segment[claimedPage.page];
    RecordAllocation[client, lastChained];
    END;
  lastPage _ claimedPage;
  claimed _ FALSE;
  unwrittenAllocation _ FALSE;
  BROADCAST notClaimed;
  END;


-- management of the free list --

FreeSegment: PUBLIC ENTRY PROCEDURE
  [from, to: VMDefs.FullAddress, client: Client] =
  BEGIN OPEN client;
  -- For the correctness of the compactor, it is necessary that its
  -- reading and writing pointers should always be on separate pages. 
  -- This would imply that we can free a segment if 'from' and 'to' would
  -- be separated by at least a page after removal of the segment. 
  -- However, if at the end of a cycle of the compactor there is a gap of
  -- less than one segment between the reading and writing pointers, and
  -- there is only one segment on the free list, and the writer is waiting
  -- for a segment (the writer can never use the last free segment, since
  -- this would stop the next cycle of the compactor starting), then it is
  -- possible that at the end of the next cycle of the compactor no
  -- segment would have been placed in the free list and so neither the
  -- compactor nor the writer could ever run again.  Accordingly, we must
  -- ensure that the reading and writing pointers are always at least one
  -- segment apart. Note that under such circumstances, the writer might
  -- wait for a long time for a segment to become available for it. --
  fromSegment: SegmentIndex = Segment[from.page.page];
  toSegment: SegmentIndex = Segment[to.page.page];
  IF fromSegment # toSegment AND chain.next[fromSegment] # toSegment THEN
    BEGIN
    ptr: SegmentIndex =
      IF from.page.page MOD segmentSize < to.page.page MOD segmentSize
      OR
        (from.page.page MOD segmentSize = to.page.page MOD segmentSize
          AND from.word <= to.word) THEN fromSegment
      ELSE chain.next[fromSegment];
    head: SegmentIndex _ chain.next[ptr];
    chain.next[ptr] _ toSegment;
    WHILE head # toSegment DO
      BEGIN
      old: SegmentIndex = head;
      head _ chain.next[head];
      AddToFreeList[old, client];
      IF head > LAST[SegmentIndex] THEN
        BEGIN SegmentCorrupt: ERROR = CODE; ERROR SegmentCorrupt END;
      END;
      ENDLOOP;
    CheckForUnwrittenAllocation[client];  -- single-page writers --
    RecordAllocation[client, ptr];
    BROADCAST segmentBecomesFree;
    END;
  END;

AddToFreeList: PROCEDURE [old: SegmentIndex, client: Client] =
  BEGIN OPEN client;
  Bitmap.Clear[freeMap, old];
  freeCount _ freeCount + 1;
  Policy.AmountOfFreeHeap[(freeCount*100 + segmentCount/2)/segmentCount];
  END;


Process.DisableTimeout[@segmentBecomesFree];
Process.DisableTimeout[@notClaimed];
debugClient _ NIL; debugSeg _ noSegment; debugPage _ 0;

END.