1 {
2  ***************************************************************************
3  *                                                                         *
4  *   This source is free software; you can redistribute it and/or modify   *
5  *   it under the terms of the GNU General Public License as published by  *
6  *   the Free Software Foundation; either version 2 of the License, or     *
7  *   (at your option) any later version.                                   *
8  *                                                                         *
9  *   This code is distributed in the hope that it will be useful, but      *
10  *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
11  *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
12  *   General Public License for more details.                              *
13  *                                                                         *
14  *   A copy of the GNU General Public License is available on the World    *
15  *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
16  *   obtain it by writing to the Free Software Foundation,                 *
17  *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
18  *                                                                         *
19  ***************************************************************************
20 
21   Author: Mattias Gaertner
22 
23   Abstract:
24     Quick lookup database for identifiers in units.
25 }
26 unit UnitDictionary;
27 
28 {$mode objfpc}{$H+}
29 
30 interface
31 
32 uses
33   Classes, SysUtils, Laz_AVL_Tree,
34   // LazUtils
35   LazFileUtils, AvgLvlTree,
36   // Codetools
37   BasicCodeTools, FileProcs, CodeToolsStructs, FindDeclarationCache,
38   CodeToolManager, CodeCache;
39 
40 const
41   // Version 2: added unit and group use count
42   UDFileVersion = 2;
43   UDFileHeader = 'UnitDirectory:';
44 type
45   TUDIdentifier = class;
46   TUDUnit = class;
47   TUnitDictionary = class;
48 
49   { TUDItem }
50 
51   TUDItem = class
52   public
53     Name: string;
54   end;
55 
56   { TUDFileItem }
57 
58   TUDFileItem = class(TUDItem)
59   public
60     Filename: string;
61     constructor Create(const aName, aFilename: string);
62   end;
63 
64   { TUDUnitGroup }
65 
66   TUDUnitGroup = class(TUDFileItem)
67   public
68     Dictionary: TUnitDictionary;
69     Units: TMTAVLTree; // tree of TIDUnit sorted with CompareIDItems
70     UseCount: int64;
71     constructor Create(const aName, aFilename: string);
72     destructor Destroy; override;
AddUnitnull73     function AddUnit(NewUnit: TUDUnit): TUDUnit; overload;
74     procedure RemoveUnit(TheUnit: TUDUnit);
75   end;
76 
77   { TUDUnit }
78 
79   TUDUnit = class(TUDFileItem)
80   public
81     FileAge: longint;
82     ToolStamp: integer;
83     FirstIdentifier, LastIdentifier: TUDIdentifier;
84     Groups: TMTAVLTree; // tree of TUDUnitGroup sorted with CompareIDItems
85     UseCount: int64;
86     constructor Create(const aName, aFilename: string);
87     destructor Destroy; override;
AddIdentifiernull88     function AddIdentifier(Item: TUDIdentifier): TUDIdentifier;
IsInGroupnull89     function IsInGroup(Group: TUDUnitGroup): boolean;
GetDictionarynull90     function GetDictionary: TUnitDictionary;
HasIdentifiernull91     function HasIdentifier(Item: TUDIdentifier): boolean; // very slow
92   end;
93 
94   { TUDIdentifier }
95 
96   TUDIdentifier = class(TUDItem)
97   public
98     DUnit: TUDUnit;
99     NextInUnit: TUDIdentifier;
100     constructor Create(const aName: string); overload;
101     constructor Create(aName: PChar); overload;
102   end;
103 
104   ECTUnitDictionaryLoadError = class(Exception)
105   public
106   end;
107 
108   { TUnitDictionary }
109 
110   TUnitDictionary = class
111   private
112     FChangeStamp: int64;
113     FNoGroup: TUDUnitGroup;
114     FIdentifiers: TMTAVLTree; // tree of TUDIdentifier sorted with CompareIDItems
115     FUnitsByName: TMTAVLTree; // tree of TUDUnit sorted with CompareIDItems
116     FUnitsByFilename: TMTAVLTree; // tree of TUDUnit sorted with CompareIDFileItems
117     FUnitGroupsByName: TMTAVLTree; // tree of TUDUnitGroup sorted with CompareIDItems
118     FUnitGroupsByFilename: TMTAVLTree; // tree of TUDUnitGroup sorted with CompareIDFileItems
119     procedure RemoveIdentifier(Item: TUDIdentifier);
120     procedure ClearIdentifiersOfUnit(TheUnit: TUDUnit);
121   public
122     constructor Create;
123     destructor Destroy; override;
124     procedure Clear(CreateDefaults: boolean = true);
125     procedure ConsistencyCheck;
126     procedure SaveToFile(const Filename: string);
127     procedure SaveToStream(aStream: TStream);
128     procedure LoadFromFile(const Filename: string; KeepData: boolean);
129     procedure LoadFromStream(aStream: TMemoryStream;
130       KeepData: boolean // keep existing data, only new units and groups will be added
131       );
Equalsnull132     function Equals(Dictionary: TUnitDictionary): boolean; reintroduce;
133     property ChangeStamp: int64 read FChangeStamp;
134     procedure IncreaseChangeStamp;
135 
136     // groups
AddUnitGroupnull137     function AddUnitGroup(Group: TUDUnitGroup): TUDUnitGroup; overload;
AddUnitGroupnull138     function AddUnitGroup(aFilename: string; aName: string = ''): TUDUnitGroup; overload;
139     procedure DeleteGroup(Group: TUDUnitGroup; DeleteUnitsWithoutGroup: boolean);
140     property NoGroup: TUDUnitGroup read FNoGroup;
141     property UnitGroupsByName: TMTAVLTree read FUnitGroupsByName;
142     property UnitGroupsByFilename: TMTAVLTree read FUnitGroupsByFilename;
FindGroupWithFilenamenull143     function FindGroupWithFilename(const aFilename: string): TUDUnitGroup;
144 
145     // units
AddUnitnull146     function AddUnit(const aFilename: string; aName: string = ''; Group: TUDUnitGroup = nil): TUDUnit; overload;
147     procedure DeleteUnit(TheUnit: TUDUnit; DeleteEmptyGroups: boolean);
ParseUnitnull148     function ParseUnit(UnitFilename: string; Group: TUDUnitGroup = nil): TUDUnit; overload;
ParseUnitnull149     function ParseUnit(Code: TCodeBuffer; Group: TUDUnitGroup = nil): TUDUnit; overload;
ParseUnitnull150     function ParseUnit(Tool: TCodeTool; Group: TUDUnitGroup = nil): TUDUnit; overload;
FindUnitWithFilenamenull151     function FindUnitWithFilename(const aFilename: string): TUDUnit;
152     procedure IncreaseUnitUseCount(TheUnit: TUDUnit);
153     property UnitsByName: TMTAVLTree read FUnitsByName;
154     property UnitsByFilename: TMTAVLTree read FUnitsByFilename;
155 
156     // identifiers
157     property Identifiers: TMTAVLTree read FIdentifiers;
158   end;
159 
CompareNameWithIDItemnull160 function CompareNameWithIDItem(NamePChar, Item: Pointer): integer;
CompareIDItemsnull161 function CompareIDItems(Item1, Item2: Pointer): integer;
CompareFileNameWithIDFileItemnull162 function CompareFileNameWithIDFileItem(NameAnsiString, Item: Pointer): integer;
CompareIDFileItemsnull163 function CompareIDFileItems(Item1, Item2: Pointer): integer;
164 
165 procedure IDCheckUnitNameAndFilename(const aName, aFilename: string);
166 
167 implementation
168 
CompareNameWithIDItemnull169 function CompareNameWithIDItem(NamePChar, Item: Pointer): integer;
170 var
171   i: TUDItem absolute Item;
172 begin
173   Result:=CompareDottedIdentifiers(PChar(NamePChar),PChar(Pointer(i.Name)));
174 end;
175 
CompareIDItemsnull176 function CompareIDItems(Item1, Item2: Pointer): integer;
177 var
178   i1: TUDItem absolute Item1;
179   i2: TUDItem absolute Item2;
180 begin
181   Result:=CompareDottedIdentifiers(PChar(Pointer(i1.Name)),PChar(Pointer(i2.Name)));
182 end;
183 
CompareFileNameWithIDFileItemnull184 function CompareFileNameWithIDFileItem(NameAnsiString, Item: Pointer): integer;
185 var
186   i: TUDFileItem absolute Item;
187 begin
188   Result:=CompareFilenames(AnsiString(NameAnsiString),i.Filename);
189 end;
190 
CompareIDFileItemsnull191 function CompareIDFileItems(Item1, Item2: Pointer): integer;
192 var
193   i1: TUDFileItem absolute Item1;
194   i2: TUDFileItem absolute Item2;
195 begin
196   Result:=CompareFilenames(i1.Filename,i2.Filename);
197 end;
198 
199 procedure IDCheckUnitNameAndFilename(const aName, aFilename: string);
200 
201   procedure InvalidName;
202   begin
203     raise Exception.Create('invalid UnitName="'+aName+'" Filename="'+aFilename+'"');
204   end;
205 
206 var
207   ShortName: String;
208 begin
209   ShortName:=ExtractFileNameOnly(aFilename);
210   if CompareDottedIdentifiers(PChar(Pointer(aName)),PChar(Pointer(ShortName)))<>0
211   then
212     InvalidName;
213 end;
214 
215 { TUDIdentifier }
216 
217 constructor TUDIdentifier.Create(const aName: string);
218 begin
219   Name:=aName;
220 end;
221 
222 constructor TUDIdentifier.Create(aName: PChar);
223 begin
224   Name:=GetIdentifier(aName);
225 end;
226 
227 constructor TUDUnit.Create(const aName, aFilename: string);
228 begin
229   ToolStamp:=CTInvalidChangeStamp;
230   IDCheckUnitNameAndFilename(aName,aFilename);
231   inherited Create(aName,aFilename);
232   Groups:=TMTAVLTree.Create(@CompareIDItems);
233 end;
234 
235 destructor TUDUnit.Destroy;
236 begin
237   // the groups are freed by the TUnitDictionary
238   FreeAndNil(Groups);
239   inherited Destroy;
240 end;
241 
AddIdentifiernull242 function TUDUnit.AddIdentifier(Item: TUDIdentifier): TUDIdentifier;
243 begin
244   if Item.DUnit<>nil then RaiseCatchableException('');
245   Result:=Item;
246   Result.DUnit:=Self;
247   if LastIdentifier<>nil then
248     LastIdentifier.NextInUnit:=Result
249   else
250     FirstIdentifier:=Result;
251   Result.NextInUnit:=nil;
252   LastIdentifier:=Result;
253 end;
254 
TUDUnit.IsInGroupnull255 function TUDUnit.IsInGroup(Group: TUDUnitGroup): boolean;
256 begin
257   Result:=AVLFindPointer(Groups,Group)<>nil;
258 end;
259 
GetDictionarynull260 function TUDUnit.GetDictionary: TUnitDictionary;
261 begin
262   Result:=TUDUnitGroup(Groups.Root.Data).Dictionary;
263 end;
264 
HasIdentifiernull265 function TUDUnit.HasIdentifier(Item: TUDIdentifier): boolean;
266 var
267   i: TUDIdentifier;
268   j: Integer;
269 begin
270   i:=FirstIdentifier;
271   j:=0;
272   while i<>nil do begin
273     if i=Item then exit(true);
274     i:=i.NextInUnit;
275     inc(j);
276     if j>10000000 then RaiseCatchableException('');
277   end;
278   Result:=false;
279 end;
280 
281 { TUDUnitGroup }
282 
283 constructor TUDUnitGroup.Create(const aName, aFilename: string);
284 begin
285   IDCheckUnitNameAndFilename(aName,aFilename);
286   inherited Create(aName,aFilename);
287   Units:=TMTAVLTree.Create(@CompareIDItems);
288 end;
289 
290 destructor TUDUnitGroup.Destroy;
291 begin
292   // the units are freed by the TIdentifierDictionary
293   FreeAndNil(Units);
294   inherited Destroy;
295 end;
296 
AddUnitnull297 function TUDUnitGroup.AddUnit(NewUnit: TUDUnit): TUDUnit;
298 begin
299   Result:=NewUnit;
300   if AVLFindPointer(Units,NewUnit)<>nil then exit;
301   Units.Add(Result);
302   Result.Groups.Add(Self);
303   if (Dictionary.NoGroup<>Self) then
304     Dictionary.NoGroup.RemoveUnit(NewUnit);
305   Dictionary.IncreaseChangeStamp;
306 end;
307 
308 procedure TUDUnitGroup.RemoveUnit(TheUnit: TUDUnit);
309 begin
310   if AVLFindPointer(Units,TheUnit)=nil then exit;
311   AVLRemovePointer(Units,TheUnit);
312   AVLRemovePointer(TheUnit.Groups,Self);
313   Dictionary.IncreaseChangeStamp;
314 end;
315 
316 { TUDFileItem }
317 
318 constructor TUDFileItem.Create(const aName, aFilename: string);
319 begin
320   Name:=aName;
321   Filename:=aFilename;
322 end;
323 
324 { TUnitDictionary }
325 
326 procedure TUnitDictionary.RemoveIdentifier(Item: TUDIdentifier);
327 begin
328   AVLRemovePointer(FIdentifiers,Item);
329 end;
330 
331 procedure TUnitDictionary.ClearIdentifiersOfUnit(TheUnit: TUDUnit);
332 var
333   Item: TUDIdentifier;
334 begin
335   while TheUnit.FirstIdentifier<>nil do begin
336     Item:=TheUnit.FirstIdentifier;
337     TheUnit.FirstIdentifier:=Item.NextInUnit;
338     Item.NextInUnit:=nil;
339     RemoveIdentifier(Item);
340     Item.Free;
341   end;
342   TheUnit.LastIdentifier:=nil;
343 end;
344 
345 constructor TUnitDictionary.Create;
346 begin
347   FIdentifiers:=TMTAVLTree.Create(@CompareIDItems);
348   FUnitsByName:=TMTAVLTree.Create(@CompareIDItems);
349   FUnitsByFilename:=TMTAVLTree.Create(@CompareIDFileItems);
350   FUnitGroupsByName:=TMTAVLTree.Create(@CompareIDItems);
351   FUnitGroupsByFilename:=TMTAVLTree.Create(@CompareIDFileItems);
352   FNoGroup:=AddUnitGroup('');
353 end;
354 
355 destructor TUnitDictionary.Destroy;
356 begin
357   Clear(false);
358   FreeAndNil(FIdentifiers);
359   FreeAndNil(FUnitsByName);
360   FreeAndNil(FUnitsByFilename);
361   FreeAndNil(FUnitGroupsByName);
362   FreeAndNil(FUnitGroupsByFilename);
363   inherited Destroy;
364 end;
365 
366 procedure TUnitDictionary.Clear(CreateDefaults: boolean);
367 begin
368   FNoGroup:=nil;
369   FUnitGroupsByFilename.Clear;
370   FUnitGroupsByName.FreeAndClear;
371   FUnitsByFilename.Clear;
372   FUnitsByName.FreeAndClear;
373   FIdentifiers.FreeAndClear;
374   if CreateDefaults then
375     FNoGroup:=AddUnitGroup('');
376 end;
377 
378 procedure TUnitDictionary.ConsistencyCheck;
379 
380   procedure e(const Msg: string);
381   begin
382     raise Exception.Create('ERROR: TUnitDictionary.ConsistencyCheck '+Msg);
383   end;
384 
385 var
386   AVLNode: TAVLTreeNode;
387   CurUnit: TUDUnit;
388   Group: TUDUnitGroup;
389   Item: TUDIdentifier;
390   SubAVLNode: TAVLTreeNode;
391   LastUnit: TUDUnit;
392   LastGroup: TUDUnitGroup;
393   IdentifiersCount: Integer;
394 begin
395   if NoGroup=nil then
396     e('DefaultGroup=nil');
397 
398   if UnitGroupsByFilename.Count<>UnitGroupsByName.Count then
399     e('UnitGroupsByFilename.Count<>UnitGroupsByName.Count');
400   if UnitsByFilename.Count<>UnitsByName.Count then
401     e('UnitsByFilename.Count<>UnitsByName.Count');
402 
403   UnitGroupsByFilename.ConsistencyCheck;
404   UnitGroupsByName.ConsistencyCheck;
405   UnitsByName.ConsistencyCheck;
406   UnitsByFilename.ConsistencyCheck;
407   IdentifiersCount:=0;
408 
409   // check UnitsByName
410   AVLNode:=UnitsByName.FindLowest;
411   LastUnit:=nil;
412   while AVLNode<>nil do begin
413     CurUnit:=TUDUnit(AVLNode.Data);
414     if CurUnit.Name='' then
415       e('unit without name');
416     if CurUnit.Filename='' then
417       e('unit '+CurUnit.Name+' without filename');
418     if AVLFindPointer(FUnitsByFilename,CurUnit)=nil then
419       e('unit '+CurUnit.Name+' in FUnitsByName not in FUnitsByFilename');
420     if CurUnit.Groups.Count=0 then
421       e('unit '+CurUnit.Name+' has not group');
422     CurUnit.Groups.ConsistencyCheck;
423     if (LastUnit<>nil)
424     and (CompareFilenames(LastUnit.Filename,CurUnit.Filename)=0) then
425       e('unit '+CurUnit.Name+' exists twice: '+CurUnit.Filename);
426     SubAVLNode:=CurUnit.Groups.FindLowest;
427     LastGroup:=nil;
428     while SubAVLNode<>nil do begin
429       Group:=TUDUnitGroup(SubAVLNode.Data);
430       if AVLFindPointer(Group.Units,CurUnit)=nil then
431         e('unit '+CurUnit.Name+' not in group '+Group.Filename);
432       if LastGroup=Group then
433         e('unit '+CurUnit.Name+' twice in group '+Group.Filename);
434       LastGroup:=Group;
435       SubAVLNode:=CurUnit.Groups.FindSuccessor(SubAVLNode);
436     end;
437     Item:=CurUnit.FirstIdentifier;
438     while Item<>nil do begin
439       if Item.Name='' then
440         e('identifier without name');
441       if Item.DUnit=nil then
442         e('identifier '+Item.Name+' without unit');
443       if Item.DUnit<>CurUnit then
444         e('identifier '+Item.Name+' not in unit '+CurUnit.Name);
445       if FIdentifiers.Find(Item)=nil then
446         e('identifier '+Item.Name+' in unit, but not in global tree');
447       inc(IdentifiersCount);
448       Item:=Item.NextInUnit;
449     end;
450     LastUnit:=CurUnit;
451     AVLNode:=UnitsByName.FindSuccessor(AVLNode);
452   end;
453 
454   if IdentifiersCount<>FIdentifiers.Count then
455     e('IdentifiersCount='+IntToStr(IdentifiersCount)+'<>FIdentifiers.Count='+IntToStr(FIdentifiers.Count));
456 
457   // UnitsByFilename
458   AVLNode:=UnitsByFilename.FindLowest;
459   LastUnit:=nil;
460   while AVLNode<>nil do begin
461     CurUnit:=TUDUnit(AVLNode.Data);
462     if AVLFindPointer(FUnitsByName,CurUnit)=nil then
463       e('unit '+CurUnit.Name+' in FUnitsByFilename not in FUnitsByName');
464     if (LastUnit<>nil)
465     and (CompareFilenames(LastUnit.Filename,CurUnit.Filename)=0) then
466       e('unit '+CurUnit.Name+' exists twice: '+CurUnit.Filename);
467     LastUnit:=CurUnit;
468     AVLNode:=UnitsByFilename.FindSuccessor(AVLNode);
469   end;
470 
471   // check UnitGroupsByName
472   AVLNode:=UnitGroupsByName.FindLowest;
473   LastGroup:=nil;
474   while AVLNode<>nil do begin
475     Group:=TUDUnitGroup(AVLNode.Data);
476     if (Group.Name='') and (Group<>NoGroup) then
477       e('group without name');
478     if (Group.Filename='') and (Group<>NoGroup) then
479       e('group '+Group.Name+' without filename');
480     if AVLFindPointer(FUnitGroupsByFilename,Group)=nil then
481       e('group '+Group.Name+' in FUnitGroupsByName not in FUnitGroupsByFilename');
482     Group.Units.ConsistencyCheck;
483     if (LastGroup<>nil)
484     and (CompareFilenames(LastGroup.Filename,Group.Filename)=0) then
485       e('group '+Group.Name+' exists twice: '+Group.Filename);
486     SubAVLNode:=Group.Units.FindLowest;
487     LastUnit:=nil;
488     while SubAVLNode<>nil do begin
489       CurUnit:=TUDUnit(SubAVLNode.Data);
490       if AVLFindPointer(CurUnit.Groups,Group)=nil then
491         e('group '+Group.Name+' has not the unit '+CurUnit.Name);
492       if LastUnit=CurUnit then
493         e('group '+Group.Name+' has unit twice '+CurUnit.Filename);
494       LastUnit:=CurUnit;
495       SubAVLNode:=Group.Units.FindSuccessor(SubAVLNode);
496     end;
497     LastGroup:=Group;
498     AVLNode:=UnitGroupsByName.FindSuccessor(AVLNode);
499   end;
500 
501   // UnitGroupsByFilename
502   AVLNode:=UnitGroupsByFilename.FindLowest;
503   LastGroup:=nil;
504   while AVLNode<>nil do begin
505     Group:=TUDUnitGroup(AVLNode.Data);
506     if AVLFindPointer(FUnitGroupsByName,Group)=nil then
507       e('group '+Group.Name+' in FUnitGroupsByFilename not in FUnitGroupsByName');
508     if (LastGroup<>nil)
509     and (CompareFilenames(LastGroup.Filename,Group.Filename)=0) then
510       e('group '+Group.Name+' exists twice: '+Group.Filename);
511     LastGroup:=Group;
512     AVLNode:=UnitGroupsByFilename.FindSuccessor(AVLNode);
513   end;
514 
515   // Identifiers
516   AVLNode:=Identifiers.FindLowest;
517   while AVLNode<>nil do begin
518     Item:=TUDIdentifier(AVLNode.Data);
519     if Item.Name='' then
520       e('identifier without name');
521     if Item.DUnit=nil then
522       e('identifier '+Item.Name+' without unit');
523     AVLNode:=Identifiers.FindSuccessor(AVLNode);
524   end;
525   debugln(['TUnitDictionary.ConsistencyCheck GOOD']);
526 end;
527 
528 procedure TUnitDictionary.SaveToFile(const Filename: string);
529 var
530   UncompressedMS: TMemoryStream;
531   TempFilename: String;
532 begin
533   UncompressedMS:=TMemoryStream.Create;
534   try
535     SaveToStream(UncompressedMS);
536     UncompressedMS.Position:=0;
537     // reduce the risk of file corruption due to crashes while saving:
538     // save to a temporary file and then rename
539     TempFilename:=FileProcs.GetTempFilename(Filename,'unitdictionary');
540     UncompressedMS.SaveToFile(TempFilename);
541     RenameFileUTF8(TempFilename,Filename);
542   finally
543     UncompressedMS.Free;
544   end;
545 end;
546 
547 procedure TUnitDictionary.SaveToStream(aStream: TStream);
548 
549   procedure w(const s: string);
550   begin
551     if s='' then exit;
552     aStream.Write(s[1],length(s));
553   end;
554 
GetBase32null555   function GetBase32(i: integer): string;
556   const
557     l: shortstring = '0123456789ABCDEFGHIJKLMNOPQRSTUV';
558   begin
559     Result:='';
560     if i=0 then exit('0');
561     while i>0 do begin
562       Result:=Result+l[(i mod 32)+1];
563       i:=i div 32;
564     end;
565   end;
566 
567   { Not used, because gzip is good enough:
568   procedure WriteDiff(var Last: string; Cur: string);
569   // write n^diff, where n is the base32 number of same bytes of last value
570   // and diff the remaining string that differs
571   var
572     p1: PChar;
573     p2: PChar;
574     l: PtrUInt;
575   begin
576     if (Cur<>'') and (Last<>'') then begin
577       p1:=PChar(Cur);
578       p2:=PChar(Last);
579       while (p1^=p2^) and (p1^<>#0) do begin
580         inc(p1);
581         inc(p2);
582       end;
583       l:=length(Cur)-(PChar(Cur)-p1);
584       w(GetBase32(l));
585       w('^');
586       if l>0 then
587         aStream.Write(p1^,l);
588     end else begin
589       w('^');
590       w(Cur);
591     end;
592     Last:=Cur;
593   end;}
594 
595 var
596   AVLNode: TAVLTreeNode;
597   CurUnit: TUDUnit;
598   Item: TUDIdentifier;
599   Group: TUDUnitGroup;
600   SubAVLNode: TAVLTreeNode;
601   UnitID: TFilenameToStringTree;
602   i: Integer;
603   ID: String;
604 begin
605   // write format version
606   w(UDFileHeader);
607   w(IntToStr(UDFileVersion));
608   w(LineEnding);
609 
610   UnitID:=TFilenameToStringTree.Create(false);
611   try
612     // write units
613     w('//BeginUnits'+LineEnding);
614     AVLNode:=FUnitsByFilename.FindLowest;
615     i:=0;
616     while AVLNode<>nil do begin
617       CurUnit:=TUDUnit(AVLNode.Data);
618       inc(i);
619       UnitID.Add(CurUnit.Filename,GetBase32(i));
620       // write unit number ; usecount ; unit name ; unit file name
621       w(UnitID[CurUnit.Filename]);
622       w(';');
623       w(IntToStr(CurUnit.UseCount));
624       w(';');
625       w(CurUnit.Name);
626       w(';');
627       w(CurUnit.Filename);
628       w(LineEnding);
629       // write identifiers
630       Item:=CurUnit.FirstIdentifier;
631       while Item<>nil do begin
632         if Item.Name<>'' then begin
633           w(Item.Name);
634           w(LineEnding);
635         end;
636         Item:=Item.NextInUnit;
637       end;
638       w(LineEnding); // empty line as end of unit
639       AVLNode:=FUnitsByFilename.FindSuccessor(AVLNode);
640     end;
641     w('//EndUnits'+LineEnding);
642 
643     // write groups
644     w('//BeginGroups'+LineEnding);
645     AVLNode:=FUnitGroupsByFilename.FindLowest;
646     while AVLNode<>nil do begin
647       Group:=TUDUnitGroup(AVLNode.Data);
648       // write group name ; usecount ; group file name
649       w(Group.Name);
650       w(';');
651       w(IntToStr(Group.UseCount));
652       w(';');
653       w(Group.Filename);
654       w(LineEnding);
655       // write IDs of units
656       SubAVLNode:=Group.Units.FindLowest;
657       while SubAVLNode<>nil do begin
658         CurUnit:=TUDUnit(SubAVLNode.Data);
659         ID:=UnitID[CurUnit.Filename];
660         if ID<>'' then begin
661           w(UnitID[CurUnit.Filename]);
662           w(LineEnding);
663         end;
664         SubAVLNode:=Group.Units.FindSuccessor(SubAVLNode);
665       end;
666       w(LineEnding); // empty line as end of group
667       AVLNode:=FUnitGroupsByFilename.FindSuccessor(AVLNode);
668     end;
669     w('//EndGroups'+LineEnding);
670   finally
671     UnitID.Free;
672   end;
673 end;
674 
675 procedure TUnitDictionary.LoadFromFile(const Filename: string; KeepData: boolean
676   );
677 var
678   UncompressedMS: TMemoryStream;
679 begin
680   UncompressedMS:=TMemoryStream.Create;
681   try
682     UncompressedMS.LoadFromFile(Filename);
683     UncompressedMS.Position:=0;
684     LoadFromStream(UncompressedMS,KeepData);
685   finally
686     UncompressedMS.Free;
687   end;
688 end;
689 
690 procedure TUnitDictionary.LoadFromStream(aStream: TMemoryStream;
691   KeepData: boolean);
692 var
693   Y: integer;
694   LineStart: PChar;
695   p: PChar;
696   EndP: PChar;
697   Version: Integer;
698   IDToUnit: TStringToPointerTree;
699 
700   procedure E(Msg: string; Col: PtrInt = -1);
701   var
702     s: String;
703   begin
704     s:='Error in line '+IntToStr(Y);
705     if Col=-1 then
706       Col:=p-LineStart+1;
707     if Col>0 then
708       s:=s+', column '+IntToStr(Col);
709     s:=s+': '+Msg;
710     raise ECTUnitDictionaryLoadError.Create(s);
711   end;
712 
ReadDecimalnull713   function ReadDecimal: integer;
714   var
715     s: PChar;
716   begin
717     Result:=0;
718     s:=p;
719     while (p<EndP) and (p^ in ['0'..'9']) do begin
720       Result:=Result*10+ord(p^)-ord('0');
721       inc(p);
722     end;
723     if s=p then
724       e('number expected, but '+dbgstr(p^)+' found.');
725   end;
726 
727   procedure ReadConstant(const Expected, ErrMsg: string);
728   var
729     i: Integer;
730   begin
731     i:=1;
732     while (i<=length(Expected)) do begin
733       if (p=EndP) or (p^<>Expected[i]) then
734         e(ErrMsg);
735       inc(p);
736       inc(i);
737     end;
738   end;
739 
740   procedure ReadLineEnding;
741   var
742     c: Char;
743   begin
744     if (p=EndP) or (not (p^ in [#10,#13])) then
745       e('line ending missing');
746     c:=p^;
747     inc(p);
748     if (p<EndP) and (p^ in [#10,#13]) and (c<>p^) then
749       inc(p);
750     inc(y);
751     LineStart:=p;
752   end;
753 
ReadFileFormatnull754   function ReadFileFormat: integer;
755   begin
756     ReadConstant(UDFileHeader,'invalid file header');
757     Result:=ReadDecimal;
758     ReadLineEnding;
759   end;
760 
761   procedure ReadUnits;
762   var
763     StartP: PChar;
764     UnitID, s, CurUnitName, UnitFilename, Identifier: string;
765     CurUnit: TUDUnit;
766     Item: TUDIdentifier;
767     Skip: boolean;
768     UseCount: Integer;
769   begin
770     ReadConstant('//BeginUnits','missing //BeginUnits header');
771     ReadLineEnding;
772 
773     repeat
774       // read unit id
775       StartP:=p;
776       while (p<EndP) and (p^ in ['0'..'9','A'..'Z']) do inc(p);
777       if (StartP=p) or (p^<>';') then
778         e('unit id expected, but found "'+dbgstr(p^)+'"');
779       SetLength(UnitID,p-StartP);
780       Move(StartP^,UnitID[1],length(UnitID));
781       inc(p); // skip semicolon
782 
783       // read usecount
784       UseCount:=0;
785       if Version>=2 then begin
786         StartP:=p;
787         while (p<EndP) and (p^ in ['0'..'9']) do inc(p);
788         if (StartP=p) or (p^<>';') then
789           e('unit use count expected, but found "'+dbgstr(p^)+'"');
790         SetLength(s,p-StartP);
791         Move(StartP^,s[1],length(s));
792         UseCount:=StrToInt64Def(s,0);
793         inc(p); // skip semicolon
794       end;
795 
796       // read unit name
797       StartP:=p;
798       while (p<EndP) and (p^ in ['0'..'9','A'..'Z','a'..'z','_','.']) do inc(p);
799       if (StartP=p) or (p^<>';') then
800         e('unit name expected, but found "'+dbgstr(p^)+'"');
801       SetLength(CurUnitName,p-StartP);
802       Move(StartP^,CurUnitName[1],length(CurUnitName));
803       inc(p); // skip semicolon
804 
805       // read file name
806       StartP:=p;
807       while (p<EndP) and (not (p^ in [#10,#13])) do inc(p);
808       if (StartP=p) or (not (p^ in [#10,#13])) then
809         e('file name expected, but found "'+dbgstr(p^)+'"');
810       SetLength(UnitFilename,p-StartP);
811       Move(StartP^,UnitFilename[1],length(UnitFilename));
812       ReadLineEnding;
813 
814       CurUnit:=FindUnitWithFilename(UnitFilename);
815       Skip:=false;
816       if CurUnit=nil then begin
817         // new unit
818         CurUnit:=AddUnit(UnitFilename,CurUnitName);
819         CurUnit.UseCount:=UseCount;
820       end else
821         Skip:=KeepData; // old unit
822       IDToUnit[UnitID]:=CurUnit;
823 
824       // read identifiers until empty line
825       repeat
826         StartP:=p;
827         while (p<EndP) and (p^ in ['0'..'9','A'..'Z','a'..'z','_']) do inc(p);
828         if (not (p^ in [#10,#13])) then
829           e('identifier expected, but found "'+dbgstr(p^)+'"');
830         if p=StartP then break;
831         SetLength(Identifier,p-StartP);
832         Move(StartP^,Identifier[1],length(Identifier));
833         ReadLineEnding;
834         if not Skip then begin
835           Item:=TUDIdentifier.Create(Identifier);
836           FIdentifiers.Add(Item);
837           CurUnit.AddIdentifier(Item);
838           //if not CurUnit.HasIdentifier(Item) then RaiseCatchableException('');
839         end;
840       until false;
841       ReadLineEnding;
842 
843     until (p=EndP) or (p^='/');
844 
845     ReadConstant('//EndUnits','missing //EndUnits footer');
846     ReadLineEnding;
847   end;
848 
849   procedure ReadGroups;
850   var
851     s, GroupName, GroupFilename, UnitID: string;
852     StartP: PChar;
853     Group: TUDUnitGroup;
854     CurUnit: TUDUnit;
855     UseCount: Integer;
856   begin
857     ReadConstant('//BeginGroups','missing //BeginGroups header');
858     ReadLineEnding;
859 
860     repeat
861       // read group name
862       StartP:=p;
863       while (p<EndP) and (p^ in ['0'..'9','A'..'Z','a'..'z','_','.']) do inc(p);
864       if (p^<>';') then
865         e('group name expected, but found "'+dbgstr(p^)+'"');
866       SetLength(GroupName,p-StartP);
867       if GroupName<>'' then
868         Move(StartP^,GroupName[1],length(GroupName));
869       inc(p); // skip semicolon
870 
871       // read usecount
872       UseCount:=0;
873       if Version>=2 then begin
874         StartP:=p;
875         while (p<EndP) and (p^ in ['0'..'9']) do inc(p);
876         if (StartP=p) or (p^<>';') then
877           e('group use count expected, but found "'+dbgstr(p^)+'"');
878         SetLength(s,p-StartP);
879         Move(StartP^,s[1],length(s));
880         UseCount:=StrToInt64Def(s,0);
881         inc(p); // skip semicolon
882       end;
883 
884       // read file name
885       StartP:=p;
886       while (p<EndP) and (not (p^ in [#10,#13])) do inc(p);
887       if (not (p^ in [#10,#13])) then
888         e('file name expected, but found "'+dbgstr(p^)+'"');
889       SetLength(GroupFilename,p-StartP);
890       if GroupFilename<>'' then
891         Move(StartP^,GroupFilename[1],length(GroupFilename));
892       ReadLineEnding;
893 
894       Group:=FindGroupWithFilename(GroupFilename);
895       if Group=nil then
896         Group:=AddUnitGroup(GroupFilename,GroupName);
897       Group.UseCount:=UseCount;
898 
899       // read units of group until empty line
900       repeat
901         StartP:=p;
902         while (p<EndP) and (p^ in ['0'..'9','A'..'Z','a'..'z','_']) do inc(p);
903         if (not (p^ in [#10,#13])) then
904           e('unit identifier expected, but found "'+dbgstr(p^)+'"');
905         if p=StartP then break;
906         SetLength(UnitID,p-StartP);
907         Move(StartP^,UnitID[1],length(UnitID));
908         ReadLineEnding;
909 
910         CurUnit:=TUDUnit(IDToUnit[UnitID]);
911         if CurUnit<>nil then begin
912           Group.AddUnit(CurUnit);
913         end else begin
914           debugln(['Warning: TUnitDictionary.LoadFromStream.ReadGroups unit id is not defined: ',UnitID]);
915         end;
916       until false;
917       ReadLineEnding;
918 
919     until (p=EndP) or (p^='/');
920 
921     ReadConstant('//EndGroups','missing //EndGroups footer');
922     ReadLineEnding;
923   end;
924 
925 begin
926   if not KeepData then
927     Clear;
928   if aStream.Size<=aStream.Position then
929     raise Exception.Create('This is not a UnitDictionary. Header missing.');
930   p:=PChar(aStream.Memory);
931   EndP:=p+aStream.Size;
932   LineStart:=p;
933   Y:=1;
934   Version:=ReadFileFormat;
935   if Version>UDFileVersion then
936     E('invalid version '+IntToStr(Version));
937   //debugln(['TUnitDictionary.LoadFromStream Version=',Version]);
938   IDToUnit:=TStringToPointerTree.Create(true);
939   try
940     ReadUnits;
941     ReadGroups;
942   finally
943     IDToUnit.Free;
944   end;
945 end;
946 
TUnitDictionary.Equalsnull947 function TUnitDictionary.Equals(Dictionary: TUnitDictionary): boolean;
948 var
949   Node1, Node2: TAVLTreeNode;
950   Group1: TUDUnitGroup;
951   Group2: TUDUnitGroup;
952   Unit1: TUDUnit;
953   Unit2: TUDUnit;
954   Item1: TUDIdentifier;
955   Item2: TUDIdentifier;
956 begin
957   Result:=false;
958   if Dictionary=nil then exit;
959   if Dictionary=Self then exit(true);
960   if UnitGroupsByFilename.Count<>Dictionary.UnitGroupsByFilename.Count then exit;
961   if UnitGroupsByName.Count<>Dictionary.UnitGroupsByName.Count then exit;
962   if UnitsByFilename.Count<>Dictionary.UnitsByFilename.Count then exit;
963   if UnitsByName.Count<>Dictionary.UnitsByName.Count then exit;
964   if Identifiers.Count<>Dictionary.Identifiers.Count then exit;
965 
966   Node1:=UnitGroupsByFilename.FindLowest;
967   Node2:=Dictionary.UnitGroupsByFilename.FindLowest;
968   while Node1<>nil do begin
969     Group1:=TUDUnitGroup(Node1.Data);
970     Group2:=TUDUnitGroup(Node2.Data);
971     if Group1.Name<>Group2.Name then exit;
972     if Group1.Filename<>Group2.Filename then exit;
973     Node1:=UnitGroupsByFilename.FindSuccessor(Node1);
974     Node2:=UnitGroupsByFilename.FindSuccessor(Node2);
975   end;
976 
977   Node1:=UnitsByFilename.FindLowest;
978   Node2:=Dictionary.UnitsByFilename.FindLowest;
979   while Node1<>nil do begin
980     Unit1:=TUDUnit(Node1.Data);
981     Unit2:=TUDUnit(Node2.Data);
982     if Unit1.Name<>Unit2.Name then exit;
983     if Unit1.Filename<>Unit2.Filename then exit;
984 
985     Item1:=Unit1.FirstIdentifier;
986     Item2:=Unit2.FirstIdentifier;
987     while (Item1<>nil) and (Item2<>nil) do begin
988       if Item1.Name<>Item2.Name then begin
989         //debugln(['TUnitDictionary.Equals Item1.Name=',Item1.Name,'<>Item2.Name=',Item2.Name]);
990         exit;
991       end;
992       Item1:=Item1.NextInUnit;
993       Item2:=Item2.NextInUnit;
994     end;
995     if (Item1<>nil) then exit;
996     if (Item2<>nil) then exit;
997     Node1:=UnitGroupsByFilename.FindSuccessor(Node1);
998     Node2:=UnitGroupsByFilename.FindSuccessor(Node2);
999   end;
1000 
1001   Result:=true
1002 end;
1003 
1004 procedure TUnitDictionary.IncreaseChangeStamp;
1005 begin
1006   CTIncreaseChangeStamp64(FChangeStamp);
1007 end;
1008 
AddUnitGroupnull1009 function TUnitDictionary.AddUnitGroup(Group: TUDUnitGroup): TUDUnitGroup;
1010 begin
1011   if Group.Dictionary<>nil then
1012     raise Exception.Create('TIdentifierDictionary.AddUnitGroup Group.Dictionary<>nil');
1013   Result:=Group;
1014   Result.Dictionary:=Self;
1015   FUnitGroupsByName.Add(Result);
1016   FUnitGroupsByFilename.Add(Result);
1017   IncreaseChangeStamp;
1018 end;
1019 
AddUnitGroupnull1020 function TUnitDictionary.AddUnitGroup(aFilename: string; aName: string
1021   ): TUDUnitGroup;
1022 begin
1023   aFilename:=TrimFilename(aFilename);
1024   if aName='' then aName:=ExtractFileNameOnly(aFilename);
1025   Result:=FindGroupWithFilename(aFilename);
1026   if Result<>nil then begin
1027     // group already exists
1028     // => improve name
1029     if (Result.Name<>aName)
1030     and ((Result.Name=lowercase(Result.Name))
1031       or (Result.Name=UpperCase(Result.Name)))
1032     then begin
1033       // old had the default name => use newer name
1034       Result.Name:=aName;
1035       IncreaseChangeStamp;
1036     end;
1037   end else begin
1038     // create new group
1039     Result:=AddUnitGroup(TUDUnitGroup.Create(aName,aFilename));
1040   end;
1041 end;
1042 
1043 procedure TUnitDictionary.DeleteGroup(Group: TUDUnitGroup;
1044   DeleteUnitsWithoutGroup: boolean);
1045 var
1046   Node: TAVLTreeNode;
1047   CurUnit: TUDUnit;
1048 begin
1049   if Group=NoGroup then
1050     raise Exception.Create('The default group can not be deleted');
1051   // remove units
1052   Node:=Group.Units.FindLowest;
1053   while Node<>nil do begin
1054     CurUnit:=TUDUnit(Node.Data);
1055     AVLRemovePointer(CurUnit.Groups,Group);
1056     if CurUnit.Groups.Count=0 then begin
1057       if DeleteUnitsWithoutGroup then
1058         DeleteUnit(CurUnit,false)
1059       else
1060         NoGroup.AddUnit(CurUnit);
1061     end;
1062     Node:=Group.Units.FindSuccessor(Node);
1063   end;
1064   Group.Units.Clear;
1065   // remove group from trees
1066   AVLRemovePointer(UnitGroupsByFilename,Group);
1067   AVLRemovePointer(UnitGroupsByName,Group);
1068   // free group
1069   Group.Free;
1070   IncreaseChangeStamp;
1071 end;
1072 
TUnitDictionary.FindGroupWithFilenamenull1073 function TUnitDictionary.FindGroupWithFilename(const aFilename: string
1074   ): TUDUnitGroup;
1075 var
1076   AVLNode: TAVLTreeNode;
1077 begin
1078   AVLNode:=FUnitGroupsByFilename.FindKey(Pointer(aFilename),@CompareFileNameWithIDFileItem);
1079   if AVLNode<>nil then
1080     Result:=TUDUnitGroup(AVLNode.Data)
1081   else
1082     Result:=nil;
1083 end;
1084 
TUnitDictionary.AddUnitnull1085 function TUnitDictionary.AddUnit(const aFilename: string; aName: string;
1086   Group: TUDUnitGroup): TUDUnit;
1087 begin
1088   if Group=nil then
1089     Group:=NoGroup;
1090   Result:=FindUnitWithFilename(aFilename);
1091   if Result=nil then begin
1092     Result:=TUDUnit.Create(aName,aFilename);
1093     FUnitsByFilename.Add(Result);
1094     FUnitsByName.Add(Result);
1095     IncreaseChangeStamp;
1096   end;
1097   Group.AddUnit(Result);
1098 end;
1099 
1100 procedure TUnitDictionary.DeleteUnit(TheUnit: TUDUnit;
1101   DeleteEmptyGroups: boolean);
1102 var
1103   Node: TAVLTreeNode;
1104   Group: TUDUnitGroup;
1105 begin
1106   Node:=TheUnit.Groups.FindLowest;
1107   // remove unit from groups
1108   while Node<>nil do begin
1109     Group:=TUDUnitGroup(Node.Data);
1110     Node:=TheUnit.Groups.FindSuccessor(Node);
1111     AVLRemovePointer(Group.Units,TheUnit);
1112     if DeleteEmptyGroups and (Group.Units.Count=0)
1113     and (Group<>NoGroup) then
1114       DeleteGroup(Group,false);
1115   end;
1116   TheUnit.Groups.Clear;
1117   // free identifiers
1118   ClearIdentifiersOfUnit(TheUnit);
1119   // remove unit from dictionary
1120   AVLRemovePointer(UnitsByFilename,TheUnit);
1121   AVLRemovePointer(UnitsByName,TheUnit);
1122   // free unit
1123   TheUnit.Free;
1124   IncreaseChangeStamp;
1125 end;
1126 
ParseUnitnull1127 function TUnitDictionary.ParseUnit(UnitFilename: string; Group: TUDUnitGroup): TUDUnit;
1128 var
1129   Code: TCodeBuffer;
1130 begin
1131   Result:=nil;
1132   UnitFilename:=TrimFilename(UnitFilename);
1133   if UnitFilename='' then exit;
1134   Code:=CodeToolBoss.LoadFile(UnitFilename,true,false);
1135   if Code=nil then
1136     raise Exception.Create('unable to load file '+UnitFilename);
1137   Result:=ParseUnit(Code,Group);
1138 end;
1139 
ParseUnitnull1140 function TUnitDictionary.ParseUnit(Code: TCodeBuffer; Group: TUDUnitGroup): TUDUnit;
1141 begin
1142   Result:=nil;
1143   if Code=nil then exit;
1144   if not CodeToolBoss.InitCurCodeTool(Code) then
1145     raise Exception.Create('unable to init unit parser for file '+Code.Filename);
1146   Result:=ParseUnit(CodeToolBoss.CurCodeTool,Group);
1147 end;
1148 
ParseUnitnull1149 function TUnitDictionary.ParseUnit(Tool: TCodeTool; Group: TUDUnitGroup): TUDUnit;
1150 var
1151   SrcTree: TAVLTree;
1152   AVLNode: TAVLTreeNode;
1153   SrcItem: PInterfaceIdentCacheEntry;
1154   UnitFilename: String;
1155   NiceName: String;
1156   SrcName: String;
1157   NewItem, PrevItem, CurItem, NextItem: TUDIdentifier;
1158   Changed: Boolean;
1159 begin
1160   Result:=nil;
1161   if Tool=nil then exit;
1162   if Group=nil then
1163     Group:=NoGroup;
1164   // parse unit
1165   Tool.BuildInterfaceIdentifierCache(true);
1166 
1167   // get unit name from source
1168   UnitFilename:=Tool.MainFilename;
1169   NiceName:=ExtractFileNameOnly(UnitFilename);
1170   if (LowerCase(NiceName)=NiceName)
1171   or (UpperCase(NiceName)=NiceName) then begin
1172     SrcName:=Tool.GetSourceName(false);
1173     if CompareDottedIdentifiers(PChar(SrcName),PChar(NiceName))=0 then
1174       NiceName:=SrcName;
1175   end;
1176 
1177   // find/create unit
1178   Result:=FindUnitWithFilename(UnitFilename);
1179   if Result<>nil then begin
1180     // old unit
1181     if (Group<>NoGroup) then begin
1182       Group.AddUnit(Result);
1183     end;
1184     // update name
1185     if Result.Name<>NiceName then
1186       Result.Name:=NiceName;
1187     if Result.ToolStamp=Tool.TreeChangeStep then begin
1188       // nothing changed since last parsing
1189       exit;
1190     end;
1191     Result.ToolStamp:=Tool.TreeChangeStep;
1192   end else begin
1193     // new unit
1194     Result:=AddUnit(UnitFilename,NiceName,Group);
1195   end;
1196 
1197   // update list of identifiers
1198   Changed:=false;
1199   SrcTree:=Tool.InterfaceIdentifierCache.Items;
1200   if SrcTree<>nil then begin
1201     AVLNode:=SrcTree.FindLowest;
1202     PrevItem:=nil;
1203     CurItem:=Result.FirstIdentifier;
1204     //debugln(['TUnitDictionary.ParseUnit ',SrcTree.Count]);
1205     while AVLNode<>nil do begin
1206       SrcItem:=PInterfaceIdentCacheEntry(AVLNode.Data);
1207       //debugln(['TUnitDictionary.ParseUnit ',GetIdentifier(SrcItem^.Identifier)]);
1208       if (SrcItem^.Node<>nil) and (SrcItem^.Identifier<>nil) then begin
1209         while (CurItem<>nil)
1210         and (CompareDottedIdentifiers(PChar(Pointer(CurItem.Name)),SrcItem^.Identifier)<0)
1211         do begin
1212           // delete old item
1213           //debugln(['TUnitDictionary.ParseUnit delete old item '+CurItem.Name+' in '+Result.Name]);
1214           Changed:=true;
1215           NextItem:=CurItem.NextInUnit;
1216           if PrevItem<>nil then
1217             PrevItem.NextInUnit:=NextItem
1218           else
1219             Result.FirstIdentifier:=NextItem;
1220           if Result.LastIdentifier=CurItem then
1221             Result.LastIdentifier:=PrevItem;
1222           AVLRemovePointer(Identifiers,CurItem);
1223           CurItem.Free;
1224           CurItem:=NextItem;
1225         end;
1226         if (CurItem=nil)
1227         or (CompareDottedIdentifiers(PChar(Pointer(CurItem.Name)),SrcItem^.Identifier)>0)
1228         then begin
1229           // new item
1230           //debugln(['TUnitDictionary.ParseUnit inserting new item '+GetIdentifier(SrcItem^.Identifier)+' in '+Result.Name]);
1231           Changed:=true;
1232           NewItem:=TUDIdentifier.Create(SrcItem^.Identifier);
1233           NewItem.DUnit:=Result;
1234           NewItem.NextInUnit:=CurItem;
1235           if PrevItem<>nil then
1236             PrevItem.NextInUnit:=NewItem
1237           else
1238             Result.FirstIdentifier:=NewItem;
1239           if CurItem=nil then begin
1240             // at end of list
1241             PrevItem:=NewItem;
1242             Result.LastIdentifier:=NewItem;
1243           end;
1244           FIdentifiers.Add(NewItem);
1245         end else begin
1246           // already in list, skip
1247           //debugln(['TUnitDictionary.ParseUnit keep '+CurItem.Name]);
1248           PrevItem:=CurItem;
1249           CurItem:=CurItem.NextInUnit;
1250         end;
1251       end;
1252       AVLNode:=SrcTree.FindSuccessor(AVLNode);
1253     end;
1254   end;
1255 
1256   if Changed then
1257     IncreaseChangeStamp;
1258 end;
1259 
FindUnitWithFilenamenull1260 function TUnitDictionary.FindUnitWithFilename(const aFilename: string): TUDUnit;
1261 var
1262   AVLNode: TAVLTreeNode;
1263 begin
1264   AVLNode:=FUnitsByFilename.FindKey(Pointer(aFilename),@CompareFileNameWithIDFileItem);
1265   if AVLNode<>nil then
1266     Result:=TUDUnit(AVLNode.Data)
1267   else
1268     Result:=nil;
1269 end;
1270 
1271 procedure TUnitDictionary.IncreaseUnitUseCount(TheUnit: TUDUnit);
1272 var
1273   Cnt: Int64;
1274 begin
1275   Cnt:=TheUnit.UseCount;
1276   if Cnt<High(Cnt) then inc(Cnt);
1277   if TheUnit.UseCount=Cnt then exit;
1278   TheUnit.UseCount:=Cnt;
1279   IncreaseChangeStamp;
1280 end;
1281 
1282 end.
1283 
1284