MG: added BaseTypeCache

git-svn-id: trunk@672 -

components/codetools/customcodetool.pas

@@ -195,7 +195,7 @@ end;
 
 procedure TCustomCodeTool.Clear;
 begin
-  Tree.Clear;
+  if Tree<>nil then DoDeleteNodes;
   CurPos.StartPos:=1;
   CurPos.EndPos:=-1;
   LastAtoms.Clear;

components/codetools/finddeclarationcache.pas

@@ -139,8 +139,16 @@ type
   {
     3. Base type node cache
     
-    ToDo:
-  
+    All nodes, that are aliases, has this type of cache.
+    For example a variable 'i: integer' creates several basetype nodes:
+      1. i variable node points to its type node 'integer'.
+      2. 'integer' node points to type definition node 'integer'.
+      3. 'integer' identifier node points to its base type 'longint'.
+      4. 'longint' identifier node points points to its range.
+      
+      FindBaseTypeOfNode will search this chain, and on success will create
+      TBaseTypeCache(s). All four nodes will point directly to the range.
+
   }
   TBaseTypeCache = class
   private
@@ -212,16 +220,17 @@ type
   // stacks for circle checking
 type
   TCodeTreeNodeStackEntry = TCodeTreeNode;
-  PCodeTreeNodeStackEntry = ^TCodeTreeNodeStackEntry;
-  
+
   TCodeTreeNodeStack = record
     Fixedtems: array[0..9] of TCodeTreeNodeStackEntry;
-    DynItems: TList; // list of PCodeTreeNodeStackEntry
+    DynItems: TList; // list of TCodeTreeNodeStackEntry
     StackPtr: integer;
   end;
   PCodeTreeNodeStack = ^TCodeTreeNodeStack;
 
   procedure InitializeNodeStack(NodeStack: PCodeTreeNodeStack);
