~
BEGIN
ROPE: TYPE ~ Rope.ROPE;
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𡤎numObjs"};
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[]]
};
Examine
ListSeeds:
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 ";
Examine
RecursiveRootsCommand: 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";
Examine
ListSeedsCommand: 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"];