<<>> <> <> <> <<>> 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 "; 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.