-- SwapBufferImpl.mesa  (last edited by: Levin on: August 3, 1982 3:55 pm)

DIRECTORY
  SwapBuffer USING [],
  Environment USING [Base, bitsPerWord, first64K, Word],
  Inline USING [BITAND, BITNOT, BITOR, BITSHIFT],
  PageMap USING [flagsVacant, GetF],
  ResidentHeap USING [MakeNode],
  Runtime USING [CallDebugger],
  RuntimeInternal USING [WorryCallDebugger],
  SimpleSpace USING [AllocateVM],
  Space USING [defaultWindow],
  StoragePrograms USING [DescribeSpace, outlaw],
  SwapperPrograms USING [],
  VM USING [Interval, PageCount, PageNumber, PageOffset],
  Zone USING [Status];

SwapBufferImpl: MONITOR
  IMPORTS
    Inline, PageMap, ResidentHeap, Runtime, RuntimeInternal, SimpleSpace,
    StoragePrograms
  EXPORTS SwapBuffer, SwapperPrograms
  SHARES PageMap =
  BEGIN

  Status: TYPE = {free, busy};  -- i.e. 0 is free

  pageBuffer: VM.PageNumber;
  countBuffer: VM.PageCount;
  pAllocationMap: LONG POINTER TO ARRAY [0..0) OF Environment.Word;
  deallocation: CONDITION;

  Error: PROCEDURE =
    BEGIN
    DO
      RuntimeInternal.WorryCallDebugger["SwapBufferImpl consistency check"L]
      ENDLOOP
    END;

  InitializeSwapBuffer: PUBLIC PROCEDURE =
    BEGIN
    allocMapSize: CARDINAL;
    node: Environment.Base RELATIVE POINTER;
    s: Zone.Status;
    w: CARDINAL;
    countBuffer ← 500;  -- I wonder what a more algorithmic value would be...
    pageBuffer ← SimpleSpace.AllocateVM[countBuffer, hyperspace];
    StoragePrograms.DescribeSpace[  -- tells Swapper about swap buffer space.
      StoragePrograms.outlaw, pageBuffer, countBuffer, Space.defaultWindow];
    allocMapSize ←
      (countBuffer + Environment.bitsPerWord - 1)/Environment.bitsPerWord;
    [node, s] ← ResidentHeap.MakeNode[allocMapSize];
    IF s ~= okay THEN Runtime.CallDebugger["Resident heap full"L];
    pAllocationMap ← @Environment.first64K[node];
    FOR w IN [0..allocMapSize) DO pAllocationMap[w] ← 0 ENDLOOP;
    -- SetBlock would be handy
    END;

  Allocate: PUBLIC ENTRY PROCEDURE [count: VM.PageCount]
    RETURNS [interval: VM.Interval] =
    BEGIN
    offsetPage: VM.PageOffset;
    offsetOffset: VM.PageOffset;
    DO  -- until enough space is available
      FOR offsetPage ← 0, offsetPage + offsetOffset + 1 WHILE offsetPage + count
        <= countBuffer DO
        BEGIN
        FOR offsetOffset DECREASING IN [0..count) DO
          IF GetStatus[offsetPage + offsetOffset] ~= free THEN GO TO HoleTooSmall
          ENDLOOP;
        FOR offsetOffset IN [0..count) DO
          SetStatus[offsetPage + offsetOffset, busy] ENDLOOP;
        RETURN[[pageBuffer + offsetPage, count]]
        EXITS HoleTooSmall => NULL
        END;
        ENDLOOP;
      WAIT deallocation
      ENDLOOP
    END;

  Deallocate: PUBLIC ENTRY PROCEDURE [interval: VM.Interval] =
    BEGIN
    offset: VM.PageOffset;
    --assert--
    IF ~(interval.page IN [pageBuffer..pageBuffer + countBuffer))
      OR ~(interval.page + interval.count IN [pageBuffer..pageBuffer + countBuffer])
      THEN Error[];
    FOR offset IN [0..interval.count) DO
      --assert--
      IF PageMap.GetF[interval.page].valueOld.flags ~= PageMap.flagsVacant THEN
        Error[];
      SetStatus[interval.page - pageBuffer + offset, free];
      ENDLOOP;
    BROADCAST deallocation;
    END;

  GetStatus: PROCEDURE [offset: VM.PageOffset] RETURNS [Status] = INLINE
    BEGIN
    w: CARDINAL = offset/Environment.bitsPerWord;
    bit: Environment.Word = Inline.BITSHIFT[
      1, offset MOD Environment.bitsPerWord];
    RETURN[IF Inline.BITAND[pAllocationMap[w], bit] = 0 THEN free ELSE busy]
    END;

  SetStatus: PROCEDURE [offset: VM.PageOffset, status: Status] = INLINE
    BEGIN
    w: CARDINAL = offset/Environment.bitsPerWord;
    bit: Environment.Word = Inline.BITSHIFT[
      1, offset MOD Environment.bitsPerWord];
    pAllocationMap[w] ← Inline.BITOR[
      Inline.BITAND[pAllocationMap[w], Inline.BITNOT[bit]],
      IF status = free THEN 0 ELSE bit]
    END;

  END.

May 22, 1978  10:57 AM  McJones  Create file
August 4, 1978  9:42 AM  McJones  Allocate allocationMap locally; add initialization, condition variable
August 18, 1978  11:53 AM  McJones  Initialization followed module END!
September 7, 1978  10:42 AM  Redell  Allow allocation/deallocation of zero-length buffers
September 8, 1978  2:00 PM  McJones  Fix check for end of intervalBuffer in Allocate
October 5, 1979  9:03 AM  McJones  Allocation map in heap
April 2, 1980  1:54 PM  Knutsen  Add InitializeSwapBuffer
September 23, 1980  12:15 PM  McJones  Check that buffer is not mapped in Deallocate
December 2, 1980  12:21 PM  Luniewski  Make inner loop in Allocate be DECREASING for efficiency reasons.  Make Get/Set status be Inline's.
14-Jan-82 16:45:02	Levin	Cut countBuffer down to a reasonable size (used to be SpecialSpace.realMemorySize).
August 3, 1982 3:55 pm	Levin	Correct all occurrences of ~IN.