MG: added update checks for node caching

git-svn-id: trunk@655 -

components/codetools/basiccodetools.pas

@@ -144,10 +144,10 @@ function CompareSubStrings(const Find, Txt: string;
 function CleanCodeFromComments(const DirtyCode: string;
     NestedComments: boolean): string;
 function CompareIdentifiers(Identifier1, Identifier2: PChar): integer;
+function GetIdentifier(Identifier: PChar): string;
 
 function GetIndentStr(Indent: integer): string;
 
-
 //-----------------------------------------------------------------------------
 const
   MaxLineLength:integer=80;
@@ -1686,6 +1686,19 @@ begin
   end;
 end;
 
+function GetIdentifier(Identifier: PChar): string;
+var len: integer;
+begin
+  if Identifier<>nil then begin
+    len:=0;
+    while (IsIdChar[Identifier[len]]) do inc(len);
+    SetLength(Result,len);
+    if len>0 then
+      Move(Identifier[0],Result[1],len);
+  end else
+    Result:='';
+end;
+
 function GetIndentStr(Indent: integer): string;
 begin
   SetLength(Result,Indent);

components/codetools/codetoolmanager.pas

@@ -469,6 +469,8 @@ 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}

components/codetools/codetree.pas

@@ -128,7 +128,7 @@ const
       ctnClassOfType];
   AllSourceTypes =
      [ctnProgram,ctnPackage,ctnLibrary,ctnUnit];
-  AllUsableSoureTypes =
+  AllUsableSourceTypes =
      [ctnUnit];
 
 

components/codetools/customcodetool.pas

@@ -48,6 +48,8 @@ type
     //FIgnoreMissingIncludeFiles: boolean;
     FLastScannerChangeStep: integer;
     FScanner: TLinkScanner;
+    FOnGetGlobalWriteLockInfo: TOnGetWriteLockInfo;
+    FOnSetGlobalWriteLock: TOnSetWriteLock;
   protected
     KeyWordFuncList: TKeyWordFunctionList;
     FForceUpdateNeeded: boolean;
@@ -93,6 +95,7 @@ type
 
     function UpdateNeeded(OnlyInterfaceNeeded: boolean): boolean;
     procedure BeginParsing(DeleteNodes, OnlyInterfaceNeeded: boolean); virtual;
+    
     procedure MoveCursorToNodeStart(ANode: TCodeTreeNode);
     procedure MoveCursorToCleanPos(ACleanPos: integer);
     procedure MoveCursorToCleanPos(ACleanPos: PChar);
@@ -133,17 +136,23 @@ type
     function CompareSrcIdentifiers(Identifier1, Identifier2: PChar): boolean;
     function CompareSrcIdentifiers(CleanStartPos: integer;
       AnIdentifier: PChar): boolean;
-    function GetIdentifier(Identifier: PChar): string;
+    function ExtractIdentifier(CleanStartPos: integer): string;
-    function GetIdentifier(CleanStartPos: integer): string;
     procedure ReadPriorAtom;
 
     procedure CreateChildNode;
     procedure EndChildNode;
     
+    procedure ActivateGlobalWriteLock; virtual;
+    procedure DeactivateGlobalWriteLock; virtual;
+    property OnGetGlobalWriteLockInfo: TOnGetWriteLockInfo
+      read FOnGetGlobalWriteLockInfo write FOnGetGlobalWriteLockInfo;
+    property OnSetGlobalWriteLock: TOnSetWriteLock
+      read FOnSetGlobalWriteLock write FOnSetGlobalWriteLock;
+
     procedure Clear; virtual;
     function NodeDescToStr(Desc: integer): string;
     function NodeSubDescToStr(Desc, SubDesc: integer): string;
-    function ConsistencyCheck: integer; // 0 = ok
+    function ConsistencyCheck: integer; virtual; // 0 = ok
     procedure WriteDebugTreeReport;
     constructor Create;
     destructor Destroy; override;
@@ -1442,20 +1451,7 @@ begin
   Result:=(CleanStartPos>SrcLen) or (not IsIdentChar[Src[CleanStartPos]]);
 end;
 
