-- Copyright (C) 1981, 1984, 1985  by Xerox Corporation. All rights reserved. 
-- MailboxAlloc.mesa, Transport Mechanism Mail Server - Mailbox management --

-- HGM, 15-Sep-85 12:57:00
-- Andrew Birrell	September 14, 1982 2:14 pm
-- Randy Gobbel		19-May-81 20:47:16
-- Mark Johnson		19-May-81 13:43:58
-- Hankins		10-Aug-84 16:22:13	 Klamath update 

DIRECTORY
  Ascii USING [CR, TAB],
  BitMapDefs USING [Map, FindFree, Clear, Test, Set],
  BodyDefs USING [
    ItemHeader, ItemLength, maxRNameLength, oldestTime, PackedTime, RName,
    RNameSize, Timestamp],
  BTreeDefs USING [BTreeHandle, Call, Delete, EnumerateFrom, Insert, Lookup],
  EnquiryDefs USING [Handle],
  Heap USING [systemZone],
  HeapDefs USING [
    GetReaderOffset, HeapAbandonWrite, HeapEndRead, HeapEndWrite, HeapReadData,
    HeapReadRName, HeapStartRead, HeapStartWrite, HeapWriteData, HeapWriteRName,
    ObjectNumber, ReaderHandle, ReadItemHeader, SendObj, SetReaderOffset,
    WriterHandle],
  Inline USING [LongCOPY],
  LocalNameDefs USING [ReadMSName],
  LogDefs USING [DisplayNumber, ShowLine, ShowNumber, WriteChar, WriteLogEntry, WriteString],
  MailboxDefs,
  NameInfoDefs USING [Close, Enumerate, GetMembers, MemberInfo],
  ObjectDirDefs USING [noObject, FreeObject, UseObject],
  PolicyDefs USING [ArchiverPause, EndOperation, Wait, WaitOperation],
  Process USING [InitializeMonitor],
  ProtocolDefs USING [
    AppendTimestamp, Handle, Remark, SendItemHeader, SendTimestamp],
  ReturnDefs USING [CopyItem],
  SendDefs USING [Handle],
  SLDefs USING [SLHeader, SLWrite],
  SpillDefs USING [
    AddBody, ArchReader, CopyBody, CopyText, Delete, DeleteEntry, EndWrite,
    EndReading, OpenToRead, RecoverBody, ServerCrash, StartWrite, TestDeletion],
  String USING [AppendDecimal, AppendString, EquivalentStrings, LowerCase],
  Time USING [Append, Current, Unpack],
  VMDefs USING [
    Page, ReadPage, UsePage, PageNumber, PageIndex, Release, FileHandle,
    MarkStartWait, LookAheadCount];

