-- Copyright (C) 1982, 1984, 1985  by Xerox Corporation. All rights reserved. 
-- Transport Mechanism Filestore - heap restart
-- HeapRestart.mesa

-- HGM, 15-Sep-85 13:02:36
-- Ted Wobber	   3-Nov-82 12:54:42 --
-- Andrew Birrell  November 1, 1982 3:55 pm --
-- Hankins	   21-Aug-84 13:39:01 

DIRECTORY
  BitMapDefs USING [Create, MapIndex, Set],
  Heap USING [MakeNode, systemZone],
  HeapDefs USING [ObjectOffset, objectStart],
  HeapFile,
  HeapFileDefs USING [Address, AddToFreeList, NotifyFreeCount, RecordAllocation],
  HeapXDefs USING [PageHeader, ObjectHeader],
  Inline USING [LongCOPY],
  LogDefs USING [ShowNumber, WriteLine, WriteLogEntry],
  LogPrivateDefs USING [tty],
  ObjectDir,
  ObjectDirDefs --EXPORT only-- ,
  ObjectDirXDefs USING [gapObjectNumber, ObjectNumber],
  System USING [switches],
  TTY USING [GetChar, GetDecimal, PutCR, PutChar, PutDecimal, PutLine, PutString],
  VMDefs USING [
    CloseFile, FileHandle, FullAddress, GetFileLength, MarkStartWait, MarkStart,
    OpenFile, Page, PageAddress, PageIndex, PageNumber, pageSize, ReadPage,
    Release, SetFileLength, UsePage, WaitFile];

