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

MG: added base class for mem managers and started node cache

Browse Source 
git-svn-id: trunk@651 -
This commit is contained in:
lazarus 2002-01-31 16:52:24 +00:00
parent 7b9bf2f1b8
commit ffb07a8f59
6 changed files with 909 additions and 517 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -6,6 +6,7 @@ components/codetools/codeatom.pas svneol=native#text/pascal
components/codetools/codecache.pas svneol=native#text/pascal
components/codetools/codecompletiontool.pas svneol=native#text/pascal
components/codetools/codetoolmanager.pas svneol=native#text/pascal
components/codetools/codetoolmemmanager.pas svneol=native#text/pascal
components/codetools/codetools.inc svneol=native#text/pascal
components/codetools/codetree.pas svneol=native#text/pascal
components/codetools/customcodetool.pas svneol=native#text/pascal
@ -13,6 +14,7 @@ components/codetools/definetemplates.pas svneol=native#text/pascal
components/codetools/eventcodetool.pas svneol=native#text/pascal
components/codetools/expreval.pas svneol=native#text/pascal
components/codetools/fileprocs.pas svneol=native#text/pascal
components/codetools/finddeclarationcache.pas svneol=native#text/pascal
components/codetools/finddeclarationtool.pas svneol=native#text/pascal
components/codetools/keywordfunclists.pas svneol=native#text/pascal
components/codetools/linkscanner.pas svneol=native#text/pascal

8
components/codetools/allcodetoolunits.pp
View File

