-- FileCacheImpl.mesa (last edited by: Luniewski on: February 6, 1981  10:13 AM)
-- Last Edited by: Levin, December 8, 1982 9:45 pm
-- Last Edited by: Paul Rovner, February 16, 1983 2:53 pm

DIRECTORY
  Environment USING [Base, wordsPerPage],
  File USING [ID, nullID, PageNumber],
  FileCache USING [PinnedAction],
  FileInternal USING [Descriptor, FilePtr, PageGroup, ReadOnlyFilePtr],
  FilerPrograms USING [],
  Process USING [DisableAborts],
  ResidentHeap USING [first64K, MakeNode],
  SystemInternal USING [UniversalID],
  Volume USING [ID],
  Zone USING [nil];

FileCacheImpl: MONITOR
  IMPORTS Process, ResidentHeap, Zone
  EXPORTS FileCache, FilerPrograms =
  BEGIN OPEN FileInternal;

  -- General cache mechanism

  Base: TYPE = Environment.Base;
  base: Base = ResidentHeap.first64K; -- base pointer for CEptr's
  Cache: TYPE = POINTER TO CacheRecord;
  CacheRecord: TYPE = RECORD [
    mru: CEptr, -- most recently used entry (head of lru chain)
    free: CEptr, -- head of free chain
    CleanUp: CacheCleanUpProc, -- proc to cleanup when an entry is replaced
    cacheType: CacheType];
  CacheType: TYPE = {file, pageGroup};
  CacheEntry: TYPE = RECORD [
    -- carefully arranged to not waste bits
    next: CEptr, -- next entry in lru chain
    pinned: BOOLEAN, -- TRUE if this cache entry is pinned
    refCnt: [0..37777B), -- number of readlocks set by FindCacheEntry
    body:
      SELECT COMPUTED CacheType FROM
        file => [fd: Descriptor, pgList: PageGroupCEptr],
        pageGroup => [group: PageGroup, fileCacheEntry: FileCEptr],
        ENDCASE];
  CEptr: TYPE = Base RELATIVE POINTER TO CacheEntry;
  FileCEptr: TYPE = Base RELATIVE POINTER TO file CacheEntry;
  PageGroupCEptr: TYPE = Base RELATIVE POINTER TO pageGroup CacheEntry;
  nilCEptr: CEptr = Zone.nil;
  nilFileCEptr: FileCEptr = LOOPHOLE[nilCEptr];
  nilPageGroupCEptr: PageGroupCEptr = LOOPHOLE[nilCEptr];
  CacheCleanUpProc: TYPE = PROCEDURE [cePtr: CEptr];
  NoCleanUp: CacheCleanUpProc; -- null case indicator (unbound control link)
  returned: CONDITION;

  -- Key for cache searches
  CacheKey: TYPE = RECORD [
    SELECT OVERLAID CacheType FROM
      file => [fileID: File.ID],
      pageGroup => [fileCacheEntry: FileCEptr, filePage: File.PageNumber],
      ENDCASE];

  --  The following code calculates the number of file cache entries to initially create.  As the initial cache is allocated as one chunk out of the resident heap, it is best if the initial file cache use as close to an integral number of pages as possible.
  PageSize: CARDINAL = Environment.wordsPerPage; -- for conciseness below
  FCESize: CARDINAL = SIZE[file CacheEntry];
  PGESize: CARDINAL = SIZE[pageGroup CacheEntry];
  ResidentHeapImplOverhead: CARDINAL = 2;
  -- Must be at least as large as the actual overhead imposed by ResidentHeapImpl
  NumPages: CARDINAL =
    (FCacheMinimumSize*FCESize + PGCacheMinimumSize*PGESize +
       ResidentHeapImplOverhead + PageSize - 1)/PageSize;
  -- number of pages to allocate initially
  Slop: CARDINAL =
    NumPages*PageSize - ResidentHeapImplOverhead - FCacheMinimumSize*FCESize -
      PGCacheMinimumSize*PGESize;
  -- extra space to be allocated as equally as possible to file and page group cache entries
  FirstExtraFCEs: CARDINAL = (Slop/2)/FCESize;
  FirstExtraPGEs: CARDINAL = (Slop/2)/PGESize;
  LastSlop: CARDINAL = Slop - FirstExtraFCEs*FCESize - FirstExtraPGEs*PGESize;
  ExtraFCEs: CARDINAL =
    IF FCESize > PGESize THEN FirstExtraFCEs
    ELSE FirstExtraFCEs + LastSlop/FCESize;
  ExtraPGEs: CARDINAL =
    IF PGESize >= FCESize THEN FirstExtraPGEs
    ELSE FirstExtraPGEs + LastSlop/PGESize;

  -- File descriptor cache
  FCache: Cache;
  FCacheRecord: CacheRecord;
  FCacheIndex: TYPE = [0..FCacheSize);
  -- There are 4 pinned entries for each logical volume of the correct type, 1 for physical volumes, and 1 for logical volumes of the "wrong" type.
  FCacheMinimumSize: CARDINAL = 200--PDR was 40--; -- must be 2 or greater
  FCacheSize: CARDINAL = FCacheMinimumSize + ExtraFCEs;
  FCacheCleanUp: INTERNAL CacheCleanUpProc =
    BEGIN -- flush corresponding entries from page group cache
    WHILE RemoveCacheEntry[PGCache, cePtr] DO NULL ENDLOOP
    END;

  -- Page Group cache
  PGCache: Cache;
  PGCacheRecord: CacheRecord;
  PGCacheIndex: TYPE = [0..PGCacheSize);
  PGCacheMinimumSize: CARDINAL = 220--PDR was 50--; -- must be 2 or greater
  PGCacheSize: CARDINAL = PGCacheMinimumSize + ExtraPGEs;

  GetFilePtrs: PUBLIC ENTRY PROCEDURE [count: CARDINAL, fileID: File.ID]
    RETURNS [success: BOOLEAN, fD: FileInternal.FilePtr] =
    BEGIN
    fEntry: CEptr;
    key: CacheKey _ [file[fileID]];
    [success, fEntry] _ FindCacheEntry[get, count, FCache, @key];
    IF success THEN WITH base[fEntry] SELECT file FROM file => fD _ @fd; ENDCASE;
    END;

  ReturnFilePtrs: PUBLIC ENTRY PROCEDURE [
    count: CARDINAL, fD: FileInternal.ReadOnlyFilePtr] =
    BEGIN
    key: CacheKey _ [file[fD.fileID]];
    [] _ FindCacheEntry[return, count, FCache, @key];
    END;

  SetFile: PUBLIC ENTRY PROCEDURE [fd: Descriptor, pinned: BOOLEAN] =
    BEGIN
    fEntry: CEptr;
    key: CacheKey _ [file[fd.fileID]];
    ce: CacheEntry _ [nilCEptr, pinned, 0, file[fd, nilPageGroupCEptr]];
    SetCacheEntry[FCache, @ce];
    fEntry _ FindCacheEntry[locate, 0, FCache, @key].ceptr;
    WITH fE: base[fEntry] SELECT file FROM file => fE.fd _ fd; ENDCASE;
    END;

  FlushFile: PUBLIC ENTRY PROCEDURE [fileID: File.ID] =
    BEGIN
    found: BOOLEAN;
    fEntry: CEptr;
    key: CacheKey _ [file[fileID]];
    [found, fEntry] _ FindCacheEntry[locate, 0, FCache, @key];
    IF found THEN [] _ RemoveCacheEntry[FCache, fEntry];
    END;

  GetPageGroup: PUBLIC ENTRY PROCEDURE [
    fileID: File.ID, filePage: File.PageNumber]
    RETURNS [success: BOOLEAN, pg: PageGroup] =
    BEGIN
    fEntry, pgEntry: CEptr;
    key: CacheKey _ [file [fileID]];
    [success, fEntry] _ FindCacheEntry[locate, 0, FCache, @key];
    IF ~success THEN RETURN;
    key _ [pageGroup[LOOPHOLE[fEntry], filePage]];
    [success, pgEntry] _ FindCacheEntry[locate, 0, PGCache, @key];
    IF success THEN
      WITH base[pgEntry] SELECT pageGroup FROM pageGroup => pg _ group; ENDCASE;
    END;

  SetPageGroup: PUBLIC ENTRY PROCEDURE [
    fileID: File.ID, group: PageGroup, pinned: BOOLEAN] =
    BEGIN
    success: BOOLEAN;
    fEntry: CEptr;
    key: CacheKey _ [file[fileID]];
    ce: CacheEntry;
    [success, fEntry] _ FindCacheEntry[locate, 0, FCache, @key];
    IF ~success THEN ERROR;
    ce _ [nilCEptr, pinned, 0, pageGroup[group, LOOPHOLE[fEntry]]];
    SetCacheEntry[PGCache, @ce];
    END;

  FlushFilesOnVolume: PUBLIC ENTRY PROCEDURE [
    lvID: Volume.ID, pin: FileCache.PinnedAction] =
    BEGIN
    foundAny: BOOLEAN _ TRUE;
    WHILE foundAny DO
      foundAny _ FALSE;
      FOR current: CEptr _ FCache.mru, base[current].next
        WHILE current ~= nilCEptr DO
          WITH fileEntry: base[current] SELECT FCache.cacheType FROM
            file =>
              IF fileEntry.fd.volumeID = lvID THEN
                IF fileEntry.pinned AND pin = error THEN ERROR
                ELSE IF NOT (fileEntry.pinned AND pin = keep) THEN
                  BEGIN
                  foundAny _ TRUE;
                  [] _ RemoveCacheEntry[FCache, current]
                  END;
             ENDCASE => ERROR;
          ENDLOOP;
        ENDLOOP;
    END;

  -- Utility routines

  IsMatch: INTERNAL PROCEDURE [
    cacheType: CacheType, key: POINTER TO CacheKey, entry: CEptr]
    RETURNS [BOOLEAN] = INLINE
    BEGIN
    RETURN[
      WITH base[entry] SELECT cacheType FROM
        file => -- compare the two file ID's for equality
                LOOPHOLE[key.fileID, SystemInternal.UniversalID].sequence =
                   LOOPHOLE[fd.fileID, SystemInternal.UniversalID].sequence AND
                LOOPHOLE[key.fileID, SystemInternal.UniversalID].processor.c =
                   LOOPHOLE[fd.fileID, SystemInternal.UniversalID].processor.c AND
                LOOPHOLE[key.fileID, SystemInternal.UniversalID].processor.b =
                   LOOPHOLE[fd.fileID, SystemInternal.UniversalID].processor.b AND
                LOOPHOLE[key.fileID, SystemInternal.UniversalID].processor.a =
                   LOOPHOLE[fd.fileID, SystemInternal.UniversalID].processor.a,
        pageGroup => key.fileCacheEntry = fileCacheEntry AND
                         key.filePage IN [group.filePage..group.nextFilePage),
        ENDCASE => -- never happens-- FALSE];
    END;

  GetMru: PROCEDURE [cacheType: CacheType, key: POINTER TO CacheKey]
    RETURNS [LONG POINTER TO CEptr] = INLINE
    BEGIN
    RETURN[
      SELECT cacheType FROM
        file => @FCache.mru,
        pageGroup => LOOPHOLE[@(base[key.fileCacheEntry]).pgList]
        ENDCASE => ERROR]
    END;

  -- FindCacheEntry searches for an entry in the indicated cache having the indicated key, and returns the specified number of pointers to it (i.e. a pointer that may be copied that many times). If the pointers will be passed outside the monitor, op = get, and a later matching call with op = return must occur when the client discards the pointers; these adjust the refCnt of the entry appropriately. If only the contents of the entry are passed outside the monitor, op = locate, and the refCnt is not incremented.

  lastMissedFileID: File.ID _ File.nullID; -- last file ID searched for and missed

  FindCacheEntry: INTERNAL PROCEDURE [
    op: {get, return, locate}, count: CARDINAL, cache: Cache,
    key: POINTER TO CacheKey]
    RETURNS [success: BOOLEAN, ceptr: CEptr] =
    BEGIN OPEN cache;
    current: CEptr;
    mru: LONG POINTER TO CEptr;
    previous: CEptr;

    -- If this is a file search, see if we KNOW that this file entry is not here
    SELECT cacheType FROM
      file => -- compare the two file ID's for equality
                IF LOOPHOLE[key.fileID, SystemInternal.UniversalID].sequence =
                   LOOPHOLE[lastMissedFileID, SystemInternal.UniversalID].sequence
                 THEN IF LOOPHOLE[key.fileID, SystemInternal.UniversalID].processor =
                     LOOPHOLE[lastMissedFileID, SystemInternal.UniversalID].processor
                  THEN RETURN[FALSE, nilCEptr];
      ENDCASE;
    previous _ nilCEptr;
    mru _ GetMru[cacheType, key];
    current _ mru^;
    WHILE current ~= nilCEptr DO
      OPEN base[current];
      IF IsMatch[cacheType, key, current] THEN -- found the matching cache entry
        BEGIN
        IF previous ~= nilCEptr THEN -- promote it to mru
          {base[previous].next _ next; next _ mru^; mru^ _ current};
        SELECT op FROM
          get => refCnt _ refCnt + count;
          return => IF (refCnt _ refCnt - count) = 0 THEN BROADCAST returned;
          ENDCASE;
        SELECT cacheType FROM
          file => lastMissedFileID _ File.nullID;
          ENDCASE;
        RETURN[TRUE, current]
        END;
      previous _ current;
      current _ next;
      ENDLOOP;
    SELECT cacheType FROM
       file => lastMissedFileID _ key.fileID;
       ENDCASE;
    RETURN[FALSE, nilCEptr];
    END;

  SetCacheEntry: INTERNAL PROCEDURE [
    cache: Cache, newEntry: POINTER TO CacheEntry] =
    BEGIN OPEN cache;
    entry, lastPtr, previous: CEptr;
    key: CacheKey;
    spliceOutMru, spliceInMru: LONG POINTER TO CEptr;

    -- Set key and keep the "cache" of recently missed guys up to date
    WITH newEntry SELECT cacheType FROM
      file => BEGIN
              key _ CacheKey[file[fd.fileID]];
              IF LOOPHOLE[fd.fileID, SystemInternal.UniversalID].sequence =
                 LOOPHOLE[lastMissedFileID, SystemInternal.UniversalID].sequence
              THEN IF LOOPHOLE[fd.fileID, SystemInternal.UniversalID].processor =
                     LOOPHOLE[lastMissedFileID, SystemInternal.UniversalID].processor
              THEN lastMissedFileID _ File.nullID;
              END;
      pageGroup => key _ CacheKey[pageGroup[fileCacheEntry, group.filePage]];
      ENDCASE;
    previous _ nilCEptr;
    spliceInMru _ GetMru[cacheType, @key];
    spliceOutMru _ NIL;
    FOR current: CEptr _ spliceInMru^, base[current].next
      WHILE current ~= nilCEptr DO
      IF IsMatch[cacheType, @key, current] THEN
        BEGIN
        base[current].refCnt _ base[current].refCnt + newEntry.refCnt;
        base[current].pinned _ base[current].pinned OR newEntry.pinned;
        IF previous ~= nilCEptr THEN
          BEGIN
          -- must move current to mru (ELSE clause would be to move mru (= current) to
          -- mru - a no-op).
          base[previous].next _ base[current].next;
          base[current].next _ spliceInMru^;
          spliceInMru^ _ current;
          END;
        RETURN;
        END;
      previous _ current;
      ENDLOOP;
    IF free ~= nilCEptr THEN -- Steal a free entry if they exist
      BEGIN entry _ free; free _ base[free].next; END
    ELSE
      BEGIN -- Must find the LRU replacable entry
      entry _ lastPtr _ previous _ nilCEptr;
      SELECT cacheType FROM
        file =>
          FOR fPtr: FileCEptr _ LOOPHOLE[(spliceOutMru _ spliceInMru)^],
            LOOPHOLE[base[fPtr].next] WHILE fPtr ~= nilCEptr DO
            IF base[fPtr].refCnt = 0 AND ~base[fPtr].pinned THEN {
              previous _ lastPtr; entry _ fPtr};
            lastPtr _ fPtr;
            ENDLOOP;
        pageGroup =>
          FOR fPtr: FileCEptr _ LOOPHOLE[FCache.mru], LOOPHOLE[base[fPtr].next]
            WHILE fPtr ~= nilCEptr DO
            lastPtr _ nilCEptr;
            FOR pgPtr: PageGroupCEptr _ base[fPtr].pgList, LOOPHOLE[base[
              pgPtr].next] WHILE pgPtr ~= nilCEptr DO
              IF base[pgPtr].refCnt = 0 AND ~base[pgPtr].pinned THEN
                BEGIN
                spliceOutMru _ LOOPHOLE[@(base[fPtr]).pgList];
                previous _ lastPtr;
                entry _ pgPtr;
                END;
              lastPtr _ pgPtr;
              ENDLOOP;
            ENDLOOP;
      ENDCASE => ERROR;
      IF entry = nilCEptr THEN
        SELECT cacheType FROM -- make a new cache entry
           file => entry _ ResidentHeap.MakeNode[SIZE[file CacheEntry]].node;
            pageGroup =>
              entry _ ResidentHeap.MakeNode[SIZE[pageGroup CacheEntry]].node;
            ENDCASE => ERROR
      ELSE
         BEGIN -- remove the LRU entry (= entry)
         IF CleanUp # NoCleanUp THEN CleanUp[entry]; -- clean up for removal
         -- Splice this entry ouyt of the list, special casing if it is MRU
         IF previous ~= nilCEptr THEN base[previous].next _ base[entry].next
         ELSE spliceOutMru^ _ base[entry].next;
         END;
      END;
    WITH newEntry SELECT cacheType FROM
      file =>
        base[entry] _
          [next: spliceInMru^, pinned: newEntry.pinned, refCnt: newEntry.refCnt,
            body: file[fd: fd, pgList: nilPageGroupCEptr]];
      pageGroup =>
        base[entry] _
          [next: spliceInMru^, pinned: newEntry.pinned, refCnt: newEntry.refCnt,
            body: pageGroup[group: group, fileCacheEntry: fileCacheEntry]];
      ENDCASE;
    spliceInMru^ _ entry; -- Complete splicing in the entry as MRU
    END;

  RemoveCacheEntry: INTERNAL PROCEDURE [cache: Cache, fce: CEptr]
    RETURNS [success: BOOLEAN] =
    BEGIN OPEN cache;
    current, previous: CEptr;
    mru: LONG POINTER TO CEptr _
      IF cacheType = file THEN @FCache.mru
      ELSE LOOPHOLE[@(base[LOOPHOLE[fce, FileCEptr]]).pgList];
    DO
      current _ mru^; -- start search with most-recently-used
      WHILE current ~= nilCEptr DO
        IF WITH base[current] SELECT cacheType FROM
          file => current = fce,
          pageGroup => fileCacheEntry = fce,
          ENDCASE => FALSE -- (never happens)
       THEN EXIT;
       previous _ current;
       current _ base[current].next; -- advance down LRU chain
       REPEAT FINISHED => RETURN[FALSE]; -- search failed
       ENDLOOP;
      IF base[current].refCnt = 0 THEN EXIT;
      WAIT returned; -- entry busy: try again when activity subsides
      ENDLOOP;
    IF CleanUp ~= NoCleanUp THEN CleanUp[current]; -- clean up entry for removal
    IF current = mru^ -- remove current from lru chain
       THEN mru^ _ base[current].next
    ELSE base[previous].next _ base[current].next;
    base[current].next _ free;
    free _ current; -- put on free chain
    RETURN[TRUE];
    END;

  Initialize: PROCEDURE =
    BEGIN
    FCacheArray: LONG DESCRIPTOR FOR ARRAY FCacheIndex OF file CacheEntry;
    PGCacheArray: LONG DESCRIPTOR FOR
      ARRAY PGCacheIndex OF pageGroup CacheEntry;
    node: CEptr;
    i: CARDINAL;
    Process.DisableAborts[@returned];
    node _ ResidentHeap.MakeNode[   -- storage for the initial caches
      NumPages*PageSize-ResidentHeapImplOverhead, a1].node;
    FCache _ @FCacheRecord;
    FCache.cacheType _ file;
    FCache.mru _ nilCEptr;
    FCache.CleanUp _ FCacheCleanUp;
    FCache.free _ node;
    FCacheArray _ DESCRIPTOR[@base[FCache.free], FCacheSize];
    FOR i IN FCacheIndex DO
      -- set up free chain
      FCacheArray[i].next _
        IF i = LAST[FCacheIndex] THEN nilCEptr ELSE (node _ node + FCESize)
      ENDLOOP;
    node _ node + FCESize;
    -- start the page group cache after the last file cache entry
    PGCache _ @PGCacheRecord;
    PGCache.cacheType _ pageGroup;
    PGCache.mru _ nilCEptr;
    PGCache.CleanUp _ NoCleanUp;
    PGCache.free _ node;
    PGCacheArray _ DESCRIPTOR[@base[PGCache.free], PGCacheSize];
    FOR i IN PGCacheIndex DO
      -- set up free chain
      PGCacheArray[i].next _
        IF i = LAST[PGCacheIndex] THEN nilCEptr ELSE (node _ node + PGESize)
      ENDLOOP;
    END;

  Initialize[];
  END.

