diff --git a/components/codetools/codecache.pas b/components/codetools/codecache.pas index 52b338bb07..224aedf39c 100644 --- a/components/codetools/codecache.pas +++ b/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; diff --git a/components/codetools/codecompletiontool.pas b/components/codetools/codecompletiontool.pas index 412e929bd9..8ad515318f 100644 --- a/components/codetools/codecompletiontool.pas +++ b/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) - +MemSizeString(FSetPropertyVariablename) + inherited CalcMemSize(Stats); + 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( diff --git a/components/codetools/codetemplatestool.pas b/components/codetools/codetemplatestool.pas index a919ab3e4f..09f1065d61 100644 --- a/components/codetools/codetemplatestool.pas +++ b/components/codetools/codetemplatestool.pas @@ -38,8 +38,8 @@ uses {$IFDEF MEM_CHECK} MemCheck, {$ENDIF} - Classes, SysUtils, CodeTree, CodeAtom, KeywordFuncLists, BasicCodeTools, - LinkScanner, AVL_Tree, SourceChanger, + Classes, SysUtils, FileProcs, CodeTree, CodeAtom, KeywordFuncLists, + 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 } diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index 801123c120..fb224b56df 100644 --- a/components/codetools/codetoolmanager.pas +++ b/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; - DebugLn(['TCodeToolManager.WriteMemoryStats TOTAL: ',m]); + SourceCache.CalcMemSize(Stats); + Stats.WriteReport; + Stats.Free; end; //----------------------------------------------------------------------------- diff --git a/components/codetools/customcodetool.pas b/components/codetools/customcodetool.pas index e389621e0a..d3577f797b 100644 --- a/components/codetools/customcodetool.pas +++ b/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) - +MemSizeString(LastErrorMessage); + Stats.Add(ClassName,InstanceSize); + 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); diff --git a/components/codetools/eventcodetool.pas b/components/codetools/eventcodetool.pas index c36fd587b9..73b3fa11f0 100644 --- a/components/codetools/eventcodetool.pas +++ b/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( diff --git a/components/codetools/extractproctool.pas b/components/codetools/extractproctool.pas index 35c5eed76a..8e53ff3b8b 100644 --- a/components/codetools/extractproctool.pas +++ b/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, diff --git a/components/codetools/fileprocs.pas b/components/codetools/fileprocs.pas index aa6e7fa599..03f213c072 100644 --- a/components/codetools/fileprocs.pas +++ b/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; diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index 116bfc4245..61824bb734 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/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; diff --git a/components/codetools/identcompletiontool.pas b/components/codetools/identcompletiontool.pas index 015659f6c2..2bc7d94637 100644 --- a/components/codetools/identcompletiontool.pas +++ b/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 - inc(Result,CurrentIdentifierList.CalcMemSize); - end; + if CurrentIdentifierList<>nil then + Stats.Add('TIdentCompletionTool.CurrentIdentifierList', + CurrentIdentifierList.CalcMemSize); if CurrentContexts<>nil then - inc(Result,CurrentContexts.CalcMemSize); + Stats.Add('TIdentCompletionTool.CurrentContexts', + CurrentContexts.CalcMemSize); end; { TIdentifierListItem } diff --git a/components/codetools/methodjumptool.pas b/components/codetools/methodjumptool.pas index 379a83f676..77a71213e1 100644 --- a/components/codetools/methodjumptool.pas +++ b/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; diff --git a/components/codetools/multikeywordlisttool.pas b/components/codetools/multikeywordlisttool.pas index 915fa20c21..ad5f95cded 100644 --- a/components/codetools/multikeywordlisttool.pas +++ b/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 - +FKeyWordLists.InstanceSize+PtrUInt(FKeyWordLists.Capacity)*SizeOf(Pointer); + inherited CalcMemSize(Stats); + Stats.Add('TMultiKeyWordListCodeTool', + PtrUInt(FKeyWordLists.InstanceSize) + +PtrUInt(FKeyWordLists.Capacity)*SizeOf(Pointer)); end; procedure TMultiKeyWordListCodeTool.SetKeyWordListID(NewID: integer); diff --git a/components/codetools/pascalparsertool.pas b/components/codetools/pascalparsertool.pas index cbc602adb3..28db50ed6f 100644 --- a/components/codetools/pascalparsertool.pas +++ b/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; diff --git a/components/codetools/pascalreadertool.pas b/components/codetools/pascalreadertool.pas index a87acc3eda..f8b867b0f1 100644 --- a/components/codetools/pascalreadertool.pas +++ b/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 - +MemSizeString(CachedSourceName); + inherited CalcMemSize(Stats); + Stats.Add('TPascalReaderTool',MemSizeString(CachedSourceName)); end; end. diff --git a/components/codetools/stdcodetools.pas b/components/codetools/stdcodetools.pas index 3eb0290039..cd3290a86a 100644 --- a/components/codetools/stdcodetools.pas +++ b/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(