-- VMMgr>MapLogImpl.mesa  (last edited by Levin on 12-Feb-82 18:13:11)

DIRECTORY
  CachedRegion USING [activate, Apply, --deactivate,-- Outcome],
  CachedSpace USING [Desc, Get],
  Environment USING [wordsPerPage],
  File USING [Capability, PageCount],
  Inline USING [LowHalf],
  KernelFile USING [GetFilePoint],
  MapLog USING [],
  PilotSwitches USING [switches --.m--],
  SimpleSpace USING [Create, Handle, Map, Page],
  Space USING [WindowOrigin],
  Utilities USING [LongPointerFromPage],
  VM USING [Interval, PageCount, PageNumber],
  VMMapLog USING [--Descriptor,-- Entry, EntryBasePointer, PatchTable],
  VMMgrStore USING [AllocateMapLogFile],
  VMMPrograms USING [];

MapLogImpl: PROGRAM [pMapLogDesc: LONG POINTER]
  -- logically, this should be a monitor, but it is only called from
  -- SpaceImpl, and is protected by its monitor lock.
  IMPORTS CachedRegion, CachedSpace, Inline, KernelFile, PilotSwitches,
    SimpleSpace, Utilities, VMMgrStore
  EXPORTS MapLog, VMMPrograms =
BEGIN OPEN VMMapLog;

maxPagesPerEntry: CARDINAL = 4096; -- should be in VMMapLog!


-- Note:  the following declaration must match VMMapLog (which we can't yet
-- afford to recompile.)  The only difference is that the EntryPointers are
-- now ORDERED.

Descriptor: TYPE = MACHINE DEPENDENT RECORD [
  self: Entry, -- description of virtual memory used by Pilot to access log
  writer: EntryPointer,
  reader: EntryPointer,
  limit: EntryPointer,
  patchTable: LONG POINTER TO PatchTable];
  
EntryPointer: TYPE = EntryBasePointer RELATIVE ORDERED POINTER [0..177777B] TO Entry;

Grain: TYPE = MACHINE DEPENDENT RECORD [
  SELECT OVERLAID * FROM
    pointer => [p: EntryPointer],
    offset => [n: CARDINAL],
    ENDCASE];

mapLogging: PUBLIC BOOLEAN = PilotSwitches.switches.m = up;

-- Performance parameters:
grainPages: VM.PageCount = 1;  -- this should evenly divide countLog
threshold: CARDINAL = 6*SIZE[Entry];  -- distance from grain boundary that triggers page-in of adjacent grain

pageLog: VM.PageNumber;
countLog: VM.PageCount;
bLog: EntryBasePointer;

-- Invariant for the following pointers:
--  They point at the first and last words, respectively, of the grain of the log that
--  surrounds the last actual entry of the log (i.e., the one pointed to by
--  pM.writer-SIZE[Entry]).  Note that they typically will not point to the start of
--  an entry.
grainStart, grainEnd: Grain;

MapLogFull: ERROR = CODE;

Bug: ERROR [type: BugType] = CODE;
BugType: TYPE = {
  bogusVariant, unmapIntervalDoesntMatchMap, cantFindEntry, activateFailed, smashedEntry};

-- Statistics:

statistics: BOOLEAN = TRUE;

totalMaps, totalUnmaps: LONG CARDINAL _ 0;
multiEntryMaps: LONG CARDINAL _ 0;
topOfStackHits: LONG CARDINAL _ 0;
simpleCompressions: LONG CARDINAL _ 0;
fullCompressions: LONG CARDINAL _ 0;
uselessCompressions: LONG CARDINAL _ 0;
crossGrainUnmaps: LONG CARDINAL _ 0;


