-- Copyright (C) 1981, 1984, 1985  by Xerox Corporation. All rights reserved. 
-- Compactor.mesa, Transport Mechanism Filestore - heap compactor

-- HGM, 15-Sep-85 10:20:25
-- Randy Gobbel		19-May-81 13:24:41 --
-- Andrew Birrell	 3-Jun-81 13:00:58 --

DIRECTORY
  Heap USING [systemZone],
  HeapDefs USING [Buffer, HeapReadData, objectStart, ReaderHandle],
  HeapFileDefs USING [
    FirstSegment, InsertFirstSegment, NextPage, NoMorePages, FreeSegment],
  HeapXDefs USING [
    PageHeader, ObjectHeader, ReaderData, StopAllReaders, RestartAllReaders],
  LogDefs USING [ShowLine],
  ObjectDirXDefs USING [
    DOPC, ObjectNumber, gapObjectNumber, GetObjectState, MoveObject, ReportDofpc],
  PolicyDefs USING [CompactorPause, CompactorStart],
  Process USING [DisableTimeout, InitializeCondition, InitializeMonitor],
  String USING [AppendLongDecimal, AppendString],
  System USING [GetGreenwichMeanTime, GreenwichMeanTime],
  VMDefs USING [
    Deactivate, Page, PageIndex, ReadPage, MarkStartWait, UsePage, PageNumber,
    PageAddress, FullAddress];

