codetools: mem stat categories

git-svn-id: trunk@19864 -

components/codetools/codecache.pas

@@ -192,7 +192,7 @@ type
     procedure OnBufferSetScanner(Sender: TCodeBuffer);
     procedure WriteAllFileNames;
     procedure WriteDebugReport;
-    function WriteMemoryStats: PtrUInt;
+    function CalcMemSize(Stats: TCTMemStats): PtrUInt;
   public
     property ExpirationTimeInDays: integer
           read FExpirationTimeInDays write FExpirationTimeInDays;
@@ -789,7 +789,7 @@ begin
   ConsistencyCheck;
 end;
 
-function TCodeCache.WriteMemoryStats: PtrUInt;
+function TCodeCache.CalcMemSize(Stats: TCTMemStats): PtrUInt;
 var
   m: PtrUInt;
   Node: TAVLTreeNode;
@@ -799,7 +799,6 @@ begin
   Result:=PtrUInt(InstanceSize)
      +MemSizeString(FDefaultEncoding)
      +MemSizeString(fLastIncludeLinkFile);
-  debugln(['TCodeCache.WriteMemoryStats Size=',Result]);
   if FItems<>nil then begin
     m:=FItems.Count*SizeOf(Node);
     Node:=FItems.FindLowest;
@@ -808,7 +807,8 @@ begin
       inc(m,Buf.CalcMemSize);
       Node:=FItems.FindSuccessor(Node);
     end;
-    debugln(['FItems Count=',FItems.Count,' Size=',m]);
+    Stats.Add('TCodeCache.Items.Count',FItems.Count);
+    Stats.Add('TCodeCache.Items',m);
     inc(Result,m);
   end;
   if FIncludeLinks<>nil then begin
@@ -819,9 +819,11 @@ begin
       inc(m,IncLink.CalcMemSize);
       Node:=FIncludeLinks.FindSuccessor(Node);
     end;
-    debugln(['FIncludeLinks Count=',FIncludeLinks.Count,' Size=',m]);
+    Stats.Add('TCodeCache.FIncludeLinks.Count',FIncludeLinks.Count);
+    Stats.Add('TCodeCache.FIncludeLinks',m);
     inc(Result,m);
   end;
+  Stats.Add('TCodeCache',Result);
 end;
 
 procedure TCodeCache.WriteAllFileNames;

components/codetools/codecompletiontool.pas

@@ -288,7 +288,7 @@ type
     property OnGetNewVariableLocation: TOnGetNewVariableLocation
                  read FOnGetNewVariableLocation write FOnGetNewVariableLocation;
 
-    function CalcMemSize: PtrUInt; override;
+    procedure CalcMemSize(Stats: TCTMemStats); override;
   end;
 
   
@@ -1046,16 +1046,18 @@ begin
   end;
 end;
 
-function TCodeCompletionCodeTool.CalcMemSize: PtrUInt;
+procedure TCodeCompletionCodeTool.CalcMemSize(Stats: TCTMemStats);
 begin
-  Result:=(inherited CalcMemSize)
+  inherited CalcMemSize(Stats);
-    +MemSizeString(FSetPropertyVariablename)
+  Stats.Add('TCodeCompletionCodeTool',
+     MemSizeString(FSetPropertyVariablename)
     +MemSizeString(FJumpToProcName)
     +length(NewClassSectionIndent)*SizeOf(integer)
     +length(NewClassSectionInsertPos)*SizeOf(integer)
-    +MemSizeString(fFullTopLvlName);
+    +MemSizeString(fFullTopLvlName));
  if fNewMainUsesSectionUnits<>nil then
