/components/codetools/ppugraph.pas

  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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
 18 *                                                                         *
 19 ***************************************************************************
 20
 21  Author: Mattias Gaertner
 22
 23  Abstract:
 24    Functions and classes to build dependency graphs for ppu files.
 25}
 26unit PPUGraph;
 27
 28{$mode objfpc}{$H+}
 29
 30interface
 31
 32uses
 33  Classes, SysUtils, dynlibs, PPUParser, CodeTree, AVL_Tree, FileProcs,
 34  LazFileUtils, BasicCodeTools, CodeGraph, CodeToolManager, CodeToolsStructs;
 35
 36const
 37  FPCPPUGroupPrefix = 'fpc_';
 38  
 39type
 40  TPPUGroup = class;
 41
 42  TPPUMemberFlag = (
 43    pmfDisabled,
 44    pmfAutoDisabled
 45    );
 46  TPPUMemberFlags = set of TPPUMemberFlag;
 47  
 48  { TPPUMember }
 49
 50  TPPUMember = class
 51  public
 52    Unit_Name: string;
 53    PPUFilename: string;
 54    KeyNode: TCodeTreeNode;
 55    InitializationMangledName: string;
 56    FinalizationMangledName: string;
 57    MainUses: TStrings;
 58    ImplementationUses: TStrings;
 59    Group: TPPUGroup;
 60    PPU: TPPU;
 61    Flags: TPPUMemberFlags;
 62    constructor Create;
 63    destructor Destroy; override;
 64    function UpdatePPU: boolean;
 65    procedure GetMissingUnits(var List: TStrings);
 66  end;
 67
 68  TPPUGroups = class;
 69
 70  { TPPUGroup }
 71
 72  TPPUGroup = class
 73  private
 74    FMembers: TAVLTree;// tree of TPPUMember sorted for AUnitName
 75    FUnitGraph: TCodeGraph;
 76    FSortedUnits: TFPList;// list of TPPUMember
 77    function FindAVLNodeOfMemberWithUnitName(const AName: string): TAVLTreeNode;
 78    function GetSortedUnits(Index: integer): TPPUMember;
 79    procedure InternalRemoveMember(AMember: TPPUMember);
 80    procedure UpdateTopologicalSortedList;
 81  public
 82    Name: string;
 83    KeyNode: TCodeTreeNode;
 84    Groups: TPPUGroups;
 85    LibName: string;
 86    constructor Create;
 87    destructor Destroy; override;
 88    procedure Clear;
 89    function AddMember(const NewUnitName: string): TPPUMember;
 90    function FindMemberWithUnitName(const AName: string): TPPUMember;
 91    function UpdatePPUs: boolean;
 92    function UpdateDependencies: boolean;
 93    function UpdateLoader: boolean;
 94    procedure GetMissingUnits(var List: TStrings);
 95    property Members: TAVLTree read FMembers;
 96    property UnitGraph: TCodeGraph read FUnitGraph;
 97    property SortedUnits[Index: integer]: TPPUMember read GetSortedUnits;
 98  end;
 99
