ExamineStorage.mesa
Copyright Ó 1990, 1991 by Xerox Corporation. All rights reserved.
Spreitze, December 10, 1990 11:49 am PST
Michael Plass, July 16, 1992 4:27 pm PDT
DIRECTORY Basics, Commander, CommanderOps, Convert, ConvertUnsafe, IO, List, MesaLoadState, PrintTypeString, Process, Rope, StructuredStreams, UnparserBuffer;
ExamineStorage:
CEDAR
PROGRAM
IMPORTS Commander, CommanderOps, Convert, ConvertUnsafe, IO, List, MesaLoadState, PrintTypeString, Process, Rope, StructuredStreams, UnparserBuffer
= BEGIN OPEN SS:StructuredStreams, UB:UnparserBuffer;
LORA: TYPE ~ LIST OF REF ANY;
ROPE: TYPE ~ Rope.ROPE;
XrBool: TYPE ~ CARD --0 is FALSE, 1 is TRUE--;
CedarProc: TYPE ~ LONG POINTER TO RECORD [startPC, flag: CARD];
TypeCount: TYPE = RECORD [objects, bytes: INT];
TypeIndex: TYPE = CARD;
TypeCounts: TYPE = REF TypeCountsRep;
TypeCountsRep:
TYPE =
RECORD [
types: INT ¬ 0,
bytes, objects: RECORD [counted, rejected: INT ¬ 0] ¬ [],
counts: SEQUENCE size: TypeIndex OF TypeCount
];
HeapObject:
TYPE ~
RECORD [
dull: CARD,
typeCode: TypeIndex];
True:
PROC [b: XrBool]
RETURNS [
BOOL]
~ INLINE {RETURN [b#0]};
CreateTypeCounts:
PROC
RETURNS [tcs: TypeCounts] ~ {
size: TypeIndex ¬ 3000;
tcs ¬ NEW [TypeCountsRep[size]];
tcs.types ¬ 0;
tcs.bytes ¬ tcs.objects ¬ [0, 0];
FOR i: NAT IN [0..tcs.size) DO tcs[i] ¬ [0, 0] ENDLOOP;
RETURN};
XrEnumObjs:
UNSAFE
PROC [fn:
CARD, clientData:
REF
ANY]
~ UNCHECKED MACHINE CODE {"XR𡤎numObjs"};
Sample:
PROC [tcs: TypeCounts] ~
TRUSTED {
noteCP: CedarProc ~ LOOPHOLE[NoteObj];
XrEnumObjs[noteCP.startPC, tcs];
RETURN};
NoteObj:
UNSAFE
PROC [tcs: TypeCounts, obj:
LONG
POINTER
TO HeapObject, sz:
INT, isAtomic: XrBool] ~
UNCHECKED {
typeCode: TypeIndex ¬ obj.typeCode;
IF typeCode
IN [0..tcs.size)
THEN {
tcs.objects.counted ¬ tcs.objects.counted.SUCC;
tcs.bytes.counted ¬ tcs.bytes.counted + sz;
IF tcs[typeCode].objects=0 THEN tcs.types ¬ tcs.types.SUCC;
tcs[typeCode].objects ¬ tcs[typeCode].objects.SUCC;
tcs[typeCode].bytes ¬ tcs[typeCode].bytes + sz;
}
ELSE {
tcs.objects.rejected ¬ tcs.objects.rejected.SUCC;
tcs.bytes.rejected ¬ tcs.bytes.rejected + sz;
};
RETURN};
PrintTypeCounts:
PROC [to:
IO.
STREAM, tcs: TypeCounts, nLargest:
INT] ~ {
CompareListElt:
PROC [ref1, ref2:
REF
ANY]
RETURNS [Basics.Comparison] ~ {
ri1: REF INT ~ NARROW[ref1]; i1: INT ~ tcs[ri1].bytes;
ri2: REF INT ~ NARROW[ref2]; i2: INT ~ tcs[ri2].bytes;
SELECT
TRUE
FROM
i1 < i2 => RETURN [greater];
i1 > i2 => RETURN [less];
ENDCASE => RETURN [equal]};
ts: LONG STRING;
tr: ROPE;
theList: LORA ¬ NIL;
to.PutFL["%g types, %g objects, %g bytes counted; %g objects, %g bytes rejected.\n", LIST[ [integer[tcs.types]], [integer[tcs.objects.counted]], [integer[tcs.bytes.counted]], [integer[tcs.objects.rejected]], [integer[tcs.bytes.rejected]]]];
FOR i: TypeIndex
IN [0..tcs.size)
DO
IF tcs[i].objects # 0 THEN theList ¬ CONS[NEW[INT ¬ i], theList];
ENDLOOP;
theList ¬ List.Sort[theList, CompareListElt];
FOR j:
INT
IN [0..nLargest)
WHILE theList #
NIL
DO
ri: REF INT ~ NARROW[theList.first];
i: INT ~ ri;
PrintTypesCounts:
PROC ~ {
to.PutF["tc: %04g, o: %06g, b: %09g,", [cardinal[i]], [integer[tcs[i].objects]], [integer[tcs[i].bytes]] ];
SS.Bp[to, width, 3, " "];
to.PutRope["type: "];
ts ¬ MesaLoadState.TypeStringFromType[VAL[i]];
tr ¬ ConvertUnsafe.ToRope[ts];
IF tr.Length[]=0
THEN to.PutRope["(appears invalid)"]
ELSE {
PrintTypeString.ToStream[to, tr !PrintTypeString.Malformed => {
to.PutF[" !Malformed[%g, %g]", [integer[i]], [rope[why]] ];
CONTINUE}];
};
};
theList ¬ theList.rest;
Process.CheckForAbort[];
IF tcs[i].objects#0 THEN {PrintObj[to, PrintTypesCounts]; to.PutRope["\n"]};
ENDLOOP;
RETURN};
PrintObj:
PROC [to:
IO.
STREAM,
Inner:
PROC] ~ {
SS.Begin[to];
Inner[!UNWIND => SS.End[to]];
SS.End[to];
RETURN};
ExamineCmd: Commander.CommandProc ~ {
tcs: TypeCounts ~ CreateTypeCounts[];
argv: CommanderOps.ArgumentVector ~ CommanderOps.Parse[cmd];
nLargest: INT ¬ 20;
margin: INT ¬ 60;
{ENABLE Convert.Error => CommanderOps.Failed["numeric conversion error"];
IF argv.argc>1 THEN nLargest ¬ Convert.IntFromRope[argv[1]];
IF argv.argc>2 THEN margin ¬ Convert.IntFromRope[argv[2]];
};
{sso: IO.STREAM ¬ SS.Create[UB.NewInittedHandle[[margin: margin, output: [stream[cmd.out]]]]];
Sample[tcs];
PrintTypeCounts[sso, tcs, nLargest];
RETURN}};
Commander.Register["ExamineStorage", ExamineCmd, "Scan heap for memory-consuming TYPEs\nargs: [ nLargest [ margin ] ]"];
END.