/components/codetools/ppugraph.pas

http://github.com/graemeg/lazarus · Pascal · 863 lines · 715 code · 83 blank · 65 comment · 88 complexity · ab6cc751b53ec79aa366808debf6a2d5 MD5 · raw file

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