@ -17,8 +17,9 @@ uses
MemCheck,
CodeToolManager, CustomCodeTool, PascalParserTool, FindDeclarationTool,
StdCodeTools, MethodJumpTool, EventCodeTool, CodeCompletionTool, LinkScanner,
BasicCodeTools, CodeTree, CodeAtom, SourceChanger, CodeCache,
KeywordFuncLists, SourceLog, ExprEval, DefineTemplates, FileProcs, AVL_Tree;
FindDeclarationCache, BasicCodeTools, CodeTree, CodeAtom, SourceChanger,
CodeToolMemManager, CodeCache, KeywordFuncLists, SourceLog, ExprEval,
DefineTemplates, FileProcs, AVL_Tree;
implementation
@ -28,6 +29,9 @@ end.
{ =============================================================================
$Log$
Revision 1.8 2002/01/31 16:52:24 lazarus
MG: added base class for mem managers and started node cache
Revision 1.7 2002/01/28 12:14:56 lazarus
MG: fixed Makefile

159
components/codetools/codetoolmemmanager.pas Normal file
View File

@ -0,0 +1,159 @@
{
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
Author: Mattias Gaertner
Abstract:
Defines TCodeToolMemManager, which is the base class for the various
memory manager in the codetools. An own memory manager is somewhat faster
and makes debugging and proiling easier.
}
unit CodeToolMemManager;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
PCodeToolMemManagerItem = ^TCodeToolMemManagerItem;
TCodeToolMemManagerItem = record
Next: PCodeToolMemManagerItem;
end;
// memory manager template
TCodeToolMemManager = class
private
procedure SetMaxFreeRatio(NewValue: integer);
procedure SetMinFree(NewValue: integer);
protected
FFirstFree: PCodeToolMemManagerItem;
FFreeCount: integer;
FCount: integer;
FMinFree: integer;
FMaxFreeRatio: integer;
FAllocatedCount: int64;
FFreedCount: int64;
procedure DisposeItem(AnItem: PCodeToolMemManagerItem);
function NewItem: PCodeToolMemManagerItem;
procedure FreeFirstItem; virtual;
public
property MinimumFreeCount: integer read FMinFree write SetMinFree;
property MaximumFreeCountRatio: integer
read FMaxFreeRatio write SetMaxFreeRatio; // in one eighth steps
property Count: integer read FCount;
property FreeCount: integer read FFreeCount;
property AllocatedCount: int64 read FAllocatedCount;
property FreedCount: int64 read FFreedCount;
procedure Clear;
constructor Create;
destructor Destroy; override;
end;
implementation
{ TCodeToolMemManager }
procedure TCodeToolMemManager.Clear;
begin
while FFirstFree<>nil do begin
FreeFirstItem;
inc(FFreedCount);
end;
FFreeCount:=0;
end;
constructor TCodeToolMemManager.Create;
begin
inherited Create;
FFirstFree:=nil;
FFreeCount:=0;
FCount:=0;
FAllocatedCount:=0;
FFreedCount:=0;
FMinFree:=100000;
FMaxFreeRatio:=8; // 1:1
end;
destructor TCodeToolMemManager.Destroy;
begin
Clear;
inherited Destroy;
end;
procedure TCodeToolMemManager.DisposeItem(AnItem: PCodeToolMemManagerItem);
begin
if (FFreeCount<FMinFree) or (FFreeCount<((FCount shr 3)*FMaxFreeRatio)) then
begin
// add ANode to Free list
//AddItemToFreeList(AnItem);
inc(FFreeCount);
end else begin
// free list full -> free the ANode
//FreeItem(AnItem);
inc(FFreedCount);
end;
dec(FCount);
end;
function TCodeToolMemManager.NewItem: PCodeToolMemManagerItem;
begin
if FFirstFree<>nil then begin
// take from free list
Result:=FFirstFree;
FFirstFree:=FFirstFree^.Next;
Result^.Next:=nil;
dec(FFreeCount);
end else begin
// free list empty -> create new node
New(Result);
inc(FAllocatedCount);
end;
inc(FCount);
end;
procedure TCodeToolMemManager.SetMaxFreeRatio(NewValue: integer);
begin
if NewValue<0 then NewValue:=0;
if NewValue=FMaxFreeRatio then exit;
FMaxFreeRatio:=NewValue;
end;
procedure TCodeToolMemManager.SetMinFree(NewValue: integer);
begin
if NewValue<0 then NewValue:=0;
if NewValue=FMinFree then exit;
FMinFree:=NewValue;
end;
procedure TCodeToolMemManager.FreeFirstItem;
var Item: PCodeToolMemManagerItem;
begin
Item:=FFirstFree;
FFirstFree:=FFirstFree^.Next;
Dispose(Item);
end;
end.

154
components/codetools/codetree.pas
View File

@ -40,7 +40,7 @@ uses
{$IFDEF MEM_CHECK}
MemCheck,
{$ENDIF}
Classes, SysUtils, BasicCodeTools, AVL_Tree;
Classes, SysUtils, BasicCodeTools, AVL_Tree, CodeToolMemManager;
//-----------------------------------------------------------------------------
@ -184,53 +184,22 @@ type
end;
// memory system for TCodeTreeNode(s)
TCodeTreeNodeMemManager = class
private
FFirstFree: TCodeTreeNode;
FFreeCount: integer;
FCount: integer;
FMinFree: integer;
FMaxFreeRatio: integer;
FAllocatedNodes: integer;
FFreedNodes: integer;
procedure SetMaxFreeRatio(NewValue: integer);
procedure SetMinFree(NewValue: integer);
TCodeTreeNodeMemManager = class(TCodeToolMemManager)
protected
procedure FreeFirstItem; override;
public
procedure DisposeNode(ANode: TCodeTreeNode);
function NewNode: TCodeTreeNode;
property MinimumFreeNode: integer read FMinFree write SetMinFree;
property MaximumFreeNodeRatio: integer
read FMaxFreeRatio write SetMaxFreeRatio; // in one eighth steps
property Count: integer read FCount;
property FreeCount: integer read FFreeCount;
property AllocatedNodes: integer read FAllocatedNodes;
property FreedNodes: integer read FFreedNodes;
procedure Clear;
constructor Create;
destructor Destroy; override;
end;
// memory system for TCodeTreeNodeExtension(s)
TCodeTreeNodeExtMemManager = class
private
FFirstFree: TCodeTreeNodeExtension;
FFreeCount: integer;
FCount: integer;
FMinFree: integer;
FMaxFreeRatio: integer;
procedure SetMaxFreeRatio(NewValue: integer);
procedure SetMinFree(NewValue: integer);
TCodeTreeNodeExtMemManager = class(TCodeToolMemManager)
protected
procedure FreeFirstItem; override;
public
procedure DisposeNode(ANode: TCodeTreeNodeExtension);
procedure DisposeAVLTree(TheTree: TAVLTree);
function NewNode: TCodeTreeNodeExtension;
property MinimumFreeNode: integer read FMinFree write SetMinFree;
property MaximumFreeNodeRatio: integer
read FMaxFreeRatio write SetMaxFreeRatio; // in one eighth steps
property Count: integer read FCount;
procedure Clear;
constructor Create;
destructor Destroy; override;
end;
@ -338,8 +307,6 @@ begin
LastChild:=nil;
StartPos:=-1;
EndPos:=-1;
Cache.Free;
Cache:=nil;
end;
function TCodeTreeNode.Next: TCodeTreeNode;
@ -556,36 +523,18 @@ end;
{ TCodeTreeNodeMemManager }
constructor TCodeTreeNodeMemManager.Create;
begin
inherited Create;
FFirstFree:=nil;
FFreeCount:=0;
FCount:=0;
FAllocatedNodes:=0;
FFreedNodes:=0;
FMinFree:=100000;
FMaxFreeRatio:=8; // 1:1
end;
destructor TCodeTreeNodeMemManager.Destroy;
begin
Clear;
inherited Destroy;
end;
function TCodeTreeNodeMemManager.NewNode: TCodeTreeNode;
begin
if FFirstFree<>nil then begin
// take from free list
Result:=FFirstFree;
FFirstFree:=FFirstFree.NextBrother;
Result:=TCodeTreeNode(FFirstFree);
TCodeTreeNode(FFirstFree):=Result.NextBrother;
Result.NextBrother:=nil;
dec(FFreeCount);
end else begin
// free list empty -> create new node
Result:=TCodeTreeNode.Create;
inc(FAllocatedNodes);
inc(FAllocatedCount);
end;
inc(FCount);
end;
@ -596,68 +545,33 @@ begin
begin
// add ANode to Free list
ANode.Clear;
ANode.NextBrother:=FFirstFree;
FFirstFree:=ANode;
ANode.NextBrother:=TCodeTreeNode(FFirstFree);
TCodeTreeNode(FFirstFree):=ANode;
inc(FFreeCount);
end else begin
// free list full -> free the ANode
ANode.Free;
inc(FFreedNodes);
inc(FFreedCount);
end;
dec(FCount);
end;
procedure TCodeTreeNodeMemManager.Clear;
procedure TCodeTreeNodeMemManager.FreeFirstItem;
var ANode: TCodeTreeNode;
begin
while FFirstFree<>nil do begin
ANode:=FFirstFree;
FFirstFree:=FFirstFree.NextBrother;
ANode.NextBrother:=nil;
ANode.Free;
inc(FFreedNodes);
end;
FFreeCount:=0;
end;
procedure TCodeTreeNodeMemManager.SetMaxFreeRatio(NewValue: integer);
begin
if NewValue<0 then NewValue:=0;
if NewValue=FMaxFreeRatio then exit;
FMaxFreeRatio:=NewValue;
end;
procedure TCodeTreeNodeMemManager.SetMinFree(NewValue: integer);
begin
if NewValue<0 then NewValue:=0;
if NewValue=FMinFree then exit;
FMinFree:=NewValue;
ANode:=TCodeTreeNode(FFirstFree);
TCodeTreeNode(FFirstFree):=ANode.NextBrother;
ANode.Free;
end;
{ TCodeTreeNodeExtMemManager }
constructor TCodeTreeNodeExtMemManager.Create;
begin
inherited Create;
FFirstFree:=nil;
FFreeCount:=0;
FCount:=0;
FMinFree:=20000;
FMaxFreeRatio:=8; // 1:1
end;
destructor TCodeTreeNodeExtMemManager.Destroy;
begin
Clear;
inherited Destroy;
end;
function TCodeTreeNodeExtMemManager.NewNode: TCodeTreeNodeExtension;
begin
if FFirstFree<>nil then begin
// take from free list
Result:=FFirstFree;
FFirstFree:=FFirstFree.Next;
Result:=TCodeTreeNodeExtension(FFirstFree);
TCodeTreeNodeExtension(FFirstFree):=Result.Next;
Result.Next:=nil;
end else begin
// free list empty -> create new node
@ -672,8 +586,8 @@ begin
begin
// add ANode to Free list
ANode.Clear;
ANode.Next:=FFirstFree;
FFirstFree:=ANode;
ANode.Next:=TCodeTreeNodeExtension(FFirstFree);
TCodeTreeNodeExtension(FFirstFree):=ANode;
inc(FFreeCount);
end else begin
// free list full -> free the ANode
@ -694,30 +608,12 @@ begin
TheTree.Free;
end;
procedure TCodeTreeNodeExtMemManager.Clear;
procedure TCodeTreeNodeExtMemManager.FreeFirstItem;
var ANode: TCodeTreeNodeExtension;
begin
while FFirstFree<>nil do begin
ANode:=FFirstFree;
FFirstFree:=FFirstFree.Next;
ANode.Next:=nil;
ANode.Free;
end;
FFreeCount:=0;
end;
procedure TCodeTreeNodeExtMemManager.SetMaxFreeRatio(NewValue: integer);
begin
if NewValue<0 then NewValue:=0;
if NewValue=FMaxFreeRatio then exit;
FMaxFreeRatio:=NewValue;
end;
procedure TCodeTreeNodeExtMemManager.SetMinFree(NewValue: integer);
begin
if NewValue<0 then NewValue:=0;
if NewValue=FMinFree then exit;
FMinFree:=NewValue;
ANode:=TCodeTreeNodeExtension(FFirstFree);
TCodeTreeNodeExtension(FFirstFree):=ANode.Next;
ANode.Free;
end;
//-----------------------------------------------------------------------------

703
components/codetools/finddeclarationcache.pas Normal file
View File

@ -0,0 +1,703 @@
{
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
Author: Mattias Gaertner
Abstract:
Cache objects for TFindDeclarationTool.
}
unit FindDeclarationCache;
{$mode objfpc}{$H+}
interface
{$I codetools.inc}
uses
Classes, SysUtils, BasicCodeTools, AVL_Tree, CodeTree, LinkScanner,
PascalParserTool, CodeToolMemManager;
type
{
1. interface cache:
Every FindIdentifierInInterface call is cached
- stores: Identifier -> Node+CleanPos
- cache must be deleted, everytime the codetree is rebuild
this is enough update, because it does only store internals
-> This will improve search time for interface requests
}
PInterfaceIdentCacheEntry = ^TInterfaceIdentCacheEntry;
TInterfaceIdentCacheEntry = record
Identifier: PChar;
Node: TCodeTreeNode; // if node = nil then identifier does not exists in
// this interface
CleanPos: integer;
NextEntry: PInterfaceIdentCacheEntry; // used by memory manager
end;
TInterfaceIdentifierCache = class
private
FItems: TAVLTree; // tree of TInterfaceIdentCacheEntry
FTool: TPascalParserTool;
function FindAVLNode(Identifier: PChar): TAVLTreeNode;
public
function FindIdentifier(Identifier: PChar): PInterfaceIdentCacheEntry;
procedure Add(Identifier: PChar; Node: TCodeTreeNode; CleanPos: integer);
procedure Clear;
constructor Create(ATool: TPascalParserTool);
destructor Destroy; override;
property Tool: TPascalParserTool read FTool;
end;
{
2. code tree node cache:
Some nodes (class, interface, implementation, program, type, var, const,
...) contain a node
cache. A node cache caches identifier requests of direct child nodes.
Because node caches can store information of used units, the cahce must be
deleted every time a used unit is changed. Currently all node caches are
resetted every time the GlobalWriteLock increases.
every 'cache' node get a list of
Identifier+CleanBackwardPos+CleanForwardPos -> TFindContext
This information means: if an identifier is searched at a
child node (not sub child node!) within the bounds, the cached
FindContext is valid.
'cache' nodes are:
- section nodes e.g. interface, program, ...
- class nodes
this cache must be deleted, every time the code tree changes, or
one of the used units changes.
}
PCodeTreeNodeCacheEntry = ^TCodeTreeNodeCacheEntry;
TCodeTreeNodeCacheEntry = record
Identifier: PChar;
CleanStartPos: integer;
CleanEndPos: integer;
NewNode: TCodeTreeNode;
NewTool: TPascalParserTool;
NewCleanPos: integer;
NextEntry: PCodeTreeNodeCacheEntry; // used for mem manager
end;
TCodeTreeNodeCache = class
private
FItems: TAVLTree; // tree of PCodeTreeNodeCacheEntry
public
Next: TCodeTreeNodeCache;
function FindLeftMostAVLNode(Identifier: PChar): TAVLTreeNode;
function FindRightMostAVLNode(Identifier: PChar): TAVLTreeNode;
function FindAVLNode(Identifier: PChar; CleanPos: integer): TAVLTreeNode;
function FindAVLNodeInRange(Identifier: PChar;
CleanStartPos, CleanEndPos: integer): TAVLTreeNode;
function Find(Identifier: PChar): PCodeTreeNodeCacheEntry;
procedure Add(Identifier: PChar; CleanStartPos, CleanEndPos: integer;
NewNode: TCodeTreeNode; NewTool: TPascalParserTool; NewCleanPos: integer);
procedure Clear;
constructor Create;
destructor Destroy; override;
end;
//----------------------------------------------------------------------------
TGlobalIdentifierTree = class
private
FItems: TAVLTree; // tree of PChar;
public
function AddCopy(Identifier: PChar): PChar;
function Find(Identifier: PChar): PChar;
procedure Clear;
constructor Create;
destructor Destroy; override;
end;
//----------------------------------------------------------------------------
// Memory Managers
// memory system for PInterfaceIdentCacheEntry(s)
TInterfaceIdentCacheEntryMemManager = class(TCodeToolMemManager)
protected
procedure FreeFirstItem; override;
public
procedure DisposeEntry(Entry: PInterfaceIdentCacheEntry);
function NewEntry: PInterfaceIdentCacheEntry;
end;
// memory system for PCodeTreeNodeCacheEntry(s)
TNodeCacheEntryMemManager = class(TCodeToolMemManager)
protected
procedure FreeFirstItem; override;
public
procedure DisposeEntry(Entry: PCodeTreeNodeCacheEntry);
function NewEntry: PCodeTreeNodeCacheEntry;
end;
// memory system for TCodeTreeNodeCache(s)
TNodeCacheMemManager = class(TCodeToolMemManager)
protected
procedure FreeFirstItem; override;
public
procedure DisposeNode(Node: TCodeTreeNodeCache);
function NewNode: TCodeTreeNodeCache;
end;
var
GlobalIdentifierTree: TGlobalIdentifierTree;
InterfaceIdentCacheEntryMemManager: TInterfaceIdentCacheEntryMemManager;
NodeCacheEntryMemManager: TNodeCacheEntryMemManager;
implementation
{ TNodeCacheEntryMemManager }
procedure TNodeCacheEntryMemManager.DisposeEntry(Entry: PCodeTreeNodeCacheEntry);
begin
if (FFreeCount<FMinFree) or (FFreeCount<((FCount shr 3)*FMaxFreeRatio)) then
begin
// add Entry to Free list
Entry^.NextEntry:=PCodeTreeNodeCacheEntry(FFirstFree);
PCodeTreeNodeCacheEntry(FFirstFree):=Entry;
inc(FFreeCount);
end else begin
// free list full -> free the Entry
Dispose(Entry);
inc(FFreedCount);
end;
dec(FCount);
end;
function TNodeCacheEntryMemManager.NewEntry: PCodeTreeNodeCacheEntry;
begin
if FFirstFree<>nil then begin
// take from free list
Result:=PCodeTreeNodeCacheEntry(FFirstFree);
PCodeTreeNodeCacheEntry(FFirstFree):=Result^.NextEntry;
Result^.NextEntry:=nil;
dec(FFreeCount);
end else begin
// free list empty -> create new Entry
New(Result);
inc(FAllocatedCount);
end;
inc(FCount);
end;
procedure TNodeCacheEntryMemManager.FreeFirstItem;
var Entry: PCodeTreeNodeCacheEntry;
begin
Entry:=PCodeTreeNodeCacheEntry(FFirstFree);
PCodeTreeNodeCacheEntry(FFirstFree):=Entry^.NextEntry;
Dispose(Entry);
end;
{ TInterfaceIdentCacheEntryMemManager }
procedure TInterfaceIdentCacheEntryMemManager.DisposeEntry(
Entry: PInterfaceIdentCacheEntry);
begin
if (FFreeCount<FMinFree) or (FFreeCount<((FCount shr 3)*FMaxFreeRatio)) then
begin
// add Entry to Free list
Entry^.NextEntry:=PInterfaceIdentCacheEntry(FFirstFree);
PInterfaceIdentCacheEntry(FFirstFree):=Entry;
inc(FFreeCount);
end else begin
// free list full -> free the Entry
Dispose(Entry);
inc(FFreedCount);
end;
dec(FCount);
end;
function TInterfaceIdentCacheEntryMemManager.NewEntry: PInterfaceIdentCacheEntry;
begin
if FFirstFree<>nil then begin
// take from free list
Result:=PInterfaceIdentCacheEntry(FFirstFree);
PInterfaceIdentCacheEntry(FFirstFree):=Result^.NextEntry;
Result^.NextEntry:=nil;
dec(FFreeCount);
end else begin
// free list empty -> create new Entry
New(Result);
inc(FAllocatedCount);
end;
inc(FCount);
end;
procedure TInterfaceIdentCacheEntryMemManager.FreeFirstItem;
var Entry: PInterfaceIdentCacheEntry;
begin
Entry:=PInterfaceIdentCacheEntry(FFirstFree);
PInterfaceIdentCacheEntry(FFirstFree):=Entry^.NextEntry;
Dispose(Entry);
end;
{ TInterfaceIdentifierCache }
function CompareTInterfaceIdentCacheEntry(Data1, Data2: Pointer): integer;
begin
Result:=CompareIdentifiers(PInterfaceIdentCacheEntry(Data1)^.Identifier,
PInterfaceIdentCacheEntry(Data2)^.Identifier);
end;
procedure TInterfaceIdentifierCache.Clear;
var
Node: TAVLTreeNode;
Entry: PInterfaceIdentCacheEntry;
begin
if FItems<>nil then begin
Node:=FItems.FindLowest;
while Node<>nil do begin
Entry:=PInterfaceIdentCacheEntry(Node.Data);
InterfaceIdentCacheEntryMemManager.DisposeEntry(Entry);
Node:=FItems.FindSuccessor(Node);
end;
FItems.Clear;
end;
end;
constructor TInterfaceIdentifierCache.Create(ATool: TPascalParserTool);
begin
inherited Create;
FTool:=ATool;
if ATool=nil then
raise Exception.Create('TInterfaceIdentifierCache.Create ATool=nil');
end;
destructor TInterfaceIdentifierCache.Destroy;
begin
Clear;
if FItems<>nil then FItems.Free;
inherited Destroy;
end;
function TInterfaceIdentifierCache.FindAVLNode(Identifier: PChar): TAVLTreeNode;
var
Entry: PInterfaceIdentCacheEntry;
comp: integer;
begin
if FItems<>nil then begin
Result:=FItems.Root;
while Result<>nil do begin
Entry:=PInterfaceIdentCacheEntry(Result.Data);
comp:=CompareIdentifiers(Identifier,Entry^.Identifier);
if comp<0 then
Result:=Result.Left
else if comp>0 then
Result:=Result.Right
else
exit;
end;
end else begin
Result:=nil;
end;
end;
function TInterfaceIdentifierCache.FindIdentifier(Identifier: PChar
): PInterfaceIdentCacheEntry;
var Node: TAVLTreeNode;
begin
Node:=FindAVLNode(Identifier);
if Node<>nil then
Result:=PInterfaceIdentCacheEntry(Node.Data)
else
Result:=nil;
end;
procedure TInterfaceIdentifierCache.Add(Identifier: PChar; Node: TCodeTreeNode;
CleanPos: integer);
var
NewEntry: PInterfaceIdentCacheEntry;
begin
if FItems=nil then
FItems:=TAVLTree.Create(@CompareTInterfaceIdentCacheEntry);
NewEntry:=InterfaceIdentCacheEntryMemManager.NewEntry;
NewEntry^.Identifier:=GlobalIdentifierTree.AddCopy(Identifier);
NewEntry^.Node:=Node;
NewEntry^.CleanPos:=CleanPos;
FItems.Add(NewEntry);
end;
{ TGlobalIdentifierTree }
procedure TGlobalIdentifierTree.Clear;
var Node: TAVLTreeNode;
begin
if FItems<>nil then begin
Node:=FItems.FindLowest;
while Node<>nil do begin
FreeMem(Node.Data);
Node:=FItems.FindSuccessor(Node);
end;
FItems.Clear;
end;
end;
constructor TGlobalIdentifierTree.Create;
begin
inherited Create;
end;
destructor TGlobalIdentifierTree.Destroy;
begin
Clear;
FItems.Free;
inherited Destroy;
end;
function TGlobalIdentifierTree.AddCopy(Identifier: PChar): PChar;
var Len: integer;
begin
Result:=nil;
if (Identifier=nil) or (not IsIdentChar[Identifier[0]]) then exit;
Result:=Find(Identifier);
if Result<>nil then
exit;
Len:=0;
while IsIdentChar[Identifier[Len]] do inc(Len);
GetMem(Result,Len+1);
Move(Identifier^,Result^,Len+1);
if FItems=nil then
FItems:=TAVLTree.Create(TListSortCompare(@CompareIdentifiers));
FItems.Add(Result);
end;
function TGlobalIdentifierTree.Find(Identifier: PChar): PChar;
var
comp: integer;
Node: TAVLTreeNode;
begin
Result:=nil;
if FItems<>nil then begin
Node:=FItems.Root;
while Result<>nil do begin
Result:=PChar(Node.Data);
comp:=CompareIdentifiers(Identifier,Result);
if comp<0 then
Node:=Node.Left
else if comp>0 then
Node:=Node.Right
else
exit;
end;
end;
end;
{ TCodeTreeNodeCache }
function CompareTCodeTreeNodeCacheEntry(Data1, Data2: Pointer): integer;
var Entry1, Entry2: PCodeTreeNodeCacheEntry;
begin
Entry1:=PCodeTreeNodeCacheEntry(Data1);
Entry2:=PCodeTreeNodeCacheEntry(Data2);
Result:=CompareIdentifiers(Entry1^.Identifier,Entry2^.Identifier);
if Result=0 then begin
if Entry1^.CleanStartPos>Entry2^.CleanStartPos then
Result:=-1
else if Entry1^.CleanStartPos<Entry2^.CleanStartPos then
Result:=1
else
Result:=0;
end;
end;
constructor TCodeTreeNodeCache.Create;
begin
inherited Create;
end;
destructor TCodeTreeNodeCache.Destroy;
begin
Clear;
inherited Destroy;
end;
function TCodeTreeNodeCache.FindLeftMostAVLNode(Identifier: PChar): TAVLTreeNode;
// find leftmost avl node with Identifier
var
Entry: PCodeTreeNodeCacheEntry;
Node: TAVLTreeNode;
comp: integer;
begin
if FItems<>nil then begin
Result:=FItems.Root;
while Result<>nil do begin
Entry:=PCodeTreeNodeCacheEntry(Result.Data);
comp:=CompareIdentifiers(Identifier,Entry^.Identifier);
if comp<0 then
Result:=Result.Left
else if comp>0 then
Result:=Result.Right
else begin
repeat
Node:=FItems.FindPrecessor(Result);
if Node<>nil then begin
Entry:=PCodeTreeNodeCacheEntry(Node.Data);
if CompareIdentifiers(Identifier,Entry^.Identifier)=0 then
Result:=Node
else
break;
end else
break;
until false;
exit;
end;
end;
end else begin
Result:=nil;
end;
end;
procedure TCodeTreeNodeCache.Clear;
var
Node: TAVLTreeNode;
Entry: PCodeTreeNodeCacheEntry;
begin
if FItems<>nil then begin
Node:=FItems.FindLowest;
while Node<>nil do begin
Entry:=PCodeTreeNodeCacheEntry(Node.Data);
NodeCacheEntryMemManager.DisposeEntry(Entry);
Node:=FItems.FindSuccessor(Node);
end;
FItems.Clear;
end;
end;
procedure TCodeTreeNodeCache.Add(Identifier: PChar;
CleanStartPos, CleanEndPos: integer;
NewNode: TCodeTreeNode; NewTool: TPascalParserTool; NewCleanPos: integer);
procedure AddNewEntry;
var NewEntry: PCodeTreeNodeCacheEntry;
begin
NewEntry:=NodeCacheEntryMemManager.NewEntry;
NewEntry^.Identifier:=GlobalIdentifierTree.AddCopy(Identifier);
NewEntry^.CleanStartPos:=CleanStartPos;
NewEntry^.CleanEndPos:=CleanEndPos;
NewEntry^.NewNode:=NewNode;
NewEntry^.NewTool:=NewTool;
NewEntry^.NewCleanPos:=NewCleanPos;
FItems.Add(NewEntry);
end;
var
OldEntry: PCodeTreeNodeCacheEntry;
OldNode: TAVLTreeNode;
begin
if CleanStartPos>=CleanEndPos then
raise Exception.Create('[TCodeTreeNodeCache.Add] internal error:'
+' CleanStartPos>=CleanEndPos');
if FItems=nil then
FItems:=TAVLTree.Create(@CompareTCodeTreeNodeCacheEntry);
// if identifier already exists, try to combine them
OldNode:=FindAVLNodeInRange(Identifier,CleanStartPos,CleanEndPos);
if OldNode=nil then begin
// identifier was never searched in this range
AddNewEntry;
end else begin
// identifier was already searched in this range
OldEntry:=PCodeTreeNodeCacheEntry(OldNode.Data);
if (NewNode=OldEntry^.NewNode)
and (NewTool=OldEntry^.NewTool) then
begin
// same FindContext with connected search ranges
// -> combine search ranges
if OldEntry^.CleanStartPos>CleanStartPos then
OldEntry^.CleanStartPos:=CleanStartPos;
if OldEntry^.CleanEndPos<CleanEndPos then
OldEntry^.CleanEndPos:=CleanEndPos;
end else begin
// different FindContext with connected search ranges
if (OldEntry^.CleanStartPos=CleanEndPos)
or (OldEntry^.CleanEndPos=CleanStartPos) then begin
// add new entry
AddNewEntry;
end else begin
raise Exception.Create('[TCodeTreeNodeCache.Add] internal error:'
+' conflicting cache nodes');
end;
end;
end;
end;
function TCodeTreeNodeCache.Find(Identifier: PChar): PCodeTreeNodeCacheEntry;
var Node: TAVLTreeNode;
begin
Node:=FindLeftMostAVLNode(Identifier);
if Node<>nil then begin
Result:=PCodeTreeNodeCacheEntry(Node.Data);
end else begin
Result:=nil;
end;
end;
function TCodeTreeNodeCache.FindAVLNode(Identifier: PChar; CleanPos: integer
): TAVLTreeNode;
begin
Result:=FindAVLNodeInRange(Identifier,CleanPos,CleanPos);
end;
function TCodeTreeNodeCache.FindRightMostAVLNode(Identifier: PChar
): TAVLTreeNode;
// find rightmost avl node with Identifier
var
Entry: PCodeTreeNodeCacheEntry;
Node: TAVLTreeNode;
comp: integer;
begin
if FItems<>nil then begin
Result:=FItems.Root;
while Result<>nil do begin
Entry:=PCodeTreeNodeCacheEntry(Result.Data);
comp:=CompareIdentifiers(Identifier,Entry^.Identifier);
if comp<0 then
Result:=Result.Left
else if comp>0 then
Result:=Result.Right
else begin
repeat
Node:=FItems.FindSuccessor(Result);
if Node<>nil then begin
Entry:=PCodeTreeNodeCacheEntry(Node.Data);
if CompareIdentifiers(Identifier,Entry^.Identifier)=0 then
Result:=Node
else
break;
end else
break;
until false;
exit;
end;
end;
end else begin
Result:=nil;
end;
end;
function TCodeTreeNodeCache.FindAVLNodeInRange(Identifier: PChar;
CleanStartPos, CleanEndPos: integer): TAVLTreeNode;
var
Entry: PCodeTreeNodeCacheEntry;
comp: integer;
begin
if FItems<>nil then begin
Result:=FItems.Root;
while Result<>nil do begin
Entry:=PCodeTreeNodeCacheEntry(Result.Data);
comp:=CompareIdentifiers(Identifier,Entry^.Identifier);
if comp<0 then
Result:=Result.Left
else if comp>0 then
Result:=Result.Right
else begin
repeat
if CleanStartPos>=Entry^.CleanEndPos then
Result:=FItems.FindSuccessor(Result)
else if CleanEndPos<Entry^.CleanStartPos then
Result:=FItems.FindPrecessor(Result)
else
exit;
until Result=nil;
end;
end;
end else begin
Result:=nil;
end;
end;
{ TNodeCacheMemManager }
procedure TNodeCacheMemManager.DisposeNode(Node: TCodeTreeNodeCache);
begin
if (FFreeCount<FMinFree) or (FFreeCount<((FCount shr 3)*FMaxFreeRatio)) then
begin
// add Entry to Free list
Node.Next:=TCodeTreeNodeCache(FFirstFree);
TCodeTreeNodeCache(FFirstFree):=Node;
inc(FFreeCount);
end else begin
// free list full -> free the Node
Node.Free;
inc(FFreedCount);
end;
dec(FCount);
end;
procedure TNodeCacheMemManager.FreeFirstItem;
var Node: TCodeTreeNodeCache;
begin
Node:=TCodeTreeNodeCache(FFirstFree);
TCodeTreeNodeCache(FFirstFree):=Node.Next;
Node.Free;
end;
function TNodeCacheMemManager.NewNode: TCodeTreeNodeCache;
begin
if FFirstFree<>nil then begin
// take from free list
Result:=TCodeTreeNodeCache(FFirstFree);
TCodeTreeNodeCache(FFirstFree):=Result.Next;
Result.Clear;
dec(FFreeCount);
end else begin
// free list empty -> create new Entry
Result:=TCodeTreeNodeCache.Create;
inc(FAllocatedCount);
end;
inc(FCount);
end;
//------------------------------------------------------------------------------
procedure InternalInit;
begin
GlobalIdentifierTree:=TGlobalIdentifierTree.Create;
InterfaceIdentCacheEntryMemManager:=TInterfaceIdentCacheEntryMemManager.Create;
end;
procedure InternalFinal;
begin
GlobalIdentifierTree.Free;
GlobalIdentifierTree:=nil;
InterfaceIdentCacheEntryMemManager.Free;
InterfaceIdentCacheEntryMemManager:=nil;
end;
initialization
InternalInit;
finalization
InternalFinal;
end.

400
components/codetools/finddeclarationtool.pas
View File

@ -28,51 +28,6 @@
ToDo:
- many things, search for 'ToDo'
- Mass Search: searching a compatible proc will result in searching every
parameter type of every reachable proc
(implementation section + interface section
+ used interface sections + class and ancestor methods)
How can this be achieved in good time?
-> Caching
- Caching:
1. interface cache:
Every FindIdentifierInInterface call should be cached
- stores: Identifier -> Node+CleanPos
- cache must be deleted, everytime the codetree is rebuild
this is enough update, because it does only store internals
-> This will improve access time to all precompiled packages
but still not fast enough.
2. dynamic cache:
searching a compatible proc not by name, but by parameter type list
results in the following:
given a library with 500 procs with 2 integer parameters, will
result in 1.000.000 checks for 'integer', before the interface
cache of objpas points to longint. Then longint will be searched
in objpas (>100 checks), before the system.pp interface cache is
asked. Total: 1.100.000 checks.
Hence, the result of a search should be saved:
every 'cache' node get a list of
Identifier+CleanBackwardPos+CleanForwardPos -> TFindContext
This information means: if an identifier is searched at a
child node (not sub child node!) within the bounds, the cached
FindContext is valid.
'cache' nodes are:
- section nodes e.g. interface, program, ...
- class nodes
this cache must be deleted, every time the code tree changes, or
one of the used units changes.
Where:
For each section node (Interface, Implementation, ...)
For each BeginBlock
Entries: (What, Declaration Pos)
What: Identifier -> Ansistring (to reduce memory usage,
maintain a list of all identifier ansistrings)
Pos: Code+SrcPos
1. Source: TCodeTreeNode
2. PPU, PPW, DCU, ...
}
unit FindDeclarationTool;
@ -97,7 +52,7 @@ uses
{$ENDIF}
Classes, SysUtils, CodeTree, CodeAtom, CustomCodeTool, SourceLog,
KeywordFuncLists, BasicCodeTools, LinkScanner, CodeCache, AVL_Tree, TypInfo,
PascalParserTool, FileProcs, DefineTemplates;
PascalParserTool, FileProcs, DefineTemplates, FindDeclarationCache;
type
TFindDeclarationTool = class;
@ -216,40 +171,6 @@ type
end;
type
{ Caching
1. interface cache:
Every FindIdentifierInInterface call is cached
- stores: Identifier -> Node+CleanPos
- cache must be deleted, everytime the codetree is rebuild
this is enough update, because it does only store internals
-> This will improve access time to all precompiled packages
but still not fast enough.
}
PInterfaceIdentCacheEntry = ^TInterfaceIdentCacheEntry;
TInterfaceIdentCacheEntry = record
Identifier: PChar;
Node: TCodeTreeNode; // if node = nil then identifier does not exists in
// this interface
CleanPos: integer;
NextEntry: PInterfaceIdentCacheEntry; // used by memory manager
end;
TInterfaceIdentifierCache = class
private
FItems: TAVLTree; // tree of TInterfaceIdentCacheEntry
FTool: TFindDeclarationTool;
function FindAVLNode(Identifier: PChar): TAVLTreeNode;
public
function FindIdentifier(Identifier: PChar): PInterfaceIdentCacheEntry;
procedure Add(Identifier: PChar; Node: TCodeTreeNode; CleanPos: integer);
procedure Clear;
constructor Create(ATool: TFindDeclarationTool);
destructor Destroy; override;
property Tool: TFindDeclarationTool read FTool;
end;
//---------------------------------------------------------------------------
TIdentifierFoundResult = (ifrProceedSearch, ifrAbortSearch, ifrSuccess);
@ -395,20 +316,6 @@ type
read FOnGetUnitSourceSearchPath write FOnGetUnitSourceSearchPath;
end;
//----------------------------------------------------------------------------
TGlobalIdentifierTree = class
private
FItems: TAVLTree; // tree of PChar;
public
function AddCopy(Identifier: PChar): PChar;
function Find(Identifier: PChar): PChar;
procedure Clear;
constructor Create;
destructor Destroy; override;
end;
var GlobalIdentifierTree: TGlobalIdentifierTree;
implementation
@ -422,117 +329,6 @@ const
fdfDefaultForExpressions = [fdfSearchInParentNodes,fdfSearchInAncestors,
fdfExceptionOnNotFound]+fdfAllClassVisibilities;
type
// memory system for PInterfaceIdentCacheEntry(s)
TInterfaceIdentCacheEntryMemManager = class
private
FFirstFree: PInterfaceIdentCacheEntry;
FFreeCount: integer;
FCount: integer;
FMinFree: integer;
FMaxFreeRatio: integer;
FAllocatedCount: integer;
FFreedCount: integer;
procedure SetMaxFreeRatio(NewValue: integer);
procedure SetMinFree(NewValue: integer);
public
procedure DisposeEntry(Entry: PInterfaceIdentCacheEntry);
function NewEntry: PInterfaceIdentCacheEntry;
property MinimumFreeCount: integer read FMinFree write SetMinFree;
property MaximumFreeRatio: integer
read FMaxFreeRatio write SetMaxFreeRatio; // in one eighth steps
property Count: integer read FCount;
property FreeCount: integer read FFreeCount;
property AllocatedCount: integer read FAllocatedCount;
property FreedCount: integer read FFreedCount;
procedure Clear;
constructor Create;
destructor Destroy; override;
end;
var
InterfaceIdentCacheEntryMemManager: TInterfaceIdentCacheEntryMemManager;
{ TInterfaceIdentCacheEntryMemManager }
procedure TInterfaceIdentCacheEntryMemManager.Clear;
var Entry: PInterfaceIdentCacheEntry;
begin
while FFirstFree<>nil do begin
Entry:=FFirstFree;
FFirstFree:=FFirstFree^.NextEntry;
Entry^.NextEntry:=nil;
Dispose(Entry);
inc(FFreedCount);
end;
FFreeCount:=0;
end;
constructor TInterfaceIdentCacheEntryMemManager.Create;
begin
inherited Create;
FFirstFree:=nil;
FFreeCount:=0;
FCount:=0;
FAllocatedCount:=0;
FFreedCount:=0;
FMinFree:=100000;
FMaxFreeRatio:=8; // 1:1
end;
destructor TInterfaceIdentCacheEntryMemManager.Destroy;
begin
Clear;
inherited Destroy;
end;
procedure TInterfaceIdentCacheEntryMemManager.DisposeEntry(
Entry: PInterfaceIdentCacheEntry);
begin
if (FFreeCount<FMinFree) or (FFreeCount<((FCount shr 3)*FMaxFreeRatio)) then
begin
// add Entry to Free list
Entry^.NextEntry:=FFirstFree;
FFirstFree:=Entry;
inc(FFreeCount);
end else begin
// free list full -> free the Entry
Dispose(Entry);
inc(FFreedCount);
end;
dec(FCount);
end;
function TInterfaceIdentCacheEntryMemManager.NewEntry: PInterfaceIdentCacheEntry;
begin
if FFirstFree<>nil then begin
// take from free list
Result:=FFirstFree;
FFirstFree:=FFirstFree^.NextEntry;
Result^.NextEntry:=nil;
dec(FFreeCount);
end else begin
// free list empty -> create new Entry
New(Result);
inc(FAllocatedCount);
end;
inc(FCount);
end;
procedure TInterfaceIdentCacheEntryMemManager.SetMaxFreeRatio(NewValue: integer);
begin
if NewValue<0 then NewValue:=0;
if NewValue=FMaxFreeRatio then exit;
FMaxFreeRatio:=NewValue;
end;
procedure TInterfaceIdentCacheEntryMemManager.SetMinFree(NewValue: integer);
begin
if NewValue<0 then NewValue:=0;
if NewValue=FMinFree then exit;
FMinFree:=NewValue;
end;
{ TFindContext }
@ -608,6 +404,8 @@ writeln('TFindDeclarationTool.FindDeclaration D CursorNode=',NodeDescriptionAsSt
BuildSubTreeForBeginBlock(CursorNode);
CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
end;
if CursorNode.Desc=ctnProcedureHead then
CursorNode:=CursorNode.Parent;
MoveCursorToCleanPos(CleanCursorPos);
while (CurPos.StartPos>1) and (IsIdentChar[Src[CurPos.StartPos-1]]) do
dec(CurPos.StartPos);
@ -2563,13 +2361,12 @@ writeln('[TFindDeclarationTool.FindIdentifierInInterface] Ident already in cache
{$ENDIF}
if CacheEntry^.Node=nil then begin
// identifier not in this interface
exit;
end else begin
// identifier in this interface found
Params.SetResult(Self,CacheEntry^.Node,CacheEntry^.CleanPos);
Result:=true;
exit;
end;
exit;
end;
end;
@ -2605,10 +2402,16 @@ writeln('[TFindDeclarationTool.FindIdentifierInInterface] Ident already in cache
// save result in cache
if FInterfaceIdentifierCache=nil then
FInterfaceIdentifierCache:=TInterfaceIdentifierCache.Create(Self);
if Result then
FInterfaceIdentifierCache.Add(OldInput.Identifier,Params.NewNode,
Params.NewCleanPos)
else
if Result then begin
// identifier exists in interface
if (Params.NewNode.Desc<>ctnProcedure) then begin
FInterfaceIdentifierCache.Add(OldInput.Identifier,Params.NewNode,
Params.NewCleanPos);
end else begin
// do not save proc identifiers.
end;
end else
// identifier does not exist in interface
FInterfaceIdentifierCache.Add(OldInput.Identifier,nil,-1);
end;
@ -3761,181 +3564,6 @@ begin
Items[Count-1]:=ExprType;
end;
{ TInterfaceIdentifierCache }
function CompareTInterfaceIdentCacheEntry(Data1, Data2: Pointer): integer;
begin
Result:=CompareIdentifiers(PInterfaceIdentCacheEntry(Data1)^.Identifier,
PInterfaceIdentCacheEntry(Data2)^.Identifier);
end;
procedure TInterfaceIdentifierCache.Clear;
var
Node: TAVLTreeNode;
Entry: PInterfaceIdentCacheEntry;
begin
if FItems<>nil then begin
Node:=FItems.FindLowest;
while Node<>nil do begin
Entry:=PInterfaceIdentCacheEntry(Node.Data);
InterfaceIdentCacheEntryMemManager.DisposeEntry(Entry);
Node:=FItems.FindSuccessor(Node);
end;
FItems.Clear;
end;
end;
constructor TInterfaceIdentifierCache.Create(ATool: TFindDeclarationTool);
begin
inherited Create;
FTool:=ATool;
if ATool=nil then
raise Exception.Create('TInterfaceIdentifierCache.Create ATool=nil');
end;
destructor TInterfaceIdentifierCache.Destroy;
begin
Clear;
if FItems<>nil then FItems.Free;
inherited Destroy;
end;
function TInterfaceIdentifierCache.FindAVLNode(Identifier: PChar): TAVLTreeNode;
var
Entry: PInterfaceIdentCacheEntry;
comp: integer;
begin
if FItems<>nil then begin
Result:=FItems.Root;
while Result<>nil do begin
Entry:=PInterfaceIdentCacheEntry(Result.Data);
comp:=CompareIdentifiers(Identifier,Entry^.Identifier);
if comp<0 then
Result:=Result.Left
else if comp>0 then
Result:=Result.Right
else
exit;
end;
end else begin
Result:=nil;
end;
end;
function TInterfaceIdentifierCache.FindIdentifier(Identifier: PChar
): PInterfaceIdentCacheEntry;
var Node: TAVLTreeNode;
begin
Node:=FindAVLNode(Identifier);
if Node<>nil then
Result:=PInterfaceIdentCacheEntry(Node.Data)
else
Result:=nil;
end;
procedure TInterfaceIdentifierCache.Add(Identifier: PChar; Node: TCodeTreeNode;
CleanPos: integer);
var
NewEntry: PInterfaceIdentCacheEntry;
begin
if FItems=nil then
FItems:=TAVLTree.Create(@CompareTInterfaceIdentCacheEntry);
NewEntry:=InterfaceIdentCacheEntryMemManager.NewEntry;
NewEntry^.Identifier:=GlobalIdentifierTree.AddCopy(Identifier);
NewEntry^.Node:=Node;
NewEntry^.CleanPos:=CleanPos;
FItems.Add(NewEntry);
end;
{ TGlobalIdentifierTree }
procedure TGlobalIdentifierTree.Clear;
var Node: TAVLTreeNode;
begin
if FItems<>nil then begin
Node:=FItems.FindLowest;
while Node<>nil do begin
FreeMem(Node.Data);
Node:=FItems.FindSuccessor(Node);
end;
FItems.Clear;
end;
end;
constructor TGlobalIdentifierTree.Create;
begin
inherited Create;
end;
destructor TGlobalIdentifierTree.Destroy;
begin
Clear;
FItems.Free;
inherited Destroy;
end;
function TGlobalIdentifierTree.AddCopy(Identifier: PChar): PChar;
var Len: integer;
begin
Result:=nil;
if (Identifier=nil) or (not IsIdentChar[Identifier[0]]) then exit;
Result:=Find(Identifier);
if Result<>nil then
exit;
Len:=0;
while IsIdentChar[Identifier[Len]] do inc(Len);
GetMem(Result,Len+1);
Move(Identifier^,Result^,Len+1);
if FItems=nil then
FItems:=TAVLTree.Create(TListSortCompare(@CompareIdentifiers));
FItems.Add(Result);
end;
function TGlobalIdentifierTree.Find(Identifier: PChar): PChar;
var
comp: integer;
Node: TAVLTreeNode;
begin
Result:=nil;
if FItems<>nil then begin
Node:=FItems.Root;
while Result<>nil do begin
Result:=PChar(Node.Data);
comp:=CompareIdentifiers(Identifier,Result);
if comp<0 then
Node:=Node.Left
else if comp>0 then
Node:=Node.Right
else
exit;
end;
end;
end;
//------------------------------------------------------------------------------
procedure InternalInit;
begin
GlobalIdentifierTree:=TGlobalIdentifierTree.Create;
InterfaceIdentCacheEntryMemManager:=TInterfaceIdentCacheEntryMemManager.Create;
end;
procedure InternalFinal;
begin
GlobalIdentifierTree.Free;
GlobalIdentifierTree:=nil;
InterfaceIdentCacheEntryMemManager.Free;
InterfaceIdentCacheEntryMemManager:=nil;
end;
initialization
InternalInit;
finalization
InternalFinal;
end.