diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index 10a2afbe3d..e630e639c8 100644 --- a/components/codetools/codetoolmanager.pas +++ b/components/codetools/codetoolmanager.pas @@ -469,8 +469,6 @@ begin end; FCurCodeTool:=TCodeCompletionCodeTool(GetCodeToolForSource(MainCode,true)); FCurCodeTool.ErrorPosition.Code:=nil; - FCurCodeTool.OnSetGlobalWriteLock:=@OnToolSetWriteLock; - FCurCodeTool.OnGetGlobalWriteLockInfo:=@OnToolGetWriteLockInfo; {$IFDEF CTDEBUG} writeln('[TCodeToolManager.InitCurCodeTool] ',Code.Filename,' ',Code.SourceLength); {$ENDIF} @@ -1358,6 +1356,8 @@ begin Result.JumpCentered:=FJumpCentered; Result.CursorBeyondEOL:=FCursorBeyondEOL; TFindDeclarationTool(Result).OnGetCodeToolForBuffer:=@OnGetCodeToolForBuffer; + Result.OnSetGlobalWriteLock:=@OnToolSetWriteLock; + Result.OnGetGlobalWriteLockInfo:=@OnToolGetWriteLockInfo; end; function TCodeToolManager.OnGetCodeToolForBuffer(Sender: TObject; @@ -1393,6 +1393,7 @@ procedure TCodeToolManager.OnToolGetWriteLockInfo(var WriteLockIsSet: boolean; begin WriteLockIsSet:=FWriteLockCount>0; WriteLockStep:=FWriteLockStep; +//writeln(' FWriteLockCount=',FWriteLockCount,' FWriteLockStep=',FWriteLockStep); end; procedure TCodeToolManager.OnToolSetWriteLock(Lock: boolean); diff --git a/components/codetools/customcodetool.pas b/components/codetools/customcodetool.pas index 560dfa4402..03046ecf15 100644 --- a/components/codetools/customcodetool.pas +++ b/components/codetools/customcodetool.pas @@ -78,6 +78,7 @@ type ErrorPosition: TCodeXYPosition; property Scanner: TLinkScanner read FScanner write SetScanner; + function MainFilename: string; function FindDeepestNodeAtPos(P: integer; ExceptionOnNotFound: boolean): TCodeTreeNode; @@ -1481,6 +1482,14 @@ begin if Assigned(OnSetGlobalWriteLock) then OnSetGlobalWriteLock(false); end; +function TCustomCodeTool.MainFilename: string; +begin + if (Scanner<>nil) and (Scanner.MainCode<>nil) then + Result:=TCodeBuffer(Scanner.MainCode).Filename + else + Result:='(unknown mainfilename)'; +end; + { ECodeToolError } constructor ECodeToolError.Create(ASender: TCustomCodeTool; diff --git a/components/codetools/finddeclarationcache.pas b/components/codetools/finddeclarationcache.pas index 8cba41bdad..4f0ed99dce 100644 --- a/components/codetools/finddeclarationcache.pas +++ b/components/codetools/finddeclarationcache.pas @@ -70,30 +70,31 @@ type { 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 + Some nodes (class, proc, record) contain a node cache. A node cache caches + search results of searched identifiers for child nodes. + + Every entry in the node cache describes the following relationship: + Identifier+Range -> Source Position + and can be interpreted as: + Identifier is a PChar to the beginning of an identifier string. + Range is a clenaed source range (CleanStartPos-CleanEndPos). + Source position is a tuple of NewTool, NewNode, NewCleanPos. + If the current context node is a child of a caching node and it is in the + range, then the result is valid. If NewNode=nil then there is no such + identifier valid at the context node. + + Every node that define local identifiers contains a node cache. + These are: class, proc, record, withstatement + + Because node caches can store information of used units, the cache 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. - - - - - } +const + AllNodeCacheDescs = [ctnClass, ctnProcedure, ctnRecordType, ctnWithStatement]; + +type PCodeTreeNodeCacheEntry = ^TCodeTreeNodeCacheEntry; TCodeTreeNodeCacheEntry = record Identifier: PChar; @@ -116,6 +117,8 @@ type function FindAVLNode(Identifier: PChar; CleanPos: integer): TAVLTreeNode; function FindAVLNodeInRange(Identifier: PChar; CleanStartPos, CleanEndPos: integer): TAVLTreeNode; + function FindInRange(Identifier: PChar; + CleanStartPos, CleanEndPos: integer): PCodeTreeNodeCacheEntry; function FindNearestAVLNode(Identifier: PChar; CleanStartPos, CleanEndPos: integer; InFront: boolean): TAVLTreeNode; function FindNearest(Identifier: PChar; @@ -132,11 +135,15 @@ type procedure WriteDebugReport(const Prefix: string); function ConsistencyCheck: integer; end; - -const - // all node types which can hold a cache - AllNodeCacheDescs = [ctnClass, ctnInterface, ctnInitialization, ctnProgram]; + { + 3. Base type node cache + + ToDo: + + } + + //---------------------------------------------------------------------------- type TGlobalIdentifierTree = class @@ -473,7 +480,7 @@ end; constructor TCodeTreeNodeCache.Create(AnOwner: TCodeTreeNode); begin inherited Create; - Owner:=AnOwner; + if AnOwner<>nil then BindToOwner(AnOwner); end; destructor TCodeTreeNodeCache.Destroy; @@ -652,11 +659,13 @@ var Entry: PCodeTreeNodeCacheEntry; begin Result:=FindNearestAVLNode(Identifier,CleanStartPos,CleanEndPos,true); - Entry:=PCodeTreeNodeCacheEntry(Result.Data); - if (CleanStartPos>Entry^.CleanEndPos) - or (CleanEndPosnil then begin + Entry:=PCodeTreeNodeCacheEntry(Result.Data); + if (CleanStartPos>Entry^.CleanEndPos) + or (CleanEndPos check range - NextNode:=Result; if CleanStartPos>=Entry^.CleanEndPos then begin NextNode:=FItems.FindSuccessor(Result); DirectionSucc:=true; @@ -698,7 +706,6 @@ begin while (NextNode<>nil) do begin Entry:=PCodeTreeNodeCacheEntry(NextNode.Data); if CompareIdentifiers(Identifier,Entry^.Identifier)<>0 then begin - Result:=nil; exit; end; Result:=NextNode; @@ -712,6 +719,7 @@ begin else NextNode:=FItems.FindPrecessor(Result); end; + exit; end; end; end else begin @@ -787,6 +795,17 @@ begin Result:=nil; end; +function TCodeTreeNodeCache.FindInRange(Identifier: PChar; CleanStartPos, + CleanEndPos: integer): PCodeTreeNodeCacheEntry; +var Node: TAVLTreeNode; +begin + Node:=FindAVLNodeInRange(Identifier,CleanStartPos,CleanEndPos); + if Node<>nil then + Result:=PCodeTreeNodeCacheEntry(Node.Data) + else + Result:=nil; +end; + { TNodeCacheMemManager } procedure TNodeCacheMemManager.DisposeNode(Node: TCodeTreeNodeCache); diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index 67e5a7485b..8baf26a0d7 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/components/codetools/finddeclarationtool.pas @@ -45,6 +45,7 @@ interface { $DEFINE ShowExprEval} { $DEFINE ShowFoundIdentifier} { $DEFINE ShowCachedIdentifiers} +{ $DEFINE ShowNodeCache} uses {$IFDEF MEM_CHECK} @@ -230,6 +231,7 @@ type FOnGetUnitSourceSearchPath: TOnGetSearchPath; FFirstNodeCache: TCodeTreeNodeCache; FLastNodeCachesGlobalWriteLockStep: integer; + FRootNodeCache: TCodeTreeNodeCache; {$IFDEF CTDEBUG} DebugPrefix: string; procedure IncPrefix; @@ -277,6 +279,12 @@ type protected procedure DoDeleteNodes; override; procedure ClearNodeCaches(Force: boolean); + function CreateNewNodeCache(Node: TCodeTreeNode): TCodeTreeNodeCache; + function GetNodeCache(Node: TCodeTreeNode; + CreateIfNotExists: boolean): TCodeTreeNodeCache; + procedure AddResultToNodeCaches(Identifier: PChar; + StartNode, EndNode: TCodeTreeNode; SearchedForward: boolean; + Params: TFindDeclarationParams); function FindDeclarationOfIdentifier( Params: TFindDeclarationParams): boolean; function FindContextNodeAtCursor( @@ -339,7 +347,7 @@ const fdfClassPrivate]; fdfGlobals = [fdfExceptionOnNotFound, fdfIgnoreUsedUnits]; fdfGlobalsSameIdent = fdfGlobals+[fdfIgnoreMissingParams,fdfFirstIdentFound, - fdfOnlyCompatibleProc]; + fdfOnlyCompatibleProc,fdfSearchInAncestors]; fdfDefaultForExpressions = [fdfSearchInParentNodes,fdfSearchInAncestors, fdfExceptionOnNotFound]+fdfAllClassVisibilities; @@ -430,6 +438,10 @@ writeln('TFindDeclarationTool.FindDeclaration D CursorNode=',NodeDescriptionAsSt end; if CursorNode.Desc=ctnProcedureHead then CursorNode:=CursorNode.Parent; + if CursorNode.Desc=ctnProcedure then begin + BuildSubTreeForProcHead(CursorNode); + CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true); + end; MoveCursorToCleanPos(CleanCursorPos); while (CurPos.StartPos>1) and (IsIdentChar[Src[CurPos.StartPos-1]]) do dec(CurPos.StartPos); @@ -787,40 +799,41 @@ function TFindDeclarationTool.FindIdentifierInContext( var LastContextNode, StartContextNode, ContextNode: TCodeTreeNode; IsForward: boolean; IdentifierFoundResult: TIdentifierFoundResult; - ParentsNodeCache: TCodeTreeNodeCache; - NearestNodeCacheEntry: PCodeTreeNodeCacheEntry; - + LastNodeCache: TCodeTreeNodeCache; + LastCacheEntry: PCodeTreeNodeCacheEntry; + function FindInNodeCache: boolean; - var Node: TCodeTreeNode; + var + NodeCache: TCodeTreeNodeCache; begin Result:=false; - Node:=ContextNode.Parent; - if (Node<>nil) and (Node.Desc in [ctnClassPublic,ctnClassPrivate, - ctnClassProtected,ctnClassPublished]) - then - Node:=Node.Parent; - if (Node<>nil) and (Node.Cache<>nil) then begin - // parent node has a cache object - if (Node.Cache is TCodeTreeNodeCache) then begin - // parent has node cache - // -> search if result already in cache - if ParentsNodeCache<>TCodeTreeNodeCache(Node.Cache) then begin - // parent cache changed -> search new nearest node - ParentsNodeCache:=TCodeTreeNodeCache(Node.Cache); - NearestNodeCacheEntry:=ParentsNodeCache.FindNearest( - Params.Identifier, - ContextNode.StartPos,ContextNode.EndPos, - not (fdfSearchForward in Params.Flags)); - end; - if (NearestNodeCacheEntry<>nil) - and (NearestNodeCacheEntry^.CleanStartPosContextNode.StartPos) then begin - // cached result found - Params.SetResult(NearestNodeCacheEntry); - Result:=true; - exit; - end; - end; + NodeCache:=GetNodeCache(ContextNode,false); + if (NodeCache<>LastNodeCache) then begin + // NodeCache changed -> search nearest cache entry for the identifier + LastNodeCache:=NodeCache; + if NodeCache<>nil then begin + LastCacheEntry:=NodeCache.FindNearest(Params.identifier, + ContextNode.StartPos,ContextNode.EndPos, + not (fdfSearchForward in Params.Flags)); + end else + LastCacheEntry:=nil; + end; + if (LastCacheEntry<>nil) + and (LastCacheEntry^.CleanStartPosContextNode.StartPos) + then begin + // cached result found + Params.SetResult(LastCacheEntry); + {$IFDEF ShowNodeCache} + writeln(':::: TFindDeclarationTool.FindIdentifierInContext.FindInNodeCache'); + writeln(' Ident=',GetIdentifier(Params.Identifier), + ' ContextNode=',ContextNode.DescAsString, + ' Self=',MainFilename); + if (Params.NewNode<>nil) then + writeln(' NewTool=',Params.NewCodeTool.MainFilename, + ' NewNode=',Params.NewNode.DescAsString); + {$ENDIF} + Result:=true; end; end; @@ -828,14 +841,13 @@ begin ContextNode:=Params.ContextNode; StartContextNode:=ContextNode; Result:=false; - - if ContextNode<>nil then begin - - // initialize cache search - ParentsNodeCache:=nil; - NearestNodeCacheEntry:=nil; - - // search ... + if ContextNode=nil then begin + RaiseException('[TFindDeclarationTool.FindIdentifierInContext] ' + +' internal error: Params.ContextNode=nil'); + end; + try + LastNodeCache:=nil; + LastCacheEntry:=nil; repeat {$IFDEF ShowTriedContexts} writeln('[TFindDeclarationTool.FindIdentifierInContext] A Ident=', @@ -849,8 +861,10 @@ if (ContextNode.Desc=ctnClass) then writeln(' ContextNode.LastChild=',ContextNode.LastChild<>nil); {$ENDIF} // search in cache - Result:=FindInNodeCache; - if Result then exit; + if FindInNodeCache then begin + Result:=(Params.NewNode<>nil); + exit; + end; // search identifier in current context LastContextNode:=ContextNode; @@ -864,6 +878,9 @@ if (ContextNode.Desc=ctnClass) then ctnRecordType, ctnRecordCase, ctnRecordVariant, ctnParameterList: begin + // these nodes build a parent-child relationship. But in pascal + // they just define a range and not a context. + // -> search in all childs if ContextNode.Desc=ctnClass then begin // just-in-time parsing for class node BuildSubTreeForClass(ContextNode); @@ -1093,9 +1110,19 @@ writeln('[TFindDeclarationTool.FindIdentifierInContext] Searching in Parent Con until false; end; until ContextNode=nil; - end else begin - // DeepestNode=nil -> ignore + + finally + if Result and (not (fdfDoNotCache in Params.NewFlags)) then begin + // add result to caches + AddResultToNodeCaches(Params.Identifier,StartContextNode,ContextNode, + fdfSearchForward in Params.Flags,Params); + end; end; + // if we are here, the identifier was not found + // add result to cache + AddResultToNodeCaches(Params.Identifier,StartContextNode,ContextNode, + fdfSearchForward in Params.Flags,nil); + if fdfExceptionOnNotFound in Params.Flags then begin if Params.IdentifierTool.IsPCharInSrc(Params.Identifier) then Params.IdentifierTool.MoveCursorToCleanPos(Params.Identifier); @@ -1593,7 +1620,7 @@ begin end; AddNodeToStack(@NodeStack,Result.Node); {$IFDEF ShowTriedContexts} -writeln('[TFindDeclarationTool.FindBaseTypeOfNode] LOOP Result=',Result.Node.DescAsString); +writeln('[TFindDeclarationTool.FindBaseTypeOfNode] LOOP Result=',Result.Node.DescAsString,' ',HexStr(Cardinal(Result.Node),8)); {$ENDIF} if (Result.Node.Desc in AllIdentifierDefinitions) then begin // instead of variable/const/type definition, return the type @@ -1603,10 +1630,12 @@ writeln('[TFindDeclarationTool.FindBaseTypeOfNode] LOOP Result=',Result.Node.Des and ((Result.Node.SubDesc and ctnsForwardDeclaration)>0) then begin // search the real class - +{$IFDEF ShowTriedContexts} +writeln('[TFindDeclarationTool.FindBaseTypeOfNode] Class is forward'); +{$ENDIF} + // ToDo: check for circles in ancestor chain - - + ClassIdentNode:=Result.Node.Parent; if (ClassIdentNode=nil) or (not (ClassIdentNode.Desc=ctnTypeDefinition)) then begin @@ -1619,7 +1648,8 @@ writeln('[TFindDeclarationTool.FindBaseTypeOfNode] LOOP Result=',Result.Node.Des Params.SetIdentifier(Self,@Src[ClassIdentNode.StartPos], @CheckSrcIdentifier); Params.Flags:=[fdfSearchInParentNodes,fdfSearchForward, - fdfIgnoreUsedUnits,fdfExceptionOnNotFound] + fdfIgnoreUsedUnits,fdfExceptionOnNotFound, + fdfIgnoreCurContextNode] +(fdfGlobals*Params.Flags); Params.ContextNode:=ClassIdentNode; FindIdentifierInContext(Params); @@ -2434,6 +2464,7 @@ writeln(DebugPrefix,'TFindDeclarationTool.FindIdentifierInInterface', // ToDo: build codetree for ppu, ppw, dcu files // build tree for pascal source + ClearNodeCaches(false); BuildTree(true); // search identifier in cache @@ -3112,6 +3143,7 @@ writeln('[TFindDeclarationTool.CheckSrcIdentifier]', Params.IdentifierTool.ReadNextAtom; ExprInputList:=Params.IdentifierTool.CreateParamExprList( Params.IdentifierTool.CurPos.EndPos,Params); + Params.Load(OldInput); // create compatibility lists CompListSize:=SizeOf(TTypeCompatibility)*ExprInputList.Count; if CompListSize>0 then begin @@ -3121,7 +3153,6 @@ writeln('[TFindDeclarationTool.CheckSrcIdentifier]', BestCompatibilityList:=nil; CurCompatibilityList:=nil; end; - Params.Load(OldInput); try Include(Params.Flags,fdfFirstIdentFound); // check the first proc for compatibility @@ -3550,7 +3581,7 @@ begin exit; end else begin // this is the first check in this GlobalWriteLockStep - FLastNodecachesGlobalWriteLockStep:=GlobalWriteLockStep; + FLastNodeCachesGlobalWriteLockStep:=GlobalWriteLockStep; // proceed normally ... end; end; @@ -3561,6 +3592,10 @@ begin FFirstNodeCache:=NodeCache.Next; NodeCacheMemManager.DisposeNode(NodeCache); end; + if FRootNodeCache<>nil then begin + NodeCacheMemManager.DisposeNode(FRootNodeCache); + FRootNodeCache:=nil; + end; end; function TFindDeclarationTool.ConsistencyCheck: integer; @@ -3588,6 +3623,102 @@ begin ClearNodeCaches(false); end; +function TFindDeclarationTool.GetNodeCache(Node: TCodeTreeNode; + CreateIfNotExists: boolean): TCodeTreeNodeCache; +begin + while (Node<>nil) and (not (Node.Desc in AllNodeCacheDescs)) do + Node:=Node.Parent; + if Node<>nil then begin + if (Node.Cache=nil) and CreateIfNotExists then + CreateNewNodeCache(Node); + if (Node.Cache<>nil) and (Node.Cache is TCodeTreeNodeCache) then + Result:=TCodeTreeNodeCache(Node.Cache) + else + Result:=nil; + end else begin + if (FRootNodeCache=nil) and CreateIfNotExists then + FRootNodeCache:=CreateNewNodeCache(nil); + Result:=FRootNodeCache; + end; +end; + +procedure TFindDeclarationTool.AddResultToNodeCaches(Identifier: PChar; + StartNode, EndNode: TCodeTreeNode; SearchedForward: boolean; + Params: TFindDeclarationParams); +var Node: TCodeTreeNode; + CurNodeCache, LastNodeCache: TCodeTreeNodeCache; + CleanStartPos, CleanEndPos: integer; + NewNode: TCodeTreeNode; + NewTool: TPascalParserTool; + NewCleanPos: integer; +begin +{$IFDEF ShowNodeCache} +write('TFindDeclarationTool.AddResultToNodeCaches ', +' Ident=',GetIdentifier(Identifier), +' StartNode=',StartNode.DescAsString,'="',copy(Src,StartNode.StartPos,12),'"'); +if EndNode<>nil then + write(' EndNode=',EndNode.DescAsString,'="',copy(Src,EndNode.StartPos,12),'"') +else + write(' EndNode=nil'); +write(' SearchedForward=',SearchedForward); +writeln(''); +writeln(' Self=',MainFilename); +if Params<>nil then begin + writeln(' NewNode=',Params.NewNode.DescAsString, + ' NewTool=',Params.NewCodeTool.MainFilename); +end else begin + writeln(' NOT FOUND'); +end; +{$ENDIF} + Node:=StartNode; + LastNodeCache:=nil; + if Params<>nil then begin + NewNode:=Params.NewNode; + NewTool:=Params.NewCodeTool; + NewCleanPos:=Params.NewCleanPos; + end else begin + NewNode:=nil; + NewTool:=nil; + end; + CleanStartPos:=StartNode.StartPos; + CleanEndPos:=StartNode.EndPos; + if EndNode<>nil then begin + if EndNode.StartPosCleanEndPos then + CleanEndPos:=EndNode.EndPos; + end else begin + if not SearchedForward then + CleanStartPos:=1 + else + CleanEndPos:=SrcLen+1; + end; + while (Node<>nil) do begin + if (Node.Desc in AllNodeCacheDescs) then begin + if (Node.Cache=nil) then + CreateNewNodeCache(Node); + if (Node.Cache is TCodeTreeNodeCache) then begin + CurNodeCache:=TCodeTreeNodeCache(Node.Cache); + if LastNodeCache<>CurNodeCache then begin + CurNodeCache.Add(Identifier,CleanStartPos,CleanEndPos, + NewNode,NewTool,NewCleanPos); + LastNodeCache:=CurNodeCache; + end; + end; + end; + Node:=Node.Parent; + if (EndNode<>nil) and (Node=EndNode.Parent) then break; + end; +end; + +function TFindDeclarationTool.CreateNewNodeCache( + Node: TCodeTreeNode): TCodeTreeNodeCache; +begin + Result:=TCodeTreeNodeCache.Create(Node); + Result.Next:=FFirstNodeCache; + FFirstNodeCache:=Result; +end; + { TFindDeclarationParams }