codetools: using less memory for global identifier table

git-svn-id: trunk@19693 -

components/codetools/codetoolsconfig.pas

@@ -263,6 +263,8 @@ begin
     LazarusSrcDir:=GetEnvironmentVariableUTF8('LAZARUSDIR');
   if GetEnvironmentVariableUTF8('FPCTARGET')<>'' then
     TargetOS:=GetEnvironmentVariableUTF8('FPCTARGET');
+  if GetEnvironmentVariableUTF8('FPCTARGETCPU')<>'' then
+    TargetProcessor:=GetEnvironmentVariableUTF8('FPCTARGETCPU');
 end;
 
 function TCodeToolsOptions.FindDefaultCompilerFilename: string;

components/codetools/examples/finddeclaration.lpi

@@ -1,12 +1,13 @@
 <?xml version="1.0"?>
 <CONFIG>
   <ProjectOptions>
-    <PathDelim Value="/"/>
-    <Version Value="5"/>
+    <Version Value="7"/>
     <General>
+      <Flags>
+        <LRSInOutputDirectory Value="False"/>
+      </Flags>
       <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
-      <IconPath Value="./"/>
       <TargetFileExt Value=""/>
     </General>
     <PublishOptions>
@@ -39,13 +40,10 @@
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="5"/>
+    <Version Value="8"/>
     <SearchPaths>
       <OtherUnitFiles Value="scanexamples/"/>
     </SearchPaths>
-    <CodeGeneration>
-      <Generate Value="Faster"/>
-    </CodeGeneration>
     <Other>
       <CompilerPath Value="$(CompPath)"/>
     </Other>

components/codetools/examples/finddeclaration.lpr

@@ -52,13 +52,10 @@ begin
   Options:=TCodeToolsOptions.Create;
   try
 
-    // To not parse the FPC sources every time, the options are saved to a file.
-    if FileExists(ConfigFilename) then
-      Options.LoadFromFile(ConfigFilename);
-
     // setup your paths
     writeln('Config=',ConfigFilename);
     if FileExists(ConfigFilename) then begin
+      // To not parse the FPC sources every time, the options are saved to a file.
       Options.LoadFromFile(ConfigFilename);
     end else begin
       Options.InitWithEnvironmentVariables;
@@ -97,7 +94,9 @@ begin
     Y:=43;
 
     writeln('FPCSrcDir=',Options.FPCSrcDir);
-    writeln('FPC=',Options.FPCPath);
+    writeln('PP=',Options.FPCPath);
+    writeln('TARGET=',Options.TargetOS);
+    writeln('TARGETCPU=',Options.TargetProcessor);
     if (ParamCount>=3) then begin
       Options.TestPascalFile:=ExpandFileName(ParamStr(1));
       X:=StrToInt(ParamStr(2));

components/codetools/finddeclarationcache.pas

@@ -203,6 +203,12 @@ type
   TGlobalIdentifierTree = class
   private
     FItems: TAVLTree; // tree of PChar;
+    FDefaultDataBlockSize: integer;
+    FDataBlockSize: integer;
+    FDataBlock: Pointer;
+    FDataBlockEnd: integer;
+    FFullDataBlocks: TFPList; // full blocks of data
+    function InternalGetMem(Size: integer): Pointer;
   public
     function AddCopy(Identifier: PChar): PChar;
     function Find(Identifier: PChar): PChar;
@@ -559,27 +565,34 @@ end;
 { TGlobalIdentifierTree }
 
 procedure TGlobalIdentifierTree.Clear;
-var Node: TAVLTreeNode;
+var
+  i: Integer;
 begin
-  if FItems<>nil then begin
-    Node:=FItems.FindLowest;
-    while Node<>nil do begin
-      FreeMem(Node.Data);
-      Node:=FItems.FindSuccessor(Node);
-    end;
+  if FItems<>nil then
     FItems.Clear;
