DIRECTORY Basics, CardTab, Commander, CommanderOps, Convert, Process, Rope, IO, SafeStorage;

ExamineRootsCommands: PROGRAM
IMPORTS CardTab, Commander, CommanderOps, Convert, Process, Rope, IO, SafeStorage
~ BEGIN

ROPE: TYPE ~ Rope.ROPE;

headerUnits: CARD = 8;

EachObjectProc: TYPE ~ PROC [obj: CARD, nBytes: INT, pointerFree: BOOL];

NoteObj: UNSAFE PROC [clientData: EachObjectProc, obj: CARD, nBytes: INT, pointerFree: BOOL] ~ {
clientData[obj, nBytes, pointerFree];
};

EnumObjs: PROC [eachObject: EachObjectProc] ~ {
XrEnumObjs: UNSAFE PROC [fn: CARD, clientData: CARD]
~ UNCHECKED MACHINE CODE {"XR_EnumObjs"};
CedarProc: TYPE ~ LONG POINTER TO RECORD [startPC: CARD, staticLink: CARD];
XrEnumObjs[LOOPHOLE[NoteObj, CedarProc].startPC, LOOPHOLE[eachObject]];
};

maxp: NAT ~ 300;
ExamineRoots: PROC [r: CARD] RETURNS [LIST OF CARD] ~ {
a: ARRAY [0..maxp) OF CARD м ALL[0];
n: INT м 0;
Note: PROC [p: CARD] ~ {
IF n < maxp THEN a[n] м p;
n м n + 1;
};
Report: PROC RETURNS [list: LIST OF CARD м NIL] ~ {
FOR i: NAT DECREASING IN [0..MIN[n, maxp]) DO
list м CONS[a[i], list];
ENDLOOP;
};
Each: EachObjectProc ~ {
hdrPointer: WORD м obj;
IF hdrPointer # 0 AND NOT pointerFree AND nBytes >= headerUnits THEN {
p: POINTER TO Basics.RawCards ~ LOOPHOLE[hdrPointer];
FOR i: CARD IN [0..CARD[nBytes]/CARD[UNITS[WORD]]) DO
word: WORD ~ p[i];
IF word = r OR word+8 = r THEN {Note[hdrPointer + headerUnits]; EXIT}
ENDLOOP;
};
};
EnumObjs[Each];
RETURN [Report[]]
};

TypeIndex: TYPE ~ CARD;
HeapObject: TYPE ~ MACHINE DEPENDENT RECORD [
dull: CARD,
typeCode: TypeIndex
];

ExamineExamples: PROC [r: TypeIndex, minBytes: INT м 0, limitBytes: INT м INT.LAST] RETURNS [LIST OF CARD] ~ {
a: ARRAY [0..maxp) OF CARD м ALL[0];
n: INT м 0;
Note: PROC [p: CARD] ~ {
IF n < maxp THEN a[n] м p;
n м n + 1;
};
Report: PROC RETURNS [list: LIST OF CARD м NIL] ~ {
FOR i: NAT DECREASING IN [0..MIN[n, maxp]) DO
list м CONS[a[i], list];
ENDLOOP;
};
Each: EachObjectProc ~ {
hdrPointer: WORD м obj;
IF hdrPointer # 0 AND nBytes > headerUnits THEN {
p: POINTER TO HeapObject м LOOPHOLE[hdrPointer];
IF p.typeCode = r AND nBytes IN [minBytes..limitBytes) THEN Note[hdrPointer+headerUnits];
};
};
EnumObjs[Each];
RETURN [Report[]]
};

