paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-10 22:36:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: mem stat categories

Browse Source 
git-svn-id: trunk@19864 -
This commit is contained in:
mattias 2009-05-09 09:44:56 +00:00
parent 8b9c7b6944
commit e3c48b9278
15 changed files with 273 additions and 127 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
components/codetools/codecache.pas
View File

@ -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;

14
components/codetools/codecompletiontool.pas
View File

@ -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(

10
components/codetools/codetemplatestool.pas
View File

@ -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 }

17
components/codetools/codetoolmanager.pas
View File

@ -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;
//-----------------------------------------------------------------------------

29
components/codetools/customcodetool.pas
View File

@ -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);

11
components/codetools/eventcodetool.pas
View File

@ -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(

6
components/codetools/extractproctool.pas
View File

@ -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,

196
components/codetools/fileprocs.pas
View File

@ -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;

24
components/codetools/finddeclarationtool.pas
View File

@ -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;

27
components/codetools/identcompletiontool.pas
View File

@ -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 }

6
components/codetools/methodjumptool.pas
View File

@ -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;

13
components/codetools/multikeywordlisttool.pas
View File

@ -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);

21
components/codetools/pascalparsertool.pas
View File

@ -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;

8
components/codetools/pascalreadertool.pas
View File

@ -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.

6
components/codetools/stdcodetools.pas
View File

@ -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(