-- Transport Mechanism Filestore - heap measuring tool --

-- [Juniper]<Grapevine>MS>HeapCount.mesa

-- Andrew Birrell	18-Feb-82 14:02:41 --

DIRECTORY
Ascii		USING[ CR, DEL, SP ],
BodyDefs	USING[ maxRNameLength, RName ],
GlassDefs	USING[ Handle, Listen, TimeOut ],
HeapDefs	USING[ objectStart ],
HeapFileDefs	USING[ FirstSegment, NextPage, NoMorePages ],
HeapXDefs	USING[ PageHeader, ObjectHeader, ReaderData],
LogDefs		USING[ WriteLogEntry ],
NameInfoDefs	USING[ Authenticate, IsMemberClosure, Membership ],
ObjectDir	USING[ DirData, FindData, LOCK, ReleaseData, zeroCount ],
ObjectDirDefs	USING[ ObjectType ],
ObjectDirXDefs	USING[ ObjectNumber, ObjectState, gapObjectNumber ],
Policy		USING[ compactorEnabled, compactorPause, compactorStart,
		       LOCK, secsCond ],
Process		USING[ Detach, DisableTimeout, InitializeCondition,
		       InitializeMonitor ],
RestartDefs	USING[],
String		USING[ AppendChar, AppendString ],
VMDefs		USING[ Deactivate, Page, PageIndex, ReadPage, 
		       PageAddress, PageNumber, FullAddress ];

Test: MONITOR LOCKS l USING l: POINTER TO MONITORLOCK
   IMPORTS GlassDefs, HeapFileDefs, LogDefs, NameInfoDefs, ObjectDir,
           Policy, Process, String, VMDefs
   EXPORTS RestartDefs 
   SHARES ObjectDir, Policy =
BEGIN

OPEN HeapXDefs, ObjectDirXDefs;

-- User interface --

LogAction: PROC[user, action: STRING] =
   BEGIN
   log: STRING = [128];
   String.AppendString[log, action];
   String.AppendString[log, " caused by "L];
   String.AppendString[log, user];
   LogDefs.WriteLogEntry[log];
   END;

LowerCase: PROC[c: CHARACTER] RETURNS[CHARACTER] = INLINE
   { RETURN[ IF c IN ['A..'Z] THEN 'a + (c-'A) ELSE c ] };

BeginsWith: PROC[a, b: STRING] RETURNS[ BOOLEAN ] =
   BEGIN
   FOR i: CARDINAL IN [0..b.length)
   DO IF i >= a.length OR LowerCase[a[i]] # LowerCase[b[i]]
      THEN RETURN[FALSE];
   ENDLOOP;
   RETURN[TRUE]
   END;

Command: TYPE = { enable, login, quit, map, stats };

Del: ERROR = CODE;

LoginState: TYPE = { none, ok, enabled };

Login: PROC[str: GlassDefs.Handle, user, pwd: STRING]
    RETURNS[ok: BOOLEAN] =
   BEGIN
   OPEN str;
   default: STRING = ".pa"L;
   WriteChar[Ascii.CR];
   IF ReadString["Your name please: "L, user, word] = Ascii.DEL
   THEN ERROR Del[];
   WriteChar[Ascii.CR];
   SELECT ReadString["Your password: "L, pwd, pwd] FROM 
     Ascii.DEL => ERROR Del[];
     Ascii.SP =>
       BEGIN
       acc: STRING = [8];
       [] _ ReadString[" (account): "L, acc, word];
       END;
   ENDCASE => NULL;
   WriteString[" ... "L]; SendNow[]; ok _ FALSE;
   SELECT NameInfoDefs.Authenticate[user, pwd] FROM
     individual => { WriteString["ok"L]; ok _ TRUE };
     group =>      WriteString["Can't login as a group"L];
     notFound =>   WriteString["Not a valid user name"L];
     badPwd =>     WriteString["Incorrect password"L];
     allDown =>    WriteString["Can't contact authentication server"L];
   ENDCASE => ERROR;
   END;