MailboxAlloc: MONITOR
  IMPORTS
    BitMapDefs, BodyDefs, BTreeDefs, Heap, HeapDefs, Inline, LocalNameDefs, LogDefs,
    NameInfoDefs, ObjectDirDefs, PolicyDefs, Process, ProtocolDefs, ReturnDefs,
    SLDefs, SpillDefs, String, Time, VMDefs
  EXPORTS EnquiryDefs, MailboxDefs
  SHARES MailboxDefs =
  BEGIN

  MBXName: TYPE = VMDefs.PageNumber;

  MBXHandle: PUBLIC TYPE = LONG POINTER TO MBXData;

  -- representation of state of mailbox reading --
  MBXData: TYPE = MONITORED RECORD [
    lock: MBXName,  -- page number for mailbox interlock bit --
    latest: MBXName,  --address of latest page of mbx--
    where: MBXName,  --address of this page--
    current: CARDINAL,  --number of next page to be read--
    messages: LONG DESCRIPTOR FOR ARRAY OF HeapDefs.ObjectNumber,  --messages in this page--
    nextMsg: CARDINAL,  -- index into array of messages --
    object: HeapDefs.ObjectNumber,  -- current element of "messages" --
    bodyObj: HeapDefs.ObjectNumber,  --"object" without TOC indirection --
    archObj: HeapDefs.ObjectNumber,  -- current "archived" object --
    archCount: CARDINAL,  -- count relative to start of archive file --
    archFile: SpillDefs.ArchReader,
    archOpen: BOOLEAN,
    remainder: CARDINAL,  -- number of messages left in the mailbox --
    next: MBXHandle,  -- for free chain of 'MBXData's--
    page: VMDefs.Page --current page buffer-- ];

  -- header in disk representation of each mailbox page --
  MBXHeader: TYPE = RECORD [
    chain: MBXName,  --previous MBX page of this MBX--
    first: VMDefs.PageIndex,  --first entry in this page--
    free: VMDefs.PageIndex,
    number: CARDINAL --page number within this MBX-- ];

  MBXEnd: MBXHandle = NIL;
  MBXChain: MBXHandle ¬ MBXEnd;

  handle: VMDefs.FileHandle;
  lookAhead: VMDefs.LookAheadCount = 0;

  pageMap: BitMapDefs.Map;

  mailboxes: CARDINAL ¬ 0;

  -- proc var's for MailboxRestart to use:

  Arch: TYPE = PROC;
  FindIn: TYPE = PROC [who: BodyDefs.RName] RETURNS [TreeRec];
  GetBody: TYPE = PROC [given: HeapDefs.ObjectNumber]
    RETURNS [body: HeapDefs.ObjectNumber];
  ReadP: TYPE = PROC [body: HeapDefs.ObjectNumber]
    RETURNS [postmark: BodyDefs.Timestamp];
  ChangeIn: TYPE = PROC [
    who: BodyDefs.RName, where, lock: MBXName, oldest: BodyDefs.Timestamp];

  archiver: Arch ¬ Archiver;
  findInTree: FindIn ¬ FindInTree;
  getBodyObj: GetBody ¬ GetBodyObj;
  readPostmark: ReadP ¬ ReadPostmark;
  changeInTree: ChangeIn ¬ ChangeInTree;
  
  myName: BodyDefs.RName = [BodyDefs.maxRNameLength];

  -- punning for R-Names --

  RNameDesc: PROCEDURE [name: BodyDefs.RName]
    RETURNS [LONG DESCRIPTOR FOR ARRAY OF WORD] =
    BEGIN
    index: CARDINAL;
    FOR index IN [0..name.length) DO
      name[index] ¬ String.LowerCase[name[index]] ENDLOOP;
    IF name.length MOD 2 # 0 THEN name[name.length] ¬ '@;
    RETURN[DESCRIPTOR[@(name.text), (1 + name.length) / 2]]
    END;


  -- Management of Btree entries --

  tree: BTreeDefs.BTreeHandle;

  TreeRec: TYPE = RECORD [
    SELECT t: * FROM
    found => [where, lock: MBXName, oldest: BodyDefs.Timestamp],
    empty => [last: BodyDefs.Timestamp],
    ENDCASE];

  FindInTree: INTERNAL PROCEDURE [who: BodyDefs.RName] RETURNS [TreeRec] =
    BEGIN
    value: TreeRec;
    length: CARDINAL = BTreeDefs.Lookup[
      tree, RNameDesc[who], DESCRIPTOR[@value, SIZE[TreeRec]]];
    IF length = 177777B THEN  -- not in tree --
      RETURN[[empty[BodyDefs.oldestTime]]]
    ELSE RETURN[value]
    END;

  ChangeInTree: INTERNAL PROCEDURE [
    who: BodyDefs.RName, where, lock: MBXName, oldest: BodyDefs.Timestamp] =
    BEGIN
    value: TreeRec ¬ [found[where: where, lock: lock, oldest: oldest]];
    BTreeDefs.Insert[tree, RNameDesc[who], DESCRIPTOR[@value, SIZE[TreeRec]]];
    END;

  EmptyInTree: ENTRY PROCEDURE [who: BodyDefs.RName, last: BodyDefs.Timestamp] =
    BEGIN
    value: TreeRec ¬ [empty[last]];
    BTreeDefs.Insert[tree, RNameDesc[who], DESCRIPTOR[@value, SIZE[TreeRec]]];
    mailboxes ¬ mailboxes - 1;
    END;

  PurgeFromTree: ENTRY PROCEDURE [who: BodyDefs.RName] =
    BEGIN
    value: TreeRec = FindInTree[who];
    WITH value SELECT FROM
      empty => BTreeDefs.Delete[tree, RNameDesc[who]];
      ENDCASE => NULL -- someone else may have reinstated it -- ;
    END;

  EnumerateTree: ENTRY PROC [work: PROC [BodyDefs.RName, found TreeRec]] =
    BEGIN
    -- beware: calls "work" with the monitor locked --
    Action: INTERNAL BTreeDefs.Call =
      BEGIN
      value: LONG POINTER TO TreeRec = LOOPHOLE[BASE[v]];
      name: BodyDefs.RName = [BodyDefs.maxRNameLength];
      more ¬ TRUE;
      dirty ¬ FALSE;  -- results of "Action" --
      IF LENGTH[k] = 0 THEN RETURN;
      name.length ¬ 2 * LENGTH[k];
      Inline.LongCOPY[from: BASE[k], to: @(name.text), nwords: LENGTH[k]];
      IF name.length > 0 AND name[name.length - 1] = '@ THEN
        name.length ¬ name.length - 1 -- undo padding kludge -- ;
      WITH res: value SELECT FROM found => work[name, res]; ENDCASE => NULL;
      END;
    BTreeDefs.EnumerateFrom[tree, DESCRIPTOR[NIL, 0], Action ! UNWIND => NULL];
    END;


  -- Interlocks on mailboxes --

  -- the lock map is used for single writer/multiple reader synchronization
  -- Any potential writer tests the lock; readers claim it.  Both always
  -- have the monitor lock while doing this.

  lockMap: BitMapDefs.Map;
  conflictMap: BitMapDefs.Map;

  MBXFree: CONDITION;

  AcquireMBX: INTERNAL PROCEDURE [who: BodyDefs.RName]
    RETURNS [found: BOOLEAN, mbx, lock: MBXName] =
    BEGIN
    DO
      value: TreeRec = FindInTree[who];
      WITH res: value SELECT FROM
        empty => {found ¬ FALSE; EXIT};
        found =>
          IF LockedMBX[res.lock] THEN WAIT MBXFree
          ELSE
            BEGIN
            found ¬ TRUE;
            mbx ¬ res.where;
            lock ¬ res.lock;
            BitMapDefs.Set[lockMap, lock];
            EXIT
            END;
        ENDCASE => ERROR;
      ENDLOOP;
    END;

  LockedMBX: INTERNAL PROCEDURE [lock: MBXName] RETURNS [locked: BOOLEAN] =
    BEGIN
    locked ¬ BitMapDefs.Test[lockMap, lock];
    IF locked THEN BitMapDefs.Set[conflictMap, lock];
    END;

  FreeMBX: INTERNAL PROCEDURE [lock: MBXName] =
    BEGIN
    BitMapDefs.Clear[lockMap, lock];
    IF BitMapDefs.Test[conflictMap, lock] THEN {
      BitMapDefs.Clear[conflictMap, lock]; NoteUnlocked[]};
    BROADCAST MBXFree;
    END;

  unlockedMBX: BOOLEAN ¬ TRUE;
  unlockedMBXCond: CONDITION;

  WaitForUnlocked: PUBLIC ENTRY PROC =
    BEGIN
    UNTIL unlockedMBX DO WAIT unlockedMBXCond ENDLOOP;
    unlockedMBX ¬ FALSE;
    END;

  NoteUnlocked: INTERNAL PROC = INLINE {
    unlockedMBX ¬ TRUE; NOTIFY unlockedMBXCond};


  -- Access to mailboxes --

  nextVirginPage: VMDefs.PageNumber;  -- size of mailbox file --
  WrongNewMBXPage: ERROR = CODE;

  mailboxContents: LONG CARDINAL ¬ 0;

  MBXWrite: PUBLIC ENTRY PROCEDURE [
    who: BodyDefs.RName, obj: HeapDefs.ObjectNumber, postmark: BodyDefs.Timestamp]
    RETURNS [done: BOOLEAN] =
    BEGIN
    ENABLE UNWIND => NULL;
    addPage: BOOLEAN ¬ FALSE;
    page: VMDefs.Page;
    header: LONG POINTER TO MBXHeader;
    number: CARDINAL;  -- number of a new page within this mailbox --
    mbx: TreeRec = FindInTree[who: who];
    WITH tree: mbx SELECT FROM
      empty =>
        BEGIN
        IF tree.last = postmark THEN {
          LogDefs.WriteChar['E];
          LogDefs.WriteChar['!];
          RETURN[TRUE] --duplicate-- };
        number ¬ 0;
        addPage ¬ TRUE;
        -- no interlock to check --
        END;
      found =>
        BEGIN
        page ¬ VMDefs.ReadPage[[handle, tree.where], lookAhead];
        header ¬ LOOPHOLE[page, LONG POINTER] + FIRST[VMDefs.PageIndex];
        IF header.first # header.free THEN  -- test for duplicate elimination --
          BEGIN
          x: LONG POINTER TO HeapDefs.ObjectNumber =
            LOOPHOLE[page, LONG POINTER] + header.free - SIZE[HeapDefs.ObjectNumber];
          IF x­ = obj THEN
            BEGIN
            VMDefs.Release[page];
            LogDefs.WriteChar['E];
            RETURN[TRUE]  --duplicate--
            END;
          END;
        IF LockedMBX[tree.lock] THEN BEGIN VMDefs.Release[page]; RETURN[FALSE] END
        --ELSE we are protected by our monitor lock -- ;
        IF header.free + SIZE[HeapDefs.ObjectNumber] > LAST[VMDefs.PageIndex] THEN
          -- will need to expand to another page --
          BEGIN
          number ¬ header.number + 1;
          VMDefs.Release[page];
          addPage ¬ TRUE;
          END;
        IF tree.oldest = BodyDefs.oldestTime AND NOT addPage THEN
          ChangeInTree[
            who: who, where: tree.where, lock: tree.lock, oldest: postmark];
        END;
      ENDCASE => ERROR;
    IF addPage THEN
      BEGIN  -- create and initialise new page of mailbox --
      desc: LONG DESCRIPTOR FOR ARRAY OF WORD = DESCRIPTOR[
        who, BodyDefs.RNameSize[who]];
      new: MBXName = BitMapDefs.FindFree[pageMap];
      IF new >= nextVirginPage THEN
        IF new > nextVirginPage THEN ERROR WrongNewMBXPage[]
        ELSE nextVirginPage ¬ nextVirginPage + 1;
      BitMapDefs.Set[pageMap, new];
      WITH tree: mbx SELECT FROM
        empty =>
          BEGIN
          ChangeInTree[who: who, where: new, lock: new, oldest: postmark];
          mailboxes ¬ mailboxes + 1;
          END;
        found =>
          ChangeInTree[
            who: who, where: new, lock: tree.lock,
            oldest:
            IF tree.oldest = BodyDefs.oldestTime THEN postmark ELSE tree.oldest];
        ENDCASE => ERROR;
      page ¬ VMDefs.UsePage[[handle, new]];
      header ¬ LOOPHOLE[page, LONG POINTER] + FIRST[VMDefs.PageIndex];
      header.free ¬ FIRST[VMDefs.PageIndex] + SIZE[MBXHeader];
      Inline.LongCOPY[BASE[desc], LENGTH[desc], page + header.free];
      header.first ¬ header.free ¬ header.free + LENGTH[desc];
      header.chain ¬
        WITH tree: mbx SELECT FROM found => tree.where, ENDCASE => new
      -- end-of-chain -- ;
      header.number ¬ number;
      END;
    BEGIN
    x: LONG POINTER TO HeapDefs.ObjectNumber = LOOPHOLE[page, LONG POINTER] + header.free;
    x­ ¬ obj;
    END;
    header.free ¬ header.free + SIZE[HeapDefs.ObjectNumber];
    ObjectDirDefs.UseObject[obj];
    mailboxContents ¬ mailboxContents + 1;  -- global count --
    VMDefs.MarkStartWait[page];
    VMDefs.Release[page];
    RETURN[TRUE]
    END;

  FreeMBXPage: ENTRY PROC [page: MBXName] = {BitMapDefs.Clear[pageMap, page]};

  Poll: PUBLIC ENTRY PROCEDURE [who: BodyDefs.RName] RETURNS [found: BOOLEAN] =
    BEGIN
    value: TreeRec = FindInTree[who];
    found ¬ WITH value SELECT FROM found => TRUE, ENDCASE => FALSE;
    END;

  Open: PUBLIC ENTRY PROCEDURE [who: BodyDefs.RName]
    RETURNS [found: BOOLEAN, count: CARDINAL, mbx: MBXHandle] =
    BEGIN
    IF MBXChain = MBXEnd THEN mbx ¬ Heap.systemZone.NEW[MBXData]
    ELSE BEGIN mbx ¬ MBXChain; MBXChain ¬ MBXChain.next END;
    [found, mbx.latest, mbx.lock] ¬ AcquireMBX[who: who];
    IF found THEN
      BEGIN
      Process.InitializeMonitor[@mbx.LOCK];
      SetupMBX[mbx];
      count ¬ mbx.remainder;
      END
    ELSE
      BEGIN
      LogAction[who, nothing];
      mbx.next ¬ MBXChain;
      MBXChain ¬ mbx;
      count ¬ 0;
      mbx ¬ NIL;
      END;
    END;

  Destroy: ENTRY PROC [mbx: MBXHandle] =
    BEGIN
    VMDefs.Release[mbx.page];
    FreeMBX[mbx.lock];
    mbx.next ¬ MBXChain;
    MBXChain ¬ mbx;
    END;

  RestartMBX: PROC [mbx: MBXHandle] =
    BEGIN
    -- re-positions to start of mailbox without releasing lock --
    CloseArch[mbx];
    VMDefs.Release[mbx.page];
    SetupMBX[mbx];
    END;

  SetupMBX: PROC [mbx: MBXHandle] =
    BEGIN
    mbx.current ¬ 0;
    mbx.page ¬ VMDefs.ReadPage[[handle, mbx.where ¬ mbx.latest], lookAhead];
    mbx.remainder ¬ GetPage[mbx];
    mbx.archObj ¬ ObjectDirDefs.noObject;
    mbx.archOpen ¬ FALSE;
    END;

  GetPage: PROCEDURE [mbx: MBXHandle] RETURNS [count: CARDINAL] =
    BEGIN
    header: LONG POINTER TO MBXHeader;
    count ¬ 0;
    IF mbx.where # mbx.latest THEN
      BEGIN  -- finish with previous page --
      VMDefs.Release[mbx.page];
      mbx.page ¬ VMDefs.ReadPage[[handle, mbx.where ¬ mbx.latest], lookAhead];
      END;
    DO
      BEGIN
      header ¬ LOOPHOLE[mbx.page, LONG POINTER] + FIRST[VMDefs.PageIndex];
      count ¬ count + (header.free - header.first) / SIZE[HeapDefs.ObjectNumber];
      IF header.number = mbx.current THEN EXIT;
      BEGIN
      next: MBXName = header.chain;  -- that store is about to go --
      VMDefs.Release[mbx.page];
      mbx.where ¬ next;
      END;
      mbx.page ¬ VMDefs.ReadPage[[handle, mbx.where], lookAhead];
      END;
      ENDLOOP;
    mbx.messages ¬ DESCRIPTOR[
      mbx.page + header.first,
        (header.free - header.first) / SIZE[HeapDefs.ObjectNumber]];
    mbx.nextMsg ¬ 0;
    mbx.current ¬ mbx.current + 1;
    END;

  NextMessage: PUBLIC PROC [mbx: MBXHandle]
    RETURNS [msgExists, archived, deleted: BOOLEAN] = {
    [msgExists, archived, deleted] ¬ RealNextMessage[mbx, yes]};

  RealNextMessage: PROC [mbx: MBXHandle, testArchDeletion: {yes, no}]
    RETURNS [msgExists, archived, deleted: BOOLEAN] =
    BEGIN
    IF mbx.remainder = 0 THEN RETURN[FALSE, FALSE, FALSE];
    IF mbx.nextMsg = LENGTH[mbx.messages] THEN [] ¬ GetPage[mbx];
    IF LENGTH[mbx.messages] = 0 THEN ERROR;
    mbx.nextMsg ¬ mbx.nextMsg + 1;
    mbx.remainder ¬ mbx.remainder - 1;
    mbx.object ¬ mbx.messages[mbx.nextMsg - 1];
    mbx.bodyObj ¬ GetBodyObj[mbx.object];
    archived ¬ (mbx.bodyObj.type = archived);
    IF archived THEN
      BEGIN
      ENABLE
        BEGIN
        SpillDefs.ServerCrash => ERROR InaccessibleArchive[];
        UNWIND => mbx.archOpen ¬ FALSE;
        END;
      IF mbx.bodyObj = mbx.archObj THEN mbx.archCount ¬ mbx.archCount + 1
      ELSE {CloseArch[mbx]; mbx.archObj ¬ mbx.bodyObj; mbx.archCount ¬ 0};
      IF testArchDeletion = yes THEN
        BEGIN
        OpenArch[mbx];  -- for deletion test! --
        deleted ¬ SpillDefs.TestDeletion[mbx.archFile, mbx.archCount];
        END
      ELSE deleted ¬ FALSE  --don't care--
      END
    ELSE
      BEGIN
      deleted ¬ (mbx.bodyObj = ObjectDirDefs.noObject);
      IF NOT deleted  -- deleted msgs were skipped when archiving --
        THEN {CloseArch[mbx]; mbx.archObj ¬ ObjectDirDefs.noObject};
      END;
    msgExists ¬ TRUE;
    END;

  ReadTOC: PUBLIC PROC [mbx: MBXHandle, text: ProtocolDefs.Remark] =
    BEGIN
    IF mbx.object.type # TOC THEN text.length ¬ 0
    ELSE
      BEGIN
      reader: HeapDefs.ReaderHandle = HeapDefs.HeapStartRead[mbx.object];
      obj: HeapDefs.ObjectNumber;
      [] ¬ HeapDefs.HeapReadData[reader, [@obj, SIZE[HeapDefs.ObjectNumber]]];
      --CHEAT-- [] ¬ HeapDefs.HeapReadRName[reader, text];
      HeapDefs.HeapEndRead[reader];
      END;
    END;

  GetBodyObj: PROC [given: HeapDefs.ObjectNumber]
    RETURNS [body: HeapDefs.ObjectNumber] =
    BEGIN
    IF given.type = TOC THEN
      BEGIN
      tocReader: HeapDefs.ReaderHandle = HeapDefs.HeapStartRead[given];
      [] ¬ HeapDefs.HeapReadData[tocReader, [@body, SIZE[HeapDefs.ObjectNumber]]];
      HeapDefs.HeapEndRead[tocReader];
      END
    ELSE body ¬ given;
    END;

  InaccessibleArchive: PUBLIC ERROR = CODE;

  SendBody: PUBLIC PROC [mbx: MBXHandle, str: ProtocolDefs.Handle] =
    BEGIN
    IF mbx.bodyObj.type = archived THEN
      BEGIN
      ENABLE
        BEGIN
        SpillDefs.ServerCrash => ERROR InaccessibleArchive[];
        UNWIND => mbx.archOpen ¬ FALSE;
        END;
      OpenArch[mbx];
      SpillDefs.CopyBody[mbx.archFile, mbx.archCount, str];
      CountArchived[];
      END
    ELSE
      BEGIN
      reader: HeapDefs.ReaderHandle = HeapDefs.HeapStartRead[mbx.bodyObj];
      header: BodyDefs.ItemHeader = HeapDefs.ReadItemHeader[reader];
      postmark: BodyDefs.Timestamp;
      IF header.type # PostMark THEN ERROR;
      [] ¬ HeapDefs.HeapReadData[reader, [@postmark, SIZE[BodyDefs.Timestamp]]];
      ConsiderDelay[postmark];
      ProtocolDefs.SendItemHeader[str, header];
      ProtocolDefs.SendTimestamp[str, postmark];
      HeapDefs.SendObj[reader, str];
      END;
    END;

  SendText: PUBLIC PROC [
    mbx: MBXHandle, sendLength: PROC [BodyDefs.ItemLength], str: SendDefs.Handle,
    sendBytes: PROC [SendDefs.Handle, LONG POINTER, CARDINAL]] =
    BEGIN
    IF mbx.bodyObj.type = archived THEN
      BEGIN
      ENABLE
        BEGIN
        SpillDefs.ServerCrash => ERROR InaccessibleArchive[];
        UNWIND => mbx.archOpen ¬ FALSE;
        END;
      OpenArch[mbx];
      SpillDefs.CopyText[mbx.archFile, mbx.archCount, sendLength, str, sendBytes];
      CountArchived[];
      END
    ELSE
      BEGIN
      reader: HeapDefs.ReaderHandle = HeapDefs.HeapStartRead[mbx.bodyObj];
      DO
        ENABLE UNWIND => HeapDefs.HeapEndRead[reader];
        header: BodyDefs.ItemHeader = HeapDefs.ReadItemHeader[reader];
        SELECT header.type FROM
          PostMark =>
            BEGIN
            postmark: BodyDefs.Timestamp;
            [] ¬ HeapDefs.HeapReadData[
              reader, [@postmark, SIZE[BodyDefs.Timestamp]]];
            ConsiderDelay[postmark];
            END;
          Text =>
            BEGIN
            sendLength[header.length];
            ReturnDefs.CopyItem[reader, header.length, sendBytes, str];
            EXIT
            END;
          LastItem => EXIT --no text-- ;
          ENDCASE =>
            HeapDefs.SetReaderOffset[
              reader, HeapDefs.GetReaderOffset[reader] + (header.length + 1) / 2];
        ENDLOOP;
      HeapDefs.HeapEndRead[reader];
      END;
    END;

  OpenArch: PROC [mbx: MBXHandle] =
    BEGIN
    IF NOT mbx.archOpen THEN
      BEGIN
      mbx.archFile ¬ SpillDefs.OpenToRead[mbx.archObj];
      mbx.archOpen ¬ TRUE;
      END;
    END;

  CloseArch: PROC [mbx: MBXHandle] =
    BEGIN
    IF mbx.archOpen THEN
      SpillDefs.EndReading[mbx.archFile ! SpillDefs.ServerCrash => CONTINUE];
    mbx.archOpen ¬ FALSE;
    END;

  WriteTOC: PUBLIC PROC [mbx: MBXHandle, text: ProtocolDefs.Remark] =
    BEGIN
    Accept: PROC [obj: HeapDefs.ObjectNumber] =
      BEGIN
      ObjectDirDefs.UseObject[obj];
      mbx.messages[mbx.nextMsg - 1] ¬ obj;
      VMDefs.MarkStartWait[mbx.page];
      IF mbx.object.type = TOC THEN ObjectDirDefs.FreeObject[mbx.object];
      mbx.object ¬ obj;
      END;
    body: HeapDefs.ObjectNumber ¬ mbx.bodyObj;
    IF text.length = 0 THEN
      BEGIN
      -- no TOC required --
      IF mbx.object.type = TOC THEN {
        Accept[body]; ObjectDirDefs.FreeObject[body]};
      END
    ELSE
      BEGIN
      writer: HeapDefs.WriterHandle = HeapDefs.HeapStartWrite[TOC];
      HeapDefs.HeapWriteData[writer, [@body, SIZE[HeapDefs.ObjectNumber]]];
      --CHEAT-- HeapDefs.HeapWriteRName[writer, text];
      HeapDefs.HeapEndWrite[writer, Accept];
      END;
    END;

  DeleteMessage: PUBLIC PROC [mbx: MBXHandle] =
    BEGIN
    IF mbx.bodyObj.type = archived THEN
      BEGIN
      ENABLE
        BEGIN
        SpillDefs.ServerCrash => ERROR InaccessibleArchive[];
        UNWIND => mbx.archOpen ¬ FALSE;
        END;
      IF mbx.object.type = TOC THEN
        BEGIN
        mbx.messages[mbx.nextMsg - 1] ¬ mbx.bodyObj;
        VMDefs.MarkStartWait[mbx.page];
        END;
      OpenArch[mbx];
      SpillDefs.DeleteEntry[mbx.archFile, mbx.archCount];
      END
    ELSE
      BEGIN
      mbx.messages[mbx.nextMsg - 1] ¬ ObjectDirDefs.noObject;
      VMDefs.MarkStartWait[mbx.page];
      ObjectDirDefs.FreeObject[mbx.bodyObj];
      mbx.bodyObj ¬ ObjectDirDefs.noObject;
      END;
    IF mbx.object.type = TOC THEN
      BEGIN ObjectDirDefs.FreeObject[mbx.object]; mbx.object ¬ mbx.bodyObj; END;
    END;

  Close: PUBLIC PROCEDURE [mbx: MBXHandle] =
    BEGIN
    LogAction[
      LOOPHOLE[mbx.page, LONG POINTER] + FIRST[VMDefs.PageIndex] + SIZE[MBXHeader],
      no];
    InnerClose[mbx];
    END;

  InnerClose: PROC [mbx: MBXHandle] = BEGIN CloseArch[mbx]; Destroy[mbx]; END;

  ReadPostmark: PROC [body: HeapDefs.ObjectNumber]
    RETURNS [postmark: BodyDefs.Timestamp] =
    BEGIN
    reader: HeapDefs.ReaderHandle = HeapDefs.HeapStartRead[body];
    header: BodyDefs.ItemHeader = HeapDefs.ReadItemHeader[reader];
    IF header.type # PostMark THEN ERROR;
    [] ¬ HeapDefs.HeapReadData[reader, [@postmark, SIZE[BodyDefs.Timestamp]]];
    HeapDefs.HeapEndRead[reader];
    END;

  FlushAndClose: PUBLIC PROCEDURE [mbx: MBXHandle] =
    BEGIN
    -- Beware: this procedure works without the monitor lock, because there
    -- may be unbounded delays while we delete archive files.  The order of
    -- events is quite important!  We must also take care that everything
    -- will look ok if we crash in the middle of flushing a multi-page
    -- mailbox.
    buffer: LONG DESCRIPTOR FOR ARRAY OF HeapDefs.ObjectNumber;
    base: VMDefs.PageIndex = FIRST[VMDefs.PageIndex];
    header: LONG POINTER TO MBXHeader ¬ LOOPHOLE[mbx.page, LONG POINTER] + base;
    msgCount: CARDINAL ¬ 0;
    archiveFailure: BOOLEAN ¬ FALSE;
    lastPost: BodyDefs.Timestamp ¬ BodyDefs.oldestTime;
    -- postmark of latest message --
    DeleteArch: PROC =  -- delete archive file --
      BEGIN
      IF mbx.archObj # ObjectDirDefs.noObject THEN
        BEGIN
        SpillDefs.Delete[
          mbx.archObj !
          SpillDefs.ServerCrash => {archiveFailure ¬ TRUE; CONTINUE}];
        ObjectDirDefs.FreeObject[mbx.archObj];
        mbx.archObj ¬ ObjectDirDefs.noObject;
        END;
      END;
    IF mbx.where # mbx.latest THEN
      BEGIN  -- find first page --
      VMDefs.Release[mbx.page];
      mbx.page ¬ VMDefs.ReadPage[[handle, mbx.where ¬ mbx.latest], lookAhead];
      END;
    CloseArch[mbx];
    mbx.archObj ¬ ObjectDirDefs.noObject;
    DO
      who: BodyDefs.RName = LOOPHOLE[mbx.page, LONG POINTER] + base + SIZE[MBXHeader];
      header ¬ LOOPHOLE[mbx.page, LONG POINTER] + base;
      buffer ¬ DESCRIPTOR[
        mbx.page + header.first,
          (header.free - header.first) / SIZE[HeapDefs.ObjectNumber]];
      msgCount ¬ msgCount + LENGTH[buffer];
      BEGIN  -- write MBX to disk as empty, in case of crash --
      header.free ¬ header.first;
      VMDefs.MarkStartWait[mbx.page];
      END;
      IF mbx.where = mbx.latest THEN
        BEGIN
        -- this mbx page contains last mbx message --
        lastObj: HeapDefs.ObjectNumber = buffer[LENGTH[buffer] - 1];
        IF lastObj # ObjectDirDefs.noObject THEN
          BEGIN
          body: HeapDefs.ObjectNumber = GetBodyObj[lastObj];
          IF body.type # archived THEN lastPost ¬ ReadPostmark[body]
          -- ELSE lastPost is irrelevant! -- ;
          END;
        END;
      -- decrement reference counts --
      FOR index: CARDINAL DECREASING IN [0..LENGTH[buffer]) DO
        obj: HeapDefs.ObjectNumber = buffer[index];
        IF obj # ObjectDirDefs.noObject THEN
          BEGIN
          body: HeapDefs.ObjectNumber = GetBodyObj[obj];
          IF obj.type = TOC THEN ObjectDirDefs.FreeObject[obj];
          IF body # mbx.archObj THEN
            BEGIN
            DeleteArch[];
            IF body.type = archived  -- record for later deletion --
              THEN {mbx.archObj ¬ body; ObjectDirDefs.UseObject[body]};
            END;
          ObjectDirDefs.FreeObject[body];
          END;
        mailboxContents ¬ mailboxContents - 1;
        ENDLOOP;
      -- Clearing bit in pageMap allows page to be re-used --
      IF header.number = 0  -- we're at the end of the earliest page --
        THEN
        BEGIN
        EmptyInTree[who, lastPost];
        FreeMBXPage[mbx.where];  -- must not access page after here --
        EXIT
        END;
      BEGIN
      next: MBXName = header.chain;  --that store is about to go--
      FreeMBXPage[mbx.where];  -- must not access page after here --
      VMDefs.Release[mbx.page];
      mbx.where ¬ next;
      mbx.page ¬ VMDefs.ReadPage[[handle, mbx.where], lookAhead];
      END;
      ENDLOOP;
    DeleteArch[];
    IF archiveFailure THEN
      LogDefs.ShowLine["Failed to delete mailbox archive file"L];
    LogAction[
      LOOPHOLE[mbx.page, LONG POINTER] + base + SIZE[MBXHeader], yes, msgCount];
    Destroy[mbx];
    END;

  AdjustOldest: ENTRY PROC [who: BodyDefs.RName, time: BodyDefs.Timestamp] =
    BEGIN
    -- alter "oldest" stamp after archiving --
    prev: TreeRec = FindInTree[who: who];
    WITH tree: prev SELECT FROM
      empty => ERROR;  -- silly: we have an interlock on it! --
      found =>
        ChangeInTree[who: who, where: tree.where, lock: tree.lock, oldest: time];
      ENDCASE => ERROR;
    END;

  Archive: PUBLIC PROC [who: BodyDefs.RName, keep: CARDINAL] =
    BEGIN
    mbx: MBXHandle;
    contents: CARDINAL;
    found: BOOLEAN;
    [found, contents, mbx] ¬ Open[who];
    IF found AND contents > keep THEN
      BEGIN
      ENABLE UNWIND => Close[mbx];
      msgExists, archived, deleted: BOOLEAN;
      archStart: CARDINAL ¬ 0;
      WHILE archStart < contents - keep  -- skip to non-archived message --
        DO
        [msgExists, archived, deleted] ¬ RealNextMessage[mbx, no];
        IF NOT msgExists THEN ERROR;
        IF NOT archived AND NOT deleted THEN EXIT;
        archStart ¬ archStart + 1;
        ENDLOOP;
      IF archStart < contents - keep THEN
        BEGIN
        spillCount: CARDINAL = (contents - keep) - archStart;
        archObj: HeapDefs.ObjectNumber;
        Backup: PROC =
          BEGIN
          RestartMBX[mbx];
          THROUGH [0..archStart] DO
            [msgExists, archived, deleted] ¬ RealNextMessage[mbx, no]; ENDLOOP;
          END;
        BEGIN
        ENABLE
          SpillDefs.ServerCrash => {
            ObjectDirDefs.FreeObject[archObj]; Backup[]; RETRY};
        archObj ¬ SpillDefs.StartWrite[
          who, spillCount ! SpillDefs.ServerCrash => ERROR InaccessibleArchive[]];
        THROUGH [0..spillCount) DO
          IF NOT msgExists OR archived THEN ERROR;
          IF NOT deleted THEN SpillDefs.AddBody[mbx.bodyObj];
          [msgExists, archived, deleted] ¬ NextMessage[mbx];
          ENDLOOP;
        SpillDefs.EndWrite[];
        END;
        Backup[];
        THROUGH [0..spillCount) DO
          IF NOT deleted THEN
            BEGIN
            mbx.messages[mbx.nextMsg - 1] ¬ archObj;
            ObjectDirDefs.UseObject[archObj];
            VMDefs.MarkStartWait[mbx.page];
            IF mbx.object.type = TOC THEN ObjectDirDefs.FreeObject[mbx.object];
            ObjectDirDefs.FreeObject[mbx.bodyObj];
            END;
          [msgExists, archived, deleted] ¬ NextMessage[mbx];
          ENDLOOP;
        AdjustOldest[
          who,
          IF msgExists THEN ReadPostmark[mbx.bodyObj] ELSE BodyDefs.oldestTime];
        ObjectDirDefs.FreeObject[archObj];
        LogAction[who, arch, spillCount];
        END;
      END;
    IF found THEN InnerClose[mbx];
    END;

  defaultDays: CARDINAL = 7;
  archiveDays: CARDINAL ¬ defaultDays;

  ReadArchiveDays: ENTRY PROC RETURNS [days: CARDINAL] = INLINE {
    days ¬ archiveDays; archiveDays ¬ defaultDays};

  SetArchiveDays: PUBLIC ENTRY PROC [days: CARDINAL] = {archiveDays ¬ days};

  Archiver: PROC =
    BEGIN
    DO
      PolicyDefs.ArchiverPause[];
      PolicyDefs.WaitOperation[archiver];
      IF ~ArchivingMakesSense[] THEN LOOP;
      BEGIN
      writer: HeapDefs.WriterHandle = HeapDefs.HeapStartWrite[temp];
      archivePeriod: CARDINAL ¬ ReadArchiveDays[];
      now: BodyDefs.PackedTime = Time.Current[];
      old: BodyDefs.PackedTime = now - LONG[archivePeriod] * 24 * 60 * 60;
      count: CARDINAL ¬ 0;
      Work: PROC [who: BodyDefs.RName, tree: found TreeRec] =
        BEGIN
        IF tree.oldest # BodyDefs.oldestTime AND tree.oldest.time < old THEN {
          HeapDefs.HeapWriteRName[writer, who]; count ¬ count + 1};
        END;
      EnumerateTree[Work];
      IF count = 0 THEN HeapDefs.HeapAbandonWrite[writer]
      ELSE
        BEGIN
        reader: HeapDefs.ReaderHandle;
        GetReader: PROC [obj: HeapDefs.ObjectNumber] = {
          reader ¬ HeapDefs.HeapStartRead[obj]};
        LogDefs.ShowNumber["Starting mailbox archiving. ("L, archivePeriod, " day cutoff)."L];
        HeapDefs.HeapEndWrite[writer, GetReader];
        THROUGH [0..count) DO
	  once: BOOLEAN ¬ FALSE;
          who: BodyDefs.RName = [BodyDefs.maxRNameLength];
          [] ¬ HeapDefs.HeapReadRName[reader, who];
	  BEGIN ENABLE InaccessibleArchive => {
	      LogAction[who, archFail];
	      RETRY; };
	  IF once THEN {
            PolicyDefs.EndOperation[archiver];
            PolicyDefs.Wait[mins: 15];
            PolicyDefs.WaitOperation[archiver]; };
	  once ¬ TRUE;
          Archive[who, 0];
	  END;
          ENDLOOP;
        HeapDefs.HeapEndRead[reader];
        LogDefs.ShowLine["Finished archiving mailboxes."L];
        END;
      END;
      PolicyDefs.EndOperation[archiver];
      ENDLOOP;
    END;


  ArchivingMakesSense: PROC RETURNS [ok: BOOL ¬ FALSE] = {
    LookAtServer: PROC [name: BodyDefs.RName] RETURNS [done: BOOLEAN] = {
      ok ¬ TRUE;
      RETURN[TRUE]; };
    listInfo: NameInfoDefs.MemberInfo;
    serverListPrefix: STRING = "Archive-"L;
    serverListName: BodyDefs.RName = [BodyDefs.maxRNameLength];
    String.AppendString[serverListName, serverListPrefix];
    String.AppendString[serverListName, myName];
    listInfo ¬ NameInfoDefs.GetMembers[serverListName];
    WITH listInfo SELECT FROM
      group => {
        NameInfoDefs.Enumerate[members, LookAtServer];
        NameInfoDefs.Close[members]; };
      ENDCASE => NULL;
    };

  Remail: PUBLIC PROC [who: BodyDefs.RName, valid: BOOLEAN] =
    BEGIN
    RemailMessage: PROC [body: HeapDefs.ObjectNumber] =
      BEGIN
      log: STRING = [64];
      slHeader: SLDefs.SLHeader;
      slHeader.created ¬ ReadPostmark[body];
      slHeader.received ¬ [0, 0, Time.Current[]];
      String.AppendString[log, "Remailing "L];
      ProtocolDefs.AppendTimestamp[log, slHeader.created];
      String.AppendString[log, " as "L];
      slHeader.created.time ¬ slHeader.received.time;
      ProtocolDefs.AppendTimestamp[log, slHeader.created];
      LogDefs.WriteLogEntry[log];
      slHeader.server ¬ NIL;
      BEGIN  -- write steering list --
      sl: HeapDefs.WriterHandle = HeapDefs.HeapStartWrite[SLinput];
      HeapDefs.HeapWriteData[sl, [@slHeader, SIZE[SLDefs.SLHeader]]];
      HeapDefs.HeapWriteRName[sl, who];
      SLDefs.SLWrite[body: body, SL: sl, queue: input];
      END;
      END;
    found: BOOLEAN;
    count: CARDINAL;
    mbx: MBXHandle;
    [found, count, mbx] ¬ Open[who];
    IF found THEN
      BEGIN
      IF valid THEN
        BEGIN
        ENABLE UNWIND => Close[mbx];
        LogAction[who, remail];
        THROUGH [1..count] DO
          msgExists, archived, deleted: BOOLEAN;
          [msgExists, archived, deleted] ¬ NextMessage[mbx];
          IF NOT msgExists THEN ERROR;
          IF deleted THEN LOOP;
          BEGIN
          ENABLE UNWIND => PolicyDefs.EndOperation[remailing];
          PolicyDefs.WaitOperation[remailing];
          IF mbx.bodyObj.type = archived THEN
            BEGIN
            ENABLE
              SpillDefs.ServerCrash => {mbx.archOpen ¬ FALSE; GOTO inaccessible};
            OpenArch[mbx];
            HeapDefs.HeapEndWrite[
              SpillDefs.RecoverBody[mbx.archFile, mbx.archCount], RemailMessage];
            EXITS inaccessible => {ERROR InaccessibleArchive[]};
            END
          ELSE RemailMessage[mbx.bodyObj];
          DeleteMessage[mbx];
          PolicyDefs.EndOperation[remailing];
          END;
          ENDLOOP;
        END
      ELSE LogAction[who, dead];
      FlushAndClose[mbx];
      END;
    PurgeFromTree[who];
    END;

  s: STRING = "Birrell.pa";  --for use from the debugger--

  LogAction: PROCEDURE [
    who: BodyDefs.RName, action: {yes, no, nothing, arch, archFail, remail, dead},
    data: CARDINAL ¬ 0] =
    BEGIN
    log: LONG STRING ¬ Heap.systemZone.NEW[StringBody[128]];
    String.AppendString[log, "Mailbox "L];
    String.AppendString[log, who];
    String.AppendString[
      log,
      SELECT action FROM
        nothing => ": already empty"L,
        no => ": abandoned reading"L,
        yes => ": emptied, "L,
        arch => ": archived "L,
        archFail => ": archive failed"L,
        remail => ": remailing"L,
        dead => ": dead"L,
        ENDCASE => ERROR];
    SELECT action FROM
      yes, arch =>
        BEGIN
        String.AppendDecimal[log, data];
        String.AppendString[log, " messages"L];
        END;
      ENDCASE => NULL;
    LogDefs.WriteLogEntry[log];
    Heap.systemZone.FREE[@log];
    IF action = remail THEN {
      LogDefs.WriteString[" Remail "L]; LogDefs.WriteString[who]};
    END;

  MailboxCount: PUBLIC PROC [
    str: EnquiryDefs.Handle, nameSought: BodyDefs.RName] =
    BEGIN OPEN str;
    allNames: BOOLEAN ¬ String.EquivalentStrings[nameSought, "*"L];
    encountered: LONG CARDINAL ¬ 0;  -- should be equivalent to mailboxContents
    freePageCount: CARDINAL ¬ 0;
    WriteChar[Ascii.CR];
    FOR pageNumber: CARDINAL IN [0..nextVirginPage) DO
      page: VMDefs.Page = VMDefs.ReadPage[[handle, pageNumber], 0];
      BEGIN
      ENABLE UNWIND => VMDefs.Release[page];
      header: LONG POINTER TO MBXHeader = LOOPHOLE[page];
      IF header.first = header.free THEN freePageCount ¬ freePageCount + 1
      ELSE
        BEGIN
        name: BodyDefs.RName = LOOPHOLE[page, LONG POINTER] + SIZE[MBXHeader];
        count: CARDINAL =
          (header.free - header.first) / SIZE[HeapDefs.ObjectNumber];
        objects: LONG DESCRIPTOR FOR ARRAY OF HeapDefs.ObjectNumber = DESCRIPTOR[
          LOOPHOLE[page, LONG POINTER] + header.first, count];
        tocCount: CARDINAL ¬ 0;
        delCount: CARDINAL ¬ 0;
        archCount: CARDINAL ¬ 0;
        IF ~allNames AND ~String.EquivalentStrings[nameSought, name] THEN
          GOTO tryNextName;
        WriteString[name];
        WriteChar['(];
        WriteDecimal[header.number];
        WriteChar[')];
        WriteString[": "L];
        WriteDecimal[count];
        encountered ¬ encountered + count;
        WriteString[" messages"L];
        FOR this: CARDINAL IN [0..count) DO
          SELECT objects[this].type FROM
            TOC => tocCount ¬ tocCount + 1;
            archived => archCount ¬ archCount + 1;
            gap => delCount ¬ delCount + 1;
            ENDCASE => NULL;
          ENDLOOP;
        IF tocCount # 0 THEN {
          WriteString["; "L]; WriteDecimal[tocCount]; WriteString[" TOC's"L]};
        IF delCount # 0 THEN {
          WriteString["; "L]; WriteDecimal[delCount]; WriteString[" deleted"L]};
        IF archCount # 0 THEN {
          WriteString["; "L]; WriteDecimal[archCount]; WriteString[" archived"L]};
        IF header.number = 0 THEN
          BEGIN
          LookInTree: ENTRY PROC RETURNS [TreeRec] = INLINE {
            RETURN[FindInTree[name]]};
          mbx: TreeRec = LookInTree[];
          WriteString["; "L];
          WITH tree: mbx SELECT FROM
            empty => WriteString[" *** not in tree!"L];
            found =>
              IF tree.oldest = BodyDefs.oldestTime THEN WriteString["no date"L]
              ELSE
                BEGIN
                t: STRING = [18];  -- 29-Feb-99 24:23:22 --
                Time.Append[t, Time.Unpack[LOOPHOLE[tree.oldest.time]]];
                WriteString[t];
                END;
            ENDCASE => WriteString[" *** illegal tree entry"L];
          END;
        WriteChar[Ascii.CR];
        END;
      EXITS tryNextName => NULL;
      END;
      VMDefs.Release[page];
      IF DelTyped[] THEN GOTO del;
      ENDLOOP;
    IF allNames THEN
      BEGIN
      WriteDecimal[freePageCount];
      WriteString[" empty pages"L];
      WriteChar[Ascii.CR];
      WriteString["Number of mailboxes with content = "L];
      WriteLongDecimal[mailboxes];
      WriteChar[Ascii.CR];
      WriteString["Total of messages in mailboxes (some are duplicates) = "L];
      WriteLongDecimal[encountered];
      WriteChar[Ascii.CR];
      END;
    EXITS del => {str.Flush[]; str.WriteString[" XXX"L]};
    END;

  HistBox: TYPE = {min17, min53, min160, hr8, day1, day3, day9, longer, archived};

  histInterval: ARRAY HistBox OF CARDINAL = [
    (8 * 60) / 27, (8 * 60) / 9, (8 * 60) / 3, 8 * 60, 3 * 8 * 60, 9 * 8 * 60,
    27 * 8 * 60, LAST[CARDINAL], LAST[CARDINAL]];

  histCount: ARRAY HistBox OF CARDINAL ¬ ALL[0];
  histTotal: LONG CARDINAL ¬ 0;

  ConsiderDelay: ENTRY PROC [postmark: BodyDefs.Timestamp] =
    BEGIN
    now: LONG CARDINAL = Time.Current[];
    FOR box: HistBox IN [FIRST[HistBox]..longer) DO
      limit: LONG CARDINAL = now - LONG[60] * histInterval[box];
      IF postmark.time > limit THEN {histCount[box] ¬ histCount[box] + 1; EXIT};
      REPEAT FINISHED => histCount[longer] ¬ histCount[longer] + 1
      ENDLOOP;
    histTotal ¬ histTotal + 1;
    END;

  CountArchived: ENTRY PROC = INLINE {
    histCount[archived] ¬ histCount[archived] + 1; histTotal ¬ histTotal + 1};

  Histograms: PUBLIC PROC [str: EnquiryDefs.Handle] =
    BEGIN OPEN str;
    histCaption: ARRAY HistBox OF STRING = [
      "17 min: "L, "53 min: "L, "2.7 hr: "L, "8 hrs:  "L, "24 hrs: "L,
      "3 days: "L, "9 days: "L, "longer: "L, "archiv: "L];
    WriteChar[Ascii.CR];
    WriteString["Mail retrieval delays"L];
    WriteChar[Ascii.CR];
    FOR box: HistBox IN HistBox DO
      WriteString[histCaption[box]];
      WriteDecimal[histCount[box]];
      WriteChar[Ascii.TAB];
      IF histTotal = 0 THEN WriteChar['?]
      ELSE WriteLongDecimal[(histCount[box] * LONG[100]) / histTotal];
      WriteChar['%];
      WriteChar[Ascii.CR];
      ENDLOOP;
    WriteString["total:  "L];
    WriteLongDecimal[histTotal];
    END;

  LogDefs.DisplayNumber["Mailboxes"L, [short[@mailboxes]]];
  String.AppendString[myName, LocalNameDefs.ReadMSName[].name];

  END.