LOG
Time: April 20, 1978  3:09 PM  By: Redell  Action: Created file
Time: May 4, 1978  1:32 PM  By: Redell  Action: bug: get free entry => refCnt _ 0
Time: July 25, 1978  1:31 PM  By: Redell  Action: clean crash if cache fills up with pinned entries.
Time: September 11, 1978  5:42 PM  By: Redell  Action: Fixed flush to wait if I/O in progress. Re-did lost edits to expand cache size to 32 entries(!)
Time: August 29, 1979  4:49 PM  By: Ladner  Action: installed cache instrumentation
Time: February 14, 1980  7:39 PM  By: Gobbel  Action: Fixed bug in UtilityPilot mode operation: forgot to zero refcnt when getting a new entry
Time: May 16, 1980  9:39 AM  By: Luniewski  Action: FrameOps -> Frame.
Time: May 23, 1980  12:08 PM  By: Luniewski  Action: Added FlushFilesOnVolume and CacheEntry.pinned field.  Modified to use ResidentHeap for cache storage and relative pointers for internal cache pointers.
Time: September 3, 1980  2:07 PM  By: Luniewski  Action: Speeded up algorithm by adding a fast pre-search to SetCacheEntry, chaining page group entries off of the corresponding file cache entry and adding an internal, INLINE, UID comparer program.  Deleted performance monitoring code.  Diabled aborts on condition variable.
Time: September 17, 1980  4:10 PM By: Yokota   Action: mru is converted to spliceInMru and spliceOutMru.
Time: December 1, 1980  4:16 PM By: Luniewski   Action: Made initial allocation request correct.  Expanded UIDCompare inline because the compiler did a lousy job of it (the algorithm also was changed to take advantage of the definition of a UID as a processor ID and a sequence nr. by comapring the sequence nr.'s first).
Time: February 6, 1981  10:13 AM By: Luniewski   Action: Make ReturnFilePtrs take a FileInternal.ReadOnlyFilePtr as first step towards haveing the external interface deal with these exclusively. 
Time: December 8, 1982 9:44 pm By: Levin   Action: SetFile now ensures that the argument descriptor appears in the cache.  Previously, if an entry for the file appeared, the size and attributes were not updated.