HeapRestart: MONITOR RETURNS [initHeap: BOOLEAN]LOCKS ObjectDir.LOCK
  IMPORTS
    BitMapDefs, Heap, HeapFile, HeapFileDefs, Inline, LogDefs, LogPrivateDefs,
    ObjectDir, System, TTY, VMDefs
  EXPORTS ObjectDirDefs, HeapDefs
  SHARES HeapFile, ObjectDir =
  BEGIN


  -- Opens files concerned with heap:
  --   "Heap.ObjectDir"  The object directory; initialised on every restart
  --                     and extended dynamically as needed during run.
  --   "Heap.Data"       The file containing the heap objects is considered
  --                     as a sequence of separate segments, numbered
  --       	       [FIRST[HeapFileDefs.Segment]..LAST[HeapFileDefs.Segment]]
  --                     These segments are of equal size.  Heap.Data should
  --                     be pre-allocated on consecutive pages of physical disk.
  --   "Heap.Segments"   Ordering for segments of Heap.Data; two pages only.  If
  --                     this file is size 0 on entry, then 'initHeap' is set
  --                     to TRUE and all files are initialised to a state
  --                     corresponding to there being no message bodies.
  -- The object directory and ancillary variables are set to correspond to
  -- the heap objects found to exist in the heap file, read in the
  -- order given by "Heap.Chain", with their reference counts set to zero
  -- pending restart of steering list queues and mailboxes.  After restart of
  -- steering list queues and mailboxes, the Compactor should be STARTed, and
  -- will then run as an asynchronous activity.

  RestartObject: PUBLIC ENTRY PROCEDURE [obj: ObjectDirXDefs.ObjectNumber] =
    BEGIN  -- executes inside the ObjectDir monitor --
    OPEN ObjectDir;
    either: LONG POINTER TO DirData = findData[obj];
    WITH data: either SELECT FROM
      used =>
        BEGIN
        IF data.count = LAST[ObjectCount] THEN ERROR objectCountTooBig;
        data.count ¬ data.count + 1;
        END;
      ENDCASE => ERROR objectNotInUse[];
    releaseData[dirty];
    END;

  BadChainSize: ERROR = CODE;
  NoWrittenHeapSegment: ERROR = CODE;
  HeapDataTooSmall: ERROR = CODE;
  BailOut: SIGNAL = CODE;

  ReadChain: PROCEDURE =
    BEGIN OPEN HeapFile, client;
    chainPages: CARDINAL;
    handle ¬ VMDefs.OpenFile[options: old, name: "Heap.Data"L, cacheFraction: 40];
    IF VMDefs.GetFileLength[handle].page = 0 THEN ERROR HeapDataTooSmall[];
    segmentCount ¬ VMDefs.GetFileLength[handle].page / segmentSize;
    chainPages ¬ (segmentCount + segmentsPerPage - 1) / segmentsPerPage;
    segmentCeiling ¬ segmentCount + chainPages * headerSize - 1;
    chainHandle ¬ VMDefs.OpenFile[
      options: oldOrNew, name: "Heap.Segments"L, cacheFraction: 0];
    chain ¬ Heap.MakeNode[n: (segmentCeiling + 1) * SIZE[SegmentIndex]];
    IF VMDefs.GetFileLength[chainHandle].page = 0 THEN
      BEGIN
      wish: CHARACTER;
      DO
        TTY.PutString[
          LogPrivateDefs.tty,
          "Grapevine Heap Initialization:  Is this ok? (Y or N): "L];
        wish ¬ TTY.GetChar[LogPrivateDefs.tty];
        TTY.PutChar[LogPrivateDefs.tty, wish];
        TTY.PutCR[LogPrivateDefs.tty];
        SELECT wish FROM
          'N, 'n => SIGNAL BailOut[];
          'Y, 'y =>
            BEGIN
            TTY.PutString[
              LogPrivateDefs.tty, "Do you know what you're doing? (Y or N): "L];
            wish ¬ TTY.GetChar[LogPrivateDefs.tty];
            TTY.PutChar[LogPrivateDefs.tty, wish];
            TTY.PutCR[LogPrivateDefs.tty];
            SELECT wish FROM
              'N, 'n => SIGNAL BailOut[];
              'Y, 'y => EXIT;  -- go on to initialize
              ENDCASE => LOOP;
            END;
          ENDCASE => LOOP;
        ENDLOOP;
      InitChain[chainPages];
      InitData[];
      END
    ELSE
      BEGIN
      initHeap ¬ FALSE;
      IF VMDefs.GetFileLength[chainHandle].page # chainPages * 2 THEN
        ERROR BadChainSize;
      FOR page: CARDINAL IN [0..chainPages) DO
        seg: SegmentIndex = page * VMDefs.pageSize;
        chain0: LONG POINTER TO SerialAndHead = LOOPHOLE[VMDefs.ReadPage[
          [chainHandle, page * 2], 3]];
        chain1: LONG POINTER TO SerialAndHead = LOOPHOLE[VMDefs.ReadPage[
          [chainHandle, page * 2 + 1], 3]];
        from: LONG POINTER TO SerialAndHead =
          IF chain1.serialNumber > chain0.serialNumber THEN chain1 ELSE chain0;
        Inline.LongCOPY[
          from: from, to: @chain.header[page],
          nwords: MIN[1 + segmentCeiling - seg, VMDefs.pageSize]];
        VMDefs.Release[LOOPHOLE[chain0]];
        VMDefs.Release[LOOPHOLE[chain1]];
        ENDLOOP;
      END;
    IF chain.header[0].chainHead = noSegment THEN ERROR NoWrittenHeapSegment[];
    InitFreeMap[chainPages];
    END;

  InitChain: PROCEDURE [chainPages: CARDINAL] =
    BEGIN OPEN HeapFile, client;
    initHeap ¬ TRUE;
    LogDefs.WriteLogEntry["Initialising Heap.segments"L];
    LogDefs.WriteLine["Initialising Heap.segments"L];
    VMDefs.SetFileLength[chainHandle, [chainPages * 2, 0]];
    FOR index: CARDINAL IN (0..segmentCeiling] DO
      chain.next[index] ¬ HeapFile.noSegment ENDLOOP;
    FOR index: CARDINAL IN [0..chainPages) DO
      chain.header[index].serialNumber ¬ 0;
      IF index = 0  -- init head of chain
        THEN {
        chain.header[index].chainHead ¬ headerSize;
        chain.next[headerSize] ¬ noSegment};
      HeapFileDefs.RecordAllocation[index * VMDefs.pageSize];
      -- this incr's serial number for next call
      HeapFileDefs.RecordAllocation[index * VMDefs.pageSize];
      ENDLOOP;
    END;

  InitData: PROCEDURE =
    BEGIN OPEN HeapFile, client;
    LogDefs.WriteLogEntry["Initialising Heap.data"L];
    LogDefs.WriteLine["Initialising Heap.data"L];
    FOR page: VMDefs.PageNumber DECREASING IN
      [0..VMDefs.GetFileLength[handle].page) DO EmptyPage[[handle, page]] ENDLOOP;
    VMDefs.WaitFile[handle];
    END;

  InitFreeMap: PROCEDURE [chainPages: CARDINAL] =
    BEGIN OPEN HeapFile, client;
    IF freeMap # NIL THEN RETURN;
    freeCount ¬ segmentCount;
    freeMap ¬ BitMapDefs.Create[segmentCeiling + 1];
    FOR index: CARDINAL IN [0..chainPages) DO
      -- make nonexistent seg indices look 'busy'
      firstBit: BitMapDefs.MapIndex = index * VMDefs.pageSize;
      FOR j: CARDINAL IN [0..headerSize) DO
        BitMapDefs.Set[freeMap, firstBit + j] ENDLOOP;
      ENDLOOP;
    FOR s: CARDINAL ¬ chain.header[0].chainHead, chain.next[s] UNTIL s = noSegment
      DO BitMapDefs.Set[freeMap, s]; freeCount ¬ freeCount - 1; ENDLOOP;
    HeapFileDefs.NotifyFreeCount[];
    END;

  CheckForExpansion: PROCEDURE =
    BEGIN
    DuringExpansion: ERROR = CODE;
    IF System.switches['l] = down AND System.switches['i] = up THEN
      BEGIN  -- enlarge heap (but initialization overrides).
      currentHeapSize, newHeapSize, currentChainSize, newChainSize,
        newSegmentCount, oldSegmentCeiling, newSegmentCeiling: CARDINAL;
      chain: LONG POINTER TO HeapFile.ChainBlock;
      heapFile, chainFile: VMDefs.FileHandle;
      -- Check that both files exist:
      heapFile ¬ VMDefs.OpenFile[
        options: old, name: "Heap.Data"L, cacheFraction: 40];
      currentHeapSize ¬ VMDefs.GetFileLength[heapFile].page;
      chainFile ¬ VMDefs.OpenFile[
        options: old, name: "Heap.Segments"L, cacheFraction: 0];
      currentChainSize ¬ (VMDefs.GetFileLength[chainFile].page) / 2;
      IF currentHeapSize = 0 OR currentChainSize = 0 THEN ERROR DuringExpansion;
      DO
        wish: CHARACTER;
        TTY.PutString[
          LogPrivateDefs.tty,
          "Grapevine Heap Expansion (files must already exist):  Is this ok? (Y or N): "L];
        wish ¬ TTY.GetChar[LogPrivateDefs.tty];
        TTY.PutChar[LogPrivateDefs.tty, wish];
        TTY.PutCR[LogPrivateDefs.tty];
        SELECT wish FROM
          'N, 'n => ERROR DuringExpansion[];
          'Y, 'y =>
            BEGIN
            TTY.PutLine[
              LogPrivateDefs.tty,
              "Failure during expansion leaves undefined results, heap.data and heap.segments will then have to be deleted"L];
            TTY.PutString[LogPrivateDefs.tty, "Heap is now "L];
            TTY.PutDecimal[LogPrivateDefs.tty, currentHeapSize];
            TTY.PutString[
              LogPrivateDefs.tty,
              " pages long, how many TOTAL pages do you wish? "L];
            newHeapSize ¬ TTY.GetDecimal[LogPrivateDefs.tty];
            TTY.PutCR[LogPrivateDefs.tty];
            TTY.PutString[LogPrivateDefs.tty, "Confirm (Y or N): "L];
            wish ¬ TTY.GetChar[LogPrivateDefs.tty];
            TTY.PutChar[LogPrivateDefs.tty, wish];
            TTY.PutCR[LogPrivateDefs.tty];
            IF wish = 'Y OR wish = 'y THEN EXIT  -- go on to initialize
            ELSE LOOP;
            END;
          ENDCASE => LOOP;
        ENDLOOP;
      LogDefs.WriteLogEntry["Doing Heap Expansion"L];
      -- init pages of heap file:
      IF newHeapSize <= 77777B THEN  -- some implementation limit
        VMDefs.SetFileLength[heapFile, [page: newHeapSize, byte: 0]]
      ELSE ERROR DuringExpansion;
      FOR page: VMDefs.PageNumber IN [currentHeapSize..newHeapSize) DO
        EmptyPage[[heapFile, page]] ENDLOOP;
      VMDefs.WaitFile[heapFile];
      -- set up chain file:
      newSegmentCount ¬ newHeapSize / HeapFile.segmentSize;
      newChainSize ¬
        (newSegmentCount + HeapFile.segmentsPerPage - 1) /
          HeapFile.segmentsPerPage;
      oldSegmentCeiling ¬
        (currentHeapSize / HeapFile.segmentSize) +
          (((currentHeapSize / HeapFile.segmentSize) + HeapFile.segmentsPerPage -
              1) / HeapFile.segmentsPerPage) * HeapFile.headerSize - 1;
      newSegmentCeiling ¬
        newSegmentCount + newChainSize * HeapFile.headerSize - 1;
      chain ¬ Heap.MakeNode[n: (newSegmentCeiling + 1) * SIZE[HeapFile.SegmentIndex]];
      VMDefs.SetFileLength[chainFile, [page: newChainSize * 2, byte: 0]];
      -- get old chain info
      FOR page: CARDINAL IN [0..currentChainSize) DO
        seg: HeapFile.SegmentIndex = page * VMDefs.pageSize;
        chain0: LONG POINTER TO HeapFile.SerialAndHead = LOOPHOLE[VMDefs.ReadPage[
          [chainFile, page * 2], 3]];
        chain1: LONG POINTER TO HeapFile.SerialAndHead = LOOPHOLE[VMDefs.ReadPage[
          [chainFile, page * 2 + 1], 3]];
        from: LONG POINTER TO HeapFile.SerialAndHead =
          IF chain1.serialNumber > chain0.serialNumber THEN chain1 ELSE chain0;
        Inline.LongCOPY[
          from: from, to: @chain.header[page],
          nwords: MIN[1 + oldSegmentCeiling - seg, VMDefs.pageSize]];
        VMDefs.Release[LOOPHOLE[chain0]];
        VMDefs.Release[LOOPHOLE[chain1]];
        ENDLOOP;
      -- add new chain info:
      FOR index: CARDINAL IN (oldSegmentCeiling..newSegmentCeiling] DO
        chain.next[index] ¬ HeapFile.noSegment ENDLOOP;
      FOR page: CARDINAL IN [currentChainSize..newChainSize) DO
        chainFilePage: VMDefs.Page ¬ VMDefs.UsePage[[chainFile, page * 2]];
        chain.header[page].serialNumber ¬ 0;
        Inline.LongCOPY[
          from: @chain.header[page], to: chainFilePage,
          nwords: MIN[
          1 + newSegmentCeiling - page * VMDefs.pageSize, VMDefs.pageSize]];
        VMDefs.MarkStartWait[chainFilePage];
        VMDefs.Release[chainFilePage];
        chain.header[page].serialNumber ¬ 1;
        chainFilePage ¬ VMDefs.UsePage[[chainFile, page * 2 + 1]];
        Inline.LongCOPY[
          from: @chain.header[page], to: chainFilePage,
          nwords: MIN[
          1 + newSegmentCeiling - page * VMDefs.pageSize, VMDefs.pageSize]];
        VMDefs.MarkStartWait[chainFilePage];
        VMDefs.Release[chainFilePage];
        ENDLOOP;
      Heap.systemZone.FREE[@chain];
      VMDefs.CloseFile[heapFile];
      VMDefs.CloseFile[chainFile];
      END;
    END;

  EmptyPage: PROCEDURE [where: VMDefs.PageAddress] =
    BEGIN OPEN VMDefs, HeapXDefs;
    page: Page = ReadPage[where, 6];  -- faster than UsePage --
    header: LONG POINTER TO PageHeader = LOOPHOLE[page, LONG POINTER] + FIRST[PageIndex];
    obj: LONG POINTER TO ObjectHeader =
      LOOPHOLE[page, LONG POINTER] + FIRST[PageIndex] + SIZE[PageHeader];
    header.offset ¬ HeapDefs.objectStart;
    obj.number ¬ ObjectDirXDefs.gapObjectNumber;
    obj.size ¬
      1 + LAST[PageIndex] -
        (FIRST[PageIndex] + SIZE[PageHeader] + SIZE[ObjectHeader]);
    MarkStart[page];
    Release[page];
    END;


  InitObjectDir: ENTRY PROCEDURE =
    BEGIN  -- after InitHeapFile, to get HeapFileDefs.handle --
    OPEN ObjectDir;
    handle ¬ VMDefs.OpenFile[
      options: oldOrNew, name: "Heap.ObjectDir", cacheFraction: 10];
    ObjectDir.heapHandle ¬ HeapFile.client.handle;
    nextVirginPage ¬ VMDefs.GetFileLength[handle].page;
    IF nextVirginPage = FIRST[VMDefs.PageNumber] THEN
      nextVirginPage ¬ nextVirginPage + 1;
    -- initialize each page with unchained "free" indexes,
    -- and put each page on free page chain.
    firstFreePage ¬ endOfChain;
    FOR reqd: VMDefs.PageNumber IN [0..nextVirginPage) DO
      IF dpPage # NIL THEN VMDefs.Release[LOOPHOLE[dpPage, VMDefs.Page]];
      dpPage ¬ LOOPHOLE[VMDefs.UsePage[[handle, dpNumber ¬ reqd]]];
      FOR index: DirIndex IN DirIndex DO
        dpPage.data[index] ¬ [free[next: 0, dopc: 0]] ENDLOOP;
      dpPage.header ¬ [nextFreePage: unchained, nextFreeIndex: noFreeIndex];
      VMDefs.MarkStart[LOOPHOLE[dpPage, VMDefs.Page]];  --may cause file extension for page 0--
      releaseData[dirty];
      ENDLOOP;
    END;

  ReadSegments: PROCEDURE =
    BEGIN OPEN HeapFile, client;
    page: VMDefs.Page;
    usedSegment: SegmentIndex ¬ lastChained ¬ chain.header[0].chainHead;
    pos: VMDefs.FullAddress ¬ HeapFileDefs.Address[lastChained];
    usedPos: VMDefs.FullAddress ¬ pos;
    offset: HeapDefs.ObjectOffset;
    current: ObjectDirXDefs.ObjectNumber ¬ ObjectDirXDefs.gapObjectNumber;
    objectsFound: LONG CARDINAL ¬ 0;

    DefineObject: ENTRY PROCEDURE [obj: ObjectDirXDefs.ObjectNumber] =
      BEGIN OPEN ObjectDir;
      data: LONG POINTER TO DirData = findData[obj];
      data­ ¬ [
        used[
        page: pos.page.page, word: pos.word, type: obj.type, count: zeroCount]];
      releaseData[dirty];
      END;

    DefineObject[ObjectDirXDefs.gapObjectNumber];

    DO  -- Consider any page header --
      IF pos.word = FIRST[VMDefs.PageIndex] THEN
        BEGIN
        pageHead: LONG POINTER TO HeapXDefs.PageHeader;
        page ¬ VMDefs.ReadPage[pos.page, 2];
        pageHead ¬ LOOPHOLE[page, LONG POINTER] + pos.word;
        pos.word ¬ pos.word + SIZE[HeapXDefs.PageHeader];
        offset ¬ pageHead.offset;
        END
      ELSE offset ¬ HeapDefs.objectStart;
      BEGIN
      object: LONG POINTER TO HeapXDefs.ObjectHeader =
        LOOPHOLE[page, LONG POINTER] + pos.word;
      -- check for non-empty segment --
      IF object.number # ObjectDirXDefs.gapObjectNumber THEN
        BEGIN usedPos ¬ pos; usedSegment ¬ lastChained; END;
      IF
        (current # ObjectDirXDefs.gapObjectNumber
          --Inside an object, looking for continuation sub-object--
          -- If a duplicate start is found for an object, then the
          -- later start is chosen, so that all earlier starts are
          -- overwritten before the object number is freed by the
          -- compactor.  Otherwise, confusion could arise by the
          -- object number being re-used and a restart occuring
          -- before the duplicate start has been overwritten.
          AND object.number = current AND offset = HeapDefs.objectStart)
        OR
          (object.number # ObjectDirXDefs.gapObjectNumber
            AND offset = HeapDefs.objectStart) THEN
        BEGIN  -- start of a new object --
        DefineObject[object.number];
	objectsFound ¬ objectsFound + 1;
        current ¬ object.number;
        END
      -- ELSE we have one of:
      --         continuation of ignorable object,
      --         imbedded object which should be ignored,
      --         unexpected partial object,
      --         gap object -- ;
      pos.word ¬ pos.word + SIZE[HeapXDefs.ObjectHeader];
      pos.word ¬ pos.word + object.size;
      END;
      IF pos.word + SIZE[HeapXDefs.ObjectHeader] > LAST[VMDefs.PageIndex] THEN
        BEGIN
        VMDefs.Release[page];
        -- similar to HeapFileDefs.NextPage, but different --
        IF pos.page.page MOD segmentSize < segmentSize - 1 THEN
          BEGIN
          pos.page.page ¬ pos.page.page + 1;
          pos.word ¬ FIRST[VMDefs.PageIndex];
          END
        ELSE
          IF chain.next[lastChained] # noSegment THEN
            BEGIN
            old: SegmentIndex = lastChained;
            pos ¬ HeapFileDefs.Address[lastChained ¬ chain.next[old]];
            IF usedSegment # old THEN
              BEGIN  -- 'old' is entirely empty --
              chain.next[usedSegment] ¬ lastChained;
              HeapFileDefs.AddToFreeList[old];
              END
            END
          ELSE EXIT -- note "pos" is last page in chain.written-- ;
        END
      ELSE  -- end of any current object --
        current ¬ ObjectDirXDefs.gapObjectNumber;
      ENDLOOP;

    lastPage ¬ pos.page;
    lastWritten ¬ lastChained;

   LogDefs.ShowNumber["Found "L, objectsFound, " objects in the heap."L];
   END;


  TidyObjectDir: ENTRY PROCEDURE =
    -- Construct object directory page free chains --
    -- Add pages with non-empty free chains to page free chain
    BEGIN OPEN ObjectDir;
    FOR p: ObjDirPageNumber DECREASING IN [0..nextVirginPage) DO
      getDirPage[p];
      dpPage.header.nextFreeIndex ¬ noFreeIndex;
      FOR index: DirIndex IN DirIndex DO
        WITH data: dpPage.data[index] SELECT FROM
          free =>
            BEGIN
            dpPage.data[index] ¬ [
              free[next: dpPage.header.nextFreeIndex, dopc: lastDofpc]];
            dpPage.header.nextFreeIndex ¬ index;
            END;
          ENDCASE => NULL;
        ENDLOOP;
      IF dpPage.header.nextFreeIndex # noFreeIndex THEN {
        dpPage.header.nextFreePage ¬ firstFreePage; firstFreePage ¬ dpNumber};
      releaseData[dirty];
      ENDLOOP;
    END;


  Go: PROCEDURE =
    BEGIN
    HeapFile.client ¬ [freeMap: NIL];
    LogDefs.WriteLine["Restarting heap storage"L];
    START HeapFile;
    CheckForExpansion[];
    ReadChain[];
    START ObjectDir;
    InitObjectDir[];
    ReadSegments[];
    TidyObjectDir[];
    END;

  Go[];

  END.

log:
21-Aug-84 11:38:03 - blh:  add expand code.