-- HeapPrint.mesa

-- Andrew Birrell August 12, 1982 1:16 pm

DIRECTORY
Directory,
File,
HeapXDefs,
ObjectDirDefs,
IO,
Rope		USING[ ROPE ],
Space;

HeapPrint: PROGRAM
IMPORTS Directory, File, IO, Space
SHARES ObjectDirDefs =

BEGIN

-- Heap.chain --

segmentCount: CARDINAL = 200; -- number of segments in message body file --
Segment:      TYPE = [0..segmentCount);
SegmentPtr:   TYPE = [ FIRST[Segment] .. 1+LAST[Segment] ];

noSegment:    SegmentPtr = LAST[SegmentPtr];

-- the 'free' and 'written' chains are stored permanently on a disk page--
PageType: TYPE = RECORD[written: ARRAY[0..0]OF SegmentPtr --for alignment--,
                        free:    ARRAY[0..0]OF SegmentPtr --for alignment--,
                        ser:     LONG INTEGER,
                        next:    ARRAY Segment OF SegmentPtr];

ChainPage: TYPE = LONG POINTER TO PageType;

chain: ChainPage;
segSize: CARDINAL;
fileSize: INT;

GetChain: PROC =
  BEGIN
  file: File.Capability = Directory.LookupUnlimited["Heap.chain"];
  space: Space.Handle = Space.Create[2, Space.virtualMemory];
  chain0: ChainPage = Space.LongPointer[space];
  chain1: ChainPage = Space.LongPointer[space] + 256;
  Space.Map[space, [file,1]];
  chain _ IF chain0.ser > chain1.ser THEN chain0 ELSE chain1;
  segSize _ fileSize / segmentCount;
  END;

First: PROC RETURNS[first: CARDINAL] =
  -- returns file-relative page number of first written page --
  { first _ chain.written[0] * segSize; out.PutF["\n%g: ", [cardinal[first]]] };

NoMorePages: ERROR = CODE;

Next: PROC[prev: CARDINAL] RETURNS[ next: CARDINAL ] =
  BEGIN
  IF prev MOD segSize < segSize-1
  THEN { next _ prev+1; out.PutChar[IO.SP] }
  ELSE BEGIN
       seg: SegmentPtr = chain.next[prev / segSize];
       IF seg = noSegment
       THEN ERROR NoMorePages[]
       ELSE BEGIN
            next _ seg * segSize;
            out.PutF["\n%g: ", [cardinal[next]]];
            END;
       END;
  END;


-- Heap.data --

briefType: ARRAY ObjectDirDefs.ObjectType OF Rope.ROPE = [
  gap: ".",
  body: "B",
  SLinput: "S",
  SLpending: "S",
  SLforward: "S",
  RSobject: "R",
  RSmail: "RSmail",
  temp: "temp",
  RSname: "RSname",
  MSname : "MSname",
  testMode: "test",
  TOC: "T",
  archived: "A",
  delArch: "spare15",
  spare16: "spare16",
  spare17: "spare17" ];

fullType: ARRAY ObjectDirDefs.ObjectType OF Rope.ROPE = [
  gap: "gap",
  body: "body",
  SLinput: "SLinput",
  SLpending: "SLpending",
  SLforward: "SLforward",
  RSobject: "RSobject",
  RSmail: "RSmail",
  temp: "temp",
  RSname: "RSname",
  MSname : "MSname",
  testMode: "testMode",
  TOC: "TOC",
  archived: "archived",
  delArch: "spare15",
  spare16: "spare16",
  spare17: "spare17" ];

in, out, textOut: IO.STREAM _ NIL;

gap: ObjectDirDefs.ObjectNumber _ ObjectDirDefs.noObject;

interesting: ObjectDirDefs.ObjectNumber _ -- object to watch for --
  [page: 1, fill: 0, type: SLforward, index: 36];

wanted: INT _ 500; -- number of characters to print --

nextOffset: LONG CARDINAL _ 0; -- next offset to expect in current object --

current: ObjectDirDefs.ObjectNumber;

pauseAtPage: CARDINAL _ LAST[CARDINAL]; -- wait for CR to be typed at that time --

watchPage: REF PACKED ARRAY NAT OF BOOL =
    NEW[PACKED ARRAY NAT OF BOOL _ ALL[FALSE]]; -- pages to print --

file: File.Capability = Directory.LookupUnlimited["Heap.data"];
space: Space.Handle = Space.Create[1, Space.virtualMemory];
header: LONG POINTER TO HeapXDefs.PageHeader = Space.LongPointer[space];
pageWords: LONG POINTER TO ARRAY [0..256) OF WORD = LOOPHOLE[header];
pageChars: LONG POINTER TO PACKED ARRAY [0..512) OF CHAR = LOOPHOLE[header];

