-- Transport Mechanism Filestore - heap file management --

-- [Indigo]<Grapevine>MS>HeapFile.mesa
-- Stolen back from [Idun]<WServices>MS>StableStorageImpl.mesa

-- Andrew Birrell	25-Oct-82 10:36:48
-- Randy Gobbel		29-Jun-82 16:38:42
-- Mark Johnson		19-May-81 13:30:37

DIRECTORY
  BitMapDefs USING [Clear, Map, MapIndex, Set, Test],
  HeapFileDefs USING [],
  Inline USING [COPY, LowHalf],
  PolicyDefs USING [AmountOfFreeHeap, GapExists],
  Process USING [DisableTimeout],
  VMDefs USING [FileHandle, FullAddress, MarkStartWait, Page, PageAddress,
    PageIndex, PageNumber, pageSize, Release, UsePage];

HeapFile: MONITOR
  IMPORTS BitMapDefs, Inline, PolicyDefs, Process, VMDefs EXPORTS HeapFileDefs =
BEGIN

segmentSize: CARDINAL = 6;  -- number of pages in a segment
headerSize: CARDINAL = SIZE[LONG INTEGER] + SIZE[SegmentIndex];
segmentsPerPage: CARDINAL =
  VMDefs.pageSize/SIZE[SegmentIndex] - headerSize;
SegmentIndex: TYPE = CARDINAL;
noSegment: SegmentIndex = LAST[SegmentIndex];

-- the 'written' chain is stored permanently on disk --
ChainBlock: TYPE = MACHINE DEPENDENT RECORD [
  vp(0): SELECT OVERLAID * FROM
    sh => [header(0): ARRAY [0..0) OF SerialAndHead],
    chain =>
      [next(0): ARRAY SegmentIndex [0..0) OF SegmentIndex],
    ENDCASE];

SerialAndHead: TYPE = MACHINE DEPENDENT RECORD [
  serialNumber(0): LONG INTEGER,
  chainHead(2): SegmentIndex,
    -- head of written chain, unused on all pages but first of chain file
  fill(3): ARRAY [0..segmentsPerPage) OF UNSPECIFIED];

ClientObject: TYPE = RECORD [
  chainHandle: VMDefs.FileHandle _ NIL,
  chain: POINTER TO ChainBlock _ NIL,
  lastWritten: SegmentIndex _ 0,  -- last segment allocated for a writer
  lastChained: SegmentIndex _ 0,  -- last segment chained onto chain.written
  lastPage: VMDefs.PageAddress _ NULL,  -- last page used in chain.written
  freeCount: CARDINAL _ 0,  -- number of free segments
  freeMap: BitMapDefs.Map, -- free segment bitmap
  segmentCeiling: CARDINAL _ 0, -- size of segment bitmap - 1
  
  handle: VMDefs.FileHandle _ NIL,
  segmentCount: CARDINAL _ 0,  -- number of segments
  -- synchronisation for single-page writers - beware!
  claimedPage: VMDefs.PageAddress _ NULL,
  claimed: BOOLEAN _ FALSE,
  unwrittenAllocation: BOOLEAN _ FALSE];

client: ClientObject;
notClaimed: CONDITION;
segmentBecomesFree: CONDITION;

Address: PROCEDURE [of: SegmentIndex] 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]
  RETURNS [new: SegmentIndex] =
  BEGIN OPEN client;
  -- find 'nearest' free segment;
  -- assumes (and checks) that bitmap entries for header words are "set".
  high: BitMapDefs.MapIndex _ near;
  low: BitMapDefs.MapIndex _ near;
  IF freeCount = 0 THEN ERROR;
  DO high _ MIN[high+1, segmentCeiling];
     IF ~BitMapDefs.Test[freeMap, high] THEN {new _ high; EXIT};
     IF ~BitMapDefs.Test[freeMap, low] THEN {new _ low; EXIT};
     low _ MAX[low,1] - 1;
  ENDLOOP;
  IF new MOD VMDefs.pageSize IN [0..headerSize) THEN ERROR;
  BitMapDefs.Set[freeMap, new];
  freeCount _ freeCount - 1;
  NotifyFreeCount[];
  END;

RecordAllocation: PROCEDURE [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);
  diskCopy: POINTER TO SerialAndHead =
    LOOPHOLE[VMDefs.UsePage[[chainHandle, chainPage]]];
  chain.header[page].serialNumber _ chain.header[page].serialNumber + 1;
  Inline.COPY[from: @chain.header[page], to: diskCopy,
    nwords: MIN[1+segmentCeiling-page*VMDefs.pageSize, VMDefs.pageSize] ];
  VMDefs.MarkStartWait[LOOPHOLE[diskCopy]];
  VMDefs.Release[LOOPHOLE[diskCopy]];
  END;

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

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

NoMorePages: PUBLIC ERROR = CODE;

NextPage: PUBLIC ENTRY PROCEDURE [given: VMDefs.FullAddress]
  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]]]
      ELSE ERROR UnexpectedChaining[];
      END;
  END;


-- Writer page allocation --

LastPageWrong: ERROR = CODE;

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

UnexpectedChaining: ERROR = CODE;

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

InnerNextWriterPage: INTERNAL PROCEDURE [given: VMDefs.FullAddress]
  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];
      chain.next[lastWritten] _ noSegment;
      IF lastWritten / VMDefs.pageSize # current / VMDefs.pageSize
      THEN RecordAllocation[lastWritten];
      chain.next[current] _ lastWritten;
      RecordAllocation[current];
      new _ Address[lastWritten];
      END;
    END;
  IF new.page.page = lastPage.page THEN ERROR LastPageWrong[];
  END;

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

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

CheckForUnwrittenAllocation: INTERNAL PROCEDURE = 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 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]].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 =
  BEGIN OPEN client;
  IF claimedPage.page MOD segmentSize = 0 THEN  -- claimedPage was chained onto lastChained --
    BEGIN
    lastChained _ Segment[claimedPage.page];
    RecordAllocation[lastChained];
    END;
  lastPage _ claimedPage;
  claimed _ FALSE;
  unwrittenAllocation _ FALSE;
  BROADCAST notClaimed;
  END;


-- management of the free list --

SegmentCorrupt: ERROR = CODE; 

FreeSegment: PUBLIC ENTRY PROCEDURE [from, to: VMDefs.FullAddress] =
  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];
      IF head > LAST[SegmentIndex] THEN ERROR SegmentCorrupt;
      END;
      ENDLOOP;
    CheckForUnwrittenAllocation[];  -- single-page writers --
    RecordAllocation[ptr];
    BROADCAST segmentBecomesFree;
    END;
  END;

AddToFreeList: PROCEDURE [old: SegmentIndex] =
  BEGIN OPEN client;
  BitMapDefs.Clear[freeMap, old];
  freeCount _ freeCount + 1;
  NotifyFreeCount[];
  END;

NotifyFreeCount: PROC =
  { OPEN client;
    PolicyDefs.AmountOfFreeHeap[
     Inline.LowHalf[(LONG[freeCount]*100 + segmentCount/2)/segmentCount]] };

Process.DisableTimeout[@segmentBecomesFree];
Process.DisableTimeout[@notClaimed];

END.