Enable: PROC[str: GlassDefs.Handle, user: STRING]
       RETURNS[ privileged: BOOLEAN ] =
   BEGIN
   OPEN str;
   privileged _ FALSE;
   SELECT NameInfoDefs.IsMemberClosure["Transport^.ms"L, user] FROM
     yes => { WriteString["ok"L]; privileged _ TRUE };
     allDown => WriteString["can't contact access control server"L];
     no, notGroup => WriteString["not privileged"L];
   ENDCASE;
   END;

ChooseCommand: PROC[str: GlassDefs.Handle, state: LoginState]
            RETURNS[Command] =
   BEGIN
   OPEN str;
   names: ARRAY Command OF STRING = [
     enable:        "Enable"L,
     login:         "Login"L,
     quit:          "Quit"L,
     map:           "Map"L,
     stats:         "Statistics"L ];
   allowed: PACKED ARRAY Command OF { yes, no } = SELECT state FROM
     none => [
       enable:        no,
       login:         yes,
       quit:          yes,
       map:           no,
       stats:         no ],
     ok => [
       enable:        yes,
       login:         yes,
       quit:          yes,
       map:           no,
       stats:         no ],
     enabled => [
       enable:        no,
       login:         yes,
       quit:          yes,
       map:           yes,
       stats:         yes ],
     ENDCASE => ERROR;
   buff: STRING = [64];
   prompt: STRING = IF state = enabled THEN "HC! "L ELSE "HC: "L;
   WriteString[prompt];
   DO c: CHARACTER = LowerCase[ReadChar[]];
      FOR i: Command IN Command
      DO IF allowed[i] = yes
         AND BeginsWith[names[i], buff]
         AND c = LowerCase[names[i][buff.length]]
         THEN BEGIN
              FOR j: CARDINAL IN [buff.length..names[i].length)
              DO nChar: CHARACTER = names[i][j];
                 String.AppendChar[buff, nChar]; WriteChar[nChar];
                 IF nChar = Ascii.SP THEN EXIT;
              REPEAT FINISHED => RETURN[i]
              ENDLOOP;
              EXIT
              END
      REPEAT FINISHED =>
         BEGIN
         SELECT c FROM
           '? =>
              BEGIN
              first: BOOLEAN _ TRUE;
              WriteString["? One of: "L];
              FOR i: Command IN Command
              DO IF allowed[i] = yes
                 AND BeginsWith[names[i], buff]
                 THEN BEGIN
                      IF first THEN first_FALSE ELSE WriteString[", "L];
                      FOR j: CARDINAL IN [buff.length..names[i].length)
                      DO WriteChar[names[i][j]] ENDLOOP;
                      END;
              ENDLOOP;
              END;
           Ascii.DEL => ERROR Del[];
         ENDCASE => { WriteChar[c]; WriteChar['?] };
         WriteChar[Ascii.CR]; WriteString[prompt]; WriteString[buff];
         END;
      ENDLOOP;
   ENDLOOP;
   END;

Receive: PROC[str: GlassDefs.Handle] =
   BEGIN
   OPEN str;
   state: LoginState _ none;
   user: BodyDefs.RName = [BodyDefs.maxRNameLength];
   pwd: STRING = [16];
   WriteChar[Ascii.CR];
   WriteString["Grapevine Server Heap-counter"L];
   WriteChar[Ascii.CR];
   DO WriteChar[Ascii.CR];
      BEGIN
      ENABLE Del => GOTO del;
      comm: Command _ ChooseCommand[str, state !
                                    GlassDefs.TimeOut => GOTO timeOut];
      WriteString[" ... "L]; SendNow[];
      SELECT comm FROM
        enable => IF Enable[str, user] THEN state _ enabled;
        login =>  { state _ none; -- because Login changes "user"
                    IF Login[str, user, pwd] THEN state _ ok };
        quit =>   EXIT;
        stats =>  { LogAction[user, "Heap-counter"L]; Count[str,FALSE] };
        map =>    { LogAction[user, "Heap-mapper"L]; Count[str,TRUE] };
      ENDCASE =>  WriteString["Unimplemented command"L];
      EXITS
        timeOut =>
          BEGIN
          WriteString["Type any character to continue ... "L];
          [] _ ReadChar[ ! GlassDefs.TimeOut => GOTO end ];
          EXITS end =>
            { WriteString["good-bye"L]; EXIT }
          END;
        del =>
          { Flush[]; WriteString[" XXX"L] };
      END;
   ENDLOOP;
   END;

Work: PROC =
   { DO GlassDefs.Listen[Receive, [0,77B]] ENDLOOP };


-- Statistics --

unused: ARRAY ObjectDirDefs.ObjectType OF CARDINAL;
   -- number of zero reference-count objects of each type --
unusedWords: ARRAY ObjectDirDefs.ObjectType OF LONG CARDINAL;
   -- total lengths of unused objects of each type --
used: ARRAY ObjectDirDefs.ObjectType OF CARDINAL;
   -- number of non-zero reference-count objects of each type --
references: ARRAY ObjectDirDefs.ObjectType OF LONG CARDINAL;
   -- number of references to objects of each type --
usedWords: ARRAY ObjectDirDefs.ObjectType OF LONG CARDINAL;
   -- total lengths of used objects of each type --
avWords: ARRAY ObjectDirDefs.ObjectType OF LONG CARDINAL;
   -- avLength[i] = usedLength[i] / used[i] --
avRefs: ARRAY ObjectDirDefs.ObjectType OF LONG CARDINAL;
   -- avRefs[i] = references[i] / used[i] --
gapWords: LONG CARDINAL;
   -- amount of space not occupied by objects --
pages: CARDINAL;
   -- number of pages in written part of heap --
words: LONG CARDINAL;
   -- pages * (VMDefs.pageSize-SIZE[PageHeader]) --

InitStats: PROC =
   BEGIN
   unused _ ALL[0];
   unusedWords _ ALL[0];
   used _ ALL[0];
   references _ ALL[0];
   usedWords _ ALL[0];
   avRefs _ ALL[0];
   avWords _ ALL[0];
   gapWords _ 0;
   pages _ 0;
   words _ 0;
   END;

WriteStats: PROC[str: GlassDefs.Handle] =
   BEGIN
   OPEN str;
   Add: PROC[i, j: ObjectDirDefs.ObjectType] =
     BEGIN
     unused[i] _ unused[i] + unused[j];
     unusedWords[i] _ unusedWords[i] + unusedWords[j];
     used[i] _ used[i] + used[j];
     references[i] _ references[i] + references[j];
     usedWords[i] _ usedWords[i] + usedWords[j];
     END;
   Write: PROC[i: ObjectDirDefs.ObjectType, s: STRING] =
     BEGIN
     WriteString[s]; WriteChar['	];
     WriteDecimal[unused[i]]; WriteChar['	];
     WriteDecimal[used[i]]; WriteChar['	];
     WriteLongDecimal[unusedWords[i]]; WriteChar['	];
     WriteLongDecimal[usedWords[i]]; WriteChar['	];
     WriteLongDecimal[avWords[i]]; WriteChar['	];
     WriteLongDecimal[references[i]]; WriteChar['	];
     WriteLongDecimal[avRefs[i]]; WriteChar[Ascii.CR];
     END;
   WriteString["
Type	object-counts:	word-counts:	av.	references:
	unused	used	unused	used	words	total	average
"L];
   FOR i: ObjectDirDefs.ObjectType IN ObjectDirDefs.ObjectType
   DO IF used[i] # 0
      THEN BEGIN
           avWords[i] _ usedWords[i] / used[i];
           avRefs[i] _ references[i] / used[i];
           END;
      IF i # spare17 THEN Add[spare17, i];
      Write[i, SELECT i FROM
                 gap => "gap"L,
                 body => "body"L,
                 SLinput => "SLinput"L,
                 SLpending => "SLpend"L,
                 SLforward => "SLfwd"L,
                 RSobject => "RSobj"L,
                 RSmail => "RSmail"L,
                 temp => "temp"L,
                 RSname => "RSname"L,
                 MSname => "MSname"L,
                 testMode => "test"L,
                 TOC => "TOC"L,
                 archived => "archive"L,
                 delArch => "spare15"L,
                 spare16 => "spare16"L,
                 spare17 => "total"L,
               ENDCASE => ERROR ];
   ENDLOOP;
   WriteString["There are "L]; WriteLongDecimal[gapWords];
   WriteString[" gap words.
"L];
   words _ LONG[pages] * ( 256 - SIZE[HeapXDefs.PageHeader] );
   WriteString["The written area contains "L]; WriteDecimal[pages];
   WriteString[" pages = "L]; WriteLongDecimal[words]; WriteString[" words."L];
   END;


-- HeapMap info --

BriefType: PROC[str: GlassDefs.Handle, i: ObjectDirDefs.ObjectType] =
   BEGIN
   str.WriteString[SELECT i FROM
                 gap => "."L,
                 body => "B"L,
                 SLinput => "S"L,
                 SLpending => "S"L,
                 SLforward => "S"L,
                 RSobject => "R"L,
                 RSmail => "RSmail"L,
                 temp => "temp"L,
                 RSname => "RSname"L,
                 MSname => "MSname"L,
                 testMode => "test"L,
                 TOC => "T"L,
                 archived => "A"L,
                 delArch => "spare15"L,
                 spare16 => "spare16"L,
                 spare17 => "spare17"L,
               ENDCASE => ERROR ];
   END;

MapInfo: PROC[str: GlassDefs.Handle] =
   BEGIN
   OPEN str;
   WriteString["


""B"" = body, ""S"" = steering-list, ""R"" = RSobject, ""T"" = TOC, ""A"" = archive; ""x?"" = unused object of type ""x""; ""-"" for each non-gap sub-object, ""."" for each gap sub-object; <sp> between pages, <cr> at non-contiguous page.
"L];
   END;


-- Procedure almost stolen from ObjectDir, but with side-effect removed --

GetObjectState: INTERNAL PROC[ obj: ObjectDirXDefs.ObjectNumber,
                               where: VMDefs.FullAddress ]
               RETURNS[ state: ObjectDirXDefs.ObjectState ] =
   BEGIN
   OPEN ObjectDir;
   either: POINTER TO DirData = FindData[obj];
   WITH data: either SELECT FROM
     used => IF data.page # where.page.page
             THEN { state _ duplicate; ReleaseData[clean] }
             ELSE IF data.count = zeroCount
                  THEN BEGIN
                       unused[obj.type] _ unused[obj.type] + 1;
                       state _ unused; ReleaseData[clean];
                       END
                  ELSE BEGIN
                       used[obj.type] _ used[obj.type] + 1;
                       references[obj.type] _ references[obj.type] +
                                                data.count - zeroCount;
                       state _ inUse; ReleaseData[clean];
                       END;
   ENDCASE => ERROR --object number not in use --;
   END;


-- Hack to stop compactor --

StopCompactor: ENTRY PROC[ l: POINTER TO MONITORLOCK _ @Policy.LOCK ] =
   BEGIN
   Policy.compactorEnabled _ FALSE;
   THROUGH [1..5] DO WAIT Policy.secsCond ENDLOOP;
   END;

StartCompactor: ENTRY PROC[ l: POINTER TO MONITORLOCK _ @Policy.LOCK ] =
   BEGIN
   Policy.compactorEnabled _ TRUE;
   NOTIFY Policy.compactorStart;
   NOTIFY Policy.compactorPause;
   END;


-- Current state --

reader:          HeapXDefs.ReaderData;


Start: PROCEDURE =
   BEGIN
   reader.where _ HeapFileDefs.FirstSegment[];
   reader.page _ VMDefs.ReadPage[reader.where.page, 2];
   reader.offset _ HeapDefs.objectStart;
   reader.object _ ObjectDirXDefs.gapObjectNumber;
   InitStats[];
   END;


ScanHeap: ENTRY PROCEDURE[ str: GlassDefs.Handle, map: BOOLEAN,
                           l: POINTER TO MONITORLOCK _ @ObjectDir.LOCK ] =
   BEGIN
   OPEN VMDefs, str;
   prevPage: VMDefs.PageNumber _ PRED[LAST[VMDefs.PageNumber]];
   state: { gap, unused, inUse } _ gap;
   reader.object _ gapObjectNumber --indicates "no current object"--;
   reader.end _ FALSE;
   DO -- Consider any page header --
      IF reader.where.word = FIRST[PageIndex]
      THEN BEGIN
           pageHead: POINTER TO PageHeader = LOOPHOLE[reader.page,POINTER]
                                                + reader.where.word;
           IF map
           THEN BEGIN
                IF reader.where.page.page # 1+prevPage
                THEN { WriteChar[Ascii.CR];
                       WriteDecimal[reader.where.page.page] };
                WriteChar[Ascii.SP];
                prevPage _ reader.where.page.page;
                END;
           reader.where.word _ reader.where.word + SIZE[ PageHeader ];
           reader.offset _ pageHead.offset;
           END
      ELSE reader.offset _ HeapDefs.objectStart;

      BEGIN -- read sub-object header --
      object: POINTER TO ObjectHeader =
                         LOOPHOLE[reader.page,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] FROM
           inUse => BEGIN
                    reader.object _ object.number;
                    IF map
                    THEN { BriefType[str, object.number.type] };
                    state _ inUse
                    END;
           unused => -- ignorable object --
                    BEGIN
                    IF map
                    THEN { BriefType[str, object.number.type];
                           WriteChar['?] };
                    state _ unused;
                    END;
           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;
      SELECT TRUE FROM
        state = inUse AND object.number = reader.object =>
          { usedWords[object.number.type] _ usedWords[object.number.type]
                        + SIZE[ObjectHeader] + object.size;
            IF map THEN WriteChar['-];
          };
        state = unused AND object.number = reader.object =>
          { unusedWords[object.number.type] _
             unusedWords[object.number.type]
                          + SIZE[ObjectHeader] + object.size;
            IF map THEN WriteChar['-];
          };
      ENDCASE => { gapWords _ gapWords + SIZE[ObjectHeader] + object.size;
                   IF map THEN WriteChar['.] };
      END;

      -- check for end of page --
      IF reader.where.word + SIZE[ObjectHeader] > LAST[PageIndex]
      THEN BEGIN
           pages _ pages + 1;
           Deactivate[reader.page]; -- not "Release", for better cache -
           reader.where _ HeapFileDefs.NextPage[reader.where !
              HeapFileDefs.NoMorePages => EXIT];
           -- That may have generated a signal --
           -- Note that there is no current page here.  --
           reader.page _ ReadPage[reader.where.page, 2];
           END
      ELSE -- end of any current object --
           BEGIN
           reader.object _ gapObjectNumber;
           state _ gap;
           END;
   ENDLOOP;
   END;


Count: PROCEDURE[str: GlassDefs.Handle, map: BOOLEAN] =
  BEGIN
  str.WriteString["I'm working on it ... "L];
  IF map THEN MapInfo[str];
  str.SendNow[];
  StopCompactor[];
  Start[];
  ScanHeap[str, map];
  StartCompactor[];
  WriteStats[str];
  END --Count--;


-- Main Program --

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

Process.Detach[FORK Work[]]

END.