Init: PROC =
  BEGIN
  fileSize _ File.GetSize[file];
  GetChain[];
  Space.Map[space];
  [in: in, out: out] _ IO.CreateTTYStreams["Heap Summary"];
  out.PutRope["For start of new object: \"B\" = body, \"S\" = steering-list, \"R\" = RSobject, \"T\" = TOC, \"A\" = archive, \"$\" = illegal object number;\n\"-\" = continuation sub-object;\n\".\" = gap sub-object;\n\"g\" = imbedded garbage;\n\"*\" = sub-object also recorded in \"Object contents\" viewer;\n<sp> between pages;\n<cr> at segment boundary.\n\n"];
  END;
  
Main: PROC =
  BEGIN
  current _ gap;
  FOR i: CARDINAL _ First[], Next[i ! NoMorePages => CONTINUE]
  DO PrintPage[i, watchPage[i]] ENDLOOP;
  IF current # gap THEN out.PutRope["\nUnterminated object!"];
  END;

PrintPage: PROC[i: CARDINAL, all: BOOL] =
  BEGIN
  word: [0..256] _ SIZE[HeapXDefs.PageHeader];
  Space.CopyIn[space, [file, i+1]];
  IF i = pauseAtPage
  THEN { out.PutRope["\nType any character to continue:"]; [] _ in.GetChar[] };
  DO -- for each sub-object --
     offset: LONG CARDINAL =
               IF word # SIZE[HeapXDefs.PageHeader] THEN 0 ELSE header.offset;
     objH: LONG POINTER TO HeapXDefs.ObjectHeader = LOOPHOLE[header + word];
     objChars: LONG POINTER TO PACKED ARRAY [0..512) OF CHAR =
                              LOOPHOLE[objH + SIZE[HeapXDefs.ObjectHeader]];
     TypeObj: PROC[remark: Rope.ROPE] =
       BEGIN
       IF textOut = NIL
       THEN BEGIN
            [out: textOut] _ IO.CreateTTYStreams["Object contents"];
            textOut.PutRope["Object:  offset:  size:  heap-page:  heap-word:  remarks:\n"];
            END;
       textOut.PutF[
                "\n[p:%g,i:%g,%g]",
                [cardinal[objH.number.page]],
                [cardinal[objH.number.index]],
                [rope[fullType[objH.number.type]]] ];
       textOut.PutF[", o:%bB, s:%bB;  h:%g, w:%g, %g",
                [cardinal[offset]],
                [cardinal[objH.size]],
                [cardinal[i]],
                [cardinal[word]],
                [rope[remark]] ];
       IF objH.number = interesting
       THEN BEGIN
            IF wanted > 0
            THEN BEGIN
                 textOut.PutChar['\n];
                 FOR i: INT IN [0..objH.size*2)
                 DO textOut.PutChar[objChars[i]]; wanted _ wanted-1 ENDLOOP;
                 END;
            END;
       out.PutChar['*];
       END;
     SELECT TRUE FROM
       objH.number.page>256 OR objH.number.index>85 OR objH.number.fill#0 =>
         { out.PutChar['$]; TypeObj["illegal"] };
       objH.number = gap =>
         out.PutChar['.];
       objH.number = current =>
         out.PutChar['-];
       current # gap =>
         out.PutChar['g];
     ENDCASE =>
       { current _ objH.number; nextOffset _ 0;
         out.PutRope[briefType[objH.number.type]] };
     IF all THEN TypeObj["watchPage"];
     IF current # gap AND objH.number = current
     THEN SELECT TRUE FROM
            offset = nextOffset =>
              { IF objH.number = interesting THEN TypeObj["ok"];
                nextOffset _ offset + objH.size };
            offset < nextOffset AND nextOffset < offset + objH.size =>
              { IF objH.number = interesting THEN TypeObj["overlap"];
                nextOffset _ offset + objH.size };
            offset < nextOffset =>
              { IF objH.number = interesting THEN TypeObj["redundant"] };
            offset > nextOffset =>
              { TypeObj["****gap****"];
                nextOffset _ offset + objH.size };
          ENDCASE => ERROR;
     word _ word + SIZE[HeapXDefs.ObjectHeader];
     word _ word + objH.size;
     IF word + SIZE[HeapXDefs.ObjectHeader] > 255 THEN EXIT;
     IF objH.number = current THEN current _ gap;
  ENDLOOP;
  END;

Init[];

{ dummy: PROCESS = FORK Main[]; };

END.