Compactor: PROGRAM
  IMPORTS
    Heap, HeapDefs, HeapFileDefs, HeapXDefs, LogDefs, ObjectDirXDefs, PolicyDefs, Process,
    String, System, VMDefs
  EXPORTS HeapDefs --Compactor-- =
  BEGIN OPEN HeapXDefs, ObjectDirXDefs;


  -- Current state --

  wPos: VMDefs.FullAddress;
  wPage: VMDefs.Page;
  flushedBefore: VMDefs.FullAddress;
  reader: HeapXDefs.ReaderData;
  readerHandle: HeapDefs.ReaderHandle = LOOPHOLE[LONG[@reader]];
  object: LONG POINTER TO ObjectHeader;
  dorpc: ObjectDirXDefs.DOPC ¬ 0;  --see comments in ObjectDirXDefs

  -- record of objects moved by compactor --
  ObjRec: TYPE = RECORD [
    obj: ObjectNumber, where: VMDefs.FullAddress, next: ObjPtr];
  ObjPtr: TYPE = LONG POINTER TO ObjRec;
  endObj: ObjPtr = NIL;
  freeChain: ObjPtr ¬ endObj;
  moveChain: ObjPtr ¬ endObj;
  freeCount: CARDINAL ¬ 0;
  
  -- Statistics
  freed, copied, firstGap: LONG CARDINAL;
  startTime: System.GreenwichMeanTime;
  waitSeconds, pauseSeconds: LONG CARDINAL;

  GetObjRec: PROCEDURE [chain: LONG POINTER TO ObjPtr] RETURNS [ptr: ObjPtr] = INLINE
    BEGIN
    IF freeChain = endObj THEN ptr ¬ Heap.systemZone.NEW[ObjRec]
    ELSE {ptr ¬ freeChain; freeChain ¬ freeChain.next; freeCount ¬ freeCount - 1};
    ptr.next ¬ chain­;
    chain­ ¬ ptr;
    END;

  FreeObjRec: PROC [ptr: ObjPtr] = INLINE
    BEGIN ptr.next ¬ freeChain; freeChain ¬ ptr; freeCount ¬ freeCount + 1; END;

  Start: PROCEDURE =
    BEGIN  -- called before each compaction --
    LogDefs.ShowLine["Compactor starting..."];
    waitSeconds ¬ (System.GetGreenwichMeanTime[]-startTime);
    startTime  ¬ System.GetGreenwichMeanTime[];
    freed ¬ copied ¬ 0;
    firstGap ¬ LAST[LONG CARDINAL];
    pauseSeconds ¬ 0;
    reader.where ¬ HeapFileDefs.FirstSegment[];
    reader.page ¬ VMDefs.ReadPage[reader.where.page, 0];
    dorpc ¬ dorpc + 1;
    reader.offset ¬ HeapDefs.objectStart;
    reader.object ¬ ObjectDirXDefs.gapObjectNumber;
    wPos ¬ HeapFileDefs.InsertFirstSegment[];
    wPage ¬ NIL -- set later by SetHeader -- ;
    flushedBefore ¬ wPos;
    Flush[];
    END;

  Finish: PROCEDURE =
    BEGIN
    log: LONG STRING ¬ Heap.systemZone.NEW[StringBody[300]];
    runTime: LONG CARDINAL ¬ (System.GetGreenwichMeanTime[]-startTime);
    startTime  ¬ System.GetGreenwichMeanTime[];
    String.AppendString[log, "Compactor: Waited "L];
    String.AppendLongDecimal[log, waitSeconds];
    String.AppendString[log, ", ran "L];
    String.AppendLongDecimal[log, runTime];
    String.AppendString[log, ", paused "L];
    String.AppendLongDecimal[log, pauseSeconds];
    String.AppendString[log, " seconds. Reclaimed "L];
    String.AppendLongDecimal[log, freed];
    String.AppendString[log, " segments. Copied "L];
    String.AppendLongDecimal[log, copied];
    String.AppendString[log, " pages. First gap was at page "L];
    String.AppendLongDecimal[log, firstGap];
    String.AppendString[log, "."L];
    LogDefs.ShowLine[log];
    Heap.systemZone.FREE[@log];
    END;

  FindObject: PROCEDURE =
    BEGIN  -- skips until non-ignorable object --
    -- If no more objects exist, HeapFileDefs.NextPage generates a signal. --
    -- This should be caught by the caller of FindObject --
    OPEN VMDefs;
    reader.object ¬ gapObjectNumber --indicates "no current object"-- ;
    reader.end ¬ FALSE;
    DO  -- Consider any page header --
      IF reader.where.word = FIRST[PageIndex] THEN
        BEGIN
        pageHead: LONG POINTER TO PageHeader =
          LOOPHOLE[reader.page, LONG POINTER] + reader.where.word;
        reader.where.word ¬ reader.where.word + SIZE[PageHeader];
        reader.offset ¬ pageHead.offset;
        END
      ELSE reader.offset ¬ HeapDefs.objectStart;

      BEGIN  -- read sub-object header --
      object: LONG POINTER TO ObjectHeader =
        LOOPHOLE[reader.page, LONG POINTER] + reader.where.word;
      IF
        (reader.object # gapObjectNumber
          -- Inside an object, looking for continuation sub-object --
          -- If a duplicate start is found, it may be non-ignorable --
          AND object.number = reader.object
          AND reader.offset = HeapDefs.objectStart)
        OR
          (object.number # gapObjectNumber
            AND reader.offset = HeapDefs.objectStart) THEN
        BEGIN  -- start of a new object --
        SELECT GetObjectState[object.number, reader.where, dorpc] FROM
          inUse =>
            BEGIN
            ptr: ObjPtr = GetObjRec[@moveChain];
            ptr.where ¬ wPos;
            ptr.obj ¬ reader.object ¬ object.number;
            EXIT
            END;
          unused =>  -- ignorable object, marked as deleted by ObjectDir --
            NULL;
          duplicate => NULL;  -- ignorable object --
          ENDCASE => ERROR;
        reader.object ¬ object.number --now the current object-- ;
        END
      -- ELSE we have one of:
      --         continuation of ignorable object,
      --         imbedded object which should be ignored,
      --         unexpected partial object,
      --         gap object -- ;
      reader.where.word ¬ reader.where.word + SIZE[ObjectHeader];
      reader.where.word ¬ reader.where.word + object.size;
      END;

      -- check for end of page --
      IF reader.where.word + SIZE[ObjectHeader] > LAST[PageIndex] THEN
        BEGIN
	start: System.GreenwichMeanTime ¬ System.GetGreenwichMeanTime[];
        Deactivate[reader.page];  -- not "Release", for better cache -
        PolicyDefs.CompactorPause[];
	pauseSeconds ¬ pauseSeconds + (System.GetGreenwichMeanTime[]-start);
        reader.where ¬ HeapFileDefs.NextPage[reader.where];
        -- That may have generated a signal, terminating FindObject --
        -- Note that there is no current page here.  --
        reader.page ¬ ReadPage[reader.where.page, 0];
        dorpc ¬ dorpc + 1;
        END
      ELSE  -- end of any current object --
        reader.object ¬ gapObjectNumber;
      ENDLOOP;
    --the interlock with the readers occurs in TerminatePage --
    END;

  Flush: PROCEDURE =
    BEGIN  --write empty pages upto, but excluding, 'limit' --
    WHILE flushedBefore.page.page # reader.where.page.page DO
      EmptyPage[flushedBefore.page];
      flushedBefore ¬ HeapFileDefs.NextPage[flushedBefore]
      ENDLOOP;
    ObjectDirXDefs.ReportDofpc[dorpc - 1];
    END;

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

  SetHeader: PROCEDURE [number: ObjectDirXDefs.ObjectNumber] =
    BEGIN
    -- Write page header, if needed --
    IF wPos.word = FIRST[VMDefs.PageIndex] THEN
      BEGIN
      wPage ¬ VMDefs.UsePage[wPos.page];
      BEGIN
      header: LONG POINTER TO PageHeader = LOOPHOLE[wPage, LONG POINTER] + wPos.word;
      header.offset ¬ reader.offset;
      wPos.word ¬ wPos.word + SIZE[PageHeader];
      END;
      END;
    -- Write object or sub-object header --
    object ¬ LOOPHOLE[wPage, LONG POINTER] + wPos.word;
    wPos.word ¬ wPos.word + SIZE[ObjectHeader];
    object.number ¬ number;
    object.size ¬ 0;
    END;

  TerminatePage: PROCEDURE [current: ObjectDirXDefs.ObjectNumber] =
    BEGIN  --write wPage to disk and update object directory and free files--
    VMDefs.MarkStartWait[wPage];
    copied ¬ copied + 1;
    VMDefs.Deactivate[wPage];
    -- altering object directory is now ok, even although old copies of --
    -- the objects in wPage still exist on other pages --
    WHILE moveChain # endObj DO
      BEGIN
      ptr: ObjPtr = moveChain;
      moveChain ¬ moveChain.next;
      ObjectDirXDefs.MoveObject[ptr.obj, ptr.where];
      --ensure the readers are not confused --
      HeapXDefs.RestartAllReaders[ptr.obj];
      FreeObjRec[ptr];
      END;
      ENDLOOP;
    PolicyDefs.CompactorPause[];
    HeapXDefs.StopAllReaders[stoppedObj ¬ current];
    Flush[];
    wPos ¬ HeapFileDefs.NextPage[wPos];
    freed ¬ freed + HeapFileDefs.FreeSegment[wPos, reader.where];
    -- leaves readers for "current" stopped --
    IF freed # 0 THEN firstGap ¬ MIN[firstGap, copied-1];
    END;

  stoppedObj: ObjectDirXDefs.ObjectNumber ¬ ObjectDirXDefs.gapObjectNumber;

  RestartStoppedObj: PROCEDURE =
    BEGIN
    IF stoppedObj # ObjectDirXDefs.gapObjectNumber THEN
      HeapXDefs.RestartAllReaders[stoppedObj];
    stoppedObj ¬ ObjectDirXDefs.gapObjectNumber;
    END;

  BufferNotFilled: ERROR = CODE;
  ObjectNotDestroyed: ERROR = CODE;

  RunCompactor: PROCEDURE =
    BEGIN
    startTime  ¬ System.GetGreenwichMeanTime[];
    -- Never returns --
    DO
      PolicyDefs.CompactorStart[];
      Start[];

      DO
        FindObject[ ! HeapFileDefs.NoMorePages => EXIT];

        BEGIN
        objectEnded: BOOLEAN ¬ FALSE;
        objectStartPage: VMDefs.PageNumber = reader.where.page.page;

        SetHeader[reader.object];

        UNTIL objectEnded DO  -- copy data into wPage --
          BEGIN
          buffer: HeapDefs.Buffer;
          buffer ¬ [wPage + wPos.word, 1 + LAST[VMDefs.PageIndex] - wPos.word];
          [objectEnded, object.size] ¬ HeapDefs.HeapReadData[
            readerHandle, buffer];
          -- always 'objectEnded' and/or object.size=buffer.length --
          wPos.word ¬ wPos.word + object.size;
          END;
          -- move to new page, if needed, even if objectEnded --
          IF wPos.word + SIZE[ObjectHeader] > LAST[VMDefs.PageIndex] THEN
            BEGIN
            RestartStoppedObj[];
            TerminatePage[reader.object];
            SetHeader[reader.object];
            END
          ELSE IF NOT objectEnded THEN ERROR BufferNotFilled[];
          ENDLOOP --for each object-- ;

        RestartStoppedObj[];

        IF reader.where.page.page # objectStartPage THEN  -- HeapReadData moved us beyond last deleted object page --
          dorpc ¬ dorpc + 1;

        END;
        ENDLOOP --end of last object-- ;

      --pad last page with gap, and write to disk--
      SetHeader[ObjectDirXDefs.gapObjectNumber];
      object.size ¬ 1 + LAST[VMDefs.PageIndex] - wPos.word;
      TerminatePage[ObjectDirXDefs.gapObjectNumber];
      RestartStoppedObj[];
      EmptyPage[reader.where.page];
      ObjectDirXDefs.ReportDofpc[dorpc];  -- everything has been flushed --
      Finish[];
      ENDLOOP -- eternal loop of compactions -- ;
    END --Compact-- ;


  -- Main Program --

  Process.InitializeMonitor[@reader.LOCK];
  Process.InitializeCondition[@reader.canStart, 0];
  Process.DisableTimeout[@reader.canStart];
  reader.stopped ¬ FALSE;

  RunCompactor[];


  END.