-- Copyright (C) 1981, 1983, 1984, 1985  by Xerox Corporation. All rights reserved. 
-- Transport Mechanism Filestore - object directory --
-- ObjectDir.mesa

-- HGM, 15-Sep-85 10:08:11
-- Andrew Birrell  10-Jun-81 10:46:42 --
-- M. D. Schroeder   7-Feb-83 15:34:06 --
-- Hankins	26-Jul-84 16:31:35	Klamath update (make some proc var's so HeapRestart can access private procs.

DIRECTORY
  HeapFileDefs USING [ObjectAbandoned],
  ObjectDirXDefs USING [DOPC, ObjectNumber, ObjectState],
  ObjectDirDefs USING [noObject, ObjectType],
  PolicyDefs USING [GapExists],
  VMDefs USING [
    Page, pageSize, PageNumber, FileHandle, PageIndex, ReadPage, UsePage, Mark,
    MarkStart, Release, FullAddress];

ObjectDir: MONITOR
  IMPORTS HeapFileDefs, PolicyDefs, VMDefs
  EXPORTS ObjectDirDefs, ObjectDirXDefs
  SHARES ObjectDirDefs =
  BEGIN

  -- proc var's for HeapRestart:

  Find: TYPE = PROC [obj: ObjectDirXDefs.ObjectNumber]
    RETURNS [data: LONG POINTER TO DirData];
  Get: TYPE = PROCEDURE [reqd: ObjDirPageNumber];
  CountTooBig: TYPE = ERROR;
  NotInUse: TYPE = ERROR;
  Release: TYPE = PROCEDURE [d: CacheState] ¬ ReleaseData;

  findData: Find ¬ FindData;
  getDirPage: Get ¬ GetDirPage;
  objectCountTooBig: CountTooBig ¬ ObjectCountTooBig;
  objectNotInUse: NotInUse ¬ ObjectNotInUse;
  releaseData: Release ¬ ReleaseData;

  -- Reference counts --

  ObjectCount: TYPE = CARDINAL;

  zeroCount: ObjectCount = 0;
  oneCount: ObjectCount = zeroCount + 1;


  -- Structure of object directory pages --

  handle: VMDefs.FileHandle;  -- set by HeapRestart --

  -- Object directory is sequence of pages, each of type "DirPage"
  -- Pages containing unused indexes are on "firstFreePage" chain
  -- Unused indexes within page are in header.nextFreeIndex chain
  -- Unused indexes are not usable until lastDofpc is high enough
  -- See ObjectDirDefs comments about DOPC.
  -- There may be pages on "firstFreePage" chain having no free indexes

  -- Object directory page numbers (and markers) fit into 8 bits!

  ObjDirPageSpace: TYPE = [0..255];
  unchained: ObjDirPageSpace = LAST[ObjDirPageSpace];  -- "not on free chain"
  endOfChain: ObjDirPageSpace = PRED[unchained];  -- "end of free chain"
  ObjDirPageNumber: TYPE = [FIRST[ObjDirPageSpace]..PRED[endOfChain]];

  DirData: TYPE = RECORD [
    SELECT freedom: * --w0,b15-- FROM
    free => [
      next: VMDefs.PageIndex,  --w0,b[7..0]--
      dopc: ObjectDirXDefs.DOPC --w[1..2]-- ],
    used => [
      type: ObjectDirDefs.ObjectType,  --w0,b[14..11]--
      word: VMDefs.PageIndex,  --w0,b[7..0]--
      page: VMDefs.PageNumber,  --w1--
      count: ObjectCount --w2-- ],
    ENDCASE];

  DirPageHeader: TYPE = RECORD [
    nextFreePage: ObjDirPageSpace, nextFreeIndex: VMDefs.PageIndex];

  entriesPerPage: CARDINAL =
    (VMDefs.pageSize - SIZE[DirPageHeader]) / SIZE[DirData];

  DirIndex: TYPE = [0..entriesPerPage);
  -- NOTE: DirIndex values must fit in the "index" field of an object number --

  DirPage: TYPE = RECORD [header: DirPageHeader, data: ARRAY DirIndex OF DirData];

  noFreeIndex: [0..LAST[VMDefs.PageIndex]] = SUCC[LAST[DirIndex]];

  firstFreePage: ObjDirPageSpace ¬ endOfChain;  -- first page containing free numbers --
  nextVirginPage: ObjDirPageSpace;  -- current size of file --

  dpNumber: ObjDirPageNumber;
  dpPage: LONG POINTER TO DirPage ¬ NIL;

  GetDirPage: INTERNAL PROCEDURE [reqd: ObjDirPageNumber] =
    BEGIN
    IF dpPage = NIL OR dpNumber # reqd THEN
      BEGIN
      IF dpPage # NIL THEN VMDefs.Release[LOOPHOLE[dpPage, VMDefs.Page]];
      dpPage ¬ LOOPHOLE[VMDefs.ReadPage[
        [handle, dpNumber ¬ reqd], 0 --lookAhead-- ], LONG POINTER TO DirPage];
      END;
    END;


  -- Allocation of object numbers --

  InitPage: PROCEDURE =
    BEGIN
    -- initialize current page as empty and chain onto firstFreePage --
    index: DirIndex;
    dpPage.header ¬ [nextFreePage: firstFreePage, nextFreeIndex: FIRST[DirIndex]];
    firstFreePage ¬ dpNumber;
    FOR index IN DirIndex DO
      dpPage.data[index] ¬ [free[next: SUCC[index], dopc: lastDofpc]] ENDLOOP
    END;

  BadFreeObjChain: ERROR = CODE;
  ObjectDirectoryFull: ERROR = CODE;

  NewObject: PUBLIC ENTRY PROCEDURE [
    at: VMDefs.FullAddress, type: ObjectDirDefs.ObjectType]
    RETURNS [obj: ObjectDirXDefs.ObjectNumber] =
    BEGIN
    obj.page ¬ firstFreePage;
    DO  --until we find a suitable page --
      IF obj.page = endOfChain THEN
        BEGIN  -- allocate a new page by extending object dir file --
        obj.page ¬ nextVirginPage;
        nextVirginPage ¬ nextVirginPage + 1;
        IF dpPage # NIL THEN VMDefs.Release[LOOPHOLE[dpPage, VMDefs.Page]];
        dpPage ¬ LOOPHOLE[VMDefs.UsePage[[handle, dpNumber ¬ obj.page]], LONG POINTER
          TO DirPage];
        InitPage[] -- puts it on firstFreePage list -- ;
        VMDefs.MarkStart[LOOPHOLE[dpPage, VMDefs.Page]];  --to cause file extension--
        END
      ELSE GetDirPage[obj.page];
      IF obj.page > LAST[ObjDirPageNumber] THEN ERROR ObjectDirectoryFull[];
      IF dpPage.header.nextFreePage = unchained THEN ERROR BadFreeObjChain[];
      -- if page is empty and is start of free page list
      IF dpPage.header.nextFreeIndex = noFreeIndex AND obj.page = firstFreePage
        THEN
        BEGIN
        firstFreePage ¬ obj.page ¬ dpPage.header.nextFreePage;
        dpPage.header.nextFreePage ¬ unchained;
        ReleaseData[dirty];
        END
      ELSE
        BEGIN
        -- scan free chain on this page --
        prev: LONG POINTER TO DirData ¬ NIL;
        possible: VMDefs.PageIndex ¬ dpPage.header.nextFreeIndex;
        UNTIL possible = noFreeIndex DO  -- find re-usable object number on this page's free list --
          WITH data: dpPage.data[possible] SELECT FROM
            free =>
              IF data.dopc <= lastDofpc THEN
                BEGIN  -- take it! --
                obj.index ¬ possible;
                IF prev = NIL THEN dpPage.header.nextFreeIndex ¬ data.next
                ELSE
                  WITH prevData: prev SELECT FROM
                    free => prevData.next ¬ data.next;
                    ENDCASE => ERROR;
                GOTO found
                END
              ELSE
                BEGIN prev ¬ @(dpPage.data[possible]); possible ¬ data.next; END;
            ENDCASE => ERROR BadFreeObjChain[];
          ENDLOOP;
        obj.page ¬ dpPage.header.nextFreePage;
        ReleaseData[clean];
        END;
      REPEAT found => NULL;
      ENDLOOP;
    dpPage.data[obj.index] ¬ [
      used[page: at.page.page, word: at.word, type: type, count: oneCount]];
    ReleaseData[dirty];
    obj.fill ¬ 0;  --to allow for expansion of type field--
    obj.type ¬ type;
    END;

  CacheState: TYPE = {clean, dirty};

  IllegalObjectNumber: ERROR = CODE;

  FindData: INTERNAL PROCEDURE [obj: ObjectDirXDefs.ObjectNumber]
    RETURNS [data: LONG POINTER TO DirData] =
    BEGIN
    IF obj.index > LAST[DirIndex] THEN ERROR IllegalObjectNumber[];
    GetDirPage[obj.page];
    RETURN[@(dpPage.data[obj.index])]
    END;

  ReleaseData: INTERNAL PROCEDURE [d: CacheState] =
    BEGIN IF d = dirty THEN VMDefs.Mark[LOOPHOLE[dpPage, VMDefs.Page]]; END;


  -- Operations on individual object numbers --

  ObjectWithZeroCount: ERROR = CODE;
  IllegalDestroyObject: ERROR = CODE;
  ObjectNotInUse: ERROR = CODE;
  ObjectCountTooBig: ERROR = CODE;

  heapHandle: VMDefs.FileHandle;  -- set by HeapRestart --

  ObjectBase: PUBLIC ENTRY PROCEDURE [obj: ObjectDirXDefs.ObjectNumber]
    RETURNS [addr: VMDefs.FullAddress] =
    BEGIN
    either: LONG POINTER TO DirData = FindData[obj];
    WITH data: either SELECT FROM
      used =>
        BEGIN
        IF data.count < oneCount THEN ERROR ObjectWithZeroCount;
        addr ¬ [page: [heapHandle, data.page], word: data.word];
        END;
      ENDCASE => ERROR ObjectNotInUse[];
    ReleaseData[clean];
    END;

  UseObject: PUBLIC ENTRY PROCEDURE [obj: ObjectDirXDefs.ObjectNumber] =
    BEGIN
    either: LONG POINTER TO DirData = FindData[obj];
    WITH data: either SELECT FROM
      used =>
        BEGIN
        IF data.count < oneCount THEN ERROR ObjectWithZeroCount;
        IF data.count = LAST[ObjectCount] THEN ERROR ObjectCountTooBig;
        data.count ¬ data.count + 1;
        END;
      ENDCASE => ERROR ObjectNotInUse[];
    ReleaseData[dirty];
    END;

  FreeObject: PUBLIC ENTRY PROCEDURE [obj: ObjectDirXDefs.ObjectNumber] =
    BEGIN
    either: LONG POINTER TO DirData = FindData[obj];
    WITH data: either SELECT FROM
      used =>
        BEGIN
        IF data.count < oneCount THEN ERROR ObjectWithZeroCount;
        IF (data.count ¬ data.count - 1) = zeroCount THEN
          BEGIN
          IF obj.type = temp THEN
            BEGIN
            HeapFileDefs.ObjectAbandoned[[heapHandle, data.page]];
            AddToFreeList[obj, either, 0];
            END
          ELSE PolicyDefs.GapExists[];
          END;
        END;
      ENDCASE => ERROR ObjectNotInUse[];
    ReleaseData[dirty];
    END;

  IllegalRelease: ERROR = CODE;

  ReleaseObject: PUBLIC ENTRY PROCEDURE [obj: ObjectDirXDefs.ObjectNumber] =
    BEGIN
    either: LONG POINTER TO DirData = FindData[obj];
    IF obj.type = temp THEN ERROR IllegalRelease[];
    WITH data: either SELECT FROM
      used =>
        IF data.count # zeroCount THEN ERROR IllegalRelease[]
        ELSE {AddToFreeList[obj, either, 0]; ReleaseData[dirty]};
      ENDCASE => ERROR IllegalRelease[];
    END;  -- ReleaseObject --


  IllegalEnumerate: ERROR = CODE;

  Enumerate: PUBLIC PROCEDURE [
    type: ObjectDirDefs.ObjectType,
    proc: PROCEDURE [ObjectDirXDefs.ObjectNumber] RETURNS [BOOLEAN]]
    RETURNS [ObjectDirXDefs.ObjectNumber] =
    BEGIN
    Check: ENTRY PROCEDURE [obj: ObjectDirXDefs.ObjectNumber]
      RETURNS [wanted: BOOLEAN] = INLINE
      BEGIN
      either: LONG POINTER TO DirData = FindData[obj];
      WITH data: either SELECT FROM
        used =>
          BEGIN
          wanted ¬ data.type = obj.type;
          IF wanted THEN data.count ¬ data.count + 1;
          END;
        ENDCASE => wanted ¬ FALSE;
      ReleaseData[IF wanted THEN dirty ELSE clean];
      END;
    IF type = temp THEN ERROR IllegalEnumerate[];
    FOR page: VMDefs.PageNumber ¬ 0, page + 1 DO
      Last: ENTRY PROCEDURE RETURNS [BOOLEAN] = INLINE
        BEGIN RETURN[page = nextVirginPage] END;
      IF Last[] THEN EXIT;
      FOR index: DirIndex IN [FIRST[DirIndex]..LAST[DirIndex]] DO
        BEGIN
        obj: ObjectDirXDefs.ObjectNumber = [
          page: page, fill: 0, type: type, index: index];
        IF Check[obj] THEN
          BEGIN
          result: BOOLEAN ¬ proc[obj ! UNWIND => FreeObject[obj]];
          FreeObject[obj];
          IF result THEN RETURN[obj];
          END;
        END;
        ENDLOOP;
      ENDLOOP;
    RETURN[ObjectDirDefs.noObject];
    END;


  -- Compactor interface --

  lastDofpc: ObjectDirXDefs.DOPC ¬ 0;

  ReportDofpc: PUBLIC ENTRY PROCEDURE [dofpc: ObjectDirXDefs.DOPC] = {
    lastDofpc ¬ dofpc};

  MoveObject: PUBLIC ENTRY PROCEDURE [
    obj: ObjectDirXDefs.ObjectNumber, where: VMDefs.FullAddress] =
    BEGIN
    either: LONG POINTER TO DirData = FindData[obj];
    -- the compactor may occasionally move objects whose count has --
    -- decreased to zero after the compactor called 'ObjectInUse'  --
    WITH data: either SELECT FROM
      used => BEGIN data.page ¬ where.page.page; data.word ¬ where.word; END;
      ENDCASE => ERROR ObjectNotInUse[];
    ReleaseData[dirty];
    END;

  GetObjectState: PUBLIC ENTRY PROCEDURE [
    obj: ObjectDirXDefs.ObjectNumber, where: VMDefs.FullAddress,
    dorpc: ObjectDirXDefs.DOPC] RETURNS [state: ObjectDirXDefs.ObjectState] =
    BEGIN
    either: LONG POINTER TO DirData = FindData[obj];
    -- TRUE iff non-zero count and on appropriate page --
    -- Word position within page is not relevant: position is considered --
    -- only to eliminate duplicates left behind by compactor crashes --
    WITH data: either SELECT FROM
      used =>
        BEGIN
        IF data.page # where.page.page THEN {
          state ¬ duplicate; ReleaseData[clean]}
        ELSE
          IF data.count = zeroCount THEN
            BEGIN
            AddToFreeList[obj, either, dorpc];
            state ¬ unused;
            ReleaseData[dirty];
            END
          ELSE {state ¬ inUse; ReleaseData[clean]};
        END;
      ENDCASE => ERROR ObjectNotInUse[];
    END;

  AddToFreeList: PROC [
    obj: ObjectDirXDefs.ObjectNumber, either: LONG POINTER TO DirData,
    dorpc: ObjectDirXDefs.DOPC] =
    BEGIN
    IF dpPage.header.nextFreePage = unchained THEN {
      dpPage.header.nextFreePage ¬ firstFreePage; firstFreePage ¬ dpNumber};
    either­ ¬ [free[dpPage.header.nextFreeIndex, dorpc]];
    dpPage.header.nextFreeIndex ¬ obj.index;
    END;

  END.