+  function GetNodeStackEntry(NodeStack: PCodeTreeNodeStack;
+    Index: integer): TCodeTreeNodeStackEntry;
   procedure AddNodeToStack(NodeStack: PCodeTreeNodeStack;
     NewNode: TCodeTreeNode);
   function NodeExistsInStack(NodeStack: PCodeTreeNodeStack;
@@ -507,6 +516,7 @@ destructor TCodeTreeNodeCache.Destroy;
 begin
   Clear;
   UnbindFromOwner;
+  FItems.Free;
   inherited Destroy;
 end;
 
@@ -861,7 +871,7 @@ begin
     Result:=TCodeTreeNodeCache(FFirstFree);
     TCodeTreeNodeCache(FFirstFree):=Result.Next;
     Result.Clear;
-    Result.Owner:=AnOwner;
+    Result.BindToOwner(AnOwner);
     dec(FFreeCount);
   end else begin
     // free list empty -> create new NodeCache
@@ -879,6 +889,17 @@ begin
   NodeStack^.DynItems:=nil;
 end;
 
+function GetNodeStackEntry(NodeStack: PCodeTreeNodeStack;
+  Index: integer): TCodeTreeNodeStackEntry;
+begin
+  if Index<=High(NodeStack^.Fixedtems) then begin
+    Result:=NodeStack^.Fixedtems[Index];
+  end else begin
+    Result:=TCodeTreeNodeStackEntry(
+                       NodeStack^.DynItems[Index-High(NodeStack^.Fixedtems)-1]);
+  end;
+end;
+
 procedure AddNodeToStack(NodeStack: PCodeTreeNodeStack;
   NewNode: TCodeTreeNode);
 begin
@@ -952,7 +973,7 @@ begin
     // take from free list
     Result:=TBaseTypeCache(FFirstFree);
     TBaseTypeCache(FFirstFree):=Result.Next;
-    Result.Owner:=AnOwner;
+    Result.BindToOwner(AnOwner);
     dec(FFreeCount);
   end else begin
     // free list empty -> create new BaseType
@@ -962,31 +983,6 @@ begin
   inc(FCount);
 end;
 
-//------------------------------------------------------------------------------
-
-procedure InternalInit;
-begin
-  GlobalIdentifierTree:=TGlobalIdentifierTree.Create;
-  InterfaceIdentCacheEntryMemManager:=TInterfaceIdentCacheEntryMemManager.Create;
-  NodeCacheEntryMemManager:=TNodeCacheEntryMemManager.Create;
-  NodeCacheMemManager:=TNodeCacheMemManager.Create;
-  BaseTypeCacheMemManager:=TBaseTypeCacheMemManager.Create;
-end;
-
-procedure InternalFinal;
-begin
-  GlobalIdentifierTree.Free;
-  GlobalIdentifierTree:=nil;
-  InterfaceIdentCacheEntryMemManager.Free;
-  InterfaceIdentCacheEntryMemManager:=nil;
-  NodeCacheEntryMemManager.Free;
-  NodeCacheEntryMemManager:=nil;
-  NodeCacheMemManager.Free;
-  NodeCacheMemManager:=nil;
-  BaseTypeCacheMemManager.Free;
-  BaseTypeCacheMemManager:=nil;
-end;
-
 { TBaseTypeCache }
 
 procedure TBaseTypeCache.BindToOwner(NewOwner: TCodeTreeNode);
@@ -1023,6 +1019,31 @@ begin
   end;
 end;
 
+//------------------------------------------------------------------------------
+
+procedure InternalInit;
+begin
+  GlobalIdentifierTree:=TGlobalIdentifierTree.Create;
+  InterfaceIdentCacheEntryMemManager:=TInterfaceIdentCacheEntryMemManager.Create;
+  NodeCacheEntryMemManager:=TNodeCacheEntryMemManager.Create;
+  NodeCacheMemManager:=TNodeCacheMemManager.Create;
+  BaseTypeCacheMemManager:=TBaseTypeCacheMemManager.Create;
+end;
+
+procedure InternalFinal;
+begin
+  BaseTypeCacheMemManager.Free;
+  BaseTypeCacheMemManager:=nil;
+  NodeCacheMemManager.Free;
+  NodeCacheMemManager:=nil;
+  NodeCacheEntryMemManager.Free;
+  NodeCacheEntryMemManager:=nil;
+  InterfaceIdentCacheEntryMemManager.Free;
+  InterfaceIdentCacheEntryMemManager:=nil;
+  GlobalIdentifierTree.Free;
+  GlobalIdentifierTree:=nil;
+end;
+
 initialization
   InternalInit;
 

components/codetools/finddeclarationtool.pas

@@ -46,6 +46,7 @@ interface
 { $DEFINE ShowFoundIdentifier}
 { $DEFINE ShowCachedIdentifiers}
 { $DEFINE ShowNodeCache}
+{ $DEFINE ShowBaseTypeCache}
 
 uses
   {$IFDEF MEM_CHECK}
@@ -282,6 +283,8 @@ type
     procedure ClearNodeCaches(Force: boolean);
     function CreateNewNodeCache(Node: TCodeTreeNode): TCodeTreeNodeCache;
     function CreateNewBaseTypeCache(Node: TCodeTreeNode): TBaseTypeCache;
+    procedure CreateBaseTypeCaches(NodeStack: PCodeTreeNodeStack;
+      Result: TFindContext);
     function GetNodeCache(Node: TCodeTreeNode;
       CreateIfNotExists: boolean): TCodeTreeNodeCache;
     procedure AddResultToNodeCaches(Identifier: PChar;
@@ -369,6 +372,12 @@ begin
   Result.Tool:=TFindDeclarationTool(Params.NewCodeTool);
 end;
 
+function CreateFindContext(BaseTypeCache: TBaseTypeCache): TFindContext;
+begin
+  Result.Node:=BaseTypeCache.NewNode;
+  Result.Tool:=TFindDeclarationTool(BaseTypeCache.NewTool);
+end;
+
 function FindContextAreEqual(Context1, Context2: TFindContext): boolean;
 begin
   Result:=(Context1.Tool=Context2.Tool) and (Context1.Node=Context2.Node);
@@ -1616,17 +1625,22 @@ begin
   InitializeNodeStack(@NodeStack);
   try
     while (Result.Node<>nil) do begin
+      if (Result.Node.Cache<>nil) and (Result.Node.Cache is TBaseTypeCache) then
+      begin
+        // base type already cached
+        Result:=CreateFindContext(TBaseTypeCache(Result.Node.Cache));
+        exit;
+      end;
       if NodeExistsInStack(@NodeStack,Result.Node) then begin
+        // circle detected
         Result.Tool.MoveCursorToNodeStart(Result.Node);
         Result.Tool.RaiseException('circle in definitions');
       end;
       AddNodeToStack(@NodeStack,Result.Node);
+
 {$IFDEF ShowTriedContexts}
 writeln('[TFindDeclarationTool.FindBaseTypeOfNode] LOOP Result=',Result.Node.DescAsString,' ',HexStr(Cardinal(Result.Node),8));
 {$ENDIF}
-
-      // ToDo: BaseTypeCache
-
       if (Result.Node.Desc in AllIdentifierDefinitions) then begin
         // instead of variable/const/type definition, return the type
         Result.Node:=FindTypeNodeOfDefinition(Result.Node);
@@ -1769,6 +1783,9 @@ writeln('[TFindDeclarationTool.FindBaseTypeOfNode] Class is forward');
         +'" not found');
     end;
   finally
+    // cache the result in all nodes
+    CreateBaseTypeCaches(@NodeStack,Result);
+    // free node stack
     FinalizeNodeStack(@NodeStack);
   end;
 {$IFDEF CTDEBUG}
@@ -3739,6 +3756,37 @@ begin
   FFirstBaseTypeCache:=Result;
 end;
 
+procedure TFindDeclarationTool.CreateBaseTypeCaches(
+  NodeStack: PCodeTreeNodeStack; Result: TFindContext);
+var i: integer;
+  Node: TCodeTreeNodeStackEntry;
+  BaseTypeCache: TBaseTypeCache;
+begin
+{$IFDEF ShowBaseTypeCache}
+write('[TFindDeclarationTool.CreateBaseTypeCaches] ',
+' StackPtr=',NodeStack^.StackPtr);
+writeln(' Self=',MainFilename);
+if Result.Node<>nil then
+  write(' Result=',Result.Node.DescAsString,
+     ' "',copy(Src,Result.Node.StartPos,10),'" ',Result.Tool.MainFilename)
+else
+  write(' Result=nil');
+writeln('');
+{$ENDIF}
+  for i:=0 to (NodeStack^.StackPtr-1) do begin
+    Node:=GetNodeStackEntry(NodeStack,i);
+    if (Node.Cache=nil)
+    and ((Result.Tool<>Self) or (Result.Node<>Node)) then begin
+{$IFDEF ShowBaseTypeCache}
+writeln('  i=',i,' Node=',Node.DescAsString,' "',copy(Src,Node.StartPos,10),'"');
+{$ENDIF}
+      BaseTypeCache:=CreateNewBaseTypeCache(Node);
+      BaseTypeCache.NewNode:=Result.Node;
+      BaseTypeCache.NewTool:=Result.Tool;
+    end;
+  end;
+end;
+
 
 { TFindDeclarationParams }