diff --git a/.gitattributes b/.gitattributes index 93c60274a3..0bd23224bc 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/components/codetools/allcodetoolunits.pp b/components/codetools/allcodetoolunits.pp index 584103e2c0..2a829bee72 100644 --- a/components/codetools/allcodetoolunits.pp +++ b/components/codetools/allcodetoolunits.pp @@ -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 diff --git a/components/codetools/codetoolmemmanager.pas b/components/codetools/codetoolmemmanager.pas new file mode 100644 index 0000000000..008a0a8b63 --- /dev/null +++ b/components/codetools/codetoolmemmanager.pas @@ -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 . 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 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. + diff --git a/components/codetools/codetree.pas b/components/codetools/codetree.pas index 60d871d0ab..5a9d242934 100644 --- a/components/codetools/codetree.pas +++ b/components/codetools/codetree.pas @@ -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; //----------------------------------------------------------------------------- diff --git a/components/codetools/finddeclarationcache.pas b/components/codetools/finddeclarationcache.pas new file mode 100644 index 0000000000..fe3629cf50 --- /dev/null +++ b/components/codetools/finddeclarationcache.pas @@ -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 . 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 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 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^.CleanStartPosnil 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^.CleanEndPosnil 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 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. + diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index eb5cab9f91..da82786945 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/components/codetools/finddeclarationtool.pas @@ -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 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.