ExamineListSeeds: PROC [r: TypeIndex] RETURNS [ans: LIST OF CARD м NIL] ~ {
maxo: CARD ~ 150000;
Table: TYPE ~ ARRAY [0..maxo) OF CARD;
a: REF Table м NEW[Table];
s: REF Table м NEW[Table];
n: INT м 0;
Note: PROC [p: CARD, words: CARD] ~ {
IF n < maxo THEN { a[n] м p; s[n] м words };
n м n + 1;
};
Each: EachObjectProc ~ {
hdrPointer: WORD м obj;
IF hdrPointer # 0 AND nBytes >= headerUnits THEN {
p: POINTER TO HeapObject м LOOPHOLE[hdrPointer];
IF p.typeCode = r THEN {
Note[hdrPointer+headerUnits, CARD[nBytes-headerUnits]/BYTES[WORD]];
};
};
};
ReportPairs: CardTab.EachPairAction ~ TRUSTED {
IF NARROW[val, REF BOOL]н = FALSE THEN {
ans м CONS[key, ans];
};
};
EnumObjs[Each];
IF n > maxo THEN CommanderOps.Failed["Too many objects of this type"] ELSE {
tab: CardTab.Ref ~ CardTab.Create[];
FOR i: NAT IN [0..n) DO
[] м CardTab.Insert[tab, a[i], NEW[BOOL м FALSE]];
ENDLOOP;
FOR i: NAT IN [0..n) DO
p: POINTER TO Basics.RawCards ~ LOOPHOLE[a[i]];
FOR i: CARD IN [0..s[i]) DO
WITH CardTab.Fetch[tab, p[i]].val SELECT FROM
b: REF BOOL => bн м TRUE;
ENDCASE;
ENDLOOP;
ENDLOOP;
[] м CardTab.Pairs[tab, ReportPairs];
CardTab.Erase[tab];
FOR i: NAT IN [0..n) DO
a[i] м 0;
ENDLOOP;
a м NIL;
};
};

PrintAndDestroyCards: PROC [cmd: Commander.Handle, a: LIST OF CARD] ~ {
UNTIL a = NIL DO
tail: LIST OF CARD м a;
a м a.rest;
IO.PutF1[cmd.out, "%g ", [cardinal[tail.first]]];
tail.first м 0;
tail.rest м NIL;
ENDLOOP;
IO.PutRope[cmd.out, "\n"];
};

FetchTypeCode: PROC [addr: CARD] RETURNS [CARDINAL] ~ TRUSTED {
RETURN[ORD[SafeStorage.GetReferentType[LOOPHOLE[addr]]]]
};

docExamineRootsCommand: ROPE ~ "Finds things that point to a REF";

ExamineRootsCommand: Commander.CommandProc ~ TRUSTED {
ENABLE Convert.Error => CommanderOps.Failed[cmd.procData.doc];
r: CARD ~ Convert.CardFromRope[CommanderOps.NextArgument[cmd]];
a: LIST OF CARD ~ ExamineRoots[r];
PrintAndDestroyCards[cmd, a];
};

docExamineRecursiveRootsCommand: ROPE ~ "Finds things that point to things that point to ... a set of REFs ";

ExamineRecursiveRootsCommand: Commander.CommandProc ~ TRUSTED {
ENABLE Convert.Error => CommanderOps.Failed[cmd.procData.doc];
c: ARRAY [0..8192) OF CARD м ALL[0];
done: NAT м 0;
top: NAT м 0;
Insert: PROC [v: CARD] ~ {
FOR i: NAT IN [0..top) DO
IF c[i] = v THEN RETURN;
ENDLOOP;
IO.PutF1[cmd.out, "%g ", [cardinal[v]]];
[] м CommanderOps.DoCommand[IO.PutFR1["PrintTypeCode %g\n", [cardinal[FetchTypeCode[v ! UNCAUGHT => {IO.PutRope[cmd.out, "??\n"]; CONTINUE}]]]], cmd];
IF top = LENGTH[c] THEN CommanderOps.Failed["table full"];
c[top] м v;
top м top + 1;
};
FOR arg: ROPE м CommanderOps.NextArgument[cmd], CommanderOps.NextArgument[cmd] UNTIL arg = NIL DO
Insert[Convert.CardFromRope[arg]];
ENDLOOP;
UNTIL done = top DO
a: LIST OF CARD м NIL;
n: INT м 0;
r: CARD ~ c[done];
done м done + 1;
IO.PutF1[cmd.out, " . . . %g ", [cardinal[r]]];
Process.PauseMsec[333];
Process.CheckForAbort[];
a м ExamineRoots[r];
FOR tail: LIST OF CARD м a, tail.rest UNTIL tail = NIL DO n м n + 1 ENDLOOP;
IO.PutF1[cmd.out, "count: %g\n", [cardinal[n]]];
UNTIL a = NIL DO
tail: LIST OF CARD м a;
a м a.rest;
Insert[tail.first];
tail.first м 0;
tail.rest м NIL;
ENDLOOP;
ENDLOOP;
};