WriteLog1: PUBLIC PROCEDURE [
  interval: VM.Interval, pSpaceD: POINTER TO CachedSpace.Desc] =
  BEGIN
  pM: LONG POINTER TO Descriptor = LOOPHOLE[pMapLogDesc];
  Compress: PROCEDURE [howMuch: {oneGrain, wholeLog}] =
    BEGIN
    start, end, out: EntryPointer;
    SELECT howMuch FROM
      oneGrain =>
        BEGIN
        start _ LOOPHOLE[((grainStart.n + SIZE[Entry] - 1)/SIZE[Entry])*SIZE[Entry]];
        end _ pM.writer;
        IF statistics THEN simpleCompressions _ simpleCompressions + 1;
        END;
      wholeLog =>
        BEGIN
        start _ pM.reader;
        end _ pM.limit;
        IF statistics THEN fullCompressions _ fullCompressions + 1;
        END;
      ENDCASE;
    out _ start;
    FOR in: EntryPointer _ start, in + SIZE[Entry] UNTIL in >= end DO
      IF bLog[in].kind ~= nil THEN
        BEGIN
        IF in ~= out THEN
	  BEGIN
	  -- We want to be careful that, if we pagefault while copying this entry,
	  -- the debugger won't get confused.  The logic below assumes it is OK for
	  -- the debugger to see two entries with identical contents.  We'd like to
	  -- write this as follows:
	  -- temp: Entry _ bLog[in];
	  -- IF temp.kind ~= disk THEN ERROR Bug[smashedEntry];
	  -- bLog[out].kind _ temp.kind _ nil;
	  -- bLog[out] _ temp;
	  -- bLog[out].kind _ disk;
	  -- However, the compiler won't let us.  As the result, we have to do
	  -- something ugly...
	  EntryHack: TYPE = MACHINE DEPENDENT RECORD [
	    body(0): SELECT OVERLAID * FROM
	      real => [entry(0): Entry],
	      hack => [fill1(0): CARDINAL, fill2(1:0..13): [0..37777B], tag(1: 14..15): [0..3]],
	      ENDCASE];
	  nilEntry: Entry = [page: , count: , writeProtected: , fill: , filePoint:  nil[]];
	  outPtr: LONG POINTER TO EntryHack _ LOOPHOLE[@bLog[out]];
	  temp: EntryHack;
	  IF (temp.entry _ bLog[in]).kind ~= disk THEN ERROR Bug[smashedEntry];
	  outPtr.tag _ temp.tag _ LOOPHOLE[nilEntry.kind];  -- now the destination looks empty to the debugger
	  outPtr.entry _ temp.entry;  -- throughout this copy, it still looks empty
	  outPtr.tag _ LOOPHOLE[bLog[in].kind];
	  END;
        out _ out + SIZE[Entry];
        END;
      ENDLOOP;
    IF statistics AND end = out THEN uselessCompressions _ uselessCompressions + 1;
    pM.writer _ out;
    END;
  Touch: PROCEDURE [where: {above, below}] =
    BEGIN
    grainOffset: CARDINAL _ grainStart.n/(grainPages*Environment.wordsPerPage);
    SELECT where FROM
      above => IF (grainOffset _ grainOffset + grainPages) >= countLog THEN RETURN;
      below => IF grainOffset = 0 THEN RETURN ELSE grainOffset _ grainOffset - grainPages;
      ENDCASE;
    IF CachedRegion.Apply[pageLog + grainOffset, CachedRegion.activate].outcome ~= [ok[]] THEN
      ERROR Bug[activateFailed];
    END;
  fileOffset: File.PageCount _ 0;
  IF ~mapLogging THEN RETURN;
  IF pSpaceD ~= NIL THEN
    BEGIN
    IF statistics THEN totalMaps _ totalMaps + 1;
    WHILE interval.count > 0 DO
      count: VM.PageCount _ MIN[interval.count, maxPagesPerEntry];
      pEntry: LONG POINTER TO Entry;
      IF pM.writer > grainEnd.p THEN
        BEGIN
        Compress[oneGrain];
        IF pM.writer >= pM.limit THEN
	  BEGIN
	  -- compression accomplished nothing and log is full
	  Compress[wholeLog];
	  IF pM.writer >= pM.limit THEN ERROR MapLogFull;
	  ResetGrain[pM.writer];
	  END
        ELSE
	  IF pM.writer > grainEnd.p THEN ResetGrain[pM.writer];  -- no space acquired; move to next grain
        END;
      pEntry _ @bLog[pM.writer];
      KernelFile.GetFilePoint[pEntry, @pSpaceD.window.file, pSpaceD.window.base + fileOffset];
      pEntry.page _ interval.page;
      count _ pEntry.count _ MIN[pEntry.count, count];  -- describes a physical run
      pEntry.writeProtected _ pSpaceD.writeProtected;
      IF statistics AND fileOffset = 0 --i.e. first time-- AND count ~= interval.count THEN
        multiEntryMaps _ multiEntryMaps + 1;
      fileOffset _ fileOffset + count;
      IF grainEnd.p - pM.writer < threshold THEN Touch[above];
      pM.writer _ pM.writer + SIZE[Entry];
      interval _ [interval.page + count, interval.count - count];
      ENDLOOP;
    END
  ELSE
    BEGIN
    totalCount: VM.PageCount _ interval.count;
    entry: EntryPointer _ pM.writer;
    IF statistics THEN totalUnmaps _ totalUnmaps + 1;
    DO
      IF totalCount = 0 THEN EXIT;
      IF entry = pM.reader THEN ERROR Bug[cantFindEntry];
      entry _ entry - SIZE[Entry];
      WITH e: bLog[entry] SELECT FROM
	disk =>
	  BEGIN
	  upperLimit: VM.PageNumber = interval.page + interval.count;
	  IF e.page IN [interval.page..upperLimit) THEN
	    BEGIN
	    IF e.page + e.count > upperLimit OR e.count > totalCount THEN ERROR Bug[unmapIntervalDoesntMatchMap];
	    totalCount _ totalCount - e.count;
	    bLog[entry].filePoint _ nil[];
	    IF entry = pM.writer - SIZE[Entry] THEN
	      BEGIN  -- unmapping the most recently mapped space.
	      IF statistics AND totalCount = 0 -- don't count each piece -- THEN
	        topOfStackHits _ topOfStackHits + 1;
	      pM.writer _ entry;
	      IF pM.writer < grainStart.p THEN ResetGrain[pM.writer - SIZE[Entry]];
	      END;
	    END;
	  END;
	nil => NULL;
	ENDCASE => ERROR Bug[bogusVariant];
      IF statistics AND entry = grainStart.p THEN crossGrainUnmaps _ crossGrainUnmaps + 1;
      ENDLOOP;
    IF pM.writer - grainStart.p < threshold THEN Touch[below];
    END;
  END;