-   inc(Result,SizeOf(TAVLTreeNode)*fNewMainUsesSectionUnits.Count);
+   Stats.Add('TCodeCompletionCodeTool.fNewMainUsesSectionUnits',
+     SizeOf(TAVLTreeNode)*fNewMainUsesSectionUnits.Count);
 end;
 
 function TCodeCompletionCodeTool.CompleteLocalVariableAssignment(

components/codetools/codetemplatestool.pas

@@ -38,8 +38,8 @@ uses
   {$IFDEF MEM_CHECK}
   MemCheck,
   {$ENDIF}
-  Classes, SysUtils, CodeTree, CodeAtom, KeywordFuncLists, BasicCodeTools,
+  Classes, SysUtils, FileProcs, CodeTree, CodeAtom, KeywordFuncLists,
-  LinkScanner, AVL_Tree, SourceChanger,
+  BasicCodeTools, LinkScanner, AVL_Tree, SourceChanger,
   CustomCodeTool, PascalParserTool, CodeToolsStructs, StdCodeTools;
 
 type
@@ -121,7 +121,7 @@ type
     function ExtractProcedureHeader(CursorPos: TCodeXYPosition;
       Attributes: TProcHeadAttributes; var ProcHead: string): boolean;
 
-    function CalcMemSize: PtrUInt; override;
+    procedure CalcMemSize(Stats: TCTMemStats); override;
   end;
 
 implementation
@@ -272,9 +272,9 @@ begin
   Result:=true;
 end;
 
-function TCodeTemplatesTool.CalcMemSize: PtrUInt;
+procedure TCodeTemplatesTool.CalcMemSize(Stats: TCTMemStats);
 begin
-  Result:=inherited CalcMemSize;
+  inherited CalcMemSize(Stats);
 end;
 
 { TCodeToolTemplate }

components/codetools/codetoolmanager.pas

@@ -5096,30 +5096,29 @@ end;
 procedure TCodeToolManager.WriteMemoryStats;
 var
   Node: TAVLTreeNode;
-  m: PtrUInt;
   ATool: TEventsCodeTool;
-  ToolSize: PtrUInt;
+  Stats: TCTMemStats;
 begin
   DebugLn(['Memory stats: ']);
+  Stats:=TCTMemStats.Create;
   // boss
-  DebugLn(['Boss=',InstanceSize]);
+  Stats.Add('Boss',InstanceSize);
   if FDirectivesTools<>nil then begin
     DebugLn(['FDirectivesTools.Count=',FDirectivesTools.Count]);
   end;
   if FPascalTools<>nil then begin
     debugln(['FPascalTools.Count=',FPascalTools.Count]);
-    ToolSize:=PtrUInt(FPascalTools.Count)*SizeOf(Node);
+    Stats.Add('PascalTools',PtrUInt(FPascalTools.Count)*SizeOf(Node));
     Node:=FPascalTools.FindLowest;
     while Node<>nil do begin
       ATool:=TCodeTool(Node.Data);
-      inc(ToolSize,ATool.CalcMemSize);
+      ATool.CalcMemSize(Stats);
       Node:=FPascalTools.FindSuccessor(Node);
     end;
-    DebugLn(['FPascalTools total=',ToolSize]);
-    inc(m,ToolSize);
   end;
-  SourceCache.WriteMemoryStats;
+  SourceCache.CalcMemSize(Stats);
-  DebugLn(['TCodeToolManager.WriteMemoryStats TOTAL: ',m]);
+  Stats.WriteReport;
+  Stats.Free;
 end;
 
 //-----------------------------------------------------------------------------

components/codetools/customcodetool.pas

@@ -326,7 +326,7 @@ type
     function NodeSubDescToStr(Desc, SubDesc: integer): string;
     procedure ConsistencyCheck; virtual;
     procedure WriteDebugTreeReport;
-    function CalcMemSize: PtrUInt; virtual;
+    procedure CalcMemSize(Stats: TCTMemStats); virtual;
     procedure CheckNodeTool(Node: TCodeTreeNode);
     constructor Create;
     destructor Destroy; override;
@@ -2115,24 +2115,31 @@ begin
   ConsistencyCheck;
 end;
 
-function TCustomCodeTool.CalcMemSize: PtrUInt;
+procedure TCustomCodeTool.CalcMemSize(Stats: TCTMemStats);
 begin
-  Result:=PtrUInt(InstanceSize)
+  Stats.Add(ClassName,InstanceSize);
-    +MemSizeString(LastErrorMessage);
+  Stats.Add('TCustomCodeTool',MemSizeString(LastErrorMessage));
   if FScanner<>nil then
-    inc(Result,FScanner.CalcMemSize);
+    Stats.Add('TCustomCodeTool.Scanner',
+      FScanner.CalcMemSize);
   if (FScanner=nil) or (Pointer(FScanner.Src)<>Pointer(Src)) then
-    inc(Result,MemSizeString(Src));
+    Stats.Add('TCustomCodeTool.Src',
+      MemSizeString(Src));
   if KeyWordFuncList<>nil then
-    inc(Result,KeyWordFuncList.CalcMemSize);
+    Stats.Add('TCustomCodeTool.KeyWordFuncList',
+      KeyWordFuncList.CalcMemSize);
   if WordIsKeyWordFuncList<>nil then
-    inc(Result,WordIsKeyWordFuncList.CalcMemSize);
+    Stats.Add('TCustomCodeTool.WordIsKeyWordFuncList',
+      WordIsKeyWordFuncList.CalcMemSize);
   if Tree<>nil then
-    inc(Result,Tree.NodeCount*TCodeTreeNode.InstanceSize);
+    Stats.Add('TCustomCodeTool.Tree',
+      Tree.NodeCount*TCodeTreeNode.InstanceSize);
   if LastAtoms<>nil then
-    inc(Result,LastAtoms.CalcMemSize);
+    Stats.Add('TCustomCodeTool.LastAtoms',
+      LastAtoms.CalcMemSize);
   if DirtySrc<>nil then
-    inc(Result,DirtySrc.CalcMemSize);
+    Stats.Add('TCustomCodeTool.DirtySrc',
+      DirtySrc.CalcMemSize);
 end;
 
 procedure TCustomCodeTool.CheckNodeTool(Node: TCodeTreeNode);

components/codetools/eventcodetool.pas

@@ -114,7 +114,7 @@ type
     function MethodTypeDataToStr(TypeData: PTypeData;
         Attr: TProcHeadAttributes): string;
 
-    function CalcMemSize: PtrUInt; override;
+    procedure CalcMemSize(Stats: TCTMemStats); override;
   end;
 
 const
@@ -220,13 +220,14 @@ begin
   Result:=Result+';';
 end;
 
-function TEventsCodeTool.CalcMemSize: PtrUInt;
+procedure TEventsCodeTool.CalcMemSize(Stats: TCTMemStats);
 begin
-  Result:=(inherited CalcMemSize);
+  inherited CalcMemSize(Stats);
   if fGatheredCompatibleMethods<>nil then
-    inc(Result,fGatheredCompatibleMethods.Count*SizeOf(TAVLTreeNode));
+    Stats.Add('TEventsCodeTool.fGatheredCompatibleMethods',
+      fGatheredCompatibleMethods.Count*SizeOf(TAVLTreeNode));
   if SearchedExprList<>nil then
-    inc(Result,SearchedExprList.CalcMemSize);
+    Stats.Add('TEventsCodeTool.SearchedExprList',SearchedExprList.CalcMemSize);
 end;
 
 function TEventsCodeTool.GetCompatiblePublishedMethods(

components/codetools/extractproctool.pas

@@ -106,7 +106,7 @@ type
       SourceChangeCache: TSourceChangeCache;
       FunctionResultVariableStartPos: integer = 0): boolean;
 
-    function CalcMemSize: PtrUInt; override;
+    procedure CalcMemSize(Stats: TCTMemStats); override;
   end;
   
 const
@@ -1116,9 +1116,9 @@ begin
   Result:=true;
 end;
 
-function TExtractProcTool.CalcMemSize: PtrUInt;
+procedure TExtractProcTool.CalcMemSize(Stats: TCTMemStats);
 begin
-  Result:=inherited CalcMemSize;
+  inherited CalcMemSize(Stats);
 end;
 
 function TExtractProcTool.ScanNodesForVariables(const StartPos,

components/codetools/fileprocs.pas

@@ -238,6 +238,44 @@ const
     'fsciExecutable'
     );
 
+var
+  FPUpChars: array[char] of char;
+
+// AnsiToUTF8 and UTF8ToAnsi need a widestring manager under Linux, BSD, MacOSX
+// but normally these OS use UTF-8 as system encoding so the widestringmanager
+// is not needed.
+function NeedRTLAnsi: boolean;// true if system encoding is not UTF-8
+procedure SetNeedRTLAnsi(NewValue: boolean);
+function UTF8ToSys(const s: string): string;// as UTF8ToAnsi but more independent of widestringmanager
+function SysToUTF8(const s: string): string;// as AnsiToUTF8 but more independent of widestringmanager
+
+// file operations
+function FileExistsUTF8(const Filename: string): boolean;
+function FileAgeUTF8(const FileName: string): Longint;
+function DirectoryExistsUTF8(const Directory: string): Boolean;
+function ExpandFileNameUTF8(const FileName: string): string;
+function FindFirstUTF8(const Path: string; Attr: Longint; out Rslt: TSearchRec): Longint;
+function FindNextUTF8(var Rslt: TSearchRec): Longint;
+procedure FindCloseUTF8(var F: TSearchrec);
+function FileSetDateUTF8(const FileName: String; Age: Longint): Longint;
+function FileGetAttrUTF8(const FileName: String): Longint;
+function FileSetAttrUTF8(const Filename: String; Attr: longint): Longint;
+function DeleteFileUTF8(const FileName: String): Boolean;
+function RenameFileUTF8(const OldName, NewName: String): Boolean;
+function FileSearchUTF8(const Name, DirList : String): String;
+function FileIsReadOnlyUTF8(const FileName: String): Boolean;
+function GetCurrentDirUTF8: String;
+function SetCurrentDirUTF8(const NewDir: String): Boolean;
+function CreateDirUTF8(const NewDir: String): Boolean;
+function RemoveDirUTF8(const Dir: String): Boolean;
+function ForceDirectoriesUTF8(const Dir: string): Boolean;
+
+// environment
+function ParamStrUTF8(Param: Integer): string;
+function GetEnvironmentStringUTF8(Index : Integer): String;
+function GetEnvironmentVariableUTF8(const EnvVar: String): String;
+
+
 // basic utility -> should go to RTL
 function ComparePointers(p1, p2: Pointer): integer;
 procedure MergeSort(List: PPointer; ListLength: PtrInt;
@@ -254,7 +292,10 @@ const DateAsCfgStrFormat='YYYYMMDD';
 function DateToCfgStr(const Date: TDateTime): string;
 function CfgStrToDate(const s: string; var Date: TDateTime): boolean;
 
+
 // debugging
+procedure RaiseCatchableException(const Msg: string);
+
 procedure DebugLn(Args: array of const);
 procedure DebugLn(const S: String; Args: array of const);// similar to Format(s,Args)
 procedure DebugLn;
@@ -295,6 +336,31 @@ function dbgMemRange(P: PByte; Count: integer; Width: integer = 0): string; over
 function DbgS(const i1,i2,i3,i4: integer): string; overload;
 function DbgStr(const StringWithSpecialChars: string): string;
 
+type
+  TCTMemStat = class
+  public
+    Name: string;
+    Sum: PtrUint;
+  end;
+
+  { TCTMemStats }
+
+  TCTMemStats = class
+  private
+    function GetItems(const Name: string): PtrUint;
+    procedure SetItems(const Name: string; const AValue: PtrUint);
+  public
+    Tree: TAVLTree; // tree of TCTMemStat sorted for Name with CompareText
+    Total: PtrUInt;
+    constructor Create;
+    destructor Destroy; override;
+    property Items[const Name: string]: PtrUint read GetItems write SetItems; default;
+    procedure Add(const Name: string; Size: PtrUint);
+    procedure WriteReport;
+  end;
+
+function CompareCTMemStat(Stat1, Stat2: TCTMemStat): integer;
+function CompareNameWithCTMemStat(KeyAnsiString: Pointer; Stat: TCTMemStat): integer;
 function MemSizeString(const s: string): PtrUInt;
 function MemSizeFPList(const List: TFPList): PtrUInt;
 
@@ -317,47 +383,6 @@ function CTGetLineInfo(Addr: Pointer; UseCache: boolean): string;
 function CompareCTLineInfoCacheItems(Data1, Data2: Pointer): integer;
 function CompareAddrWithCTLineInfoCacheItem(Addr, Item: Pointer): integer;
 
-var
-  FPUpChars: array[char] of char;
-
-// AnsiToUTF8 and UTF8ToAnsi need a widestring manager under Linux, BSD, MacOSX
-// but normally these OS use UTF-8 as system encoding so the widestringmanager
-// is not needed.
-function NeedRTLAnsi: boolean;// true if system encoding is not UTF-8
-procedure SetNeedRTLAnsi(NewValue: boolean);
-function UTF8ToSys(const s: string): string;// as UTF8ToAnsi but more independent of widestringmanager
-function SysToUTF8(const s: string): string;// as AnsiToUTF8 but more independent of widestringmanager
-
-// file operations
-function FileExistsUTF8(const Filename: string): boolean;
-function FileAgeUTF8(const FileName: string): Longint;
-function DirectoryExistsUTF8(const Directory: string): Boolean;
-function ExpandFileNameUTF8(const FileName: string): string;
-function FindFirstUTF8(const Path: string; Attr: Longint; out Rslt: TSearchRec): Longint;
-function FindNextUTF8(var Rslt: TSearchRec): Longint;
-procedure FindCloseUTF8(var F: TSearchrec);
-function FileSetDateUTF8(const FileName: String; Age: Longint): Longint;
-function FileGetAttrUTF8(const FileName: String): Longint;
-function FileSetAttrUTF8(const Filename: String; Attr: longint): Longint;
-function DeleteFileUTF8(const FileName: String): Boolean;
-function RenameFileUTF8(const OldName, NewName: String): Boolean;
-function FileSearchUTF8(const Name, DirList : String): String;
-function FileIsReadOnlyUTF8(const FileName: String): Boolean;
-function GetCurrentDirUTF8: String;
-function SetCurrentDirUTF8(const NewDir: String): Boolean;
-function CreateDirUTF8(const NewDir: String): Boolean;
-function RemoveDirUTF8(const Dir: String): Boolean;
-function ForceDirectoriesUTF8(const Dir: string): Boolean;
-
-// environment
-function ParamStrUTF8(Param: Integer): string;
-function GetEnvironmentStringUTF8(Index : Integer): String;
-function GetEnvironmentVariableUTF8(const EnvVar: String): String;
-
-
-// other useful stuff
-procedure RaiseCatchableException(const Msg: string);
-
 
 implementation
 
@@ -2589,6 +2614,17 @@ begin
   end;
 end;
 
+function CompareCTMemStat(Stat1, Stat2: TCTMemStat): integer;
+begin
+  Result:=SysUtils.CompareText(Stat1.Name,Stat2.Name);
+end;
+
+function CompareNameWithCTMemStat(KeyAnsiString: Pointer; Stat: TCTMemStat
+  ): integer;
+begin
+  Result:=SysUtils.CompareText(AnsiString(KeyAnsiString),Stat.Name);
+end;
+
 function MemSizeString(const s: string): PtrUInt;
 begin
   Result:=length(s);
@@ -3029,6 +3065,84 @@ begin
   LineInfoCache:=nil;
 end;
 
+{ TCTMemStats }
+
+function TCTMemStats.GetItems(const Name: string): PtrUint;
+var
+  Node: TAVLTreeNode;
+begin
+  Node:=Tree.FindKey(Pointer(Name),TListSortCompare(@CompareNameWithCTMemStat));
+  if Node<>nil then
+    Result:=TCTMemStat(Node.Data).Sum
+  else
+    Result:=0;
+end;
+
+procedure TCTMemStats.SetItems(const Name: string; const AValue: PtrUint);
+var
+  Node: TAVLTreeNode;
+  NewStat: TCTMemStat;
+begin
+  Node:=Tree.FindKey(Pointer(Name),TListSortCompare(@CompareNameWithCTMemStat));
+  if Node<>nil then begin
+    if AValue<>0 then begin
+      TCTMemStat(Node.Data).Sum:=AValue;
+    end else begin
+      Tree.FreeAndDelete(Node);
+    end;
+  end else begin
+    if AValue<>0 then begin
+      NewStat:=TCTMemStat.Create;
+      NewStat.Name:=Name;
+      NewStat.Sum:=AValue;
+      Tree.Add(NewStat);
+    end;
+  end;
+end;
+
+constructor TCTMemStats.Create;
+begin
+  Tree:=TAVLTree.Create(TListSortCompare(@CompareCTMemStat));
+end;
+
+destructor TCTMemStats.Destroy;
+begin
+  Tree.FreeAndClear;
+  FreeAndNil(Tree);
+  inherited Destroy;
+end;
+
+procedure TCTMemStats.Add(const Name: string; Size: PtrUint);
+var
+  Node: TAVLTreeNode;
+  NewStat: TCTMemStat;
+begin
+  inc(Total,Size);
+  Node:=Tree.FindKey(Pointer(Name),TListSortCompare(@CompareNameWithCTMemStat));
+  if Node<>nil then begin
+    inc(TCTMemStat(Node.Data).Sum,Size);
+  end else begin
+    NewStat:=TCTMemStat.Create;
+    NewStat.Name:=Name;
+    NewStat.Sum:=Size;
+    Tree.Add(NewStat);
+  end;
+end;
+
+procedure TCTMemStats.WriteReport;
+var
+  Node: TAVLTreeNode;
+  CurStat: TCTMemStat;
+begin
+  DebugLn(['TCTMemStats.WriteReport Stats=',Tree.Count,' Total=',Total]);
+  Node:=Tree.FindLowest;
+  while Node<>nil do begin
+    CurStat:=TCTMemStat(Node.Data);
+    DebugLn(['  ',CurStat.Name,'=',CurStat.Sum]);
+    Node:=Tree.FindSuccessor(Node);
+  end;
+end;
+
 initialization
   {$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('fileprocs.pas: initialization');{$ENDIF}
   InternalInit;

components/codetools/finddeclarationtool.pas

@@ -711,7 +711,7 @@ type
   public
     destructor Destroy; override;
     procedure ConsistencyCheck; override;
-    function CalcMemSize: PtrUInt; override;
+    procedure CalcMemSize(Stats: TCTMemStats); override;
 
     procedure BeginParsing(DeleteNodes, OnlyInterfaceNeeded: boolean); override;
     procedure ValidateToolDependencies; override;
@@ -8322,32 +8322,40 @@ begin
   end;
 end;
 
-function TFindDeclarationTool.CalcMemSize: PtrUInt;
+procedure TFindDeclarationTool.CalcMemSize(Stats: TCTMemStats);
 var
   NodeCache: TCodeTreeNodeCache;
   TypeCache: TBaseTypeCache;
+  m: PtrUInt;
 begin
-  Result:=inherited CalcMemSize;
+  inherited CalcMemSize(Stats);
   if FInterfaceIdentifierCache<>nil then
-    inc(Result,FInterfaceIdentifierCache.CalcMemSize);
+    Stats.Add('TFindDeclarationTool.FInterfaceIdentifierCache',
+      FInterfaceIdentifierCache.CalcMemSize);
   if FFirstNodeCache<>nil then begin
+    m:=0;
     NodeCache:=FFirstNodeCache;
     while NodeCache<>nil do begin
-      inc(Result,NodeCache.CalcMemSize);
+      inc(m,NodeCache.CalcMemSize);
       NodeCache:=NodeCache.Next;
     end;
+    Stats.Add('TFindDeclarationTool.NodeCache',m);
   end;
   if FFirstBaseTypeCache<>nil then begin
+    m:=0;
     TypeCache:=FFirstBaseTypeCache;
     while TypeCache<>nil do begin
-      inc(Result,TypeCache.CalcMemSize);
+      inc(m,TypeCache.CalcMemSize);
       TypeCache:=TypeCache.Next;
     end;
+    Stats.Add('TFindDeclarationTool.TypeCache',m);
   end;
   if FDependentCodeTools<>nil then
-    inc(Result,FDependentCodeTools.Count*SizeOf(TAVLTreeNode));
+    Stats.Add('TFindDeclarationTool.FDependentCodeTools',
+      FDependentCodeTools.Count*SizeOf(TAVLTreeNode));
   if FDependsOnCodeTools<>nil then
-    inc(Result,FDependsOnCodeTools.Count*SizeOf(TAVLTreeNode));
+    Stats.Add('TFindDeclarationTool.FDependsOnCodeTools',
+      FDependsOnCodeTools.Count*SizeOf(TAVLTreeNode));
 end;
 
 procedure TFindDeclarationTool.ValidateToolDependencies;

components/codetools/identcompletiontool.pas

@@ -346,7 +346,7 @@ type
     function GetValuesOfCaseVariable(const CursorPos: TCodeXYPosition;
                                      List: TStrings): boolean;
 
-    function CalcMemSize: PtrUInt; override;
+    procedure CalcMemSize(Stats: TCTMemStats); override;
   end;
   
 const
@@ -2104,30 +2104,35 @@ begin
   end;
 end;
 
-function TIdentCompletionTool.CalcMemSize: PtrUInt;
+procedure TIdentCompletionTool.CalcMemSize(Stats: TCTMemStats);
 var
   Node: TAVLTreeNode;
   Ext: TCodeTreeNodeExtension;
+  m: PtrUint;
 begin
-  Result:=inherited CalcMemSize;
+  inherited CalcMemSize(Stats);
   if ClassAndAncestors<>nil then
-    inc(Result,ClassAndAncestors.Count*(SizeOf(TAVLTreeNode)+SizeOf(TCodeXYPosition)));
+    Stats.Add('TIdentCompletionTool.ClassAndAncestors',
+        ClassAndAncestors.Count*(SizeOf(TAVLTreeNode)+SizeOf(TCodeXYPosition)));
   if FoundPublicProperties<>nil then
-    inc(Result,FoundPublicProperties.COunt*SizeOf(TAVLTreeNode));
+    Stats.Add('TIdentCompletionTool.FoundPublicProperties',
+              FoundPublicProperties.COunt*SizeOf(TAVLTreeNode));
   if FoundMethods<>nil then begin
-    inc(Result,FoundMethods.Count*SizeOf(TAVLTreeNode));
+    m:=PtrUint(FoundMethods.Count)*SizeOf(TAVLTreeNode);
     Node:=FoundMethods.FindLowest;
     while Node<>nil do begin
       Ext:=TCodeTreeNodeExtension(Node.Data);
-      inc(Result,Ext.CalcMemSize);
+      inc(m,Ext.CalcMemSize);
       Node:=FoundMethods.FindSuccessor(Node);
     end;
+    STats.Add('TIdentCompletionTool.FoundMethods',m);
   end;
-  if CurrentIdentifierList<>nil then begin
+  if CurrentIdentifierList<>nil then
-    inc(Result,CurrentIdentifierList.CalcMemSize);
+    Stats.Add('TIdentCompletionTool.CurrentIdentifierList',
-  end;
+      CurrentIdentifierList.CalcMemSize);
   if CurrentContexts<>nil then
-    inc(Result,CurrentContexts.CalcMemSize);
+    Stats.Add('TIdentCompletionTool.CurrentContexts',
+              CurrentContexts.CalcMemSize);
 end;
 
 { TIdentifierListItem }

components/codetools/methodjumptool.pas

@@ -84,7 +84,7 @@ type
         out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
         
     procedure WriteCodeTreeNodeExtTree(ExtTree: TAVLTree);
-    function CalcMemSize: PtrUInt; override;
+    procedure CalcMemSize(Stats: TCTMemStats); override;
   end;
 
 
@@ -1171,9 +1171,9 @@ begin
   end;
 end;
 
-function TMethodJumpingCodeTool.CalcMemSize: PtrUInt;
+procedure TMethodJumpingCodeTool.CalcMemSize(Stats: TCTMemStats);
 begin
-  Result:=inherited CalcMemSize;
+  inherited CalcMemSize(Stats);
 end;
 
 function TMethodJumpingCodeTool.JumpToMethod(const ProcHead: string;

components/codetools/multikeywordlisttool.pas

@@ -36,7 +36,8 @@ uses
   {$IFDEF MEM_CHECK}
   MemCheck,
   {$ENDIF}
-  Classes, SysUtils, CodeAtom, CustomCodeTool, KeywordFuncLists, BasicCodeTools;
+  Classes, SysUtils, FileProcs, CodeAtom, CustomCodeTool, KeywordFuncLists,
+  BasicCodeTools;
 
 type
 
@@ -60,7 +61,7 @@ type
 
     constructor Create;
     destructor Destroy; override;
-    function CalcMemSize: PtrUInt; override;
+    procedure CalcMemSize(Stats: TCTMemStats); override;
   end;
 
 
@@ -84,10 +85,12 @@ begin
   inherited Destroy;
 end;
 
-function TMultiKeyWordListCodeTool.CalcMemSize: PtrUInt;
+procedure TMultiKeyWordListCodeTool.CalcMemSize(Stats: TCTMemStats);
 begin
-  Result:=inherited CalcMemSize
+  inherited CalcMemSize(Stats);
-    +FKeyWordLists.InstanceSize+PtrUInt(FKeyWordLists.Capacity)*SizeOf(Pointer);
+  Stats.Add('TMultiKeyWordListCodeTool',
+     PtrUInt(FKeyWordLists.InstanceSize)
+     +PtrUInt(FKeyWordLists.Capacity)*SizeOf(Pointer));
 end;
 
 procedure TMultiKeyWordListCodeTool.SetKeyWordListID(NewID: integer);

components/codetools/pascalparsertool.pas

@@ -241,7 +241,7 @@ type
 
     constructor Create;
     destructor Destroy; override;
-    function CalcMemSize: PtrUInt; override;
+    procedure CalcMemSize(Stats: TCTMemStats); override;
   end;
   
 const
@@ -330,19 +330,24 @@ begin
   inherited Destroy;
 end;
 
-function TPascalParserTool.CalcMemSize: PtrUInt;
+procedure TPascalParserTool.CalcMemSize(Stats: TCTMemStats);
 begin
-  Result:=inherited CalcMemSize;
+  inherited CalcMemSize(Stats);
   if TypeKeyWordFuncList<>nil then
-    inc(Result,TypeKeyWordFuncList.CalcMemSize);
+    Stats.Add('TPascalParserTool.TypeKeyWordFuncList',
+      TypeKeyWordFuncList.CalcMemSize);
   if InnerClassKeyWordFuncList<>nil then
-    inc(Result,InnerClassKeyWordFuncList.CalcMemSize);
+    Stats.Add('TPascalParserTool.InnerClassKeyWordFuncList',
+      InnerClassKeyWordFuncList.CalcMemSize);
   if ClassInterfaceKeyWordFuncList<>nil then
-    inc(Result,ClassInterfaceKeyWordFuncList.CalcMemSize);
+    Stats.Add('TPascalParserTool.ClassInterfaceKeyWordFuncList',
+      ClassInterfaceKeyWordFuncList.CalcMemSize);
   if ClassVarTypeKeyWordFuncList<>nil then
-    inc(Result,ClassVarTypeKeyWordFuncList.CalcMemSize);
+    Stats.Add('TPascalParserTool.ClassVarTypeKeyWordFuncList',
+      ClassVarTypeKeyWordFuncList.CalcMemSize);
   if ExtractMemStream<>nil then
-    inc(Result,ExtractMemStream.InstanceSize+ExtractMemStream.Size);
+    Stats.Add('TPascalParserTool.ExtractMemStream',
+      ExtractMemStream.InstanceSize+ExtractMemStream.Size);
 end;
 
 procedure TPascalParserTool.BuildDefaultKeyWordFunctions;

components/codetools/pascalreadertool.pas

@@ -175,7 +175,7 @@ type
     procedure ReadNextUsedUnit(out UnitNameAtom, InAtom: TAtomPosition);
     procedure ReadPriorUsedUnit(out UnitNameAtom, InAtom: TAtomPosition);
 
-    function CalcMemSize: PtrUInt; override;
+    procedure CalcMemSize(Stats: TCTMemStats); override;
   end;
 
 implementation
@@ -1908,10 +1908,10 @@ begin
   UnitNameAtom:=CurPos;
 end;
 
-function TPascalReaderTool.CalcMemSize: PtrUInt;
+procedure TPascalReaderTool.CalcMemSize(Stats: TCTMemStats);
 begin
-  Result:=inherited CalcMemSize
+  inherited CalcMemSize(Stats);
-    +MemSizeString(CachedSourceName);
+  Stats.Add('TPascalReaderTool',MemSizeString(CachedSourceName));
 end;
 
 end.

components/codetools/stdcodetools.pas

@@ -301,7 +301,7 @@ type
                                InvokeBuildTree: boolean;
                                out ListOfPCodeXYPosition: TFPList): boolean;
 
-    function CalcMemSize: PtrUInt; override;
+    procedure CalcMemSize(Stats: TCTMemStats); override;
   end;
 
 
@@ -4280,9 +4280,9 @@ begin
   Result:=true;
 end;
 
-function TStandardCodeTool.CalcMemSize: PtrUInt;
+procedure TStandardCodeTool.CalcMemSize(Stats: TCTMemStats);
 begin
-  Result:=inherited CalcMemSize;
+  inherited CalcMemSize(Stats);
 end;
 
 function TStandardCodeTool.GatherResourceStringsWithValue(