docExamineExamplesCommand: ROPE ~ "Finds a few things with the given typecode\nswitch: -s <minBytes> <limitBytes>";

ExamineExamplesCommand: Commander.CommandProc ~ TRUSTED {
ENABLE Convert.Error => CommanderOps.Failed[cmd.procData.doc];
r: CARD м CARD.LAST;
minBytes: INT м 0;
limitBytes: INT м INT.LAST;
arg0: ROPE _ CommanderOps.NextArgument[cmd];
IF arg0 = NIL THEN CommanderOps.Failed[cmd.procData.doc];
FOR arg: ROPE _ arg0, CommanderOps.NextArgument[cmd] UNTIL arg = NIL DO
IF Rope.Match["-*", arg]
THEN {
FOR i: INT IN (0..Rope.Size[arg]) DO
SELECT Rope.Lower[Rope.Fetch[arg, i]] FROM
's => {
minBytes м Convert.IntFromRope[CommanderOps.NextArgument[cmd]];
limitBytes м Convert.IntFromRope[CommanderOps.NextArgument[cmd]];
};
ENDCASE => CommanderOps.Failed[cmd.procData.doc];
ENDLOOP;
}
ELSE {
r: CARD ~ Convert.CardFromRope[arg];
a: LIST OF CARD ~ ExamineExamples[r, minBytes, limitBytes];
PrintAndDestroyCards[cmd, a];
};
ENDLOOP;
};

docExamineListSeedsCommand: ROPE ~ "Finds the seeds of lists with a given typecode";

ExamineListSeedsCommand: Commander.CommandProc ~ TRUSTED {
ENABLE Convert.Error => CommanderOps.Failed[cmd.procData.doc];
r: CARD ~ Convert.CardFromRope[CommanderOps.NextArgument[cmd]];
a: LIST OF CARD ~ ExamineListSeeds[r];
PrintAndDestroyCards[cmd, a];
};

MemoryGrepCommand: Commander.CommandProc ~ TRUSTED {
ENABLE Convert.Error => CommanderOps.Failed[cmd.procData.doc];
target: CARD ~ Convert.CardFromRope[CommanderOps.NextArgument[cmd]];
start: CARD ~ Convert.CardFromRope[CommanderOps.NextArgument[cmd]];
end: CARD ~ Convert.CardFromRope[CommanderOps.NextArgument[cmd]];
FOR addr: CARD м start, addr+4 UNTIL addr >= end DO
IF LOOPHOLE[addr, POINTER TO CARD]н = target THEN {
IO.PutF1[cmd.out, "0x%08x ", [cardinal[addr]]];
};
ENDLOOP;
};

Commander.Register["ExamineRoots", ExamineRootsCommand, docExamineRootsCommand];
Commander.Register["ExamineRecursiveRoots", ExamineRecursiveRootsCommand, docExamineRecursiveRootsCommand];
Commander.Register["ExamineExamples", ExamineExamplesCommand, docExamineExamplesCommand];
Commander.Register["ExamineListSeeds", ExamineListSeedsCommand, docExamineListSeedsCommand];
Commander.Register["MemoryGrep", MemoryGrepCommand, "target startAddr endAddr"];


END.


    Ф  
ExamineRootsCommands.mesa
Copyright ╙ 1991, 1992 by Xerox Corporation.  All rights reserved.
Michael Plass, September 8, 1992 11:35 am PDT

 Э╩J  ХNewlineDelimiter