ResetGrain: PROCEDURE [entry: EntryPointer] =
  BEGIN
  -- resets the grain limit pointers to enclose 'entry'.
  pM: LONG POINTER TO Descriptor = LOOPHOLE[pMapLogDesc];
  grainWords: CARDINAL = grainPages*Environment.wordsPerPage;
  grainStart.n _ (LOOPHOLE[entry, CARDINAL]/grainWords)*grainWords;
  grainEnd.p _ MIN[grainStart.p + grainWords, pM.limit] - 1;
  END;

Initialize: PROCEDURE =
  BEGIN
  pM: LONG POINTER TO Descriptor = LOOPHOLE[pMapLogDesc];
  handle: SimpleSpace.Handle;
  window: Space.WindowOrigin;
  desc: CachedSpace.Desc;

  IF ~mapLogging THEN RETURN;
  countLog _ Inline.LowHalf[VMMgrStore.AllocateMapLogFile[pWindowResult: @window].count];
  KernelFile.GetFilePoint[@pM.self, @window.file, window.base];
  handle _ SimpleSpace.Create[count: countLog, location: hyperspace, sizeSwapUnit: grainPages];
  SimpleSpace.Map[handle: handle, window: window, andPin: FALSE];
  pM.self.page _ pageLog _ SimpleSpace.Page[handle];
  pM.self.count _ MIN[pM.self.count, countLog];
  pM.writer _ pM.reader _ FIRST[EntryPointer];
  pM.limit _ LOOPHOLE[countLog*Environment.wordsPerPage/SIZE[Entry]*SIZE[Entry], EntryPointer];
  ResetGrain[pM.writer];
  bLog _ LOOPHOLE[Utilities.LongPointerFromPage[pM.self.page]];
  -- map log space is set up, now map log it`
  CachedSpace.Get[@desc, LOOPHOLE[handle]];
  WriteLog1[interval: [pM.self.page, countLog], pSpaceD: @desc];
  END;

Initialize[];


END.


LOG

Time: August 1, 1978  10:11 AM	By: McJones
	Action: Create file
Time: August 7, 1978  4:51 PM	By: McJones
	Action: pDesc.self.page wasn't initialized
Time: August 8, 1978  9:10 AM	By: McJones
	Action: WriteLog didn't set entry page field in case of non-nil
	pWindow
Time: August 8, 1978  3:25 PM	By: McJones
	Action: limit initialization didn't convert pages to words
Time: August 29, 1978  4:44 PM	By: McJones
	Action: Add VMMode
Time: September 5, 1978  6:48 PM	By: McJones
	Action: Replace signal with CleanMapLog[], GetFilePoint moved
	to SpecialFile
Time: September 15, 1978  4:47 PM	By: McJones
	Action: Getting ready for "uniform" swap unit management
Time: September 29, 1978  11:05 AM	By: McJones
	CR20.42: Replace PutRootFile with MakePermanent
Time: July 31, 1979  1:12 PM	By: McJones
	Action: Prepared to add writeProtected to map log entry
Time: August 16, 1979  8:56 PM	By: McJones
	Action: Add writeProtected to map log entry; SpecialFile =>
	KernelFile; VMMode => PilotSwitches
Time: September 4, 1979  10:00 AM	By: Forrest
	Action: Change to use PilotFileTypes
Time: November 7, 1979  2:39 PM	By: McJones
	AR2744: Create backing file even if map log disabled
Time: November 21, 1979  9:18 AM	By: Knutsen
	Action: Use backing file now provided by STLeafImpl.
Time: June 3, 1980  12:19 PM	By: Knutsen
	Action: Use Uniform Swap Units. Activate/deactivate as appropriate.
	Named the errors.
Time: December 19, 1980  11:10 AM	By: Gobbel
	Action: Remove requirement that map log file be contiguous.
Time: January 9, 1981  3:22 PM	By: Gobbel
	Action: Fix bug introduced by previous change: make count of "self"
	entry be MIN of self.count and countLog, instead of size of whole
	page group.
Time: January 13, 1981  12:03 PM	By: Gobbel
	Action: Make mapLogging be PUBLIC, chane WriteLog to WriteLog1.
Time: 23-Nov-81 10:28:37		By: Levin
	Action: Implementation completely changed.  The map log is now a
	complete history rather than a chronological log of recent events.
	Although in principle this would require an unreasonbly large
	number of entries, empirical observation shows that, in practice,
	a plateau is reach quite quickly and that most Map/Unmap activity is
	essentially stack-like.  The algorithm takes care that the
	non-stack-like cases do not significantly perturb the working set.
	Specifically, a Map operation never touches more than one stack "grain",
	unless the grain is completely full.  An Unmap operation only touches
	multiple grains when the corresponding map entry is not near the top
	of the stack.  We take care to avoid thrashing at grain boundaries and
	unnecessary compression of dead entries in the stack.
Time:  4-Feb-82 11:47:42		By: Levin
	Action: Compression is now careful to avoid an incomplete entry that
	might confuse the debugger.
Time: 12-Feb-82 18:13:11		By: Levin
	Action: Fix bug in compression that loses first entry in log; rename
	BugTypes to be more intelligible.