-function TCustomCodeTool.GetIdentifier(Identifier: PChar): string;
+function TCustomCodeTool.ExtractIdentifier(CleanStartPos: integer): string;
-var len: integer;
-begin
-  if Identifier<>nil then begin
-    len:=0;
-    while (IsIdentChar[Identifier[len]]) do inc(len);
-    SetLength(Result,len);
-    if len>0 then
-      Move(Identifier[0],Result[1],len);
-  end else
-    Result:='';
-end;
-
-function TCustomCodeTool.GetIdentifier(CleanStartPos: integer): string;
 var len: integer;
 begin
   if (CleanStartPos>=1) then begin
@@ -1475,6 +1471,16 @@ begin
   Tree.Clear;
 end;
 
+procedure TCustomCodeTool.ActivateGlobalWriteLock;
+begin
+  if Assigned(OnSetGlobalWriteLock) then OnSetGlobalWriteLock(true);
+end;
+
+procedure TCustomCodeTool.DeactivateGlobalWriteLock;
+begin
+  if Assigned(OnSetGlobalWriteLock) then OnSetGlobalWriteLock(false);
+end;
+
 { ECodeToolError }
 
 constructor ECodeToolError.Create(ASender: TCustomCodeTool;

components/codetools/finddeclarationcache.pas

@@ -105,20 +105,32 @@ type
     FItems: TAVLTree; // tree of PCodeTreeNodeCacheEntry
   public
     Next: TCodeTreeNodeCache;
+    Owner: TCodeTreeNode;
     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 FindNearestAVLNode(Identifier: PChar;
+      CleanStartPos, CleanEndPos: integer; InFront: boolean): TAVLTreeNode;
     function Find(Identifier: PChar): PCodeTreeNodeCacheEntry;
     procedure Add(Identifier: PChar; CleanStartPos, CleanEndPos: integer;
       NewNode: TCodeTreeNode; NewTool: TPascalParserTool; NewCleanPos: integer);
     procedure Clear;
-    constructor Create;
+    procedure BindToOwner(NewOwner: TCodeTreeNode);
+    procedure UnbindFromOwner;
+    constructor Create(AnOwner: TCodeTreeNode);
     destructor Destroy; override;
+    procedure WriteDebugReport(const Prefix: string);
+    function ConsistencyCheck: integer;
   end;
 
+const
+  // all node types which can create a cache
+  AllNodeCacheDescs = [ctnClass, ctnInterface, ctnInitialization, ctnProgram];
+  
   //----------------------------------------------------------------------------
+type
   TGlobalIdentifierTree = class
   private
     FItems: TAVLTree; // tree of PChar;
@@ -157,13 +169,14 @@ type
     procedure FreeFirstItem; override;
   public
     procedure DisposeNode(Node: TCodeTreeNodeCache);
-    function NewNode: TCodeTreeNodeCache;
+    function NewNode(AnOwner: TCodeTreeNode): TCodeTreeNodeCache;
   end;
 
 var
   GlobalIdentifierTree: TGlobalIdentifierTree;
   InterfaceIdentCacheEntryMemManager: TInterfaceIdentCacheEntryMemManager;
   NodeCacheEntryMemManager: TNodeCacheEntryMemManager;
+  NodeCacheMemManager: TNodeCacheMemManager;
 
 
 implementation
@@ -428,15 +441,16 @@ begin
   end;
 end;
 
-constructor TCodeTreeNodeCache.Create;
+constructor TCodeTreeNodeCache.Create(AnOwner: TCodeTreeNode);
 begin
   inherited Create;
-
+  Owner:=AnOwner;
 end;
 
 destructor TCodeTreeNodeCache.Destroy;
 begin
   Clear;
+  UnbindFromOwner;
   inherited Destroy;
 end;
 
@@ -607,8 +621,28 @@ function TCodeTreeNodeCache.FindAVLNodeInRange(Identifier: PChar;
   CleanStartPos, CleanEndPos: integer): TAVLTreeNode;
 var
   Entry: PCodeTreeNodeCacheEntry;
-  comp: integer;
 begin
+  Result:=FindNearestAVLNode(Identifier,CleanStartPos,CleanEndPos,true);
+  Entry:=PCodeTreeNodeCacheEntry(Result.Data);
+  if (CleanStartPos>=Entry^.CleanEndPos)
+  or (CleanEndPos<Entry^.CleanStartPos) then begin
+    // node is not in range
+    Result:=nil;
+  end;
+end;
+
+function TCodeTreeNodeCache.FindNearestAVLNode(Identifier: PChar;
+  CleanStartPos, CleanEndPos: integer; InFront: boolean): TAVLTreeNode;
+var
+  Entry: PCodeTreeNodeCacheEntry;
+  comp: integer;
+  DirectionSucc: boolean;
+  NextNode: TAVLTreeNode;
+begin
+  if CleanStartPos>CleanEndPos then begin
+    raise Exception.Create('[TCodeTreeNodeCache.FindNearestAVLNode]'
+      +' internal error: CleanStartPos>CleanEndPos');
+  end;
   if FItems<>nil then begin
     Result:=FItems.Root;
     while Result<>nil do begin
@@ -619,14 +653,36 @@ begin
       else if comp>0 then
         Result:=Result.Right
       else begin
-        repeat
+        // cached result with identifier found
-          if CleanStartPos>=Entry^.CleanEndPos then
+        // -> check range
-            Result:=FItems.FindSuccessor(Result)
+        NextNode:=Result;
-          else if CleanEndPos<Entry^.CleanStartPos then
+        if CleanStartPos>=Entry^.CleanEndPos then begin
-            Result:=FItems.FindPrecessor(Result)
+          NextNode:=FItems.FindSuccessor(Result);
-          else
+          DirectionSucc:=true;
+        end else if CleanEndPos<Entry^.CleanStartPos then begin
+          NextNode:=FItems.FindPrecessor(Result);
+          DirectionSucc:=false;
+        end else begin
+          // cached result in range found
           exit;
-        until Result=nil;
+        end;
+        while (NextNode<>nil) do begin
+          Entry:=PCodeTreeNodeCacheEntry(NextNode.Data);
+          if CompareIdentifiers(Identifier,Entry^.Identifier)<>0 then begin
+            Result:=nil;
+            exit;
+          end;
+          Result:=NextNode;
+          if (CleanStartPos<Entry^.CleanEndPos)
+          and (CleanEndPos>=Entry^.CleanStartPos) then begin
+            // cached result in range found
+            exit;
+          end;
+          if DirectionSucc then
+            NextNode:=FItems.FindSuccessor(Result)
+          else
+            NextNode:=FItems.FindPrecessor(Result);
+        end;
       end;
     end;
   end else begin
@@ -634,6 +690,63 @@ begin
   end;
 end;
 
+function TCodeTreeNodeCache.ConsistencyCheck: integer;
+begin
+  if (FItems<>nil) then begin
+    Result:=FItems.ConsistencyCheck;
+    if Result<>0 then begin
+      dec(Result,100);
+      exit;
+    end;
+  end;
+  if Owner<>nil then begin
+    if Owner.Cache<>Self then begin
+      Result:=-1;
+      exit;
+    end;
+  end;
+  Result:=0;
+end;
+
+procedure TCodeTreeNodeCache.WriteDebugReport(const Prefix: string);
+var Node: TAVLTreeNode;
+  Entry: PCodeTreeNodeCacheEntry;
+begin
+  writeln(Prefix,'[TCodeTreeNodeCache.WriteDebugReport] Self=',
+    HexStr(Cardinal(Self),8),' Consistency=',ConsistencyCheck);
+  if FItems<>nil then begin
+    Node:=FItems.FindLowest;
+    while Node<>nil do begin
+      Entry:=PCodeTreeNodeCacheEntry(Node.Data);
+      write(Prefix,' Ident="',GetIdentifier(Entry^.Identifier),'"');
+      writeln('');
+      Node:=FItems.FindSuccessor(Node);
+    end;
+  end;
+end;
+
+procedure TCodeTreeNodeCache.UnbindFromOwner;
+begin
+  if Owner<>nil then begin
+    if Owner.Cache<>Self then
+      raise Exception.Create('[TCodeTreeNodeCache.UnbindFromOwner] '
+        +' internal error: Owner.Cache<>Self');
+    Owner.Cache:=nil;
+    Owner:=nil;
+  end;
+end;
+
+procedure TCodeTreeNodeCache.BindToOwner(NewOwner: TCodeTreeNode);
+begin
+  if NewOwner<>nil then begin
+    if NewOwner.Cache<>nil then
+      raise Exception.Create('[TCodeTreeNodeCache.BindToOwner] internal error:'
+        +' NewOwner.Cache<>nil');
+    NewOwner.Cache:=Self;
+  end;
+  Owner:=NewOwner;
+end;
+
 { TNodeCacheMemManager }
 
 procedure TNodeCacheMemManager.DisposeNode(Node: TCodeTreeNodeCache);
@@ -643,6 +756,7 @@ begin
     // add Entry to Free list
     Node.Next:=TCodeTreeNodeCache(FFirstFree);
     TCodeTreeNodeCache(FFirstFree):=Node;
+    Node.UnbindFromOwner;
     inc(FFreeCount);
   end else begin
     // free list full -> free the Node
@@ -660,17 +774,19 @@ begin
   Node.Free;
 end;
 
-function TNodeCacheMemManager.NewNode: TCodeTreeNodeCache;
+function TNodeCacheMemManager.NewNode(
+  AnOwner: TCodeTreeNode): TCodeTreeNodeCache;
 begin
   if FFirstFree<>nil then begin
     // take from free list
     Result:=TCodeTreeNodeCache(FFirstFree);
     TCodeTreeNodeCache(FFirstFree):=Result.Next;
     Result.Clear;
+    Result.Owner:=AnOwner;
     dec(FFreeCount);
   end else begin
     // free list empty -> create new Entry
-    Result:=TCodeTreeNodeCache.Create;
+    Result:=TCodeTreeNodeCache.Create(AnOwner);
     inc(FAllocatedCount);
   end;
   inc(FCount);
@@ -682,6 +798,8 @@ procedure InternalInit;
 begin
   GlobalIdentifierTree:=TGlobalIdentifierTree.Create;
   InterfaceIdentCacheEntryMemManager:=TInterfaceIdentCacheEntryMemManager.Create;
+  NodeCacheEntryMemManager:=TNodeCacheEntryMemManager.Create;
+  NodeCacheMemManager:=TNodeCacheMemManager.Create;
 end;
 
 procedure InternalFinal;
@@ -690,6 +808,10 @@ begin
   GlobalIdentifierTree:=nil;
   InterfaceIdentCacheEntryMemManager.Free;
   InterfaceIdentCacheEntryMemManager:=nil;
+  NodeCacheEntryMemManager.Free;
+  NodeCacheEntryMemManager:=nil;
+  NodeCacheMemManager.Free;
+  NodeCacheMemManager:=nil;
 end;
 
 initialization

components/codetools/finddeclarationtool.pas

@@ -220,6 +220,8 @@ type
     FInterfaceIdentifierCache: TInterfaceIdentifierCache;
     FOnGetCodeToolForBuffer: TOnGetCodeToolForBuffer;
     FOnGetUnitSourceSearchPath: TOnGetSearchPath;
+    FFirstNodeCache: TCodeTreeNodeCache;
+    FLastNodeCachesGlobalWriteLockStep: integer;
     {$IFDEF CTDEBUG}
     DebugPrefix: string;
     procedure IncPrefix;
@@ -265,6 +267,7 @@ type
     function PredefinedIdentToTypeDesc(Identifier: PChar): TExpressionTypeDesc;
   protected
     procedure DoDeleteNodes; override;
+    procedure ClearNodeCaches(Force: boolean);
     function FindDeclarationOfIdentifier(
       Params: TFindDeclarationParams): boolean;
     function FindContextNodeAtCursor(
@@ -314,6 +317,8 @@ type
       read FOnGetCodeToolForBuffer write FOnGetCodeToolForBuffer;
     property OnGetUnitSourceSearchPath: TOnGetSearchPath
       read FOnGetUnitSourceSearchPath write FOnGetUnitSourceSearchPath;
+    procedure ActivateGlobalWriteLock; override;
+    function ConsistencyCheck: integer; override;
   end;
 
 
@@ -360,7 +365,7 @@ var CleanCursorPos: integer;
   Params: TFindDeclarationParams;
 begin
   Result:=false;
-  Scanner.ActivateGlobalWriteLock;
+  ActivateGlobalWriteLock;
   try
     // build code tree
 {$IFDEF CTDEBUG}
@@ -436,7 +441,7 @@ writeln('TFindDeclarationTool.FindDeclaration D CursorNode=',NodeDescriptionAsSt
       end;
     end;
   finally
-    Scanner.DeactivateGlobalWriteLock;
+    DeactivateGlobalWriteLock;
   end;
 end;
 
@@ -771,6 +776,10 @@ begin
   end;
   
   if ContextNode<>nil then begin
+    if (ContextNode.Parent<>nil) and (ContextNode.Parent.Cache<>nil) then begin
+
+    end;
+  
     repeat
 {$IFDEF ShowTriedContexts}
 writeln('[TFindDeclarationTool.FindIdentifierInContext] A Ident=',
@@ -1291,7 +1300,7 @@ writeln('');
         ReadNextAtom;
         RaiseException('identifier expected, but '+GetAtom+' found');
       end;
-      if (Result.Node.Desc in AllUsableSoureTypes) then begin
+      if (Result.Node.Desc in AllUsableSourceTypes) then begin
         // identifier in front of the point is a unit name
         if Result.Tool<>Self then begin
           Result.Node:=Result.Tool.GetInterfaceNode;
@@ -2345,9 +2354,6 @@ writeln(DebugPrefix,'TFindDeclarationTool.FindIdentifierInInterface',
   // ToDo: build codetree for ppu, ppw, dcu files
   
   // build tree for pascal source
-  
-  // ToDo: only check the first time during a big search
-  
   BuildTree(true);
   
   // search identifier in cache
@@ -2438,7 +2444,7 @@ begin
     CurPos.StartPos:=-1;
     RaiseException('[TFindDeclarationTool.GetInterfaceNode] no code tree found');
   end;
-  if not (Tree.Root.Desc in AllUsableSoureTypes) then begin
+  if not (Tree.Root.Desc in AllUsableSourceTypes) then begin
     CurPos.StartPos:=-1;
     RaiseException('used unit is not an pascal unit');
   end;
@@ -3433,6 +3439,7 @@ end;
 
 procedure TFindDeclarationTool.DoDeleteNodes;
 begin
+  ClearNodeCaches(true);
   if FInterfaceIdentifierCache<>nil then
     FInterfaceIdentifierCache.Clear;
   inherited DoDeleteNodes;
@@ -3445,6 +3452,60 @@ begin
   inherited Destroy;
 end;
 
+procedure TFindDeclarationTool.ClearNodeCaches(Force: boolean);
+var
+  NodeCache: TCodeTreeNodeCache;
+  GlobalWriteLockIsSet: boolean;
+  GlobalWriteLockStep: integer;
+begin
+  if not Force then begin
+    // check if node cache must be cleared
+    if Assigned(OnGetGlobalWriteLockInfo) then begin
+      OnGetGlobalWriteLockInfo(GlobalWriteLockIsSet,GlobalWriteLockStep);
+      if GlobalWriteLockIsSet then begin
+        // The global write lock is set. That means, input variables and code
+        // are frozen
+        if (FLastNodeCachesGlobalWriteLockStep=GlobalWriteLockStep) then begin
+          // source and values did not change since last UpdateNeeded check
+          exit;
+        end else begin
+          // this is the first check in this GlobalWriteLockStep
+          FLastNodecachesGlobalWriteLockStep:=GlobalWriteLockStep;
+          // proceed normally ...
+        end;
+      end;
+    end;
+  end;
+  while FFirstNodeCache<>nil do begin
+    NodeCache:=FFirstNodeCache;
+    FFirstNodeCache:=NodeCache.Next;
+    NodeCacheMemManager.DisposeNode(NodeCache);
+  end;
+end;
+
+function TFindDeclarationTool.ConsistencyCheck: integer;
+var ANodeCache: TCodeTreeNodeCache;
+begin
+  if FInterfaceIdentifierCache<>nil then begin
+
+  end;
+  ANodeCache:=FFirstNodeCache;
+  while ANodeCache<>nil do begin
+    Result:=ANodeCache.ConsistencyCheck;
+    if Result<>0 then begin
+      dec(Result,100);
+      exit;
+    end;
+    ANodeCache:=ANodeCache.Next;
+  end;
+end;
+
+procedure TFindDeclarationTool.ActivateGlobalWriteLock;
+begin
+  inherited;
+  ClearNodeCaches(false);
+end;
+
 
 { TFindDeclarationParams }
 
@@ -3565,7 +3626,5 @@ begin
 end;
 
 
-
 end.
 
-