100  { TPPUGroups }
101
102  TPPUGroups = class
103  private
104    FGroups: TAVLTree;// tree of TPPUGroup sorted for name
105    FMembers: TAVLTree;// tree of TPPUMember sorted for AUnitName
106    FGroupGraph: TCodeGraph;
107    FUnitGraph: TCodeGraph;
108    FSortedGroups: TFPList; // list of TPPUGroup
109    function FindAVLNodeOfGroupWithName(const AName: string): TAVLTreeNode;
110    function FindAVLNodeOfMemberWithName(const AName: string): TAVLTreeNode;
111    function GetSortedGroups(Index: integer): TPPUGroup;
112    procedure InternalRemoveMember(AMember: TPPUMember);
113    procedure InternalRemoveGroup(AGroup: TPPUGroup);
114    procedure UpdateTopologicalSortedList;
115  public
116    Name: string;
117    constructor Create;
118    destructor Destroy; override;
119    procedure Clear;
120    procedure ClearAutoDisableFlags;
121    function AddGroup(const NewName: string): TPPUGroup;
122    procedure AddFPCGroupsForCurrentCompiler(const BaseDirectory: string);
123    procedure AddFPCGroups(const FPCPPUBaseDir: string); // for example: /usr/lib/fpc/2.2.3/units/i386-linux/
124    procedure AddFPCGroup(const BaseGroupname, Directory: string);
125    function FindGroupWithName(const AName: string): TPPUGroup;
126    function FindMemberWithUnitName(const AName: string): TPPUMember;
127    function UpdateDependencies: boolean;
128    function UpdateLoaders: boolean;
129    procedure AutoDisableUnitsWithBrokenDependencies;
130    procedure AutoDisableMember(Member: TPPUMember);
131    procedure GetMissingUnits(var List: TStrings);
132    property GroupGraph: TCodeGraph read FGroupGraph;
133    property UnitGraph: TCodeGraph read FUnitGraph;
134    property SortedGroups[Index: integer]: TPPUGroup read GetSortedGroups;
135  end;
136  
137function ComparePPUMembersByUnitName(Member1, Member2: Pointer): integer;
138function CompareNameWithPPUMemberName(NamePChar, Member: Pointer): integer;
139
140function ComparePPUGroupsByName(Group1, Group2: Pointer): integer;
141function CompareNameWithPPUGroupName(NamePChar, Group: Pointer): integer;
142
143function PPUGroupObjectAsString(Obj: TObject): string;
144
145implementation
146
147function ComparePPUMembersByUnitName(Member1, Member2: Pointer): integer;
148begin
149  Result:=CompareIdentifierPtrs(Pointer(TPPUMember(Member1).Unit_Name),
150                                Pointer(TPPUMember(Member2).Unit_Name));
151end;
152
153function CompareNameWithPPUMemberName(NamePChar, Member: Pointer): integer;
154begin
155  Result:=CompareIdentifierPtrs(NamePChar,Pointer(TPPUMember(Member).Unit_Name));
156end;
157
158function ComparePPUGroupsByName(Group1, Group2: Pointer): integer;
159begin
160  Result:=CompareIdentifierPtrs(Pointer(TPPUGroup(Group1).Name),
161                                Pointer(TPPUGroup(Group2).Name));
162end;
163
164function CompareNameWithPPUGroupName(NamePChar, Group: Pointer): integer;
165begin
166  Result:=CompareIdentifierPtrs(NamePChar,Pointer(TPPUGroup(Group).Name));
167end;
168
169function PPUGroupObjectAsString(Obj: TObject): string;
170begin
171  if Obj is TPPUMember then
172    Result:='unit '+TPPUMember(Obj).Unit_Name
173  else if Obj is TPPUGroup then
174    Result:='group '+TPPUGroup(Obj).Name
175  else
176    Result:=dbgs(Obj);
177end;
178
179{ TPPUMember }
180
181constructor TPPUMember.Create;
182begin
183  KeyNode:=TCodeTreeNode.Create;
184  MainUses:=TStringList.Create;
185  ImplementationUses:=TStringList.Create;
186end;
187
188destructor TPPUMember.Destroy;
189begin
190  FreeAndNil(PPU);
191  FreeAndNil(MainUses);
192  FreeAndNil(ImplementationUses);
193  FreeAndNil(KeyNode);
194  if Group<>nil then
195    Group.InternalRemoveMember(Self);
196  inherited Destroy;
197end;
198
199function TPPUMember.UpdatePPU: boolean;
200begin
201  Result:=false;
202  MainUses.Clear;
203  ImplementationUses.Clear;
204  InitializationMangledName:='';
205  FinalizationMangledName:='';
206  if PPU=nil then PPU:=TPPU.Create(Self);
207  PPU.LoadFromFile(PPUFilename);
208  debugln('================================================================');
209  DebugLn(['TPPUMember.UpdatePPU Group=',Group.Name,' AUnitName=',Unit_Name,' Filename=',PPUFilename]);
210  //PPU.Dump('');
211  PPU.GetMainUsesSectionNames(MainUses);
212  if MainUses.Count>0 then
213    debugln('Main used units: ',MainUses.DelimitedText);
214  PPU.GetImplementationUsesSectionNames(ImplementationUses);
215  if ImplementationUses.Count>0 then
216    debugln('Implementation used units: ',ImplementationUses.DelimitedText);
217  InitializationMangledName:=PPU.GetInitProcName;
218  //debugln('Initialization proc: ',InitializationMangledName);
219  FinalizationMangledName:=PPU.GetFinalProcName;
220  //debugln('Finalization proc: ',FinalizationMangledName);
221  
222  Result:=true;
223end;
224
225procedure TPPUMember.GetMissingUnits(var List: TStrings);
226
227  procedure GetMissing(UsesList: TStrings);
228  var
229    i: Integer;
230    CurUnitName: string;
231  begin
232    if UsesList=nil then exit;
233    for i:=0 to UsesList.Count-1 do begin
234      CurUnitName:=UsesList[i];
235      if Group.Groups.FindMemberWithUnitName(CurUnitName)=nil then begin
236        if List=nil then
237          List:=TStringList.Create;
238        if List.IndexOf(CurUnitName)<0 then
239          List.Add(CurUnitName);
240      end;
241    end;
242  end;
243
244begin
245  GetMissing(MainUses);
246  GetMissing(ImplementationUses);
247end;
248
249{ TPPUGroup }
250
251function TPPUGroup.FindAVLNodeOfMemberWithUnitName(const AName: string
252  ): TAVLTreeNode;
253begin
254  Result:=FMembers.FindKey(PChar(AName),@CompareNameWithPPUMemberName);
255end;
256
257function TPPUGroup.GetSortedUnits(Index: integer): TPPUMember;
258begin
259  Result:=TPPUMember(TCodeGraphNode(FSortedUnits[Index]).Data);
260end;
261
262procedure TPPUGroup.InternalRemoveMember(AMember: TPPUMember);
263begin
264  FUnitGraph.DeleteGraphNode(AMember.KeyNode);
265  AVLRemovePointer(FMembers,AMember);
266  if Groups<>nil then
267    Groups.InternalRemoveMember(AMember);
268end;
269
270procedure TPPUGroup.UpdateTopologicalSortedList;
271begin
272  FreeAndNil(FSortedUnits);
273  UnitGraph.GetTopologicalSortedList(FSortedUnits,true,false,false);
274  if FSortedUnits=nil then
275    FSortedUnits:=TFPList.Create;
276  //DebugLn(['TPPUGroup.UpdateTopologicalSortedList ',Name,' ',FMembers.Count,' ',FSortedUnits.Count]);
277end;
278
279constructor TPPUGroup.Create;
280begin
281  FMembers:=TAVLTree.Create(@ComparePPUMembersByUnitName);
282  KeyNode:=TCodeTreeNode.Create;
283  FUnitGraph:=TCodeGraph.Create;
284end;
285
286destructor TPPUGroup.Destroy;
287begin
288  Clear;
289  FreeAndNil(FUnitGraph);
290  FreeAndNil(FMembers);
291  FreeAndNil(KeyNode);
292  if Groups<>nil then
293    Groups.InternalRemoveGroup(Self);
294  inherited Destroy;
295end;
296
297procedure TPPUGroup.Clear;
298begin
299  FreeAndNil(FSortedUnits);
300  FUnitGraph.Clear;
301  while FMembers.Count>0 do
302    TPPUMember(FMembers.Root.Data).Free;
303end;
304
305function TPPUGroup.AddMember(const NewUnitName: string): TPPUMember;
306begin
307  Result:=FindMemberWithUnitName(NewUnitName);
308  if Result<>nil then exit;
309  Result:=TPPUMember.Create;
310  Result.Unit_Name:=NewUnitName;
311  FMembers.Add(Result);
312  Result.Group:=Self;
313  Groups.FMembers.Add(Result);
314end;
315
316function TPPUGroup.FindMemberWithUnitName(const AName: string): TPPUMember;
317var
318  AVLNode: TAVLTreeNode;
319begin
320  AVLNode:=FindAVLNodeOfMemberWithUnitName(AName);
321  if AVLNode<>nil then
322    Result:=TPPUMember(AVLNode.Data)
323  else
324    Result:=nil;
325end;
326
327function TPPUGroup.UpdatePPUs: boolean;
328var
329  AVLNode: TAVLTreeNode;
330  Member: TPPUMember;
331begin
332  Result:=true;
333  // load all PPU
334  AVLNode:=FMembers.FindLowest;
335  while AVLNode<>nil do begin
336    Member:=TPPUMember(AVLNode.Data);
337    if not Member.UpdatePPU then exit(false);
338    AVLNode:=FMembers.FindSuccessor(AVLNode);
339  end;
340end;
341
342function TPPUGroup.UpdateDependencies: boolean;
343
344  procedure AddUnitDependency(Member: TPPUMember; const UsedUnit: string);
345  var
346    Graph: TCodeGraph;
347    UsedMember: TPPUMember;
348  begin
349    UsedMember:=Groups.FindMemberWithUnitName(UsedUnit);
350    if UsedMember=nil then begin
351      DebugLn(['AddUnitDependency ',Member.Unit_Name,' misses an unit: ',UsedUnit]);
352      exit;
353    end;
354    // add to 'global' unit graph
355    Graph:=Groups.UnitGraph;
356    if not Graph.PathExists(UsedMember.KeyNode,Member.KeyNode) then
357      Graph.AddEdge(Member.KeyNode,UsedMember.KeyNode)
358    else
359      DebugLn(['AddUnitDependency Unit circle found: ',Member.Unit_Name,' to ',UsedMember.Unit_Name]);
360    if Member.Group=UsedMember.Group then begin
361      // add to unit graph of group
362      Graph:=Member.Group.UnitGraph;
363      if not Graph.PathExists(UsedMember.KeyNode,Member.KeyNode) then
364        Graph.AddEdge(Member.KeyNode,UsedMember.KeyNode)
365      else
366        DebugLn(['AddUnitDependency Unit circle found: ',Member.Unit_Name,' to ',UsedMember.Unit_Name]);
367    end else begin
368      // add to 'global' package graph
369      if not Groups.GroupGraph.PathExists(UsedMember.Group.KeyNode,Member.Group.KeyNode) then
370        Groups.GroupGraph.AddEdge(Member.Group.KeyNode,UsedMember.Group.KeyNode)
371      else
372        DebugLn(['AddUnitDependency Group circle found: ',Member.Group.Name,' to ',UsedMember.Group.Name]);
373    end;
374  end;
375
376  procedure AddSectionDependencies(Member: TPPUMember; UsesList: TStrings);
377  var
378    i: Integer;
379  begin
380    if UsesList=nil then exit;
381    for i:=0 to UsesList.Count-1 do
382      AddUnitDependency(Member,UsesList[i]);
383  end;
384  
385  procedure AddDependencies(Main: boolean);
386  var
387    AVLNode: TAVLTreeNode;
388    Member: TPPUMember;
389  begin
390    AVLNode:=FMembers.FindLowest;
391    while AVLNode<>nil do begin
392      Member:=TPPUMember(AVLNode.Data);
393      if Main then
394        AddSectionDependencies(Member,Member.MainUses)
395      else
396        AddSectionDependencies(Member,Member.ImplementationUses);
397      AVLNode:=FMembers.FindSuccessor(AVLNode);
398    end;
399  end;
400
401var
402  AVLNode: TAVLTreeNode;
403  Member: TPPUMember;
404  GraphNode: TCodeGraphNode;
405begin
406  Result:=false;
407  FUnitGraph.Clear;
408
409  // create graph nodes
410  AVLNode:=FMembers.FindLowest;
411  while AVLNode<>nil do begin
412    Member:=TPPUMember(AVLNode.Data);
413    GraphNode:=UnitGraph.AddGraphNode(Member.KeyNode);
414    GraphNode.Data:=Member;
415    AVLNode:=FMembers.FindSuccessor(AVLNode);
416  end;
417  
418  // add primary dependencies
419  AddDependencies(true);
420  // add secondary dependencies
421  AddDependencies(false);
422
423  // sort topological
424  UpdateTopologicalSortedList;
425
426  Result:=true;
427end;
428
429function TPPUGroup.UpdateLoader: boolean;
430
431  function StringToParagraph(Code: string): string;
432  const
433    MaxLineLen=80;
434  var
435    p: Integer;
436    LineLen: Integer;
437    BreakPos: Integer;
438    Indent: String;
439    InsertStr: String;
440  begin
441    Result:=Code;
442    p:=1;
443    LineLen:=0;
444    BreakPos:=0;
445    Indent:='      ';
446    while (p<length(Result)) do begin
447      if (LineLen>=MaxLineLen) and (BreakPos>0) then begin
448        if Result[BreakPos]=',' then begin
449          InsertStr:=LineEnding+Indent;
450          LineLen:=length(Indent);
451        end else begin
452          InsertStr:=''''+LineEnding+Indent+'+''';
453          LineLen:=length(Indent)+2;
454        end;
455        Result:=copy(Result,1,BreakPos)+InsertStr+copy(Result,BreakPos+1,length(Result));
456        inc(p,length(InsertStr));
457        BreakPos:=0;
458      end else begin
459        if Result[p] in [',',';'] then
460          BreakPos:=p;
461        inc(p);
462        inc(LineLen);
463      end;
464    end;
465  end;
466
467var
468  i: Integer;
469  GraphNode: TCodeGraphNode;
470  Member: TPPUMember;
471  Group: TPPUGroup;
472  NeededLibs: String;
473  InitProcs: String;
474  FinalProcs: String;
475  s: String;
476  RegisterFPLibProcName: String;
477begin
478  Result:=true;
479  LibName:=Name+'.'+SharedSuffix;
480  // needed groups in topological order
481  if Groups.GroupGraph.GetGraphNode(KeyNode,false)=nil then
482    raise Exception.Create('inconsistency');
483    
484    
485  NeededLibs:='';
486  for i:=0 to Groups.FSortedGroups.Count-1 do begin
487    Group:=Groups.SortedGroups[i];
488    if Groups.GroupGraph.GetGraphNode(Group.KeyNode,false)=nil then
489      raise Exception.Create('inconsistency');
490    if Groups.GroupGraph.GetEdge(KeyNode,Group.KeyNode,false)<>nil then begin
491      if NeededLibs<>'' then NeededLibs:=NeededLibs+';';
492      NeededLibs:=NeededLibs+Group.Name;
493    end;
494  end;
495  // initialize units
496  InitProcs:='';
497  for i:=FSortedUnits.Count-1 downto 0 do begin
498    GraphNode:=TCodeGraphNode(FSortedUnits[i]);
499    Member:=TPPUMember(GraphNode.Data);
500    if Member.InitializationMangledName<>'' then begin
501      if InitProcs<>'' then InitProcs:=InitProcs+';';
502      InitProcs:=InitProcs+Member.InitializationMangledName;
503    end;
504  end;
505  // finalize units
506  FinalProcs:='';
507  for i:=0 to FSortedUnits.Count-1 do begin
508    GraphNode:=TCodeGraphNode(FSortedUnits[i]);
509    Member:=TPPUMember(GraphNode.Data);
510    if Member.FinalizationMangledName<>'' then begin
511      if FinalProcs<>'' then FinalProcs:=FinalProcs+';';
512      FinalProcs:=FinalProcs+Member.FinalizationMangledName;
513    end;
514  end;
515  RegisterFPLibProcName:='REGISTER_FPLIBRARY_'+UpperCase(Name);
516  s:=  'procedure '+RegisterFPLibProcName+';[public, alias : '''+RegisterFPLibProcName+'''];'+LineEnding;
517  s:=s+'begin'+LineEnding;
518  s:=s+StringToParagraph('  RegisterFPDynLib('''+Name+''','''+NeededLibs+''','''+InitProcs+''','''+FinalProcs+''');')+LineEnding;
519  s:=s+'end;'+LineEnding;
520  Debugln(s);
521end;
522
523procedure TPPUGroup.GetMissingUnits(var List: TStrings);
524var
525  Member: TPPUMember;
526  AVLNode: TAVLTreeNode;
527begin
528  AVLNode:=FMembers.FindLowest;
529  while AVLNode<>nil do begin
530    Member:=TPPUMember(AVLNode.Data);
531    Member.GetMissingUnits(List);
532    AVLNode:=FMembers.FindSuccessor(AVLNode);
533  end;
534end;
535
536{ TPPUGroups }
537
538function TPPUGroups.FindAVLNodeOfGroupWithName(const AName: string
539  ): TAVLTreeNode;
540begin
541  Result:=FGroups.FindKey(PChar(AName),@CompareNameWithPPUGroupName);
542end;
543
544function TPPUGroups.FindAVLNodeOfMemberWithName(const AName: string
545  ): TAVLTreeNode;
546begin
547  Result:=FMembers.FindKey(PChar(AName),@CompareNameWithPPUMemberName);
548end;
549
550function TPPUGroups.GetSortedGroups(Index: integer): TPPUGroup;
551begin
552  Result:=TPPUGroup(TCodeGraphNode(FSortedGroups[Index]).Data);
553end;
554
555procedure TPPUGroups.InternalRemoveMember(AMember: TPPUMember);
556begin
557  AVLRemovePointer(FMembers,AMember);
558end;
559
560procedure TPPUGroups.InternalRemoveGroup(AGroup: TPPUGroup);
561begin
562  AVLRemovePointer(FGroups,AGroup);
563end;
564
565procedure TPPUGroups.UpdateTopologicalSortedList;
566begin
567  FreeAndNil(FSortedGroups);
568  GroupGraph.GetTopologicalSortedList(FSortedGroups,false,false,false);
569  if FSortedGroups=nil then
570    FSortedGroups:=TFPList.Create;
571  //DebugLn(['TPPUGroups.UpdateTopologicalSortedList ',FGroups.Count,' ',FSortedGroups.Count]);
572end;
573
574constructor TPPUGroups.Create;
575begin
576  FGroups:=TAVLTree.Create(@ComparePPUGroupsByName);
577  FMembers:=TAVLTree.Create(@ComparePPUMembersByUnitName);
578  FGroupGraph:=TCodeGraph.Create;
579  FUnitGraph:=TCodeGraph.Create;
580end;
581
582destructor TPPUGroups.Destroy;
583begin
584  Clear;
585  FreeAndNil(FUnitGraph);
586  FreeAndNil(FGroupGraph);
587  FreeAndNil(FGroups);
588  FreeAndNil(FMembers);
589  inherited Destroy;
590end;
591
592procedure TPPUGroups.Clear;
593begin
594  FreeAndNil(FSortedGroups);
595  FGroupGraph.Clear;
596  FUnitGraph.Clear;
597  while FGroups.Count>0 do
598    TPPUGroup(FGroups.Root.Data).Free;
599end;
600
601procedure TPPUGroups.ClearAutoDisableFlags;
602var
603  AVLNode: TAVLTreeNode;
604  Member: TPPUMember;
605begin
606  AVLNode:=FMembers.FindLowest;
607  while AVLNode<>nil do begin
608    Member:=TPPUMember(AVLNode.Data);
609    Exclude(Member.Flags,pmfAutoDisabled);
610    AVLNode:=FMembers.FindSuccessor(AVLNode);
611  end;
612end;
613
614function TPPUGroups.AddGroup(const NewName: string): TPPUGroup;
615begin
616  Result:=FindGroupWithName(NewName);
617  if Result<>nil then exit;
618  Result:=TPPUGroup.Create;
619  Result.Name:=NewName;
620  FGroups.Add(Result);
621  Result.Groups:=Self;
622end;
623
624procedure TPPUGroups.AddFPCGroupsForCurrentCompiler(const BaseDirectory: string);
625var
626  FPCSearchPath: String;
627  SystemPPUFilename: String;
628  RTLPPUDirectory: String; // directory containing the system.ppu
629  FPCPPUBaseDir: String; // directory containing all FPC ppu directories
630begin
631  FPCSearchPath:=CodeToolBoss.GetFPCUnitPathForDirectory(BaseDirectory);
632  // search system.ppu
633  SystemPPUFilename:=SearchFileInPath('system.ppu',BaseDirectory,FPCSearchPath,
634                                      ';',ctsfcDefault);
635  if SystemPPUFilename='' then begin
636    debugln(['TPPUGroups.AddFPCGroupsForCurrentCompiler BaseDir="',BaseDirectory,'" FPCSearchPath="',FPCSearchPath,'"']);
637    raise Exception.Create('TPPUGroups.AddFPCGroupsForCurrentCompiler: system.ppu is not in the FPC search paths');
638  end;
639  RTLPPUDirectory:=ExtractFilePath(SystemPPUFilename);
640  FPCPPUBaseDir:=ExtractFilePath(ChompPathDelim(RTLPPUDirectory));
641  AddFPCGroups(FPCPPUBaseDir);
642end;
643
644procedure TPPUGroups.AddFPCGroups(const FPCPPUBaseDir: string);
645var
646  FileInfo: TSearchRec;
647  GroupName: String;
648  i: Integer;
649begin
650  DebugLn(['TPPUGroups.AddFPCGroups ',FPCPPUBaseDir]);
651  if FindFirstUTF8(AppendPathDelim(FPCPPUBaseDir)+FileMask,faAnyFile,FileInfo)=0
652  then begin
653    repeat
654      // check if special file
655      if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') then
656        continue;
657      if (faDirectory and FileInfo.Attr)<>0 then begin
658        GroupName:=FileInfo.Name;
659        for i:=length(GroupName) downto 1 do
660          if not (Groupname[i] in ['a'..'z','A'..'Z','0'..'9','_']) then
661            System.Delete(GroupName,i,1);
662        if (Groupname='') then continue;
663        Groupname:=FPCPPUGroupPrefix+LowerCase(Groupname);
664        if (not IsValidIdent(Groupname)) then continue;
665        AddFPCGroup(GroupName,AppendPathDelim(FPCPPUBaseDir)+FileInfo.Name);
666      end;
667    until FindNextUTF8(FileInfo)<>0;
668  end;
669  FindCloseUTF8(FileInfo);
670end;
671
672procedure TPPUGroups.AddFPCGroup(const BaseGroupname, Directory: string);
673var
674  FileInfo: TSearchRec;
675  Filename: String;
676  AUnitName: String;
677  Group: TPPUGroup;
678  Member: TPPUMember;
679  GroupName: String;
680begin
681  //DebugLn(['TPPUGroups.AddFPCGroup ',Groupname,' ',Directory]);
682  Group:=nil;
683  if FindFirstUTF8(AppendPathDelim(Directory)+FileMask,faAnyFile,FileInfo)=0
684  then begin
685    repeat
686      // check if special file
687      if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') then
688        continue;
689      Filename:=FileInfo.Name;
690      if (CompareFileExt(Filename,'ppu',false)<>0) then continue;
691      AUnitName:=ExtractFileNameOnly(Filename);
692      Filename:=AppendPathDelim(Directory)+Filename;
693      if (AUnitName='') or (not IsValidIdent(AUnitName)) then begin
694        DebugLn(['TPPUGroups.AddFPCGroup NOTE: invalid ppu name: ',Filename]);
695        continue;
696      end;
697      GroupName:=BaseGroupName;
698      if BaseGroupname=FPCPPUGroupPrefix+'rtl' then begin
699        if (copy(FileInfo.Name,1,3)='si_') then begin
700          // the si_* units are program loaders => not for libraries
701          continue;
702        end;
703
704        if (CompareFilenames(FileInfo.Name,'system.ppu')=0)
705        or (CompareFilenames(FileInfo.Name,'dl.ppu')=0)
706        then begin
707          // the RTL should only contain the minimum for dynamic libs.
708          // It looks strange to exclude the dynlibs.ppu, but
709          // the dynlibs.ppu uses objpas.ppu, which might not be needed.
710          // But: do they hurt?
711          GroupName:=BaseGroupName+'_system';
712        end else begin
713          // all other ppu of the rtl directory need to be loaded separately
714          // => put them into separate groups
715          GroupName:=BaseGroupName+'_'+lowercase(ExtractFileNameOnly(FileInfo.Name));
716        end;
717      end;
718      if FindGroupWithName(GroupName)=nil then
719        DebugLn(['TPPUGroups.AddFPCGroup Creating group ',GroupName]);
720      Group:=AddGroup(GroupName);
721      Member:=Group.AddMember(AUnitName);
722      Member.PPUFilename:=Filename;
723    until FindNextUTF8(FileInfo)<>0;
724  end;
725  FindCloseUTF8(FileInfo);
726end;
727
728function TPPUGroups.FindGroupWithName(const AName: string): TPPUGroup;
729var
730  AVLNode: TAVLTreeNode;
731begin
732  AVLNode:=FindAVLNodeOfGroupWithName(AName);
733  if AVLNode<>nil then
734    Result:=TPPUGroup(AVLNode.Data)
735  else
736    Result:=nil;
737end;
738
739function TPPUGroups.FindMemberWithUnitName(const AName: string): TPPUMember;
740var
741  AVLNode: TAVLTreeNode;
742begin
743  AVLNode:=FindAVLNodeOfMemberWithName(AName);
744  if AVLNode<>nil then
745    Result:=TPPUMember(AVLNode.Data)
746  else
747    Result:=nil;
748end;
749
750function TPPUGroups.UpdateDependencies: boolean;
751var
752  AVLNode: TAVLTreeNode;
753  Group: TPPUGroup;
754  GraphNode: TCodeGraphNode;
755begin
756  Result:=false;
757  FGroupGraph.Clear;
758  FUnitGraph.Clear;
759  FreeAndNil(FSortedGroups);
760  ClearAutoDisableFlags;
761
762  // add nodes to GroupGraph
763  AVLNode:=FGroups.FindLowest;
764  while AVLNode<>nil do begin
765    Group:=TPPUGroup(AVLNode.Data);
766    GraphNode:=GroupGraph.AddGraphNode(Group.KeyNode);
767    GraphNode.Data:=Group;
768    AVLNode:=FGroups.FindSuccessor(AVLNode);
769  end;
770  // parse PPU
771  AVLNode:=FGroups.FindLowest;
772  while AVLNode<>nil do begin
773    Group:=TPPUGroup(AVLNode.Data);
774    if not Group.UpdatePPUs then exit;
775    AVLNode:=FGroups.FindSuccessor(AVLNode);
776  end;
777  // update dependencies
778  AVLNode:=FGroups.FindLowest;
779  while AVLNode<>nil do begin
780    Group:=TPPUGroup(AVLNode.Data);
781    if not Group.UpdateDependencies then exit;
782    AVLNode:=FGroups.FindSuccessor(AVLNode);
783  end;
784  // auto disable units with broken dependencies
785  AutoDisableUnitsWithBrokenDependencies;
786  // sort topologically
787  UpdateTopologicalSortedList;
788  // update loader units
789  if not UpdateLoaders then exit;
790  
791  Result:=true;
792end;
793
794function TPPUGroups.UpdateLoaders: boolean;
795var
796  i: Integer;
797begin
798  Result:=true;
799  for i:=0 to FSortedGroups.Count-1 do
800    if not SortedGroups[i].UpdateLoader then exit(false);
801end;
802
803procedure TPPUGroups.AutoDisableUnitsWithBrokenDependencies;
804var
805  AVLNode: TAVLTreeNode;
806  Member: TPPUMember;
807  List: TStringList;
808begin
809  AVLNode:=FMembers.FindLowest;
810  List:=TStringList.Create;
811  while AVLNode<>nil do begin
812    Member:=TPPUMember(AVLNode.Data);
813    if not (pmfAutoDisabled in Member.Flags) then begin
814      List.Clear;
815      Member.GetMissingUnits(TStrings(List));
816      if List.Count>0 then begin
817        DebugLn(['TPPUGroups.AutoDisableUnitsWithBrokenDependencies auto disabling unit ',Member.Unit_Name,' due to missing units: ',List.DelimitedText]);
818        AutoDisableMember(Member);
819      end;
820    end;
821    AVLNode:=FMembers.FindSuccessor(AVLNode);
822  end;
823  List.Free;
824end;
825
826procedure TPPUGroups.AutoDisableMember(Member: TPPUMember);
827var
828  GraphNode: TCodeGraphNode;
829  AVLNode: TAVLTreeNode;
830  GraphEdge: TCodeGraphEdge;
831  DependingMember: TPPUMember;
832begin
833  if pmfAutoDisabled in Member.Flags then exit;
834  Include(Member.Flags,pmfAutoDisabled);
835  GraphNode:=FUnitGraph.GetGraphNode(Member.KeyNode,false);
836  if (GraphNode=nil) or (GraphNode.InTree=nil) then exit;
837  AVLNode:=GraphNode.InTree.FindLowest;
838  while AVLNode<>nil do begin
839    GraphEdge:=TCodeGraphEdge(AVLNode.Data);
840    DependingMember:=TPPUMember(GraphEdge.FromNode.Data);
841    if not (pmfAutoDisabled in DependingMember.Flags) then begin
842      DebugLn(['TPPUGroups.AutoDisableMember auto disabling unit ',DependingMember.Unit_Name,' because it uses auto disabled unit ',Member.Unit_Name]);
843      AutoDisableMember(DependingMember);
844    end;
845    AVLNode:=GraphNode.InTree.FindSuccessor(AVLNode);
846  end;
847end;
848
849procedure TPPUGroups.GetMissingUnits(var List: TStrings);
850var
851  AVLNode: TAVLTreeNode;
852  Group: TPPUGroup;
853begin
854  AVLNode:=FGroups.FindLowest;
855  while AVLNode<>nil do begin
856    Group:=TPPUGroup(AVLNode.Data);
857    Group.GetMissingUnits(List);
858    AVLNode:=FGroups.FindSuccessor(AVLNode);
859  end;
860end;
861
862end.
863