Ц"cedarcode" styleЩ codeЪ╧tЬЩKЪЬ
╧eЬ7ЩBKЩ-KЩ ЧKЪ╧k	ЬCЯЬШ\KШ KЪ╨nt╧nЬЯШKЪЯЬ5ЬЯЬШQЪЬЯШKШ KЪЯЬЯЬЯЬШKШ ЪЬЯЬШKШ ЧЪЬЯЬЯЬЯЬ
ЯЬЯЬШHKШ ЧЪбЬЯЬЯЬ#ЯЬ
ЯЬЯЬШ`KЪЬ%Ш%KЪЬШKШ ЧЪбЬЯЬ!Ш/Ъ
б
ЬЯЬЯЬЯЬЯЬШ4KЪЬЯ	ЬЯЬЯЬШ)ЧKЪЬЯЬЯЬЯЬЯЬЯЬЯЬЯЬШKKЪЬЯЬЯЬШGKЪЬШЧKШ KЪЬЯЬШЪбЬЯЬЯЬЯЬЯЬЯЬЯЬШ7KЪ	ЬЯЬЯЬЯЬЯЬШ$KЪЬЯЬШЪбЬЯЬЯЬШKЪЯЬ
ЯЬ
ШKШ
KЪЬШЧЪбЬЯЬЯЬЯЬЯЬЯЬЯЬШ3ЪЯЬЯЬЯ
ЬЯЬЯЬЯШ-KЪЬЯЬШKЪЯЬШЧKЪЬШЧЪбЬШKЪЬЯЬШЪ
ЯЬЯЬЯЬЯЬЯЬШFKЪЬЯЬЯЬЯЬШ5ЪЯЬЯЬЯЬЯЬ	ЯЬЯЬЯЬЯШ5KЪЬЯЬШKЪЯЬ
ЯЬЯЬ"ЯЬШEKЪЯЬШЧKЪЬШЧKЪЬШЧKЪЬШKЪЯЬШKЪЬШKШ ЧKЪЬЯЬЯЬШЪ	ЬЯЬЯЬЯ	ЬЯЬШ-KЪЬЯЬШKЪЬШKЪЬШKШ ЧЪбЬЯЬЯЬЯЬЯЬЯЬЯЬЯЬЯЬЯЬШnKЪ	ЬЯЬЯЬЯЬЯЬШ$KЪЬЯЬШЪбЬЯЬЯЬШKЪЯЬ
ЯЬ
ШKШ
KЪЬШЧЪбЬЯЬЯЬЯЬЯЬЯЬЯЬШ3ЪЯЬЯЬЯ
ЬЯЬЯЬЯШ-KЪЬЯЬШKЪЯЬШЧKЪЬШЧЪбЬШKЪЬЯЬШЪЯЬЯЬЯЬШ1KЪЬЯЬЯЬЯЬШ0KЪЯЬЯЬЯЬЯЬШYKЪЬШЧKЪЬШЧKЪЬШKЪЯЬШKЪЬШKШ ЧЪба	ЬЯЬЯЬЯЬЯЬЯЬЯЬШKKЪЬЯЬ
ШKЪ	ЬЯЬЯЬЯЬЯЬШ&KЪЬЯЬ	ЯЬШKЪЬЯЬ	ЯЬШKЪЬЯЬШЪбЬЯЬЯЬ	ЯЬШ%KЪЯЬ
ЯЬШ,KШ
KЪЬШЧЪбЬШKЪЬЯЬШЪЯЬЯЬЯЬШ2KЪЬЯЬЯЬЯЬШ0ЪЯЬЯЬШKЪЬЯЬЯЬЯЬШCKЪЬШЧKЪЬШЧKЪЬШЧЪбЬЯЬШ/ЪЯЬЯЬЯЬЯЬЯЬЯЬШ(KЪЬЯЬШKЪЬШЧKЪЬШЧKЪЬШЪЯЬ
ЯЬ6ЯЬШLKШ$ЪЯЬЯЬЯЬЯШKЪЬЯЬЯЬЯЬШ2KЪЯЬШЧЪЯЬЯЬЯЬЯШKЪЬЯЬЯЬЯЬШ/ЪЯЬЯЬЯЬЯШЪЯЬЯЬЯШ-KЪЬЯЬЯЬ	ЯЬШKЪЯЬШЧKЪЯЬШЧKЪЯЬШЧKШ%KЪЬШЪЯЬЯЬЯЬЯШKШ	KЪЯЬШЧKЪЬЯЬШKЪЬШЧKЪЬШKШ ЧЪ
бЬЯЬЯЬЯЬЯЬШGЪЯЬЯЬЯШKЪЬЯЬЯЬЯЬШKШKЪЯЬ/Ш1KШKЪЬЯЬШKЪЯЬШЧKЪЯЬШKЪЬШKШ ЧЪбЬЯЬЯЬЯЬЯЬЯЬШ?KЪЯЬЯЬЯЬ	Ш8KШKШ ЧЪЭЬ	ЯЬ&ШBKШ ЧЪбЬЯЬШ6KЪЯЬ8Ш>KЪЬЯЬ8Ш?KЪЬЯЬЯЬЯЬШ"KЪЬШKШKШ ЧЪЭЬ	ЯЬHШmKШ ЧЪба	бЬЯЬШ?KЪЯЬ8Ш>KЪ	ЬЯЬЯЬЯЬЯЬШ$KЪЬЯЬШKЪЬЯЬШЪбЬЯЬЯЬШЪЯЬЯЬЯЬ
ЯШKЪЯЬ
ЯЬЯЬШKЪЯЬШЧKЪЯЬ&Ш(KЪ	ЬЯЬ:ЯЬЯЬЯЬШЦKЪЯЬЯЬЯЬ#Ш:KШKШKШЧЪ	ЯЬЯЬBЯЬЯЬЯШaKЪЬ"Ш"KЪЯЬШЧЪЯЬЯШKЪ	ЬЯЬЯЬЯЬЯЬШKЪЬЯЬШKЪЬЯЬШKШKЪЯЬ-Ш/KЪЬШKШKШKЪЯЬЯЬЯЬЯЬЯЬЯЬЯЬЯЬШLKЪЯЬ.Ш0ЪЯЬЯЬЯШKЪЬЯЬЯЬЯЬШKШKЪЬШKШKЪЬЯЬШKЪЯЬШЧKЪЯЬШЧKШKШ ЧЪЭ
ЬЯЬTШsKШ ЧЪбЬЯЬШ9KЪЯЬ8Ш>KЪЬЯЬЯЬЯЬШKЪЬ
ЯЬШKЪЬЯЬЯЬЯЬШKЪЬЯЬ"Ш,KЪЯЬЯЬЯЬ'Ш9Ъ	ЯЬЯЬ(ЯЬЯЬЯШGЪЯЬШЪЯЬШЪЯЬЯЬЯЬЯШ$ЪЯЬ ЯШ*ШKШ?KШAKШЧKЪЯЬ*Ш1ЧKЪЯЬШЧKШЧЪЯЬШKЪЬЯЬШ$KЪЬЯЬЯЬЯЬ,Ш;KЪЬШKЪЬШЧЧKЪЯЬШЧKШKШ ЧЪЭЬ	ЯЬ4ШTKШ ЧЪба	бЬЯЬШ:KЪЯЬ8Ш>KЪЬЯЬ8Ш?KЪ	ЬЯЬЯЬЯЬ
Э	ЬШ&KЪЬШKШKШ ЧЪбЬЯЬШ4KЪЯЬ8Ш>KЪЬЯЬ8ШDKЪЬЯЬ8ШCKЪЬЯЬ8ШAЪЯЬЯЬЯЬЯШ3ЪЯЬЯЬЯЬЯЬЯЬЯЬШ3KЪЯЬ-Ш/KЪЬШЧKЪЯЬШЧKЪЬШKШ ЧKЪЬЭЬЭЬ	ЭЬ	ШPKЪЬЭЬЭЬ	ЭЬ	ШkKЪЬЭЬЭЬ	Э
ЬШYKЪЬЭЬЭЬ	Э
ЬШ\KЪ	Ь4ЭЬЭЬЭЬЭЬШPKШ ЧKШ KЪЯЬШKШ JШ Ч ЕЧ    ─  *в  