+  if FFullDataBlocks<>nil then begin
+    for i:=0 to FFullDataBlocks.Count-1 do
+      FreeMem(FFullDataBlocks[i]);
+    FFullDataBlocks.Clear;
+    ReAllocMem(FDataBlock,0);
+    FDataBlockEnd:=0;
+    FDataBlockSize:=0;
   end;
 end;
 
 constructor TGlobalIdentifierTree.Create;
 begin
   inherited Create;
+  FItems:=TAVLTree.Create(TListSortCompare(@CompareIdentifiers));
+  FFullDataBlocks:=TFPList.Create;
+  FDefaultDataBlockSize:=256*256*2;
 end;
 
 destructor TGlobalIdentifierTree.Destroy;
 begin
   Clear;
   FItems.Free;
+  FFullDataBlocks.Free;
   inherited Destroy;
 end;
 
@@ -591,6 +604,22 @@ begin
     Result:=0;
 end;
 
+function TGlobalIdentifierTree.InternalGetMem(Size: integer): Pointer;
+begin
+  if (FDataBlock=nil) or (FDataBlockEnd+Size>FDataBlockSize) then begin
+    // store old block
+    FFullDataBlocks.Add(FDataBlock);
+    // create a new
+    FDataBlockSize:=FDefaultDataBlockSize;
+    if FDataBlockSize<Size then
+      FDataBlockSize:=Size;
+    GetMem(FDataBlock,FDataBlockSize);
+    FDataBlockEnd:=0;
+  end;
+  Result:=FDataBlock+FDataBlockEnd;
+  inc(FDataBlockEnd,Size);
+end;
+
 function TGlobalIdentifierTree.AddCopy(Identifier: PChar): PChar;
 var Len: integer;
 begin
@@ -601,11 +630,10 @@ begin
     exit;
   Len:=0;
   while IsIdentChar[Identifier[Len]] do inc(Len);
-  GetMem(Result,Len+1);
+  Result:=InternalGetMem(Len+1);
+  // GetMem(Result,Len+1);
   Move(Identifier^,Result^,Len);
   Result[Len]:=#0;
-  if FItems=nil then
-    FItems:=TAVLTree.Create(TListSortCompare(@CompareIdentifiers));
   FItems.Add(Result);
 end;
 

components/codetools/finddeclarationtool.pas

@@ -5081,8 +5081,10 @@ function TFindDeclarationTool.BuildInterfaceIdentifierCache(
 var
   InterfaceNode: TCodeTreeNode;
 begin
+  //DebugLn(['TFindDeclarationTool.BuildInterfaceIdentifierCache START ',GetTicks]);
   // build tree for pascal source
   BuildTree(true);
+  //DebugLn(['TFindDeclarationTool.BuildInterfaceIdentifierCache BuildTree ',GetTicks]);
 
   // search interface section
   InterfaceNode:=FindInterfaceNode;
@@ -5107,6 +5109,7 @@ begin
   else
     FInterfaceIdentifierCache.Clear;
   FInterfaceIdentifierCache.Complete:=true;
+  //DebugLn(['TFindDeclarationTool.BuildInterfaceIdentifierCache CLEAR ',GetTicks]);
 
   // add unit node
   MoveCursorToNodeStart(Tree.Root);
@@ -5114,9 +5117,11 @@ begin
   ReadNextAtom;
   FInterfaceIdentifierCache.Add(@Src[CurPos.StartPos],Tree.Root,CurPos.StartPos);
 
+  //DebugLn(['TFindDeclarationTool.BuildInterfaceIdentifierCache root node ',GetTicks]);
   // create nodes
   ScanChilds(InterfaceNode);
 
+  //DebugLn(['TFindDeclarationTool.BuildInterfaceIdentifierCache childs ',GetTicks]);
   //DebugLn(['TFindDeclarationTool.BuildInterfaceIdentifierCache ',MainFilename,' ',FInterfaceIdentifierCache.Items.Count,' ',GlobalIdentifierTree.Count]);
   Result:=true;
 end;