Syntax10.Scn.FntSyntax10i.Scn.FntMarkElemsAlloc"IStampElemsAlloc25 May 97qInfoElemsAllocVSyntax10.Scn.FntIStampElemsAlloc25 May 97"Title": HeapInspViewers "Author": Martin Rammerstorfer (MR) "Abstract": . "Keywords": Heap, module descriptors, type descriptors, typed memory "Version": 1 "From": 28.06.96 15:14:03 "Until":  "Changes": no changes "Hints": 8FoldElemsNew88#Syntax10.Scn.Fnt## TAB = 09X; Simple = 0; WithSort = 1; WithFolds = 2; red = 1; darkred = 7; (*green = 2;*) darkgreen = 8; blue = 3; darkblue = 9; (*magenta = 4; yellow = 5; lightblue = 10; darkcyan = 11;*) black = 15; (*white = 0; grey0 = 12; grey1 = 13; grey2 = 14;*) All = 0; Named = 1; Classes = 2; 828Syntax10.Scn.Fnt8FoldElemsNew#Syntax10.Scn.Fnt w: Texts.Writer; parc2, parc5, parc52, parcFin, parcFree, parcTask: TextFrames.Parc; cmdSortName, cmdSortNumber, cmdSortSize: PopupElems.Elem; cmdExpFolds, cmdCollFolds, cmdSearch: PopupElems.Elem; menuViewer: MenuViewers.Viewer; END; 8"38CSyntax10.Scn.FntSyntax10i.Scn.Fnt#R FinObjNode = RECORD (* Copied from Kernel.FinObjNode *) next: FinObj; obj: LONGINT; marked: BOOLEAN; fin: Kernel.Finalizer END; Syntax10i.Scn.Fnt8O TextDesc = RECORD  FinObj = POINTER TO FinObjNode;  Like Kernel.FinObj  88#Syntax10.Scn.Fnt t: TextDesc; 8 {kK8#Syntax10.Scn.Fnt.. BEGIN Texts.WriteString (t.w, s) END String; 8 |kK8#Syntax10.Scn.Fnt'' BEGIN Texts.Write (t.w, TAB) END Tab; 8 ~kK8#Syntax10.Scn.Fnt## BEGIN Texts.WriteLn (t.w) END Ln; 8 }kK8#Syntax10.Scn.Fnt++ BEGIN Texts.WriteInt (t.w, l, 0) END Int; 8 }kK}8#Syntax10.Scn.Fntaa BEGIN IF HI.printHex THEN Texts.WriteHex (t.w, l) ELSE Texts.WriteInt (t.w, l, 0) END END AInt; 8 {kK*8#Syntax10.Scn.FntMM BEGIN Texts.WriteString (t.w, s); Texts.WriteInt (t.w, l, 0) END StringInt; 8 {kK8#Syntax10.Scn.FntEE BEGIN Texts.WriteString (t.w, s); Texts.WriteLn (t.w) END StringLn; 8 kK8#Syntax10.Scn.Fnt%% BEGIN Texts.Write (t.w, ch) END Ch; 8  8#Syntax10.Scn.Fnt88 BEGIN Texts.SetFont (t.w, Fonts.Default) END TDefault; 8 t8#Syntax10.Scn.FntHH BEGIN Texts.SetFont (t.w, Fonts.This ("Syntax10b.Scn.Fnt")) END TBold; 8 kK8#Syntax10.Scn.Fnt// BEGIN Texts.Append (txt, t.w.buf) END Append; 8 {kK8#Syntax10.Scn.Fnt-- BEGIN Texts.SetColor (t.w, c) END SetColor; 8  !A8#Syntax10.Scn.Fnt VAR fold: FoldElems.Elem; BEGIN NEW (fold); fold.visible := TRUE; NEW (fold.hidden); Texts.OpenBuf (fold.hidden); fold.W := FoldElems.elemW; fold.H := FoldElems.elemH; fold.handle := FoldElems.FoldHandler; IF collapsed THEN IF left THEN fold.mode := FoldElems.colLeft ELSE fold.mode := FoldElems.colRight END ELSIF left THEN fold.mode := FoldElems.expLeft ELSE fold.mode := FoldElems.expRight END; Texts.WriteElem (t.w, fold); Append (txt); IF switch THEN FoldElems.Switch (fold) END END InsertFolds; 8 +?48#Syntax10.Scn.Fnt!! VAR cmds: PopupElems.Elem; BEGIN NEW (cmds); COPY (name, cmds.name); cmds.small := TRUE; cmds.menu := TextFrames.Text (""); cmds.handle := PopupElems.Handle; Texts.Delete (cmds.menu, 0, cmds.menu.len); Append (cmds.menu); PopupElems.MeasureMenu (cmds); RETURN cmds END CreatePopup; 8  P=8#Syntax10.Scn.Fnt VAR c: PopupElems.Elem; copy: Texts.CopyMsg; BEGIN cmds.handle (cmds, copy); c := copy.e (PopupElems.Elem); Texts.WriteElem (t.w, c); Texts.Insert (menu.text, menu.text.len, t.w.buf) END InsertPopup; 8 kKG8BSyntax10.Scn.FntSyntax8i.Scn.FntW VAR menuF, mainF: TextFrames.Frame; x, y: INTEGER; BEGIN txt := TextFrames.Text(""); CASE menu OF WithSort: menuF := TextFrames.NewMenu (title, ""); InsertPopup (HI.t.cmdSClose, menuF); InsertPopup (t.cmdSortName, menuF); InsertPopup (t.cmdSortNumber, menuF); InsertPopup (t.cmdSortSize, menuF); InsertPopup (HI.t.cmdStore, menuF) | WithFolds:menuF := TextFrames.NewMenu (title, ""); InsertPopup (HI.t.cmdSClose, menuF); InsertPopup (t.cmdExpFolds, menuF); InsertPopup (t.cmdCollFolds, menuF); InsertPopup (t.cmdSearch, menuF); InsertPopup (HI.t.cmdStore, menuF) | Simple: menuF := TextFrames.NewMenu (title, ""); InsertPopup (HI.t.cmdSClose, menuF); InsertPopup (HI.t.cmdStore, menuF) ELSE menuF := TextFrames.NewMenu (title, "System.Close System.Copy System.Grow"); END; mainF := TextFrames.NewText(txt, 0); Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y); t.menuViewer := MenuViewers.New(menuF, mainF, TextFrames.menuH, x, y) END OpenViewer; 8 kKSyntax10b.Scn.Fnt8Syntax10.Scn.Fnt`8FoldElemsNew#Syntax10.Scn.Fnt~~m: X.Module; i, size, code, data, refs, nOfTD, totalSize: LONGINT; txt: Texts.Text; copy: Texts.CopyMsg; p: TextFrames.Parc;88#Syntax10.Scn.FntSS m := S.VAL (X.Module, HI.mods.e [i].mod); X.GetSizes (m, code, data, refs, size, nOfTD); String (m.name); Tab; Int (code); Tab; Int (data); Tab; Int (refs); Tab; Int (nOfTD); Tab; Int (size); Tab; Int (HI.mods.e [i].cntIsImpDir); StringInt (" / ", HI.mods.e [i].cntIsImpIndir); IF HI.mods.e [i].isImported THEN Ch ('#') END; Tab; Int (HI.mods.e [i].cntImpDir); StringInt (" / ", HI.mods.e [i].cntImpIndir); IF HI.mods.e [i].specUnload THEN String ("++") ELSIF HI.mods.e [i].unload THEN Ch ('+') END; IF HI.mods.e [i].unloadP THEN Ch ('*') END; INC(totalSize, size); Ln Syntax10i.Scn.Fnt+8 VAR  BEGIN HI.HeapUpdate; OpenViewer ("Modules", txt, WithSort); t.parc5.handle (t.parc5, copy); p := copy.e (TextFrames.Parc); Texts.WriteElem (t.w, p); TBold; String ("Module"); Tab; String ("code"); Tab; String ("data"); Tab; String ("refs"); Tab; String ("types"); Tab; String ("total mem"); Tab; String ("is imported"); Tab; StringLn ("imports"); Tab; Tab; Tab; Tab; Tab; Tab; String ("dir / indir"); Tab; StringLn ("dir / indir"); TDefault; totalSize := 0; FOR i := 0 TO HI.mods.cnt - 1 DO  Print modules + information about modules  END; Ln; Int (totalSize); StringInt (" bytes of memory used for ", HI.mods.cnt); String (" modules."); Append (txt) END Modules; :8 kK8#Syntax10.Scn.Fnt   VAR i, totalObjMem: LONGINT; txt: Texts.Text; copy: Texts.CopyMsg; p: TextFrames.Parc; m: X.Module; BEGIN HI.HeapUpdate (); OpenViewer ("ObjectsByModules", txt, WithSort); i := 0; totalObjMem := 0; t.parc2.handle (t.parc2, copy); p := copy.e (TextFrames.Parc); Texts.WriteElem (t.w, p); TBold; String ("Module"); Tab; String ("number of objects"); Tab; StringLn ("memory consumed by objects"); Ln; TDefault; FOR i := 0 TO HI.mods.cnt - 1 DO m := S.VAL (X.Module, HI.mods.e [i].mod); IF HI.mods.e [i].objs > 0 THEN String (m.name); Tab; Int (HI.mods.e [i].objs); Tab; Int (HI.mods.e [i].objMem); Ln; INC (totalObjMem, HI.mods.e [i].objMem) END END; Ln; Int (totalObjMem); String (" bytes of memory consumed by objects."); Append (txt) END ObjectsByModule; <8 kK 8Syntax10.Scn.Fnt'8FoldElemsNew#Syntax10.Scn.Fnttxt: Texts.Text; copy: Texts.CopyMsg; p: TextFrames.Parc; nofMethods, size, size2, i, frag, nrOfNamedT, nrOfClasses: LONGINT; str: ARRAY 16 OF CHAR; mode: INTEGER; named: BOOLEAN;8<s8#Syntax10.Scn.Fntkk In.Name (str); IF str = "Named" THEN mode := Named ELSIF str = "Classes" THEN mode := Classes END Syntax10i.Scn.Fnt 88#Syntax10.Scn.Fnt.. ASSERT (HI.types.elems [i].type # NIL); S.GET (S.VAL (LONGINT, HI.types.elems [i].type) + 8, size); S.GET (size, size); size2 := S.VAL (LONGINT, S.VAL (SET, size + HI.BlockSize - 1 + 4) - S.VAL (SET, HI.BlockSize - 1)); nofMethods := X.GetNoOfMethods (S.VAL (X.TypeS, HI.types.elems [i].type)); frag := size2 - size; named := HI.types.elems [i].type.name # ""; IF named THEN INC (nrOfNamedT) END; IF nofMethods > 0 THEN INC (nrOfClasses) END; IF ((mode # Named) OR named) & ((mode # Classes) OR (nofMethods > 0)) THEN String (HI.types.elems [i].type.module.name); Ch ("."); String (HI.types.elems [i].type.name); Tab; Int (frag); Tab; Int (size); Tab; Int (frag * HI.types.elems [i].nofObjs); Tab; Int (HI.types.elems [i].nofObjs); Tab; Int (size2 * HI.types.elems [i].nofObjs); Ln END  8 VAR  BEGIN In.Open; mode := All; IF In.Next () = In.name THEN  Read mode  END; nrOfNamedT := 0; nrOfClasses := 0; HI.HeapUpdate (); OpenViewer ("Types", txt, WithSort); t.parc2.handle (t.parc52, copy); p := copy.e (TextFrames.Parc); Texts.WriteElem (t.w, p); TBold; String ("Type"); Tab; String ("frag."); Tab; String ("size"); Tab; String ("frag. loss"); Tab; String ("nofObjs"); Tab; StringLn ("mem (incl. frag.)"); Ln; TDefault; FOR i := 0 TO HI.types.count - 1 DO  Print types  END; Ln; Int (HI.types.count); StringLn (" types."); Int (nrOfNamedT); StringLn (" named types."); Int (nrOfClasses); String (" classes."); Append (txt) END ObjectsByType; A8 kK8eSyntax10.Scn.Fnt8FoldElemsNew#Syntax10.Scn.Fnttxt: Texts.Text; copy: Texts.CopyMsg; size, size2, i, frag, nrOfNamedT, nrOfTypes: LONGINT; p: TextFrames.Parc; modName: ARRAY 34 OF CHAR; outText: ARRAY 85 OF CHAR; sysBlks, typeDescs, arrP: Descs.Count;8rSyntax10b.Scn.FntFc8#Syntax10.Scn.Fnt{{ IF HI.types.elems [i].specNofObjs # 0 THEN S.GET (S.VAL (LONGINT, HI.types.elems [i].type) + 8, size); S.GET (size, size); size2 := S.VAL (LONGINT, S.VAL (SET, size + HI.BlockSize - 1 + 4) - S.VAL (SET, HI.BlockSize - 1)); frag := size2 - size; IF HI.types.elems [i].type.name # "" THEN INC (nrOfNamedT) END; INC (nrOfTypes); String (HI.types.elems [i].type.module.name); Ch ("."); String (HI.types.elems [i].type.name); Tab; Int (frag); Tab; Int (size); Tab; Int (frag * HI.types.elems [i].specNofObjs); Tab; Int (HI.types.elems [i].specNofObjs); Tab; Int (size2 * HI.types.elems [i].specNofObjs); Ln END Syntax10i.Scn.Fnt8 VAR  BEGIN HI.HeapUpdate (); In.Open (); IF In.Next () # In.name THEN Out.String ("No module specified."); Out.Ln; RETURN END; HI.types.ClearOutCnt (); In.Name (modName); IF modName = "HeapInspector" THEN Out.String ('Module "HeapInspector" not allowed as parameter !'); Out.Ln; RETURN END; IF ~Descs.MarkModObjects (modName) THEN Out.String ('Module "'); Out.String (modName); Out.String ('" not found.'); Out.Ln; RETURN END; HI.types.CountMarkedObjs (HI.mods, sysBlks, typeDescs, arrP); nrOfNamedT := 0; nrOfTypes := 0; HI.CheckModUpdate (); outText := 'From module "'; Strings.Append (modName, outText); Strings.Append ('" reached objects', outText); OpenViewer (outText, txt, WithSort); t.parc2.handle (t.parc52, copy); p := copy.e (TextFrames.Parc); Texts.WriteElem (t.w, p); TBold; String ("Type"); Tab; String ("frag."); Tab; String ("size"); Tab; String ("frag. loss"); Tab; String ("nofObjs"); Tab; StringLn ("mem (incl. frag.)"); Ln; TDefault; FOR i := 0 TO HI.types.count - 1 DO  Print reached types  END; String ("$$$SysblocksAndArraysWithoutPointers$$$"); Tab; Int (0); Tab; Int (sysBlks.mem - sysBlks.frag); Tab; Int (sysBlks.frag); Tab; Int (sysBlks.nOfObjs); Tab; Int (sysBlks.mem); Ln; String ("$$$Typedescriptors$$$"); Tab; Int (0); Tab; Int (typeDescs.mem - typeDescs.frag); Tab; Int (typeDescs.frag); Tab; Int (typeDescs.nOfObjs); Tab; Int (typeDescs.mem); Ln; String ("$$$ArraysWithPointers$$$"); Tab; Int (0); Tab; Int (arrP.mem - arrP.frag); Tab; Int (arrP.frag); Tab; Int (arrP.nOfObjs); Tab; Int (arrP.mem); Ln; Ln; Int (nrOfTypes); StringLn (" types."); Int (nrOfNamedT); String (" named types."); Append (txt) END ModuleReachableTypes; 98 n8Syntax10.Scn.Fnt^8FoldElemsNew#Syntax10.Scn.Fnttxt: Texts.Text; mod, rMod: X.Module; first: BOOLEAN; r: Ref.Rider; i, j, k, n, nOfImps: INTEGER; termH: X.TerminationHandler;8q8PSyntax10.Scn.FntB8FoldElemsNew#Syntax10.Scn.Fnt TDefault; Ref.OpenProc (S.VAL (LONGINT, termH), r); Tab; Tab; String ("Termination handler: "); String (r.mod); Ch ('.'); String (r.name); TBold Syntax10i.Scn.Fnt)88#Syntax10.Scn.Fnt   FOR j := 1 TO nOfImps - 1 DO IF (j MOD 6) = 1 THEN Ln; Tab; Tab; Tab ELSE Ch (' ') END; rMod := S.VAL (X.Module, X.GetImportInMod (mod, j)); String (rMod.name); IF j < (nOfImps - 1) THEN Ch (',') ELSE Ch ('.') END END ELSE String (" None.") :8l8#Syntax10.Scn.Fntrr IF j # i THEN rMod := S.VAL (X.Module, HI.mods.e [j].mod); FOR k := 1 TO X.GetNoOfImportsInMod (rMod) - 1 DO IF mod = S.VAL (X.Module, X.GetImportInMod (rMod, k)) THEN IF ~first THEN Ch (',') ELSE first := FALSE END; IF (n MOD 6) = 0 THEN Ln; Tab; Tab; Tab ELSE Ch (' ') END; String (rMod.name); INC (n) END END END 08d! TBold; mod := S.VAL (X.Module, HI.mods.e [HI.mods.sort [i]].mod); String (mod.name); termH := X.GetTermHandler (S.VAL (X.Module, mod)); IF termH # NIL THEN  Print termination handler, if installed  END; Ln; Tab; Tab; String ("imports:"); TDefault; InsertFolds (txt, TRUE, FALSE, FALSE); nOfImps := X.GetNoOfImportsInMod (mod); IF nOfImps # 1 THEN  Print all modules which are imported from current module  END; InsertFolds (txt, FALSE, FALSE, TRUE); Ln; Tab; Tab; TBold; String ("is imported from:"); TDefault; InsertFolds (txt, TRUE, FALSE, FALSE); n := 0; first := TRUE; FOR j := 0 TO SHORT (HI.mods.cnt - 1) DO  Print all modules which imports current module  END; IF n = 0 THEN String (" None") END; Ch ('.'); InsertFolds (txt, FALSE, FALSE, TRUE); Ln Syntax10i.Scn.Fnt98! VAR  BEGIN HI.CheckModUpdate (); OpenViewer ("Imports", txt, WithFolds); FOR i := 0 TO SHORT (HI.mods.cnt - 1) DO  Print imported modules and modules importing curr. mod.  END; Append (txt) END Imports; E8 n8Syntax10.Scn.Fnt8FoldElemsNew#Syntax10.Scn.FntGG notFound := TRUE; first := TRUE; cnt := 0; FOR j := 0 TO HI.mods.cnt - 1 DO IF HI.mods.e [j].hierarchy = i THEN INC (cnt) END END; FOR j := 0 TO HI.mods.cnt - 1 DO IF HI.mods.e [j].hierarchy = i THEN mod := S.VAL (X.Module, HI.mods.e [j].mod); IF ~first THEN String (", "); INC (cnt); IF (cnt MOD 8) = 0 THEN Ln; Tab END ELSE IF ~ffirst THEN Ln ELSE ffirst := FALSE END; TDefault; Int (cnt); StringInt (" module(s) in the ", i); StringLn (". hierarchy-level:"); TBold; Tab; first := FALSE; cnt := 1 END; IF HI.mods.e [j].unload THEN SetColor (darkblue); String (mod.name); SetColor (black) ELSIF HI.mods.e [j].isImported THEN SetColor (darkgreen); String (mod.name); SetColor (black) ELSIF HI.mods.e [j].cntIsImpDir = 0 THEN SetColor (red); String (mod.name); SetColor (black) ELSE String (mod.name) END; InsertFolds (txt, TRUE, FALSE, FALSE); SetColor (darkred); Tab; FOR k := 1 TO SHORT (X.GetNoOfImportsInMod (mod)) - 1 DO m := S.VAL (X.Module, HI.mods.e [HI.mods.FindMod (S.VAL (X.Module, X.GetImportInMod (mod, SHORT (k))))].mod); IF k # 1 THEN String (", ") END; IF (k MOD 9) = 1 THEN Ln; Tab; Tab END; String (m.name) END; SetColor (black); Ln; InsertFolds (txt, FALSE, FALSE, TRUE); notFound := FALSE END END; INC (i) 84' VAR txt: Texts.Text; i, j, k, cnt: LONGINT; mod, m: X.Module; ffirst, first, notFound: BOOLEAN; BEGIN i := 0; HI.CheckModUpdate (); OpenViewer ("ModuleHierarchy", txt, WithFolds); notFound := FALSE; ffirst := TRUE; WHILE ~notFound DO  END; TDefault; Append (txt) END ModuleHierarchy; <8 8 Syntax10.Scn.Fnt[8FoldElemsNewSyntax10.Scn.FntV8FoldElemsNew#Syntax10.Scn.Fntderived: Types.Type; show, hasFolds, found, firstAtLevel: BOOLEAN; iterator, i: INTEGER; nofMethods, ptrOff: LONGINT; htype: X.TypeS;8*8#Syntax10.Scn.Fnt VAR i: INTEGER; BEGIN IF folds THEN Tab; InsertFolds (txt, TRUE, FALSE, FALSE); Ln END; FOR i := 0 TO depth - 1 DO Tab END; TBold; StringInt ("Level of type-hierarchy: ", depth); TDefault; Ln END PrintLevel; 8M8CSyntax10.Scn.FntSyntax10i.Scn.Fnt found := TRUE; htype := S.VAL (X.TypeS, derived); IF firstAtLevel THEN hasFolds := ~first; PrintLevel (hasFolds); first := FALSE; firstAtLevel := FALSE END; FOR i := 0 TO depth DO Tab END; String (derived.module.name); Ch ('.'); String (derived.name); String (": "); SetColor (darkgreen); Int (htype.self.size); String (" bytes"); IF nofMethods > 0 THEN String (", "); SetColor (blue); Int (nofMethods); String (" methods") END; i := 0; REPEAT (* Count pointers in type *) INC (i, 4); S.GET (S.VAL (LONGINT, htype.self) + i, ptrOff) UNTIL ptrOff < 0; IF i > 4 THEN String (", "); SetColor (red); Int ((i - 4) DIV 4); String (" pointers") END; SetColor (black)Syntax10i.Scn.Fnt#88#Syntax10.Scn.Fnt'' InsertFolds (txt, FALSE, FALSE, TRUE)  8. VAR  PROCEDURE PrintLevel (folds: BOOLEAN);  BEGIN iterator := Descs.StartIterator; derived := HI.types.GetDerived (iterator, type); firstAtLevel := TRUE; hasFolds := FALSE; WHILE derived # NIL DO nofMethods := X.GetNoOfMethods (S.VAL (X.TypeS, derived)); show := ((nofMethods > 0) OR (mode # Classes)) & ((derived.name # "") OR (mode # Named)); IF show THEN  Print information about this type  END; found := HierarchyRecursive (derived, txt, depth + 1, (~show) OR first) OR found; IF show THEN Ln END; derived := HI.types.GetDerived (iterator, type) END; IF hasFolds THEN  Close folds  END; RETURN found END HierarchyRecursive; 8<s8#Syntax10.Scn.Fntkk In.Name (str); IF str = "Named" THEN mode := Named ELSIF str = "Classes" THEN mode := Classes END Syntax10i.Scn.Fnt 83< VAR txt: Texts.Text; str: ARRAY 16 OF CHAR; mode: INTEGER; PROCEDURE HierarchyRecursive (type: Types.Type; VAR txt: Texts.Text; depth: INTEGER; first: BOOLEAN): BOOLEAN;  BEGIN In.Open; mode := All; IF In.Next () = In.name THEN  Read mode  END; HI.CheckModUpdate (); OpenViewer ("TypeHierarchy", txt, WithFolds); IF ~HierarchyRecursive (NIL, txt, 0,TRUE) THEN CASE mode OF Classes: String ("No classes found.") | Named: String ("No named types found.") | All: String ("No types found.") END END; Append (txt) END TypeHierarchy; A8  8Syntax10.Scn.Fnt8FoldElemsNew8Syntax10b.Scn.FntF VAR r: Ref.Rider; fin: FinObj; type: Types.Type; p: TextFrames.Parc; copy: Texts.CopyMsg; txt:Texts.Text; tdesc: X.Tag; size: LONGINT; BEGIN Ref.OpenVars ("Kernel", r); WHILE (r.mode # Ref.End) & (r.name # "finObjs") DO r.Next () END; IF r.mode = Ref.End THEN Out.String ("Variable finObjs in module Kernel not found."); Out.Ln; RETURN END; OpenViewer ("Finalizers", txt, Simple); t.parcFin.handle (t.parcFin, copy); p := copy.e (TextFrames.Parc); Texts.WriteElem (t.w, p); TBold; String ("Object type"); Tab; String ("Address of obj. (rel.)"); Tab; String ("Finalizer procedure"); Tab; String ("Marked"); TDefault; Ln; Ln; r.ReadPtr (fin); WHILE fin # NIL DO CASE X.GetObjType (S.VAL (S.PTR, fin.obj), tdesc, size) OF X.TFree: String ("Free block ???") | X.TObj: type := Types.TypeOf (S.VAL (S.PTR, fin.obj)); String (type.module.name); Ch ('.'); String (type.name) | X.TArrP: type := Types.TypeOf (S.VAL (S.PTR, fin.obj)); String (type.module.name); Ch ('.'); String (type.name) | X.TSysBl: String ("Sysblock") | X.TTypDesc: String ("Typedescriptor") ELSE String ("Error") END; Tab; AInt (fin.obj); String (" ("); AInt (X.AddressAbsToRel (fin.obj)); Ch (')'); Tab; Ref.OpenProc (S.VAL (LONGINT, fin.fin), r); String (r.mod); Ch ('.'); String (r.name); Tab; IF fin.marked THEN StringLn ("TRUE") ELSE StringLn ("FALSE") END; fin := fin.next END; Append (txt) END Finalizers; F8  r8Syntax10.Scn.FntB8FoldElemsNew#Syntax10.Scn.Fntr: Ref.Rider; p: TextFrames.Parc; copy: Texts.CopyMsg; txt:Texts.Text; len: LONGINT; freeBlk: Inspector.TypeFreeBlk; first: BOOLEAN; i, cnt, col: INTEGER;8Syntax10b.Scn.FntSyntax10i.Scn.Fnt"8#Syntax10.Scn.Fnt IF first THEN first := FALSE ELSE String (',') END; IF cnt MOD col = 0 THEN Ln END; Tab; AInt (S.VAL (LONGINT, freeBlk)); IF len = i THEN Tab; Ch ('['); Int (freeBlk.size); Ch (']') END; freeBlk := S.VAL (Inspector.TypeFreeBlk, freeBlk.next); INC (cnt) 8q VAR  BEGIN Ref.OpenVars ("Kernel", r); WHILE (r.mode # Ref.End) & (r.name # "A") DO r.Next () END; IF r.mode = Ref.End THEN Out.String ("Variable A in module Kernel not found."); Out.Ln; RETURN END; OpenViewer ("Free blocks", txt, Simple); t.parcFree.handle (t.parcFree, copy); p := copy.e (TextFrames.Parc); Texts.WriteElem (t.w, p); r.Zoom (r); len := r.len - 1; r.Next (); (* Go to first element of array *) i := 1; WHILE r.mode # Ref.End DO TBold; IF i # len THEN String ("Size of free block: "); col := 6 ELSE String ("Free blocks with sizes greater or equal "); col := 3 END; Int (i * Descs.B); String (" bytes."); TDefault; Tab; IF i # len THEN String ("Address of free block"); ELSE String ("Address [Size]") END; S.GET (r.base + r.off, freeBlk); first := TRUE; cnt := 0; WHILE freeBlk # NIL DO  Print blocks of the same size  END; Ln; String ("Counted blocks: "); Int (cnt); Ln; r.Next (); INC (i) END; Append (txt) END FreeBlocks; F8 8Syntax10.Scn.Fnt$l8FoldElemsNew#Syntax10.Scn.Fntrrp, end: X.Blockm4Ptr; tdesc: X.Tag; size, cnt: LONGINT; type: X.TypeS; kind, iterator: INTEGER; txt: Texts.Text;8{8DSyntax10.Scn.Fnt.8FoldElemsNew#Syntax10.Scn.FntIF kind # X.TTypDesc THEN type := S.VAL (X.TypeS, X.TypeOf (S.VAL (S.PTR, S.VAL (LONGINT, p) + 4))) ELSE type := S.VAL (X.TypeS, S.VAL (LONGINT, p) + 4) END; IF HI.mods.FindMod (S.VAL (X.Module, type.mdesc)) = HI.NotFound THEN INC (cnt); IF cnt <= MaxPrintModless THEN Int (cnt); String (". "); CASE kind OF X.TObj: String ("Object ") | X.TTypDesc: String ("Typedescriptor ") | X.TArrP: String ("Array with pointer ") ELSE HALT (99) END; String (type.name); String (" at "); AInt (S.VAL (LONGINT, p) + 4); String (" ("); AInt (X.AddressAbsToRel (S.VAL (LONGINT, p))); Ch (')'); Ln END ENDSyntax10i.Scn.Fnt&8B kind := X.GetObjType (S.VAL (S.PTR, S.VAL (LONGINT, p) + 4), tdesc, size); IF (kind = X.TObj) OR (kind = X.TTypDesc) OR (kind = X.TArrP) THEN  Object has a "normal" typedescriptor  END; INC (S.VAL(LONGINT, p), S.VAL (LONGINT, S.VAL (SET, size + HI.BlockSize-1) - S.VAL (SET, HI.BlockSize-1))) Syntax10i.Scn.Fnt)8*C8#Syntax10.Scn.Fnt StringLn ("..."); String ("Number of moduleless objects: "); Int (cnt); StringLn (" .") ELSIF cnt = 0 THEN StringLn ("No moduleless objects found.") 78+ CONST MaxPrintModless = 500; VAR  BEGIN cnt := 0; iterator := 0; OpenViewer ("Moduleless objects", txt, Simple); StringLn ("Printing objects which have no module:"); WHILE X.GetNextMemBlock (p, end, iterator (* = Number of heap *) ) DO WHILE p # end DO  Search moduleless objects an print them  END END; IF cnt > MaxPrintModless THEN  If too much moduleless objects -> print only ... objs  END; Append (txt) END ModuleLessObjects; :8 +8Syntax10.Scn.Fnta8FoldElemsNew#Syntax10.Scn.Fnt}}firstT, task, curT: Oberon.Task; txt: Texts.Text; r: Ref.Rider; currTime: LONGINT; copy: Texts.CopyMsg; p: TextFrames.Parc;8-{8#Syntax10.Scn.Fntcc VAR r: Ref.Rider; proc: Ref.ProcVar; b: BOOLEAN; l: LONGINT; BEGIN Ref.OpenPtr (task, r); WHILE (r.mode # Ref.End) & (r.name # "handle") DO r.Next () END; IF r.mode = Ref.End THEN String ("???") ELSE r.ReadProc (proc); Ref.OpenProc (S.VAL (LONGINT, proc), r); String (r.mod); Ch ('.'); String (r.name) END; Tab; Ref.OpenPtr (task, r); WHILE (r.mode # Ref.End) & (r.name # "safe") DO r.Next () END; IF r.mode = Ref.End THEN String ("???") ELSE r.ReadBool (b); IF b THEN String ("TRUE") ELSE String ("FALSE") END END; Tab; Ref.OpenPtr (task, r); WHILE (r.mode # Ref.End) & (r.name # "removed") DO r.Next () END; IF r.mode = Ref.End THEN String ("???") ELSE r.ReadBool (b); IF b THEN String ("TRUE") ELSE String ("FALSE") END END; Tab; Ref.OpenPtr (task, r); WHILE (r.mode # Ref.End) & (r.name # "time") DO r.Next () END; IF r.mode = Ref.End THEN String ("???") ELSE r.ReadLInt (l); Int (l); Tab; Int (l - currTime) END; Ln; Ref.OpenPtr (task, r); WHILE (r.mode # Ref.End) & (r.name # "next") DO r.Next () END; IF r.mode = Ref.End THEN task := NIL ELSE r.ReadPtr (task) END END ShowPtr; 82Syntax10b.Scn.Fnt VAR  PROCEDURE ShowPtr (VAR task: Oberon.Task);  BEGIN currTime := Oberon.Time (); OpenViewer ("Installed Tasks", txt, Simple); t.parcTask.handle (t.parcTask, copy); p := copy.e (TextFrames.Parc); Texts.WriteElem (t.w, p); TBold; String ("Handler"); Tab; String ("Safe"); Tab; String ("Removed"); Tab; String ("Wakeup time"); Tab; String ("Relative time to ("); Int (currTime); Ch (')'); Ln; Ln; TDefault; Ref.OpenVars ("Oberon", r); WHILE (r.mode # Ref.End) & (r.name # "FirstTask") DO r.Next () END; IF r.mode = Ref.End THEN Out.String ("Variable FirstTask in module Oberon not found."); Out.Ln; RETURN END; r.ReadPtr (firstT); task := firstT; Ref.OpenVars ("Oberon", r); WHILE (r.mode # Ref.End) & (r.name # "CurTask") DO r.Next () END; IF r.mode = Ref.End THEN Out.String ("Variable CurTask in module Oberon not found."); Out.Ln; RETURN END; r.ReadPtr (curT); REPEAT IF task = curT THEN TBold END; ShowPtr (task); TDefault UNTIL (task = NIL) OR (task = firstT); Append (txt) END Tasks; ;8 C8ASyntax10.Scn.FntB8FoldElemsNew#Syntax10.Scn.Fnt Line = POINTER TO LineDesc; LineDesc = RECORD name: ARRAY 64 OF CHAR; int: ARRAY 5 OF LONGINT; int2: ARRAY 4 OF INTEGER; next: Line END; 88#Syntax10.Scn.Fntstr: ARRAY 32 OF CHAR; v: Viewers.Viewer; txt: Texts.Text; s: Texts.Scanner; line, first, last, nil: Line; i: INTEGER; pos, end, lineNr: LONGINT; nofCols: INTEGER; parc: TextFrames.Parc; isNumeric, isModules: BOOLEAN; keyIdx: INTEGER; 8(8#Syntax10.Scn.Fnt@@ VAR c: Line; BEGIN c := nil; REPEAT IF (isNumeric & (a.int [keyIdx] > b.int [keyIdx])) OR (~isNumeric & (a.name < b.name)) THEN c.next := a; c := a; a := a.next ELSE c.next := b; c := b; b := b.next END UNTIL c.int [0] = MIN (LONGINT); c := nil.next; nil.next := nil; RETURN c END Merge; Syntax10i.Scn.Fnt 8"8#Syntax10.Scn.Fnt VAR a, b: Line; BEGIN IF c.next = nil THEN RETURN c END ; a := c; b := c.next.next; WHILE b # nil DO c := c.next; b := b.next.next END ; b := c.next; c.next := nil; RETURN Merge(Sort(a), Sort(b)) END Sort;  8Syntax10b.Scn.Fnth TYPE  VAR  PROCEDURE Merge (a, b: Line): Line;  Mergesort  PROCEDURE Sort (c: Line): Line;  Mergesort  BEGIN In.Open; In.Name (str); v := Oberon.Par.vwr; IF (Oberon.Par.frame IS TextFrames.Frame) & (Oberon.Par.frame = v.dsc) THEN IF (v.dsc # NIL) & (v.dsc.next IS TextFrames.Frame) THEN txt := Oberon.Par.vwr.dsc.next (TextFrames.Frame).text; TextFrames.ParcBefore (txt, 1, parc, pos); isModules := parc.nofTabs = 7; IF ~isModules THEN nofCols := parc.nofTabs ELSE nofCols := 5 END; isNumeric := str # "name"; IF isNumeric THEN IF str = "number" THEN keyIdx := 0 ELSE keyIdx := 1 END ; IF nofCols = 5 THEN INC (keyIdx, 3) END END ; Texts.OpenScanner (s, txt, 0); Texts.Scan (s); REPEAT pos := Texts.Pos (s); Texts.Scan (s) UNTIL s.line > 1; IF s.class = Texts.Int THEN RETURN END; IF ~isModules THEN INC (pos) END; NEW (first); last := first; NEW (nil); nil.next := nil; nil.int[0] := MIN (LONGINT); nil.int[1] := MIN (LONGINT); nil.int[2] := MIN (LONGINT); nil.int[3] := MIN (LONGINT); nil.int[4] := MIN (LONGINT); nil.int2[0] := MIN (INTEGER); nil.int2[1] := MIN (INTEGER); nil.int2[2] := MIN (INTEGER); nil.int2[3] := MIN (INTEGER); COPY ("", nil.name); lineNr := s.line; REPEAT ASSERT (s.class IN {Texts.String, Texts.Name}); IF s.line <= lineNr + 1 THEN NEW (line); last.next := line; last := line; COPY (s.s, line.name); FOR i := 0 TO nofCols - 1 DO lineNr := s.line; Texts.Scan (s); ASSERT (s.class = Texts.Int); line.int [i] := s.i END; IF isModules THEN FOR i := 0 TO 2 BY 2 DO Texts.Scan (s); ASSERT (s.class = Texts.Int); line.int2 [i] := SHORT (s.i); Texts.Scan (s); Texts.Scan (s); ASSERT (s.class = Texts.Int); line.int2 [i + 1] := SHORT (s.i) END END; end := Texts.Pos (s); Texts.Scan (s) END UNTIL s.eot OR (s.line > lineNr + 1); last.next := nil; last := nil; Texts.Delete (txt, pos, end); line := Sort (first.next); WHILE line # nil DO String (line.name); Tab; FOR i := 0 TO nofCols - 1 DO Int (line.int [i]); IF (i < nofCols - 1) OR isModules THEN Tab END END; IF isModules THEN Int (line.int2 [0]); StringInt (" / ", line.int2 [1]); Tab; Int (line.int2 [2]); StringInt (" / ", line.int2 [3]) END; Ln; line := line.next END ; Texts.Insert (txt, pos, t.w.buf) END END END Sort; B8  8#Syntax10.Scn.Fnt VAR hString: ARRAY 40 OF CHAR; BEGIN In.Open; In.Name (hString); IF hString = "Documentation" THEN LinkElems.FollowLink ("HeapInspector.Text", 1, NIL, NIL) ELSIF hString = "DocuOfCode" THEN LinkElems.FollowLink ("HeapInspector.Text", 30, NIL, NIL) ELSIF hString = "Mouse" THEN LinkElems.FollowLink ("HeapInspector.Text", 310, NIL, NIL) ELSIF hString = "Keyboard" THEN LinkElems.FollowLink ("HeapInspector.Text", 320, NIL, NIL) ELSIF hString = "Authors" THEN LinkElems.FollowLink ("HeapInspector.Text", 50, NIL, NIL) ELSIF hString = "Code" THEN LinkElems.FollowLink ("HeapInspector.Mod", 1, NIL, NIL) ELSIF hString = "Menu" THEN In.Name (hString); IF hString = "" THEN LinkElems.FollowLink ("HeapInspector.Text", 2, NIL, NIL) ELSIF hString = "Close" THEN LinkElems.FollowLink ("HeapInspector.Text", 110, NIL, NIL) ELSIF hString = "HeapInspector" THEN LinkElems.FollowLink ("HeapInspector.Text", 120, NIL, NIL) ELSIF hString = "GC" THEN LinkElems.FollowLink ("HeapInspector.Text", 130, NIL, NIL) ELSIF hString = "Info" THEN LinkElems.FollowLink ("HeapInspector.Text", 140, NIL, NIL) ELSIF hString = "Map" THEN LinkElems.FollowLink ("HeapInspector.Text", 150, NIL, NIL) ELSIF hString = "Show" THEN LinkElems.FollowLink ("HeapInspector.Text", 160, NIL, NIL) ELSIF hString = "Modules" THEN LinkElems.FollowLink ("HeapInspector.Text", 170, NIL, NIL) ELSIF hString = "Store" THEN LinkElems.FollowLink ("HeapInspector.Text", 180, NIL, NIL) ELSIF hString = "Help" THEN LinkElems.FollowLink ("HeapInspector.Text", 190, NIL, NIL) ELSIF hString = "Commands" THEN LinkElems.FollowLink ("HeapInspector.Text", 1010, NIL, NIL) END; ELSIF hString = "Examples" THEN LinkElems.FollowLink ("HeapInspector.Text", 1020, NIL, NIL) END END Help; 18!8[ Syntax10.Scn.FntW8FoldElemsNewSyntax10.Scn.Fnt18FoldElemsNew#Syntax10.Scn.FntTextFrames.defParc.handle (TextFrames.defParc, copy); t.parc2 := copy.e (TextFrames.Parc); t.parc2.nofTabs := 2; t.parc2.tab [0] := 1944000; t.parc2.tab [1] := 3204000; TextFrames.defParc.handle(TextFrames.defParc, copy); t.parc5 := copy.e (TextFrames.Parc);Syntax10i.Scn.Fnt88#Syntax10.Scn.Fntt.parc5.nofTabs := 7; t.parc5.tab [0] := 1530000; t.parc5.tab [1] := 2070000; t.parc5.tab [2] := 2680000; t.parc5.tab [3] := 3180000; t.parc5.tab [4] := 3680000; t.parc5.tab [5] := 4460000; t.parc5.tab [6] := 5300000;88#Syntax10.Scn.Fnt$$TextFrames.defParc.handle (TextFrames.defParc, copy); t.parc52 := copy.e (TextFrames.Parc); t.parc52.nofTabs := 5; t.parc52.tab [0] := 2400000; t.parc52.tab [1] := 2800000; t.parc52.tab [2] := 3400000; t.parc52.tab [3] := 4100000; t.parc52.tab [4] := 4800000; t.parc52.width := 6100000; 8 8#Syntax10.Scn.FntTextFrames.defParc.handle (TextFrames.defParc, copy); t.parcFin := copy.e (TextFrames.Parc); t.parcFin.nofTabs := 3; t.parcFin.tab [0] := 1850000; t.parcFin.tab [1] := 3450000; t.parcFin.tab [2] := 5200000;88#Syntax10.Scn.FntTextFrames.defParc.handle (TextFrames.defParc, copy); t.parcFree := copy.e (TextFrames.Parc); t.parcFree.nofTabs := 6; t.parcFree.tab [0] := 130000; FOR i := 1 TO 6 DO t.parcFree.tab [i] := 130000 + i * 820000 END88#Syntax10.Scn.Fnt$$TextFrames.defParc.handle (TextFrames.defParc, copy); t.parcTask := copy.e (TextFrames.Parc); t.parcTask.nofTabs := 4; t.parcTask.tab [0] := 2200000; FOR i := 1 TO 2 DO t.parcTask.tab [i] := 2200000 + i * 600000 END; FOR i := 1 TO 2 DO t.parcTask.tab [i + 2] := 3400000 + i * 900000 END 8 VAR copy: Texts.CopyMsg; i: INTEGER; BEGIN  Parc 2   Parc 5   Parc 52   Parc Finalize objects   Parc Free blocks ;  Parc Tasks  END SetParcs; 88#Syntax10.Scn.Fnt BEGIN String ("HeapInspViewers.Sort name"); t.cmdSortName := CreatePopup ("Sort name"); String ("HeapInspViewers.Sort number"); t.cmdSortNumber := CreatePopup ("Sort number"); String ("HeapInspViewers.Sort size"); t.cmdSortSize := CreatePopup ("Sort size"); String ("FoldElems.Expand"); t.cmdExpFolds := CreatePopup ("Expand Folds"); String ("FoldElems.Collapse"); t.cmdCollFolds := CreatePopup ("Collapse Folds"); String ("FoldElems.Search"); t.cmdSearch := CreatePopup ("Search (in Folds)") END SetMenuPopups; 8J PROCEDURE SetParcs ();  PROCEDURE SetMenuPopups ();  BEGIN Texts.OpenWriter (t.w); SetParcs (); SetMenuPopups () END Init; 8!MODULE HeapInspViewers; (* HeapInspViewers by MR 17 Dec 96 -   *) IMPORT S := SYSTEM, Kernel, Oberon, Texts, TextFrames, PopupElems, MenuViewers, Fonts, FoldElems, LinkElems, Types, Viewers, In, Out, Strings, Ref, X := Platform, HI := HeapInspector, Descs := HeapInspDescs, Inspector; CONST  TYPE  VAR  PROCEDURE String (s: ARRAY OF CHAR);  PROCEDURE Tab;  PROCEDURE Ln;  PROCEDURE Int (l: LONGINT);  PROCEDURE AInt (l: LONGINT);  PROCEDURE StringInt (s: ARRAY OF CHAR; l: LONGINT);  PROCEDURE StringLn (s: ARRAY OF CHAR);  PROCEDURE Ch (ch: CHAR);  PROCEDURE TDefault;  PROCEDURE TBold;  PROCEDURE Append (txt: Texts.Text);  PROCEDURE SetColor (c: SHORTINT);  PROCEDURE InsertFolds (txt: Texts.Text; left, collapsed, switch: BOOLEAN);  PROCEDURE CreatePopup (name: ARRAY OF CHAR): PopupElems.Elem;  PROCEDURE InsertPopup (cmds: PopupElems.Elem; menu: TextFrames.Frame);  PROCEDURE OpenViewer (title: ARRAY OF CHAR; VAR txt: Texts.Text; menu: INTEGER);  PROCEDURE Modules*;  Opens a viewer with information about the loaded modules  PROCEDURE ObjectsByModule*;  Opens a viewer with information about objects and modules  PROCEDURE ObjectsByType*;  Opens a viewer with information about the loaded objects, types  PROCEDURE ModuleReachableTypes*;  Opens a viewer with info about module-reachable objects  PROCEDURE Imports*;  Opens a viewer with information about the imports of loaded modules  PROCEDURE ModuleHierarchy*;  Opens a viewer with information about the import-hierarchy  PROCEDURE TypeHierarchy*;  Opens a viewer with information about the type(class)-hierarchy  PROCEDURE Finalizers*;  Opens a viewer with information about the actual finalizer(-objects)  PROCEDURE FreeBlocks*;  Opens a viewer with information about the actual finalizer(-objects)  PROCEDURE ModuleLessObjects*;  Opens a viewer with information about moduleless objects  PROCEDURE Tasks*;  Opens a viewer with information about the installed tasks  PROCEDURE Sort*;  Sort names or sizes (Modules, ObjectsByModule and ObjectsByType)  PROCEDURE Help*;  Help by ... (File HeapInspector.Text is needed)  PROCEDURE Init;  BEGIN Init END HeapInspViewers.