C\Syntax10.Scn.FntSyntax10i.Scn.FntMarkElemsAlloc IStampElemsAlloc1 May 97qInfoElemsAllocUSyntax10.Scn.FntIStampElemsAlloc1 May 97"Title": HeapInspDescs "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":;8FoldElemsNewqSyntax10.Scn.FntPSyntax10b.Scn.FntSyntax10i.Scn.Fnt,@ (* arrayBit = X.arrayBit;*) markBit = X.markBit; NotFound = -1; Error = -1; StartIterator* = 0; (* Starts iterator in types.GetDerived () *) Unknown = -1; B* = X.B; (* other = X.TObj; array = X.TArrP; *) free = X.TFree; 8>8Syntax10.Scn.FntIq8FoldElemsNewQSyntax10.Scn.FntSyntax10b.Scn.Fnt ? nofObjs-, specNofObjs-: LONGINT; type-: Types.Type; END; 89Syntax10b.Scn.Fnt  }8QSyntax10.Scn.FntSyntax10b.Scn.Fnt3 elems-: TypeElemArray; count-: LONGINT; END; 88'Syntax10.Scn.FntSyntax10b.Scn.Fnt Syntax10i.Scn.Fnt             mod-: LONGINT; (* "Pointer to" Kernel.Module *) objTypes-, objs-, objMem-, typePos-: LONGINT; cntImpDir-, cntImpIndir-, cntIsImpDir-, cntIsImpIndir-, refCnt, hierarchy-: INTEGER; specUnload-, unload-, imports, isImported-, mark, unloadParents-, unloadP-: BOOLEAN; END; 83 _8_Syntax10.Scn.FntSyntax10b.Scn.FntC e-: ModElemArray; sort-: IntegerArray; cnt-: LONGINT; END; 8 8CSyntax10.Scn.FntSyntax10b.Scn.Fnt) nOfObjs*, mem*, frag*: LONGINT; END; 8!2 IntegerArray = POINTER TO ARRAY OF INTEGER; TypeInfoElemDesc = RECORD  TypeElemArray = POINTER TO ARRAY OF TypeInfoElemDesc; TypeInfoDesc* = RECORD  ModDescElem = RECORD  ModElemArray = POINTER TO ARRAY OF ModDescElem; ModDesc* = RECORD  Count* = RECORD  Map = POINTER TO ARRAY OF SET; 88Syntax10.Scn.FntSyntax10i.Scn.FntfMarkElemsAllockKSyntax10b.Scn.Fnt- (* Forward declarations *) PROCEDURE ^(VAR types: TypeInfoDesc) Init (nrOfTypes: LONGINT); PROCEDURE ^(VAR types: TypeInfoDesc) Update* (type: Types.Type; mods: ModDesc): LONGINT; 8C Syntax10b.Scn.Fnt 8_Syntax10.Scn.FntvSyntax10i.Scn.Fnt"?"v VAR m: X.Module; i: INTEGER; ptr: Kernel.Block; BEGIN m := X.GetModules (); WHILE m # NIL DO X.SetModMarks (m); (* Only necessary for MacOberon *) FOR i := 0 TO X.GetNoOfPtrsInMod (m) - 1 DO S.GET (X.GetPtrInMod (m, i), ptr); IF S.VAL (LONGINT, ptr) > 0 THEN Kernel.Mark (ptr) (* ptr # NIL *) END; END; (*FOR i := 0 TO X.GetNoOfTDsInMod (m) - 1 DO (* Doesn't work for PowerMac !! *) ptr := S.VAL (Kernel.Block, X.GetTDInMod (m, i)); Kernel.Mark (ptr) END; *) m := m.next END END MarkObjects; 8 $8_Syntax10.Scn.FntSyntax10i.Scn.Fnt"B" VAR m: X.Module; i: INTEGER; ptr: Kernel.Block; found: BOOLEAN; BEGIN m := X.GetModules (); found := FALSE; WHILE (m # NIL) & ~found DO IF m.name = modName THEN found := TRUE; X.SetModMarks (m); (* Only necessary for MacOberon *) FOR i := 0 TO X.GetNoOfPtrsInMod (m) - 1 DO S.GET (X.GetPtrInMod (m, i), ptr); IF S.VAL (LONGINT, ptr) > 0 THEN Kernel.Mark (ptr) (* ptr # NIL *) END END; (* FOR i := 0 TO X.GetNoOfTDsInMod (m) - 1 DO (* Doesn't work for PowerMac !! *) ptr := S.VAL (Kernel.Block, X.GetTDInMod (m, i)); Kernel.Mark (ptr) END *) END; m := m^.next END; RETURN found END MarkModObjects; 8: e 58#Syntax10.Scn.Fnt VAR p, end: X.Blockm4Ptr; tdesc: X.Tag; size: LONGINT; kind, iterator: INTEGER; BEGIN iterator := 0; WHILE X.GetNextMemBlock (p, end, iterator) DO WHILE p # end DO p.tag := S.VAL (X.Tag, S.VAL (SET, p.tag) - {markBit}); kind := X.GetObjType (S.VAL (S.PTR, S.VAL (LONGINT, p) + 4), tdesc, size); INC (S.VAL (LONGINT, p), S.VAL (LONGINT, S.VAL (SET, size + B-1) - S.VAL (SET, B-1))) END END END UnmarkAll; 68 e8#Syntax10.Scn.Fnt VAR p, end: X.Blockm4Ptr; tdesc: X.Tag; size: LONGINT; kind, iterator: INTEGER; BEGIN iterator := 0; WHILE X.GetNextMemBlock (p, end, iterator) DO WHILE p # end DO kind := X.GetObjType (S.VAL (S.PTR, S.VAL (LONGINT, p) + 4), tdesc, size); IF kind # free THEN p.tag := S.VAL (X.Tag, S.VAL (SET, p.tag) + {markBit}) END; INC (S.VAL(LONGINT, p), S.VAL (LONGINT, S.VAL (SET, size + B-1)-S.VAL (SET, B-1))) END END END MarkAll; 48R>;8#Syntax10.Scn.Fnt(( BEGIN m.cnt := 0; m.e := NIL END Init;  8>; n8#Syntax10.Scn.Fntpp VAR i: LONGINT; BEGIN FOR i := 0 TO m.cnt - 1 DO m.e [i].objs := 0; m.e [i].objMem := 0 END END CntReset; '8U L8_Syntax10.Scn.Fnt4Syntax10b.Scn.Fnt    VAR mod: X.Module; BEGIN IF mIdx = NotFound THEN RETURN FALSE END; mod := S.VAL (X.Module, m.e [mIdx].mod); IF mod.name = type.module.name THEN INC (m.e [mIdx].objs); INC (m.e [mIdx].objMem, size); RETURN TRUE ELSE RETURN FALSE END END UpdateElem; &8e8#Syntax10.Scn.Fnt VAR i, last: LONGINT; mod: X.Module; BEGIN i := 0; WHILE (i < m.cnt) & m.e [i].unload DO INC (i) END; IF i < m.cnt THEN X.SetModules (S.VAL (X.Module, m.e [i].mod)) ELSE X.SetModules (NIL) END; WHILE i < m.cnt DO WHILE (i < m.cnt) & (~m.e [i].unload) DO last := i; INC (i) END; WHILE (i < m.cnt) & m.e [i].unload DO INC (i) END; IF i < m.cnt THEN mod := S.VAL (X.Module, m.e [last].mod); mod.next := S.VAL (X.Module, m.e [i].mod) ELSE mod := S.VAL (X.Module, m.e [last].mod); mod.next := NIL END END END Unchain; 288#Syntax10.Scn.Fnt;; VAR i: LONGINT; mod: X.Module; BEGIN IF m.cnt >= 1 THEN X.SetModules (S.VAL (X.Module, m.e [0].mod)) END; i := 1; WHILE i < m.cnt DO mod := S.VAL (X.Module, m.e [i - 1].mod); mod.next := S.VAL (X.Module, m.e [i].mod); INC (i) END; mod := S.VAL (X.Module, m.e [i - 1].mod); mod.next := NIL END Chain; 18\$8CSyntax10.Scn.FntSyntax10b.Scn.Fnt* VAR pos, lastPos, min, max: LONGINT; mod: X.Module; mh: ModElemArray; sh: IntegerArray; BEGIN pos := m.cnt DIV 2; lastPos := 0; min := 0; max := m.cnt; mh := m.e; sh := m.sort; WHILE lastPos # pos DO mod := S.VAL (X.Module, mh [sh [pos]].mod); IF mod.name < modName THEN lastPos := pos; min := pos; pos := (max + min) DIV 2 ELSIF mod.name > modName THEN lastPos := pos; max := pos; pos := (max + min) DIV 2 ELSE lastPos := pos END END; IF mod.name # modName THEN RETURN NotFound ELSE RETURN m.sort [pos] END END Find; 8ݪmX8QSyntax10.Scn.FntSyntax10b.Scn.Fnt$X BEGIN IF mod = NIL THEN RETURN NotFound ELSE RETURN m.Find (mod.name) END END FindMod; 8Ȅ 8cSyntax10.Scn.FntSyntax10i.Scn.Fnt).Syntax10b.Scn.Fnt (* Returns the number of marks or Error *) VAR i, n: INTEGER; BEGIN IF m.e = NIL THEN RETURN Error END; n := 0; FOR i := 0 TO SHORT (m.cnt) - 1 DO IF m.e [i].mark THEN INC (n); m.e [i].mark := FALSE END END; RETURN n END ClearMarks; 8߄ 8cSyntax10.Scn.FntSyntax10i.Scn.Fnt(.Syntax10b.Scn.Fnt q (* Returns number of unloads or Error *) VAR i, n: LONGINT; BEGIN IF m.e = NIL THEN RETURN Error END; n := 0; FOR i := 0 TO m.cnt - 1 DO IF m.e [i].unload THEN INC (n) END END; RETURN n END CountUnload; 8߄ =q8#Syntax10.Scn.Fntmm BEGIN m.e [n].unload := TRUE; m.e [n].specUnload := TRUE; m.e [n].unloadParents := parents END SetUnload; !8߄ 8#Syntax10.Scn.Fnt VAR i: INTEGER; BEGIN FOR i := 0 TO SHORT (m.cnt) - 1 DO m.e [i].unload := FALSE; m.e [i].unloadParents := FALSE; m.e [i].unloadP := FALSE; m.e [i].specUnload := FALSE; m.e [i].imports := FALSE; m.e [i].isImported := FALSE END END ResetUnload; &8t8Syntax10.Scn.Fnt`>8FoldElemsNew#Syntax10.Scn.Fnt VAR m2: LONGINT; j: INTEGER; mod2: X.Module; BEGIN IF m.e [mParent].refCnt = 0 THEN m.e [mParent].unloadP := TRUE; FOR j := 0 TO X.GetNoOfImportsInMod (mod) - 1 DO mod2 := S.VAL (X.Module, X.GetImportInMod (mod, j)); IF mod # mod2 THEN m2 := m.Find (mod2.name); ASSERT (m2 # NotFound); DEC (m.e [m2].refCnt); RecursiveFree (mod2, m2) END END END END RecursiveFree; Syntax10i.Scn.Fnt8-i8#Syntax10.Scn.Fntuu VAR mNr: LONGINT; j: INTEGER; mod2: X.Module; BEGIN FOR j := 0 TO X.GetNoOfImportsInMod (mod) - 1 DO mod2 := S.VAL (X.Module, X.GetImportInMod (mod, j)); IF mod2 # mod THEN mNr := m.Find (mod2.name); ASSERT (mNr # NotFound); IF ~m.e [mNr].mark THEN m.e [mNr].mark := TRUE; RecursiveUpdate (mod2) END END END END RecursiveUpdate; 8t8#Syntax10.Scn.Fntjj BEGIN FOR i := 0 TO m.cnt - 1 DO m.e [i].cntIsImpIndir := 0; m.e [i].mark := FALSE END END ClearImp; 8 VAR i, k: LONGINT; mod: X.Module; PROCEDURE RecursiveFree (mod: X.Module; mParent: LONGINT);  Virtual freeing of modules  PROCEDURE RecursiveUpdate (mod: X.Module);  Update imports, ...  PROCEDURE ClearImp ();  Clear imports  BEGIN ClearImp (); FOR i := 0 TO m.cnt - 1 DO mod := S.VAL (X.Module, m.e [i].mod); RecursiveUpdate (mod); m.e [i].mark := FALSE; IF m.e [i].unloadParents THEN RecursiveFree (mod, i) END; k := 0; WHILE (k < m.cnt) & (~(m.e [k].mark & m.e [k].unload)) DO INC (k) END; m.e [i].imports := k < m.cnt; FOR k := 0 TO m.cnt - 1 DO IF m.e [k].mark THEN INC (m.e [k].cntIsImpIndir); IF m.e [i].unload THEN m.e [k].isImported := TRUE END END END; m.e [i].cntImpIndir := m.ClearMarks (); m.e [i].cntImpDir := X.GetNoOfImportsInMod (mod) - 1; m.e [i].cntIsImpDir := SHORT (mod.refcnt) END; FOR i := 0 TO m.cnt - 1 DO IF m.e [i].imports THEN m.e [i].unload := TRUE END END END UpdateImports; $8* 8#Syntax10.Scn.Fnt VAR i: LONGINT; mod: X.Module; BEGIN i := 0; nrOfTypes := 0; mod := X.GetModules (); WHILE mod # NIL DO INC (i); INC (nrOfTypes, LONG (X.GetNoOfTDsInMod (mod))); mod := mod.next END; RETURN i END Count; 8`  %8oSyntax10.Scn.Fntl8FoldElemsNewSyntax10.Scn.FntF8FoldElemsNew<Syntax10.Scn.FntUSyntax10i.Scn.Fnt*step, j1, j2, p1, p2, resPos: INTEGER; m1, m2: X.Module; hSort, hs: IntegerArray; (* name: ARRAY 32 OF CHAR; err: BOOLEAN;*)8Syntax10i.Scn.FntS8$Syntax10i.Scn.Fnt name := ""; err := FALSE; FOR j1 := 0 TO SHORT (m.cnt - 1) DO m1 := S.VAL (Kernel.Module, m.e [m.sort [j1]].mod); err := err OR (m1.name <= name); COPY (m1.name, name) END; IF err THEN FOR j1 := 0 TO SHORT (m.cnt - 1) DO m1 := S.VAL (Kernel.Module, m.e [m.sort [j1]].mod); Out.Int (j1, 0); Out.Char (' '); Out.String (m1.name); Out.Ln END; ASSERT (~err) END 8 VAR  BEGIN NEW (hSort, m.cnt); FOR j1 := 0 TO SHORT (m.cnt) - 1 DO m.sort [j1] := j1 END; step := 1; WHILE step < m.cnt DO resPos := 0; step := step * 2; p1 := step DIV 2 - 1; p2 := step - 1; j1 := 0; j2 := p1 + 1; WHILE p1 < m.cnt DO IF p2 >= m.cnt THEN p2 := SHORT (m.cnt) - 1 END; WHILE (j1 <= p1) OR (j2 <= p2) DO IF j1 > p1 THEN hSort [resPos] := m.sort [j2]; INC (j2) ELSIF j2 > p2 THEN hSort [resPos] := m.sort [j1]; INC (j1) ELSE m1 := S.VAL (X.Module, m.e [m.sort [j1]].mod); m2 := S.VAL (X.Module, m.e [m.sort [j2]].mod); IF m1.name > m2.name THEN hSort [resPos] := m.sort [j2]; INC (j2) ELSE hSort [resPos] := m.sort [j1]; INC (j1) END END; INC (resPos) END; INC (j1, step DIV 2); INC (j2, step DIV 2); INC (p1, step); INC (p2, step) END; WHILE resPos < m.cnt DO hSort [resPos] := m.sort [resPos]; INC (resPos) END; hs := m.sort; m.sort := hSort; hSort := hs END; (* Sort-check *) END SortIndex; 8;8.Syntax10.Scn.FntrD8FoldElemsNew#Syntax10.Scn.Fnt mod := S.VAL (X.Module, m.e [i].mod); IF X.GetNoOfImportsInMod (mod) <= 1 THEN m.e [i].hierarchy := 0 ELSE m.e [i].hierarchy := Unknown END Syntax10i.Scn.Fnt+8 VAR i, j, k: INTEGER; allSet: BOOLEAN; mod: X.Module; mp: LONGINT; BEGIN FOR i := 0 TO SHORT (m.cnt) - 1 DO  Initialize modules with empty import-list  END; i := SHORT (m.cnt - 1); allSet := FALSE; WHILE i >= 0 DO WHILE (i >= 0) & (m.e [i].hierarchy # Unknown) DO DEC (i) END; k := i; WHILE k >= 0 DO IF m.e [k].hierarchy = Unknown THEN mod := S.VAL (X.Module, m.e [k].mod); allSet := TRUE; m.e [k].hierarchy := -1; FOR j := 1 TO X.GetNoOfImportsInMod (mod) - 1 DO mp := m.FindMod (S.VAL (X.Module, X.GetImportInMod (mod, j))); ASSERT (mp # NotFound); IF m.e [mp].hierarchy # Unknown THEN IF m.e [mp].hierarchy >= m.e [k].hierarchy THEN m.e [k].hierarchy := m.e [mp].hierarchy + 1 END ELSE allSet := FALSE END END; IF ~allSet THEN m.e [k].hierarchy := Unknown END END; DEC (k) END END END CalcHierarchy; 8^Syntax10i.Scn.Fnt%H*^a8#Syntax10.Scn.Fnt}} mods.e [i].objs := 0; mods.e [i].objMem := 0; mods.e [i].imports := FALSE; mods.e [i].isImported := FALSE; mods.e [i].mark := FALSE; mods.e [i].unload := FALSE; mods.e [i].specUnload := FALSE; mods.e [i].unloadParents := FALSE; mods.e [i].cntIsImpDir := 0; mods.e [i].cntIsImpIndir := 0; mods.e [i].hierarchy := 0; mods.e [i].cntImpDir := 0; mods.e [i].cntImpIndir := 0;8q VAR i, nrOfTypes, k, tadr: LONGINT; j: INTEGER; mod: X.Module; changed: BOOLEAN; PROCEDURE SortIndex ();  PROCEDURE CalcHierarchy ();  BEGIN i := m.Count (nrOfTypes); changed := (m.e = NIL) OR (i # m.cnt) OR (i # LEN (m.e^)); (* Registered modules have changed *) IF changed THEN m.cnt := i; NEW (m.e, m.cnt); NEW (m.sort, m.cnt) (* For sorting modules -> Binary search *) END; types.Init (nrOfTypes); mod := X.GetModules (); k := 0; FOR i := 0 TO m.cnt - 1 DO (* Register loaded modules *) m.e [i].mod := S.VAL (LONGINT, mod); m.e [i].typePos := k; m.e [i].objTypes := X.GetNoOfTDsInMod (mod); FOR j := 0 TO X.GetNoOfTDsInMod (mod) - 1 DO (* Register typedescriptors *) tadr := X.GetTDInMod (mod, j); types.elems [k].type := S.VAL (Types.Type, tadr); INC (k) END; m.e [i].refCnt := SHORT (mod.refcnt); (* NEW initializes to zero  *) mod := mod.next END; SortIndex (); m.UpdateImports (); CalcHierarchy (); RETURN changed END Register; 8 %e8#Syntax10.Scn.Fntyy VAR i: LONGINT; mod: X.Module; changed: BOOLEAN; BEGIN IF m.e = NIL THEN changed := m.Register (types) ELSE mod := X.GetModules (); i := 0; WHILE (i < m.cnt) & (S.VAL (X.Module, m.e [i].mod) = mod) DO mod := mod.next; INC (i) END; IF (i # m.cnt) OR (mod # NIL) THEN changed := m.Register (types) ELSE changed := FALSE END; END; RETURN changed END CheckUpdate;  86%~8#Syntax10.Scn.Fnt$$ VAR i: LONGINT; BEGIN IF (types.elems = NIL) OR (nrOfTypes # types.count) OR (nrOfTypes # LEN (types.elems^)) THEN types.count := nrOfTypes; NEW (types.elems, types.count) END; FOR i := 0 TO types.count - 1 DO types.elems [i].type := NIL; types.elems [i].nofObjs := 0 END END Init; 8%~x8#Syntax10.Scn.Fntff VAR i: LONGINT; BEGIN FOR i := 0 TO types.count - 1 DO types.elems [i].nofObjs := 0 END END Clear; #8%~ n8#Syntax10.Scn.Fntpp VAR i: LONGINT; BEGIN FOR i := 0 TO types.count - 1 DO types.elems [i].specNofObjs := 0 END END ClearOutCnt; 8%8#Syntax10.Scn.Fnt88 BEGIN types.elems := NIL; types.count := 0 END Reset; 8%kKG8CSyntax10.Scn.FntlSyntax10b.Scn.FntC VAR mPos, tPos, lastT: LONGINT; th: TypeElemArray; BEGIN ASSERT (type # NIL); IF type.module = NIL THEN RETURN NotFound END; mPos := mods.Find (type.module.name); IF mPos # NotFound THEN tPos := mods.e [mPos].typePos; lastT := tPos + mods.e [mPos].objTypes; th := types.elems; WHILE (tPos < lastT) & (type # th [tPos].type) DO INC (tPos) END; IF tPos < lastT THEN INC (types.elems [tPos].nofObjs) END END; RETURN mPos END Update; "8%kK 9'8#Syntax10.Scn.Fnt VAR mPos, tPos, lastT: LONGINT; th: TypeElemArray; BEGIN ASSERT (type # NIL); ASSERT (type.module # NIL); mPos := mods.Find (type.module.name); th := types.elems; IF mPos # NotFound THEN tPos := mods.e [mPos].typePos; lastT := tPos + mods.e [mPos].objTypes; th := types.elems; WHILE (tPos < lastT) & (type # th [tPos].type) DO INC (tPos) END; IF tPos < lastT THEN INC (types.elems [tPos].specNofObjs) END END END UpdateSpec; /8%?w7B8Syntax10.Scn.FntS8FoldElemsNew#Syntax10.Scn.Fntp, end: X.Blockm4Ptr; tag, tdesc: X.Tag; size, size2, mapPos: LONGINT; type: Types.Type; mapTag: SET; hmap: Map; iterator, kind: INTEGER;8zSyntax10i.Scn.Fntx8#Syntax10.Scn.Fnt tag := p.tag; kind := X.GetObjType (S.VAL (S.PTR, S.VAL (LONGINT, p) + 4), tdesc, size2); size := S.VAL (LONGINT, S.VAL (SET, size2 + B-1) - S.VAL (SET, B-1)); IF (markBit IN S.VAL (SET, tag)) THEN CASE kind OF X.TTypDesc: INC (typeDescs.nOfObjs); INC (typeDescs.mem, size); INC (typeDescs.frag, size - size2) | X.TSysBl: INC (sysBlks.nOfObjs); INC (sysBlks.mem, size); INC (sysBlks.frag, size - size2) | X.TObj: p.tag := S.VAL (X.Tag, S.VAL (SET, tag) - {markBit}); type := X.TypeOf (S.VAL (S.PTR, S.VAL (LONGINT, p) + 4)); IF (type # NIL) & (type.module # NIL) & (type.module.name # "") THEN INCL (hmap [mapPos DIV 32], mapPos MOD 32) END ELSE END END; INC (S.VAL (LONGINT, p), size); INC (mapPos, size DIV B) H8j;8#Syntax10.Scn.Fnt tag := p.tag; IF (mapPos MOD 32) IN hmap [mapPos DIV 32] THEN type := X.TypeOf (S.VAL (S.PTR, S.VAL (LONGINT, p) + 4)); IF type.module.name # "" THEN types.UpdateSpec (type, mods) END; END; kind := X.GetObjType (S.VAL (S.PTR, S.VAL (LONGINT, p) + 4), tdesc, size); size := S.VAL (LONGINT, S.VAL (SET, size + B-1) - S.VAL (SET, B-1)); INC (S.VAL (LONGINT, p), size); INC (mapPos, size DIV B) M89 VAR  BEGIN NEW (hmap, X.GetHeapSize () DIV B DIV 32 + 1); (* FOR mapPos := 0 TO LEN (hmap^) - 1 DO hmap [mapPos] := {} END; (* NEW initializes to zero *)*) S.GET (S.VAL (LONGINT, hmap) - 4, mapTag); S.PUT (S.VAL (LONGINT, hmap) - 4, mapTag - {markBit}); iterator := 0; mapPos := 0; arrP.nOfObjs := 0; arrP.mem := 0; arrP.frag := 0; sysBlks.nOfObjs := 0; sysBlks.mem := 0; sysBlks.frag := 0; typeDescs.nOfObjs := 0; typeDescs.mem := 0; typeDescs.frag := 0; WHILE X.GetNextMemBlock (p, end, iterator) DO WHILE p # end DO  Set hmap bits of marked objects (no access to objects !), delete marks  END END; mapPos := 0; iterator := 0; WHILE X.GetNextMemBlock (p, end, iterator) DO WHILE p # end DO  For all set hmap bits => Update statistics (access to objects (not marked))  END END END CountMarkedObjs; 8%d4 J 8Syntax10.Scn.FntuSyntax10b.Scn.Fnt Syntax10i.Scn.Fnt@ k VAR level: INTEGER; type: Types.Type; BEGIN IF (iteratorPos >= types.count) OR (iteratorPos < StartIterator) THEN RETURN NIL END; IF base = NIL THEN (* Basetype of actual type does not exist (->type is basetype)*) WHILE (iteratorPos < types.count) & (Types.LevelOf (types.elems [iteratorPos].type) # 0) DO INC (iteratorPos) END; IF iteratorPos < types.count THEN INC (iteratorPos); RETURN types.elems [iteratorPos - 1].type END ELSE level := Types.LevelOf (base) + 1; type := types.elems [iteratorPos].type; INC (iteratorPos); WHILE (iteratorPos < types.count) & ((Types.LevelOf (type) # level) OR (Types.BaseOf (type, level - 1) # base)) DO type := types.elems [iteratorPos].type; INC (iteratorPos) END; IF (Types.LevelOf (type) = level) & (Types.BaseOf (type, level - 1) = base) THEN RETURN type END END; RETURN NIL END GetDerived; !8 MODULE HeapInspDescs; (* HeapInspDescs by MR 17 Dec 96 -   *) IMPORT S := SYSTEM, Kernel, Types, X := Platform; CONST  TYPE   Forward declarations  (* Like garbage collector in Kernel.GC, but marking objects only *) PROCEDURE MarkObjects* ();  Like Garbage Collector  PROCEDURE MarkModObjects* (modName: ARRAY OF CHAR): BOOLEAN;  Objs reached by mod  (* Set or reset the mark bit in all objects on the heap *) PROCEDURE UnmarkAll* ();  Clears mark bit in every existing object on the heap  PROCEDURE MarkAll* ();  Sets mark bit in every existing object on the heap  (* Operations on moduledescriptor-list (and internal array of moduledescriptors *) PROCEDURE (VAR m: ModDesc) Init* ();  Resets m  PROCEDURE (VAR m: ModDesc) CntReset* ();  Resets object counter for all modules  PROCEDURE (VAR m: ModDesc) UpdateElem* (type: Types.Type; size, mIdx: LONGINT): BOOLEAN;  Statistics (count objects per module)  PROCEDURE (VAR m: ModDesc) Unchain* ();  Removes module descs from module descriptor list  PROCEDURE (VAR m: ModDesc) Chain* ();  Restores module descriptor list (Kernel.modules)  PROCEDURE (VAR m: ModDesc) Find* (modName: ARRAY OF CHAR): LONGINT;  Searches module  PROCEDURE (VAR m: ModDesc) FindMod* (mod: X.Module): LONGINT;  Searches module  PROCEDURE (VAR m: ModDesc) ClearMarks* (): INTEGER;  Clear internal marked modules  PROCEDURE (VAR m: ModDesc) CountUnload* (): LONGINT;  Counts unloaded modules  PROCEDURE (VAR m: ModDesc) SetUnload* (n: LONGINT; parents: BOOLEAN);  Set module n for test-unloading  PROCEDURE (VAR m: ModDesc) ResetUnload* ();  Reset all modules for test-unloading  PROCEDURE (VAR m: ModDesc) UpdateImports* ();  Updates import info in module list  PROCEDURE (VAR m: ModDesc) Count* (VAR nrOfTypes: LONGINT): LONGINT; Count modules,types PROCEDURE (VAR m: ModDesc) Register* (VAR types: TypeInfoDesc): BOOLEAN;  Reg. load modules  PROCEDURE (VAR m: ModDesc) CheckUpdate* (VAR types: TypeInfoDesc): BOOLEAN;  Changes ?  (* Operations on internal array of type descriptors *) PROCEDURE (VAR types: TypeInfoDesc) Init (nrOfTypes: LONGINT);  Initialize (Reset all)  PROCEDURE (VAR types: TypeInfoDesc) Clear* ();  Reset number of objects of a type  PROCEDURE (VAR types: TypeInfoDesc) ClearOutCnt* ();  Reset  PROCEDURE (VAR types: TypeInfoDesc) Reset* ();  PROCEDURE (VAR types: TypeInfoDesc) Update* (type: Types.Type; mods: ModDesc): LONGINT;  Update array of type descriptors  PROCEDURE (VAR types: TypeInfoDesc) UpdateSpec* (type: Types.Type; mods: ModDesc);  Update array of type descriptors (specNofObj)  PROCEDURE (VAR types: TypeInfoDesc) CountMarkedObjs* (mods: ModDesc; VAR sysBlks, typeDescs, arrP: Count);  PROCEDURE (VAR types: TypeInfoDesc) GetDerived* (VAR iteratorPos: INTEGER; base: Types.Type): Types.Type;  Get next from base derived type  END HeapInspDescs.