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 This unit is a support unit for the code tools. It manages compilation
25 information, which is not stored in the source, like Makefile information
26 and compiler command line options. This information is needed to
27 successfully find the right units, include files, predefined variables,
28 etc..
29
30 The information is stored in a TDefineTree, which contains nodes of type
31 TDefineTemplate. Each TDefineTemplate is a tree of defines, undefines,
32 definerecurses, ifdefs, ifndefs, elses, elseifs, directories ... .
33
34 Simply give a TDefineTree a directory and it will return all predefined
35 variables for that directory. These values can be used to parse a unit in
36 the directory.
37
38 TDefineTree can be saved to and loaded from a XML file.
39
40 The TDefinePool contains a list of TDefineTemplate trees, and can generate
41 some default templates for Lazarus and FPC sources.
42 }
43 unit DefineTemplates;
44
45 {$mode objfpc}{$H+}
46
47 { $Define VerboseDefineCache}
48 { $Define VerboseFPCSrcScan}
49
50 { $Define ShowTriedFiles}
51 { $Define ShowTriedUnits}
52
53 interface
54
55 uses
56 // RTL + FCL
57 Classes, SysUtils, contnrs, process, Laz_AVL_Tree,
58 // CodeTools
59 CodeToolsStrConsts, ExprEval, DirectoryCacher, BasicCodeTools,
60 CodeToolsStructs, KeywordFuncLists, LinkScanner, FileProcs,
61 // LazUtils
62 LazStringUtils, LazFileUtils, LazFileCache,
63 LazUTF8, LazUTF8Classes, UTF8Process, LazDbgLog, AvgLvlTree, Laz2_XMLCfg;
64
65 const
66 ExternalMacroStart = ExprEval.ExternalMacroStart;
67
68 // Standard Template Names (do not translate them)
69 StdDefTemplFPC = 'Free Pascal Compiler';
70 StdDefTemplFPCSrc = 'Free Pascal sources';
71 StdDefTemplLazarusSources = 'Lazarus sources';
72 StdDefTemplLazarusSrcDir = 'Lazarus source directory';
73 StdDefTemplLazarusBuildOpts = 'Lazarus build options';
74 StdDefTemplLCLProject = 'LCL project';
75
76 // Standard macros
77 DefinePathMacroName = ExternalMacroStart+'DefinePath'; // the current directory
78 UnitPathMacroName = ExternalMacroStart+'UnitPath'; // unit search path separated by semicolon (same as given to FPC)
79 IncludePathMacroName = ExternalMacroStart+'IncPath'; // include file search path separated by semicolon (same as given to FPC)
80 SrcPathMacroName = ExternalMacroStart+'SrcPath'; // unit source search path separated by semicolon (not given to FPC)
81 PPUSrcPathMacroName = ExternalMacroStart+'PPUSrcPath';
82 DCUSrcPathMacroName = ExternalMacroStart+'DCUSrcPath';
83 CompiledSrcPathMacroName = ExternalMacroStart+'CompiledSrcPath';
84 UnitLinksMacroName = ExternalMacroStart+'UnitLinks';
85 UnitSetMacroName = ExternalMacroStart+'UnitSet';
86 FPCUnitPathMacroName = ExternalMacroStart+'FPCUnitPath';
87 TargetOSMacroName = ExternalMacroStart+'TargetOS';
88 TargetCPUMacroName = ExternalMacroStart+'TargetCPU';
89 NamespacesMacroName = ExternalMacroStart+'Namespaces';
90
91 DefinePathMacro = '$('+DefinePathMacroName+')'; // the path of the define template
92 UnitPathMacro = '$('+UnitPathMacroName+')';
93 IncludePathMacro = '$('+IncludePathMacroName+')';
94 SrcPathMacro = '$('+SrcPathMacroName+')';
95 PPUSrcPathMacro = '$('+PPUSrcPathMacroName+')';
96 DCUSrcPathMacro = '$('+DCUSrcPathMacroName+')';
97 CompiledSrcPathMacro = '$('+CompiledSrcPathMacroName+')';
98 UnitLinksMacro = '$('+UnitLinksMacroName+')';
99 UnitSetMacro = '$('+UnitSetMacroName+')';
100 FPCUnitPathMacro = '$('+FPCUnitPathMacroName+')';
101 TargetOSMacro = '$('+TargetOSMacroName+')';
102 TargetCPUMacro = '$('+TargetCPUMacroName+')';
103 NamespacesMacro = '$('+NamespacesMacroName+')';
104
105 MacOSMinSDKVersionMacro = 'MAC_OS_X_VERSION_MIN_REQUIRED';
106
107 // virtual directories
108 VirtualDirectory='VIRTUALDIRECTORY';
109 VirtualTempDir='TEMPORARYDIRECTORY';
110
111 // FPC operating systems and processor types
112 FPCOperatingSystemNames: array[1..35] of shortstring =(
113 'linux',
114 'win32','win64','wince',
115 'darwin','macos',
116 'freebsd','netbsd','openbsd',
117 'aix',
118 'amiga',
119 'android',
120 'aros',
121 'atari',
122 'beos',
123 'embedded',
124 'emx',
125 'gba',
126 'go32v2',
127 'haiku',
128 'iphonesim',
129 'java',
130 'msdos',
131 'morphos',
132 'nds',
133 'netware',
134 'netwlibc',
135 'os2',
136 'palmos',
137 'qnx',
138 'solaris',
139 'symbian',
140 'watcom',
141 'wdosx',
142 'wii'
143 );
144 FPCOperatingSystemCaptions: array[1..35] of shortstring =(
145 'AIX',
146 'Amiga',
147 'Android',
148 'AROS',
149 'Atari',
150 'Beos',
151 'Darwin',
152 'Embedded',
153 'emx',
154 'FreeBSD',
155 'gba',
156 'go32v2',
157 'Haiku',
158 'iphonesim',
159 'Java',
160 'Linux',
161 'MacOS',
162 'MorphOS',
163 'MSDOS',
164 'nds',
165 'NetBSD',
166 'Netware',
167 'NetwLibC',
168 'OpenBSD',
169 'OS2',
170 'PalmOS',
171 'qnx',
172 'Solaris',
173 'Symbian',
174 'Watcom',
175 'wdosx',
176 'Win32',
177 'Win64',
178 'WinCE',
179 'Wii'
180 );
181
182 FPCOperatingSystemAlternativeNames: array[1..2] of shortstring =(
183 'unix', 'win' // see GetDefaultSrcOSForTargetOS
184 );
185 FPCOperatingSystemAlternative2Names: array[1..2] of shortstring =(
186 'bsd', 'linux' // see GetDefaultSrcOS2ForTargetOS
187 );
188 FPCProcessorNames: array[1..13] of shortstring =(
189 'aarch64',
190 'arm',
191 'avr',
192 'i386',
193 'i8086',
194 'jvm',
195 'm68k',
196 'mips',
197 'mipsel',
198 'powerpc',
199 'powerpc64',
200 'sparc',
201 'x86_64'
202 );
203 FPCSyntaxModes: array[1..6] of shortstring = (
204 'FPC', 'ObjFPC', 'Delphi', 'TP', 'MacPas', 'ISO'
205 );
206
207 Pas2jsPlatformNames: array[1..2] of shortstring = (
208 'Browser',
209 'NodeJS'
210 );
211 Pas2jsProcessorNames: array[1..2] of shortstring = (
212 'ECMAScript5',
213 'ECMAScript6'
214 );
215
216 Lazarus_CPU_OS_Widget_Combinations: array[1..91] of shortstring = (
217 'i386-linux-gtk',
218 'i386-linux-gtk2',
219 'i386-linux-qt',
220 'i386-linux-qt5',
221 'i386-linux-fpgui',
222 'i386-linux-nogui',
223 'i386-freebsd-gtk',
224 'i386-freebsd-gtk2',
225 'i386-freebsd-qt',
226 'i386-freebsd-qt5',
227 'i386-freebsd-nogui',
228 'i386-openbsd-gtk',
229 'i386-openbsd-gtk2',
230 'i386-openbsd-qt',
231 'i386-openbsd-qt5',
232 'i386-openbsd-nogui',
233 'i386-netbsd-gtk',
234 'i386-netbsd-gtk2',
235 'i386-netbsd-qt',
236 'i386-netbsd-qt5',
237 'i386-netbsd-nogui',
238 'i386-win32-win32',
239 'i386-win32-gtk2',
240 'i386-win32-qt',
241 'i386-win32-qt5',
242 'i386-win32-fpgui',
243 'i386-win32-nogui',
244 'i386-wince-wince',
245 'i386-wince-fpgui',
246 'i386-wince-nogui',
247 'i386-darwin-gtk',
248 'i386-darwin-gtk2',
249 'i386-darwin-carbon',
250 'i386-darwin-qt',
251 'i386-darwin-qt5',
252 'i386-darwin-fpgui',
253 'i386-darwin-nogui',
254 'i386-haiku-qt',
255 'i386-haiku-qt5',
256 'i386-haiku-nogui',
257 'i386-aros-mui',
258 'i386-aros-nogui',
259 'powerpc-darwin-gtk',
260 'powerpc-darwin-gtk2',
261 'powerpc-darwin-carbon',
262 'powerpc-linux-gtk',
263 'powerpc-linux-gtk2',
264 'powerpc-linux-nogui',
265 'powerpc-morphos-mui',
266 'powerpc-morphos-nogui',
267 'powerpc64-darwin-gtk',
268 'powerpc64-darwin-gtk2',
269 'powerpc64-darwin-cocoa',
270 'powerpc64-darwin-nogui',
271 'powerpc64-linux-gtk',
272 'powerpc64-linux-gtk2',
273 'powerpc64-linux-nogui',
274 'powerpc64-aix-gtk',
275 'powerpc64-aix-gtk2',
276 'powerpc64-aix-nogui',
277 'sparc-linux-gtk',
278 'sparc-linux-gtk2',
279 'sparc-linux-nogui',
280 'arm-wince-wince',
281 'arm-wince-fpgui',
282 'arm-wince-nogui',
283 'arm-linux-gtk',
284 'arm-linux-gtk2',
285 'arm-linux-qt',
286 'arm-linux-qt5',
287 'arm-linux-android',
288 'arm-linux-nogui',
289 'arm-darwin-carbon',
290 'arm-darwin-nogui',
291 'x86_64-freebsd-gtk',
292 'x86_64-freebsd-gtk2',
293 'x86_64-freebsd-qt',
294 'x86_64-freebsd-qt5',
295 'x86_64-freebsd-fpgui',
296 'x86_64-freebsd-nogui',
297 'x86_64-linux-gtk',
298 'x86_64-linux-gtk2',
299 'x86_64-linux-qt',
300 'x86_64-linux-qt5',
301 'x86_64-linux-fpgui',
302 'x86_64-linux-nogui',
303 'x86_64-win64-win32',
304 'x86_64-win64-fpgui',
305 'x86_64-win64-nogui',
306 'm68k-amiga-mui',
307 'm68k-amiga-nogui'
308 );
309
310 type
311 //---------------------------------------------------------------------------
312 // TDefineTemplate stores a define action, the variablename and the value
313 TDefineAction = (
314 da_None,
315 da_Block,
316 da_Define,
317 da_DefineRecurse,
318 da_Undefine,
319 da_UndefineRecurse,
320 da_UndefineAll,
321 da_If,
322 da_IfDef,
323 da_IfNDef,
324 da_ElseIf,
325 da_Else,
326 da_Directory
327 );
328
329 const
330 DefineActionBlocks = [da_Block, da_Directory, da_If, da_IfDef, da_IfNDef,
331 da_ElseIf, da_Else];
332 DefineActionDefines = [da_Define,da_DefineRecurse,da_Undefine,
333 da_UndefineRecurse,da_UndefineAll];
334 DefineActionNames: array[TDefineAction] of string = (
335 'None', 'Block', 'Define', 'DefineRecurse', 'Undefine', 'UndefineRecurse',
336 'UndefineAll', 'If', 'IfDef', 'IfNDef', 'ElseIf', 'Else', 'Directory'
337 );
338 var
339 DefineActionImages: array[TDefineAction] of integer;
340 AutogeneratedImage: Integer;
341
342 type
343 TDefineTree = class;
344 TDefineTemplateFlag = (
345 dtfAutoGenerated
346 );
347 TDefineTemplateFlags = set of TDefineTemplateFlag;
348
349 TDefineTemplate = class
350 private
351 FChildCount: integer;
352 FFirstChild: TDefineTemplate;
353 FLastChild: TDefineTemplate;
354 FMarked: boolean;
355 FMergeNameBehind: string;
356 FMergeNameInFront: string;
357 FNext: TDefineTemplate;
358 FParent: TDefineTemplate;
359 FPrior: TDefineTemplate;
360 public
361 Name: string;
362 Description: string;
363 Variable: string;
364 Value: string;
365 Action: TDefineAction;
366 Flags: TDefineTemplateFlags;
367 Owner: TObject;
368 class procedure MergeTemplates(ParentDefTempl: TDefineTemplate;
369 var FirstSibling, LastSibling:TDefineTemplate;
370 SourceTemplate: TDefineTemplate; WithSiblings: boolean;
371 const NewNamePrefix: string);
372 class procedure MergeXMLConfig(ParentDefTempl: TDefineTemplate;
373 var FirstSibling, LastSibling:TDefineTemplate;
374 XMLConfig: TXMLConfig; const Path, NewNamePrefix: string);
375 constructor Create(const AName, ADescription, AVariable, AValue: string;
376 AnAction: TDefineAction);
377 constructor Create;
378 destructor Destroy; override;
379 procedure ConsistencyCheck;
380 procedure CalcMemSize(Stats: TCTMemStats);
CreateCopynull381 function CreateCopy(OnlyMarked: boolean = false;
382 WithSiblings: boolean = true;
383 WithChilds: boolean = true): TDefineTemplate;
CreateMergeCopynull384 function CreateMergeCopy: TDefineTemplate;
FindByNamenull385 function FindByName(const AName: string;
386 WithSubChilds, WithNextSiblings: boolean): TDefineTemplate;
FindChildByNamenull387 function FindChildByName(const AName: string): TDefineTemplate;
FindRootnull388 function FindRoot: TDefineTemplate;
FindUniqueNamenull389 function FindUniqueName(const Prefix: string): string;
GetFirstSiblingnull390 function GetFirstSibling: TDefineTemplate;
HasDefinesnull391 function HasDefines(OnlyMarked, WithSiblings: boolean): boolean;
IsAutoGeneratednull392 function IsAutoGenerated: boolean;
IsEqualnull393 function IsEqual(ADefineTemplate: TDefineTemplate;
394 CheckSubNodes, CheckNextSiblings: boolean): boolean;
Levelnull395 function Level: integer;
LoadFromXMLConfignull396 function LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string;
397 ClearOldSiblings, WithMergeInfo: boolean): boolean;
SelfOrParentContainsFlagnull398 function SelfOrParentContainsFlag(AFlag: TDefineTemplateFlag): boolean;
399 procedure AddChild(ADefineTemplate: TDefineTemplate);
400 procedure ReplaceChild(ADefineTemplate: TDefineTemplate);
DeleteChildnull401 function DeleteChild(const AName: string): boolean;
402 procedure Assign(ADefineTemplate: TDefineTemplate; WithSubNodes,
403 WithNextSiblings, ClearOldSiblings: boolean); virtual;
404 procedure AssignValues(ADefineTemplate: TDefineTemplate);
405 procedure Clear(WithSiblings: boolean);
406 procedure CreateMergeInfo(WithSiblings, OnlyMarked: boolean);
407 procedure InheritMarks(WithSiblings, WithChilds, Down, Up: boolean);
408 procedure InsertBehind(APrior: TDefineTemplate);
409 procedure InsertInFront(ANext: TDefineTemplate);
410 procedure MoveToLast(Child: TDefineTemplate);
411 procedure LoadValuesFromXMLConfig(XMLConfig: TXMLConfig; const Path: string;
412 WithMergeInfo: boolean);
413 procedure MarkFlags(const MustFlags, NotFlags: TDefineTemplateFlags;
414 WithSiblings, WithChilds: boolean);
415 procedure MarkNodes(WithSiblings, WithChilds: boolean);
416 procedure MarkOwnedBy(TheOwner: TObject;
417 const MustFlags, NotFlags: TDefineTemplateFlags;
418 WithSiblings, WithChilds: boolean);
419 procedure RemoveFlags(TheFlags: TDefineTemplateFlags);
420 procedure RemoveLeaves(TheOwner: TObject; const MustFlags,
421 NotFlags: TDefineTemplateFlags;
422 WithSiblings: boolean;
423 var FirstDefTemplate: TDefineTemplate);
424 procedure RemoveMarked(WithSiblings: boolean;
425 var FirstDefTemplate: TDefineTemplate);
426 procedure RemoveOwner(TheOwner: TObject; WithSiblings: boolean);
427 procedure ReverseMarks(WithSiblings, WithChilds: boolean);
428 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string;
429 WithSiblings, OnlyMarked,
430 WithMergeInfo, UpdateMergeInfo: boolean);
431 procedure SaveValuesToXMLConfig(XMLConfig: TXMLConfig; const Path: string;
432 WithMergeInfo: boolean);
433 procedure SetDefineOwner(NewOwner: TObject; WithSiblings: boolean);
434 procedure SetFlags(AddFlags, SubFlags: TDefineTemplateFlags;
435 WithSiblings: boolean);
436 procedure Unbind;
437 procedure UnmarkNodes(WithSiblings, WithChilds: boolean);
438 procedure WriteDebugReport(OnlyMarked: boolean);
GetNextnull439 function GetNext: TDefineTemplate;
GetNextSkipChildrennull440 function GetNextSkipChildren: TDefineTemplate;
441 public
442 property ChildCount: integer read FChildCount;
443 property FirstChild: TDefineTemplate read FFirstChild;
444 property LastChild: TDefineTemplate read FLastChild;
445 property Marked: boolean read FMarked write FMarked;
446 property Next: TDefineTemplate read FNext;
447 property Parent: TDefineTemplate read FParent;
448 property Prior: TDefineTemplate read FPrior;
449 property MergeNameInFront: string read FMergeNameInFront write FMergeNameInFront;
450 property MergeNameBehind: string read FMergeNameBehind write FMergeNameBehind;
451 end;
452
453 //---------------------------------------------------------------------------
454 //
455
456 { TDirectoryDefines }
457
458 TDirectoryDefines = class
459 public
460 Path: string;
461 Values: TExpressionEvaluator;
462 constructor Create;
463 destructor Destroy; override;
464 procedure CalcMemSize(Stats: TCTMemStats);
465 end;
466
467 TOnGetVirtualDirectoryDefines = procedure(Sender: TDefineTree;
468 Defines: TDirectoryDefines) of object;
469
470 //---------------------------------------------------------------------------
471 // TDefineTree caches the define values for directories
472 TOnReadValue = procedure(Sender: TObject; const VariableName: string;
473 var Value: string; var Handled: boolean) of object;
474
475 TOnGetVirtualDirectoryAlias = procedure(Sender: TObject;
476 var RealDir: string) of object;
477
478 TReadFunctionData = record
479 Param: string;
480 Result: string;
481 end;
482 PReadFunctionData = ^TReadFunctionData;
483
484 TDefTreeCalculate = procedure(Tree: TDefineTree; Node: TDefineTemplate;
485 ValueParsed: boolean; const ParsedValue: string;
486 ExpressionCalculated: boolean; const ExpressionResult: string;
487 Execute: boolean) of object;
488
489 TDefineTree = class
490 private
491 FDirectoryCachePool: TCTDirectoryCachePool;
492 FFirstDefineTemplate: TDefineTemplate;
493 FCache: TAVLTree; // tree of TDirectoryDefines
494 FDefineStrings: TStringTree;
495 FChangeStep: integer;
496 FErrorDescription: string;
497 FErrorTemplate: TDefineTemplate;
498 FMacroFunctions: TKeyWordFunctionList;
499 FMacroVariables: TKeyWordFunctionList;
500 FOnCalculate: TDefTreeCalculate;
501 FOnGetVirtualDirectoryAlias: TOnGetVirtualDirectoryAlias;
502 FOnGetVirtualDirectoryDefines: TOnGetVirtualDirectoryDefines;
503 FOnPrepareTree: TNotifyEvent;
504 FOnReadValue: TOnReadValue;
505 FVirtualDirCache: TDirectoryDefines;
Calculatenull506 function Calculate(DirDef: TDirectoryDefines): boolean;
507 procedure IncreaseChangeStep;
508 procedure SetDirectoryCachePool(const AValue: TCTDirectoryCachePool);
509 procedure RemoveDoubles(Defines: TDirectoryDefines);
510 protected
FindDirectoryInCachenull511 function FindDirectoryInCache(const Path: string): TDirectoryDefines;
GetDirDefinesForDirectorynull512 function GetDirDefinesForDirectory(const Path: string;
513 WithVirtualDir: boolean): TDirectoryDefines;
GetDirDefinesForVirtualDirectorynull514 function GetDirDefinesForVirtualDirectory: TDirectoryDefines;
MacroFuncExtractFileExtnull515 function MacroFuncExtractFileExt(Data: Pointer): boolean;
MacroFuncExtractFilePathnull516 function MacroFuncExtractFilePath(Data: Pointer): boolean;
MacroFuncExtractFileNamenull517 function MacroFuncExtractFileName(Data: Pointer): boolean;
MacroFuncExtractFileNameOnlynull518 function MacroFuncExtractFileNameOnly(Data: Pointer): boolean;
519 procedure DoClearCache;
520 procedure DoPrepareTree;
521 public
522 property RootTemplate: TDefineTemplate
523 read FFirstDefineTemplate write FFirstDefineTemplate;
524 property ChangeStep: integer read FChangeStep;
525 property ErrorTemplate: TDefineTemplate read FErrorTemplate;
526 property ErrorDescription: string read FErrorDescription;
527 property OnGetVirtualDirectoryAlias: TOnGetVirtualDirectoryAlias
528 read FOnGetVirtualDirectoryAlias write FOnGetVirtualDirectoryAlias;
529 property OnGetVirtualDirectoryDefines: TOnGetVirtualDirectoryDefines
530 read FOnGetVirtualDirectoryDefines write FOnGetVirtualDirectoryDefines;
531 property OnReadValue: TOnReadValue read FOnReadValue write FOnReadValue;
532 property OnPrepareTree: TNotifyEvent read FOnPrepareTree write FOnPrepareTree;
533 property OnCalculate: TDefTreeCalculate read FOnCalculate write FOnCalculate;
534 property MacroFunctions: TKeyWordFunctionList read FMacroFunctions;
535 property MacroVariables: TKeyWordFunctionList read FMacroVariables;
536 public
537 constructor Create;
538 destructor Destroy; override;
539 procedure ConsistencyCheck;
540 procedure CalcMemSize(Stats: TCTMemStats);
ExtractNonAutoCreatednull541 function ExtractNonAutoCreated: TDefineTemplate;
ExtractTemplatesOwnedBynull542 function ExtractTemplatesOwnedBy(TheOwner: TObject; const MustFlags,
543 NotFlags: TDefineTemplateFlags): TDefineTemplate;
FindDefineTemplateByNamenull544 function FindDefineTemplateByName(const AName: string;
545 OnlyRoots: boolean): TDefineTemplate;
GetCompiledSrcPathForDirectorynull546 function GetCompiledSrcPathForDirectory(const Directory: string): string;
GetDCUSrcPathForDirectorynull547 function GetDCUSrcPathForDirectory(const Directory: string): string;
GetDefinesForDirectorynull548 function GetDefinesForDirectory(const Path: string;
549 WithVirtualDir: boolean): TExpressionEvaluator;
GetDefinesForVirtualDirectorynull550 function GetDefinesForVirtualDirectory: TExpressionEvaluator;
GetIncludePathForDirectorynull551 function GetIncludePathForDirectory(const Directory: string): string;
GetLastRootTemplatenull552 function GetLastRootTemplate: TDefineTemplate;
GetPPUSrcPathForDirectorynull553 function GetPPUSrcPathForDirectory(const Directory: string): string;
GetSrcPathForDirectorynull554 function GetSrcPathForDirectory(const Directory: string): string;
GetUnitPathForDirectorynull555 function GetUnitPathForDirectory(const Directory: string): string;
IsEqualnull556 function IsEqual(SrcDefineTree: TDefineTree): boolean;
557 procedure Add(ADefineTemplate: TDefineTemplate);
558 procedure AddChild(ParentTemplate, NewDefineTemplate: TDefineTemplate);
559 procedure AddFirst(ADefineTemplate: TDefineTemplate);
560 procedure MoveToLast(ADefineTemplate: TDefineTemplate);
561 procedure Assign(SrcDefineTree: TDefineTree);
562 procedure AssignNonAutoCreated(SrcDefineTree: TDefineTree);
563 procedure Clear;
564 procedure ClearCache;
565 procedure MarkNonAutoCreated;
566 procedure MarkTemplatesOwnedBy(TheOwner: TObject;
567 const MustFlags, NotFlags: TDefineTemplateFlags);
568 procedure MergeDefineTemplates(SourceTemplate: TDefineTemplate;
569 const NewNamePrefix: string);
570 procedure MergeTemplates(SourceTemplate: TDefineTemplate;
571 const NewNamePrefix: string);
572 procedure ReadValue(const DirDef: TDirectoryDefines;
573 const PreValue, CurDefinePath: string; out NewValue: string);
574 procedure RemoveDefineTemplate(ADefTempl: TDefineTemplate);
575 procedure RemoveMarked;
576 procedure RemoveRootDefineTemplateByName(const AName: string);
577 procedure RemoveTemplatesOwnedBy(TheOwner: TObject;
578 const MustFlags, NotFlags: TDefineTemplateFlags);
579 procedure ReplaceChild(ParentTemplate, NewDefineTemplate: TDefineTemplate;
580 const ChildName: string);
581 procedure ReplaceRootSameName(ADefineTemplate: TDefineTemplate);
582 procedure ReplaceRootSameName(const Name: string;
583 ADefineTemplate: TDefineTemplate);
584 procedure ReplaceRootSameNameAddFirst(ADefineTemplate: TDefineTemplate);
585 procedure WriteDebugReport;
586 property DirectoryCachePool: TCTDirectoryCachePool read FDirectoryCachePool write SetDirectoryCachePool;
587 end;
588
589 //---------------------------------------------------------------------------
590
591 { TDefinePool }
592
593 TDefinePoolProgress = procedure(Sender: TObject;
594 Index, MaxIndex: integer; // MaxIndex=-1 if unknown
595 const Msg: string;
596 var Abort: boolean) of object;
597
598 TDefinePool = class
599 private
600 FEnglishErrorMsgFilename: string;
601 FItems: TFPList; // list of TDefineTemplate;
602 FOnProgress: TDefinePoolProgress;
GetItemsnull603 function GetItems(Index: integer): TDefineTemplate;
604 procedure SetEnglishErrorMsgFilename(const AValue: string);
CheckAbortnull605 function CheckAbort(ProgressID, MaxIndex: integer; const Msg: string
606 ): boolean;
607 public
608 property Items[Index: integer]: TDefineTemplate read GetItems; default;
Countnull609 function Count: integer;
610 procedure Add(ADefineTemplate: TDefineTemplate);
611 procedure Insert(Index: integer; ADefineTemplate: TDefineTemplate);
612 procedure Delete(Index: integer);
613 procedure Move(SrcIndex, DestIndex: integer);
614 property EnglishErrorMsgFilename: string
615 read FEnglishErrorMsgFilename write SetEnglishErrorMsgFilename;
616 // FPC templates
CreateFPCTemplatenull617 function CreateFPCTemplate(const CompilerPath, CompilerOptions,
618 TestPascalFile: string;
619 out UnitSearchPath, TargetOS,
620 aTargetCPU: string;
621 Owner: TObject): TDefineTemplate;
GetFPCVerFromFPCTemplatenull622 function GetFPCVerFromFPCTemplate(Template: TDefineTemplate;
623 out FPCVersion, FPCRelease, FPCPatch: integer): boolean;
CreateFPCCommandLineDefinesnull624 function CreateFPCCommandLineDefines(const Name, CmdLine: string;
625 RecursiveDefines: boolean;
626 Owner: TObject;
627 AlwaysCreate: boolean = false;
628 AddPaths: boolean = false
629 ): TDefineTemplate;
630 // Lazarus templates
CreateLazarusSrcTemplatenull631 function CreateLazarusSrcTemplate(
632 const LazarusSrcDir, WidgetType, ExtraOptions: string;
633 Owner: TObject): TDefineTemplate;
CreateLCLProjectTemplatenull634 function CreateLCLProjectTemplate(const LazarusSrcDir, WidgetType,
635 ProjectDir: string; Owner: TObject): TDefineTemplate;
636 // Delphi templates
CreateDelphiSrcPathnull637 function CreateDelphiSrcPath(DelphiVersion: integer;
638 const PathPrefix: string): string;
CreateDelphiCompilerDefinesTemplatenull639 function CreateDelphiCompilerDefinesTemplate(DelphiVersion: integer;
640 Owner: TObject): TDefineTemplate;
CreateDelphiDirectoryTemplatenull641 function CreateDelphiDirectoryTemplate(const DelphiDirectory: string;
642 DelphiVersion: integer; Owner: TObject): TDefineTemplate;
CreateDelphiProjectTemplatenull643 function CreateDelphiProjectTemplate(const ProjectDir,
644 DelphiDirectory: string; DelphiVersion: integer;
645 Owner: TObject): TDefineTemplate;
646 // Kylix templates
CreateKylixCompilerDefinesTemplatenull647 function CreateKylixCompilerDefinesTemplate(KylixVersion: integer;
648 Owner: TObject): TDefineTemplate;
CreateKylixSrcPathnull649 function CreateKylixSrcPath({%H-}KylixVersion: integer;
650 const PathPrefix: string): string;
CreateKylixDirectoryTemplatenull651 function CreateKylixDirectoryTemplate(const KylixDirectory: string;
652 KylixVersion: integer; Owner: TObject): TDefineTemplate;
CreateKylixProjectTemplatenull653 function CreateKylixProjectTemplate(const ProjectDir,
654 KylixDirectory: string; KylixVersion: integer;
655 Owner: TObject): TDefineTemplate;
656
657 constructor Create;
658 destructor Destroy; override;
659 procedure Clear;
660 property OnProgress: TDefinePoolProgress read FOnProgress write FOnProgress;
661 procedure ConsistencyCheck;
662 procedure WriteDebugReport;
663 procedure CalcMemSize(Stats: TCTMemStats);
664 end;
665
666 { TFPCSourceRule }
667
668 TFPCSourceRule = class
669 public
670 Filename: string;
671 Score: integer;
672 Targets: string; // comma separated list of OS, CPU, e.g. win32,unix,i386 or * for all
FitsTargetsnull673 function FitsTargets(const FilterTargets: string): boolean;
FitsFilenamenull674 function FitsFilename(const aFilename: string): boolean;
IsEqualnull675 function IsEqual(Rule: TFPCSourceRule): boolean;
676 procedure Assign(Rule: TFPCSourceRule);
677 end;
678
679 { TFPCSourceRules }
680
681 TFPCSourceRules = class
682 private
683 FChangeStamp: integer;
684 FItems: TFPList;// list of TFPCSourceRule
685 FScore: integer;
686 FTargets: string;
GetItemsnull687 function GetItems(Index: integer): TFPCSourceRule;
688 procedure SetTargets(const AValue: string);
689 public
690 constructor Create;
691 destructor Destroy; override;
692 procedure Clear;
IsEqualnull693 function IsEqual(Rules: TFPCSourceRules): boolean;
694 procedure Assign(Rules: TFPCSourceRules);
Clonenull695 function Clone: TFPCSourceRules;
696 property Items[Index: integer]: TFPCSourceRule read GetItems; default;
Countnull697 function Count: integer;
Addnull698 function Add(const Filename: string): TFPCSourceRule;
GetDefaultTargetsnull699 function GetDefaultTargets(TargetOS, TargetCPU: string): string;
700 procedure GetRulesForTargets(Targets: string;
701 var RulesSortedForFilenameStart: TAVLTree);
GetScorenull702 function GetScore(Filename: string;
703 RulesSortedForFilenameStart: TAVLTree): integer;
704 property Score: integer read FScore write FScore; // used for Add
705 property Targets: string read FTargets write SetTargets; // used for Add, e.g. win32,unix,bsd or * for all
706 property ChangeStamp: integer read FChangeStamp;
707 procedure IncreaseChangeStamp;
708 end;
709
710 var
711 DefaultFPCSourceRules: TFPCSourceRules;
712
713 const
714 DefineTemplateFlagNames: array[TDefineTemplateFlag] of shortstring = (
715 'AutoGenerated'
716 );
717
718 type
719 TFPCInfoType = (
720 fpciCompilerDate, // -iD Return compiler date
721 fpciShortVersion, // -iV Return short compiler version
722 fpciFullVersion, // -iW Return full compiler version
723 fpciCompilerOS, // -iSO Return compiler OS
724 fpciCompilerProcessor, // -iSP Return compiler host processor
725 fpciTargetOS, // -iTO Return target OS
726 fpciTargetProcessor // -iTP Return target processor
727 );
728 TFPCInfoTypes = set of TFPCInfoType;
729 TFPCInfoStrings = array[TFPCInfoType] of string;
730 const
731 fpciAll = [low(TFPCInfoType)..high(TFPCInfoType)];
732
733 type
734
735 { TPCConfigFileState
736 Store if a config file exists and its modification date }
737
738 TPCConfigFileState = class
739 public
740 Filename: string;
741 FileExists: boolean;
742 FileDate: longint;
743 constructor Create(const aFilename: string;
744 aFileExists: boolean; aFileDate: longint);
Equalsnull745 function Equals(Other: TPCConfigFileState; CheckDate: boolean): boolean; reintroduce;
746 procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
747 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
748 end;
749
750 TFPCConfigFileState = TPCConfigFileState deprecated 'use TPCConfigFileState'; // Laz 1.9
751
752 { TPCConfigFileStateList
753 list of TPCConfigFileState }
754
755 TPCConfigFileStateList = class
756 private
757 fItems: TFPList;
GetItemsnull758 function GetItems(Index: integer): TPCConfigFileState;
759 public
760 constructor Create;
761 destructor Destroy; override;
762 procedure Clear;
763 procedure Assign(List: TPCConfigFileStateList);
Equalsnull764 function Equals(List: TPCConfigFileStateList; CheckDates: boolean): boolean; reintroduce;
Addnull765 function Add(aFilename: string; aFileExists: boolean;
766 aFileDate: longint): TPCConfigFileState;
Countnull767 function Count: integer;
768 property Items[Index: integer]: TPCConfigFileState read GetItems; default;
769 procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
770 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
771 end;
772
773 TFPCConfigFileStateList = TPCConfigFileStateList deprecated 'use TPCConfigFileStateList'; // Laz 1.9
774
775 TPCTargetConfigCaches = class;
776
777 { TPCTargetConfigCache
778 Storing all information (macros, search paths) of one compiler
779 with one specific TargetOS and TargetCPU. }
780
781 TPCTargetConfigCache = class(TComponent)
782 private
783 FChangeStamp: integer;
784 public
785 // key
786 TargetOS: string; // will be passed lowercase
787 TargetCPU: string; // will be passed lowercase
788 Compiler: string; // full file name
789 CompilerOptions: string; // e.g. -V<version> -Xp<path>
790 // values
791 Kind: TPascalCompiler;
792 CompilerDate: longint;
793 RealCompiler: string; // when Compiler is fpc.exe, this is the real compiler (e.g. ppc386.exe)
794 RealCompilerDate: longint;
795 RealTargetOS: string;
796 RealTargetCPU: string;
797 RealTargetCPUCompiler: string; // the ppc<target>.exe in PATH for TargetCPU
798 FullVersion: string; // Version.Release.Patch
799 ConfigFiles: TPCConfigFileStateList;
800 UnitPaths: TStrings;
801 IncludePaths: TStrings;
802 UnitScopes: TStrings;
803 Defines: TStringToStringTree; // macro to value
804 Undefines: TStringToStringTree; // macro
805 Units: TStringToStringTree; // unit name to file name
806 Includes: TStringToStringTree; // inc name to file name
807 ErrorMsg: string;
808 ErrorTranslatedMsg: string;
809 Caches: TPCTargetConfigCaches;
810 HasPPUs: boolean;
811 constructor Create(AOwner: TComponent); override;
812 destructor Destroy; override;
813 procedure Clear; // values, not keys
Equalsnull814 function Equals(Item: TPCTargetConfigCache;
815 CompareKey: boolean = true): boolean; reintroduce;
816 procedure Assign(Source: TPersistent); override;
817 procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
818 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
819 procedure LoadFromFile(Filename: string);
820 procedure SaveToFile(Filename: string);
NeedsUpdatenull821 function NeedsUpdate: boolean;
GetFPCInfoCmdLineOptionsnull822 function GetFPCInfoCmdLineOptions(ExtraOptions: string): string;
Updatenull823 function Update(TestFilename: string; ExtraOptions: string = '';
824 const OnProgress: TDefinePoolProgress = nil): boolean;
FindDefaultTargetCPUCompilernull825 function FindDefaultTargetCPUCompiler(aTargetCPU: string; ResolveLinks: boolean): string;
GetUnitPathsnull826 function GetUnitPaths: string;
GetFPCVerNumbersnull827 function GetFPCVerNumbers(out FPCVersion, FPCRelease, FPCPatch: integer): boolean;
GetFPCVernull828 function GetFPCVer: string; // e.g. 2.7.1
GetFPC_FULLVERSIONnull829 function GetFPC_FULLVERSION: integer; // e.g. 20701
IndexOfUsedCfgFilenull830 function IndexOfUsedCfgFile: integer;
831 procedure IncreaseChangeStamp;
832 property ChangeStamp: integer read FChangeStamp;
833 end;
834
835 TFPCTargetConfigCache = TPCTargetConfigCache deprecated 'use TPCTargetConfigCache'; // Laz 1.9
836
837 { TPCTargetConfigCaches
838 List of TPCTargetConfigCache }
839
840 TPCTargetConfigCaches = class(TComponent)
841 private
842 FChangeStamp: integer;
843 FExtraOptions: string;
844 fItems: TAVLTree; // tree of TPCTargetConfigCache
845 FTestFilename: string;
846 public
847 constructor Create(AOwner: TComponent); override;
848 destructor Destroy; override;
849 procedure Clear;
Equalsnull850 function Equals(Caches: TPCTargetConfigCaches): boolean; reintroduce;
851 procedure Assign(Source: TPersistent); override;
852 procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
853 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
854 procedure LoadFromFile(Filename: string);
855 procedure SaveToFile(Filename: string);
856 procedure IncreaseChangeStamp;
857 property ChangeStamp: integer read FChangeStamp;
Findnull858 function Find(CompilerFilename, CompilerOptions, TargetOS, TargetCPU: string;
859 CreateIfNotExists: boolean): TPCTargetConfigCache;
860 procedure GetDefaultCompilerTarget(const CompilerFilename,CompilerOptions: string;
861 out TargetOS, TargetCPU: string);
GetListingnull862 function GetListing: string;
863 property TestFilename: string read FTestFilename write FTestFilename; // an empty file to test the compiler, will be auto created
864 property ExtraOptions: string read FExtraOptions write FExtraOptions; // additional compiler options not used as key, e.g. -Fr<language file>
865 end;
866
867 TFPCTargetConfigCaches = TPCTargetConfigCaches deprecated 'use TPCTargetConfigCaches'; // Laz 1.9
868
869 TFPCSourceCaches = class;
870
871 { TFPCSourceCache
872 All source files of one FPC source directory }
873
874 TFPCSourceCache = class(TComponent)
875 private
876 FChangeStamp: integer;
877 public
878 Directory: string;
879 Valid: boolean;
880 Files: TStringList;
881 Caches: TFPCSourceCaches;
882 constructor Create(AOwner: TComponent); override;
883 destructor Destroy; override;
884 procedure Clear;
885 procedure Assign(Source: TPersistent); override;
Equalsnull886 function Equals(Cache: TFPCSourceCache): boolean; reintroduce;
887 procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
888 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
889 procedure LoadFromFile(Filename: string);
890 procedure SaveToFile(Filename: string);
891 procedure Update(const OnProgress: TDefinePoolProgress = nil);
892 procedure Update(var NewFiles: TStringList); // NewFiles is used for Files! do not free NewFiles
893 procedure IncreaseChangeStamp;
894 property ChangeStamp: integer read FChangeStamp;
895 end;
896
897 { TFPCSourceCaches }
898
899 TFPCSourceCaches = class(TComponent)
900 private
901 FChangeStamp: integer;
902 fItems: TAVLTree; // tree of TFPCSourceCacheItem
903 public
904 constructor Create(AOwner: TComponent); override;
905 destructor Destroy; override;
906 procedure Clear;
907 procedure Assign(Source: TPersistent); override;
Equalsnull908 function Equals(Caches: TFPCSourceCaches): boolean; reintroduce;
909 procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
910 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
911 procedure LoadFromFile(Filename: string);
912 procedure SaveToFile(Filename: string);
913 procedure IncreaseChangeStamp;
914 property ChangeStamp: integer read FChangeStamp;
Findnull915 function Find(Directory: string;
916 CreateIfNotExists: boolean): TFPCSourceCache;
917 end;
918
919 TCompilerDefinesCache = class;
920
921 TFPCUnitToSrcCacheFlag = (
922 fuscfSrcRulesNeedUpdate,
923 fuscfUnitTreeNeedsUpdate
924 );
925 TFPCUnitToSrcCacheFlags = set of TFPCUnitToSrcCacheFlag;
926
927 { TFPCUnitSetCache
928 Unit name to FPC source file.
929 Specific to one compiler, compileroptions, targetos, targetcpu and FPC source directory. }
930
931 TFPCUnitSetCache = class(TComponent)
932 private
933 FCaches: TCompilerDefinesCache;
934 FChangeStamp: integer;
935 FCompilerFilename: string;
936 FCompilerOptions: string;
937 FFPCSourceDirectory: string;
938 FTargetCPU: string;
939 FTargetOS: string;
940 FConfigCache: TPCTargetConfigCache;
941 fSourceCache: TFPCSourceCache;
942 fSourceRules: TFPCSourceRules;
943 fRulesStampOfConfig: integer; // fSourceCache.ChangeStamp while creation of fFPCSourceRules
944 fUnitToSourceTree: TStringToStringTree; // unit name to file name (maybe relative)
945 fUnitStampOfFPC: integer; // FConfigCache.ChangeStamp at creation of fUnitToSourceTree
946 fUnitStampOfFiles: integer; // fSourceCache.ChangeStamp at creation of fUnitToSourceTree
947 fUnitStampOfRules: integer; // fSourceRules.ChangeStamp at creation of fUnitToSourceTree
948 fSrcDuplicates: TStringToStringTree; // unit to list of files (semicolon separated)
949 fFlags: TFPCUnitToSrcCacheFlags;
950 procedure SetCompilerFilename(const AValue: string);
951 procedure SetCompilerOptions(const AValue: string);
952 procedure SetFPCSourceDirectory(const AValue: string);
953 procedure SetTargetCPU(const AValue: string);
954 procedure SetTargetOS(const AValue: string);
955 procedure ClearConfigCache;
956 procedure ClearSourceCache;
957 protected
958 procedure Notification(AComponent: TComponent; Operation: TOperation);
959 override;
960 public
961 constructor Create(TheOwner: TComponent); override;
962 destructor Destroy; override;
963 procedure Clear;
964 procedure Init;
965 property Caches: TCompilerDefinesCache read FCaches;
966 property CompilerFilename: string read FCompilerFilename write SetCompilerFilename;
967 property CompilerOptions: string read FCompilerOptions write SetCompilerOptions;
968 property TargetOS: string read FTargetOS write SetTargetOS; // case insensitive, will be passed lowercase
969 property TargetCPU: string read FTargetCPU write SetTargetCPU; // case insensitive, will be passed lowercase
970 property FPCSourceDirectory: string read FFPCSourceDirectory write SetFPCSourceDirectory;
GetConfigCachenull971 function GetConfigCache(AutoUpdate: boolean): TPCTargetConfigCache;
GetSourceCachenull972 function GetSourceCache(AutoUpdate: boolean): TFPCSourceCache;
GetSourceRulesnull973 function GetSourceRules(AutoUpdate: boolean): TFPCSourceRules;
GetUnitToSourceTreenull974 function GetUnitToSourceTree(AutoUpdate: boolean): TStringToStringTree; // unit name to file name (maybe relative)
GetSourceDuplicatesnull975 function GetSourceDuplicates(AutoUpdate: boolean): TStringToStringTree; // unit to semicolon separated list of files
GetUnitSrcFilenull976 function GetUnitSrcFile(const AnUnitName: string;
977 SrcSearchRequiresPPU: boolean = true;
978 SkipPPUCheckIfTargetIsSourceOnly: boolean = true): string;
GetCompiledUnitFilenull979 function GetCompiledUnitFile(const AUnitName: string): string;
980 property ChangeStamp: integer read FChangeStamp;
GetInvalidChangeStampnull981 class function GetInvalidChangeStamp: integer;
982 procedure IncreaseChangeStamp;
GetUnitSetIDnull983 function GetUnitSetID: string;
GetFirstFPCCfgnull984 function GetFirstFPCCfg: string;
GetUnitScopesnull985 function GetUnitScopes: string;
GetCompilerKindnull986 function GetCompilerKind: TPascalCompiler;
987 end;
988
989 { TCompilerDefinesCache }
990
991 TCompilerDefinesCache = class(TComponent)
992 private
993 FConfigCaches: TPCTargetConfigCaches;
994 FConfigCachesSaveStamp: integer;
995 FSourceCaches: TFPCSourceCaches;
996 FSourceCachesSaveStamp: integer;
997 fUnitToSrcCaches: TFPList; // list of TFPCUnitSetCache
GetExtraOptionsnull998 function GetExtraOptions: string;
GetTestFilenamenull999 function GetTestFilename: string;
1000 procedure SetConfigCaches(const AValue: TPCTargetConfigCaches);
1001 procedure SetExtraOptions(AValue: string);
1002 procedure SetSourceCaches(const AValue: TFPCSourceCaches);
1003 procedure ClearUnitToSrcCaches;
1004 procedure SetTestFilename(AValue: string);
1005 public
1006 constructor Create(AOwner: TComponent); override;
1007 destructor Destroy; override;
1008 procedure Clear;
1009 procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
1010 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
1011 procedure LoadFromFile(Filename: string);
1012 procedure SaveToFile(Filename: string);
NeedsSavenull1013 function NeedsSave: boolean;
1014 property SourceCaches: TFPCSourceCaches read FSourceCaches write SetSourceCaches;
1015 property ConfigCaches: TPCTargetConfigCaches read FConfigCaches write SetConfigCaches;
1016 property TestFilename: string read GetTestFilename write SetTestFilename; // an empty file to test the compiler, will be auto created
1017 property ExtraOptions: string read GetExtraOptions write SetExtraOptions; // additional compiler options not used as key, e.g. -Fr<language file>
GetFPCVersionnull1018 function GetFPCVersion(const CompilerFilename, TargetOS, TargetCPU: string;
1019 UseCompiledVersionAsDefault: boolean): string; deprecated 'use GetPCVersion'; // 2.0.1
GetPCVersionnull1020 function GetPCVersion(const CompilerFilename, TargetOS, TargetCPU: string;
1021 UseCompiledVersionAsDefault: boolean;
1022 out Kind: TPascalCompiler): string;
FindUnitSetnull1023 function FindUnitSet(const CompilerFilename, TargetOS, TargetCPU,
1024 Options, FPCSrcDir: string;
1025 CreateIfNotExists: boolean): TFPCUnitSetCache;
FindUnitSetWithIDnull1026 function FindUnitSetWithID(const UnitSetID: string; out Changed: boolean;
1027 CreateIfNotExists: boolean): TFPCUnitSetCache;
GetUnitSetIDnull1028 function GetUnitSetID(CompilerFilename, TargetOS, TargetCPU, Options,
1029 FPCSrcDir: string; ChangeStamp: integer): string;
1030 procedure ParseUnitSetID(const ID: string; out CompilerFilename,
1031 TargetOS, TargetCPU, Options, FPCSrcDir: string;
1032 out ChangeStamp: integer);
1033 end;
1034
1035 TFPCDefinesCache = TCompilerDefinesCache deprecated 'use TCompilerDefinesCache'; // 1.9
1036
DefineActionNameToActionnull1037 function DefineActionNameToAction(const s: string): TDefineAction;
DefineTemplateFlagsToStringnull1038 function DefineTemplateFlagsToString(Flags: TDefineTemplateFlags): string;
GetDefaultSrcOSForTargetOSnull1039 function GetDefaultSrcOSForTargetOS(const TargetOS: string): string;
GetDefaultSrcOS2ForTargetOSnull1040 function GetDefaultSrcOS2ForTargetOS(const TargetOS: string): string;
GetDefaultSrcCPUForTargetCPUnull1041 function GetDefaultSrcCPUForTargetCPU(const TargetCPU: string): string;
1042 procedure SplitLazarusCPUOSWidgetCombo(const Combination: string;
1043 out CPU, OS, WidgetSet: string);
GetCompiledFPCVersionnull1044 function GetCompiledFPCVersion: integer;
GetCompiledTargetOSnull1045 function GetCompiledTargetOS: string;
GetCompiledTargetCPUnull1046 function GetCompiledTargetCPU: string;
GetDefaultCompilerFilenamenull1047 function GetDefaultCompilerFilename(const TargetCPU: string = ''; Cross: boolean = false): string;
1048 procedure GetTargetProcessors(const TargetCPU: string; aList: TStrings);
GetFPCTargetOSnull1049 function GetFPCTargetOS(TargetOS: string): string; // normalize
GetFPCTargetCPUnull1050 function GetFPCTargetCPU(TargetCPU: string): string; // normalize
IsPas2jsTargetOSnull1051 function IsPas2jsTargetOS(TargetOS: string): boolean;
IsPas2jsTargetCPUnull1052 function IsPas2jsTargetCPU(TargetCPU: string): boolean;
1053
IsCTExecutablenull1054 function IsCTExecutable(AFilename: string; out ErrorMsg: string): boolean; // not thread-safe
1055
GuessPascalCompilerFromExeNamenull1056 function GuessPascalCompilerFromExeName(Filename: string): TPascalCompiler; // thread-safe
IsCompilerExecutablenull1057 function IsCompilerExecutable(AFilename: string; out ErrorMsg: string;
1058 out Kind: TPascalCompiler; Run: boolean): boolean; // not thread-safe
IsFPCExecutablenull1059 function IsFPCExecutable(AFilename: string; out ErrorMsg: string; Run: boolean): boolean; deprecated; // 2.1, not thread-safe
IsPas2JSExecutablenull1060 function IsPas2JSExecutable(AFilename: string; out ErrorMsg: string; Run: boolean): boolean; deprecated; // 2.1, not thread-safe
1061
1062 // functions to quickly setup some defines
CreateDefinesInDirectoriesnull1063 function CreateDefinesInDirectories(const SourcePaths, FlagName: string
1064 ): TDefineTemplate;
1065
GatherFilesnull1066 function GatherFiles(Directory, ExcludeDirMask, IncludeFileMask: string;
1067 MaxLevel: integer; const OnProgress: TDefinePoolProgress): TStringList; // thread safe
GatherFilesInFPCSourcesnull1068 function GatherFilesInFPCSources(Directory: string;
1069 const OnProgress: TDefinePoolProgress): TStringList; // thread safe
MakeRelativeFileListnull1070 function MakeRelativeFileList(Files: TStrings; out BaseDir: string): TStringList;
Compress1FileListnull1071 function Compress1FileList(Files: TStrings): TStringList; // thread-safe
Decompress1FileListnull1072 function Decompress1FileList(Files: TStrings): TStringList; // thread-safe
RunToolnull1073 function RunTool(const Filename: string; Params: TStrings;
1074 WorkingDirectory: string = ''; Quiet: boolean = false): TStringList; // thread-safe
RunToolnull1075 function RunTool(const Filename, Params: string;
1076 WorkingDirectory: string = ''; Quiet: boolean = false): TStringList; // thread-safe
1077
1078 type
1079 // fpc parameter effecting search for compiler
1080 TFPCFrontEndParam = (
1081 fpcpT, // -T<targetos>
1082 fpcpP, // -P<targetprocessor>
1083 fpcpV, // -V<postfix>
1084 fpcpXp // -Xp<directory>
1085 );
1086 TFPCFrontEndParams = set of TFPCFrontEndParam;
1087 const
1088 AllFPCFrontEndParams = [low(TFPCFrontEndParam)..high(TFPCFrontEndParam)];
1089
ParseFPCInfonull1090 function ParseFPCInfo(FPCInfo: string; InfoTypes: TFPCInfoTypes;
1091 out Infos: TFPCInfoStrings): boolean;
RunFPCInfonull1092 function RunFPCInfo(const CompilerFilename: string;
1093 InfoTypes: TFPCInfoTypes; const Options: string =''): string;
FPCVersionToNumbernull1094 function FPCVersionToNumber(const FPCVersionString: string): integer; // 2.7.1 -> 20701
SplitFPCVersionnull1095 function SplitFPCVersion(const FPCVersionString: string;
1096 out FPCVersion, FPCRelease, FPCPatch: integer): boolean; // 2.7.1 -> 2,7,1
ParseFPCVerbosenull1097 function ParseFPCVerbose(List: TStrings; // fpc -va output
1098 const WorkDir: string;
1099 out ConfigFiles: TStrings; // prefix '-' for file not found, '+' for found and read
1100 out RealCompilerFilename: string; // what compiler is used by fpc
1101 out UnitPaths: TStrings; // unit search paths
1102 out IncludePaths: TStrings; // include search paths
1103 out UnitScopes: TStrings; // unit scopes/namespaces
1104 out Defines, Undefines: TStringToStringTree): boolean;
RunFPCVerbosenull1105 function RunFPCVerbose(const CompilerFilename, TestFilename: string;
1106 out ConfigFiles: TStrings;
1107 out RealCompilerFilename: string;
1108 out UnitPaths: TStrings;
1109 out IncludePaths: TStrings;
1110 out UnitScopes: TStrings; // unit scopes/namespaces
1111 out Defines, Undefines: TStringToStringTree;
1112 const Options: string = ''): boolean;
1113 procedure GatherUnitsInSearchPaths(SearchUnitPaths, SearchIncludePaths: TStrings;
1114 const OnProgress: TDefinePoolProgress;
1115 out Units: TStringToStringTree;
1116 out Includes: TStringToStringTree;
1117 CheckFPMkInst: boolean = false); // unit names to full file name
GatherUnitSourcesInDirectorynull1118 function GatherUnitSourcesInDirectory(Directory: string;
1119 MaxLevel: integer = 1): TStringToStringTree; // unit names to full file name
1120 procedure AdjustFPCSrcRulesForPPUPaths(Units: TStringToStringTree;
1121 Rules: TFPCSourceRules); // not for pas2js
GatherUnitsInFPCSourcesnull1122 function GatherUnitsInFPCSources(Files: TStringList;
1123 TargetOS: string = ''; TargetCPU: string = '';
1124 Duplicates: TStringToStringTree = nil; // unit to semicolon separated list of files
1125 Rules: TFPCSourceRules = nil;
1126 const DebugUnitName: string = ''): TStringToStringTree; // not for pas2js
CreateFPCTemplatenull1127 function CreateFPCTemplate(Config: TPCTargetConfigCache;
1128 Owner: TObject): TDefineTemplate; overload;
CreateFPCTemplatenull1129 function CreateFPCTemplate(Config: TFPCUnitSetCache;
1130 Owner: TObject): TDefineTemplate; overload;
CreateFPCSourceTemplatenull1131 function CreateFPCSourceTemplate(Config: TFPCUnitSetCache;
1132 Owner: TObject): TDefineTemplate; overload; // not for pas2js
CreateFPCSourceTemplatenull1133 function CreateFPCSourceTemplate(FPCSrcDir: string;
1134 Owner: TObject): TDefineTemplate; overload; // not for pas2js
1135 procedure CheckPPUSources(PPUFiles, // unitname to filename
1136 UnitToSource, // unitname to file name
1137 UnitToDuplicates: TStringToStringTree; // unitname to semicolon separated list of files
1138 var Duplicates, Missing: TStringToStringTree); // not for pas2js
1139 procedure LoadFPCCacheFromFile(Filename: string;
1140 var Configs: TPCTargetConfigCaches; var Sources: TFPCSourceCaches);
1141 procedure SaveFPCCacheToFile(Filename: string;
1142 Configs: TPCTargetConfigCaches; Sources: TFPCSourceCaches);
1143
1144 // FPC
1145 const
1146 FPCParamEnabled = 'true';
1147
1148 type
1149 TFPCParamKind = (
1150 fpkUnknown,
1151 fpkBoolean, // Values: true = FPCParamEnabled otherwise false
1152 fpkValue,
1153 fpkMultiValue, // e.g. -k
1154 fpkDefine, // -d and -u options
1155 fpkConfig, // @ parameter
1156 fpkNonOption // e.g. source file
1157 );
1158 TFPCParamFlag = (
1159 fpfUnset, // use default, e.g. turns an fpkDefine into an Undefine
1160 fpfSetTwice,
1161 fpfValueChanged);
1162 TFPCParamFlags = set of TFPCParamFlag;
1163
1164 { TFPCParamValue }
1165
1166 TFPCParamValue = class
1167 public
1168 Name: string;
1169 Value: string;
1170 Kind: TFPCParamKind;
1171 Flags: TFPCParamFlags;
1172 constructor Create(const aName, aValue: string; aKind: TFPCParamKind; aFlags: TFPCParamFlags = []);
1173 end;
1174 procedure ParseFPCParameters(const CmdLineParams: string;
1175 Params: TObjectList { list of TFPCParamValue }; ReadBackslash: boolean = false);
1176 procedure ParseFPCParameters(CmdLineParams: TStrings;
1177 ParsedParams: TObjectList { list of TFPCParamValue });
1178 procedure ParseFPCParameter(const CmdLineParam: string;
1179 ParsedParams: TObjectList { list of TFPCParamValue });
IndexOfFPCParamValuenull1180 function IndexOfFPCParamValue(ParsedParams: TObjectList { list of TFPCParamValue };
1181 const Name: string): integer;
GetFPCParamValuenull1182 function GetFPCParamValue(ParsedParams: TObjectList { list of TFPCParamValue };
1183 const Name: string): TFPCParamValue;
dbgsnull1184 function dbgs(k: TFPCParamKind): string; overload;
dbgsnull1185 function dbgs(f: TFPCParamFlag): string; overload;
dbgsnull1186 function dbgs(const Flags: TFPCParamFlags): string; overload;
ExtractFPCFrontEndParametersnull1187 function ExtractFPCFrontEndParameters(const CmdLineParams: string;
1188 const Kinds: TFPCFrontEndParams = AllFPCFrontEndParams): string;
1189
1190 procedure ReadMakefileFPC(const Filename: string; List: TStrings);
1191 procedure ParseMakefileFPC(const Filename, SrcOS: string;
1192 out Dirs, SubDirs: string);
1193
CompareFPCSourceRulesViaFilenamenull1194 function CompareFPCSourceRulesViaFilename(Rule1, Rule2: Pointer): integer;
CompareFPCTargetConfigCacheItemsnull1195 function CompareFPCTargetConfigCacheItems(CacheItem1, CacheItem2: Pointer): integer;
CompareFPCSourceCacheItemsnull1196 function CompareFPCSourceCacheItems(CacheItem1, CacheItem2: Pointer): integer;
CompareDirectoryWithFPCSourceCacheItemnull1197 function CompareDirectoryWithFPCSourceCacheItem(AString, CacheItem: Pointer): integer;
1198
1199
1200 implementation
1201
1202
1203 type
1204 TUnitNameLink = class
1205 public
1206 Unit_Name: string;
1207 Filename: string;
1208 ConflictFilename: string;
1209 MacroCount: integer;
1210 UsedMacroCount: integer;
1211 Score: integer;
1212 end;
1213
CompareUnitNameLinksnull1214 function CompareUnitNameLinks(Link1, Link2: Pointer): integer;
1215 var
1216 UnitLink1: TUnitNameLink absolute Link1;
1217 UnitLink2: TUnitNameLink absolute Link2;
1218 begin
1219 Result:=CompareNames(UnitLink1.Unit_Name,UnitLink2.Unit_Name);
1220 end;
1221
CompareUnitNameWithUnitNameLinknull1222 function CompareUnitNameWithUnitNameLink(Name, Link: Pointer): integer;
1223 var
1224 UnitLink: TUnitNameLink absolute Link;
1225 begin
1226 Result:=CompareNames(AnsiString(Name),UnitLink.Unit_Name);
1227 end;
1228
1229 // some useful functions
1230
GatherFilesnull1231 function GatherFiles(Directory, ExcludeDirMask, IncludeFileMask: string;
1232 MaxLevel: integer; const OnProgress: TDefinePoolProgress): TStringList;
1233 { ExcludeDirMask: check FilenameIsMatching vs the short file name of a directory
1234 IncludeFileMask: check FilenameIsMatching vs the short file name of a file
1235 }
1236 var
1237 Files: TAVLTree; // tree of ansistring
1238 FileCount: integer;
1239 Abort: boolean;
1240
1241 procedure Add(Filename: string);
1242 var
1243 s: String;
1244 begin
1245 if Filename='' then exit;
1246 // increase refcount
1247 s:=Filename;
1248 // add
1249 Files.Add(PChar(s));
1250 // keep refcount
1251 Pointer(s):=nil;
1252 end;
1253
1254 procedure Search(CurDir: string; Level: integer);
1255 var
1256 FileInfo: TSearchRec;
1257 ShortFilename: String;
1258 Filename: String;
1259 begin
1260 if Level>MaxLevel then exit;
1261 //DebugLn(['Search CurDir=',CurDir]);
1262 if FindFirstUTF8(Directory+CurDir+FileMask,faAnyFile,FileInfo)=0 then begin
1263 repeat
1264 inc(FileCount);
1265 if (FileCount mod 100=0) and Assigned(OnProgress) then begin
1266 OnProgress(nil,0,-1,'Scanned files: '+IntToStr(FileCount),Abort);
1267 if Abort then break;
1268 end;
1269 ShortFilename:=FileInfo.Name;
1270 if (ShortFilename='') or (ShortFilename='.') or (ShortFilename='..') then
1271 continue;
1272 //debugln(['Search ShortFilename=',ShortFilename,' IsDir=',(FileInfo.Attr and faDirectory)>0]);
1273 Filename:=CurDir+ShortFilename;
1274 if (FileInfo.Attr and faDirectory)>0 then begin
1275 // directory
1276 if (ExcludeDirMask='')
1277 or (not FilenameIsMatching(ExcludeDirMask,ShortFilename,true))
1278 then begin
1279 Search(Filename+PathDelim,Level+1);
1280 if Abort then break;
1281 end else begin
1282 //DebugLn(['Search DIR MISMATCH ',Filename]);
1283 end;
1284 end else begin
1285 // file
1286 if (IncludeFileMask='')
1287 or FilenameIsMatching(IncludeFileMask,ShortFilename,true) then begin
1288 //DebugLn(['Search ADD ',Filename]);
1289 Add(Filename);
1290 end else begin
1291 //DebugLn(['Search MISMATCH ',Filename]);
1292 end;
1293 end;
1294 until FindNextUTF8(FileInfo)<>0;
1295 end;
1296 FindCloseUTF8(FileInfo);
1297 end;
1298
1299 var
1300 Node: TAVLTreeNode;
1301 s: String;
1302 NodeMgr: TAVLTreeNodeMemManager;
1303 begin
1304 Result:=nil;
1305 Files:=TAVLTree.Create(@CompareAnsiStringFilenames);
1306 NodeMgr:=TAVLTreeNodeMemManager.Create;
1307 Files.SetNodeManager(NodeMgr);
1308 Abort:=false;
1309 try
1310 FileCount:=0;
1311 Directory:=TrimAndExpandDirectory(Directory);
1312 if Directory='' then exit;
1313 Search('',0);
1314 finally
1315 if not Abort then
1316 Result:=TStringList.Create;
1317 Node:=Files.FindLowest;
1318 while Node<>nil do begin
1319 Pointer(s):=Node.Data;
1320 if Result<>nil then Result.Add(s);
1321 s:='';
1322 Node:=Files.FindSuccessor(Node);
1323 end;
1324 FreeAndNil(Files);
1325 FreeAndNil(NodeMgr);
1326 end;
1327 end;
1328
GatherFilesInFPCSourcesnull1329 function GatherFilesInFPCSources(Directory: string;
1330 const OnProgress: TDefinePoolProgress): TStringList;
1331 begin
1332 Result:=GatherFiles(Directory,'{.*,CVS}',
1333 '{*.pas,*.pp,*.p,*.inc,Makefile.fpc}',8,OnProgress);
1334 end;
1335
MakeRelativeFileListnull1336 function MakeRelativeFileList(Files: TStrings; out BaseDir: string
1337 ): TStringList;
1338 var
1339 BaseDirLen: Integer;
1340 i: Integer;
1341 Filename: string;
1342 begin
1343 BaseDir:='';
1344 Result:=TStringList.Create;
1345 if (Files=nil) or (Files.Count=0) then exit;
1346 Result.Assign(Files);
1347 // delete empty lines
1348 for i:=Result.Count-1 downto 0 do
1349 if Result[i]='' then Result.Delete(i);
1350 if Result.Count=0 then exit;
1351 // find shortest common BaseDir
1352 BaseDir:=ChompPathDelim(ExtractFilepath(Result[0]));
1353 BaseDirLen:=length(BaseDir);
1354 for i:=1 to Result.Count-1 do begin
1355 Filename:=Result[i];
1356 while (BaseDirLen>0) do begin
1357 if (BaseDirLen<=length(Filename))
1358 and ((BaseDirLen=length(Filename)) or (Filename[BaseDirLen+1]=PathDelim))
1359 and (CompareFilenames(BaseDir,copy(Filename,1,BaseDirLen))=0) then
1360 break;
1361 BaseDir:=ChompPathDelim(ExtractFilePath(copy(BaseDir,1,BaseDirLen-1)));
1362 BaseDirLen:=length(BaseDir);
1363 if (BaseDir='') or (BaseDir[length(BaseDir)]=PathDelim) then break;
1364 end;
1365 end;
1366 // create relative paths
1367 if (BaseDir<>'') then
1368 for i:=0 to Result.Count-1 do begin
1369 Filename:=Result[i];
1370 delete(Filename,1,BaseDirLen);
1371 if (Filename<>'') and (Filename[1]=PathDelim) then
1372 System.Delete(Filename,1,1);
1373 Result[i]:=Filename;
1374 end;
1375 end;
1376
Compress1FileListnull1377 function Compress1FileList(Files: TStrings): TStringList;
1378 var
1379 i: Integer;
1380 Filename: string;
1381 LastFilename: String;
1382 p: Integer;
1383 begin
1384 Result:=TStringList.Create;
1385 LastFilename:='';
1386 for i:=0 to Files.Count-1 do begin
1387 Filename:=TrimFilename(Files[i]);
1388 p:=1;
1389 while (p<=length(Filename)) and (p<=length(LastFilename))
1390 and (Filename[p]=LastFilename[p]) do
1391 inc(p);
1392 Result.Add(IntToStr(p-1)+':'+copy(Filename,p,length(Filename)));
1393 LastFilename:=Filename;
1394 end;
1395 end;
1396
Decompress1FileListnull1397 function Decompress1FileList(Files: TStrings): TStringList;
1398 var
1399 LastFilename: String;
1400 i: Integer;
1401 Filename: string;
1402 p: Integer;
1403 Same: Integer;
1404 begin
1405 Result:=TStringList.Create;
1406 LastFilename:='';
1407 try
1408 for i:=0 to Files.Count-1 do begin
1409 Filename:=Files[i];
1410 p:=1;
1411 Same:=0;
1412 while (p<=length(Filename)) and (Filename[p] in ['0'..'9']) do begin
1413 Same:=Same*10+ord(Filename[p])-ord('0');
1414 inc(p);
1415 end;
1416 inc(p);
1417 Filename:=copy(LastFilename,1,Same)+copy(Filename,p,length(Filename));
1418 Result.Add(Filename);
1419 LastFilename:=Filename;
1420 end;
1421 except
1422 end;
1423 end;
1424
RunToolnull1425 function RunTool(const Filename: string; Params: TStrings;
1426 WorkingDirectory: string; Quiet: boolean): TStringList;
1427 var
1428 buf: string;
1429 TheProcess: TProcessUTF8;
1430 OutputLine: String;
1431 OutLen: Integer;
1432 LineStart, i: Integer;
1433 begin
1434 Result:=nil;
1435 if not FileIsExecutable(Filename) then
1436 exit(nil);
1437 if (WorkingDirectory<>'') and not DirPathExists(WorkingDirectory) then
1438 exit(nil);
1439 Result:=TStringList.Create;
1440 try
1441 buf:='';
1442 if (MainThreadID=GetCurrentThreadId) and not Quiet then begin
1443 DbgOut(['Hint: (lazarus) [RunTool] "',Filename,'"']);
1444 for i:=0 to Params.Count-1 do
1445 dbgout(' "',Params[i],'"');
1446 Debugln;
1447 end;
1448 TheProcess := TProcessUTF8.Create(nil);
1449 try
1450 TheProcess.Executable := Filename;
1451 TheProcess.Parameters:=Params;
1452 TheProcess.Options:= [poUsePipes, poStdErrToOutPut];
1453 TheProcess.ShowWindow := swoHide;
1454 TheProcess.CurrentDirectory:=WorkingDirectory;
1455 TheProcess.Execute;
1456 OutputLine:='';
1457 SetLength(buf,4096);
1458 repeat
1459 if (TheProcess.Output<>nil) then begin
1460 OutLen:=TheProcess.Output.Read(Buf[1],length(Buf));
1461 end else
1462 OutLen:=0;
1463 //debugln(['RunTool OutLen=',OutLen,' Buf="',copy(Buf,1,OutLen),'"']);
1464 LineStart:=1;
1465 i:=1;
1466 while i<=OutLen do begin
1467 if Buf[i] in [#10,#13] then begin
1468 OutputLine:=OutputLine+copy(Buf,LineStart,i-LineStart);
1469 Result.Add(OutputLine);
1470 OutputLine:='';
1471 if (i<OutLen) and (Buf[i+1] in [#10,#13]) and (Buf[i]<>Buf[i+1])
1472 then
1473 inc(i);
1474 LineStart:=i+1;
1475 end;
1476 inc(i);
1477 end;
1478 OutputLine:=OutputLine+copy(Buf,LineStart,OutLen-LineStart+1);
1479 until OutLen=0;
1480 //debugln(['RunTool Last=',OutputLine]);
1481 if OutputLine<>'' then
1482 Result.Add(OutputLine);
1483 //debugln(['RunTool Result=',Result[Result.Count-1]]);
1484 TheProcess.WaitOnExit;
1485 finally
1486 TheProcess.Free;
1487 end;
1488 except
1489 FreeAndNil(Result);
1490 end;
1491 end;
1492
RunToolnull1493 function RunTool(const Filename, Params: string; WorkingDirectory: string;
1494 Quiet: boolean): TStringList;
1495 var
1496 ParamList: TStringList;
1497 begin
1498 ParamList:=TStringList.Create;
1499 try
1500 SplitCmdLineParams(Params,ParamList);
1501 Result:=RunTool(Filename,ParamList,WorkingDirectory,Quiet);
1502 finally
1503 ParamList.Free;
1504 end;
1505 end;
1506
ParseFPCInfonull1507 function ParseFPCInfo(FPCInfo: string; InfoTypes: TFPCInfoTypes;
1508 out Infos: TFPCInfoStrings): boolean;
1509 var
1510 i: TFPCInfoType;
1511 p: PChar;
1512 StartPos: PChar;
1513 begin
1514 Result:=false;
1515 if FPCInfo='' then exit(InfoTypes=[]);
1516 if copy(FPCInfo,1,6)='Error:' then exit(false);
1517
1518 p:=PChar(FPCInfo);
1519 for i:=low(TFPCInfoType) to high(TFPCInfoType) do begin
1520 if not (i in InfoTypes) then continue;
1521 StartPos:=p;
1522 while not (p^ in [' ',#0]) do inc(p);
1523 if (p=StartPos) then exit(false);
1524 Infos[i]:=copy(FPCInfo,StartPos-PChar(FPCInfo)+1,p-StartPos);
1525 // skip space
1526 if p^<>#0 then
1527 inc(p);
1528 end;
1529 Result:=true;
1530 end;
1531
RunFPCInfonull1532 function RunFPCInfo(const CompilerFilename: string;
1533 InfoTypes: TFPCInfoTypes; const Options: string): string;
1534 var
1535 Param: String;
1536 List: TStringList;
1537 Params: TStringListUTF8;
1538 begin
1539 Result:='';
1540 Param:='';
1541 if fpciCompilerDate in InfoTypes then Param:=Param+'D';
1542 if fpciShortVersion in InfoTypes then Param:=Param+'V';
1543 if fpciFullVersion in InfoTypes then Param:=Param+'W';
1544 if fpciCompilerOS in InfoTypes then Param:=Param+'SO';
1545 if fpciCompilerProcessor in InfoTypes then Param:=Param+'SP';
1546 if fpciTargetOS in InfoTypes then Param:=Param+'TO';
1547 if fpciTargetProcessor in InfoTypes then Param:=Param+'TP';
1548 if Param='' then exit;
1549 Param:='-i'+Param;
1550 List:=nil;
1551 Params:=TStringListUTF8.Create;
1552 try
1553 Params.Add(Param);
1554 SplitCmdLineParams(Options,Params);
1555 List:=RunTool(CompilerFilename,Params);
1556 if (List=nil) or (List.Count<1) then exit;
1557 Result:=List[0];
1558 if copy(Result,1,6)='Error:' then Result:='';
1559 finally
1560 Params.Free;
1561 List.free;
1562 end;
1563 end;
1564
FPCVersionToNumbernull1565 function FPCVersionToNumber(const FPCVersionString: string): integer;
1566 var
1567 FPCVersion, FPCRelease, FPCPatch: integer;
1568 begin
1569 if SplitFPCVersion(FPCVersionString,FPCVersion,FPCRelease,FPCPatch) then
1570 Result:=FPCVersion*10000+FPCRelease*100+FPCPatch
1571 else
1572 Result:=0;
1573 end;
1574
SplitFPCVersionnull1575 function SplitFPCVersion(const FPCVersionString: string; out FPCVersion,
1576 FPCRelease, FPCPatch: integer): boolean;
1577 // for example 2.5.1
1578 var
1579 p: PChar;
1580
ReadWordnull1581 function ReadWord(out v: integer): boolean;
1582 var
1583 Empty: Boolean;
1584 begin
1585 v:=0;
1586 Empty:=true;
1587 while (p^ in ['0'..'9']) do begin
1588 if v>10000 then exit(false);
1589 v:=v*10+ord(p^)-ord('0');
1590 inc(p);
1591 Empty:=false;
1592 end;
1593 Result:=not Empty;
1594 end;
1595
1596 begin
1597 Result:=false;
1598 FPCVersion:=0;
1599 FPCRelease:=0;
1600 FPCPatch:=0;
1601 if FPCVersionString='' then exit;
1602 p:=PChar(FPCVersionString);
1603 if not ReadWord(FPCVersion) then exit;
1604 if (p^<>'.') then exit;
1605 inc(p);
1606 if not ReadWord(FPCRelease) then exit;
1607 if (p^<>'.') then exit;
1608 inc(p);
1609 if not ReadWord(FPCPatch) then exit;
1610 Result:=true;
1611 end;
1612
ParseFPCVerbosenull1613 function ParseFPCVerbose(List: TStrings; const WorkDir: string; out
1614 ConfigFiles: TStrings; out RealCompilerFilename: string; out
1615 UnitPaths: TStrings; out IncludePaths: TStrings; out UnitScopes: TStrings; out
1616 Defines, Undefines: TStringToStringTree): boolean;
1617
DeQuotenull1618 function DeQuote(const s: string): string;
1619 begin
1620 if (length(s)>1) and (s[1]='"') and (s[length(s)]='"') then
1621 Result:=AnsiDequotedStr(s,'"')
1622 else
1623 Result:=s;
1624 end;
1625
1626 procedure UndefineSymbol(const MacroName: string);
1627 begin
1628 {$IFDEF VerboseFPCSrcScan}
1629 DebugLn(['UndefineSymbol ',MacroName]);
1630 {$ENDIF}
1631 Defines.Remove(MacroName);
1632 Undefines[MacroName]:='';
1633 end;
1634
1635 procedure DefineSymbol(const MacroName, Value: string);
1636 begin
1637 {$IFDEF VerboseFPCSrcScan}
1638 if Value='' then
1639 DebugLn(['DefineSymbol ',MacroName])
1640 else
1641 DebugLn(['DefineSymbol ',MacroName,':=',Value]);
1642 {$ENDIF}
1643 Undefines.Remove(MacroName);
1644 Defines[MacroName]:=Value;
1645 end;
1646
ExpFilenull1647 function ExpFile(const aFilename: string): string;
1648 begin
1649 Result:=DeQuote(aFilename);
1650 if FilenameIsAbsolute(Result) then exit;
1651 Result:=AppendPathDelim(WorkDir)+Result;
1652 end;
1653
1654 procedure ProcessOutputLine(Line: string);
1655 var
1656 UpLine: string;
1657
IsUpLinenull1658 function IsUpLine(p: integer; const s: string): boolean;
1659 begin
1660 Result:=StrLComp(@UpLine[p], PChar(s), length(s)) = 0;
1661 end;
1662
1663 var
1664 SymbolName, SymbolValue, NewPath: string;
1665 i, len, CurPos: integer;
1666 Filename: String;
1667 p: SizeInt;
1668 begin
1669 Line:=SysToUtf8(Line);
1670 len := length(Line);
1671 if len <= 6 then Exit; // shortest match
1672
1673 CurPos := 1;
1674 // skip timestamp e.g. [0.306]
1675 if Line[CurPos] = '[' then begin
1676 repeat
1677 inc(CurPos);
1678 if CurPos > len then Exit;
1679 until line[CurPos] = ']';
1680 Inc(CurPos, 2); // skip space too
1681 if len - CurPos < 6 then Exit; // shortest match
1682 end;
1683
1684 UpLine:=UpperCaseStr(Line);
1685 case UpLine[CurPos] of
1686 'I':
1687 if IsUpLine(CurPos,'INFO: ') then
1688 inc(CurPos,6);
1689 'E':
1690 if IsUpLine(CurPos,'ERROR: ') then begin
1691 inc(CurPos,7);
1692 if RealCompilerFilename='' then begin
1693 p:=Pos(' returned an error exitcode',Line);
1694 if p>0 then
1695 RealCompilerFilename:=copy(Line,CurPos,p-CurPos);
1696 end;
1697 exit;
1698 end;
1699 end;
1700
1701 case UpLine[CurPos] of
1702 'C':
1703 if IsUpLine(CurPos,'CONFIGFILE SEARCH: ') then
1704 begin
1705 // skip keywords
1706 Inc(CurPos, 19);
1707 Filename:=ExpFile(GetForcedPathDelims(copy(Line,CurPos,length(Line))));
1708 ConfigFiles.Add('-'+Filename);
1709 end else if IsUpLine(CurPos,'COMPILER: ') then begin
1710 // skip keywords
1711 Inc(CurPos, 10);
1712 RealCompilerFilename:=ExpFile(copy(Line,CurPos,length(Line)));
1713 end;
1714 'M':
1715 if IsUpLine(CurPos,'MACRO ') then begin
1716 // skip keyword macro
1717 Inc(CurPos, 6);
1718
1719 if IsUpLine(CurPos,'DEFINED: ') then begin
1720 Inc(CurPos, 9);
1721 SymbolName:=copy(Line, CurPos, len);
1722 if (SameText(SymbolName,'PAS2JS_FULLVERSION')
1723 or SameText(SymbolName,'FPC_FULLVERSION'))
1724 and Defines.Contains(SymbolName) then
1725 begin
1726 // keep the FULLVERSION value
1727 // Note: pas2js <1.4 had a bug, it gave out DEFINED
1728 exit;
1729 end;
1730 DefineSymbol(SymbolName,'');
1731 Exit;
1732 end;
1733
1734 if IsUpLine(CurPos,'UNDEFINED: ') then begin
1735 Inc(CurPos, 11);
1736 SymbolName:=copy(Line,CurPos,len);
1737 UndefineSymbol(SymbolName);
1738 Exit;
1739 end;
1740
1741 // MACRO something...
1742 i := CurPos;
1743 while (i <= len) and (Line[i]<>' ') do inc(i);
1744 SymbolName:=copy(Line,CurPos,i-CurPos);
1745 CurPos := i + 1; // skip space
1746
1747 if IsUpLine(CurPos,'SET TO ') then begin
1748 // MACRO name SET TO "value"
1749 Inc(CurPos, 7);
1750 SymbolValue:=DeQuote(copy(Line, CurPos, len));
1751 DefineSymbol(SymbolName, SymbolValue);
1752 end;
1753 end;
1754 'R':
1755 if IsUpLine(CurPos,'READING OPTIONS FROM FILE ') then
1756 begin
1757 // skip keywords
1758 Inc(CurPos, 26);
1759 Filename:=ExpFile(GetForcedPathDelims(copy(Line,CurPos,length(Line))));
1760 if (ConfigFiles.Count>0)
1761 and (ConfigFiles[ConfigFiles.Count-1]='-'+Filename) then
1762 ConfigFiles.Delete(ConfigFiles.Count-1);
1763 {$IFDEF VerboseFPCSrcScan}
1764 DebugLn('Used options file: "',Filename,'"');
1765 {$ENDIF}
1766 ConfigFiles.Add('+'+Filename);
1767 end;
1768 'U':
1769 if IsUpLine(CurPos,'USING UNIT PATH: ') then begin
1770 Inc(CurPos, 17);
1771 NewPath:=ExpFile(GetForcedPathDelims(DeQuote(copy(Line,CurPos,len))));
1772 NewPath:=ChompPathDelim(TrimFilename(NewPath));
1773 {$IFDEF VerboseFPCSrcScan}
1774 DebugLn('Using unit path: "',NewPath,'"');
1775 {$ENDIF}
1776 UnitPaths.Add(NewPath);
1777 end else if IsUpLine(CurPos,'USING INCLUDE PATH: ') then begin
1778 Inc(CurPos, 20);
1779 NewPath:=ExpFile(GetForcedPathDelims(DeQuote(copy(Line,CurPos,len))));
1780 NewPath:=ChompPathDelim(TrimFilename(NewPath));
1781 {$IFDEF VerboseFPCSrcScan}
1782 DebugLn('Using include path: "',NewPath,'"');
1783 {$ENDIF}
1784 IncludePaths.Add(NewPath);
1785 end else if IsUpLine(CurPos,'USING UNIT SCOPE: ') then begin
1786 Inc(CurPos, 18);
1787 NewPath:=Trim(DeQuote(copy(Line,CurPos,len)));
1788 {$IFDEF VerboseFPCSrcScan}
1789 DebugLn('Using unit scope: "',NewPath,'"');
1790 {$ENDIF}
1791 UnitScopes.Add(NewPath);
1792 end;
1793 end;
1794 end;
1795
1796 var
1797 i: Integer;
1798 begin
1799 Result:=false;
1800 ConfigFiles:=TStringList.Create;
1801 RealCompilerFilename:='';
1802 UnitPaths:=TStringList.Create;
1803 IncludePaths:=TStringList.Create;
1804 UnitScopes:=TStringList.Create;
1805 Defines:=TStringToStringTree.Create(false);
1806 Undefines:=TStringToStringTree.Create(false);
1807 try
1808 for i:=0 to List.Count-1 do
1809 ProcessOutputLine(List[i]);
1810 Result:=true;
1811 finally
1812 if not Result then begin
1813 FreeAndNil(ConfigFiles);
1814 FreeAndNil(UnitPaths);
1815 FreeAndNil(IncludePaths);
1816 FreeAndNil(UnitScopes);
1817 FreeAndNil(Undefines);
1818 FreeAndNil(Defines);
1819 end;
1820 end;
1821 end;
1822
RunFPCVerbosenull1823 function RunFPCVerbose(const CompilerFilename, TestFilename: string; out
1824 ConfigFiles: TStrings; out RealCompilerFilename: string; out
1825 UnitPaths: TStrings; out IncludePaths: TStrings; out UnitScopes: TStrings;
1826 out Defines, Undefines: TStringToStringTree; const Options: string): boolean;
1827 var
1828 Params: TStringListUTF8;
1829 Filename: String;
1830 WorkDir: String;
1831 List: TStringList;
1832 fs: TFileStreamUTF8;
1833 begin
1834 Result:=false;
1835 ConfigFiles:=nil;
1836 RealCompilerFilename:='';
1837 UnitPaths:=nil;
1838 IncludePaths:=nil;
1839 UnitScopes:=nil;
1840 Defines:=nil;
1841 Undefines:=nil;
1842
1843 Params:=TStringListUTF8.Create;
1844 List:=nil;
1845 try
1846 Params.Add('-va');
1847
1848 if TestFilename<>'' then begin
1849 // create empty file
1850 try
1851 fs:=TFileStreamUTF8.Create(TestFilename,fmCreate);
1852 fs.Free;
1853 except
1854 debugln(['Warning: [RunFPCVerbose] unable to create test file "'+TestFilename+'"']);
1855 exit;
1856 end;
1857 Filename:=ExtractFileName(TestFilename);
1858 WorkDir:=ExtractFilePath(TestFilename);
1859 Params.Add(Filename);
1860 end else
1861 WorkDir:='';
1862
1863 SplitCmdLineParams(Options,Params);
1864
1865 //DebugLn(['RunFPCVerbose ',CompilerFilename,' ',Params,' ',WorkDir]);
1866 List:=RunTool(CompilerFilename,Params,WorkDir);
1867 if (List=nil) or (List.Count=0) then begin
1868 debugln(['Warning: RunFPCVerbose failed: ',CompilerFilename,' ',Params]);
1869 exit;
1870 end;
1871 Result:=ParseFPCVerbose(List,WorkDir,ConfigFiles,RealCompilerFilename,
1872 UnitPaths,IncludePaths,UnitScopes,Defines,Undefines);
1873 finally
1874 Params.Free;
1875 List.Free;
1876 if TestFilename<>'' then
1877 DeleteFileUTF8(TestFilename);
1878 end;
1879 end;
1880
1881 procedure GatherUnitsInSearchPaths(SearchUnitPaths, SearchIncludePaths: TStrings;
1882 const OnProgress: TDefinePoolProgress; out Units: TStringToStringTree;
1883 out Includes: TStringToStringTree; CheckFPMkInst: boolean);
1884 { returns a stringtree,
1885 where name is unitname and value is the full file name
1886
1887 SearchUnitsPaths are searched from last to start
1888 first found wins
1889 pas, pp, p replaces ppu
1890
1891 check for each UnitPath of the form
1892 lib/fpc/<FPCVer>/units/<FPCTarget>/<name>/
1893 if there is lib/fpc/<FPCVer>/fpmkinst/><FPCTarget>/<name>.fpm
1894 and search line SourcePath=<directory>
1895 and search source files in this directory including subdirectories
1896 }
1897
SearchPriorPathDelimnull1898 function SearchPriorPathDelim(var p: integer; const Filename: string): boolean; inline;
1899 begin
1900 repeat
1901 dec(p);
1902 if p<1 then exit(false)
1903 until Filename[p]=PathDelim;
1904 Result:=true;
1905 end;
1906
1907 var
1908 i: Integer;
1909 Directory: String;
1910 FileCount, p, EndPos, FPCTargetEndPos: Integer;
1911 Abort: boolean;
1912 FileInfo: TSearchRec;
1913 ShortFilename: String;
1914 Filename: String;
1915 Ext: String;
1916 File_Name, PkgName, FPMFilename, FPMSourcePath, Line, SrcFilename: String;
1917 AVLNode: TAVLTreeNode;
1918 S2SItem: PStringToStringItem;
1919 FPMToUnitTree: TStringToPointerTree;// pkgname to TStringToStringTree (unitname to source filename)
1920 sl: TStringListUTF8;
1921 PkgUnitToFilename: TStringToStringTree;
1922 begin
1923 // units sources
1924 Units:=TStringToStringTree.Create(false);
1925 FileCount:=0;
1926 Abort:=false;
1927 if Assigned(SearchUnitPaths) then
1928 for i:=SearchUnitPaths.Count-1 downto 0 do begin
1929 Directory:=TrimAndExpandDirectory(SearchUnitPaths[i]);
1930 if (Directory='') then continue;
1931 if FindFirstUTF8(Directory+FileMask,faAnyFile,FileInfo)=0 then begin
1932 repeat
1933 inc(FileCount);
1934 if (FileCount mod 100=0) and Assigned(OnProgress) then begin
1935 OnProgress(nil, 0, -1, Format(ctsScannedFiles, [IntToStr(FileCount)]
1936 ), Abort);
1937 if Abort then break;
1938 end;
1939 ShortFilename:=FileInfo.Name;
1940 if (ShortFilename='') or (ShortFilename='.') or (ShortFilename='..') then
1941 continue;
1942 //debugln(['GatherUnitsInSearchPaths ShortFilename=',ShortFilename,' IsDir=',(FileInfo.Attr and faDirectory)>0]);
1943 Filename:=Directory+ShortFilename;
1944 Ext:=LowerCase(ExtractFileExt(ShortFilename));
1945 if (Ext='.pas') or (Ext='.pp') or (Ext='.p') or (Ext='.ppu') then begin
1946 File_Name:=ExtractFileNameOnly(Filename);
1947 if (not Units.Contains(File_Name))
1948 or ((Ext<>'.ppu') and (CompareFileExt(Units[File_Name],'ppu',false)=0))
1949 then
1950 Units[File_Name]:=Filename;
1951 end;
1952 until FindNextUTF8(FileInfo)<>0;
1953 end;
1954 FindCloseUTF8(FileInfo);
1955 end;
1956
1957 // inc files
1958 Includes:=TStringToStringTree.Create(false);
1959 if Assigned(SearchIncludePaths) then
1960 for i:=SearchIncludePaths.Count-1 downto 0 do begin
1961 Directory:=TrimAndExpandDirectory(SearchIncludePaths[i]);
1962 if (Directory='') then continue;
1963 if FindFirstUTF8(Directory+FileMask,faAnyFile,FileInfo)=0 then begin
1964 repeat
1965 inc(FileCount);
1966 if (FileCount mod 100=0) and Assigned(OnProgress) then begin
1967 OnProgress(nil, 0, -1, Format(ctsScannedFiles, [IntToStr(FileCount)]
1968 ), Abort);
1969 if Abort then break;
1970 end;
1971 ShortFilename:=FileInfo.Name;
1972 if (ShortFilename='') or (ShortFilename='.') or (ShortFilename='..') then
1973 continue;
1974 //debugln(['GatherUnitsInSearchPaths ShortFilename=',ShortFilename,' IsDir=',(FileInfo.Attr and faDirectory)>0]);
1975 Filename:=Directory+ShortFilename;
1976 Ext:=LowerCase(ExtractFileExt(ShortFilename));
1977 if (Ext='.inc') then begin
1978 File_Name:=ExtractFileName(Filename);
1979 if (not Includes.Contains(File_Name))
1980 then
1981 Includes[File_Name]:=Filename;
1982 end;
1983 until FindNextUTF8(FileInfo)<>0;
1984 end;
1985 FindCloseUTF8(FileInfo);
1986 end;
1987
1988 // units ppu
1989 if CheckFPMkInst then begin
1990 // try to resolve .ppu files via fpmkinst .fpm files
1991 FPMToUnitTree:=nil;
1992 try
1993 AVLNode:=Units.Tree.FindLowest;
1994 while AVLNode<>nil do begin
1995 S2SItem:=PStringToStringItem(AVLNode.Data);
1996 File_Name:=S2SItem^.Name;
1997 Filename:=S2SItem^.Value; // trimmed and expanded filename
1998 //if Pos('lazmkunit',Filename)>0 then
1999 // debugln(['GatherUnitsInSearchPaths ===== ',Filename]);
2000 AVLNode:=Units.Tree.FindSuccessor(AVLNode);
2001 if CompareFileExt(Filename,'ppu',false)<>0 then continue;
2002 // check if filename has the form
2003 // /something/lib/fpc/<FPCVer>/units/<FPCTarget>/<pkgname>/
2004 // and if there is /something/lib/fpc/<FPCVer>/fpmkinst/><FPCTarget>/<pkgname>.fpm
2005 p:=length(Filename);
2006 if not SearchPriorPathDelim(p,Filename) then exit;
2007 // <pkgname>
2008 EndPos:=p;
2009 if not SearchPriorPathDelim(p,Filename) then exit;
2010 PkgName:=copy(Filename,p+1,EndPos-p-1);
2011 if PkgName='' then continue;
2012 FPCTargetEndPos:=p;
2013 if not SearchPriorPathDelim(p,Filename) then exit;
2014 // <fpctarget>
2015 EndPos:=p;
2016 if not SearchPriorPathDelim(p,Filename) then exit;
2017 // 'units'
2018 if (EndPos-p<>6) or (CompareIdentifiers(@Filename[p+1],'units')<>0) then
2019 continue;
2020 FPMFilename:=copy(Filename,1,p)+'fpmkinst'
2021 +copy(Filename,EndPos,FPCTargetEndPos-EndPos+1)+PkgName+'.fpm';
2022 if FPMToUnitTree=nil then begin
2023 FPMToUnitTree:=TStringToPointerTree.Create(false);
2024 FPMToUnitTree.FreeValues:=true;
2025 end;
2026 if not FPMToUnitTree.Contains(PkgName) then begin
2027 FPMSourcePath:='';
2028 if FileExistsCached(FPMFilename) then begin
2029 //debugln(['GatherUnitsInSearchPaths Found .fpm: ',FPMFilename]);
2030 sl:=TStringListUTF8.Create;
2031 try
2032 try
2033 sl.LoadFromFile(FPMFilename);
2034 for i:=0 to sl.Count-1 do begin
2035 Line:=sl[i];
2036 if LeftStr(Line,length('SourcePath='))='SourcePath=' then
2037 begin
2038 FPMSourcePath:=TrimAndExpandDirectory(copy(Line,length('SourcePath=')+1,length(Line)));
2039 break;
2040 end;
2041 end;
2042 except
2043 on E: Exception do
2044 debugln(['Warning: (lazarus) [GatherUnitsInSearchPaths] ',E.Message]);
2045 end;
2046 finally
2047 sl.Free;
2048 end;
2049 end;
2050 if FPMSourcePath<>'' then begin
2051 PkgUnitToFilename:=GatherUnitSourcesInDirectory(FPMSourcePath,5);
2052 FPMToUnitTree[PkgName]:=PkgUnitToFilename;
2053 //debugln(['GatherUnitsInSearchPaths Pkg=',PkgName,' UnitsFound=',PkgUnitToFilename.Count]);
2054 end else
2055 FPMToUnitTree[PkgName]:=nil; // mark as not found
2056 end;
2057
2058 PkgUnitToFilename:=TStringToStringTree(FPMToUnitTree[PkgName]);
2059 if PkgUnitToFilename=nil then continue;
2060 SrcFilename:=PkgUnitToFilename[File_Name];
2061 if SrcFilename<>'' then begin
2062 // unit source found in fppkg -> replace ppu with src file
2063 //debugln(['GatherUnitsInSearchPaths ppu=',Filename,' -> fppkg src=',SrcFilename]);
2064 Units[File_Name]:=SrcFilename;
2065 end;
2066 end;
2067 finally
2068 FPMToUnitTree.Free;
2069 end;
2070 end;
2071 end;
2072
GatherUnitSourcesInDirectorynull2073 function GatherUnitSourcesInDirectory(Directory: string; MaxLevel: integer
2074 ): TStringToStringTree;
2075
2076 procedure Traverse(Dir: string; Tree: TStringToStringTree; Lvl: integer);
2077 var
2078 Info: TSearchRec;
2079 Filename: String;
2080 AnUnitName: String;
2081 begin
2082 if FindFirstUTF8(Dir+AllFilesMask,faAnyFile,Info)=0 then begin
2083 repeat
2084 Filename:=Info.Name;
2085 if (Filename='') or (Filename='.') or (Filename='..') then continue;
2086 if faDirectory and Info.Attr>0 then begin
2087 if Lvl<MaxLevel then
2088 Traverse(Dir+Filename+PathDelim,Tree,Lvl+1);
2089 end else if FilenameIsPascalUnit(Filename) then begin
2090 AnUnitName:=ExtractFileNameOnly(Filename);
2091 if not Tree.Contains(AnUnitName) then
2092 Tree[AnUnitName]:=Dir+Filename;
2093 end;
2094 until FindNextUTF8(Info)<>0;
2095 end;
2096 FindCloseUTF8(Info);
2097 end;
2098
2099 begin
2100 Result:=TStringToStringTree.Create(false);
2101 if MaxLevel<1 then exit;
2102 Directory:=AppendPathDelim(Directory);
2103 Traverse(Directory,Result,1);
2104 end;
2105
2106 procedure AdjustFPCSrcRulesForPPUPaths(Units: TStringToStringTree;
2107 Rules: TFPCSourceRules);
2108 var
2109 Filename: string;
2110 Rule: TFPCSourceRule;
2111 begin
2112 if Units.CaseSensitive then
2113 raise Exception.Create('AdjustFPCSrcRulesForPPUPaths Units is case sensitive');
2114 // check unit httpd
2115 Filename:=Units['httpd'];
2116 if Filename<>'' then begin
2117 Filename:=ChompPathDelim(ExtractFilePath(Filename));
2118 Rule:=Rules.Add('packages/'+ExtractFileName(Filename));
2119 Rule.Score:=10;
2120 Rule.Targets:='*';
2121 //DebugLn(['AdjustFPCSrcRulesForPPUPaths ',Rule.Filename,' ',Filename]);
2122 end;
2123 end;
2124
GatherUnitsInFPCSourcesnull2125 function GatherUnitsInFPCSources(Files: TStringList; TargetOS: string;
2126 TargetCPU: string; Duplicates: TStringToStringTree;
2127 Rules: TFPCSourceRules; const DebugUnitName: string): TStringToStringTree;
2128 { returns tree unit name to file name (maybe relative)
2129 }
2130
CountMatchesnull2131 function CountMatches(Targets, aTxt: PChar): integer;
2132 // check how many of the comma separated words in Targets are in words of aTxt
2133 var
2134 TxtStartPos: PChar;
2135 TargetPos: PChar;
2136 TxtPos: PChar;
2137 begin
2138 Result:=0;
2139 if (aTxt=nil) or (Targets=nil) then exit;
2140 TxtStartPos:=aTxt;
2141 while true do begin
2142 while (not (IsIdentChar[TxtStartPos^])) do begin
2143 if TxtStartPos^=#0 then exit;
2144 inc(TxtStartPos);
2145 end;
2146 //DebugLn(['CountMatches TxtStartPos=',TxtStartPos]);
2147 TargetPos:=Targets;
2148 repeat
2149 while (TargetPos^=',') do inc(TargetPos);
2150 if TargetPos^=#0 then break;
2151 //DebugLn(['CountMatches TargetPos=',TargetPos]);
2152 TxtPos:=TxtStartPos;
2153 while (TxtPos^=TargetPos^) and (not (TargetPos^ in [#0,','])) do begin
2154 inc(TargetPos);
2155 inc(TxtPos);
2156 end;
2157 //DebugLn(['CountMatches Test TargetPos=',TargetPos,' TxtPos=',TxtPos]);
2158 if (TargetPos^ in [#0,',']) and (not IsIdentChar[TxtPos^]) then begin
2159 // the target fits
2160 //DebugLn(['CountMatches FITS']);
2161 inc(Result);
2162 end;
2163 // try next target
2164 while not (TargetPos^ in [#0,',']) do inc(TargetPos);
2165 until TargetPos^=#0;
2166 // next txt word
2167 while IsIdentChar[TxtStartPos^] do inc(TxtStartPos);
2168 end;
2169 end;
2170
2171 var
2172 i: Integer;
2173 Filename: string;
2174 Links: TAVLTree;
2175 Unit_Name: String;
2176 LastDirectory: String;
2177 LastDirScore: Integer;
2178 Directory: String;
2179 DirScore: LongInt;
2180 Node: TAVLTreeNode;
2181 Link: TUnitNameLink;
2182 TargetRules: TAVLTree;
2183 Score: LongInt;
2184 Targets: string;
2185 begin
2186 Result:=nil;
2187 if (Files=nil) or (Files.Count=0) then exit;
2188
2189 if (Duplicates<>nil) and Duplicates.CaseSensitive then
2190 raise Exception.Create('GatherUnitsInFPCSources: Duplicates case sensitive');
2191
2192 // get default targets
2193 if Rules=nil then Rules:=DefaultFPCSourceRules;
2194 Targets:=Rules.GetDefaultTargets(TargetOS,TargetCPU);
2195
2196 TargetRules:=nil;
2197 Links:=TAVLTree.Create(@CompareUnitNameLinks);
2198 try
2199 // get Score rules for duplicate units
2200 Rules.GetRulesForTargets(Targets,TargetRules);
2201 //DebugLn(['GatherUnitsInFPCSources ',Rules.GetScore('packages/h',TargetRules)]);
2202 //exit;
2203
2204 if (TargetRules<>nil) and (TargetRules.Count=0) then
2205 FreeAndNil(TargetRules);
2206 LastDirectory:='';
2207 LastDirScore:=0;
2208 for i:=0 to Files.Count-1 do begin
2209 Filename:=Files[i];
2210 if (CompareFileExt(Filename,'PAS',false)=0)
2211 or (CompareFileExt(Filename,'PP',false)=0)
2212 or (CompareFileExt(Filename,'P',false)=0)
2213 then begin
2214 if CompareFilenameOnly(PChar(Filename),length(Filename),'fpmake',6,true)=0
2215 then
2216 continue; // skip the fpmake.pp files
2217 // Filename is a pascal unit source
2218 Directory:=ExtractFilePath(Filename);
2219 if LastDirectory=Directory then begin
2220 // same directory => reuse directory Score
2221 DirScore:=LastDirScore;
2222 end else begin
2223 // a new directory => recompute directory score
2224 // default heuristic: add one point for every target in directory
2225 DirScore:=CountMatches(PChar(Targets),PChar(Directory));
2226 end;
2227 Score:=DirScore;
2228 // apply target rules
2229 if TargetRules<>nil then
2230 inc(Score,Rules.GetScore(Filename,TargetRules));
2231 // add or update unitlink
2232 Unit_Name:=ExtractFileNameOnly(Filename);
2233 Node:=Links.FindKey(Pointer(Unit_Name),@CompareUnitNameWithUnitNameLink);
2234 if Node<>nil then begin
2235 // duplicate unit
2236 Link:=TUnitNameLink(Node.Data);
2237 if Link.Score<Score then begin
2238 // found a better unit
2239 if (DebugUnitName<>'') and (SysUtils.CompareText(Unit_Name,DebugUnitName)=0)
2240 then
2241 debugln(['GatherUnitsInFPCSources UnitName=',Unit_Name,' File=',Filename,' Score=',Score,' => better than ',Link.Score]);
2242 Link.Unit_Name:=Unit_Name;
2243 Link.Filename:=Filename;
2244 Link.ConflictFilename:='';
2245 Link.Score:=Score;
2246 end else if Link.Score=Score then begin
2247 // unit with same Score => maybe a conflict
2248 // be deterministic and choose the highest
2249 if (DebugUnitName<>'') and (SysUtils.CompareText(Unit_Name,DebugUnitName)=0)
2250 then
2251 debugln(['GatherUnitsInFPCSources UnitName=',Unit_Name,' File=',Filename,' Score=',Score,' => duplicate']);
2252 if CompareStr(Filename,Link.Filename)>0 then begin
2253 if Link.ConflictFilename<>'' then
2254 Link.ConflictFilename:=Link.ConflictFilename+';'+Link.Filename
2255 else
2256 Link.ConflictFilename:=Link.Filename;
2257 Link.Filename:=Filename;
2258 end else begin
2259 Link.ConflictFilename:=Link.ConflictFilename+';'+Filename;
2260 end;
2261 end;
2262 end else begin
2263 // new unit source found => add to list
2264 if (DebugUnitName<>'') and (SysUtils.CompareText(Unit_Name,DebugUnitName)=0)
2265 then
2266 debugln(['GatherUnitsInFPCSources UnitName=',Unit_Name,' File=',Filename,' Score=',Score]);
2267 Link:=TUnitNameLink.Create;
2268 Link.Unit_Name:=Unit_Name;
2269 Link.Filename:=Filename;
2270 Link.Score:=Score;
2271 Links.Add(Link);
2272 end;
2273 LastDirectory:=Directory;
2274 LastDirScore:=DirScore;
2275 end;
2276 end;
2277 Result:=TStringToStringTree.Create(false);
2278 Node:=Links.FindLowest;
2279 while Node<>Nil do begin
2280 Link:=TUnitNameLink(Node.Data);
2281 Result[Link.Unit_Name]:=Link.Filename;
2282 if (Link.ConflictFilename<>'') and (Link.Score>0) then begin
2283 //DebugLn(['GatherUnitsInFPCSources Ambiguous: ',Link.Score,' ',Link.Filename,' ',Link.ConflictFilename]);
2284 if Duplicates<>nil then
2285 Duplicates[Link.Unit_Name]:=Link.Filename+';'+Link.ConflictFilename;
2286 end;
2287 Node:=Links.FindSuccessor(Node);
2288 end;
2289 finally
2290 TargetRules.Free;
2291 Links.FreeAndClear;
2292 Links.Free;
2293 end;
2294 end;
2295
CreateFPCTemplatenull2296 function CreateFPCTemplate(Config: TPCTargetConfigCache; Owner: TObject): TDefineTemplate;
2297 var
2298 Node: TAVLTreeNode;
2299 StrItem: PStringToStringItem;
2300 NewDefTempl: TDefineTemplate;
2301 TargetOS: String;
2302 SrcOS: String;
2303 SrcOS2: String;
2304 TargetCPU: String;
2305 begin
2306 Result:=TDefineTemplate.Create(StdDefTemplFPC,
2307 ctsFreePascalCompilerInitialMacros,'','',da_Block);
2308
2309 // define #TargetOS
2310 TargetOS:=Config.RealTargetOS;
2311 if TargetOS='' then
2312 TargetOS:=Config.TargetOS;
2313 if TargetOS='' then
2314 TargetOS:=GetCompiledTargetOS;
2315 NewDefTempl:=TDefineTemplate.Create('Define TargetOS',
2316 ctsDefaultFPCTargetOperatingSystem,
2317 ExternalMacroStart+'TargetOS',TargetOS,da_DefineRecurse);
2318 Result.AddChild(NewDefTempl);
2319 // define #SrcOS
2320 SrcOS:=GetDefaultSrcOSForTargetOS(TargetOS);
2321 if SrcOS='' then SrcOS:=TargetOS;
2322 NewDefTempl:=TDefineTemplate.Create('Define SrcOS',
2323 ctsDefaultFPCSourceOperatingSystem,
2324 ExternalMacroStart+'SrcOS',SrcOS,da_DefineRecurse);
2325 Result.AddChild(NewDefTempl);
2326 // define #SrcOS2
2327 SrcOS2:=GetDefaultSrcOS2ForTargetOS(TargetOS);
2328 if SrcOS2='' then SrcOS2:=TargetOS;
2329 NewDefTempl:=TDefineTemplate.Create('Define SrcOS2',
2330 ctsDefaultFPCSource2OperatingSystem,
2331 ExternalMacroStart+'SrcOS2',SrcOS2,da_DefineRecurse);
2332 Result.AddChild(NewDefTempl);
2333 // define #TargetCPU
2334 TargetCPU:=Config.RealTargetCPU;
2335 if TargetCPU='' then
2336 TargetCPU:=Config.TargetCPU;
2337 if TargetCPU='' then
2338 TargetCPU:=GetCompiledTargetCPU;
2339 NewDefTempl:=TDefineTemplate.Create('Define TargetCPU',
2340 ctsDefaultFPCTargetProcessor,
2341 TargetCPUMacroName,TargetCPU,
2342 da_DefineRecurse);
2343 Result.AddChild(NewDefTempl);
2344
2345 if Config.Defines<>nil then begin
2346 Node:=Config.Defines.Tree.FindLowest;
2347 while Node<>nil do begin
2348 StrItem:=PStringToStringItem(Node.Data);
2349 NewDefTempl:=TDefineTemplate.Create('Define '+StrItem^.Name,
2350 'Macro',StrItem^.Name,StrItem^.Value,da_DefineRecurse);
2351 Result.AddChild(NewDefTempl);
2352 Node:=Config.Defines.Tree.FindSuccessor(Node);
2353 end;
2354 end;
2355
2356 if Config.Undefines<>nil then begin
2357 Node:=Config.Undefines.Tree.FindLowest;
2358 while Node<>nil do begin
2359 StrItem:=PStringToStringItem(Node.Data);
2360 NewDefTempl:=TDefineTemplate.Create('Undefine '+StrItem^.Name,
2361 'Macro',StrItem^.Name,'',da_UndefineRecurse);
2362 Result.AddChild(NewDefTempl);
2363 Node:=Config.Undefines.Tree.FindSuccessor(Node);
2364 end;
2365 end;
2366
2367 Result.SetFlags([dtfAutoGenerated],[],false);
2368 Result.SetDefineOwner(Owner,true);
2369 end;
2370
CreateFPCTemplatenull2371 function CreateFPCTemplate(Config: TFPCUnitSetCache; Owner: TObject): TDefineTemplate; overload;
2372 begin
2373 Result:=CreateFPCTemplate(Config.GetConfigCache(false),Owner);
2374 Result.AddChild(TDefineTemplate.Create('UnitSet','UnitSet identifier',
2375 UnitSetMacroName,Config.GetUnitSetID,da_DefineRecurse));
2376 end;
2377
CreateFPCSourceTemplatenull2378 function CreateFPCSourceTemplate(FPCSrcDir: string; Owner: TObject): TDefineTemplate;
2379 const
2380 RTLPkgDirs: array[1..4] of string = ('rtl-console','rtl-extra','rtl-objpas','rtl-unicode');
2381 var
2382 Dir, SrcOS, SrcOS2, aTargetCPU,
2383 IncPathMacro: string;
2384 DS: char; // dir separator
2385
dnull2386 function d(const Filenames: string): string;
2387 begin
2388 Result:=GetForcedPathDelims(Filenames);
2389 end;
2390
2391 procedure AddSrcOSDefines(ParentDefTempl: TDefineTemplate);
2392 var
2393 IfTargetOSIsNotSrcOS: TDefineTemplate;
2394 RTLSrcOSDir: TDefineTemplate;
2395 IfTargetOSIsNotSrcOS2: TDefineTemplate;
2396 RTLSrcOS2Dir: TDefineTemplate;
2397 begin
2398 // if TargetOS<>SrcOS
2399 IfTargetOSIsNotSrcOS:=TDefineTemplate.Create(
2400 'IF TargetOS<>SrcOS',
2401 ctsIfTargetOSIsNotSrcOS,'',''''+TargetOSMacro+'''<>'''+SrcOS+'''',da_If);
2402 // rtl/$(#SrcOS)
2403 RTLSrcOSDir:=TDefineTemplate.Create('SrcOS',SrcOS,'',
2404 SrcOS,da_Directory);
2405 IfTargetOSIsNotSrcOS.AddChild(RTLSrcOSDir);
2406 // add include path inc
2407 RTLSrcOSDir.AddChild(TDefineTemplate.Create('Include Path',
2408 'include path',
2409 IncludePathMacroName,IncPathMacro+';inc',
2410 da_Define));
2411 // add include path $(TargetOS)
2412 RTLSrcOSDir.AddChild(TDefineTemplate.Create('Include Path',
2413 'include path to TargetCPU directories',
2414 IncludePathMacroName,IncPathMacro+';'+aTargetCPU,
2415 da_Define));
2416 ParentDefTempl.AddChild(IfTargetOSIsNotSrcOS);
2417
2418 // if TargetOS<>SrcOS2
2419 IfTargetOSIsNotSrcOS2:=TDefineTemplate.Create(
2420 'IF TargetOS is not SrcOS2',
2421 ctsIfTargetOSIsNotSrcOS,'',''''+TargetOSMacro+'''<>'''+SrcOS2+'''',da_If);
2422 // rtl/$(#SrcOS2)
2423 RTLSrcOS2Dir:=TDefineTemplate.Create('SrcOS2',SrcOS2,'',
2424 SrcOS2,da_Directory);
2425 IfTargetOSIsNotSrcOS2.AddChild(RTLSrcOS2Dir);
2426 RTLSrcOS2Dir.AddChild(TDefineTemplate.Create('Include Path',
2427 'include path to TargetCPU directories',
2428 IncludePathMacroName,IncPathMacro+';'+aTargetCPU,
2429 da_DefineRecurse));
2430 ParentDefTempl.AddChild(IfTargetOSIsNotSrcOS2);
2431 end;
2432
2433 var
2434 DefTempl, MainDir, FCLDir, RTLDir, RTLOSDir, PackagesDir, CompilerDir,
2435 UtilsDir, DebugSvrDir: TDefineTemplate;
2436 s: string;
2437 FCLDBDir: TDefineTemplate;
2438 FCLDBInterbaseDir: TDefineTemplate;
2439 InstallerDir: TDefineTemplate;
2440 IFTempl: TDefineTemplate;
2441 FCLBaseDir: TDefineTemplate;
2442 FCLBaseSrcDir: TDefineTemplate;
2443 PackagesFCLAsyncDir: TDefineTemplate;
2444 PackagesExtraDir: TDefineTemplate;
2445 PackagesFCLExtraDir: TDefineTemplate;
2446 PackagesSubDir: TDefineTemplate;
2447 PkgExtraGraphDir: TDefineTemplate;
2448 PkgExtraAMunitsDir: TDefineTemplate;
2449 FCLSubSrcDir: TDefineTemplate;
2450 FCLSubDir, SubPkgDir: TDefineTemplate;
2451 Ok: Boolean;
2452 begin
2453 {$IFDEF VerboseFPCSrcScan}
2454 DebugLn('CreateFPCSrcTemplate FPCSrcDir="',FPCSrcDir,'"');
2455 {$ENDIF}
2456 Result:=nil;
2457 Ok:=false;
2458 try
2459 if (FPCSrcDir='') or (not DirPathExists(FPCSrcDir)) then begin
2460 DebugLn(['Warning: [CreateFPCSrcTemplate] FPCSrcDir does not exist: FPCSrcDir="',FPCSrcDir,'"']);
2461 exit;
2462 end;
2463 DS:=PathDelim;
2464 Dir:=AppendPathDelim(FPCSrcDir);
2465 SrcOS:='$('+ExternalMacroStart+'SrcOS)';
2466 SrcOS2:='$('+ExternalMacroStart+'SrcOS2)';
2467 aTargetCPU:=TargetCPUMacro;
2468 IncPathMacro:=IncludePathMacro;
2469
2470 Result:=TDefineTemplate.Create(StdDefTemplFPCSrc,
2471 Format(ctsFreePascalSourcesPlusDesc,['RTL, FCL, Packages, Compiler']),
2472 '','',da_Block);
2473
2474 // The Free Pascal sources build a world of their own
2475 // => reset all search paths
2476 MainDir:=TDefineTemplate.Create('Free Pascal Source Directory',
2477 ctsFreePascalSourceDir,'',FPCSrcDir,da_Directory);
2478 Result.AddChild(MainDir);
2479 DefTempl:=TDefineTemplate.Create('Reset SrcPath',
2480 ctsSrcPathInitialization,ExternalMacroStart+'SrcPath','',da_DefineRecurse);
2481 MainDir.AddChild(DefTempl);
2482 DefTempl:=TDefineTemplate.Create('Reset UnitPath',
2483 ctsUnitPathInitialization,UnitPathMacroName,'',da_DefineRecurse);
2484 MainDir.AddChild(DefTempl);
2485 DefTempl:=TDefineTemplate.Create('Reset IncPath',
2486 ctsUnitPathInitialization,IncludePathMacroName,'',da_DefineRecurse);
2487 MainDir.AddChild(DefTempl);
2488
2489 // rtl
2490 RTLDir:=TDefineTemplate.Create('RTL',ctsRuntimeLibrary,'','rtl',da_Directory);
2491 MainDir.AddChild(RTLDir);
2492
2493 // rtl include paths
2494 s:=IncPathMacro
2495 +';'+Dir+'rtl'+DS+'objpas'+DS
2496 +';'+Dir+'rtl'+DS+'objpas'+DS+'sysutils'
2497 +';'+Dir+'rtl'+DS+'objpas'+DS+'classes'
2498 +';'+Dir+'rtl'+DS+'inc'+DS
2499 +';'+Dir+'rtl'+DS+'inc'+DS+'graph'+DS
2500 +';'+Dir+'rtl'+DS+SrcOS+DS
2501 +';'+Dir+'rtl'+DS+TargetOSMacro+DS
2502 +';'+Dir+'rtl'+DS+SrcOS2+DS
2503 +';'+Dir+'rtl'+DS+SrcOS2+DS+aTargetCPU
2504 +';'+Dir+'rtl'+DS+aTargetCPU+DS
2505 +';'+Dir+'rtl'+DS+TargetOSMacro+DS+aTargetCPU+DS;
2506 RTLDir.AddChild(TDefineTemplate.Create('Include Path',
2507 Format(ctsIncludeDirectoriesPlusDirs,
2508 ['objpas, inc,'+aTargetCPU+','+SrcOS]),
2509 IncludePathMacroName,s,da_DefineRecurse));
2510
2511 // if solaris or darwin or beos then define FPC_USE_LIBC
2512 IFTempl:=TDefineTemplate.Create('IF darwin or solaris or beos',
2513 'If Darwin or Solaris or Beos', '', 'defined(darwin) or defined(solaris) or defined(beos)', da_If);
2514 // then define FPC_USE_LIBC
2515 IFTempl.AddChild(TDefineTemplate.Create('define FPC_USE_LIBC',
2516 'define FPC_USE_LIBC','FPC_USE_LIBC','',da_DefineRecurse));
2517 RTLDir.AddChild(IFTempl);
2518
2519 // rtl: IF SrcOS=win then add include path rtl/TargetOS/wininc;rtl/win/wininc;rtl/win
2520 IFTempl:=TDefineTemplate.Create('If SrcOS=win','If SrcOS=win',
2521 '',''''+SrcOS+'''=''win''',da_If);
2522 IFTempl.AddChild(TDefineTemplate.Create('Include Path',
2523 Format(ctsIncludeDirectoriesPlusDirs,['wininc']),
2524 IncludePathMacroName,
2525 IncPathMacro
2526 +';'+Dir+'rtl'+DS+TargetOSMacro+DS+'wininc'
2527 +';'+Dir+'rtl'+DS+'win'+DS+'wininc'
2528 +';'+Dir+'rtl'+DS+'win',
2529 da_DefineRecurse));
2530 RTLDir.AddChild(IFTempl);
2531
2532 // rtl: IF TargetOS=iphonesim then add include path rtl/unix, rtl/bsd, rtl/darwin
2533 IFTempl:=TDefineTemplate.Create('If TargetOS=iphonesim','If TargetOS=iphonesim',
2534 '',''''+TargetOSMacro+'''=''iphonesim''',da_If);
2535 IFTempl.AddChild(TDefineTemplate.Create('Include Path',
2536 Format(ctsIncludeDirectoriesPlusDirs,['unix,bsd,darwin']),
2537 IncludePathMacroName,
2538 IncPathMacro
2539 +';'+Dir+'rtl'+DS+'unix'
2540 +';'+Dir+'rtl'+DS+'bsd'
2541 +';'+Dir+'rtl'+DS+'darwin',
2542 da_DefineRecurse));
2543 RTLDir.AddChild(IFTempl);
2544
2545 // add processor and SrcOS alias defines for the RTL
2546 AddSrcOSDefines(RTLDir);
2547
2548 // rtl/$(#TargetOS)
2549 RTLOSDir:=TDefineTemplate.Create('TargetOS','Target OS','',
2550 TargetOSMacro,da_Directory);
2551 s:=IncPathMacro
2552 +';'+Dir+'rtl'+DS+TargetOSMacro+DS+SrcOS+'inc' // e.g. rtl/win32/inc/
2553 +';'+Dir+'rtl'+DS+TargetOSMacro+DS+aTargetCPU+DS
2554 ;
2555 RTLOSDir.AddChild(TDefineTemplate.Create('Include Path',
2556 Format(ctsIncludeDirectoriesPlusDirs,[aTargetCPU]),
2557 IncludePathMacroName,
2558 s,da_DefineRecurse));
2559 s:=SrcPathMacro
2560 +';'+Dir+'rtl'+DS+'objpas'+DS;
2561 RTLOSDir.AddChild(TDefineTemplate.Create('Src Path',
2562 Format(ctsAddsDirToSourcePath,[aTargetCPU]),
2563 ExternalMacroStart+'SrcPath',s,da_DefineRecurse));
2564 RTLDir.AddChild(RTLOSDir);
2565
2566 // fcl
2567 FCLDir:=TDefineTemplate.Create('FCL',ctsFreePascalComponentLibrary,'','fcl',
2568 da_Directory);
2569 MainDir.AddChild(FCLDir);
2570 FCLDir.AddChild(TDefineTemplate.Create('Include Path',
2571 Format(ctsIncludeDirectoriesPlusDirs,['inc,'+SrcOS]),
2572 IncludePathMacroName,
2573 d( DefinePathMacro+'/inc/'
2574 +';'+DefinePathMacro+'/classes/'
2575 +';'+DefinePathMacro+'/'+TargetOSMacro+DS // TargetOS before SrcOS !
2576 +';'+DefinePathMacro+'/'+SrcOS+DS
2577 +';'+IncPathMacro)
2578 ,da_DefineRecurse));
2579
2580 // fcl/db
2581 FCLDBDir:=TDefineTemplate.Create('DB','DB','','db',da_Directory);
2582 FCLDir.AddChild(FCLDBDir);
2583 FCLDBInterbaseDir:=TDefineTemplate.Create('interbase','interbase','',
2584 'interbase',da_Directory);
2585 FCLDBDir.AddChild(FCLDBInterbaseDir);
2586 FCLDBInterbaseDir.AddChild(TDefineTemplate.Create('SrcPath',
2587 'SrcPath addition',
2588 ExternalMacroStart+'SrcPath',
2589 d(Dir+'/packages/base/ibase;'+SrcPathMacro)
2590 ,da_Define));
2591
2592 // packages
2593 PackagesDir:=TDefineTemplate.Create('Packages',ctsPackageDirectories,'',
2594 'packages',da_Directory);
2595 MainDir.AddChild(PackagesDir);
2596
2597 // packages/rtl-*
2598 for s in RTLPkgDirs do begin
2599 SubPkgDir:=TDefineTemplate.Create(s,s,'',s,da_Directory);
2600 PackagesDir.AddChild(SubPkgDir);
2601 SubPkgDir.AddChild(TDefineTemplate.Create('Include Path',
2602 Format(ctsIncludeDirectoriesPlusDirs,['inc']),
2603 IncludePathMacroName,
2604 d(DefinePathMacro+'/inc'),da_DefineRecurse));
2605 end;
2606
2607 // packages/rtl-console
2608 PackagesSubDir:=TDefineTemplate.Create('rtl-console','rtl-console','','rtl-console',da_Directory);
2609 PackagesDir.AddChild(PackagesSubDir);
2610 PackagesSubDir.AddChild(TDefineTemplate.Create('Include Path',
2611 Format(ctsIncludeDirectoriesPlusDirs,['packages/rtl-console/src/inc']),
2612 IncludePathMacroName,
2613 d(DefinePathMacro+'/src/inc;'
2614 +IncPathMacro)
2615 ,da_DefineRecurse));
2616
2617 // packages/rtl-extra
2618 PackagesSubDir:=TDefineTemplate.Create('rtl-extra','rtl-extra','','rtl-extra',da_Directory);
2619 PackagesDir.AddChild(PackagesSubDir);
2620 PackagesSubDir.AddChild(TDefineTemplate.Create('Include Path',
2621 Format(ctsIncludeDirectoriesPlusDirs,['packages/rtl-extra/src/OS']),
2622 IncludePathMacroName,
2623 d(DefinePathMacro+'/src/inc;'
2624 +DefinePathMacro+'/src/'+TargetOSMacro+';'
2625 +DefinePathMacro+'/src/'+SrcOS+';'
2626 +DefinePathMacro+'/src/'+SrcOS2+';'
2627 +IncPathMacro)
2628 ,da_DefineRecurse));
2629
2630 // packages/rtl-objpas
2631 PackagesSubDir:=TDefineTemplate.Create('rtl-objpas','rtl-objpas','','rtl-objpas',da_Directory);
2632 PackagesDir.AddChild(PackagesSubDir);
2633 PackagesSubDir.AddChild(TDefineTemplate.Create('Include Path',
2634 Format(ctsIncludeDirectoriesPlusDirs,['packages/rtl-objpas/src/inc']),
2635 IncludePathMacroName,
2636 d(DefinePathMacro+'/src/inc;'
2637 +IncPathMacro)
2638 ,da_DefineRecurse));
2639
2640 // packages/fcl-base
2641 FCLBaseDir:=TDefineTemplate.Create('FCL-base',
2642 ctsFreePascalComponentLibrary,'','fcl-base',
2643 da_Directory);
2644 PackagesDir.AddChild(FCLBaseDir);
2645 // packages/fcl-base/src
2646 FCLBaseSrcDir:=TDefineTemplate.Create('src',
2647 'src','','src',
2648 da_Directory);
2649 FCLBaseDir.AddChild(FCLBaseSrcDir);
2650 FCLBaseSrcDir.AddChild(TDefineTemplate.Create('Include Path',
2651 Format(ctsIncludeDirectoriesPlusDirs,['inc,'+SrcOS]),
2652 IncludePathMacroName,
2653 d( DefinePathMacro+'/inc/'
2654 +';'+DefinePathMacro+'/'+TargetOSMacro+DS // TargetOS before SrcOS !
2655 +';'+DefinePathMacro+'/'+SrcOS+DS
2656 +';'+IncPathMacro)
2657 ,da_DefineRecurse));
2658
2659 // packages/fcl-process
2660 FCLSubDir:=TDefineTemplate.Create('FCL-process',
2661 'fcl-process','','fcl-process',
2662 da_Directory);
2663 PackagesDir.AddChild(FCLSubDir);
2664 // packages/fcl-process/src
2665 FCLSubSrcDir:=TDefineTemplate.Create('src',
2666 'src','','src',
2667 da_Directory);
2668 FCLSubDir.AddChild(FCLSubSrcDir);
2669 FCLSubSrcDir.AddChild(TDefineTemplate.Create('Include Path',
2670 Format(ctsIncludeDirectoriesPlusDirs,['inc,'+SrcOS]),
2671 IncludePathMacroName,
2672 d( DefinePathMacro+'/'+TargetOSMacro+DS // TargetOS before SrcOS !
2673 +';'+DefinePathMacro+'/'+SrcOS+DS
2674 +';'+IncPathMacro)
2675 ,da_DefineRecurse));
2676 // packages/fcl-process/src
2677 // IF SrcOS=win then add include path winall
2678 IFTempl:=TDefineTemplate.Create('If SrcOS=win','If SrcOS=win',
2679 '',''''+SrcOS+'''=''win''',da_If);
2680 IFTempl.AddChild(TDefineTemplate.Create('Include Path',
2681 Format(ctsIncludeDirectoriesPlusDirs,['winall']),
2682 IncludePathMacroName,
2683 IncPathMacro
2684 +';winall',
2685 da_DefineRecurse));
2686 FCLSubDir.AddChild(IFTempl);
2687
2688 // packages/fcl-async
2689 PackagesFCLAsyncDir:=TDefineTemplate.Create('fcl-async','fcl-async','','fcl-async',da_Directory);
2690 PackagesDir.AddChild(PackagesFCLAsyncDir);
2691
2692 // packages/fcl-async/src
2693 PackagesFCLAsyncDir.AddChild(TDefineTemplate.Create('Include Path',
2694 Format(ctsIncludeDirectoriesPlusDirs,['packages/fcl-async/src']),
2695 IncludePathMacroName,
2696 d( DefinePathMacro+'/src/'
2697 +';'+IncPathMacro)
2698 ,da_DefineRecurse));
2699
2700 // packages/fcl-extra
2701 PackagesFCLExtraDir:=TDefineTemplate.Create('fcl-extra','fcl-extra','','fcl-extra',da_Directory);
2702 PackagesDir.AddChild(PackagesFCLExtraDir);
2703
2704 // packages/fcl-extra/src
2705 PackagesFCLExtraDir.AddChild(TDefineTemplate.Create('Include Path',
2706 Format(ctsIncludeDirectoriesPlusDirs,['packages/fcl-extra/src']),
2707 IncludePathMacroName,
2708 d( DefinePathMacro+'/src/'+SrcOS
2709 +';'+IncPathMacro)
2710 ,da_DefineRecurse));
2711
2712 // packages/extra
2713 PackagesExtraDir:=TDefineTemplate.Create('extra','extra','','extra',da_Directory);
2714 PackagesDir.AddChild(PackagesExtraDir);
2715
2716 // packages/extra/graph
2717 PkgExtraGraphDir:=TDefineTemplate.Create('graph','graph','','graph',
2718 da_Directory);
2719 PackagesExtraDir.AddChild(PkgExtraGraphDir);
2720 PkgExtraGraphDir.AddChild(TDefineTemplate.Create('Include Path',
2721 Format(ctsIncludeDirectoriesPlusDirs,['inc']),
2722 IncludePathMacroName,
2723 d( DefinePathMacro+'/inc/'
2724 +';'+IncPathMacro)
2725 ,da_DefineRecurse));
2726
2727 // packages/extra/amunits
2728 PkgExtraAMunitsDir:=TDefineTemplate.Create('amunits','amunits','','amunits',
2729 da_Directory);
2730 PackagesExtraDir.AddChild(PkgExtraAMunitsDir);
2731 PkgExtraAMunitsDir.AddChild(TDefineTemplate.Create('Include Path',
2732 Format(ctsIncludeDirectoriesPlusDirs,['inc']),
2733 IncludePathMacroName,
2734 d( DefinePathMacro+'/inc/'
2735 +';'+IncPathMacro)
2736 ,da_DefineRecurse));
2737
2738 // packages/graph
2739 PackagesSubDir:=TDefineTemplate.Create('graph','graph','','graph',da_Directory);
2740 PackagesDir.AddChild(PackagesSubDir);
2741 PackagesSubDir.AddChild(TDefineTemplate.Create('Include Path',
2742 Format(ctsIncludeDirectoriesPlusDirs,['packages/graph/src/inc']),
2743 IncludePathMacroName,
2744 d(DefinePathMacro+'/src/inc;'
2745 +IncPathMacro)
2746 ,da_DefineRecurse));
2747
2748 // utils
2749 UtilsDir:=TDefineTemplate.Create('Utils',ctsUtilsDirectories,'',
2750 'utils',da_Directory);
2751 MainDir.AddChild(UtilsDir);
2752
2753 // utils/debugsvr
2754 DebugSvrDir:=TDefineTemplate.Create('DebugSvr','Debug Server','',
2755 'debugsvr',da_Directory);
2756 UtilsDir.AddChild(DebugSvrDir);
2757 DebugSvrDir.AddChild(TDefineTemplate.Create('Interface Path',
2758 Format(ctsAddsDirToSourcePath,['..']),ExternalMacroStart+'SrcPath',
2759 '..;'+ExternalMacroStart+'SrcPath',da_DefineRecurse));
2760
2761 // installer
2762 InstallerDir:=TDefineTemplate.Create('Installer',ctsInstallerDirectories,'',
2763 'installer',da_Directory);
2764 InstallerDir.AddChild(TDefineTemplate.Create('SrcPath','SrcPath addition',
2765 ExternalMacroStart+'SrcPath',
2766 SrcPathMacro+';'+Dir+'ide;'+Dir+'fv',da_Define));
2767 MainDir.AddChild(InstallerDir);
2768
2769 // compiler
2770 CompilerDir:=TDefineTemplate.Create('Compiler',ctsCompiler,'','compiler',
2771 da_Directory);
2772 CompilerDir.AddChild(TDefineTemplate.Create('SrcPath','SrcPath addition',
2773 ExternalMacroStart+'SrcPath',
2774 SrcPathMacro+';'+Dir+aTargetCPU,da_Define));
2775 CompilerDir.AddChild(TDefineTemplate.Create('IncPath','IncPath addition',
2776 IncludePathMacroName,
2777 IncPathMacro+';'+Dir+'compiler',da_DefineRecurse));
2778 MainDir.AddChild(CompilerDir);
2779
2780 // compiler/utils
2781 UtilsDir:=TDefineTemplate.Create('utils',ctsUtilsDirectories,'',
2782 'utils',da_Directory);
2783 UtilsDir.AddChild(TDefineTemplate.Create('SrcPath','SrcPath addition',
2784 ExternalMacroStart+'SrcPath',
2785 SrcPathMacro+';..',da_Define));
2786 CompilerDir.AddChild(UtilsDir);
2787
2788 Result.SetDefineOwner(Owner,true);
2789 Result.SetFlags([dtfAutoGenerated],[],false);
2790
2791 Ok:=true;
2792 finally
2793 if not ok then
2794 FreeAndNil(Result);
2795 end;
2796 end;
2797
CreateFPCSourceTemplatenull2798 function CreateFPCSourceTemplate(Config: TFPCUnitSetCache; Owner: TObject
2799 ): TDefineTemplate;
2800 begin
2801 Result:=CreateFPCSourceTemplate(Config.FPCSourceDirectory,Owner);
2802 end;
2803
2804 procedure CheckPPUSources(PPUFiles, UnitToSource,
2805 UnitToDuplicates: TStringToStringTree;
2806 var Duplicates, Missing: TStringToStringTree);
2807 var
2808 Node: TAVLTreeNode;
2809 Item: PStringToStringItem;
2810 Unit_Name: String;
2811 Filename: String;
2812 SrcFilename: string;
2813 DuplicateFilenames: string;
2814 begin
2815 if PPUFiles.CaseSensitive then
2816 raise Exception.Create('CheckPPUSources PPUFiles is case sensitive');
2817 if UnitToSource.CaseSensitive then
2818 raise Exception.Create('CheckPPUSources UnitToSource is case sensitive');
2819 if UnitToDuplicates.CaseSensitive then
2820 raise Exception.Create('CheckPPUSources UnitToDuplicates is case sensitive');
2821 if (Duplicates<>nil) and Duplicates.CaseSensitive then
2822 raise Exception.Create('CheckPPUSources Duplicates is case sensitive');
2823 if (Missing<>nil) and Missing.CaseSensitive then
2824 raise Exception.Create('CheckPPUSources Missing is case sensitive');
2825 Node:=PPUFiles.Tree.FindLowest;
2826 while Node<>nil do begin
2827 Item:=PStringToStringItem(Node.Data);
2828 Unit_Name:=Item^.Name;
2829 Filename:=Item^.Value;
2830 if CompareFileExt(Filename,'.ppu',false)=0 then begin
2831 SrcFilename:=UnitToSource[Unit_Name];
2832 if SrcFilename<>'' then begin
2833 DuplicateFilenames:=UnitToDuplicates[Unit_Name];
2834 if (DuplicateFilenames<>'') and (Duplicates<>nil) then
2835 Duplicates[Unit_Name]:=DuplicateFilenames;
2836 end else begin
2837 if Missing<>nil then
2838 Missing[Unit_Name]:=Filename;
2839 end;
2840 end;
2841 Node:=PPUFiles.Tree.FindSuccessor(Node);
2842 end;
2843 end;
2844
2845 procedure LoadFPCCacheFromFile(Filename: string;
2846 var Configs: TPCTargetConfigCaches; var Sources: TFPCSourceCaches);
2847 var
2848 XMLConfig: TXMLConfig;
2849 begin
2850 if Configs=nil then Configs:=TPCTargetConfigCaches.Create(nil);
2851 if Sources=nil then Sources:=TFPCSourceCaches.Create(nil);
2852 if not FileExistsUTF8(Filename) then exit;
2853 XMLConfig:=TXMLConfig.Create(Filename);
2854 try
2855 Configs.LoadFromXMLConfig(XMLConfig,'FPCConfigs/');
2856 Sources.LoadFromXMLConfig(XMLConfig,'FPCSourceDirectories/');
2857 finally
2858 XMLConfig.Free;
2859 end;
2860 end;
2861
2862 procedure SaveFPCCacheToFile(Filename: string; Configs: TPCTargetConfigCaches;
2863 Sources: TFPCSourceCaches);
2864 var
2865 XMLConfig: TXMLConfig;
2866 begin
2867 XMLConfig:=TXMLConfig.CreateClean(Filename);
2868 try
2869 Configs.SaveToXMLConfig(XMLConfig,'FPCConfigs/');
2870 Sources.SaveToXMLConfig(XMLConfig,'FPCSourceDirectories/');
2871 finally
2872 XMLConfig.Free;
2873 end;
2874 end;
2875
2876 { TFPCParamValue }
2877
2878 constructor TFPCParamValue.Create(const aName, aValue: string;
2879 aKind: TFPCParamKind; aFlags: TFPCParamFlags);
2880 begin
2881 Name:=aName;
2882 Value:=aValue;
2883 Kind:=aKind;
2884 Flags:=aFlags;
2885 end;
2886
2887 procedure ParseFPCParameters(const CmdLineParams: string;
2888 Params: TObjectList; ReadBackslash: boolean);
2889 var
2890 ParamList: TStringList;
2891 begin
2892 ParamList:=TStringList.Create;
2893 try
2894 SplitCmdLineParams(CmdLineParams,ParamList,ReadBackslash);
2895 ParseFPCParameters(ParamList,Params);
2896 finally
2897 ParamList.Free;
2898 end;
2899 end;
2900
2901 procedure ParseFPCParameters(CmdLineParams: TStrings;
2902 ParsedParams: TObjectList);
2903 var
2904 i: Integer;
2905 begin
2906 if (CmdLineParams=nil) or (CmdLineParams.Count=0) or (ParsedParams=nil) then exit;
2907 for i:=0 to CmdLineParams.Count-1 do
2908 ParseFPCParameter(CmdLineParams[i],ParsedParams);
2909 end;
2910
2911 procedure ParseFPCParameter(const CmdLineParam: string;
2912 ParsedParams: TObjectList);
2913 { $DEFINE VerboseParseFPCParameter}
2914 const
2915 AlphaNum = ['a'..'z','A'..'Z','0'..'9'];
2916
2917 procedure Add(aName, aValue: string; aKind: TFPCParamKind; aFlags: TFPCParamFlags = []);
2918 var
2919 i: Integer;
2920 Param: TFPCParamValue;
2921 begin
2922 {$IFDEF VerboseParseFPCParameter}
2923 debugln(['ParseFPCParameter.Add Name="',aName,'" Value="',aValue,'" Kind=',dbgs(aKind),' Flags=',dbgs(aFlags)]);
2924 {$ENDIF}
2925 if (aName='O1') or (aName='O2') or (aName='O3') or (aName='O4') then begin
2926 aValue:=aName[2];
2927 aName:='O';
2928 aKind:=fpkValue;
2929 end;
2930
2931 if (aKind in [fpkBoolean,fpkValue,fpkDefine]) then
2932 // check for duplicates
2933 for i:=0 to ParsedParams.Count-1 do begin
2934 Param:=TFPCParamValue(ParsedParams[i]);
2935 if aKind=fpkDefine then begin
2936 if CompareText(Param.Name,aName)<>0 then continue;
2937 end else begin
2938 if (Param.Name<>aName) then continue;
2939 end;
2940 if (aKind=fpkDefine) <> (Param.Kind=fpkDefine) then continue;
2941 // was already set
2942 Include(Param.Flags,fpfSetTwice);
2943 if (aValue<>Param.Value) or ((fpfUnset in aFlags)<>(fpfUnset in Param.Flags))
2944 or (aKind<>Param.Kind) then
2945 Include(Param.Flags,fpfValueChanged);
2946 Param.Kind:=aKind;
2947 Param.Value:=aValue;
2948 if fpfUnset in aFlags then
2949 Include(Param.Flags,fpfUnset)
2950 else
2951 Exclude(Param.Flags,fpfUnset);
2952 exit;
2953 end;
2954 ParsedParams.Add(TFPCParamValue.Create(aName, aValue, aKind, aFlags));
2955
2956 // alias
2957 if aName='S2' then
2958 Add('M','objfpc',fpkValue,aFlags)
2959 else if aName='Sd' then
2960 Add('M','delphi',fpkValue,aFlags)
2961 else if aName='So' then
2962 Add('M','tp',fpkValue,aFlags)
2963 else if aName='?' then
2964 Add('h',aValue,aKind,aFlags);
2965 end;
2966
2967 procedure AddBooleanFlag(var p: PChar; Len: integer; Prefix: string = '');
2968 var
2969 aName: string;
2970 PrefixLen: Integer;
2971 begin
2972 PrefixLen:=length(Prefix);
2973 SetLength(aName,PrefixLen+Len);
2974 if PrefixLen>0 then
2975 Move(Prefix[1],aName[1],PrefixLen);
2976 if Len>0 then
2977 Move(p^,aName[PrefixLen+1],Len);
2978 {$IFDEF VerboseParseFPCParameter}
2979 debugln(['ParseFPCParameter.AddBooleanFlag p="',p,'" Len=',Len,' Prefix="',Prefix,'" Name="'+aName+'"']);
2980 {$ENDIF}
2981 inc(p,Len);
2982 if p^='-' then begin
2983 Add(aName,'',fpkBoolean,[fpfUnset]);
2984 inc(p);
2985 end else begin
2986 Add(aName,FPCParamEnabled,fpkBoolean);
2987 if p^='+' then
2988 inc(p);
2989 end;
2990 end;
2991
2992 procedure ReadSequence(p: PChar;
2993 const Specials: string = '');
2994 // e.g. -Ci-n+o p points to the 'C'
2995 // Specials is a space separated list of params:
2996 // SO : a two letter option 'SO'
2997 // h: : a one letter option 'h' followed by a value
2998 // ma& : a two letter option 'ma' followed by a multi value
2999 // T* : a boolean option starting with T, e.g. Tcld
3000 // P= : a one letter option 'P' followed by a name=value pair
3001 var
3002 Option, c: Char;
3003 Opt, Opt2, p2: PChar;
3004 aName: string;
3005 begin
3006 if not (p[1] in AlphaNum) then begin
3007 AddBooleanFlag(p,1,'');
3008 exit;
3009 end;
3010 Option:=p^;
3011 inc(p);
3012 repeat
3013 c:=p^;
3014 if not (c in AlphaNum) then
3015 break; // invalid option
3016 if (p[1]<>#0) and (Specials<>'') then begin
3017 Opt:=PChar(Specials);
3018 while Opt^<>#0 do begin
3019 while Opt^=' ' do inc(Opt);
3020 p2:=p;
3021 Opt2:=Opt;
3022 while (Opt2^ in AlphaNum) and (p2^=Opt2^) do begin
3023 inc(p2);
3024 inc(Opt2);
3025 end;
3026 case Opt2^ of
3027 ' ',#0: // boolean option
3028 begin
3029 AddBooleanFlag(p,Opt2-Opt,Option);
3030 break;
3031 end;
3032 ':': // option followed by value
3033 begin
3034 Add(Option+copy(Specials,Opt-PChar(Specials)+1,Opt2-Opt),p2,fpkValue);
3035 exit;
3036 end;
3037 '&': // option followed by multi value
3038 begin
3039 Add(Option+copy(Specials,Opt-PChar(Specials)+1,Opt2-Opt),p2,fpkMultiValue);
3040 exit;
3041 end;
3042 '*': // boolean option with arbitrary name
3043 begin
3044 while p2^ in AlphaNum do inc(p2);
3045 AddBooleanFlag(p,p2-p,Option);
3046 break;
3047 end;
3048 '=': // name=value
3049 begin
3050 if not (p2^ in AlphaNum) then exit; // invalid option
3051 while p2^ in AlphaNum do inc(p2);
3052 if (p2^<>'=') then exit; // invalid option
3053 SetLength(aName,p2-p);
3054 Move(p^,aName[1],p2-p);
3055 inc(p2);
3056 Add(Option+aName,p2,fpkValue);
3057 exit;
3058 end
3059 else
3060 // mismatch -> try next special option
3061 Opt:=Opt2;
3062 while not (Opt^ in [#0,' ']) do inc(Opt);
3063 end;
3064 end;
3065 if Opt^<>#0 then continue;
3066 end;
3067 // default: single char flag
3068 AddBooleanFlag(p,1,Option);
3069 until false;
3070 end;
3071
3072 procedure DisableAllFlags(const Prefix: string);
3073 var
3074 i: Integer;
3075 Param: TFPCParamValue;
3076 begin
3077 for i:=0 to ParsedParams.Count-1 do begin
3078 Param:=TFPCParamValue(ParsedParams[i]);
3079 if not (Param.Kind in [fpkBoolean,fpkValue,fpkMultiValue]) then continue;
3080 if LeftStr(Param.Name,length(Prefix))<>Prefix then continue;
3081 Include(Param.Flags,fpfSetTwice);
3082 if not (fpfUnset in Param.Flags) then
3083 Include(Param.Flags,fpfValueChanged);
3084 Param.Value:='';
3085 Include(Param.Flags,fpfUnset);
3086 end;
3087 end;
3088
3089 var
3090 p, p2: PChar;
3091 begin
3092 {$IFDEF VerboseParseFPCParameter}
3093 debugln(['ParseFPCParameter "',CmdLineParam,'"']);
3094 {$ENDIF}
3095 if CmdLineParam='' then exit;
3096 p:=PChar(CmdLineParam);
3097 case p^ of
3098 '-': // option
3099 begin
3100 inc(p);
3101 case p^ of
3102 'a': ReadSequence(p);
3103 'C': ReadSequence(p,'a: c: f: F: h: p: P= s: T*');
3104 'd': Add(copy(CmdLineParam,3,255),'',fpkDefine);
3105 'D':
3106 begin
3107 inc(p);
3108 case p^ of
3109 'd','v': Add('D'+p^,PChar(@p[1]),fpkValue);
3110 else
3111 AddBooleanFlag(p,1,'D');
3112 end;
3113 end;
3114 'e': Add('e',PChar(@p[1]),fpkValue);
3115 'F':
3116 case p[1] of
3117 'a','f','i','l','N','o','u': Add('F'+p[1],PChar(@p[2]),fpkMultiValue);
3118 'c','C','D','e','E','L','m','M','r','R','U','W','w': Add('F'+p[1],PChar(@p[2]),fpkValue);
3119 else AddBooleanFlag(p,2);
3120 end;
3121 'g':
3122 if p[1] in [#0,'+'] then begin
3123 Add('g',FPCParamEnabled,fpkBoolean,[]);
3124 end else if p[1]='-' then begin
3125 DisableAllFlags('g');
3126 Add('g','',fpkBoolean,[fpfUnset]);
3127 end else begin
3128 inc(p);
3129 repeat
3130 case p^ of
3131 'o':
3132 begin
3133 Add('g'+p,FPCParamEnabled,fpkBoolean,[]);
3134 exit;
3135 end;
3136 'w':
3137 case p[1] of
3138 '2'..'9':
3139 begin
3140 Add('gw',p[1],fpkValue);
3141 inc(p,2);
3142 end;
3143 else
3144 Add('gw','2',fpkValue);
3145 inc(p);
3146 end;
3147 'a'..'n','p'..'v','A'..'Z','0'..'9':
3148 AddBooleanFlag(p,1,'g');
3149 else
3150 break;
3151 end;
3152 until false;
3153 end;
3154 'i': ReadSequence(p,'SO SP TO TP');
3155 'I': Add(p^,PChar(@p[1]),fpkMultiValue);
3156 'k': Add(p^,PChar(@p[1]),fpkMultiValue);
3157 'M': Add(p^,PChar(@p[1]),fpkValue);
3158 'N':
3159 case p[1] of
3160 'S': Add('NS',PChar(@p[2]),fpkMultiValue); // -NS namespaces
3161 end;
3162 'o': Add(p^,PChar(@p[1]),fpkValue);
3163 'O':
3164 case p[1] of
3165 '-': DisableAllFlags('O');
3166 else
3167 ReadSequence(p,'a= o* p: W: w:');
3168 end;
3169 'P': ; // ToDo
3170 'R': Add(p^,PChar(@p[1]),fpkValue);
3171 'S': ReadSequence(p,'e: I:');
3172 's': ReadSequence(p);
3173 'T': Add(p^,PChar(@p[1]),fpkValue);
3174 'u': Add(copy(CmdLineParam,3,255),'',fpkDefine,[fpfUnset]);
3175 'U': ReadSequence(p);
3176 'v': ReadSequence(p,'m&');
3177 'V': Add(p^,PChar(@p[1]),fpkValue);
3178 'W': ReadSequence(p,'B: M: P:');
3179 'X': ReadSequence(p,'LA LO LD M: P: r: R:');
3180 else
3181 p2:=p;
3182 while p2^ in AlphaNum do inc(p2);
3183 AddBooleanFlag(p,p2-p);
3184 end;
3185 end;
3186 '@': // config
3187 Add('',PChar(@p[1]),fpkConfig);
3188 else
3189 // filename
3190 Add('',p,fpkNonOption);
3191 end;
3192 end;
3193
IndexOfFPCParamValuenull3194 function IndexOfFPCParamValue(ParsedParams: TObjectList; const Name: string
3195 ): integer;
3196 begin
3197 if ParsedParams=nil then exit(-1);
3198 for Result:=0 to ParsedParams.Count-1 do
3199 if TFPCParamValue(ParsedParams[Result]).Name=Name then exit;
3200 Result:=-1;
3201 end;
3202
GetFPCParamValuenull3203 function GetFPCParamValue(ParsedParams: TObjectList; const Name: string
3204 ): TFPCParamValue;
3205 var
3206 i: Integer;
3207 begin
3208 i:=IndexOfFPCParamValue(ParsedParams,Name);
3209 if i<0 then
3210 Result:=nil
3211 else
3212 Result:=TFPCParamValue(ParsedParams[i]);
3213 end;
3214
dbgsnull3215 function dbgs(k: TFPCParamKind): string;
3216 begin
3217 str(k,Result);
3218 end;
3219
dbgsnull3220 function dbgs(f: TFPCParamFlag): string;
3221 begin
3222 str(f,Result);
3223 end;
3224
dbgsnull3225 function dbgs(const Flags: TFPCParamFlags): string;
3226 var
3227 f: TFPCParamFlag;
3228 begin
3229 Result:='';
3230 for f in TFPCParamFlag do
3231 if f in Flags then begin
3232 if Result<>'' then Result+=',';
3233 Result+=dbgs(f);
3234 end;
3235 Result:='['+Result+']';
3236 end;
3237
ExtractFPCFrontEndParametersnull3238 function ExtractFPCFrontEndParameters(const CmdLineParams: string;
3239 const Kinds: TFPCFrontEndParams): string;
3240 // extract the parameters for the FPC frontend tool fpc.exe
3241 // The result is normalized:
3242 // - only the last value
3243 // - order is: -T -P -V -Xp
3244
3245 procedure Add(const Name, Value: string);
3246 begin
3247 if Value='' then exit;
3248 if Result<>'' then Result+=' ';
3249 Result+='-'+Name+StrToCmdLineParam(Value);
3250 end;
3251
3252 var
3253 Position: Integer;
3254 Param, ParamT, ParamP, ParamV, ParamXp: String;
3255 StartPos: integer;
3256 p: PChar;
3257 begin
3258 Result:='';
3259 ParamT:='';
3260 ParamP:='';
3261 ParamV:='';
3262 ParamXp:='';
3263 Position:=1;
3264 while ReadNextFPCParameter(CmdLineParams,Position,StartPos) do begin
3265 Param:=ExtractFPCParameter(CmdLineParams,StartPos);
3266 if Param='' then continue;
3267 p:=PChar(Param);
3268 if p^<>'-' then continue;
3269 case p[1] of
3270 'T': if fpcpT in Kinds then ParamT:=copy(Param,3,255);
3271 'P': if fpcpP in Kinds then ParamP:=copy(Param,3,255);
3272 'V': if fpcpV in Kinds then ParamV:=copy(Param,3,length(Param));
3273 'X':
3274 case p[2] of
3275 'p': if fpcpXp in Kinds then ParamXp:=copy(Param,4,length(Param));
3276 end;
3277 end;
3278 end;
3279 // add parameters
3280 Add('Xp',ParamXp);
3281 Add('T',ParamT);
3282 Add('P',ParamP);
3283 Add('V',ParamV);
3284 end;
3285
3286 procedure ReadMakefileFPC(const Filename: string; List: TStrings);
3287 var
3288 MakefileFPC: TStringListUTF8;
3289 i: Integer;
3290 Line: string;
3291 p: LongInt;
3292 NameValue: String;
3293 begin
3294 MakefileFPC:=TStringListUTF8.Create;
3295 MakefileFPC.LoadFromFile(Filename);
3296 i:=0;
3297 while i<MakefileFPC.Count do begin
3298 Line:=MakefileFPC[i];
3299 if Line='' then begin
3300 end else if (Line[1]='[') then begin
3301 // start of section
3302 p:=System.Pos(']',Line);
3303 if p<1 then p:=length(Line);
3304 List.Add(Line);
3305 end else if (Line[1] in ['a'..'z','A'..'Z','0'..'9','_']) then begin
3306 // start of name=value pair
3307 NameValue:=Line;
3308 repeat
3309 p:=length(NameValue);
3310 while (p>=1) and (NameValue[p] in [' ',#9]) do dec(p);
3311 //List.Add(' NameValue="'+NameValue+'" p='+IntToStr(p)+' "'+NameValue[p]+'"');
3312 if (p>=1) and (NameValue[p]='\')
3313 and ((p=1) or (NameValue[p-1]<>'\')) then begin
3314 // append next line
3315 NameValue:=copy(NameValue,1,p-1);
3316 inc(i);
3317 if i>=MakefileFPC.Count then break;
3318 NameValue:=NameValue+MakefileFPC[i];
3319 end else break;
3320 until false;
3321 List.Add(NameValue);
3322 end;
3323 inc(i);
3324 end;
3325 MakefileFPC.Free;
3326 end;
3327
3328 procedure ParseMakefileFPC(const Filename, SrcOS: string;
3329 out Dirs, SubDirs: string);
3330
MakeSearchPathnull3331 function MakeSearchPath(const s: string): string;
3332 var
3333 SrcPos: Integer;
3334 DestPos: Integer;
3335 begin
3336 // check how much space is needed
3337 SrcPos:=1;
3338 DestPos:=0;
3339 while (SrcPos<=length(s)) do begin
3340 if s[SrcPos] in [#0..#31] then begin
3341 // space is a delimiter
3342 inc(SrcPos);
3343 // skip multiple spaces
3344 while (SrcPos<=length(s)) and (s[SrcPos] in [#0..#31]) do inc(SrcPos);
3345 if (DestPos>0) and (SrcPos<=length(s)) then begin
3346 inc(DestPos);// add semicolon
3347 end;
3348 end else begin
3349 inc(DestPos);
3350 inc(SrcPos);
3351 end;
3352 end;
3353
3354 // allocate space
3355 SetLength(Result,DestPos);
3356
3357 // create semicolon delimited search path
3358 SrcPos:=1;
3359 DestPos:=0;
3360 while (SrcPos<=length(s)) do begin
3361 if s[SrcPos] in [#0..#32] then begin
3362 // space is a delimiter
3363 inc(SrcPos);
3364 // skip multiple spaces
3365 while (SrcPos<=length(s)) and (s[SrcPos] in [#0..#32]) do inc(SrcPos);
3366 if (DestPos>0) and (SrcPos<=length(s)) then begin
3367 inc(DestPos);// add semicolon
3368 Result[DestPos]:=';';
3369 end;
3370 end else begin
3371 inc(DestPos);
3372 Result[DestPos]:=s[SrcPos];
3373 inc(SrcPos);
3374 end;
3375 end;
3376 end;
3377
3378 var
3379 Params: TStringList;
3380 i: Integer;
3381 Line: string;
3382 p: LongInt;
3383 Name: String;
3384 SubDirsName: String;
3385 begin
3386 SubDirs:='';
3387 Dirs:='';
3388 Params:=TStringList.Create;
3389 try
3390 ReadMakefileFPC(Filename,Params);
3391
3392 SubDirsName:='';
3393 if SrcOS<>'' then
3394 SubDirsName:='dirs_'+SrcOS;
3395
3396 for i:=0 to Params.Count-1 do begin
3397 Line:=Params[i];
3398 if Line='' then continue;
3399 if (Line[1] in ['a'..'z','A'..'Z','0'..'9','_']) then begin
3400 p:=System.Pos('=',Line);
3401 if p<1 then continue;
3402 Name:=copy(Line,1,p-1);
3403 if Name=SubDirsName then begin
3404 SubDirs:=MakeSearchPath(copy(Line,p+1,length(Line)));
3405 end else if Name='dirs' then begin
3406 Dirs:=MakeSearchPath(copy(Line,p+1,length(Line)));
3407 end;
3408 end;
3409 end;
3410 except
3411 on e: Exception do begin
3412 debugln('Error: [ParseMakefileFPC] Filename=',Filename,': ',E.Message);
3413 end;
3414 end;
3415 Params.Free;
3416 end;
3417
CompareFPCSourceRulesViaFilenamenull3418 function CompareFPCSourceRulesViaFilename(Rule1, Rule2: Pointer): integer;
3419 var
3420 SrcRule1: TFPCSourceRule absolute Rule1;
3421 SrcRule2: TFPCSourceRule absolute Rule2;
3422 begin
3423 Result:=CompareFilenames(SrcRule1.Filename,SrcRule2.Filename);
3424 end;
3425
CompareFPCTargetConfigCacheItemsnull3426 function CompareFPCTargetConfigCacheItems(CacheItem1, CacheItem2: Pointer): integer;
3427 var
3428 Item1: TPCTargetConfigCache absolute CacheItem1;
3429 Item2: TPCTargetConfigCache absolute CacheItem2;
3430 begin
3431 Result:=CompareStr(Item1.TargetOS,Item2.TargetOS);
3432 if Result<>0 then exit;
3433 Result:=CompareStr(Item1.TargetCPU,Item2.TargetCPU);
3434 if Result<>0 then exit;
3435 Result:=CompareFilenames(Item1.Compiler,Item2.Compiler);
3436 if Result<>0 then exit;
3437 Result:=CompareFilenames(Item1.CompilerOptions,Item2.CompilerOptions);
3438 end;
3439
CompareFPCSourceCacheItemsnull3440 function CompareFPCSourceCacheItems(CacheItem1, CacheItem2: Pointer): integer;
3441 var
3442 Src1: TFPCSourceCache absolute CacheItem1;
3443 Src2: TFPCSourceCache absolute CacheItem2;
3444 begin
3445 Result:=CompareFilenames(Src1.Directory,Src2.Directory);
3446 end;
3447
CompareDirectoryWithFPCSourceCacheItemnull3448 function CompareDirectoryWithFPCSourceCacheItem(AString, CacheItem: Pointer
3449 ): integer;
3450 var
3451 Src: TFPCSourceCache absolute CacheItem;
3452 begin
3453 Result:=CompareFilenames(AnsiString(AString),Src.Directory);
3454 end;
3455
DefineActionNameToActionnull3456 function DefineActionNameToAction(const s: string): TDefineAction;
3457 begin
3458 for Result:=Low(TDefineAction) to High(TDefineAction) do
3459 if CompareText(s,DefineActionNames[Result])=0 then exit;
3460 Result:=da_None;
3461 end;
3462
DefineTemplateFlagsToStringnull3463 function DefineTemplateFlagsToString(Flags: TDefineTemplateFlags): string;
3464 var f: TDefineTemplateFlag;
3465 begin
3466 Result:='';
3467 for f:=Low(TDefineTemplateFlag) to High(TDefineTemplateFlag) do begin
3468 if f in Flags then begin
3469 if Result<>'' then Result:=Result+',';
3470 Result:=Result+DefineTemplateFlagNames[f];
3471 end;
3472 end;
3473 end;
3474
CompareUnitLinkNodesnull3475 function CompareUnitLinkNodes(NodeData1, NodeData2: pointer): integer;
3476 var Link1, Link2: TUnitNameLink;
3477 begin
3478 Link1:=TUnitNameLink(NodeData1);
3479 Link2:=TUnitNameLink(NodeData2);
3480 Result:=CompareText(Link1.Unit_Name,Link2.Unit_Name);
3481 end;
3482
CompareUnitNameWithUnitLinkNodenull3483 function CompareUnitNameWithUnitLinkNode(AUnitName: Pointer;
3484 NodeData: pointer): integer;
3485 begin
3486 Result:=CompareText(String(AUnitName),TUnitNameLink(NodeData).Unit_Name);
3487 end;
3488
CompareDirectoryDefinesnull3489 function CompareDirectoryDefines(NodeData1, NodeData2: pointer): integer;
3490 var DirDef1, DirDef2: TDirectoryDefines;
3491 begin
3492 DirDef1:=TDirectoryDefines(NodeData1);
3493 DirDef2:=TDirectoryDefines(NodeData2);
3494 Result:=CompareFilenames(DirDef1.Path,DirDef2.Path);
3495 end;
3496
GetDefaultSrcOSForTargetOSnull3497 function GetDefaultSrcOSForTargetOS(const TargetOS: string): string;
3498 begin
3499 Result:='';
3500 if (CompareText(TargetOS,'linux')=0)
3501 or (CompareText(TargetOS,'freebsd')=0)
3502 or (CompareText(TargetOS,'netbsd')=0)
3503 or (CompareText(TargetOS,'openbsd')=0)
3504 or (CompareText(TargetOS,'darwin')=0)
3505 or (CompareText(TargetOS,'solaris')=0)
3506 or (CompareText(TargetOS,'haiku')=0)
3507 or (CompareText(TargetOS,'android')=0)
3508 then
3509 Result:='unix'
3510 else
3511 if (CompareText(TargetOS,'win32')=0)
3512 or (CompareText(TargetOS,'win64')=0)
3513 or (CompareText(TargetOS,'wince')=0)
3514 then
3515 Result:='win';
3516 end;
3517
GetDefaultSrcOS2ForTargetOSnull3518 function GetDefaultSrcOS2ForTargetOS(const TargetOS: string): string;
3519 begin
3520 Result:='';
3521 if (CompareText(TargetOS,'freebsd')=0)
3522 or (CompareText(TargetOS,'netbsd')=0)
3523 or (CompareText(TargetOS,'openbsd')=0)
3524 or (CompareText(TargetOS,'darwin')=0)
3525 then
3526 Result:='bsd'
3527 else if (CompareText(TargetOS,'android')=0) then
3528 Result:='linux';
3529 end;
3530
GetDefaultSrcCPUForTargetCPUnull3531 function GetDefaultSrcCPUForTargetCPU(const TargetCPU: string): string;
3532 begin
3533 Result:='';
3534 if (CompareText(TargetCPU,'i386')=0)
3535 or (CompareText(TargetCPU,'x86_64')=0)
3536 then
3537 Result:='x86';
3538 end;
3539
3540 procedure SplitLazarusCPUOSWidgetCombo(const Combination: string;
3541 out CPU, OS, WidgetSet: string);
3542 var
3543 StartPos, EndPos: integer;
3544 begin
3545 StartPos:=1;
3546 EndPos:=StartPos;
3547 while (EndPos<=length(Combination)) and (Combination[EndPos]<>'-') do
3548 inc(EndPos);
3549 CPU:=copy(Combination,StartPos,EndPos-StartPos);
3550 StartPos:=EndPos+1;
3551 EndPos:=StartPos;
3552 while (EndPos<=length(Combination)) and (Combination[EndPos]<>'-') do
3553 inc(EndPos);
3554 OS:=copy(Combination,StartPos,EndPos-StartPos);
3555 StartPos:=EndPos+1;
3556 EndPos:=StartPos;
3557 while (EndPos<=length(Combination)) and (Combination[EndPos]<>'-') do
3558 inc(EndPos);
3559 WidgetSet:=copy(Combination,StartPos,EndPos-StartPos);
3560 end;
3561
GetCompiledFPCVersionnull3562 function GetCompiledFPCVersion: integer;
3563 begin
3564 Result:=FPCVersionToNumber({$I %FPCVERSION%});
3565 end;
3566
GetCompiledTargetOSnull3567 function GetCompiledTargetOS: string;
3568 begin
3569 Result:=lowerCase({$I %FPCTARGETOS%});
3570 end;
3571
GetCompiledTargetCPUnull3572 function GetCompiledTargetCPU: string;
3573 begin
3574 Result:=lowerCase({$I %FPCTARGETCPU%});
3575 end;
3576
GetDefaultCompilerFilenamenull3577 function GetDefaultCompilerFilename(const TargetCPU: string;
3578 Cross: boolean): string;
3579 begin
3580 if Cross then
3581 {$ifdef darwin}
3582 Result:='ppc' // the mach-o format supports "fat" binaries whereby
3583 // a single executable contains machine code for several architectures
3584 {$else}
3585 Result:='ppcross'
3586 {$endif}
3587 else
3588 Result:='ppc';
3589 if TargetCPU='' then
3590 Result:='fpc'
3591 else if SysUtils.CompareText(TargetCPU,'i386')=0 then
3592 Result:=Result+'386'
3593 else if SysUtils.CompareText(TargetCPU,'m68k')=0 then
3594 Result:=Result+'86k'
3595 else if SysUtils.CompareText(TargetCPU,'alpha')=0 then
3596 Result:=Result+'apx'
3597 else if SysUtils.CompareText(TargetCPU,'powerpc')=0 then
3598 Result:=Result+'ppc'
3599 else if SysUtils.CompareText(TargetCPU,'powerpc64')=0 then
3600 Result:=Result+'ppc64'
3601 else if SysUtils.CompareText(TargetCPU,'arm')=0 then
3602 Result:=Result+'arm'
3603 else if SysUtils.CompareText(TargetCPU,'avr')=0 then
3604 Result:=Result+'avr'
3605 else if SysUtils.CompareText(TargetCPU,'sparc')=0 then
3606 Result:=Result+'sparc'
3607 else if SysUtils.CompareText(TargetCPU,'x86_64')=0 then
3608 Result:=Result+'x64'
3609 else if SysUtils.CompareText(TargetCPU,'ia64')=0 then
3610 Result:=Result+'ia64'
3611 else if SysUtils.CompareText(TargetCPU,'aarch64')=0 then
3612 Result:=Result+'aarch64'
3613 else
3614 Result:='fpc';
3615 Result:=Result+ExeExt;
3616 end;
3617
3618 procedure GetTargetProcessors(const TargetCPU: string; aList: TStrings);
3619
3620 procedure Arm;
3621 begin
3622 aList.Add('ARMV3');
3623 aList.Add('ARMV4');
3624 aList.Add('ARMV4T');
3625 aList.Add('ARMV5');
3626 aList.Add('ARMV5T');
3627 aList.Add('ARMV5TE');
3628 aList.Add('ARMV5TEJ');
3629 aList.Add('ARMV6');
3630 aList.Add('ARMV6K');
3631 aList.Add('ARMV6T2');
3632 aList.Add('ARMV6Z');
3633 aList.Add('ARMV6M');
3634 aList.Add('ARMV7');
3635 aList.Add('ARMV7A');
3636 aList.Add('ARMV7R');
3637 aList.Add('ARMV7M');
3638 aList.Add('ARMV7EM');
3639 aList.Add('CORTEXM3');
3640 end;
3641
3642 procedure Intel_i386;
3643 begin
3644 aList.Add('80386');
3645 aList.Add('Pentium');
3646 aList.Add('Pentium2');
3647 aList.Add('Pentium3');
3648 aList.Add('Pentium4');
3649 aList.Add('PentiumM');
3650 end;
3651
3652 procedure Intel_x86_64;
3653 begin
3654 aList.Add('ATHLON64');
3655 end;
3656
3657 procedure PowerPC;
3658 begin
3659 aList.Add('604');
3660 aList.Add('750');
3661 aList.Add('7400');
3662 aList.Add('970');
3663 end;
3664
3665 procedure PowerPC64;
3666 begin
3667 //aList.Add('power4');
3668 aList.Add('970');
3669 //aList.Add('power5');
3670 //aList.Add('power5+');
3671 //aList.Add('power6');
3672 //aList.Add('power6x');
3673 //aList.Add('power7');
3674 //aList.Add('power8');
3675 end;
3676
3677 procedure Sparc;
3678 begin
3679 aList.Add('SPARC V7');
3680 aList.Add('SPARC V8');
3681 aList.Add('SPARC V9');
3682 end;
3683
3684 procedure Mips;
3685 begin
3686 aList.Add('mips1');
3687 aList.Add('mips2');
3688 aList.Add('mips3');
3689 aList.Add('mips4');
3690 aList.Add('mips5');
3691 aList.Add('mips32');
3692 aList.Add('mips32r2');
3693 end;
3694
3695 procedure AVR;
3696 begin
3697 aList.Add('AVR1');
3698 aList.Add('AVR2');
3699 aList.Add('AVR25');
3700 aList.Add('AVR3');
3701 aList.Add('AVR31');
3702 aList.Add('AVR35');
3703 aList.Add('AVR4');
3704 aList.Add('AVR5');
3705 aList.Add('AVR51');
3706 aList.Add('AVR6');
3707 end;
3708
3709 procedure M68k;
3710 begin
3711 aList.Add('68000');
3712 aList.Add('68020');
3713 aList.Add('68040');
3714 aList.Add('68060');
3715 aList.Add('ISAA');
3716 aList.Add('ISAA+');
3717 aList.Add('ISAB');
3718 aList.Add('ISAC');
3719 aList.Add('CFV4');
3720 end;
3721
3722 begin
3723 case TargetCPU of
3724 'arm' : Arm;
3725 'avr' : AVR;
3726 'i386' : Intel_i386;
3727 'm68k' : M68k;
3728 'powerpc' : PowerPC;
3729 'powerpc64': PowerPC64;
3730 'sparc' : Sparc;
3731 'x86_64' : Intel_x86_64;
3732 'mipsel','mips' : Mips;
3733 'jvm' : ;
3734 'aarch64' : ;
3735 end;
3736 end;
3737
GetFPCTargetOSnull3738 function GetFPCTargetOS(TargetOS: string): string;
3739 begin
3740 Result:=lowercase(TargetOS);
3741 end;
3742
GetFPCTargetCPUnull3743 function GetFPCTargetCPU(TargetCPU: string): string;
3744 begin
3745 Result:=LowerCase(TargetCPU);
3746 end;
3747
IsPas2jsTargetOSnull3748 function IsPas2jsTargetOS(TargetOS: string): boolean;
3749 begin
3750 TargetOS:=LowerCase(TargetOS);
3751 Result:=(TargetOS='browser') or (TargetOS='nodejs');
3752 end;
3753
IsPas2jsTargetCPUnull3754 function IsPas2jsTargetCPU(TargetCPU: string): boolean;
3755 begin
3756 TargetCPU:=LowerCase(TargetCPU);
3757 Result:=Pos('ecmascript',TargetCPU)>0;
3758 end;
3759
IsCTExecutablenull3760 function IsCTExecutable(AFilename: string; out ErrorMsg: string): boolean;
3761 begin
3762 Result:=false;
3763 AFilename:=ResolveDots(AFilename);
3764 if AFilename='' then begin
3765 ErrorMsg:='missing file name';
3766 exit;
3767 end;
3768 if not FilenameIsAbsolute(AFilename) then begin
3769 ErrorMsg:='file missing path';
3770 exit;
3771 end;
3772 if not FileExistsCached(AFilename) then begin
3773 ErrorMsg:='file not found';
3774 exit;
3775 end;
3776 if DirPathExistsCached(AFilename) then begin
3777 ErrorMsg:='file is a directory';
3778 exit;
3779 end;
3780 if not FileIsExecutableCached(AFilename) then begin
3781 ErrorMsg:='file is not executable';
3782 exit;
3783 end;
3784 ErrorMsg:='';
3785 Result:=true;
3786 end;
3787
GuessPascalCompilerFromExeNamenull3788 function GuessPascalCompilerFromExeName(Filename: string): TPascalCompiler;
3789 var
3790 ShortFilename: String;
3791 begin
3792 ShortFilename:=LowerCase(ExtractFileNameOnly(Filename));
3793
3794 // *pas2js*
3795 if Pos('pas2js',ShortFilename)>0 then
3796 exit(pcPas2js);
3797
3798 // dcc*.exe
3799 if (LeftStr(ShortFilename,3)='dcc')
3800 and ((ExeExt='') or (CompareFileExt(Filename,ExeExt)=0))
3801 then
3802 exit(pcDelphi);
3803
3804 Result:=pcFPC;
3805 end;
3806
IsCompilerExecutablenull3807 function IsCompilerExecutable(AFilename: string; out ErrorMsg: string; out
3808 Kind: TPascalCompiler; Run: boolean): boolean;
3809 var
3810 ShortFilename, Line: String;
3811 Params: TStringListUTF8;
3812 Lines: TStringList;
3813 i: Integer;
3814 begin
3815 Result:=False;
3816 if not IsCTExecutable(AFilename,ErrorMsg) then exit;
3817 Kind:=pcFPC;
3818
3819 // allow scripts like fpc.sh and fpc.bat
3820 ShortFilename:=ExtractFileNameOnly(AFilename);
3821 //debugln(['IsCompilerExecutable Short=',ShortFilename]);
3822
3823 // check ppc*.exe
3824 if CompareText(LeftStr(ShortFilename,3),'ppc')=0 then
3825 exit(true);
3826
3827 // check pas2js*
3828 if CompareText(LeftStr(ShortFilename,6),'pas2js')=0 then begin
3829 Kind:=pcPas2js;
3830 exit(true);
3831 end;
3832
3833 // dcc*.exe
3834 if (CompareFilenames(LeftStr(ShortFilename,3),'dcc')=0)
3835 and ((ExeExt='') or (CompareFileExt(AFilename,ExeExt)=0))
3836 then begin
3837 Kind:=pcDelphi;
3838 exit(true);
3839 end;
3840
3841 if Run then begin
3842 // run it and check for magics
3843 debugln(['Note: (lazarus) [IsCompilerExecutable] run "',AFilename,'"']);
3844 Params:=TStringListUTF8.Create;
3845 Lines:=nil;
3846 try
3847 Params.Add('-va');
3848 Lines:=RunTool(AFilename,Params);
3849 if Lines<>nil then begin
3850 for i:=0 to Lines.Count-1 do
3851 begin
3852 Line:=Lines[i];
3853 if Pos('fpc.cfg',Line)>0 then
3854 begin
3855 Kind:=pcFPC;
3856 exit(true);
3857 end;
3858 if Pos('pas2js.cfg',Line)>0 then
3859 begin
3860 Kind:=pcPas2js;
3861 exit(true);
3862 end;
3863 end;
3864 ErrorMsg:='Compiler -va does neither search for fpc.cfg nor pas2js.cfg. This is neither fpc nor pas2js.';
3865 exit;
3866 end;
3867 finally
3868 Params.Free;
3869 Lines.Free;
3870 end;
3871 end;
3872
3873 // check fpc<something>
3874 // Note: fpc.exe is just a wrapper, it can call pas2js
3875 if CompareFilenames(LeftStr(ShortFilename,3),'fpc')=0 then
3876 exit(true);
3877
3878 ErrorMsg:='fpc executable should start with fpc or ppc';
3879 end;
3880
IsFPCExecutablenull3881 function IsFPCExecutable(AFilename: string; out ErrorMsg: string; Run: boolean
3882 ): boolean;
3883 var
3884 ShortFilename: String;
3885 Kind: TPascalCompiler;
3886 begin
3887 if Run then begin
3888 Result:=IsCompilerExecutable(AFilename,ErrorMsg,Kind,true) and (Kind=pcFPC);
3889 exit;
3890 end;
3891
3892 Result:=IsCTExecutable(AFilename,ErrorMsg);
3893 if not Result then exit;
3894
3895 // allow scripts like fpc*.sh and fpc*.bat
3896 ShortFilename:=LowerCase(ExtractFileNameOnly(AFilename));
3897 //debugln(['IsFPCExecutable Short=',ShortFilename]);
3898 if (LeftStr(ShortFilename,3)='fpc') then
3899 exit(true);
3900
3901 // allow ppcxxx.exe
3902 if (LeftStr(ShortFilename,3)='ppc')
3903 and ((ExeExt='') or (CompareFileExt(AFilename,ExeExt)=0))
3904 then
3905 exit(true);
3906
3907 ErrorMsg:='fpc executable should start with fpc or ppc';
3908 end;
3909
IsPas2JSExecutablenull3910 function IsPas2JSExecutable(AFilename: string; out ErrorMsg: string;
3911 Run: boolean): boolean;
3912 var
3913 ShortFilename: String;
3914 Kind: TPascalCompiler;
3915 begin
3916 if Run then begin
3917 Result:=IsCompilerExecutable(AFilename,ErrorMsg,Kind,true) and (Kind=pcPas2js);
3918 exit;
3919 end;
3920
3921 Result:=IsCTExecutable(AFilename,ErrorMsg);
3922 if not Result then exit;
3923
3924 // allow scripts like *pas2js*
3925 ShortFilename:=LowerCase(ExtractFileNameOnly(AFilename));
3926 if Pos('pas2js',ShortFilename)>0 then
3927 exit(true);
3928
3929 ErrorMsg:='pas2js executable should start with pas2js';
3930 end;
3931
CreateDefinesInDirectoriesnull3932 function CreateDefinesInDirectories(const SourcePaths, FlagName: string
3933 ): TDefineTemplate;
3934 var
3935 StartPos: Integer;
3936 EndPos: LongInt;
3937 CurDirectory: String;
3938 DirsTempl: TDefineTemplate;
3939 DirTempl: TDefineTemplate;
3940 SetFlagTempl: TDefineTemplate;
3941 begin
3942 // create a block template for the directories
3943 DirsTempl:=TDefineTemplate.Create(FlagName,
3944 'Block of directories to set '+FlagName,
3945 '','',da_Block);
3946
3947 // create a define flag for every directory
3948 StartPos:=1;
3949 while StartPos<=length(SourcePaths) do begin
3950 EndPos:=StartPos;
3951 while (EndPos<=length(SourcePaths)) and (SourcePaths[EndPos]<>';') do
3952 inc(EndPos);
3953 if EndPos>StartPos then begin
3954 CurDirectory:=copy(SourcePaths,StartPos,EndPos-StartPos);
3955 DirTempl:=TDefineTemplate.Create('FlagDirectory','FlagDirectory',
3956 '',CurDirectory,da_Directory);
3957 SetFlagTempl:=TDefineTemplate.Create(FlagName,FlagName,
3958 FlagName,'1',da_Define);
3959 DirTempl.AddChild(SetFlagTempl);
3960 DirsTempl.AddChild(DirTempl);
3961 end;
3962 StartPos:=EndPos+1;
3963 end;
3964
3965 Result:=DirsTempl;
3966 end;
3967
3968 procedure InitDefaultFPCSourceRules;
3969 begin
3970 DefaultFPCSourceRules:=TFPCSourceRules.Create;
3971 with DefaultFPCSourceRules do begin
3972 // put into an include file for easy edit via an editor
3973 {$I fpcsrcrules.inc}
3974 end;
3975 end;
3976
3977 { TDefineTemplate }
3978
3979 procedure TDefineTemplate.MarkFlags(
3980 const MustFlags, NotFlags: TDefineTemplateFlags;
3981 WithSiblings, WithChilds: boolean);
3982 var
3983 ANode: TDefineTemplate;
3984 begin
3985 ANode:=Self;
3986 while ANode<>nil do begin
3987 ANode.FMarked:=ANode.FMarked
3988 or (((ANode.Flags*MustFlags)=MustFlags)
3989 and (ANode.Flags*NotFlags=[]));
3990 if (ANode.FirstChild<>nil) and WithChilds then
3991 ANode.FirstChild.MarkFlags(MustFlags,NotFlags,true,true);
3992 if not WithSiblings then break;
3993 ANode:=ANode.Next;
3994 end;
3995 end;
3996
3997 procedure TDefineTemplate.MarkOwnedBy(TheOwner: TObject;
3998 const MustFlags, NotFlags: TDefineTemplateFlags;
3999 WithSiblings, WithChilds: boolean);
4000 var
4001 ANode: TDefineTemplate;
4002 begin
4003 ANode:=Self;
4004 while ANode<>nil do begin
4005 ANode.FMarked:=ANode.FMarked
4006 or ((ANode.Owner=TheOwner)
4007 and ((ANode.Flags*MustFlags)=MustFlags)
4008 and (ANode.Flags*NotFlags=[]));
4009 if (ANode.FirstChild<>nil) and WithChilds then
4010 ANode.FirstChild.MarkOwnedBy(TheOwner,MustFlags,NotFlags,true,true);
4011 if not WithSiblings then break;
4012 ANode:=ANode.Next;
4013 end;
4014 end;
4015
4016 procedure TDefineTemplate.MarkNodes(WithSiblings, WithChilds: boolean);
4017 var
4018 ANode: TDefineTemplate;
4019 begin
4020 ANode:=Self;
4021 while ANode<>nil do begin
4022 ANode.FMarked:=true;
4023 if (ANode.FirstChild<>nil) and WithChilds then
4024 ANode.FirstChild.MarkNodes(true,true);
4025 if not WithSiblings then break;
4026 ANode:=ANode.Next;
4027 end;
4028 end;
4029
4030 procedure TDefineTemplate.ReverseMarks(WithSiblings, WithChilds: boolean);
4031 var
4032 ANode: TDefineTemplate;
4033 begin
4034 ANode:=Self;
4035 while ANode<>nil do begin
4036 ANode.FMarked:=not ANode.FMarked;
4037 if (ANode.FirstChild<>nil) and WithChilds then
4038 ANode.FirstChild.MarkNodes(true,true);
4039 if not WithSiblings then break;
4040 ANode:=ANode.Next;
4041 end;
4042 end;
4043
4044 procedure TDefineTemplate.InheritMarks(WithSiblings, WithChilds, Down,
4045 Up: boolean);
4046 var
4047 ANode: TDefineTemplate;
4048 ChildNode: TDefineTemplate;
4049 begin
4050 ANode:=Self;
4051 while ANode<>nil do begin
4052 if WithChilds then begin
4053 ChildNode:=ANode.FirstChild;
4054 while ChildNode<>nil do begin
4055 if Down and ANode.FMarked then
4056 ChildNode.FMarked:=true;
4057 ChildNode.InheritMarks(false,true,Down,Up);
4058 if Up and ChildNode.FMarked then
4059 ANode.FMarked:=true;
4060 ChildNode:=ChildNode.Next;
4061 end;
4062 end;
4063 if not WithSiblings then break;
4064 ANode:=ANode.Next;
4065 end;
4066 end;
4067
4068 procedure TDefineTemplate.UnmarkNodes(WithSiblings, WithChilds: boolean);
4069 var
4070 ANode: TDefineTemplate;
4071 begin
4072 ANode:=Self;
4073 while ANode<>nil do begin
4074 ANode.FMarked:=false;
4075 if (ANode.FirstChild<>nil) and WithChilds then
4076 ANode.FirstChild.UnmarkNodes(true,true);
4077 if not WithSiblings then break;
4078 ANode:=ANode.Next;
4079 end;
4080 end;
4081
4082 procedure TDefineTemplate.RemoveMarked(WithSiblings: boolean;
4083 var FirstDefTemplate: TDefineTemplate);
4084 var ANode, NextNode: TDefineTemplate;
4085 begin
4086 ANode:=Self;
4087 while ANode<>nil do begin
4088 NextNode:=ANode.Next;
4089 if ANode.FirstChild<>nil then begin
4090 ANode.FirstChild.RemoveMarked(true,FirstDefTemplate);
4091 end;
4092 if ANode.FMarked and (ANode.FirstChild=nil) then begin
4093 if ANode=FirstDefTemplate then FirstDefTemplate:=ANode.Next;
4094 ANode.Unbind;
4095 ANode.Free;
4096 end;
4097 if not WithSiblings then break;
4098 ANode:=NextNode;
4099 end;
4100 end;
4101
4102 procedure TDefineTemplate.RemoveOwner(TheOwner: TObject; WithSiblings: boolean);
4103 var
4104 ANode: TDefineTemplate;
4105 begin
4106 ANode:=Self;
4107 while ANode<>nil do begin
4108 if ANode.FFirstChild<>nil then
4109 ANode.FFirstChild.RemoveOwner(TheOwner,true);
4110 if ANode.Owner=TheOwner then ANode.Owner:=nil;
4111 if not WithSiblings then break;
4112 ANode:=ANode.Next;
4113 end;
4114 end;
4115
4116 procedure TDefineTemplate.RemoveLeaves(TheOwner: TObject; const MustFlags,
4117 NotFlags: TDefineTemplateFlags; WithSiblings: boolean;
4118 var FirstDefTemplate: TDefineTemplate);
4119 var ANode, NextNode: TDefineTemplate;
4120 begin
4121 ANode:=Self;
4122 while ANode<>nil do begin
4123 NextNode:=ANode.Next;
4124 if ANode.FirstChild<>nil then
4125 ANode.FirstChild.RemoveLeaves(TheOwner,MustFlags,NotFlags,true,
4126 FirstDefTemplate);
4127 if ANode.FirstChild=nil then begin
4128 // this is a leaf
4129 if ((ANode.Owner=TheOwner)
4130 and ((ANode.Flags*MustFlags)=MustFlags)
4131 and (ANode.Flags*NotFlags=[]))
4132 then begin
4133 if ANode=FirstDefTemplate then
4134 FirstDefTemplate:=ANode.Next;
4135 ANode.Unbind;
4136 ANode.Free;
4137 end;
4138 end;
4139 if not WithSiblings then break;
4140 ANode:=NextNode;
4141 end;
4142 end;
4143
4144 procedure TDefineTemplate.AddChild(ADefineTemplate: TDefineTemplate);
4145 // add as last child
4146 begin
4147 if ADefineTemplate=nil then exit;
4148 if ADefineTemplate.Parent<>nil then
4149 raise Exception.Create('TDefineTemplate.AddChild');
4150 if LastChild=nil then begin
4151 while ADefineTemplate<>nil do begin
4152 ADefineTemplate.fParent:=Self;
4153 if ADefineTemplate.Prior=nil then FFirstChild:=ADefineTemplate;
4154 if ADefineTemplate.Next=nil then FLastChild:=ADefineTemplate;
4155 inc(FChildCount);
4156 ADefineTemplate:=ADefineTemplate.Next;
4157 end;
4158 end else begin
4159 ADefineTemplate.InsertBehind(LastChild);
4160 end;
4161 end;
4162
4163 procedure TDefineTemplate.ReplaceChild(ADefineTemplate: TDefineTemplate);
4164 var
4165 OldTempl: TDefineTemplate;
4166 begin
4167 OldTempl:=FindChildByName(ADefineTemplate.Name);
4168 if OldTempl<>nil then begin
4169 ADefineTemplate.InsertInFront(OldTempl);
4170 OldTempl.UnBind;
4171 OldTempl.Free;
4172 end else
4173 AddChild(ADefineTemplate);
4174 end;
4175
TDefineTemplate.DeleteChildnull4176 function TDefineTemplate.DeleteChild(const AName: string): boolean;
4177 var
4178 OldTempl: TDefineTemplate;
4179 begin
4180 OldTempl:=FindChildByName(AName);
4181 if OldTempl<>nil then begin
4182 Result:=true;
4183 OldTempl.Unbind;
4184 OldTempl.Free;
4185 end else
4186 Result:=false;
4187 end;
4188
4189 procedure TDefineTemplate.InsertBehind(APrior: TDefineTemplate);
4190 // insert this and all next siblings behind APrior
4191 var ANode, LastSibling, NewParent: TDefineTemplate;
4192 begin
4193 if APrior=nil then exit;
4194 NewParent:=APrior.Parent;
4195 if Parent<>nil then begin
4196 ANode:=Self;
4197 while ANode<>nil do begin
4198 if ANode=APrior then
4199 raise Exception.Create('internal error: '
4200 +'TDefineTemplate.InsertBehind: APrior=ANode');
4201 dec(Parent.FChildCount);
4202 ANode.FParent:=nil;
4203 ANode:=ANode.Next;
4204 end;
4205 end;
4206 LastSibling:=Self;
4207 while LastSibling.Next<>nil do LastSibling:=LastSibling.Next;
4208 FParent:=NewParent;
4209 if Parent<>nil then begin
4210 ANode:=Self;
4211 while (ANode<>nil) do begin
4212 ANode.FParent:=Parent;
4213 inc(Parent.FChildCount);
4214 ANode:=ANode.Next;
4215 end;
4216 if Parent.LastChild=APrior then Parent.FLastChild:=LastSibling;
4217 end;
4218 FPrior:=APrior;
4219 LastSibling.FNext:=APrior.Next;
4220 APrior.FNext:=Self;
4221 if LastSibling.Next<>nil then LastSibling.Next.FPrior:=LastSibling;
4222 end;
4223
4224 procedure TDefineTemplate.InsertInFront(ANext: TDefineTemplate);
4225 // insert this and all next siblings in front of ANext
4226 var ANode, LastSibling: TDefineTemplate;
4227 begin
4228 if ANext=nil then exit;
4229 if FParent<>nil then begin
4230 ANode:=Self;
4231 while ANode<>nil do begin
4232 if ANode=ANext then
4233 raise Exception.Create('internal error: '
4234 +'TDefineTemplate.InsertInFront: ANext=ANode');
4235 dec(FParent.FChildCount);
4236 ANode.FParent:=nil;
4237 ANode:=ANode.Next;
4238 end;
4239 end;
4240 LastSibling:=Self;
4241 while LastSibling.Next<>nil do LastSibling:=LastSibling.Next;
4242 FParent:=ANext.Parent;
4243 if Parent<>nil then begin
4244 ANode:=Self;
4245 while ANode<>nil do begin
4246 ANode.FParent:=Parent;
4247 inc(Parent.FChildCount);
4248 ANode:=ANode.Next;
4249 end;
4250 if Parent.FirstChild=ANext then Parent.FFirstChild:=Self;
4251 end;
4252 FPrior:=ANext.Prior;
4253 if Prior<>nil then Prior.FNext:=Self;
4254 LastSibling.FNext:=ANext;
4255 ANext.FPrior:=LastSibling;
4256 end;
4257
4258 procedure TDefineTemplate.MoveToLast(Child: TDefineTemplate);
4259 var
4260 Node: TDefineTemplate;
4261 begin
4262 if Child.Next=nil then exit;
4263 Node:=Child.Next;
4264 while Node.Next<>nil do Node:=Node.Next;
4265 Child.Unbind;
4266 Child.InsertBehind(Node);
4267 end;
4268
4269 procedure TDefineTemplate.Assign(ADefineTemplate: TDefineTemplate;
4270 WithSubNodes, WithNextSiblings, ClearOldSiblings: boolean);
4271 var ChildTemplate, CopyTemplate, NextTemplate: TDefineTemplate;
4272 begin
4273 Clear(ClearOldSiblings);
4274 if ADefineTemplate=nil then exit;
4275 AssignValues(ADefineTemplate);
4276 if WithSubNodes then begin
4277 ChildTemplate:=ADefineTemplate.FirstChild;
4278 if ChildTemplate<>nil then begin
4279 CopyTemplate:=TDefineTemplate.Create;
4280 AddChild(CopyTemplate);
4281 CopyTemplate.Assign(ChildTemplate,true,true,false);
4282 end;
4283 end;
4284 if WithNextSiblings then begin
4285 NextTemplate:=ADefineTemplate.Next;
4286 if NextTemplate<>nil then begin
4287 CopyTemplate:=TDefineTemplate.Create;
4288 CopyTemplate.InsertBehind(Self);
4289 CopyTemplate.Assign(NextTemplate,WithSubNodes,true,false);
4290 end;
4291 end;
4292 end;
4293
4294 procedure TDefineTemplate.AssignValues(ADefineTemplate: TDefineTemplate);
4295 begin
4296 Name:=ADefineTemplate.Name;
4297 Description:=ADefineTemplate.Description;
4298 Variable:=ADefineTemplate.Variable;
4299 Value:=ADefineTemplate.Value;
4300 Action:=ADefineTemplate.Action;
4301 Flags:=ADefineTemplate.Flags;
4302 MergeNameInFront:=ADefineTemplate.MergeNameInFront;
4303 MergeNameBehind:=ADefineTemplate.MergeNameBehind;
4304 Owner:=ADefineTemplate.Owner;
4305 end;
4306
4307 procedure TDefineTemplate.Unbind;
4308 begin
4309 if FPrior<>nil then FPrior.FNext:=FNext;
4310 if FNext<>nil then FNext.FPrior:=FPrior;
4311 if FParent<>nil then begin
4312 if FParent.FFirstChild=Self then FParent.FFirstChild:=FNext;
4313 if FParent.FLastChild=Self then FParent.FLastChild:=FPrior;
4314 dec(FParent.FChildCount);
4315 end;
4316 FNext:=nil;
4317 FPrior:=nil;
4318 FParent:=nil;
4319 end;
4320
4321 procedure TDefineTemplate.Clear(WithSiblings: boolean);
4322 begin
4323 while FFirstChild<>nil do FFirstChild.Free;
4324 if WithSiblings then
4325 while FNext<>nil do FNext.Free;
4326 Name:='';
4327 Description:='';
4328 Value:='';
4329 Variable:='';
4330 Flags:=[];
4331 end;
4332
4333 constructor TDefineTemplate.Create;
4334 begin
4335 inherited Create;
4336 end;
4337
4338 constructor TDefineTemplate.Create(const AName, ADescription, AVariable,
4339 AValue: string; AnAction: TDefineAction);
4340 begin
4341 inherited Create;
4342 Name:=AName;
4343 Description:=ADescription;
4344 Variable:=AVariable;
4345 Value:=AValue;
4346 Action:=AnAction;
4347 end;
4348
CreateCopynull4349 function TDefineTemplate.CreateCopy(OnlyMarked: boolean;
4350 WithSiblings: boolean; WithChilds: boolean): TDefineTemplate;
4351 var LastNewNode, NewNode, ANode: TDefineTemplate;
4352 begin
4353 Result:=nil;
4354 LastNewNode:=nil;
4355 ANode:=Self;
4356 while ANode<>nil do begin
4357 if (not OnlyMarked) or (ANode.FMarked) then begin
4358 // copy node
4359 NewNode:=TDefineTemplate.Create;
4360 NewNode.Assign(ANode,false,false,false);
4361 if LastNewNode<>nil then
4362 NewNode.InsertBehind(LastNewNode)
4363 else
4364 Result:=NewNode;
4365 LastNewNode:=NewNode;
4366 // copy children
4367 if WithChilds and (ANode.FirstChild<>nil) then begin
4368 NewNode:=ANode.FirstChild.CreateCopy(OnlyMarked,true,true);
4369 if NewNode<>nil then
4370 LastNewNode.AddChild(NewNode);
4371 end;
4372 end;
4373 if not WithSiblings then break;
4374 ANode:=ANode.Next;
4375 end;
4376 end;
4377
CreateMergeCopynull4378 function TDefineTemplate.CreateMergeCopy: TDefineTemplate;
4379 begin
4380 CreateMergeInfo(false,false);
4381 Result:=TDefineTemplate.Create;
4382 Result.Assign(Self,true,false,false);
4383 end;
4384
TDefineTemplate.FindRootnull4385 function TDefineTemplate.FindRoot: TDefineTemplate;
4386 begin
4387 Result:=Self;
4388 repeat
4389 if Result.Parent<>nil then
4390 Result:=Result.Parent
4391 else if Result.Prior<>nil then
4392 Result:=Result.Prior
4393 else
4394 break;
4395 until false;
4396 end;
4397
4398 destructor TDefineTemplate.Destroy;
4399 begin
4400 Clear(false);
4401 Unbind;
4402 inherited Destroy;
4403 end;
4404
LoadFromXMLConfignull4405 function TDefineTemplate.LoadFromXMLConfig(XMLConfig: TXMLConfig;
4406 const Path: string; ClearOldSiblings, WithMergeInfo: boolean): boolean;
4407 var IndexedPath: string;
4408 i, LvlCount: integer;
4409 DefTempl, LastDefTempl: TDefineTemplate;
4410 NewChild: TDefineTemplate;
4411 begin
4412 Clear(ClearOldSiblings);
4413 LvlCount:=XMLConfig.GetValue(Path+'Count/Value',0);
4414 DefTempl:=nil;
4415 for i:=1 to LvlCount do begin
4416 if i=1 then begin
4417 DefTempl:=Self;
4418 LastDefTempl:=Prior;
4419 end else begin
4420 LastDefTempl:=DefTempl;
4421 DefTempl:=TDefineTemplate.Create;
4422 DefTempl.InsertBehind(LastDefTempl);
4423 end;
4424 IndexedPath:=Path+'Node'+IntToStr(i)+'/';
4425 DefTempl.LoadValuesFromXMLConfig(XMLConfig,IndexedPath,WithMergeInfo);
4426 // load children
4427 if XMLConfig.GetValue(IndexedPath+'Count/Value',0)>0 then begin
4428 NewChild:=TDefineTemplate.Create;
4429 DefTempl.AddChild(NewChild);
4430 if not NewChild.LoadFromXMLConfig(XMLConfig,IndexedPath,
4431 false,WithMergeInfo) then
4432 begin
4433 Result:=false; exit;
4434 end;
4435 end;
4436 end;
4437 Result:=true;
4438 end;
4439
4440 procedure TDefineTemplate.LoadValuesFromXMLConfig(XMLConfig: TXMLConfig;
4441 const Path: string; WithMergeInfo: boolean);
4442 var f: TDefineTemplateFlag;
4443 begin
4444 Name:=XMLConfig.GetValue(Path+'Name/Value','no name');
4445 Description:=XMLConfig.GetValue(Path+'Description/Value','');
4446 Value:=XMLConfig.GetValue(Path+'Value/Value','');
4447 Variable:=XMLConfig.GetValue(Path+'Variable/Value','');
4448 Action:=DefineActionNameToAction(
4449 XMLConfig.GetValue(Path+'Action/Value',''));
4450 Flags:=[];
4451 for f:=Low(TDefineTemplateFlag) to High(TDefineTemplateFlag) do begin
4452 if (f<>dtfAutoGenerated)
4453 and (XMLConfig.GetValue(Path+'Flags/'+DefineTemplateFlagNames[f],false))
4454 then
4455 Include(Flags,f);
4456 end;
4457 if WithMergeInfo then begin
4458 MergeNameInFront:=XMLConfig.GetValue(Path+'MergeNameInFront/Value','');
4459 MergeNameBehind:=XMLConfig.GetValue(Path+'MergeNameInFront/Value','');
4460 end else begin
4461 MergeNameInFront:='';
4462 MergeNameBehind:='';
4463 end;
4464 end;
4465
4466 procedure TDefineTemplate.SaveValuesToXMLConfig(XMLConfig: TXMLConfig;
4467 const Path: string; WithMergeInfo: boolean);
4468 var
4469 f: TDefineTemplateFlag;
4470 begin
4471 XMLConfig.SetDeleteValue(Path+'Name/Value',Name,'');
4472 XMLConfig.SetDeleteValue(Path+'Description/Value',Description,'');
4473 XMLConfig.SetDeleteValue(Path+'Value/Value',Value,'');
4474 XMLConfig.SetDeleteValue(Path+'Variable/Value',Variable,'');
4475 XMLConfig.SetDeleteValue(Path+'Action/Value',
4476 DefineActionNames[Action],
4477 DefineActionNames[da_None]);
4478 for f:=Low(TDefineTemplateFlag) to High(TDefineTemplateFlag) do begin
4479 if (f<>dtfAutoGenerated) then
4480 XMLConfig.SetDeleteValue(
4481 Path+'Flags/'+DefineTemplateFlagNames[f]
4482 ,f in Flags,false);
4483 end;
4484 if WithMergeInfo then begin
4485 XMLConfig.SetDeleteValue(Path+'MergeNameInFront/Value',
4486 MergeNameInFront,'');
4487 XMLConfig.SetDeleteValue(Path+'MergeNameBehind/Value',
4488 MergeNameBehind,'');
4489 end else begin
4490 XMLConfig.SetDeleteValue(Path+'MergeNameInFront/Value','','');
4491 XMLConfig.SetDeleteValue(Path+'MergeNameBehind/Value','','');
4492 end;
4493 end;
4494
4495 procedure TDefineTemplate.SaveToXMLConfig(XMLConfig: TXMLConfig;
4496 const Path: string;
4497 WithSiblings, OnlyMarked, WithMergeInfo, UpdateMergeInfo: boolean);
4498 var IndexedPath: string;
4499 Index, LvlCount: integer;
4500 DefTempl: TDefineTemplate;
4501 begin
4502 if UpdateMergeInfo then CreateMergeInfo(WithSiblings,OnlyMarked);
4503 DefTempl:=Self;
4504 LvlCount:=0;
4505 while DefTempl<>nil do begin
4506 inc(LvlCount);
4507 DefTempl:=DefTempl.Next;
4508 end;
4509 DefTempl:=Self;
4510 Index:=0;
4511 repeat
4512 if (DefTempl.FMarked) or (not OnlyMarked) then begin
4513 // save node
4514 inc(Index);
4515 IndexedPath:=Path+'Node'+IntToStr(Index)+'/';
4516 DefTempl.SaveValuesToXMLConfig(XMLConfig,IndexedPath,WithMergeInfo);
4517 // save children
4518 if DefTempl.FFirstChild<>nil then
4519 DefTempl.FirstChild.SaveToXMLConfig(XMLConfig,IndexedPath,
4520 true,OnlyMarked,
4521 WithMergeInfo,false)
4522 else
4523 XMLConfig.SetDeleteValue(IndexedPath+'Count/Value',0,0);
4524 end;
4525 if not WithSiblings then break;
4526 DefTempl:=DefTempl.Next;
4527 until DefTempl=nil;
4528 XMLConfig.SetDeleteValue(Path+'Count/Value',Index,0);
4529 end;
4530
4531 procedure TDefineTemplate.CreateMergeInfo(WithSiblings, OnlyMarked: boolean);
4532 var
4533 DefTempl: TDefineTemplate;
4534 begin
4535 DefTempl:=Self;
4536 repeat
4537 if (DefTempl.FMarked) or (not OnlyMarked) then begin
4538 if DefTempl.Prior<>nil then
4539 DefTempl.MergeNameInFront:=DefTempl.Prior.Name
4540 else
4541 DefTempl.MergeNameInFront:='';
4542 if DefTempl.Next<>nil then
4543 DefTempl.MergeNameBehind:=DefTempl.Next.Name
4544 else
4545 DefTempl.MergeNameBehind:='';
4546 // update children
4547 if DefTempl.FFirstChild<>nil then
4548 DefTempl.FirstChild.CreateMergeInfo(true,OnlyMarked);
4549 end;
4550 if not WithSiblings then break;
4551 DefTempl:=DefTempl.Next;
4552 until DefTempl=nil;
4553 end;
4554
4555 class procedure TDefineTemplate.MergeXMLConfig(ParentDefTempl: TDefineTemplate;
4556 var FirstSibling, LastSibling: TDefineTemplate;
4557 XMLConfig: TXMLConfig; const Path, NewNamePrefix: string);
4558 var
4559 SrcNode: TDefineTemplate;
4560 begin
4561 SrcNode:=TDefineTemplate.Create;
4562 SrcNode.LoadFromXMLConfig(XMLConfig,Path,false,true);
4563 MergeTemplates(ParentDefTempl,FirstSibling,LastSibling,SrcNode,true,
4564 NewNamePrefix);
4565 SrcNode.Clear(true);
4566 SrcNode.Free;
4567 end;
4568
4569 class procedure TDefineTemplate.MergeTemplates(ParentDefTempl: TDefineTemplate;
4570 var FirstSibling, LastSibling: TDefineTemplate;
4571 SourceTemplate: TDefineTemplate; WithSiblings: boolean;
4572 const NewNamePrefix: string);
4573 // merge SourceTemplate. This will keep SourceTemplate untouched
4574 var
4575 NewNode, PosNode: TDefineTemplate;
4576 Inserted: boolean;
4577 SrcNode: TDefineTemplate;
4578 begin
4579 SrcNode:=SourceTemplate;
4580 while SrcNode<>nil do begin
4581 // merge all source nodes
4582 NewNode:=SrcNode.CreateCopy(false,false,false);
4583 Inserted:=false;
4584 if NewNode.Name<>'' then begin
4585 // node has a name -> test if already exists
4586 PosNode:=FirstSibling;
4587 while (PosNode<>nil)
4588 and (CompareText(PosNode.Name,NewNode.Name)<>0) do
4589 PosNode:=PosNode.Next;
4590 if PosNode<>nil then begin
4591 // node with same name already exists -> check if it is a copy
4592 if NewNode.IsEqual(PosNode,false,false) then begin
4593 // node already exists
4594 NewNode.Free;
4595 NewNode:=PosNode;
4596 end else begin
4597 // node has same name, but different values
4598 // -> rename node
4599 NewNode.Name:=NewNode.FindUniqueName(NewNamePrefix+NewNode.Name);
4600 // insert behind PosNode
4601 NewNode.InsertBehind(PosNode);
4602 end;
4603 Inserted:=true;
4604 end;
4605 end;
4606 if not Inserted then begin
4607 // node name is unique or empty -> insert node
4608 if NewNode.MergeNameInFront<>'' then begin
4609 // last time, node was inserted behind MergeNameInFront
4610 // -> search MergeNameInFront
4611 PosNode:=LastSibling;
4612 while (PosNode<>nil)
4613 and (CompareText(PosNode.Name,NewNode.MergeNameInFront)<>0) do
4614 PosNode:=PosNode.Prior;
4615 if PosNode<>nil then begin
4616 // MergeNameInFront found -> insert behind
4617 NewNode.InsertBehind(PosNode);
4618 Inserted:=true;
4619 end;
4620 end;
4621 if not Inserted then begin
4622 if NewNode.MergeNameBehind<>'' then begin
4623 // last time, node was inserted in front of MergeNameBehind
4624 // -> search MergeNameBehind
4625 PosNode:=FirstSibling;
4626 while (PosNode<>nil)
4627 and (CompareText(PosNode.Name,NewNode.MergeNameBehind)<>0) do
4628 PosNode:=PosNode.Next;
4629 if PosNode<>nil then begin
4630 // MergeNameBehind found -> insert in front
4631 NewNode.InsertInFront(PosNode);
4632 Inserted:=true;
4633 end;
4634 end;
4635 end;
4636 if not Inserted then begin
4637 // no merge position found -> add as last
4638 if LastSibling<>nil then begin
4639 NewNode.InsertBehind(LastSibling);
4640 end else if ParentDefTempl<>nil then begin
4641 ParentDefTempl.AddChild(NewNode);
4642 end;
4643 end;
4644 end;
4645 // NewNode is now inserted -> update FirstSibling and LastSibling
4646 if FirstSibling=nil then begin
4647 FirstSibling:=NewNode;
4648 LastSibling:=NewNode;
4649 end;
4650 while FirstSibling.Prior<>nil do
4651 FirstSibling:=FirstSibling.Prior;
4652 while LastSibling.Next<>nil do
4653 LastSibling:=LastSibling.Next;
4654 // merge children
4655 MergeTemplates(NewNode,NewNode.FFirstChild,NewNode.FLastChild,
4656 SrcNode.FirstChild,true,NewNamePrefix);
4657 if not WithSiblings then break;
4658 SrcNode:=SrcNode.Next;
4659 end;
4660 end;
4661
4662 procedure TDefineTemplate.ConsistencyCheck;
4663 var RealChildCount: integer;
4664 DefTempl: TDefineTemplate;
4665 begin
4666 RealChildCount:=0;
4667 DefTempl:=FFirstChild;
4668 if DefTempl<>nil then begin
4669 if DefTempl.Prior<>nil then begin
4670 // not first child
4671 RaiseCatchableException('');
4672 end;
4673 while DefTempl<>nil do begin
4674 if DefTempl.Parent<>Self then begin
4675 DebugLn(' C: DefTempl.Parent<>Self: ',Name,',',DefTempl.Name);
4676 RaiseCatchableException('');
4677 end;
4678 if (DefTempl.Next<>nil) and (DefTempl.Next.Prior<>DefTempl) then
4679 RaiseCatchableException('');
4680 if (DefTempl.Prior<>nil) and (DefTempl.Prior.Next<>DefTempl) then
4681 RaiseCatchableException('');
4682 DefTempl.ConsistencyCheck;
4683 DefTempl:=DefTempl.Next;
4684 inc(RealChildCount);
4685 end;
4686 end;
4687 if (Parent<>nil) then begin
4688 if (Prior=nil) and (Parent.FirstChild<>Self) then
4689 RaiseCatchableException('');
4690 if (Next=nil) and (Parent.LastChild<>Self) then
4691 RaiseCatchableException('');
4692 end;
4693 if RealChildCount<>FChildCount then
4694 RaiseCatchableException('');
4695 end;
4696
4697 procedure TDefineTemplate.CalcMemSize(Stats: TCTMemStats);
4698 var
4699 Child: TDefineTemplate;
4700 begin
4701 Stats.Add('TDefineTemplate Instance Count',1);
4702 Stats.Add('TDefineTemplate',
4703 PtrUInt(InstanceSize)
4704 +MemSizeString(FMergeNameBehind)
4705 +MemSizeString(FMergeNameInFront)
4706 +MemSizeString(Name)
4707 +MemSizeString(Description)
4708 +MemSizeString(Variable)
4709 +MemSizeString(Value)
4710 +MemSizeString(Value)
4711 );
4712 Child:=FFirstChild;
4713 while Child<>nil do begin
4714 Child.CalcMemSize(Stats);
4715 Child:=Child.Next;
4716 end;
4717 end;
4718
4719 procedure TDefineTemplate.SetDefineOwner(NewOwner: TObject;
4720 WithSiblings: boolean);
4721 var
4722 ANode: TDefineTemplate;
4723 begin
4724 ANode:=Self;
4725 while ANode<>nil do begin
4726 ANode.Owner:=NewOwner;
4727 if ANode.FFirstChild<>nil then
4728 ANode.FFirstChild.SetDefineOwner(NewOwner,true);
4729 if not WithSiblings then exit;
4730 ANode:=ANode.Next;
4731 end;
4732 end;
4733
4734 procedure TDefineTemplate.SetFlags(AddFlags, SubFlags: TDefineTemplateFlags;
4735 WithSiblings: boolean);
4736 var
4737 ANode: TDefineTemplate;
4738 begin
4739 ANode:=Self;
4740 while ANode<>nil do begin
4741 ANode.Flags:=ANode.Flags+AddFlags-SubFlags;
4742 if ANode.FFirstChild<>nil then
4743 ANode.FFirstChild.SetFlags(AddFlags,SubFlags,true);
4744 if not WithSiblings then exit;
4745 ANode:=ANode.Next;
4746 end;
4747 end;
4748
4749 procedure TDefineTemplate.WriteDebugReport(OnlyMarked: boolean);
4750
4751 procedure WriteNode(ANode: TDefineTemplate; const Prefix: string);
4752 var ActionStr: string;
4753 begin
4754 if ANode=nil then exit;
4755 if (not OnlyMarked) or (ANode.Marked) then begin
4756 ActionStr:=DefineActionNames[ANode.Action];
4757 DebugLn(Prefix+'Self='+DbgS(ANode),
4758 ' Name="'+ANode.Name,'"',
4759 ' Next='+DbgS(ANode.Next),
4760 ' Prior='+DbgS(ANode.Prior),
4761 ' Action='+ActionStr,
4762 ' Flags=['+DefineTemplateFlagsToString(ANode.Flags),']',
4763 ' Marked='+dbgs(ANode.Marked)
4764 );
4765 DebugLn(Prefix+' + Description="',ANode.Description,'"');
4766 DebugLn(Prefix+' + Variable="',ANode.Variable,'"');
4767 DebugLn(Prefix+' + Value="',ANode.Value,'"');
4768 end;
4769 WriteNode(ANode.FirstChild,Prefix+' ');
4770 WriteNode(ANode.Next,Prefix);
4771 end;
4772
4773 begin
4774 WriteNode(Self,' ');
4775 end;
4776
GetNextnull4777 function TDefineTemplate.GetNext: TDefineTemplate;
4778 begin
4779 if FirstChild<>nil then
4780 exit(FirstChild);
4781 Result:=GetNextSkipChildren;
4782 end;
4783
TDefineTemplate.GetNextSkipChildrennull4784 function TDefineTemplate.GetNextSkipChildren: TDefineTemplate;
4785 begin
4786 Result:=Self;
4787 while (Result<>nil) do begin
4788 if Result.Next<>nil then begin
4789 Result:=Result.Next;
4790 exit;
4791 end;
4792 Result:=Result.Parent;
4793 end;
4794 end;
4795
HasDefinesnull4796 function TDefineTemplate.HasDefines(OnlyMarked, WithSiblings: boolean): boolean;
4797 var
4798 CurTempl: TDefineTemplate;
4799 begin
4800 Result:=true;
4801 CurTempl:=Self;
4802 while CurTempl<>nil do begin
4803 if ((not OnlyMarked) or (CurTempl.FMarked))
4804 and (CurTempl.Action in DefineActionDefines) then exit;
4805 // go to next
4806 if CurTempl.FFirstChild<>nil then
4807 CurTempl:=CurTempl.FFirstChild
4808 else if (CurTempl.FNext<>nil)
4809 and (WithSiblings or (CurTempl.Parent<>Parent)) then
4810 CurTempl:=CurTempl.FNext
4811 else begin
4812 // search uncle
4813 repeat
4814 CurTempl:=CurTempl.Parent;
4815 if (CurTempl=Parent)
4816 or ((CurTempl.Parent=Parent) and not WithSiblings) then begin
4817 Result:=false;
4818 exit;
4819 end;
4820 until (CurTempl.FNext<>nil);
4821 CurTempl:=CurTempl.FNext;
4822 end;
4823 end;
4824 Result:=false;
4825 end;
4826
TDefineTemplate.IsEqualnull4827 function TDefineTemplate.IsEqual(ADefineTemplate: TDefineTemplate;
4828 CheckSubNodes, CheckNextSiblings: boolean): boolean;
4829 var SrcNode, DestNode: TDefineTemplate;
4830 begin
4831 Result:=(ADefineTemplate<>nil)
4832 and (Name=ADefineTemplate.Name)
4833 and (Description=ADefineTemplate.Description)
4834 and (Variable=ADefineTemplate.Variable)
4835 and (Value=ADefineTemplate.Value)
4836 and (Action=ADefineTemplate.Action)
4837 and (Flags=ADefineTemplate.Flags)
4838 and (Owner=ADefineTemplate.Owner);
4839 if not Result then begin
4840 exit;
4841 end;
4842 if CheckSubNodes then begin
4843 if (ChildCount<>ADefineTemplate.ChildCount) then begin
4844 Result:=false;
4845 exit;
4846 end;
4847 SrcNode:=FirstChild;
4848 DestNode:=ADefineTemplate.FirstChild;
4849 if SrcNode<>nil then begin
4850 Result:=SrcNode.IsEqual(DestNode,CheckSubNodes,true);
4851 if not Result then exit;
4852 end;
4853 end;
4854 if CheckNextSiblings then begin
4855 SrcNode:=Next;
4856 DestNode:=ADefineTemplate.Next;
4857 while (SrcNode<>nil) and (DestNode<>nil) do begin
4858 Result:=SrcNode.IsEqual(DestNode,CheckSubNodes,false);
4859 if not Result then exit;
4860 SrcNode:=SrcNode.Next;
4861 DestNode:=DestNode.Next;
4862 end;
4863 Result:=(SrcNode=nil) and (DestNode=nil);
4864 if not Result then begin
4865 //DebugLn('TDefineTemplate.IsEqual DIFF 3 ',Name,' ',
4866 // ADefineTemplate.Name,' ',dbgs(ChildCount),' ',dbgs(ADefineTemplate.ChildCount));
4867 end;
4868 end;
4869 end;
4870
TDefineTemplate.IsAutoGeneratednull4871 function TDefineTemplate.IsAutoGenerated: boolean;
4872 begin
4873 Result:=SelfOrParentContainsFlag(dtfAutoGenerated);
4874 end;
4875
4876 procedure TDefineTemplate.RemoveFlags(TheFlags: TDefineTemplateFlags);
4877 var ANode: TDefineTemplate;
4878 begin
4879 ANode:=Self;
4880 while ANode<>nil do begin
4881 Flags:=Flags-TheFlags;
4882 if FirstChild<>nil then FirstChild.RemoveFlags(TheFlags);
4883 ANode:=ANode.Next;
4884 end;
4885 end;
4886
TDefineTemplate.Levelnull4887 function TDefineTemplate.Level: integer;
4888 var ANode: TDefineTemplate;
4889 begin
4890 Result:=-1;
4891 ANode:=Self;
4892 while ANode<>nil do begin
4893 inc(Result);
4894 ANode:=ANode.Parent;
4895 end;
4896 end;
4897
TDefineTemplate.GetFirstSiblingnull4898 function TDefineTemplate.GetFirstSibling: TDefineTemplate;
4899 begin
4900 Result:=Self;
4901 while Result.Prior<>nil do Result:=Result.Prior;
4902 end;
4903
SelfOrParentContainsFlagnull4904 function TDefineTemplate.SelfOrParentContainsFlag(
4905 AFlag: TDefineTemplateFlag): boolean;
4906 var Node: TDefineTemplate;
4907 begin
4908 Node:=Self;
4909 while (Node<>nil) do begin
4910 if AFlag in Node.Flags then begin
4911 Result:=true;
4912 exit;
4913 end;
4914 Node:=Node.Parent;
4915 end;
4916 Result:=false;
4917 end;
4918
FindChildByNamenull4919 function TDefineTemplate.FindChildByName(const AName: string): TDefineTemplate;
4920 begin
4921 if FirstChild<>nil then begin
4922 Result:=FirstChild.FindByName(AName,false,true)
4923 end else
4924 Result:=nil;
4925 end;
4926
TDefineTemplate.FindByNamenull4927 function TDefineTemplate.FindByName(const AName: string; WithSubChilds,
4928 WithNextSiblings: boolean): TDefineTemplate;
4929 var ANode: TDefineTemplate;
4930 begin
4931 if CompareText(AName,Name)=0 then begin
4932 Result:=Self;
4933 end else begin
4934 if WithSubChilds and (FirstChild<>nil) then
4935 Result:=FirstChild.FindByName(AName,true,true)
4936 else
4937 Result:=nil;
4938 if (Result=nil) and WithNextSiblings then begin
4939 ANode:=Next;
4940 while (ANode<>nil) do begin
4941 Result:=ANode.FindByName(AName,WithSubChilds,false);
4942 if Result<>nil then break;
4943 ANode:=ANode.Next;
4944 end;
4945 end;
4946 end;
4947 end;
4948
FindUniqueNamenull4949 function TDefineTemplate.FindUniqueName(const Prefix: string): string;
4950 var Root: TDefineTemplate;
4951 i: integer;
4952 begin
4953 Root:=FindRoot;
4954 i:=0;
4955 repeat
4956 inc(i);
4957 Result:=Prefix+IntToStr(i);
4958 until Root.FindByName(Result,true,true)=nil;
4959 end;
4960
4961
4962 { TDirectoryDefines }
4963
4964 constructor TDirectoryDefines.Create;
4965 begin
4966 inherited Create;
4967 Values:=TExpressionEvaluator.Create;
4968 Path:='';
4969 end;
4970
4971 destructor TDirectoryDefines.Destroy;
4972 begin
4973 Values.Free;
4974 inherited Destroy;
4975 end;
4976
4977 procedure TDirectoryDefines.CalcMemSize(Stats: TCTMemStats);
4978 begin
4979 Stats.Add('TDirectoryDefines',PtrUInt(InstanceSize)
4980 +MemSizeString(Path));
4981 if Values<>nil then
4982 Stats.Add('TDirectoryDefines.Values',Values.CalcMemSize(false,nil));
4983 end;
4984
4985
4986 { TDefineTree }
4987
4988 procedure TDefineTree.Clear;
4989 begin
4990 if FFirstDefineTemplate<>nil then begin
4991 FFirstDefineTemplate.Clear(true);
4992 FFirstDefineTemplate.Free;
4993 FFirstDefineTemplate:=nil;
4994 end;
4995 ClearCache;
4996 end;
4997
TDefineTree.IsEqualnull4998 function TDefineTree.IsEqual(SrcDefineTree: TDefineTree): boolean;
4999 begin
5000 Result:=false;
5001 if SrcDefineTree=nil then exit;
5002 if (FFirstDefineTemplate=nil) xor (SrcDefineTree.FFirstDefineTemplate=nil)
5003 then exit;
5004 if (FFirstDefineTemplate<>nil)
5005 and (not FFirstDefineTemplate.IsEqual(
5006 SrcDefineTree.FFirstDefineTemplate,true,true))
5007 then exit;
5008 Result:=true;
5009 end;
5010
5011 procedure TDefineTree.Assign(SrcDefineTree: TDefineTree);
5012 begin
5013 if IsEqual(SrcDefineTree) then exit;
5014 Clear;
5015 if SrcDefineTree.FFirstDefineTemplate<>nil then begin
5016 FFirstDefineTemplate:=TDefineTemplate.Create;
5017 FFirstDefineTemplate.Assign(SrcDefineTree.FFirstDefineTemplate,
5018 true,true,true);
5019 end;
5020 end;
5021
5022 procedure TDefineTree.AssignNonAutoCreated(SrcDefineTree: TDefineTree);
5023 var
5024 SrcNonAutoCreated: TDefineTemplate;
5025 begin
5026 MarkNonAutoCreated;
5027 RemoveMarked;
5028 SrcNonAutoCreated:=SrcDefineTree.ExtractNonAutoCreated;
5029 if SrcNonAutoCreated=nil then exit;
5030 //DebugLn('TDefineTree.AssignNonAutoCreated A Front=',SrcNonAutoCreated.MergeNameInFront,' Behind=',SrcNonAutoCreated.MergeNameBehind);
5031 MergeTemplates(SrcNonAutoCreated,'');
5032 SrcNonAutoCreated.Clear(true);
5033 SrcNonAutoCreated.Free;
5034 FFirstDefineTemplate.CreateMergeInfo(true,false);
5035 //DebugLn('TDefineTree.AssignNonAutoCreated B Front=',FFirstDefineTemplate.MergeNameInFront,' Behind=',FFirstDefineTemplate.MergeNameBehind);
5036 end;
5037
5038 procedure TDefineTree.ClearCache;
5039 begin
5040 if (FCache.Count=0) and (FVirtualDirCache=nil) then exit;
5041 DoClearCache;
5042 end;
5043
5044 constructor TDefineTree.Create;
5045 begin
5046 inherited Create;
5047 IncreaseChangeStep;
5048 FFirstDefineTemplate:=nil;
5049 FCache:=TAVLTree.Create(@CompareDirectoryDefines);
5050 FDefineStrings:=TStringTree.Create;
5051
5052 FMacroFunctions:=TKeyWordFunctionList.Create('TDefineTree.Create.MacroFunctions');
5053 FMacroFunctions.AddExtended('Ext',nil,@MacroFuncExtractFileExt);
5054 FMacroFunctions.AddExtended('PATH',nil,@MacroFuncExtractFilePath);
5055 FMacroFunctions.AddExtended('NAME',nil,@MacroFuncExtractFileName);
5056 FMacroFunctions.AddExtended('NAMEONLY',nil,@MacroFuncExtractFileNameOnly);
5057
5058 FMacroVariables:=TKeyWordFunctionList.Create('TDefineTree.Create.MacroVariables');
5059 end;
5060
5061 destructor TDefineTree.Destroy;
5062 begin
5063 Clear;
5064 FMacroVariables.Free;
5065 FMacroFunctions.Free;
5066 FCache.Free;
5067 FreeAndNil(FDefineStrings);
5068 inherited Destroy;
5069 end;
5070
GetLastRootTemplatenull5071 function TDefineTree.GetLastRootTemplate: TDefineTemplate;
5072 begin
5073 Result:=FFirstDefineTemplate;
5074 if Result=nil then exit;
5075 while Result.Next<>nil do Result:=Result.Next;
5076 end;
5077
FindDirectoryInCachenull5078 function TDefineTree.FindDirectoryInCache(
5079 const Path: string): TDirectoryDefines;
5080 var cmp: integer;
5081 ANode: TAVLTreeNode;
5082 begin
5083 ANode:=FCache.Root;
5084 while (ANode<>nil) do begin
5085 cmp:=CompareFilenames(Path,TDirectoryDefines(ANode.Data).Path);
5086 if cmp<0 then
5087 ANode:=ANode.Left
5088 else if cmp>0 then
5089 ANode:=ANode.Right
5090 else
5091 break;
5092 end;
5093 if ANode<>nil then
5094 Result:=TDirectoryDefines(ANode.Data)
5095 else
5096 Result:=nil;
5097 end;
5098
TDefineTree.GetDirDefinesForDirectorynull5099 function TDefineTree.GetDirDefinesForDirectory(const Path: string;
5100 WithVirtualDir: boolean): TDirectoryDefines;
5101 var
5102 ExpPath: String;
5103 begin
5104 //DebugLn('[TDefineTree.GetDirDefinesForDirectory] "',Path,'"');
5105 if (Path<>'') or (not WithVirtualDir) then begin
5106 DoPrepareTree;
5107 ExpPath:=AppendPathDelim(TrimFilename(Path));
5108 Result:=FindDirectoryInCache(ExpPath);
5109 if Result=nil then begin
5110 Result:=TDirectoryDefines.Create;
5111 Result.Path:=ExpPath;
5112 //DebugLn('[TDefineTree.GetDirDefinesForDirectory] B ',ExpPath,' ');
5113 if Calculate(Result) then begin
5114 //DebugLn('[TDefineTree.GetDirDefinesForDirectory] C success');
5115 RemoveDoubles(Result);
5116 FCache.Add(Result);
5117 end else begin
5118 Result.Free;
5119 Result:=nil;
5120 end;
5121 end;
5122 end else begin
5123 Result:=GetDirDefinesForVirtualDirectory;
5124 end;
5125 end;
5126
GetDirDefinesForVirtualDirectorynull5127 function TDefineTree.GetDirDefinesForVirtualDirectory: TDirectoryDefines;
5128 begin
5129 DoPrepareTree;
5130 if FVirtualDirCache=nil then begin
5131 {$IFDEF VerboseDefineCache}
5132 DebugLn('################ TDefineTree.GetDirDefinesForVirtualDirectory');
5133 {$ENDIF}
5134 FVirtualDirCache:=TDirectoryDefines.Create;
5135 FVirtualDirCache.Path:=VirtualDirectory;
5136 if Calculate(FVirtualDirCache) then begin
5137 //DebugLn('TDefineTree.GetDirDefinesForVirtualDirectory ');
5138 RemoveDoubles(FVirtualDirCache);
5139 end else begin
5140 FVirtualDirCache.Free;
5141 FVirtualDirCache:=nil;
5142 end;
5143 end;
5144 Result:=FVirtualDirCache;
5145 end;
5146
TDefineTree.MacroFuncExtractFileExtnull5147 function TDefineTree.MacroFuncExtractFileExt(Data: Pointer): boolean;
5148 var
5149 FuncData: PReadFunctionData;
5150 begin
5151 FuncData:=PReadFunctionData(Data);
5152 FuncData^.Result:=ExtractFileExt(FuncData^.Param);
5153 Result:=true;
5154 end;
5155
MacroFuncExtractFilePathnull5156 function TDefineTree.MacroFuncExtractFilePath(Data: Pointer): boolean;
5157 var
5158 FuncData: PReadFunctionData;
5159 begin
5160 FuncData:=PReadFunctionData(Data);
5161 FuncData^.Result:=ExtractFilePath(FuncData^.Param);
5162 Result:=true;
5163 end;
5164
MacroFuncExtractFileNamenull5165 function TDefineTree.MacroFuncExtractFileName(Data: Pointer): boolean;
5166 var
5167 FuncData: PReadFunctionData;
5168 begin
5169 FuncData:=PReadFunctionData(Data);
5170 FuncData^.Result:=ExtractFileName(FuncData^.Param);
5171 Result:=true;
5172 end;
5173
TDefineTree.MacroFuncExtractFileNameOnlynull5174 function TDefineTree.MacroFuncExtractFileNameOnly(Data: Pointer): boolean;
5175 var
5176 FuncData: PReadFunctionData;
5177 begin
5178 FuncData:=PReadFunctionData(Data);
5179 FuncData^.Result:=ExtractFileNameOnly(FuncData^.Param);
5180 Result:=true;
5181 end;
5182
5183 procedure TDefineTree.DoClearCache;
5184 begin
5185 {$IFDEF VerboseDefineCache}
5186 DebugLn('TDefineTree.DoClearCache A +++++++++');
5187 {$ENDIF}
5188 if FCache<>nil then FCache.FreeAndClear;
5189 if FVirtualDirCache<>nil then begin
5190 FVirtualDirCache.Free;
5191 FVirtualDirCache:=nil;
5192 end;
5193 IncreaseChangeStep;
5194 FDefineStrings.Clear;
5195 end;
5196
5197 procedure TDefineTree.DoPrepareTree;
5198 begin
5199 if Assigned(OnPrepareTree) then OnPrepareTree(Self);
5200 end;
5201
5202 procedure TDefineTree.RemoveMarked;
5203 begin
5204 if FFirstDefineTemplate=nil then exit;
5205 FFirstDefineTemplate.RemoveMarked(true,FFirstDefineTemplate);
5206 ClearCache;
5207 end;
5208
5209 procedure TDefineTree.MarkNonAutoCreated;
5210 begin
5211 if FFirstDefineTemplate=nil then exit;
5212 with FFirstDefineTemplate do begin
5213 // clear marks
5214 UnmarkNodes(true,true);
5215 // mark each non autocreated node
5216 MarkFlags([],[dtfAutoGenerated],true,true);
5217 // mark every parent with a marked child
5218 InheritMarks(true,true,false,true);
5219 end;
5220 end;
5221
TDefineTree.GetUnitPathForDirectorynull5222 function TDefineTree.GetUnitPathForDirectory(const Directory: string): string;
5223 var Evaluator: TExpressionEvaluator;
5224 begin
5225 Evaluator:=GetDefinesForDirectory(Directory,true);
5226 if Evaluator<>nil then begin
5227 Result:=Evaluator.Variables[UnitPathMacroName];
5228 end else begin
5229 Result:='';
5230 end;
5231 end;
5232
TDefineTree.GetIncludePathForDirectorynull5233 function TDefineTree.GetIncludePathForDirectory(const Directory: string
5234 ): string;
5235 var Evaluator: TExpressionEvaluator;
5236 begin
5237 Evaluator:=GetDefinesForDirectory(Directory,true);
5238 if Evaluator<>nil then begin
5239 Result:=Evaluator.Variables[IncludePathMacroName];
5240 end else begin
5241 Result:='';
5242 end;
5243 end;
5244
GetSrcPathForDirectorynull5245 function TDefineTree.GetSrcPathForDirectory(const Directory: string): string;
5246 var Evaluator: TExpressionEvaluator;
5247 begin
5248 Evaluator:=GetDefinesForDirectory(Directory,true);
5249 if Evaluator<>nil then begin
5250 Result:=Evaluator.Variables[SrcPathMacroName];
5251 end else begin
5252 Result:='';
5253 end;
5254 end;
5255
TDefineTree.GetPPUSrcPathForDirectorynull5256 function TDefineTree.GetPPUSrcPathForDirectory(const Directory: string
5257 ): string;
5258 var Evaluator: TExpressionEvaluator;
5259 begin
5260 Evaluator:=GetDefinesForDirectory(Directory,true);
5261 if Evaluator<>nil then begin
5262 Result:=Evaluator.Variables[PPUSrcPathMacroName];
5263 end else begin
5264 Result:='';
5265 end;
5266 end;
5267
TDefineTree.GetDCUSrcPathForDirectorynull5268 function TDefineTree.GetDCUSrcPathForDirectory(const Directory: string
5269 ): string;
5270 var Evaluator: TExpressionEvaluator;
5271 begin
5272 Evaluator:=GetDefinesForDirectory(Directory,true);
5273 if Evaluator<>nil then begin
5274 Result:=Evaluator.Variables[DCUSrcPathMacroName];
5275 end else begin
5276 Result:='';
5277 end;
5278 end;
5279
TDefineTree.GetCompiledSrcPathForDirectorynull5280 function TDefineTree.GetCompiledSrcPathForDirectory(const Directory: string
5281 ): string;
5282 var
5283 Evaluator: TExpressionEvaluator;
5284 begin
5285 Evaluator:=GetDefinesForDirectory(Directory,true);
5286 if Evaluator<>nil then begin
5287 Result:=Evaluator.Variables[CompiledSrcPathMacroName];
5288 end else begin
5289 Result:='';
5290 end;
5291 end;
5292
TDefineTree.GetDefinesForDirectorynull5293 function TDefineTree.GetDefinesForDirectory(
5294 const Path: string; WithVirtualDir: boolean): TExpressionEvaluator;
5295 var
5296 DirDef: TDirectoryDefines;
5297 begin
5298 DirDef:=GetDirDefinesForDirectory(Path,WithVirtualDir);
5299 if DirDef<>nil then
5300 Result:=DirDef.Values
5301 else
5302 Result:=nil;
5303 end;
5304
TDefineTree.GetDefinesForVirtualDirectorynull5305 function TDefineTree.GetDefinesForVirtualDirectory: TExpressionEvaluator;
5306 var
5307 DirDef: TDirectoryDefines;
5308 begin
5309 DirDef:=GetDirDefinesForVirtualDirectory;
5310 if DirDef<>nil then
5311 Result:=DirDef.Values
5312 else
5313 Result:=nil;
5314 end;
5315
5316 procedure TDefineTree.ReadValue(const DirDef: TDirectoryDefines;
5317 const PreValue, CurDefinePath: string; out NewValue: string);
5318 var
5319 Buffer: PChar;
5320 BufferPos: integer;
5321 BufferSize: integer;
5322 ValuePos: integer;
5323
SearchBracketClosenull5324 function SearchBracketClose(const s: string; Position:integer): integer;
5325 var BracketClose:char;
5326 sLen: Integer;
5327 begin
5328 if s[Position]='(' then
5329 BracketClose:=')'
5330 else
5331 BracketClose:='{';
5332 inc(Position);
5333 sLen:=length(s);
5334 while (Position<=sLen) and (s[Position]<>BracketClose) do begin
5335 if s[Position]=SpecialChar then
5336 inc(Position)
5337 else if (s[Position] in ['(','{']) then
5338 Position:=SearchBracketClose(s,Position);
5339 inc(Position);
5340 end;
5341 Result:=Position;
5342 end;
5343
ExecuteMacroFunctionnull5344 function ExecuteMacroFunction(const FuncName, Params: string): string;
5345 var
5346 FuncData: TReadFunctionData;
5347 begin
5348 FuncData.Param:=Params;
5349 FuncData.Result:='';
Charnull5350 FMacroFunctions.DoDataFunction(PChar(Pointer(FuncName)),length(FuncName),
5351 @FuncData);
5352 Result:=FuncData.Result;
5353 end;
5354
ExecuteMacroVariablenull5355 function ExecuteMacroVariable(var MacroVariable: string): boolean;
5356 var
5357 FuncData: TReadFunctionData;
5358 begin
5359 FuncData.Param:=MacroVariable;
5360 FuncData.Result:='';
5361 Result:=FMacroVariables.DoDataFunction(
PCharnull5362 PChar(Pointer(MacroVariable)),length(MacroVariable),@FuncData);
5363 if Result then
5364 MacroVariable:=FuncData.Result;
5365 end;
5366
5367 procedure GrowBuffer(MinSize: integer);
5368 var
5369 NewSize: Integer;
5370 begin
5371 if MinSize<=BufferSize then exit;
5372 NewSize:=MinSize*2+100;
5373 ReAllocMem(Buffer,NewSize);
5374 BufferSize:=NewSize;
5375 end;
5376
5377 procedure CopyStringToBuffer(const Src: string);
5378 begin
5379 if Src='' then exit;
5380 Move(Src[1],Buffer[BufferPos],length(Src));
5381 inc(BufferPos,length(Src));
5382 end;
5383
5384 procedure CopyFromValueToBuffer(Len: integer);
5385 begin
5386 if Len=0 then exit;
5387 Move(NewValue[ValuePos],Buffer[BufferPos],Len);
5388 inc(BufferPos,Len);
5389 inc(ValuePos,Len);
5390 end;
5391
Substitutenull5392 function Substitute(const CurValue: string; ValueLen: integer;
5393 MacroStart: integer; var MacroEnd: integer): boolean;
5394 var
5395 MacroFuncNameEnd: Integer;
5396 MacroFuncNameLen: Integer;
5397 MacroStr: String;
5398 MacroFuncName: String;
5399 NewMacroLen: Integer;
5400 MacroParam: string;
5401 OldMacroLen: Integer;
5402 Handled: Boolean;
5403 MacroVarName: String;
5404 begin
5405 Result:=false;
5406 MacroFuncNameEnd:=MacroEnd;
5407 MacroFuncNameLen:=MacroFuncNameEnd-MacroStart-1;
5408 MacroEnd:=SearchBracketClose(CurValue,MacroFuncNameEnd)+1;
5409 if MacroEnd>ValueLen+1 then exit;
5410 OldMacroLen:=MacroEnd-MacroStart;
5411 // Macro found
5412 if MacroFuncNameLen>0 then begin
5413 MacroFuncName:=copy(CurValue,MacroStart+1,MacroFuncNameLen);
5414 // Macro function -> substitute macro parameter first
5415 ReadValue(DirDef,copy(CurValue,MacroFuncNameEnd+1
5416 ,MacroEnd-MacroFuncNameEnd-2),CurDefinePath,MacroParam);
5417 // execute the macro function
5418 //debugln('Substitute MacroFuncName="',MacroFuncName,'" MacroParam="',MacroParam,'"');
acroFuncNamenull5419 MacroStr:=ExecuteMacroFunction(MacroFuncName,MacroParam);
5420 end else begin
5421 // Macro variable
5422 MacroVarName:=copy(CurValue,MacroStart+2,MacroEnd-MacroStart-3);
5423 MacroStr:=MacroVarName;
5424 //DebugLn('**** MacroVarName=',MacroVarName,' ',DirDef.Values.Variables[MacroVarName]);
5425 //DebugLn('DirDef.Values=',DirDef.Values.AsString);
5426 if MacroVarName=DefinePathMacroName then begin
5427 MacroStr:=CurDefinePath;
5428 end else if DirDef.Values.IsDefined(MacroVarName) then begin
5429 MacroStr:=DirDef.Values.Variables[MacroVarName];
5430 end else begin
5431 Handled:=false;
5432 if Assigned(FOnReadValue) then begin
5433 MacroParam:=MacroVarName;
5434 MacroStr:='';
5435 FOnReadValue(Self,MacroParam,MacroStr,Handled);
5436 end;
5437 if not Handled then begin
5438 MacroStr:=MacroVarName;
5439 Handled:=ExecuteMacroVariable(MacroStr);
5440 end;
5441 if not Handled then begin
5442 MacroStr:='';
5443 end;
5444 end;
5445 end;
5446 NewMacroLen:=length(MacroStr);
5447 GrowBuffer(BufferPos+NewMacroLen-OldMacroLen+ValueLen-ValuePos+1);
5448 // copy text between this macro and last macro
5449 CopyFromValueToBuffer(MacroStart-ValuePos);
5450 // copy macro value to buffer
5451 CopyStringToBuffer(MacroStr);
5452 ValuePos:=MacroEnd;
5453 Result:=true;
5454 end;
5455
5456 procedure SetNewValue;
5457 var
5458 RestLen: Integer;
5459 begin
5460 if Buffer=nil then exit;
5461 // write rest to buffer
5462 RestLen:=length(NewValue)-ValuePos+1;
5463 if RestLen>0 then begin
5464 GrowBuffer(BufferPos+RestLen);
5465 Move(NewValue[ValuePos],Buffer[BufferPos],RestLen);
5466 inc(BufferPos,RestLen);
5467 end;
5468 // copy the buffer into NewValue
5469 //DebugLn(' [ReadValue] Old="',copy(NewValue,1,100),'"');
5470 SetLength(NewValue,BufferPos);
5471 if BufferPos>0 then
5472 Move(Buffer^,NewValue[1],BufferPos);
5473 //DebugLn(' [ReadValue] New="',copy(NewValue,1,100),'"');
5474 // clean up
5475 FreeMem(Buffer);
5476 Buffer:=nil;
5477 end;
5478
5479 var MacroStart,MacroEnd: integer;
5480 ValueLen: Integer;
5481 begin
5482 // DebugLn(' [ReadValue] A "',copy(PreValue,1,100),'"');
5483 NewValue:=PreValue;
5484 if NewValue='' then exit;
5485 MacroStart:=1;
5486 ValueLen:=length(NewValue);
5487 Buffer:=nil;
5488 BufferSize:=0;
5489 BufferPos:=0; // position in buffer
5490 ValuePos:=1; // same position in value
5491 while MacroStart<=ValueLen do begin
5492 // search for macro
5493 while (MacroStart<=ValueLen) and (NewValue[MacroStart]<>'$') do begin
5494 if (NewValue[MacroStart]=SpecialChar) then inc(MacroStart);
5495 inc(MacroStart);
5496 end;
5497 if MacroStart>ValueLen then break;
namenull5498 // read macro function name
5499 MacroEnd:=MacroStart+1;
5500 while (MacroEnd<=ValueLen)
5501 and (NewValue[MacroEnd] in ['0'..'9','A'..'Z','a'..'z','_']) do
5502 inc(MacroEnd);
5503 // read macro name / parameters
5504 if (MacroEnd<ValueLen) and (NewValue[MacroEnd] in ['(','{']) then
5505 begin
5506 if not Substitute(NewValue,ValueLen,MacroStart,MacroEnd) then break;
5507 end;
5508 MacroStart:=MacroEnd;
5509 end;
5510 if Buffer<>nil then SetNewValue;
5511 end;
5512
5513 procedure TDefineTree.MarkTemplatesOwnedBy(TheOwner: TObject; const MustFlags,
5514 NotFlags: TDefineTemplateFlags);
5515 begin
5516 if FFirstDefineTemplate=nil then exit;
5517 with FFirstDefineTemplate do begin
5518 // unmark all nodes
5519 UnmarkNodes(true,true);
5520 // mark each node in filter
5521 MarkOwnedBy(TheOwner,MustFlags,NotFlags,true,true);
5522 // mark every parent, that has a marked child
5523 InheritMarks(true,true,false,true);
5524 end;
5525 end;
5526
5527 procedure TDefineTree.RemoveTemplatesOwnedBy(TheOwner: TObject;
5528 const MustFlags, NotFlags: TDefineTemplateFlags);
5529 begin
5530 if FFirstDefineTemplate=nil then exit;
5531 FFirstDefineTemplate.RemoveLeaves(TheOwner,MustFlags,NotFlags,true,
5532 FFirstDefineTemplate);
5533 FFirstDefineTemplate.RemoveOwner(TheOwner,true);
5534 ClearCache;
5535 end;
5536
ExtractTemplatesOwnedBynull5537 function TDefineTree.ExtractTemplatesOwnedBy(TheOwner: TObject;
5538 const MustFlags, NotFlags: TDefineTemplateFlags): TDefineTemplate;
5539 begin
5540 Result:=nil;
5541 if FFirstDefineTemplate=nil then exit;
5542 MarkTemplatesOwnedBy(TheOwner,MustFlags,NotFlags);
5543 with FFirstDefineTemplate do begin
5544 // store some information, so that merging the nodes will result in old order
5545 CreateMergeInfo(true,false);
5546 // extract marked nodes
5547 Result:=CreateCopy(true,true,true);
5548 end;
5549 end;
5550
ExtractNonAutoCreatednull5551 function TDefineTree.ExtractNonAutoCreated: TDefineTemplate;
5552 begin
5553 Result:=nil;
5554 if FFirstDefineTemplate=nil then exit;
5555 MarkNonAutoCreated;
5556 with FFirstDefineTemplate do begin
5557 // store some information, so that merging the nodes will result in old order
5558 CreateMergeInfo(true,false);
5559 // extract marked nodes
5560 Result:=CreateCopy(true,true,true);
5561 end;
5562 end;
5563
5564 procedure TDefineTree.MergeTemplates(SourceTemplate: TDefineTemplate;
5565 const NewNamePrefix: string);
5566 var
5567 LastDefTempl: TDefineTemplate;
5568 begin
5569 LastDefTempl:=GetLastRootTemplate;
5570 TDefineTemplate.MergeTemplates(nil,FFirstDefineTemplate,LastDefTempl,
5571 SourceTemplate,true,NewNamePrefix);
5572 ClearCache;
5573 end;
5574
TDefineTree.Calculatenull5575 function TDefineTree.Calculate(DirDef: TDirectoryDefines): boolean;
5576 // calculates the values for a single directory
5577 // returns false on error
5578 var
5579 ExpandedDirectory, EvalResult, TempValue: string;
5580
5581 procedure CalculateTemplate(DefTempl: TDefineTemplate; const CurPath: string);
5582
5583 procedure CalculateIfChildren;
5584 begin
5585 // execute children
5586 CalculateTemplate(DefTempl.FirstChild,CurPath);
5587 // jump to end of else templates
5588 while (DefTempl.Next<>nil)
5589 and (DefTempl.Next.Action in [da_Else,da_ElseIf])
5590 do begin
5591 if Assigned(OnCalculate) then
5592 OnCalculate(Self,DefTempl,false,'',false,'',false);
5593 DefTempl:=DefTempl.Next;
5594 end;
5595 end;
5596
5597 // procedure CalculateTemplate(DefTempl: TDefineTemplate; const CurPath: string);
5598 var SubPath, TempValue: string;
5599 VarName: string;
5600 begin
5601 while DefTempl<>nil do begin
5602 //DebugLn(' [CalculateTemplate] CurPath="',CurPath,'" DefTempl.Name="',DefTempl.Name,'"');
5603 case DefTempl.Action of
5604 da_Block:
5605 // calculate children
5606 begin
5607 if Assigned(OnCalculate) then
5608 OnCalculate(Self,DefTempl,false,'',false,'',true);
5609 CalculateTemplate(DefTempl.FirstChild,CurPath);
5610 end;
5611
5612 da_Define:
5613 // Define for a single Directory (not SubDirs)
5614 begin
5615 if FilenameIsMatching(CurPath,ExpandedDirectory,true) then begin
5616 ReadValue(DirDef,DefTempl.Value,CurPath,TempValue);
5617 if Assigned(OnCalculate) then
5618 OnCalculate(Self,DefTempl,true,TempValue,false,'',true);
5619 ReadValue(DirDef,DefTempl.Variable,CurPath,VarName);
5620 DirDef.Values.Variables[VarName]:=TempValue;
5621 end else begin
5622 if Assigned(OnCalculate) then
5623 OnCalculate(Self,DefTempl,false,'',false,'',false);
5624 end;
5625 end;
5626
5627 da_DefineRecurse:
5628 // Define for current and sub directories
5629 begin
5630 ReadValue(DirDef,DefTempl.Value,CurPath,TempValue);
5631 if Assigned(OnCalculate) then
5632 OnCalculate(Self,DefTempl,true,TempValue,false,'',true);
5633 ReadValue(DirDef,DefTempl.Variable,CurPath,VarName);
5634 DirDef.Values.Variables[VarName]:=TempValue;
5635 end;
5636
5637 da_Undefine:
5638 // Undefine for a single Directory (not SubDirs)
5639 if FilenameIsMatching(CurPath,ExpandedDirectory,true) then begin
5640 if Assigned(OnCalculate) then
5641 OnCalculate(Self,DefTempl,false,'',false,'',true);
5642 ReadValue(DirDef,DefTempl.Variable,CurPath,VarName);
5643 DirDef.Values.Undefine(VarName);
5644 end else begin
5645 if Assigned(OnCalculate) then
5646 OnCalculate(Self,DefTempl,false,'',false,'',false);
5647 end;
5648
5649 da_UndefineRecurse:
5650 // Undefine for current and sub directories
5651 begin
5652 if Assigned(OnCalculate) then
5653 OnCalculate(Self,DefTempl,false,'',false,'',true);
5654 ReadValue(DirDef,DefTempl.Variable,CurPath,VarName);
5655 DirDef.Values.Undefine(VarName);
5656 end;
5657
5658 da_UndefineAll:
5659 // Undefine every value for current and sub directories
5660 begin
5661 if Assigned(OnCalculate) then
5662 OnCalculate(Self,DefTempl,false,'',false,'',true);
5663 DirDef.Values.Clear;
5664 end;
5665
5666 da_If, da_ElseIf:
5667 begin
5668 // test expression in value
5669 ReadValue(DirDef,DefTempl.Value,CurPath,TempValue);
5670 EvalResult:=DirDef.Values.Eval(TempValue,true);
5671 if Assigned(OnCalculate) then
5672 OnCalculate(Self,DefTempl,true,TempValue,true,EvalResult,EvalResult='1');
5673 //debugln('da_If,da_ElseIf: DefTempl.Value="',DbgStr(DefTempl.Value),'" CurPath="',CurPath,'" TempValue="',TempValue,'" EvalResult=',EvalResult);
5674 if DirDef.Values.ErrorPosition>=0 then begin
5675 FErrorDescription:=Format(ctsSyntaxErrorInExpr,[TempValue]);
5676 FErrorTemplate:=DefTempl;
5677 //debugln(['CalculateTemplate "',FErrorDescription,'"']);
5678 end else if EvalResult='1' then
5679 CalculateIfChildren;
5680 end;
5681 da_IfDef,da_IfNDef:
5682 // test if variable is defined
5683 begin
5684 //DebugLn('da_IfDef A Name=',DefTempl.Name,
5685 // ' Variable=',DefTempl.Variable,
5686 // ' Is=',dbgs(DirDef.Values.IsDefined(DefTempl.Variable)),
5687 // ' CurPath="',CurPath,'"',
5688 // ' Values.Count=',dbgs(DirDef.Values.Count));
5689 ReadValue(DirDef,DefTempl.Variable,CurPath,VarName);
5690 if DirDef.Values.IsDefined(VarName)=(DefTempl.Action=da_IfDef) then begin
5691 if Assigned(OnCalculate) then
5692 OnCalculate(Self,DefTempl,false,'',false,'',true);
5693 CalculateIfChildren;
5694 end else begin
5695 if Assigned(OnCalculate) then
5696 OnCalculate(Self,DefTempl,false,'',false,'',false);
5697 end;
5698 end;
5699
5700 da_Else:
5701 // execute children
5702 begin
5703 if Assigned(OnCalculate) then
5704 OnCalculate(Self,DefTempl,false,'',false,'',true);
5705 CalculateTemplate(DefTempl.FirstChild,CurPath);
5706 end;
5707
5708 da_Directory:
5709 begin
5710 // template for a sub directory
5711 ReadValue(DirDef,DefTempl.Value,CurPath,TempValue);
5712 // Note: CurPath can be ''
5713 SubPath:=AppendPathDelim(CurPath)+TempValue;
5714 // test if ExpandedDirectory is part of SubPath
5715 if (SubPath<>'') and FilenameIsMatching(SubPath,ExpandedDirectory,false)
5716 then begin
5717 if Assigned(OnCalculate) then
5718 OnCalculate(Self,DefTempl,true,SubPath,false,'',true);
5719 CalculateTemplate(DefTempl.FirstChild,SubPath);
5720 end else begin
5721 if Assigned(OnCalculate) then
5722 OnCalculate(Self,DefTempl,true,SubPath,false,'',false);
5723 end;
5724 end;
5725 end;
5726 if ErrorTemplate<>nil then exit;
5727 if DefTempl<>nil then
5728 DefTempl:=DefTempl.Next;
5729 end;
5730 end;
5731
TDefineTree.Calculatenull5732 // function TDefineTree.Calculate(DirDef: TDirectoryDefines): boolean;
5733 begin
5734 {$IFDEF VerboseDefineCache}
5735 DebugLn('[TDefineTree.Calculate] ++++++ "',DirDef.Path,'"');
5736 {$ENDIF}
5737 Result:=true;
5738 FErrorTemplate:=nil;
5739 ExpandedDirectory:=DirDef.Path;
5740 if (ExpandedDirectory=VirtualDirectory)
5741 and Assigned(OnGetVirtualDirectoryAlias) then
5742 OnGetVirtualDirectoryAlias(Self,ExpandedDirectory);
5743 if (ExpandedDirectory<>VirtualDirectory) then begin
5744 ReadValue(DirDef,ExpandedDirectory,'',TempValue);
5745 ExpandedDirectory:=TempValue;
5746 end;
5747 DirDef.Values.Clear;
5748 // compute the result of all matching DefineTemplates
5749 CalculateTemplate(FFirstDefineTemplate,'');
5750 if (ExpandedDirectory=VirtualDirectory)
5751 and (Assigned(OnGetVirtualDirectoryDefines)) then
5752 OnGetVirtualDirectoryDefines(Self,DirDef);
5753 Result:=(ErrorTemplate=nil);
5754 end;
5755
5756 procedure TDefineTree.IncreaseChangeStep;
5757 begin
5758 CTIncreaseChangeStamp(FChangeStep);
5759 if DirectoryCachePool<>nil then DirectoryCachePool.IncreaseConfigTimeStamp;
5760 end;
5761
5762 procedure TDefineTree.SetDirectoryCachePool(const AValue: TCTDirectoryCachePool);
5763 begin
5764 if FDirectoryCachePool=AValue then exit;
5765 FDirectoryCachePool:=AValue;
5766 end;
5767
5768 procedure TDefineTree.RemoveDoubles(Defines: TDirectoryDefines);
5769 // use only one copy of each ansistring
5770 begin
5771 if Defines=nil then exit;
5772 Defines.Values.RemoveDoubles(@FDefineStrings.ReplaceString);
5773 end;
5774
5775 procedure TDefineTree.Add(ADefineTemplate: TDefineTemplate);
5776 // add as last
5777 var LastDefTempl: TDefineTemplate;
5778 begin
5779 if ADefineTemplate=nil then exit;
5780 if RootTemplate=nil then
5781 RootTemplate:=ADefineTemplate
5782 else begin
5783 // add as last
5784 LastDefTempl:=RootTemplate;
5785 while LastDefTempl.Next<>nil do
5786 LastDefTempl:=LastDefTempl.Next;
5787 ADefineTemplate.InsertBehind(LastDefTempl);
5788 end;
5789 ClearCache;
5790 end;
5791
5792 procedure TDefineTree.AddFirst(ADefineTemplate: TDefineTemplate);
5793 // add as first
5794 begin
5795 if ADefineTemplate=nil then exit;
5796 if RootTemplate=nil then
5797 RootTemplate:=ADefineTemplate
5798 else begin
5799 RootTemplate.InsertBehind(ADefineTemplate);
5800 RootTemplate:=ADefineTemplate;
5801 end;
5802 ClearCache;
5803 end;
5804
5805 procedure TDefineTree.MoveToLast(ADefineTemplate: TDefineTemplate);
5806 begin
5807 if (ADefineTemplate.Next=nil) and (ADefineTemplate.Parent=nil) then exit;
5808 ADefineTemplate.Unbind;
5809 if FFirstDefineTemplate=ADefineTemplate then FFirstDefineTemplate:=nil;
5810 Add(ADefineTemplate);
5811 end;
5812
FindDefineTemplateByNamenull5813 function TDefineTree.FindDefineTemplateByName(
5814 const AName: string; OnlyRoots: boolean): TDefineTemplate;
5815 begin
5816 Result:=RootTemplate;
5817 if RootTemplate<>nil then
5818 Result:=RootTemplate.FindByName(AName,not OnlyRoots,true)
5819 else
5820 Result:=nil;
5821 end;
5822
5823 procedure TDefineTree.ReplaceRootSameName(const Name: string;
5824 ADefineTemplate: TDefineTemplate);
5825 // if there is a DefineTemplate with the same name then replace it
5826 // else add as last
5827 var OldDefineTemplate: TDefineTemplate;
5828 begin
5829 if (Name='') then exit;
5830 OldDefineTemplate:=FindDefineTemplateByName(Name,true);
5831 if OldDefineTemplate<>nil then begin
5832 if not OldDefineTemplate.IsEqual(ADefineTemplate,true,false) then begin
5833 ClearCache;
5834 end;
5835 if ADefineTemplate<>nil then
5836 ADefineTemplate.InsertBehind(OldDefineTemplate);
5837 if OldDefineTemplate=FFirstDefineTemplate then
5838 FFirstDefineTemplate:=FFirstDefineTemplate.Next;
5839 OldDefineTemplate.Unbind;
5840 OldDefineTemplate.Free;
5841 end else
5842 Add(ADefineTemplate);
5843 end;
5844
5845 procedure TDefineTree.RemoveRootDefineTemplateByName(const AName: string);
5846 var ADefTempl: TDefineTemplate;
5847 begin
5848 ADefTempl:=FindDefineTemplateByName(AName,true);
5849 if ADefTempl<>nil then RemoveDefineTemplate(ADefTempl);
5850 end;
5851
5852 procedure TDefineTree.RemoveDefineTemplate(ADefTempl: TDefineTemplate);
5853 var
5854 HadDefines: Boolean;
5855 begin
5856 if ADefTempl=FFirstDefineTemplate then
5857 FFirstDefineTemplate:=FFirstDefineTemplate.Next;
5858 HadDefines:=ADefTempl.HasDefines(false,false);
5859 ADefTempl.Unbind;
5860 ADefTempl.Free;
5861 if HadDefines then ClearCache;
5862 end;
5863
5864 procedure TDefineTree.ReplaceChild(ParentTemplate,
5865 NewDefineTemplate: TDefineTemplate; const ChildName: string);
5866 // if there is a DefineTemplate with the same name then replace it
5867 // else add as last
5868 var OldDefineTemplate: TDefineTemplate;
5869 begin
5870 if (ChildName='') or (ParentTemplate=nil) then exit;
5871 OldDefineTemplate:=ParentTemplate.FindChildByName(ChildName);
5872 if OldDefineTemplate<>nil then begin
5873 if not OldDefineTemplate.IsEqual(NewDefineTemplate,true,false) then begin
5874 ClearCache;
5875 end;
5876 if NewDefineTemplate<>nil then
5877 NewDefineTemplate.InsertBehind(OldDefineTemplate);
5878 if OldDefineTemplate=FFirstDefineTemplate then
5879 FFirstDefineTemplate:=FFirstDefineTemplate.Next;
5880 OldDefineTemplate.Unbind;
5881 OldDefineTemplate.Free;
5882 end else begin
5883 ClearCache;
5884 ParentTemplate.AddChild(NewDefineTemplate);
5885 end;
5886 end;
5887
5888 procedure TDefineTree.AddChild(ParentTemplate,
5889 NewDefineTemplate: TDefineTemplate);
5890 begin
5891 ClearCache;
5892 ParentTemplate.AddChild(NewDefineTemplate);
5893 end;
5894
5895 procedure TDefineTree.ReplaceRootSameName(ADefineTemplate: TDefineTemplate);
5896 begin
5897 if (ADefineTemplate=nil) then exit;
5898 ReplaceRootSameName(ADefineTemplate.Name,ADefineTemplate);
5899 end;
5900
5901 procedure TDefineTree.ReplaceRootSameNameAddFirst(
5902 ADefineTemplate: TDefineTemplate);
5903 var OldDefineTemplate: TDefineTemplate;
5904 begin
5905 if ADefineTemplate=nil then exit;
5906 OldDefineTemplate:=FindDefineTemplateByName(ADefineTemplate.Name,true);
5907 if OldDefineTemplate<>nil then begin
5908 if not OldDefineTemplate.IsEqual(ADefineTemplate,true,false) then begin
5909 ClearCache;
5910 end;
5911 ADefineTemplate.InsertBehind(OldDefineTemplate);
5912 if OldDefineTemplate=FFirstDefineTemplate then
5913 FFirstDefineTemplate:=FFirstDefineTemplate.Next;
5914 OldDefineTemplate.Unbind;
5915 OldDefineTemplate.Free;
5916 end else
5917 AddFirst(ADefineTemplate);
5918 end;
5919
5920 procedure TDefineTree.MergeDefineTemplates(SourceTemplate: TDefineTemplate;
5921 const NewNamePrefix: string);
5922 var
5923 LastDefTempl: TDefineTemplate;
5924 begin
5925 if SourceTemplate=nil then exit;
5926 // import new defines
5927 LastDefTempl:=GetLastRootTemplate;
5928 TDefineTemplate.MergeTemplates(nil,FFirstDefineTemplate,LastDefTempl,
5929 SourceTemplate,true,NewNamePrefix);
5930 ClearCache;
5931 end;
5932
5933 procedure TDefineTree.ConsistencyCheck;
5934 begin
5935 if FFirstDefineTemplate<>nil then
5936 FFirstDefineTemplate.ConsistencyCheck;
5937 FCache.ConsistencyCheck;
5938 end;
5939
5940 procedure TDefineTree.CalcMemSize(Stats: TCTMemStats);
5941 var
5942 Node: TAVLTreeNode;
5943 begin
5944 Stats.Add('TDefineTree',PtrUInt(InstanceSize)
5945 +MemSizeString(FErrorDescription)
5946 );
5947 if FMacroFunctions<>nil then
5948 Stats.Add('TDefineTree.FMacroFunctions',FMacroFunctions.CalcMemSize);
5949 if FMacroVariables<>nil then
5950 Stats.Add('TDefineTree.FMacroVariables',FMacroVariables.CalcMemSize);
5951 if FFirstDefineTemplate<>nil then
5952 FFirstDefineTemplate.CalcMemSize(Stats);
5953 if FVirtualDirCache<>nil then
5954 FVirtualDirCache.CalcMemSize(Stats);
5955 if FDefineStrings<>nil then
5956 Stats.Add('TDefineTree.FDefineStrings',FDefineStrings.CalcMemSize);
5957 if FCache<>nil then begin
5958 Stats.Add('TDefineTree.FCache.Count',FCache.Count);
5959 Node:=FCache.FindLowest;
5960 while Node<>nil do begin
5961 TDirectoryDefines(Node.Data).CalcMemSize(Stats);
5962 Node:=FCache.FindSuccessor(Node);
5963 end;
5964 end;
5965 end;
5966
5967 procedure TDefineTree.WriteDebugReport;
5968 begin
5969 DebugLn('TDefineTree.WriteDebugReport');
5970 if FFirstDefineTemplate<>nil then
5971 FFirstDefineTemplate.WriteDebugReport(false)
5972 else
5973 DebugLn(' No templates defined');
5974 DebugLn(FCache.ReportAsString);
5975 DebugLn('');
5976 ConsistencyCheck;
5977 end;
5978
5979
5980 { TDefinePool }
5981
5982 constructor TDefinePool.Create;
5983 begin
5984 inherited Create;
5985 FItems:=TFPList.Create;
5986 end;
5987
5988 destructor TDefinePool.Destroy;
5989 begin
5990 Clear;
5991 FItems.Free;
5992 inherited Destroy;
5993 end;
5994
5995 procedure TDefinePool.Clear;
5996 var i: integer;
5997 begin
5998 for i:=0 to Count-1 do begin
5999 Items[i].Clear(true);
6000 Items[i].Free;
6001 end;
6002 FItems.Clear;
6003 end;
6004
TDefinePool.GetItemsnull6005 function TDefinePool.GetItems(Index: integer): TDefineTemplate;
6006 begin
6007 Result:=TDefineTemplate(FItems[Index]);
6008 end;
6009
6010 procedure TDefinePool.SetEnglishErrorMsgFilename(const AValue: string);
6011 begin
6012 if FEnglishErrorMsgFilename=AValue then exit;
6013 FEnglishErrorMsgFilename:=AValue;
6014 end;
6015
CheckAbortnull6016 function TDefinePool.CheckAbort(ProgressID, MaxIndex: integer;
6017 const Msg: string): boolean;
6018 begin
6019 Result:=false;
6020 if Assigned(OnProgress) then
6021 OnProgress(Self,ProgressID,MaxIndex,Msg,Result);
6022 end;
6023
6024 procedure TDefinePool.Add(ADefineTemplate: TDefineTemplate);
6025 begin
6026 if ADefineTemplate<>nil then
6027 FItems.Add(ADefineTemplate);
6028 end;
6029
6030 procedure TDefinePool.Insert(Index: integer; ADefineTemplate: TDefineTemplate);
6031 begin
6032 FItems.Insert(Index,ADefineTemplate);
6033 end;
6034
6035 procedure TDefinePool.Delete(Index: integer);
6036 begin
6037 Items[Index].Clear(true);
6038 Items[Index].Free;
6039 FItems.Delete(Index);
6040 end;
6041
6042 procedure TDefinePool.Move(SrcIndex, DestIndex: integer);
6043 begin
6044 FItems.Move(SrcIndex,DestIndex);
6045 end;
6046
TDefinePool.Countnull6047 function TDefinePool.Count: integer;
6048 begin
6049 Result:=FItems.Count;
6050 end;
6051
CreateFPCTemplatenull6052 function TDefinePool.CreateFPCTemplate(
6053 const CompilerPath, CompilerOptions, TestPascalFile: string;
6054 out UnitSearchPath, TargetOS, aTargetCPU: string;
6055 Owner: TObject): TDefineTemplate;
6056 // create symbol definitions for the freepascal compiler
6057 // To get reliable values the compiler itself is asked for
6058 var
6059 LastDefTempl: TDefineTemplate;
6060
6061 procedure AddTemplate(NewDefTempl: TDefineTemplate);
6062 begin
6063 if NewDefTempl=nil then exit;
6064 if LastDefTempl<>nil then
6065 NewDefTempl.InsertBehind(LastDefTempl);
6066 LastDefTempl:=NewDefTempl;
6067 end;
6068
FindSymbolnull6069 function FindSymbol(const SymbolName: string): TDefineTemplate;
6070 begin
6071 Result:=LastDefTempl;
6072 while (Result<>nil)
6073 and (Comparetext(Result.Variable,SymbolName)<>0) do
6074 Result:=Result.Prior;
6075 end;
6076
6077 procedure DefineSymbol(const SymbolName, SymbolValue: string;
6078 const Description: string = '');
6079 var NewDefTempl: TDefineTemplate;
6080 Desc: String;
6081 begin
6082 NewDefTempl:=FindSymbol(SymbolName);
6083 if NewDefTempl=nil then begin
6084 if Description<>'' then
6085 Desc:=Description
6086 else
6087 Desc:=ctsDefaultFPCSymbol;
6088 NewDefTempl:=TDefineTemplate.Create('Define '+SymbolName,
6089 Desc,SymbolName,SymbolValue,da_DefineRecurse);
6090 AddTemplate(NewDefTempl);
6091 end else begin
6092 NewDefTempl.Value:=SymbolValue;
6093 end;
6094 end;
6095
6096 procedure UndefineSymbol(const SymbolName: string);
6097 var
6098 ADefTempl: TDefineTemplate;
6099 begin
6100 ADefTempl:=FindSymbol(SymbolName);
6101 if ADefTempl=nil then exit;
6102 if LastDefTempl=ADefTempl then LastDefTempl:=ADefTempl.Prior;
6103 ADefTempl.Unbind;
6104 ADefTempl.Free;
6105 end;
6106
6107 procedure ProcessOutputLine(var Line: string);
6108 var
6109 SymbolName, SymbolValue, UpLine, NewPath: string;
6110 i, len, curpos: integer;
6111 begin
6112 len := length(Line);
6113 if len <= 6 then Exit; // shortest match
6114
6115 CurPos := 1;
6116 // strip timestamp e.g. [0.306]
6117 if Line[CurPos] = '[' then begin
6118 repeat
6119 inc(CurPos);
6120 if CurPos > len then Exit;
6121 until line[CurPos] = ']';
6122 Inc(CurPos, 2); // skip space too
6123 if len - CurPos < 6 then Exit; // shortest match
6124 end;
6125
6126 UpLine:=UpperCaseStr(Line);
6127 //DebugLn(['ProcessOutputLine ',Line]);
6128
6129 case UpLine[CurPos] of
6130 'M':
6131 if StrLComp(@UpLine[CurPos], 'MACRO ', 6) = 0 then begin
6132 // no macro
6133 Inc(CurPos, 6);
6134
6135 if (StrLComp(@UpLine[CurPos], 'DEFINED: ', 9) = 0) then begin
6136 Inc(CurPos, 9);
6137 SymbolName:=copy(UpLine, CurPos, len);
6138 DefineSymbol(SymbolName,'');
6139 Exit;
6140 end;
6141
6142 if (StrLComp(@UpLine[CurPos], 'UNDEFINED: ', 11) = 0) then begin
6143 Inc(CurPos, 11);
6144 SymbolName:=copy(UpLine,CurPos,len);
6145 UndefineSymbol(SymbolName);
6146 Exit;
6147 end;
6148
6149 // MACRO something...
6150 i := CurPos;
6151 while (i <= len) and (Line[i]<>' ') do inc(i);
6152 SymbolName:=copy(UpLine,CurPos,i-CurPos);
6153 CurPos := i + 1; // skip space
6154
6155 if StrLComp(@UpLine[CurPos], 'SET TO ', 7) = 0 then begin
6156 Inc(CurPos, 7);
6157 SymbolValue:=copy(Line, CurPos, len);
6158 DefineSymbol(SymbolName, SymbolValue);
6159 end;
6160 end;
6161 'U':
6162 if (StrLComp(@UpLine[CurPos], 'USING UNIT PATH: ', 17) = 0) then begin
6163 Inc(CurPos, 17);
6164 NewPath:=copy(Line,CurPos,len);
6165 if not FilenameIsAbsolute(NewPath) then
6166 NewPath:=ExpandFileNameUTF8(NewPath);
6167 {$IFDEF VerboseFPCSrcScan}
6168 DebugLn('Using unit path: "',NewPath,'"');
6169 {$ENDIF}
6170 UnitSearchPath:=UnitSearchPath+NewPath+';';
6171 end;
6172 end;
6173 end;
6174
6175 var
6176 i, OutLen, LineStart: integer;
6177 TheProcess: TProcessUTF8;
6178 OutputLine, Buf: String;
6179 NewDefTempl: TDefineTemplate;
6180 SrcOS: string;
6181 SrcOS2: String;
6182 Step: String;
6183 Params: TStringListUTF8;
6184 begin
6185 Result:=nil;
6186 //DebugLn('TDefinePool.CreateFPCTemplate PPC386Path="',CompilerPath,'" FPCOptions="',CompilerOptions,'"');
6187 if TestPascalFile='' then begin
6188 DebugLn(['Warning: [TDefinePool.CreateFPCTemplate] TestPascalFile empty']);
6189 end;
6190 UnitSearchPath:='';
6191 TargetOS:='';
6192 SrcOS:='';
6193 aTargetCPU:='';
6194 if (CompilerPath='') or (not FileIsExecutable(CompilerPath)) then exit;
6195 LastDefTempl:=nil;
6196 // find all initial compiler macros and all unit paths
6197 // -> ask compiler with the -va switch
6198 SetLength(Buf,1024);
6199 Step:='Init';
6200 try
6201 Params:=TStringListUTF8.Create;
6202 TheProcess := TProcessUTF8.Create(nil);
6203 try
6204 TheProcess.Executable:=CompilerPath;
6205 Params.Add('-va');
6206 if (Pos('pas2js',lowercase(ExtractFileName(CompilerPath)))<1)
6207 and FileExistsCached(EnglishErrorMsgFilename) then
6208 Params.Add('-Fr'+EnglishErrorMsgFilename);
6209 if CompilerOptions<>'' then
6210 SplitCmdLineParams(CompilerOptions,Params,true);
6211 Params.Add(TestPascalFile);
6212 //DebugLn('TDefinePool.CreateFPCTemplate Params="',MergeCmdLineParams(Params),'"');
6213 TheProcess.Parameters:=Params;
6214 TheProcess.Options:= [poUsePipes, poStdErrToOutPut];
6215 TheProcess.ShowWindow := swoHide;
6216 Step:='Running '+MergeCmdLineParams(Params);
6217 TheProcess.Execute;
6218 OutputLine:='';
6219 repeat
6220 if (TheProcess.Output<>nil) then begin
6221 OutLen:=TheProcess.Output.Read(Buf[1],length(Buf));
6222 end else
6223 OutLen:=0;
6224 LineStart:=1;
6225 i:=1;
6226 while i<=OutLen do begin
6227 if Buf[i] in [#10,#13] then begin
6228 OutputLine:=OutputLine+copy(Buf,LineStart,i-LineStart);
6229 ProcessOutputLine(OutputLine);
6230 OutputLine:='';
6231 if (i<OutLen) and (Buf[i+1] in [#10,#13]) and (Buf[i]<>Buf[i+1])
6232 then
6233 inc(i);
6234 LineStart:=i+1;
6235 end;
6236 inc(i);
6237 end;
6238 OutputLine:=copy(Buf,LineStart,OutLen-LineStart+1);
6239 until OutLen=0;
6240 TheProcess.WaitOnExit;
6241 finally
6242 //DebugLn('TDefinePool.CreateFPCTemplate Run with -va: OutputLine="',OutputLine,'"');
6243 TheProcess.Free;
6244 Params.Free;
6245 end;
6246 DefineSymbol(FPCUnitPathMacroName,UnitSearchPath,'FPC default unit search path');
6247
6248 //DebugLn('TDefinePool.CreateFPCTemplate First done UnitSearchPath="',UnitSearchPath,'"');
6249
6250 // ask for target operating system -> ask compiler with switch -iTO
6251 Params:=TStringListUTF8.Create;
6252 TheProcess := TProcessUTF8.Create(nil);
6253 try
6254 TheProcess.Executable:=CompilerPath;
6255 if CompilerOptions<>'' then
6256 SplitCmdLineParams(CompilerOptions,Params,true);
6257 Params.Add('-iTO');
6258 TheProcess.Parameters:=Params;
6259 TheProcess.Options:= [poUsePipes, poStdErrToOutPut];
6260 TheProcess.ShowWindow := swoHide;
6261 Step:='Running '+MergeCmdLineParams(Params);
6262 TheProcess.Execute;
6263 if (TheProcess.Output<>nil) then
6264 OutLen:=TheProcess.Output.Read(Buf[1],length(Buf))
6265 else
6266 OutLen:=0;
6267 i:=1;
6268 while i<=OutLen do begin
6269 if Buf[i] in [#10,#13] then begin
6270 // define #TargetOS
6271 TargetOS:=copy(Buf,1,i-1);
6272 NewDefTempl:=TDefineTemplate.Create('Define TargetOS',
6273 ctsDefaultFPCTargetOperatingSystem,
6274 ExternalMacroStart+'TargetOS',TargetOS,da_DefineRecurse);
6275 AddTemplate(NewDefTempl);
6276 // define #SrcOS
6277 SrcOS:=GetDefaultSrcOSForTargetOS(TargetOS);
6278 if SrcOS='' then SrcOS:=TargetOS;
6279 NewDefTempl:=TDefineTemplate.Create('Define SrcOS',
6280 ctsDefaultFPCSourceOperatingSystem,
6281 ExternalMacroStart+'SrcOS',SrcOS,da_DefineRecurse);
6282 AddTemplate(NewDefTempl);
6283 // define #SrcOS2
6284 SrcOS2:=GetDefaultSrcOS2ForTargetOS(TargetOS);
6285 if SrcOS2='' then SrcOS2:=TargetOS;
6286 NewDefTempl:=TDefineTemplate.Create('Define SrcOS2',
6287 ctsDefaultFPCSource2OperatingSystem,
6288 ExternalMacroStart+'SrcOS2',SrcOS2,da_DefineRecurse);
6289 AddTemplate(NewDefTempl);
6290 break;
6291 end;
6292 inc(i);
6293 end;
6294 TheProcess.WaitOnExit;
6295 //DebugLn('TDefinePool.CreateFPCTemplate target OS done');
6296 finally
6297 //DebugLn('TDefinePool.CreateFPCTemplate Run with -iTO: OutputLine="',OutputLine,'"');
6298 TheProcess.Free;
6299 Params.Free;
6300 end;
6301
6302 // ask for target processor -> ask compiler with switch -iTP
6303 Params:=TStringListUTF8.Create;
6304 TheProcess := TProcessUTF8.Create(nil);
6305 try
6306 TheProcess.Executable:=CompilerPath;
6307 if CompilerOptions<>'' then
6308 SplitCmdLineParams(CompilerOptions,Params,true);
6309 Params.Add('-iTP');
6310 TheProcess.Parameters:=Params;
6311 TheProcess.Options:= [poUsePipes, poStdErrToOutPut];
6312 TheProcess.ShowWindow := swoHide;
6313 Step:='Running '+MergeCmdLineParams(Params);
6314 TheProcess.Execute;
6315 if TheProcess.Output<>nil then
6316 OutLen:=TheProcess.Output.Read(Buf[1],length(Buf))
6317 else
6318 OutLen:=0;
6319 i:=1;
6320 while i<=OutLen do begin
6321 if Buf[i] in [#10,#13] then begin
6322 aTargetCPU:=copy(Buf,1,i-1);
6323 NewDefTempl:=TDefineTemplate.Create('Define TargetCPU',
6324 ctsDefaultFPCTargetProcessor,
6325 TargetCPUMacroName,aTargetCPU,
6326 da_DefineRecurse);
6327 AddTemplate(NewDefTempl);
6328 break;
6329 end;
6330 inc(i);
6331 end;
6332 TheProcess.WaitOnExit;
6333 //DebugLn('TDefinePool.CreateFPCTemplate target CPU done');
6334 finally
6335 //DebugLn('TDefinePool.CreateFPCTemplate Run with -iTP: OutputLine="',OutputLine,'"');
6336 TheProcess.Free;
6337 end;
6338
6339 // add
6340 if (LastDefTempl<>nil) then begin
6341 Result:=TDefineTemplate.Create(StdDefTemplFPC,
6342 ctsFreePascalCompilerInitialMacros,'','',da_Block);
6343 Result.AddChild(LastDefTempl.GetFirstSibling);
6344 Result.SetFlags([dtfAutoGenerated],[],false);
6345 //DebugLn('TDefinePool.CreateFPCTemplate FPC defines done');
6346 end;
6347 except
6348 on E: Exception do begin
6349 DebugLn('Error: TDefinePool.CreateFPCTemplate (',Step,'): ',E.Message);
6350 end;
6351 end;
6352 if Result<>nil then
6353 Result.SetDefineOwner(Owner,true);
6354 end;
6355
TDefinePool.GetFPCVerFromFPCTemplatenull6356 function TDefinePool.GetFPCVerFromFPCTemplate(Template: TDefineTemplate; out
6357 FPCVersion, FPCRelease, FPCPatch: integer): boolean;
6358 var
6359 p: Integer;
6360
ReadIntnull6361 function ReadInt(const VarName: string; out AnInteger: integer): boolean;
6362 var
6363 StartPos: Integer;
6364 begin
6365 StartPos:=p;
6366 AnInteger:=0;
6367 while (p<=length(VarName)) and (VarName[p] in ['0'..'9']) do begin
6368 AnInteger:=AnInteger*10+(ord(VarName[p])-ord('0'));
6369 if AnInteger>=100 then begin
6370 Result:=false;
6371 exit;
6372 end;
6373 inc(p);
6374 end;
6375 Result:=StartPos<p;
6376 end;
6377
ReadVersionnull6378 function ReadVersion(const VarName: string;
6379 out NewVersion, NewRelease, NewPatch: integer): integer;
6380 begin
6381 Result:=0;
6382 if (length(VarName)>3) and (VarName[1] in ['V','v'])
6383 and (VarName[2] in ['E','e']) and (VarName[3] in ['R','r'])
6384 and (VarName[4] in ['0'..'9']) then begin
6385 p:=4;
6386 if not ReadInt(VarName,NewVersion) then exit;
6387 inc(Result);
6388 if (p>=length(VarName)) or (VarName[p]<>'_') then exit;
6389 inc(p);
6390 if not ReadInt(VarName,NewRelease) then exit;
6391 inc(Result);
6392 if (p>=length(VarName)) or (VarName[p]<>'_') then exit;
6393 inc(p);
6394 if not ReadInt(VarName,NewPatch) then exit;
6395 inc(Result);
6396 end;
6397 end;
6398
6399 var
6400 Def: TDefineTemplate;
6401 VarName: String;
6402 BestCount: integer;
6403 NewCount: LongInt;
6404 NewVersion: integer;
6405 NewRelease: integer;
6406 NewPatch: integer;
6407 begin
6408 Result:=false;
6409 FPCVersion:=0;
6410 FPCRelease:=0;
6411 FPCPatch:=0;
6412 BestCount:=0;
6413 Def:=Template;
6414 while Def<>nil do begin
6415 if Def.Action in [da_Define,da_DefineRecurse] then begin
6416 VarName:=Def.Variable;
6417 NewCount:=ReadVersion(VarName,NewVersion,NewRelease,NewPatch);
6418 if NewCount>BestCount then begin
6419 BestCount:=NewCount;
6420 FPCVersion:=NewVersion;
6421 if NewCount>1 then FPCRelease:=NewRelease;
6422 if NewCount>2 then FPCPatch:=NewPatch;
6423 if NewCount=3 then exit;
6424 end;
6425 end;
6426 Def:=Def.Next;
6427 end;
6428 end;
6429
CreateDelphiSrcPathnull6430 function TDefinePool.CreateDelphiSrcPath(DelphiVersion: integer;
6431 const PathPrefix: string): string;
6432 begin
6433 case DelphiVersion of
6434 1..5:
6435 Result:=PathPrefix+'Source/Rtl/Win;'
6436 +PathPrefix+'Source/Rtl/Sys;'
6437 +PathPrefix+'Source/Rtl/Corba;'
6438 +PathPrefix+'Source/Vcl;';
6439 else
6440 // 6 and above
6441 Result:=PathPrefix+'Source/Rtl/Win;'
6442 +PathPrefix+'Source/Rtl/Sys;'
6443 +PathPrefix+'Source/Rtl/Common;'
6444 +PathPrefix+'Source/Rtl/Corba40;'
6445 +PathPrefix+'Source/Vcl;';
6446 end;
6447 end;
6448
TDefinePool.CreateLazarusSrcTemplatenull6449 function TDefinePool.CreateLazarusSrcTemplate(
6450 const LazarusSrcDir, WidgetType, ExtraOptions: string;
6451 Owner: TObject): TDefineTemplate;
6452
Dnull6453 function D(const Filename: string): string;
6454 begin
6455 Result:=GetForcedPathDelims(Filename);
6456 end;
6457
6458 var
6459 MainDir, DirTempl, SubDirTempl, IfTemplate,
6460 SubTempl: TDefineTemplate;
6461 TargetOS, SrcOS, SrcPath: string;
6462 i: Integer;
6463 CurCPU, CurOS, CurWidgetSet: string;
6464 ToolsInstallDirTempl: TDefineTemplate;
6465 AllWidgetSets: String;
6466 begin
6467 Result:=nil;
6468 if (LazarusSrcDir='') or (WidgetType='') then exit;
6469 TargetOS:='$('+ExternalMacroStart+'TargetOS)';
6470 SrcOS:='$('+ExternalMacroStart+'SrcOS)';
6471 SrcPath:='$('+ExternalMacroStart+'SrcPath)';
6472
6473 AllWidgetSets:='';
6474 for i:=Low(Lazarus_CPU_OS_Widget_Combinations)
6475 to High(Lazarus_CPU_OS_Widget_Combinations) do
6476 begin
6477 SplitLazarusCPUOSWidgetCombo(Lazarus_CPU_OS_Widget_Combinations[i],
6478 CurCPU,CurOS,CurWidgetSet);
6479 if not HasDelimitedItem(AllWidgetSets,';',CurWidgetSet) then begin
6480 if AllWidgetSets<>'' then
6481 AllWidgetSets:=AllWidgetSets+';';
6482 AllWidgetSets:=AllWidgetSets+CurWidgetSet;
6483 end;
6484 end;
6485
6486 // <LazarusSrcDir>
6487 MainDir:=TDefineTemplate.Create(
6488 StdDefTemplLazarusSrcDir, ctsDefsForLazarusSources,'',LazarusSrcDir,
6489 da_Directory);
6490 // clear src path
6491 MainDir.AddChild(TDefineTemplate.Create('Clear SrcPath','Clear SrcPath',
6492 ExternalMacroStart+'SrcPath','',da_DefineRecurse));
6493 // if SrcOS<>win
6494 IfTemplate:=TDefineTemplate.Create('IF '''+SrcOS+'''<>''win''',
6495 ctsIfTargetOSIsNotWin32,'',''''+SrcOS+'''<>''win''',da_If);
6496 // then define #SrcPath := #SrcPath;lcl/nonwin32
6497 IfTemplate.AddChild(TDefineTemplate.Create('win32api for non win',
6498 Format(ctsAddsDirToSourcePath,[d(LazarusSrcDir+'/lcl/nonwin32')]),
6499 ExternalMacroStart+'SrcPath',
6500 d(LazarusSrcDir+'/lcl/nonwin32;')+SrcPath,da_DefineRecurse));
6501 MainDir.AddChild(IfTemplate);
6502 // define 'LCL'
6503 MainDir.AddChild(TDefineTemplate.Create('define LCL',
6504 ctsDefineLCL,'LCL',WidgetType,da_DefineRecurse));
6505 // define LCLwidgetset, e.g. LCLcarbon, LCLgtk, LCLgtk2
6506 MainDir.AddChild(TDefineTemplate.Create('Define LCLwidgettype',
6507 ctsDefineLCLWidgetset,
6508 'LCL$(#LCLWidgetType)','',da_DefineRecurse));
6509
6510 // <LazarusSrcDir>/ide
6511 DirTempl:=TDefineTemplate.Create('ide',ctsIDEDirectory,
6512 '','ide',da_Directory);
6513 DirTempl.AddChild(TDefineTemplate.Create('IDE path addition',
6514 Format(ctsAddsDirToSourcePath,['designer, debugger, synedit, ...']),
6515 ExternalMacroStart+'SrcPath',
6516 d(LazarusSrcDir+'/ide;'
6517 +LazarusSrcDir+'/ide/frames;'
6518 +LazarusSrcDir+'/designer;'
6519 +LazarusSrcDir+'/debugger;'
6520 +LazarusSrcDir+'/debugger/frames;'
6521 +LazarusSrcDir+'/converter;'
6522 +LazarusSrcDir+'/packager;'
6523 +LazarusSrcDir+'/packager/registration;'
6524 +LazarusSrcDir+'/packager/frames;'
6525 +LazarusSrcDir+'/components/ideintf;'
6526 +LazarusSrcDir+'/components/lazutils;'
6527 +LazarusSrcDir+'/components/lazcontrols;'
6528 +LazarusSrcDir+'/components/synedit;'
6529 +LazarusSrcDir+'/components/codetools;'
6530 +LazarusSrcDir+'/components/lazdebuggergdbmi;'
6531 +LazarusSrcDir+'/components/debuggerintf;'
6532 +LazarusSrcDir+'/lcl;'
6533 +LazarusSrcDir+'/lcl/interfaces;'
6534 +LazarusSrcDir+'/lcl/interfaces/'+WidgetType+';'
6535 +LazarusSrcDir+'/components/custom;'
6536 +SrcPath)
6537 ,da_DefineRecurse));
6538 // include path addition
6539 DirTempl.AddChild(TDefineTemplate.Create('includepath addition',
6540 Format(ctsSetsIncPathTo,['include, include/TargetOS, include/SrcOS']),
6541 IncludePathMacroName,
6542 d(LazarusSrcDir+'/ide/include;'
6543 +LazarusSrcDir+'/ide/include/'+TargetOS+';'
6544 +LazarusSrcDir+'/ide/include/'+SrcOS),
6545 da_DefineRecurse));
6546 MainDir.AddChild(DirTempl);
6547
6548 // <LazarusSrcDir>/designer
6549 DirTempl:=TDefineTemplate.Create('Designer',ctsDesignerDirectory,
6550 '','designer',da_Directory);
6551 DirTempl.AddChild(TDefineTemplate.Create('components path addition',
6552 Format(ctsAddsDirToSourcePath,['synedit']),
6553 SrcPathMacroName,
6554 d('../components/lazutils'
6555 +';../components/codetools'
6556 +';../lcl'
6557 +';../lcl/interfaces'
6558 +';../lcl/interfaces/'+WidgetType
6559 +';../components/ideintf'
6560 +';../components/synedit'
6561 +';../components/codetools'
6562 +';../components/lazcontrols'
6563 +';../components/custom')
6564 +';'+SrcPath
6565 ,da_Define));
6566 DirTempl.AddChild(TDefineTemplate.Create('main path addition',
6567 Format(ctsAddsDirToSourcePath,[ctsLazarusMainDirectory]),
6568 SrcPathMacroName,
6569 d('../ide;../packager;')+SrcPath
6570 ,da_Define));
6571 DirTempl.AddChild(TDefineTemplate.Create('includepath addition',
6572 Format(ctsIncludeDirectoriesPlusDirs,['include']),
6573 IncludePathMacroName,
6574 d('../ide/include;../ide/include/'+TargetOS),
6575 da_Define));
6576 // <LazarusSrcDir>/designer/units
6577 MainDir.AddChild(DirTempl);
6578
6579
6580 // <LazarusSrcDir>/images
6581
6582
6583 // <LazarusSrcDir>/debugger
6584 DirTempl:=TDefineTemplate.Create('Debugger',ctsDebuggerDirectory,
6585 '','debugger',da_Directory);
6586 DirTempl.AddChild(TDefineTemplate.Create('LCL path addition',
6587 Format(ctsAddsDirToSourcePath,['lcl, components']),
6588 ExternalMacroStart+'SrcPath',
6589 d(LazarusSrcDir+'/debugger;'
6590 +LazarusSrcDir+'/debugger/frames;'
6591 +LazarusSrcDir+'/ide;'
6592 +LazarusSrcDir+'/components/ideintf;'
6593 +LazarusSrcDir+'/components/lazutils;'
6594 +LazarusSrcDir+'/components/codetools;'
6595 +LazarusSrcDir+'/components/lazdebuggergdbmi;'
6596 +LazarusSrcDir+'/components/debuggerintf;'
6597 +LazarusSrcDir+'/lcl;'
6598 +LazarusSrcDir+'/lcl/interfaces;'
6599 +LazarusSrcDir+'/lcl/interfaces/'+WidgetType+';')
6600 +SrcPath
6601 ,da_DefineRecurse));
6602 MainDir.AddChild(DirTempl);
6603
6604
6605 // <LazarusSrcDir>/converter
6606 DirTempl:=TDefineTemplate.Create('Converter',ctsDebuggerDirectory,
6607 '','converter',da_Directory);
6608 DirTempl.AddChild(TDefineTemplate.Create('LCL path addition',
6609 Format(ctsAddsDirToSourcePath,['lcl, components']),
6610 ExternalMacroStart+'SrcPath',
6611 d('../ide'
6612 +';../components/ideintf'
6613 +';../components/lazutils'
6614 +';../components/codetools'
6615 +';../components/synedit'
6616 +';../components/lazcontrols'
6617 +';../packager'
6618 +';../debugger'
6619 +';../designer'
6620 +';../lcl'
6621 +';../lcl/interfaces'
6622 +';../lcl/interfaces/'+WidgetType)
6623 +';'+SrcPath
6624 ,da_Define));
6625 MainDir.AddChild(DirTempl);
6626
6627
6628 // <LazarusSrcDir>/packager
6629 DirTempl:=TDefineTemplate.Create('Packager',ctsDesignerDirectory,
6630 '','packager',da_Directory);
6631 DirTempl.AddChild(TDefineTemplate.Create('src path addition',
6632 Format(ctsAddsDirToSourcePath,['lcl synedit codetools lazcontrols ideintf']),
6633 SrcPathMacroName,
6634 d(LazarusSrcDir+'/lcl'
6635 +';'+LazarusSrcDir+'/lcl/interfaces'
6636 +';'+LazarusSrcDir+'/lcl/interfaces/'+WidgetType
6637 +';'+LazarusSrcDir+'/ide'
6638 +';'+LazarusSrcDir+'/components/ideintf'
6639 +';'+LazarusSrcDir+'/components/synedit'
6640 +';'+LazarusSrcDir+'/components/lazcontrols'
6641 +';'+LazarusSrcDir+'/components/lazutils'
6642 +';'+LazarusSrcDir+'/components/codetools'
6643 +';'+LazarusSrcDir+'/packager/frames'
6644 +';'+LazarusSrcDir+'/packager/registration'
6645 +';'+SrcPath)
6646 ,da_DefineRecurse));
6647 DirTempl.AddChild(TDefineTemplate.Create('includepath addition',
6648 Format(ctsIncludeDirectoriesPlusDirs,['include']),
6649 IncludePathMacroName,
6650 d('../ide/include;../ide/include/'+TargetOS),
6651 da_Define));
6652 // <LazarusSrcDir>/packager/frames
6653 SubDirTempl:=TDefineTemplate.Create('Frames',
6654 'Frames','','frames',da_Directory);
6655 DirTempl.AddChild(SubDirTempl);
6656 SubDirTempl.AddChild(TDefineTemplate.Create('src path addition',
6657 Format(ctsAddsDirToSourcePath,['ide']),
6658 SrcPathMacroName,
6659 d(LazarusSrcDir+'/ide;'+LazarusSrcDir+'/packager;'+SrcPath)
6660 ,da_Define));
6661 // <LazarusSrcDir>/packager/registration
6662 SubDirTempl:=TDefineTemplate.Create('Registration',
6663 ctsPackagerRegistrationDirectory,'','registration',da_Directory);
6664 DirTempl.AddChild(SubDirTempl);
6665 // <LazarusSrcDir>/packager/units
6666 SubDirTempl:=TDefineTemplate.Create('Packager Units',
6667 ctsPackagerUnitsDirectory,'','units',da_Directory);
6668 SubDirTempl.AddChild(TDefineTemplate.Create('CompiledSrcPath',
6669 ctsCompiledSrcPath,CompiledSrcPathMacroName,
6670 LazarusSrcDir+d('/packager/registration'),
6671 da_DefineRecurse));
6672 DirTempl.AddChild(SubDirTempl);
6673 MainDir.AddChild(DirTempl);
6674
6675
6676 // <LazarusSrcDir>/examples
6677 DirTempl:=TDefineTemplate.Create('Examples',
6678 Format(ctsNamedDirectory,['Examples']),
6679 '','examples',da_Directory);
6680 DirTempl.AddChild(TDefineTemplate.Create('LCL path addition',
6681 Format(ctsAddsDirToSourcePath,['lcl']),
6682 ExternalMacroStart+'SrcPath',
6683 d('../lcl'
6684 +';../lcl/interfaces/'+WidgetType+';'+SrcPath)
6685 ,da_Define));
6686 MainDir.AddChild(DirTempl);
6687
6688 // <LazarusSrcDir>/components
6689 DirTempl:=TDefineTemplate.Create('Components',ctsComponentsDirectory,
6690 '','components',da_Directory);
6691
6692 // <LazarusSrcDir>/components/custom
6693 SubDirTempl:=TDefineTemplate.Create('Custom Components',
6694 ctsCustomComponentsDirectory,
6695 '','custom',da_Directory);
6696 SubDirTempl.AddChild(TDefineTemplate.Create('lazarus standard components',
6697 Format(ctsAddsDirToSourcePath,['synedit']),
6698 ExternalMacroStart+'SrcPath',
6699 d('../synedit;')
6700 +SrcPath
6701 ,da_DefineRecurse));
6702 DirTempl.AddChild(SubDirTempl);
6703 MainDir.AddChild(DirTempl);
6704
6705 // <LazarusSrcDir>/tools
6706 DirTempl:=TDefineTemplate.Create('Tools',
6707 ctsToolsDirectory,'','tools',da_Directory);
6708 DirTempl.AddChild(TDefineTemplate.Create('LCL path addition',
6709 Format(ctsAddsDirToSourcePath,['lcl']),
6710 ExternalMacroStart+'SrcPath',
6711 d('../lcl;../lcl/interfaces/'+WidgetType
6712 +';../components/codetools')
6713 +';'+SrcPath
6714 ,da_Define));
6715 // <LazarusSrcDir>/tools/install
6716 ToolsInstallDirTempl:=TDefineTemplate.Create('Install',
6717 ctsInstallDirectory,'','install',da_Directory);
6718 DirTempl.AddChild(ToolsInstallDirTempl);
6719 ToolsInstallDirTempl.AddChild(TDefineTemplate.Create('LCL path addition',
6720 Format(ctsAddsDirToSourcePath,['lcl']),
6721 ExternalMacroStart+'SrcPath',
6722 d('../../lcl;../../lcl/interfaces/'+WidgetType
6723 +';../../components/codetools')
6724 +';'+SrcPath
6725 ,da_Define));
6726 MainDir.AddChild(DirTempl);
6727
6728 // extra options
6729 SubTempl:=CreateFPCCommandLineDefines(StdDefTemplLazarusBuildOpts,
6730 ExtraOptions,true,Owner);
6731 MainDir.AddChild(SubTempl);
6732
6733 // put it all into a block
6734 if MainDir<>nil then begin
6735 Result:=TDefineTemplate.Create(StdDefTemplLazarusSources,
6736 ctsLazarusSources,'','',da_Block);
6737 Result.AddChild(MainDir);
6738 end;
6739
6740 Result.SetDefineOwner(Owner,true);
6741 Result.SetFlags([dtfAutoGenerated],[],false);
6742 end;
6743
TDefinePool.CreateLCLProjectTemplatenull6744 function TDefinePool.CreateLCLProjectTemplate(
6745 const LazarusSrcDir, WidgetType, ProjectDir: string;
6746 Owner: TObject): TDefineTemplate;
6747 var DirTempl: TDefineTemplate;
6748 begin
6749 Result:=nil;
6750 if (LazarusSrcDir='') or (WidgetType='') or (ProjectDir='') then exit;
6751 DirTempl:=TDefineTemplate.Create('ProjectDir',ctsAnLCLProject,
6752 '',ProjectDir,da_Directory);
6753 DirTempl.AddChild(TDefineTemplate.Create('LCL',
6754 Format(ctsAddsDirToSourcePath,['lcl']),
6755 ExternalMacroStart+'SrcPath',
6756 LazarusSrcDir+PathDelim+'lcl;'
6757 +LazarusSrcDir+PathDelim+'lcl'+PathDelim+'interfaces'
6758 +PathDelim+WidgetType
6759 +';$('+ExternalMacroStart+'SrcPath)'
6760 ,da_DefineRecurse));
6761 Result:=TDefineTemplate.Create(StdDefTemplLCLProject,
6762 'LCL Project','','',da_Block);
6763 Result.AddChild(DirTempl);
6764 Result.SetDefineOwner(Owner,true);
6765 Result.SetFlags([dtfAutoGenerated],[],false);
6766 end;
6767
CreateDelphiCompilerDefinesTemplatenull6768 function TDefinePool.CreateDelphiCompilerDefinesTemplate(
6769 DelphiVersion: integer; Owner: TObject): TDefineTemplate;
6770 var
6771 DefTempl: TDefineTemplate;
6772 VerMacro: String;
6773 begin
6774 DefTempl:=TDefineTemplate.Create('Delphi'+IntToStr(DelphiVersion)
6775 +' Compiler Defines',
6776 Format(ctsOtherCompilerDefines,['Delphi'+IntToStr(DelphiVersion)]),
6777 '','',da_Block);
6778 DefTempl.AddChild(TDefineTemplate.Create('Reset',
6779 ctsResetAllDefines,
6780 '','',da_UndefineAll));
6781 DefTempl.AddChild(TDefineTemplate.Create('Define macro DELPHI',
6782 Format(ctsDefineMacroName,['DELPHI']),
6783 'DELPHI','',da_DefineRecurse));
6784 DefTempl.AddChild(TDefineTemplate.Create('Define macro FPC_DELPHI',
6785 Format(ctsDefineMacroName,['FPC_DELPHI']),
6786 'FPC_DELPHI','',da_DefineRecurse));
6787 DefTempl.AddChild(TDefineTemplate.Create('Define macro MSWINDOWS',
6788 Format(ctsDefineMacroName,['MSWINDOWS']),
6789 'MSWINDOWS','',da_DefineRecurse));
6790
6791 // version
6792 case DelphiVersion of
6793 3: VerMacro:='VER_110';
6794 4: VerMacro:='VER_125';
6795 5: VerMacro:='VER_130';
6796 6: VerMacro:='VER_140';
6797 else
6798 // else define Delphi 7
6799 VerMacro:='VER_150';
6800 end;
6801 DefTempl.AddChild(TDefineTemplate.Create('Define macro '+VerMacro,
6802 Format(ctsDefineMacroName,[VerMacro]),
6803 VerMacro,'',da_DefineRecurse));
6804
6805 DefTempl.AddChild(TDefineTemplate.Create(
6806 Format(ctsDefineMacroName,[ExternalMacroStart+'Compiler']),
6807 'Define '+ExternalMacroStart+'Compiler variable',
6808 ExternalMacroStart+'Compiler','DELPHI',da_DefineRecurse));
6809
6810 Result:=DefTempl;
6811 Result.SetDefineOwner(Owner,true);
6812 end;
6813
TDefinePool.CreateDelphiDirectoryTemplatenull6814 function TDefinePool.CreateDelphiDirectoryTemplate(
6815 const DelphiDirectory: string; DelphiVersion: integer;
6816 Owner: TObject): TDefineTemplate;
6817 var MainDirTempl: TDefineTemplate;
6818 begin
6819 MainDirTempl:=TDefineTemplate.Create('Delphi'+IntToStr(DelphiVersion)
6820 +' Directory',
6821 Format(ctsNamedDirectory,['Delphi'+IntToStr(DelphiVersion)]),
6822 '',DelphiDirectory,da_Directory);
6823 MainDirTempl.AddChild(CreateDelphiCompilerDefinesTemplate(DelphiVersion,Owner));
6824 MainDirTempl.AddChild(TDefineTemplate.Create('SrcPath',
6825 Format(ctsSetsSrcPathTo,['RTL, VCL']),
6826 ExternalMacroStart+'SrcPath',
6827 GetForcedPathDelims(
6828 CreateDelphiSrcPath(DelphiVersion,DefinePathMacro+'/')+'$(#SrcPath)'),
6829 da_DefineRecurse));
6830
6831 Result:=MainDirTempl;
6832 Result.SetDefineOwner(Owner,true);
6833 end;
6834
CreateDelphiProjectTemplatenull6835 function TDefinePool.CreateDelphiProjectTemplate(
6836 const ProjectDir, DelphiDirectory: string;
6837 DelphiVersion: integer; Owner: TObject): TDefineTemplate;
6838 var MainDirTempl: TDefineTemplate;
6839 begin
6840 MainDirTempl:=TDefineTemplate.Create('Delphi'+IntToStr(DelphiVersion)+' Project',
6841 Format(ctsNamedProject,['Delphi'+IntToStr(DelphiVersion)]),
6842 '',ProjectDir,da_Directory);
6843 MainDirTempl.AddChild(
6844 CreateDelphiCompilerDefinesTemplate(DelphiVersion,Owner));
6845 MainDirTempl.AddChild(TDefineTemplate.Create(
6846 'Define '+ExternalMacroStart+'DelphiDir',
6847 Format(ctsDefineMacroName,[ExternalMacroStart+'DelphiDir']),
6848 ExternalMacroStart+'DelphiDir',DelphiDirectory,da_DefineRecurse));
6849 MainDirTempl.AddChild(TDefineTemplate.Create('SrcPath',
6850 Format(ctsAddsDirToSourcePath,['Delphi RTL+VCL']),
6851 ExternalMacroStart+'SrcPath',
6852 GetForcedPathDelims(CreateDelphiSrcPath(DelphiVersion,'$(#DelphiDir)/')
6853 +'$(#SrcPath)'),
6854 da_DefineRecurse));
6855
6856 Result:=MainDirTempl;
6857 Result.SetDefineOwner(Owner,true);
6858 end;
6859
CreateKylixCompilerDefinesTemplatenull6860 function TDefinePool.CreateKylixCompilerDefinesTemplate(KylixVersion: integer;
6861 Owner: TObject): TDefineTemplate;
6862 var
6863 DefTempl: TDefineTemplate;
6864 begin
6865 DefTempl:=TDefineTemplate.Create('Kylix'+IntToStr(KylixVersion)
6866 +' Compiler Defines',
6867 Format(ctsOtherCompilerDefines,['Kylix'+IntToStr(KylixVersion)]),
6868 '','',da_Block);
6869 DefTempl.AddChild(TDefineTemplate.Create('Reset',
6870 ctsResetAllDefines,
6871 '','',da_UndefineAll));
6872 DefTempl.AddChild(TDefineTemplate.Create('Define macro KYLIX',
6873 Format(ctsDefineMacroName,['KYLIX']),
6874 'KYLIX','',da_DefineRecurse));
6875 DefTempl.AddChild(TDefineTemplate.Create('Define macro FPC_DELPHI',
6876 Format(ctsDefineMacroName,['FPC_DELPHI']),
6877 'FPC_DELPHI','',da_DefineRecurse));
6878 DefTempl.AddChild(TDefineTemplate.Create('Define macro LINUX',
6879 Format(ctsDefineMacroName,['LINUX']),
6880 'LINUX','',da_DefineRecurse));
6881 DefTempl.AddChild(TDefineTemplate.Create('Define macro CPU386',
6882 Format(ctsDefineMacroName,['CPU386']),
6883 'CPU386','',da_DefineRecurse));
6884
6885 // version
6886 case KylixVersion of
6887 1:
6888 DefTempl.AddChild(TDefineTemplate.Create('Define macro VER_125',
6889 Format(ctsDefineMacroName,['VER_125']),
6890 'VER_125','',da_DefineRecurse));
6891 2:
6892 DefTempl.AddChild(TDefineTemplate.Create('Define macro VER_130',
6893 Format(ctsDefineMacroName,['VER_130']),
6894 'VER_130','',da_DefineRecurse));
6895 else
6896 // else define Kylix 3
6897 DefTempl.AddChild(TDefineTemplate.Create('Define macro VER_140',
6898 Format(ctsDefineMacroName,['VER_140']),
6899 'VER_140','',da_DefineRecurse));
6900 end;
6901
6902 DefTempl.AddChild(TDefineTemplate.Create(
6903 Format(ctsDefineMacroName,[ExternalMacroStart+'Compiler']),
6904 'Define '+ExternalMacroStart+'Compiler variable',
6905 ExternalMacroStart+'Compiler','DELPHI',da_DefineRecurse));
6906
6907 Result:=DefTempl;
6908 Result.SetDefineOwner(Owner,true);
6909 end;
6910
CreateKylixSrcPathnull6911 function TDefinePool.CreateKylixSrcPath(KylixVersion: integer;
6912 const PathPrefix: string): string;
6913 begin
6914 Result:=PathPrefix+'source/rtl/linux;'
6915 +PathPrefix+'source/rtl/sys;'
6916 +PathPrefix+'source/rtl/common;'
6917 +PathPrefix+'source/rtl/corba40;'
6918 +PathPrefix+'source/rtle;'
6919 +PathPrefix+'source/rtl/clx';
6920 end;
6921
CreateKylixDirectoryTemplatenull6922 function TDefinePool.CreateKylixDirectoryTemplate(const KylixDirectory: string;
6923 KylixVersion: integer; Owner: TObject): TDefineTemplate;
6924 var MainDirTempl: TDefineTemplate;
6925 begin
6926 MainDirTempl:=TDefineTemplate.Create('Kylix'+IntToStr(KylixVersion)
6927 +' Directory',
6928 Format(ctsNamedDirectory,['Kylix'+IntToStr(KylixVersion)]),
6929 '',KylixDirectory,da_Directory);
6930 MainDirTempl.AddChild(CreateKylixCompilerDefinesTemplate(KylixVersion,Owner));
6931 MainDirTempl.AddChild(TDefineTemplate.Create('SrcPath',
6932 Format(ctsSetsSrcPathTo,['RTL, CLX']),
6933 ExternalMacroStart+'SrcPath',
6934 GetForcedPathDelims(CreateKylixSrcPath(KylixVersion,DefinePathMacro+'/')
6935 +'$(#SrcPath)'),
6936 da_DefineRecurse));
6937
6938 Result:=MainDirTempl;
6939 Result.SetDefineOwner(Owner,true);
6940 end;
6941
CreateKylixProjectTemplatenull6942 function TDefinePool.CreateKylixProjectTemplate(const ProjectDir,
6943 KylixDirectory: string; KylixVersion: integer; Owner: TObject
6944 ): TDefineTemplate;
6945 var MainDirTempl: TDefineTemplate;
6946 begin
6947 MainDirTempl:=TDefineTemplate.Create('Kylix'+IntToStr(KylixVersion)+' Project',
6948 Format(ctsNamedProject,['Kylix'+IntToStr(KylixVersion)]),
6949 '',ProjectDir,da_Directory);
6950 MainDirTempl.AddChild(
6951 CreateDelphiCompilerDefinesTemplate(KylixVersion,Owner));
6952 MainDirTempl.AddChild(TDefineTemplate.Create(
6953 'Define '+ExternalMacroStart+'KylixDir',
6954 Format(ctsDefineMacroName,[ExternalMacroStart+'KylixDir']),
6955 ExternalMacroStart+'KylixDir',KylixDirectory,da_DefineRecurse));
6956 MainDirTempl.AddChild(TDefineTemplate.Create('SrcPath',
6957 Format(ctsAddsDirToSourcePath,['Kylix RTL+VCL']),
6958 ExternalMacroStart+'SrcPath',
6959 GetForcedPathDelims(CreateKylixSrcPath(KylixVersion,'$(#KylixDir)/')
6960 +'$(#SrcPath)'),
6961 da_DefineRecurse));
6962
6963 Result:=MainDirTempl;
6964 Result.SetDefineOwner(Owner,true);
6965 end;
6966
TDefinePool.CreateFPCCommandLineDefinesnull6967 function TDefinePool.CreateFPCCommandLineDefines(const Name, CmdLine: string;
6968 RecursiveDefines: boolean; Owner: TObject; AlwaysCreate: boolean;
6969 AddPaths: boolean): TDefineTemplate;
6970
6971 procedure CreateMainTemplate;
6972 begin
6973 if Result=nil then
6974 Result:=TDefineTemplate.Create(Name,ctsCommandLineParameters,'','',
6975 da_Block);
6976 end;
6977
6978 procedure AddDefine(const AName, ADescription, AVariable, AValue: string;
6979 AnAction: TDefineAction);
6980 var
6981 NewTempl: TDefineTemplate;
6982 begin
6983 if AName='' then exit;
6984 NewTempl:=TDefineTemplate.Create(AName, ADescription, AVariable, AValue,
6985 AnAction);
6986 CreateMainTemplate;
6987 Result.AddChild(NewTempl);
6988 end;
6989
6990 procedure AddDefine(const AName, ADescription, AVariable, AValue: string);
6991 var
6992 NewAction: TDefineAction;
6993 begin
6994 //debugln(['AddDefine Name="',AName,'" Var="',AVariable,'" Value="',AValue,'"']);
6995 if RecursiveDefines then
6996 NewAction:=da_DefineRecurse
6997 else
6998 NewAction:=da_Define;
6999 AddDefine(AName,ADescription,AVariable,AValue,NewAction);
7000 end;
7001
7002 procedure AddDefine(const AParam: string);
7003 var
7004 Identifier: String;
7005 AValue: String;
7006 begin
7007 Identifier:=GetIdentifier(PChar(AParam));
7008 if Identifier='' then exit;
7009 AValue:='';
7010 if length(Identifier)<length(AParam) then begin
7011 if copy(AParam,length(Identifier)+1,2)=':=' then
7012 AValue:=copy(AParam,length(Identifier)+3,length(AParam));
7013 end;
7014 AddDefine('Define '+Identifier,ctsDefine+AParam,Identifier,AValue);
7015 end;
7016
7017 procedure AddUndefine(const AParam: string);
7018 var
7019 NewAction: TDefineAction;
7020 Identifier: String;
7021 begin
7022 if RecursiveDefines then
7023 NewAction:=da_UndefineRecurse
7024 else
7025 NewAction:=da_Undefine;
7026 Identifier:=GetIdentifier(PChar(AParam));
7027 AddDefine('Undefine '+Identifier,ctsUndefine+AParam,Identifier,'',NewAction);
7028 end;
7029
7030 procedure AddDefineUndefine(const AName: string; Define: boolean);
7031 begin
7032 if Define then
7033 AddDefine(AName)
7034 else
7035 AddUndefine(AName);
7036 end;
7037
FindControllerUnitnull7038 function FindControllerUnit(const AControllerName: string): string;
7039 type
7040 TControllerType = record
7041 controllertypestr,
7042 controllerunitstr: string[20];
7043 end;
7044 const
7045 ControllerTypes: array[0..532] of TControllerType =
7046 ((controllertypestr:''; controllerunitstr:''),
7047 (controllertypestr:'LPC810M021FN8'; controllerunitstr:'LPC8xx'),
7048 (controllertypestr:'LPC811M001JDH16'; controllerunitstr:'LPC8xx'),
7049 (controllertypestr:'LPC812M101JD20'; controllerunitstr:'LPC8xx'),
7050 (controllertypestr:'LPC812M101JDH16'; controllerunitstr:'LPC8xx'),
7051 (controllertypestr:'LPC812M101JDH20'; controllerunitstr:'LPC8xx'),
7052 (controllertypestr:'LPCXPRESSO812MAX'; controllerunitstr:'LPC8xx'),
7053 (controllertypestr:'LPC812M101JTB16'; controllerunitstr:'LPC8xx'),
7054 (controllertypestr:'LPC822M101JDH20'; controllerunitstr:'LPC82x'),
7055 (controllertypestr:'LPC822M101JHI33'; controllerunitstr:'LPC82x'),
7056 (controllertypestr:'LPC824M201JDH20'; controllerunitstr:'LPC82x'),
7057 (controllertypestr:'LPC824M201JHI33'; controllerunitstr:'LPC82x'),
7058 (controllertypestr:'LPCXPRESSO824MAX'; controllerunitstr:'LPC82x'),
7059
7060 (controllertypestr:'LPC1110FD20'; controllerunitstr:'LPC11XX'),
7061 (controllertypestr:'LPC1111FDH20_002'; controllerunitstr:'LPC11XX'),
7062 (controllertypestr:'LPC1111FHN33_101'; controllerunitstr:'LPC11XX'),
7063 (controllertypestr:'LPC1111FHN33_102'; controllerunitstr:'LPC11XX'),
7064 (controllertypestr:'LPC1111FHN33_103'; controllerunitstr:'LPC11XX'),
7065 (controllertypestr:'LPC1111FHN33_201'; controllerunitstr:'LPC11XX'),
7066 (controllertypestr:'LPC1111FHN33_202'; controllerunitstr:'LPC11XX'),
7067 (controllertypestr:'LPC1111FHN33_203'; controllerunitstr:'LPC11XX'),
7068 (controllertypestr:'LPC1112FD20_102'; controllerunitstr:'LPC11XX'),
7069 (controllertypestr:'LPC1112FDH20_102'; controllerunitstr:'LPC11XX'),
7070 (controllertypestr:'LPC1112FDH28_102'; controllerunitstr:'LPC11XX'),
7071 (controllertypestr:'LPC1112FHN33_101'; controllerunitstr:'LPC11XX'),
7072 (controllertypestr:'LPC1112FHN33_102'; controllerunitstr:'LPC11XX'),
7073 (controllertypestr:'LPC1112FHN33_103'; controllerunitstr:'LPC11XX'),
7074 (controllertypestr:'LPC1112FHN33_201'; controllerunitstr:'LPC11XX'),
7075 (controllertypestr:'LPC1112FHN24_202'; controllerunitstr:'LPC11XX'),
7076 (controllertypestr:'LPC1112FHN33_202'; controllerunitstr:'LPC11XX'),
7077 (controllertypestr:'LPC1112FHN33_203'; controllerunitstr:'LPC11XX'),
7078 (controllertypestr:'LPC1112FHI33_202'; controllerunitstr:'LPC11XX'),
7079 (controllertypestr:'LPC1112FHI33_203'; controllerunitstr:'LPC11XX'),
7080 (controllertypestr:'LPC1113FHN33_201'; controllerunitstr:'LPC11XX'),
7081 (controllertypestr:'LPC1113FHN33_202'; controllerunitstr:'LPC11XX'),
7082 (controllertypestr:'LPC1113FHN33_203'; controllerunitstr:'LPC11XX'),
7083 (controllertypestr:'LPC1113FHN33_301'; controllerunitstr:'LPC11XX'),
7084 (controllertypestr:'LPC1113FHN33_302'; controllerunitstr:'LPC11XX'),
7085 (controllertypestr:'LPC1113FHN33_303'; controllerunitstr:'LPC11XX'),
7086 (controllertypestr:'LPC1113FBD48_301'; controllerunitstr:'LPC11XX'),
7087 (controllertypestr:'LPC1113FBD48_302'; controllerunitstr:'LPC11XX'),
7088 (controllertypestr:'LPC1113FBD48_303'; controllerunitstr:'LPC11XX'),
7089 (controllertypestr:'LPC1114FDH28_102'; controllerunitstr:'LPC11XX'),
7090 (controllertypestr:'LPC1114FN28_102'; controllerunitstr:'LPC11XX'),
7091 (controllertypestr:'LPC1114FHN33_201'; controllerunitstr:'LPC11XX'),
7092 (controllertypestr:'LPC1114FHN33_202'; controllerunitstr:'LPC11XX'),
7093 (controllertypestr:'LPC1114FHN33_203'; controllerunitstr:'LPC11XX'),
7094 (controllertypestr:'LPC1114FHN33_301'; controllerunitstr:'LPC11XX'),
7095 (controllertypestr:'LPC1114FHN33_302'; controllerunitstr:'LPC11XX'),
7096 (controllertypestr:'LPC1114FHN33_303'; controllerunitstr:'LPC11XX'),
7097 (controllertypestr:'LPC1114FHN33_333'; controllerunitstr:'LPC11XX'),
7098 (controllertypestr:'LPC1114FHI33_302'; controllerunitstr:'LPC11XX'),
7099 (controllertypestr:'LPC1114FHI33_303'; controllerunitstr:'LPC11XX'),
7100 (controllertypestr:'LPC1114FBD48_301'; controllerunitstr:'LPC11XX'),
7101 (controllertypestr:'LPC1114FBD48_302'; controllerunitstr:'LPC11XX'),
7102 (controllertypestr:'LPC1114FBD48_303'; controllerunitstr:'LPC11XX'),
7103 (controllertypestr:'LPC1114FBD48_323'; controllerunitstr:'LPC11XX'),
7104 (controllertypestr:'LPC1114FBD48_333'; controllerunitstr:'LPC11XX'),
7105 (controllertypestr:'LPC1115FBD48_303'; controllerunitstr:'LPC11XX'),
7106 (controllertypestr:'LPC11C12FBD48_301'; controllerunitstr:'LPC11XX'),
7107 (controllertypestr:'LPC11C14FBD48_301'; controllerunitstr:'LPC11XX'),
7108 (controllertypestr:'LPC11C22FBD48_301'; controllerunitstr:'LPC11XX'),
7109 (controllertypestr:'LPC11C24FBD48_301'; controllerunitstr:'LPC11XX'),
7110 (controllertypestr:'LPC11D14FBD100_302';controllerunitstr:'LPC11XX'),
7111 (controllertypestr:'LPC1224FBD48_101'; controllerunitstr:'LPC122X'),
7112 (controllertypestr:'LPC1224FBD48_121'; controllerunitstr:'LPC122X'),
7113 (controllertypestr:'LPC1224FBD64_101'; controllerunitstr:'LPC122X'),
7114 (controllertypestr:'LPC1224FBD64_121'; controllerunitstr:'LPC122X'),
7115 (controllertypestr:'LPC1225FBD48_301'; controllerunitstr:'LPC122X'),
7116 (controllertypestr:'LPC1225FBD48_321'; controllerunitstr:'LPC122X'),
7117 (controllertypestr:'LPC1225FBD64_301'; controllerunitstr:'LPC122X'),
7118 (controllertypestr:'LPC1225FBD64_321'; controllerunitstr:'LPC122X'),
7119 (controllertypestr:'LPC1226FBD48_301'; controllerunitstr:'LPC122X'),
7120 (controllertypestr:'LPC1226FBD64_301'; controllerunitstr:'LPC122X'),
7121 (controllertypestr:'LPC1227FBD48_301'; controllerunitstr:'LPC122X'),
7122 (controllertypestr:'LPC1227FBD64_301'; controllerunitstr:'LPC122X'),
7123 (controllertypestr:'LPC12D27FBD100_301';controllerunitstr:'LPC122X'),
7124 (controllertypestr:'LPC1311FHN33'; controllerunitstr:'LPC13XX'),
7125 (controllertypestr:'LPC1311FHN33_01'; controllerunitstr:'LPC13XX'),
7126 (controllertypestr:'LPC1313FHN33'; controllerunitstr:'LPC13XX'),
7127 (controllertypestr:'LPC1313FHN33_01'; controllerunitstr:'LPC13XX'),
7128 (controllertypestr:'LPC1313FBD48'; controllerunitstr:'LPC13XX'),
7129 (controllertypestr:'LPC1313FBD48_01'; controllerunitstr:'LPC13XX'),
7130 (controllertypestr:'LPC1315FHN33'; controllerunitstr:'LPC13XX'),
7131 (controllertypestr:'LPC1315FBD48'; controllerunitstr:'LPC13XX'),
7132 (controllertypestr:'LPC1316FHN33'; controllerunitstr:'LPC13XX'),
7133 (controllertypestr:'LPC1316FBD48'; controllerunitstr:'LPC13XX'),
7134 (controllertypestr:'LPC1317FHN33'; controllerunitstr:'LPC13XX'),
7135 (controllertypestr:'LPC1317FBD48'; controllerunitstr:'LPC13XX'),
7136 (controllertypestr:'LPC1317FBD64'; controllerunitstr:'LPC13XX'),
7137 (controllertypestr:'LPC1342FHN33'; controllerunitstr:'LPC13XX'),
7138 (controllertypestr:'LPC1342FBD48'; controllerunitstr:'LPC13XX'),
7139 (controllertypestr:'LPC1343FHN33'; controllerunitstr:'LPC13XX'),
7140 (controllertypestr:'LPC1343FBD48'; controllerunitstr:'LPC13XX'),
7141 (controllertypestr:'LPC1345FHN33'; controllerunitstr:'LPC13XX'),
7142 (controllertypestr:'LPC1345FBD48'; controllerunitstr:'LPC13XX'),
7143 (controllertypestr:'LPC1346FHN33'; controllerunitstr:'LPC13XX'),
7144 (controllertypestr:'LPC1346FBD48'; controllerunitstr:'LPC13XX'),
7145 (controllertypestr:'LPC1347FHN33'; controllerunitstr:'LPC13XX'),
7146 (controllertypestr:'LPC1347FBD48'; controllerunitstr:'LPC13XX'),
7147 (controllertypestr:'LPC1347FBD64'; controllerunitstr:'LPC13XX'),
7148 (controllertypestr:'LPC2114'; controllerunitstr:'LPC21x4'),
7149 (controllertypestr:'LPC2124'; controllerunitstr:'LPC21x4'),
7150 (controllertypestr:'LPC2194'; controllerunitstr:'LPC21x4'),
7151 (controllertypestr:'LPC1754'; controllerunitstr:'LPC1754'),
7152 (controllertypestr:'LPC1756'; controllerunitstr:'LPC1756'),
7153 (controllertypestr:'LPC1758'; controllerunitstr:'LPC1758'),
7154 (controllertypestr:'LPC1764'; controllerunitstr:'LPC1764'),
7155 (controllertypestr:'LPC1766'; controllerunitstr:'LPC1766'),
7156 (controllertypestr:'LPC1768'; controllerunitstr:'LPC1768'),
7157 (controllertypestr:'AT91SAM7S256'; controllerunitstr:'AT91SAM7x256'),
7158 (controllertypestr:'AT91SAM7SE256'; controllerunitstr:'AT91SAM7x256'),
7159 (controllertypestr:'AT91SAM7X256'; controllerunitstr:'AT91SAM7x256'),
7160 (controllertypestr:'AT91SAM7XC256'; controllerunitstr:'AT91SAM7x256'),
7161 (controllertypestr:'STM32F030C6'; controllerunitstr:'STM32F0XX'),
7162 (controllertypestr:'STM32F030C8'; controllerunitstr:'STM32F0XX'),
7163 (controllertypestr:'STM32F030F4'; controllerunitstr:'STM32F0XX'),
7164 (controllertypestr:'STM32F030K6'; controllerunitstr:'STM32F0XX'),
7165 (controllertypestr:'STM32F030R8'; controllerunitstr:'STM32F0XX'),
7166 (controllertypestr:'STM32F050C4'; controllerunitstr:'STM32F0XX'),
7167 (controllertypestr:'STM32F050C6'; controllerunitstr:'STM32F0XX'),
7168 (controllertypestr:'STM32F050F4'; controllerunitstr:'STM32F0XX'),
7169 (controllertypestr:'STM32F050F6'; controllerunitstr:'STM32F0XX'),
7170 (controllertypestr:'STM32F050G4'; controllerunitstr:'STM32F0XX'),
7171 (controllertypestr:'STM32F050G6'; controllerunitstr:'STM32F0XX'),
7172 (controllertypestr:'STM32F050K4'; controllerunitstr:'STM32F0XX'),
7173 (controllertypestr:'STM32F050K6'; controllerunitstr:'STM32F0XX'),
7174 (controllertypestr:'STM32F051C4'; controllerunitstr:'STM32F0XX'),
7175 (controllertypestr:'STM32F051C6'; controllerunitstr:'STM32F0XX'),
7176 (controllertypestr:'STM32F051C8'; controllerunitstr:'STM32F0XX'),
7177 (controllertypestr:'STM32F051K4'; controllerunitstr:'STM32F0XX'),
7178 (controllertypestr:'STM32F051K6'; controllerunitstr:'STM32F0XX'),
7179 (controllertypestr:'STM32F051K8'; controllerunitstr:'STM32F0XX'),
7180 (controllertypestr:'STM32F051R4'; controllerunitstr:'STM32F0XX'),
7181 (controllertypestr:'STM32F051R6'; controllerunitstr:'STM32F0XX'),
7182 (controllertypestr:'STM32F051R8'; controllerunitstr:'STM32F0XX'),
7183 (controllertypestr:'STM32F100X4'; controllerunitstr:'STM32F10X_LD'),
7184 (controllertypestr:'STM32F100X6'; controllerunitstr:'STM32F10X_LD'),
7185 (controllertypestr:'STM32F100X8'; controllerunitstr:'STM32F10X_MD'),
7186 (controllertypestr:'STM32F100XB'; controllerunitstr:'STM32F10X_MD'),
7187 (controllertypestr:'STM32F100XC'; controllerunitstr:'STM32F10X_HD'),
7188 (controllertypestr:'STM32F100XD'; controllerunitstr:'STM32F10X_HD'),
7189 (controllertypestr:'STM32F100XE'; controllerunitstr:'STM32F10X_HD'),
7190 (controllertypestr:'STM32F101X4'; controllerunitstr:'STM32F10X_LD'),
7191 (controllertypestr:'STM32F101X6'; controllerunitstr:'STM32F10X_LD'),
7192 (controllertypestr:'STM32F101X8'; controllerunitstr:'STM32F10X_MD'),
7193 (controllertypestr:'STM32F101XB'; controllerunitstr:'STM32F10X_MD'),
7194 (controllertypestr:'STM32F101XC'; controllerunitstr:'STM32F10X_HD'),
7195 (controllertypestr:'STM32F101XD'; controllerunitstr:'STM32F10X_HD'),
7196 (controllertypestr:'STM32F101XE'; controllerunitstr:'STM32F10X_HD'),
7197 (controllertypestr:'STM32F101XF'; controllerunitstr:'STM32F10X_XL'),
7198 (controllertypestr:'STM32F101XG'; controllerunitstr:'STM32F10X_XL'),
7199 (controllertypestr:'STM32F102X4'; controllerunitstr:'STM32F10X_LD'),
7200 (controllertypestr:'STM32F102X6'; controllerunitstr:'STM32F10X_LD'),
7201 (controllertypestr:'STM32F102X8'; controllerunitstr:'STM32F10X_MD'),
7202 (controllertypestr:'STM32F102XB'; controllerunitstr:'STM32F10X_MD'),
7203 (controllertypestr:'STM32F103X4'; controllerunitstr:'STM32F10X_LD'),
7204 (controllertypestr:'STM32F103X6'; controllerunitstr:'STM32F10X_LD'),
7205 (controllertypestr:'STM32F103X8'; controllerunitstr:'STM32F10X_MD'),
7206 (controllertypestr:'STM32F103XB'; controllerunitstr:'STM32F10X_MD'),
7207 (controllertypestr:'STM32F103XC'; controllerunitstr:'STM32F10X_HD'),
7208 (controllertypestr:'STM32F103XD'; controllerunitstr:'STM32F10X_HD'),
7209 (controllertypestr:'STM32F103XE'; controllerunitstr:'STM32F10X_HD'),
7210 (controllertypestr:'STM32F103XF'; controllerunitstr:'STM32F10X_XL'),
7211 (controllertypestr:'STM32F103XG'; controllerunitstr:'STM32F10X_XL'),
7212 (controllertypestr:'STM32F107X8'; controllerunitstr:'STM32F10X_CONN'),
7213 (controllertypestr:'STM32F107XB'; controllerunitstr:'STM32F10X_CONN'),
7214 (controllertypestr:'STM32F107XC'; controllerunitstr:'STM32F10X_CONN'),
7215 (controllertypestr:'STM32F105R8'; controllerunitstr:'STM32F10X_CL'),
7216 (controllertypestr:'STM32F105RB'; controllerunitstr:'STM32F10X_CL'),
7217 (controllertypestr:'STM32F105RC'; controllerunitstr:'STM32F10X_CL'),
7218 (controllertypestr:'STM32F105V8'; controllerunitstr:'STM32F10X_CL'),
7219 (controllertypestr:'STM32F105VB'; controllerunitstr:'STM32F10X_CL'),
7220 (controllertypestr:'STM32F105VC'; controllerunitstr:'STM32F10X_CL'),
7221 (controllertypestr:'STM32F107RB'; controllerunitstr:'STM32F10X_CL'),
7222 (controllertypestr:'STM32F107RC'; controllerunitstr:'STM32F10X_CL'),
7223 (controllertypestr:'STM32F107VB'; controllerunitstr:'STM32F10X_CL'),
7224 (controllertypestr:'STM32F107VC'; controllerunitstr:'STM32F10X_CL'),
7225 (controllertypestr:'STM32F401RB'; controllerunitstr:'STM32F401XX'),
7226 (controllertypestr:'STM32F401VB'; controllerunitstr:'STM32F401XX'),
7227 (controllertypestr:'STM32F401CC'; controllerunitstr:'STM32F401XX'),
7228 (controllertypestr:'STM32F401RC'; controllerunitstr:'STM32F401XX'),
7229 (controllertypestr:'STM32F401VC'; controllerunitstr:'STM32F401XX'),
7230 (controllertypestr:'DISCOVERYF401VC'; controllerunitstr:'STM32F401XX'),
7231 (controllertypestr:'STM32F401CD'; controllerunitstr:'STM32F401XX'),
7232 (controllertypestr:'STM32F401RD'; controllerunitstr:'STM32F401XX'),
7233 (controllertypestr:'STM32F401VD'; controllerunitstr:'STM32F401XX'),
7234 (controllertypestr:'STM32F401CE'; controllerunitstr:'STM32F401XX'),
7235 (controllertypestr:'STM32F401RE'; controllerunitstr:'STM32F401XX'),
7236 (controllertypestr:'NUCLEOF401RE'; controllerunitstr:'STM32F401XX'),
7237 (controllertypestr:'STM32F401VE'; controllerunitstr:'STM32F401XX'),
7238 (controllertypestr:'STM32F407VG'; controllerunitstr:'STM32F407XX'),
7239 (controllertypestr:'DISCOVERYF407VG'; controllerunitstr:'STM32F407XX'),
7240 (controllertypestr:'STM32F407IG'; controllerunitstr:'STM32F407XX'),
7241 (controllertypestr:'STM32F407ZG'; controllerunitstr:'STM32F407XX'),
7242 (controllertypestr:'STM32F407VE'; controllerunitstr:'STM32F407XX'),
7243 (controllertypestr:'STM32F407ZE'; controllerunitstr:'STM32F407XX'),
7244 (controllertypestr:'STM32F407IE'; controllerunitstr:'STM32F407XX'),
7245 (controllertypestr:'STM32F411CC'; controllerunitstr:'STM32F411XE'),
7246 (controllertypestr:'STM32F411RC'; controllerunitstr:'STM32F411XE'),
7247 (controllertypestr:'STM32F411VC'; controllerunitstr:'STM32F411XE'),
7248 (controllertypestr:'STM32F411CE'; controllerunitstr:'STM32F411XE'),
7249 (controllertypestr:'STM32F411RE'; controllerunitstr:'STM32F411XE'),
7250 (controllertypestr:'NUCLEOF411RE'; controllerunitstr:'STM32F411XE'),
7251 (controllertypestr:'STM32F411VE'; controllerunitstr:'STM32F411XE'),
7252 (controllertypestr:'DISCOVERYF411VE'; controllerunitstr:'STM32F411XE'),
7253 (controllertypestr:'STM32F429VG'; controllerunitstr:'STM32F429XX'),
7254 (controllertypestr:'STM32F429ZG'; controllerunitstr:'STM32F429XX'),
7255 (controllertypestr:'STM32F429IG'; controllerunitstr:'STM32F429XX'),
7256 (controllertypestr:'STM32F429VI'; controllerunitstr:'STM32F429XX'),
7257 (controllertypestr:'STM32F429ZI'; controllerunitstr:'STM32F429XX'),
7258 (controllertypestr:'DISCOVERYF429ZI'; controllerunitstr:'STM32F429XX'),
7259 (controllertypestr:'STM32F429II'; controllerunitstr:'STM32F429XX'),
7260 (controllertypestr:'STM32F429VE'; controllerunitstr:'STM32F429XX'),
7261 (controllertypestr:'STM32F429ZE'; controllerunitstr:'STM32F429XX'),
7262 (controllertypestr:'STM32F429IE'; controllerunitstr:'STM32F429XX'),
7263 (controllertypestr:'STM32F429BG'; controllerunitstr:'STM32F429XX'),
7264 (controllertypestr:'STM32F429BI'; controllerunitstr:'STM32F429XX'),
7265 (controllertypestr:'STM32F429BE'; controllerunitstr:'STM32F429XX'),
7266 (controllertypestr:'STM32F429NG'; controllerunitstr:'STM32F429XX'),
7267 (controllertypestr:'STM32F429NI'; controllerunitstr:'STM32F429XX'),
7268 (controllertypestr:'STM32F429NE'; controllerunitstr:'STM32F429XX'),
7269 (controllertypestr:'STM32F446MC'; controllerunitstr:'STM32F446XX'),
7270 (controllertypestr:'STM32F446RC'; controllerunitstr:'STM32F446XX'),
7271 (controllertypestr:'STM32F446VC'; controllerunitstr:'STM32F446XX'),
7272 (controllertypestr:'STM32F446ZC'; controllerunitstr:'STM32F446XX'),
7273 (controllertypestr:'STM32F446ME'; controllerunitstr:'STM32F446XX'),
7274 (controllertypestr:'STM32F446RE'; controllerunitstr:'STM32F446XX'),
7275 (controllertypestr:'NUCLEOF446RE'; controllerunitstr:'STM32F446XX'),
7276 (controllertypestr:'STM32F446VE'; controllerunitstr:'STM32F446XX'),
7277 (controllertypestr:'STM32F446ZE'; controllerunitstr:'STM32F446XX'),
7278 (controllertypestr:'STM32F745XE'; controllerunitstr:'STM32F745'),
7279 (controllertypestr:'STM32F745XG'; controllerunitstr:'STM32F745'),
7280 (controllertypestr:'STM32F746XE'; controllerunitstr:'STM32F746'),
7281 (controllertypestr:'STM32F746XG'; controllerunitstr:'STM32F746'),
7282 (controllertypestr:'STM32F756XE'; controllerunitstr:'STM32F756'),
7283 (controllertypestr:'STM32F756XG'; controllerunitstr:'STM32F756'),
7284 (controllertypestr:'LM3S1110'; controllerunitstr:'LM3FURY'),
7285 (controllertypestr:'LM3S1133'; controllerunitstr:'LM3FURY'),
7286 (controllertypestr:'LM3S1138'; controllerunitstr:'LM3FURY'),
7287 (controllertypestr:'LM3S1150'; controllerunitstr:'LM3FURY'),
7288 (controllertypestr:'LM3S1162'; controllerunitstr:'LM3FURY'),
7289 (controllertypestr:'LM3S1165'; controllerunitstr:'LM3FURY'),
7290 (controllertypestr:'LM3S1166'; controllerunitstr:'LM3FURY'),
7291 (controllertypestr:'LM3S2110'; controllerunitstr:'LM3FURY'),
7292 (controllertypestr:'LM3S2139'; controllerunitstr:'LM3FURY'),
7293 (controllertypestr:'LM3S6100'; controllerunitstr:'LM3FURY'),
7294 (controllertypestr:'LM3S6110'; controllerunitstr:'LM3FURY'),
7295 (controllertypestr:'LM3S1601'; controllerunitstr:'LM3FURY'),
7296 (controllertypestr:'LM3S1608'; controllerunitstr:'LM3FURY'),
7297 (controllertypestr:'LM3S1620'; controllerunitstr:'LM3FURY'),
7298 (controllertypestr:'LM3S1635'; controllerunitstr:'LM3FURY'),
7299 (controllertypestr:'LM3S1636'; controllerunitstr:'LM3FURY'),
7300 (controllertypestr:'LM3S1637'; controllerunitstr:'LM3FURY'),
7301 (controllertypestr:'LM3S1651'; controllerunitstr:'LM3FURY'),
7302 (controllertypestr:'LM3S2601'; controllerunitstr:'LM3FURY'),
7303 (controllertypestr:'LM3S2608'; controllerunitstr:'LM3FURY'),
7304 (controllertypestr:'LM3S2620'; controllerunitstr:'LM3FURY'),
7305 (controllertypestr:'LM3S2637'; controllerunitstr:'LM3FURY'),
7306 (controllertypestr:'LM3S2651'; controllerunitstr:'LM3FURY'),
7307 (controllertypestr:'LM3S6610'; controllerunitstr:'LM3FURY'),
7308 (controllertypestr:'LM3S6611'; controllerunitstr:'LM3FURY'),
7309 (controllertypestr:'LM3S6618'; controllerunitstr:'LM3FURY'),
7310 (controllertypestr:'LM3S6633'; controllerunitstr:'LM3FURY'),
7311 (controllertypestr:'LM3S6637'; controllerunitstr:'LM3FURY'),
7312 (controllertypestr:'LM3S8630'; controllerunitstr:'LM3FURY'),
7313 (controllertypestr:'LM3S1911'; controllerunitstr:'LM3FURY'),
7314 (controllertypestr:'LM3S1918'; controllerunitstr:'LM3FURY'),
7315 (controllertypestr:'LM3S1937'; controllerunitstr:'LM3FURY'),
7316 (controllertypestr:'LM3S1958'; controllerunitstr:'LM3FURY'),
7317 (controllertypestr:'LM3S1960'; controllerunitstr:'LM3FURY'),
7318 (controllertypestr:'LM3S1968'; controllerunitstr:'LM3FURY'),
7319 (controllertypestr:'LM3S1969'; controllerunitstr:'LM3FURY'),
7320 (controllertypestr:'LM3S2911'; controllerunitstr:'LM3FURY'),
7321 (controllertypestr:'LM3S2918'; controllerunitstr:'LM3FURY'),
7322 (controllertypestr:'LM3S2919'; controllerunitstr:'LM3FURY'),
7323 (controllertypestr:'LM3S2939'; controllerunitstr:'LM3FURY'),
7324 (controllertypestr:'LM3S2948'; controllerunitstr:'LM3FURY'),
7325 (controllertypestr:'LM3S2950'; controllerunitstr:'LM3FURY'),
7326 (controllertypestr:'LM3S2965'; controllerunitstr:'LM3FURY'),
7327 (controllertypestr:'LM3S6911'; controllerunitstr:'LM3FURY'),
7328 (controllertypestr:'LM3S6918'; controllerunitstr:'LM3FURY'),
7329 (controllertypestr:'LM3S6938'; controllerunitstr:'LM3FURY'),
7330 (controllertypestr:'LM3S6950'; controllerunitstr:'LM3FURY'),
7331 (controllertypestr:'LM3S6952'; controllerunitstr:'LM3FURY'),
7332 (controllertypestr:'LM3S6965'; controllerunitstr:'LM3FURY'),
7333 (controllertypestr:'LM3S8930'; controllerunitstr:'LM3FURY'),
7334 (controllertypestr:'LM3S8933'; controllerunitstr:'LM3FURY'),
7335 (controllertypestr:'LM3S8938'; controllerunitstr:'LM3FURY'),
7336 (controllertypestr:'LM3S8962'; controllerunitstr:'LM3FURY'),
7337 (controllertypestr:'LM3S8970'; controllerunitstr:'LM3FURY'),
7338 (controllertypestr:'LM3S8971'; controllerunitstr:'LM3FURY'),
7339 (controllertypestr:'LM3S5951'; controllerunitstr:'LM3TEMPEST'),
7340 (controllertypestr:'LM3S5956'; controllerunitstr:'LM3TEMPEST'),
7341 (controllertypestr:'LM3S1B21'; controllerunitstr:'LM3TEMPEST'),
7342 (controllertypestr:'LM3S2B93'; controllerunitstr:'LM3TEMPEST'),
7343 (controllertypestr:'LM3S5B91'; controllerunitstr:'LM3TEMPEST'),
7344 (controllertypestr:'LM3S9B81'; controllerunitstr:'LM3TEMPEST'),
7345 (controllertypestr:'LM3S9B90'; controllerunitstr:'LM3TEMPEST'),
7346 (controllertypestr:'LM3S9B92'; controllerunitstr:'LM3TEMPEST'),
7347 (controllertypestr:'LM3S9B95'; controllerunitstr:'LM3TEMPEST'),
7348 (controllertypestr:'LM3S9B96'; controllerunitstr:'LM3TEMPEST'),
7349 (controllertypestr:'LM3S5D51'; controllerunitstr:'LM3TEMPEST'),
7350 (controllertypestr:'LM4F120H5'; controllerunitstr:'LM4F120'),
7351 (controllertypestr:'SC32442B'; controllerunitstr:'SC32442b'),
7352 (controllertypestr:'XMC4500X1024'; controllerunitstr:'XMC4500'),
7353 (controllertypestr:'XMC4500X768'; controllerunitstr:'XMC4500'),
7354 (controllertypestr:'XMC4502X768'; controllerunitstr:'XMC4502'),
7355 (controllertypestr:'XMC4504X512'; controllerunitstr:'XMC4504'),
7356 (controllertypestr:'ALLWINNER_A20'; controllerunitstr:'ALLWINNER_A20'),
7357 (controllertypestr:'MK20DX128VFM5'; controllerunitstr:'MK20D5'),
7358 (controllertypestr:'MK20DX128VFT5'; controllerunitstr:'MK20D5'),
7359 (controllertypestr:'MK20DX128VLF5'; controllerunitstr:'MK20D5'),
7360 (controllertypestr:'MK20DX128VLH5'; controllerunitstr:'MK20D5'),
7361 (controllertypestr:'TEENSY30' ; controllerunitstr:'MK20D5'),
7362 (controllertypestr:'MK20DX128VMP5'; controllerunitstr:'MK20D5'),
7363 (controllertypestr:'MK20DX32VFM5'; controllerunitstr:'MK20D5'),
7364 (controllertypestr:'MK20DX32VFT5'; controllerunitstr:'MK20D5'),
7365 (controllertypestr:'MK20DX32VLF5'; controllerunitstr:'MK20D5'),
7366 (controllertypestr:'MK20DX32VLH5'; controllerunitstr:'MK20D5'),
7367 (controllertypestr:'MK20DX32VMP5'; controllerunitstr:'MK20D5'),
7368 (controllertypestr:'MK20DX64VFM5'; controllerunitstr:'MK20D5'),
7369 (controllertypestr:'MK20DX64VFT5'; controllerunitstr:'MK20D5'),
7370 (controllertypestr:'MK20DX64VLF5'; controllerunitstr:'MK20D5'),
7371 (controllertypestr:'MK20DX64VLH5'; controllerunitstr:'MK20D5'),
7372 (controllertypestr:'MK20DX64VMP5'; controllerunitstr:'MK20D5'),
7373 (controllertypestr:'MK20DX128VLH7'; controllerunitstr:'MK20D7'),
7374 (controllertypestr:'MK20DX128VLK7'; controllerunitstr:'MK20D7'),
7375 (controllertypestr:'MK20DX128VLL7'; controllerunitstr:'MK20D7'),
7376 (controllertypestr:'MK20DX128VMC7'; controllerunitstr:'MK20D7'),
7377 (controllertypestr:'MK20DX256VLH7'; controllerunitstr:'MK20D7'),
7378 (controllertypestr:'MK20DX256VLK7'; controllerunitstr:'MK20D7'),
7379 (controllertypestr:'MK20DX256VLL7'; controllerunitstr:'MK20D7'),
7380 (controllertypestr:'MK20DX256VMC7'; controllerunitstr:'MK20D7'),
7381 (controllertypestr:'TEENSY31'; controllerunitstr:'MK20D7'),
7382 (controllertypestr:'TEENSY32'; controllerunitstr:'MK20D7'),
7383 (controllertypestr:'MK20DX64VLH7'; controllerunitstr:'MK20D7'),
7384 (controllertypestr:'MK20DX64VLK7'; controllerunitstr:'MK20D7'),
7385 (controllertypestr:'MK20DX64VMC7'; controllerunitstr:'MK20D7'),
7386 (controllertypestr:'MK22FN512CAP12'; controllerunitstr:'MK22F51212'),
7387 (controllertypestr:'MK22FN512CBP12'; controllerunitstr:'MK22F51212'),
7388 (controllertypestr:'MK22FN512VDC12'; controllerunitstr:'MK22F51212'),
7389 (controllertypestr:'MK22FN512VLH12'; controllerunitstr:'MK22F51212'),
7390 (controllertypestr:'MK22FN512VLL12'; controllerunitstr:'MK22F51212'),
7391 (controllertypestr:'MK22FN512VMP12'; controllerunitstr:'MK22F51212'),
7392 (controllertypestr:'FREEDOM_K22F'; controllerunitstr:'MK22F51212'),
7393 (controllertypestr:'MK64FN1M0VDC12'; controllerunitstr:'MK64F12'),
7394 (controllertypestr:'MK64FN1M0VLL12'; controllerunitstr:'MK64F12'),
7395 (controllertypestr:'FREEDOM_K64F'; controllerunitstr:'MK64F12'),
7396 (controllertypestr:'MK64FN1M0VLQ12'; controllerunitstr:'MK64F12'),
7397 (controllertypestr:'MK64FN1M0VMD12'; controllerunitstr:'MK64F12'),
7398 (controllertypestr:'MK64FX512VDC12'; controllerunitstr:'MK64F12'),
7399 (controllertypestr:'MK64FX512VLL12'; controllerunitstr:'MK64F12'),
7400 (controllertypestr:'MK64FX512VLQ12'; controllerunitstr:'MK64F12'),
7401 (controllertypestr:'MK64FX512VMD12'; controllerunitstr:'MK64F12'),
7402 (controllertypestr:'ATSAM3X8E'; controllerunitstr:'SAM3X8E'),
7403 (controllertypestr:'ARDUINO_DUE'; controllerunitstr:'SAM3X8E'),
7404 (controllertypestr:'FLIP_N_CLICK'; controllerunitstr:'SAM3X8E'),
7405 (controllertypestr:'THUMB2_BARE'; controllerunitstr:'THUMB2_BARE'),
7406 (controllertypestr:'PIC32MX110F016B'; controllerunitstr:'PIC32MX1xxFxxxB'),
7407 (controllertypestr:'PIC32MX110F016C'; controllerunitstr:'PIC32MX1xxFxxxC'),
7408 (controllertypestr:'PIC32MX110F016D'; controllerunitstr:'PIC32MX1xxFxxxD'),
7409 (controllertypestr:'PIC32MX120F032B'; controllerunitstr:'PIC32MX1xxFxxxB'),
7410 (controllertypestr:'PIC32MX120F032C'; controllerunitstr:'PIC32MX1xxFxxxC'),
7411 (controllertypestr:'PIC32MX120F032D'; controllerunitstr:'PIC32MX1xxFxxxD'),
7412 (controllertypestr:'PIC32MX130F064B'; controllerunitstr:'PIC32MX1xxFxxxB'),
7413 (controllertypestr:'PIC32MX130F064C'; controllerunitstr:'PIC32MX1xxFxxxC'),
7414 (controllertypestr:'PIC32MX130F064D'; controllerunitstr:'PIC32MX1xxFxxxD'),
7415 (controllertypestr:'PIC32MX150F128B'; controllerunitstr:'PIC32MX1xxFxxxB'),
7416 (controllertypestr:'PIC32MX150F128C'; controllerunitstr:'PIC32MX1xxFxxxC'),
7417 (controllertypestr:'PIC32MX150F128D'; controllerunitstr:'PIC32MX1xxFxxxD'),
7418 (controllertypestr:'PIC32MX210F016B'; controllerunitstr:'PIC32MX2xxFxxxB'),
7419 (controllertypestr:'PIC32MX210F016C'; controllerunitstr:'PIC32MX2xxFxxxC'),
7420 (controllertypestr:'PIC32MX210F016D'; controllerunitstr:'PIC32MX2xxFxxxD'),
7421 (controllertypestr:'PIC32MX220F032B'; controllerunitstr:'PIC32MX2xxFxxxB'),
7422 (controllertypestr:'PIC32MX220F032C'; controllerunitstr:'PIC32MX2xxFxxxC'),
7423 (controllertypestr:'PIC32MX220F032D'; controllerunitstr:'PIC32MX2xxFxxxD'),
7424 (controllertypestr:'PIC32MX230F064B'; controllerunitstr:'PIC32MX2xxFxxxB'),
7425 (controllertypestr:'PIC32MX230F064C'; controllerunitstr:'PIC32MX2xxFxxxC'),
7426 (controllertypestr:'PIC32MX230F064D'; controllerunitstr:'PIC32MX2xxFxxxD'),
7427 (controllertypestr:'PIC32MX250F128B'; controllerunitstr:'PIC32MX2xxFxxxB'),
7428 (controllertypestr:'PIC32MX250F128C'; controllerunitstr:'PIC32MX2xxFxxxC'),
7429 (controllertypestr:'PIC32MX250F128D'; controllerunitstr:'PIC32MX2xxFxxxD'),
7430 (controllertypestr:'PIC32MX775F256H'; controllerunitstr:'PIC32MX7x5FxxxH'),
7431 (controllertypestr:'PIC32MX775F256L'; controllerunitstr:'PIC32MX7x5FxxxL'),
7432 (controllertypestr:'PIC32MX775F512H'; controllerunitstr:'PIC32MX7x5FxxxH'),
7433 (controllertypestr:'PIC32MX775F512L'; controllerunitstr:'PIC32MX7x5FxxxL'),
7434 (controllertypestr:'PIC32MX795F512H'; controllerunitstr:'PIC32MX7x5FxxxH'),
7435 (controllertypestr:'PIC32MX795F512L'; controllerunitstr:'PIC32MX7x5FxxxL'),
7436 (controllertypestr:'ATMEGA645'; controllerunitstr:'ATMEGA645'),
7437 (controllertypestr:'ATMEGA165A'; controllerunitstr:'ATMEGA165A'),
7438 (controllertypestr:'ATTINY44A'; controllerunitstr:'ATTINY44A'),
7439 (controllertypestr:'ATMEGA649A'; controllerunitstr:'ATMEGA649A'),
7440 (controllertypestr:'ATMEGA32U4'; controllerunitstr:'ATMEGA32U4'),
7441 (controllertypestr:'ATTINY26'; controllerunitstr:'ATTINY26'),
7442 (controllertypestr:'AT90USB1287'; controllerunitstr:'AT90USB1287'),
7443 (controllertypestr:'AT90PWM161'; controllerunitstr:'AT90PWM161'),
7444 (controllertypestr:'ATTINY48'; controllerunitstr:'ATTINY48'),
7445 (controllertypestr:'ATMEGA168P'; controllerunitstr:'ATMEGA168P'),
7446 (controllertypestr:'ATTINY10'; controllerunitstr:'ATTINY10'),
7447 (controllertypestr:'ATTINY84A'; controllerunitstr:'ATTINY84A'),
7448 (controllertypestr:'AT90USB82'; controllerunitstr:'AT90USB82'),
7449 (controllertypestr:'ATTINY2313'; controllerunitstr:'ATTINY2313'),
7450 (controllertypestr:'ATTINY461'; controllerunitstr:'ATTINY461'),
7451 (controllertypestr:'ATMEGA3250PA'; controllerunitstr:'ATMEGA3250PA'),
7452 (controllertypestr:'ATMEGA3290A'; controllerunitstr:'ATMEGA3290A'),
7453 (controllertypestr:'ATMEGA165P'; controllerunitstr:'ATMEGA165P'),
7454 (controllertypestr:'ATTINY43U'; controllerunitstr:'ATTINY43U'),
7455 (controllertypestr:'AT90USB162'; controllerunitstr:'AT90USB162'),
7456 (controllertypestr:'ATMEGA16U4'; controllerunitstr:'ATMEGA16U4'),
7457 (controllertypestr:'ATTINY24A'; controllerunitstr:'ATTINY24A'),
7458 (controllertypestr:'ATMEGA88P'; controllerunitstr:'ATMEGA88P'),
7459 (controllertypestr:'ATTINY88'; controllerunitstr:'ATTINY88'),
7460 (controllertypestr:'ATMEGA6490P'; controllerunitstr:'ATMEGA6490P'),
7461 (controllertypestr:'ATTINY40'; controllerunitstr:'ATTINY40'),
7462 (controllertypestr:'ATMEGA324P'; controllerunitstr:'ATMEGA324P'),
7463 (controllertypestr:'ATTINY167'; controllerunitstr:'ATTINY167'),
7464 (controllertypestr:'ATMEGA328'; controllerunitstr:'ATMEGA328'),
7465 (controllertypestr:'ATTINY861'; controllerunitstr:'ATTINY861'),
7466 (controllertypestr:'ATTINY85'; controllerunitstr:'ATTINY85'),
7467 (controllertypestr:'ATMEGA64M1'; controllerunitstr:'ATMEGA64M1'),
7468 (controllertypestr:'ATMEGA645P'; controllerunitstr:'ATMEGA645P'),
7469 (controllertypestr:'ATMEGA8U2'; controllerunitstr:'ATMEGA8U2'),
7470 (controllertypestr:'ATMEGA329A'; controllerunitstr:'ATMEGA329A'),
7471 (controllertypestr:'ATMEGA8A'; controllerunitstr:'ATMEGA8A'),
7472 (controllertypestr:'ATMEGA324PA'; controllerunitstr:'ATMEGA324PA'),
7473 (controllertypestr:'ATMEGA32HVB'; controllerunitstr:'ATMEGA32HVB'),
7474 (controllertypestr:'AT90PWM316'; controllerunitstr:'AT90PWM316'),
7475 (controllertypestr:'AT90PWM3B'; controllerunitstr:'AT90PWM3B'),
7476 (controllertypestr:'AT90USB646'; controllerunitstr:'AT90USB646'),
7477 (controllertypestr:'ATTINY20'; controllerunitstr:'ATTINY20'),
7478 (controllertypestr:'ATMEGA16'; controllerunitstr:'ATMEGA16'),
7479 (controllertypestr:'ATMEGA48A'; controllerunitstr:'ATMEGA48A'),
7480 (controllertypestr:'ATTINY24'; controllerunitstr:'ATTINY24'),
7481 (controllertypestr:'ATMEGA644'; controllerunitstr:'ATMEGA644'),
7482 (controllertypestr:'ATMEGA1284'; controllerunitstr:'ATMEGA1284'),
7483 (controllertypestr:'ATA6285'; controllerunitstr:'ATA6285'),
7484 (controllertypestr:'AT90CAN64'; controllerunitstr:'AT90CAN64'),
7485 (controllertypestr:'ATMEGA48'; controllerunitstr:'ATMEGA48'),
7486 (controllertypestr:'AT90CAN32'; controllerunitstr:'AT90CAN32'),
7487 (controllertypestr:'ATTINY9'; controllerunitstr:'ATTINY9'),
7488 (controllertypestr:'ATTINY87'; controllerunitstr:'ATTINY87'),
7489 (controllertypestr:'ATMEGA1281'; controllerunitstr:'ATMEGA1281'),
7490 (controllertypestr:'AT90PWM216'; controllerunitstr:'AT90PWM216'),
7491 (controllertypestr:'ATMEGA3250A'; controllerunitstr:'ATMEGA3250A'),
7492 (controllertypestr:'ATMEGA88A'; controllerunitstr:'ATMEGA88A'),
7493 (controllertypestr:'ATMEGA128RFA1'; controllerunitstr:'ATMEGA128RFA1'),
7494 (controllertypestr:'ATMEGA3290PA'; controllerunitstr:'ATMEGA3290PA'),
7495 (controllertypestr:'AT90PWM81'; controllerunitstr:'AT90PWM81'),
7496 (controllertypestr:'ATMEGA325P'; controllerunitstr:'ATMEGA325P'),
7497 (controllertypestr:'ATTINY84'; controllerunitstr:'ATTINY84'),
7498 (controllertypestr:'ATMEGA328P'; controllerunitstr:'ATMEGA328P'),
7499 (controllertypestr:'ATTINY13A'; controllerunitstr:'ATTINY13A'),
7500 (controllertypestr:'ATMEGA8'; controllerunitstr:'ATMEGA8'),
7501 (controllertypestr:'ATMEGA1284P'; controllerunitstr:'ATMEGA1284P'),
7502 (controllertypestr:'ATMEGA16U2'; controllerunitstr:'ATMEGA16U2'),
7503 (controllertypestr:'ATTINY45'; controllerunitstr:'ATTINY45'),
7504 (controllertypestr:'ATMEGA3250'; controllerunitstr:'ATMEGA3250'),
7505 (controllertypestr:'ATMEGA329'; controllerunitstr:'ATMEGA329'),
7506 (controllertypestr:'ATMEGA32A'; controllerunitstr:'ATMEGA32A'),
7507 (controllertypestr:'ATTINY5'; controllerunitstr:'ATTINY5'),
7508 (controllertypestr:'AT90CAN128'; controllerunitstr:'AT90CAN128'),
7509 (controllertypestr:'ATMEGA6490'; controllerunitstr:'ATMEGA6490'),
7510 (controllertypestr:'ATMEGA8515'; controllerunitstr:'ATMEGA8515'),
7511 (controllertypestr:'ATMEGA88PA'; controllerunitstr:'ATMEGA88PA'),
7512 (controllertypestr:'ATMEGA168A'; controllerunitstr:'ATMEGA168A'),
7513 (controllertypestr:'ATMEGA128'; controllerunitstr:'ATMEGA128'),
7514 (controllertypestr:'AT90USB1286'; controllerunitstr:'AT90USB1286'),
7515 (controllertypestr:'ATMEGA164PA'; controllerunitstr:'ATMEGA164PA'),
7516 (controllertypestr:'ATTINY828'; controllerunitstr:'ATTINY828'),
7517 (controllertypestr:'ATMEGA88'; controllerunitstr:'ATMEGA88'),
7518 (controllertypestr:'ATMEGA645A'; controllerunitstr:'ATMEGA645A'),
7519 (controllertypestr:'ATMEGA3290P'; controllerunitstr:'ATMEGA3290P'),
7520 (controllertypestr:'ATMEGA644P'; controllerunitstr:'ATMEGA644P'),
7521 (controllertypestr:'ATMEGA164A'; controllerunitstr:'ATMEGA164A'),
7522 (controllertypestr:'ATTINY4313'; controllerunitstr:'ATTINY4313'),
7523 (controllertypestr:'ATMEGA162'; controllerunitstr:'ATMEGA162'),
7524 (controllertypestr:'ATMEGA32C1'; controllerunitstr:'ATMEGA32C1'),
7525 (controllertypestr:'ATMEGA128A'; controllerunitstr:'ATMEGA128A'),
7526 (controllertypestr:'ATMEGA324A'; controllerunitstr:'ATMEGA324A'),
7527 (controllertypestr:'ATTINY13'; controllerunitstr:'ATTINY13'),
7528 (controllertypestr:'ATMEGA2561'; controllerunitstr:'ATMEGA2561'),
7529 (controllertypestr:'ATMEGA169A'; controllerunitstr:'ATMEGA169A'),
7530 (controllertypestr:'ATTINY261'; controllerunitstr:'ATTINY261'),
7531 (controllertypestr:'ATMEGA644A'; controllerunitstr:'ATMEGA644A'),
7532 (controllertypestr:'ATMEGA3290'; controllerunitstr:'ATMEGA3290'),
7533 (controllertypestr:'ATMEGA64A'; controllerunitstr:'ATMEGA64A'),
7534 (controllertypestr:'ATMEGA169P'; controllerunitstr:'ATMEGA169P'),
7535 (controllertypestr:'ATMEGA2560'; controllerunitstr:'ATMEGA2560'),
7536 (controllertypestr:'ATMEGA32'; controllerunitstr:'ATMEGA32'),
7537 (controllertypestr:'ATTINY861A'; controllerunitstr:'ATTINY861A'),
7538 (controllertypestr:'ATTINY28'; controllerunitstr:'ATTINY28'),
7539 (controllertypestr:'ATMEGA48P'; controllerunitstr:'ATMEGA48P'),
7540 (controllertypestr:'ATMEGA8535'; controllerunitstr:'ATMEGA8535'),
7541 (controllertypestr:'ATMEGA168PA'; controllerunitstr:'ATMEGA168PA'),
7542 (controllertypestr:'ATMEGA16M1'; controllerunitstr:'ATMEGA16M1'),
7543 (controllertypestr:'ATMEGA16HVB'; controllerunitstr:'ATMEGA16HVB'),
7544 (controllertypestr:'ATMEGA164P'; controllerunitstr:'ATMEGA164P'),
7545 (controllertypestr:'ATMEGA325A'; controllerunitstr:'ATMEGA325A'),
7546 (controllertypestr:'ATMEGA640'; controllerunitstr:'ATMEGA640'),
7547 (controllertypestr:'ATMEGA6450'; controllerunitstr:'ATMEGA6450'),
7548 (controllertypestr:'ATMEGA329P'; controllerunitstr:'ATMEGA329P'),
7549 (controllertypestr:'ATA6286'; controllerunitstr:'ATA6286'),
7550 (controllertypestr:'AT90USB647'; controllerunitstr:'AT90USB647'),
7551 (controllertypestr:'ATMEGA168'; controllerunitstr:'ATMEGA168'),
7552 (controllertypestr:'ATMEGA6490A'; controllerunitstr:'ATMEGA6490A'),
7553 (controllertypestr:'ATMEGA32M1'; controllerunitstr:'ATMEGA32M1'),
7554 (controllertypestr:'ATMEGA64C1'; controllerunitstr:'ATMEGA64C1'),
7555 (controllertypestr:'ATMEGA32U2'; controllerunitstr:'ATMEGA32U2'),
7556 (controllertypestr:'ATTINY4'; controllerunitstr:'ATTINY4'),
7557 (controllertypestr:'ATMEGA644PA'; controllerunitstr:'ATMEGA644PA'),
7558 (controllertypestr:'AT90PWM1'; controllerunitstr:'AT90PWM1'),
7559 (controllertypestr:'ATTINY44'; controllerunitstr:'ATTINY44'),
7560 (controllertypestr:'ATMEGA325PA'; controllerunitstr:'ATMEGA325PA'),
7561 (controllertypestr:'ATMEGA6450A'; controllerunitstr:'ATMEGA6450A'),
7562 (controllertypestr:'ATTINY2313A'; controllerunitstr:'ATTINY2313A'),
7563 (controllertypestr:'ATMEGA329PA'; controllerunitstr:'ATMEGA329PA'),
7564 (controllertypestr:'ATTINY461A'; controllerunitstr:'ATTINY461A'),
7565 (controllertypestr:'ATMEGA6450P'; controllerunitstr:'ATMEGA6450P'),
7566 (controllertypestr:'ATMEGA64'; controllerunitstr:'ATMEGA64'),
7567 (controllertypestr:'ATMEGA165PA'; controllerunitstr:'ATMEGA165PA'),
7568 (controllertypestr:'ATMEGA16A'; controllerunitstr:'ATMEGA16A'),
7569 (controllertypestr:'ATMEGA649'; controllerunitstr:'ATMEGA649'),
7570 (controllertypestr:'ATMEGA1280'; controllerunitstr:'ATMEGA1280'),
7571 (controllertypestr:'AT90PWM2B'; controllerunitstr:'AT90PWM2B'),
7572 (controllertypestr:'ATMEGA649P'; controllerunitstr:'ATMEGA649P'),
7573 (controllertypestr:'ATMEGA3250P'; controllerunitstr:'ATMEGA3250P'),
7574 (controllertypestr:'ATMEGA48PA'; controllerunitstr:'ATMEGA48PA'),
7575 (controllertypestr:'ATTINY1634'; controllerunitstr:'ATTINY1634'),
7576 (controllertypestr:'ATMEGA325'; controllerunitstr:'ATMEGA325'),
7577 (controllertypestr:'ATMEGA169PA'; controllerunitstr:'ATMEGA169PA'),
7578 (controllertypestr:'ATTINY261A'; controllerunitstr:'ATTINY261A'),
7579 (controllertypestr:'ATTINY25'; controllerunitstr:'ATTINY25'));
7580
7581 var
7582 i: integer;
7583 str: String;
7584 begin
7585 str:=UpperCase(AControllerName);
7586 for i := low(ControllerTypes) to high(ControllerTypes) do
7587 if ControllerTypes[i].controllertypestr=str then
7588 exit(ControllerTypes[i].controllerunitstr);
7589 result:='';
7590 end;
7591
7592 var
7593 s: string;
7594 CompilerMode: String;
7595 m: Integer;
7596 UnitPath: String;
7597 IncPath: String;
7598 Params: TStrings;
7599 i: Integer;
7600 Param, Namespaces: String;
7601 p: PChar;
7602 MacMinVer: single;
7603 begin
7604 Result:=nil;
7605 if AlwaysCreate then
7606 CreateMainTemplate;
7607 CompilerMode:='';
7608 UnitPath:='';
7609 IncPath:='';
7610 Namespaces:='';
7611 Params:=TStringListUTF8.Create;
7612 try
7613 SplitCmdLineParams(CmdLine,Params);
7614 for i:=0 to Params.Count-1 do begin
7615 Param:=Params[i];
7616 if Param='' then continue;
7617 p:=PChar(Param);
7618 if p^<>'-' then continue;
7619 // a parameter
7620 case p[1] of
7621 'F':
7622 case p[2] of
7623 'i':
7624 IncPath+=';'+copy(Param,4,length(Param));
7625 'u':
7626 UnitPath+=';'+copy(Param,4,length(Param));
7627 'N':
7628 Namespaces+=';'+copy(Param,4,length(Param));
7629 end;
7630
7631 'd':
7632 begin
7633 // define
7634 AddDefine(copy(Param,3,255));
7635 end;
7636
7637 'u':
7638 begin
7639 // undefine
7640 AddUndefine(copy(Param,3,255));
7641 end;
7642
7643 'S':
7644 begin
7645 // syntax
7646 inc(p,2);
7647 repeat
7648 case p^ of
7649 '2': CompilerMode:='ObjFPC';
7650 'd': CompilerMode:='Delphi';
7651 'o': CompilerMode:='TP';
7652 'p': CompilerMode:='GPC';
7653 else break;
7654 end;
7655 inc(p);
7656 until false;
7657 end;
7658
7659 'M':
7660 begin
7661 // syntax
7662 CompilerMode:=copy(Param,3,255);
7663 end;
7664
7665 'N':
7666 case p[2] of
7667 'S': Namespaces+=';'+copy(Param,4,length(Param))
7668 end;
7669
7670 'W':
7671 case p[2] of
7672 'p':
7673 begin
7674 s:=FindControllerUnit(copy(Param,4,255));
7675
7676 // controller unit
7677 if s<>'' then
7678 AddDefine('Define '+MacroControllerUnit,
7679 ctsDefine+MacroControllerUnit,MacroControllerUnit,
7680 s);
7681 end;
7682 'M':
7683 begin
7684 val(copy(Param,4,255),MacMinVer,m);
7685 if m=0 then
7686 AddDefine(MacOSMinSDKVersionMacro,MacOSMinSDKVersionMacro,
7687 MacOSMinSDKVersionMacro,IntToStr(Round(MacMinVer*100)));
7688 end;
7689 end;
7690
7691 end;
7692 end;
7693 finally
7694 Params.Free;
7695 end;
7696 if CompilerMode<>'' then begin
7697 for m:=low(FPCSyntaxModes) to high(FPCSyntaxModes) do
7698 AddDefineUndefine('FPC_'+FPCSyntaxModes[m],SysUtils.CompareText(CompilerMode,FPCSyntaxModes[m])=0);
7699 end;
7700 if AddPaths then begin
7701 if UnitPath<>'' then
7702 AddDefine('UnitPath','UnitPath addition',UnitPathMacroName,UnitPathMacro+';'+UnitPath);
7703 if IncPath<>'' then
7704 AddDefine('IncPath','IncPath addition',IncludePathMacroName,IncludePathMacro+';'+IncPath);
7705 end;
7706 if Namespaces<>'' then
7707 AddDefine('Namespaces','Namespaces addition',NamespacesMacroName,NamespacesMacro+';'+Namespaces);
7708
7709 Result.SetDefineOwner(Owner,true);
7710 end;
7711
7712 procedure TDefinePool.ConsistencyCheck;
7713 var i: integer;
7714 begin
7715 for i:=0 to Count-1 do
7716 Items[i].ConsistencyCheck;
7717 end;
7718
7719 procedure TDefinePool.WriteDebugReport;
7720 var i: integer;
7721 begin
7722 DebugLn('TDefinePool.WriteDebugReport');
7723 for i:=0 to Count-1 do
7724 Items[i].WriteDebugReport(false);
7725 ConsistencyCheck;
7726 end;
7727
7728 procedure TDefinePool.CalcMemSize(Stats: TCTMemStats);
7729 var
7730 i: Integer;
7731 begin
7732 Stats.Add('TDefinePool',PtrUInt(InstanceSize)
7733 +MemSizeString(FEnglishErrorMsgFilename));
7734 if FItems<>nil then begin
7735 Stats.Add('TDefinePool.Count',Count);
7736 for i:=0 to Count-1 do
7737 Items[i].CalcMemSize(Stats);
7738 end;
7739 end;
7740
7741
7742 { TFPCSourceRules }
7743
TFPCSourceRules.GetItemsnull7744 function TFPCSourceRules.GetItems(Index: integer): TFPCSourceRule;
7745 begin
7746 Result:=TFPCSourceRule(FItems[Index]);
7747 end;
7748
7749 procedure TFPCSourceRules.SetTargets(const AValue: string);
7750 begin
7751 if FTargets=AValue then exit;
7752 FTargets:=LowerCase(AValue);
7753 end;
7754
7755 constructor TFPCSourceRules.Create;
7756 begin
7757 FItems:=TFPList.Create;
7758 end;
7759
7760 destructor TFPCSourceRules.Destroy;
7761 begin
7762 Clear;
7763 FreeAndNil(FItems);
7764 inherited Destroy;
7765 end;
7766
7767 procedure TFPCSourceRules.Clear;
7768 var
7769 i: Integer;
7770 begin
7771 if FItems.Count=0 then exit;
7772 for i:=0 to FItems.Count-1 do
7773 TObject(FItems[i]).Free;
7774 FItems.Clear;
7775 IncreaseChangeStamp;
7776 end;
7777
TFPCSourceRules.IsEqualnull7778 function TFPCSourceRules.IsEqual(Rules: TFPCSourceRules): boolean;
7779 var
7780 i: Integer;
7781 begin
7782 Result:=false;
7783 if Count<>Rules.Count then exit;
7784 for i:=0 to Count-1 do
7785 if not Items[i].IsEqual(Rules[i]) then exit;
7786 Result:=true;
7787 end;
7788
7789 procedure TFPCSourceRules.Assign(Rules: TFPCSourceRules);
7790 var
7791 i: Integer;
7792 SrcRule: TFPCSourceRule;
7793 Rule: TFPCSourceRule;
7794 begin
7795 if IsEqual(Rules) then exit;
7796 Clear;
7797 for i:=0 to Rules.Count-1 do begin
7798 SrcRule:=Rules[i];
7799 Rule:=Add(SrcRule.Filename);
7800 Rule.Assign(SrcRule);
7801 //debugln(['TFPCSourceRules.Assign ',i,' ',Rule.Targets,' ',Rule.Filename]);
7802 end;
7803 IncreaseChangeStamp;
7804 end;
7805
TFPCSourceRules.Clonenull7806 function TFPCSourceRules.Clone: TFPCSourceRules;
7807 begin
7808 Result:=TFPCSourceRules.Create;
7809 Result.Assign(Self);
7810 end;
7811
Countnull7812 function TFPCSourceRules.Count: integer;
7813 begin
7814 Result:=FItems.Count;
7815 end;
7816
Addnull7817 function TFPCSourceRules.Add(const Filename: string): TFPCSourceRule;
7818 begin
7819 Result:=TFPCSourceRule.Create;
7820 Result.Score:=Score;
7821 Result.Targets:=Targets;
7822 //DebugLn(['TFPCSourceRules.Add Targets="',Result.Targets,'" Priority=',Result.Score]);
7823 Result.Filename:=lowercase(GetForcedPathDelims(Filename));
7824 FItems.Add(Result);
7825 IncreaseChangeStamp;
7826 end;
7827
TFPCSourceRules.GetDefaultTargetsnull7828 function TFPCSourceRules.GetDefaultTargets(TargetOS, TargetCPU: string): string;
7829 var
7830 SrcOS: String;
7831 SrcOS2: String;
7832 SrcCPU: String;
7833 begin
7834 if TargetOS='' then
7835 TargetOS:=GetCompiledTargetOS;
7836 if TargetCPU='' then
7837 TargetCPU:=GetCompiledTargetCPU;
7838 Result:=TargetOS+','+TargetCPU;
7839 SrcOS:=GetDefaultSrcOSForTargetOS(TargetOS);
7840 SrcOS2:=GetDefaultSrcOS2ForTargetOS(TargetOS);
7841 SrcCPU:=GetDefaultSrcCPUForTargetCPU(TargetCPU);
7842 if SrcOS<>'' then Result:=Result+','+SrcOS;
7843 if SrcOS2<>'' then Result:=Result+','+SrcOS2;
7844 if SrcCPU<>'' then Result:=Result+','+SrcCPU;
7845 end;
7846
7847 procedure TFPCSourceRules.GetRulesForTargets(Targets: string;
7848 var RulesSortedForFilenameStart: TAVLTree);
7849 var
7850 i: Integer;
7851 begin
7852 if RulesSortedForFilenameStart=nil then
7853 RulesSortedForFilenameStart:=
7854 TAVLTree.Create(@CompareFPCSourceRulesViaFilename);
7855 for i:=0 to Count-1 do
7856 if Items[i].FitsTargets(Targets) then
7857 RulesSortedForFilenameStart.Add(Items[i]);
7858 end;
7859
TFPCSourceRules.GetScorenull7860 function TFPCSourceRules.GetScore(Filename: string;
7861 RulesSortedForFilenameStart: TAVLTree): integer;
7862 var
7863 Node: TAVLTreeNode;
7864 Rule: TFPCSourceRule;
7865 cmp: LongInt;
7866 Cnt: Integer;
7867 begin
7868 Result:=0;
7869 if Filename='' then exit;
7870 Filename:=LowerCase(Filename);
7871 {Node:=RulesSortedForFilenameStart.FindLowest;
7872 while Node<>nil do begin
7873 Rule:=TFPCSourceRule(Node.Data);
7874 DebugLn(['TFPCSourceRules.GetScore Rule: ',Rule.Score,' ',Rule.Filename]);
7875 Node:=RulesSortedForFilenameStart.FindSuccessor(Node);
7876 end;}
7877 // find first rule for Filename
7878 Node:=RulesSortedForFilenameStart.Root;
7879 while true do begin
7880 Rule:=TFPCSourceRule(Node.Data);
7881 cmp:=CompareFilenames(Filename,Rule.Filename);
7882 //DebugLn(['TFPCSourceRules.GetScore Rule.Filename=',Rule.Filename,' Filename=',Filename,' cmp=',cmp]);
7883 if cmp=0 then
7884 break;
7885 if cmp<0 then begin
7886 if Node.Left<>nil then
7887 Node:=Node.Left
7888 else
7889 break;
7890 end else begin
7891 if Node.Right<>nil then
7892 Node:=Node.Right
7893 else
7894 break;
7895 end;
7896 end;
7897 { The rules are sorted for the file name. Shorter file names comes before
7898 longer ones.
7899 packages/httpd20/examples
7900 packages/httpd22
7901 packages/httpd22/examples
7902 A filename packages/httpd22/examples matches
7903 packages/httpd22
7904 and packages/httpd22/examples
7905 If a file name has no exact match the binary search for packages/httpd22/e
7906 can either point to
7907 packages/httpd22
7908 or packages/httpd22/examples
7909 }
7910
7911 // run through all fitting rules (the Filename is >= Rule.Filename)
7912 Cnt:=0;
7913 while Node<>nil do begin
7914 inc(Cnt);
7915 Rule:=TFPCSourceRule(Node.Data);
7916 if Rule.FitsFilename(Filename) then
7917 inc(Result,Rule.Score)
7918 else if Cnt>1 then
7919 break;
7920 Node:=RulesSortedForFilenameStart.FindPrecessor(Node);
7921 end;
7922 end;
7923
7924 procedure TFPCSourceRules.IncreaseChangeStamp;
7925 begin
7926 if FChangeStamp<High(FChangeStamp) then
7927 inc(FChangeStamp)
7928 else
7929 FChangeStamp:=Low(FChangeStamp);
7930 end;
7931
7932 { TFPCSourceRule }
7933
TFPCSourceRule.FitsTargetsnull7934 function TFPCSourceRule.FitsTargets(const FilterTargets: string): boolean;
7935 var
7936 FilterStartPos: PChar;
7937 TargetPos: PChar;
7938 FilterPos: PChar;
7939 begin
7940 //DebugLn(['TFPCSourceRule.FitsTargets FilterTargets="',FilterTargets,'" Targets="',Targets,'"']);
7941 if Targets='*' then exit(true);
7942 if (Targets='') or (FilterTargets='') then exit(false);
7943 FilterStartPos:=PChar(FilterTargets);
7944 while true do begin
7945 while (FilterStartPos^=',') do inc(FilterStartPos);
7946 if FilterStartPos^=#0 then exit(false);
7947 TargetPos:=PChar(Targets);
7948 repeat
7949 while (TargetPos^=',') do inc(TargetPos);
7950 if TargetPos^=#0 then break;
7951 FilterPos:=FilterStartPos;
7952 while (FilterPos^=TargetPos^) and (not (FilterPos^ in [#0,','])) do begin
7953 inc(TargetPos);
7954 inc(FilterPos);
7955 end;
7956 if (TargetPos^ in [#0,',']) then begin
7957 // the target fits
7958 exit(true);
7959 end;
7960 // try next target
7961 while not (TargetPos^ in [#0,',']) do inc(TargetPos);
7962 until TargetPos^=#0;
7963 // next target filter
7964 while not (FilterStartPos^ in [#0,',']) do inc(FilterStartPos);
7965 end;
7966 Result:=false;
7967 end;
7968
TFPCSourceRule.FitsFilenamenull7969 function TFPCSourceRule.FitsFilename(const aFilename: string): boolean;
7970 begin
7971 Result:=(length(Filename)<=length(aFilename))
7972 and CompareMem(Pointer(Filename),Pointer(aFilename),length(Filename));
7973 end;
7974
TFPCSourceRule.IsEqualnull7975 function TFPCSourceRule.IsEqual(Rule: TFPCSourceRule): boolean;
7976 begin
7977 Result:=false;
7978 if (Filename<>Rule.Filename)
7979 or (Score<>Rule.Score)
7980 or (Targets<>Rule.Targets) then
7981 exit;
7982 Result:=true;
7983 end;
7984
7985 procedure TFPCSourceRule.Assign(Rule: TFPCSourceRule);
7986 begin
7987 Filename:=Rule.Filename;
7988 Score:=Rule.Score;
7989 Targets:=Rule.Targets;
7990 end;
7991
7992 { TPCTargetConfigCache }
7993
7994 constructor TPCTargetConfigCache.Create(AOwner: TComponent);
7995 begin
7996 CTIncreaseChangeStamp(FChangeStamp); // set to not 0
7997 inherited Create(AOwner);
7998 ConfigFiles:=TPCConfigFileStateList.Create;
7999 if Owner is TPCTargetConfigCaches then
8000 Caches:=TPCTargetConfigCaches(Owner);
8001 end;
8002
8003 destructor TPCTargetConfigCache.Destroy;
8004 begin
8005 Clear;
8006 FreeAndNil(ConfigFiles);
8007 inherited Destroy;
8008 end;
8009
8010 procedure TPCTargetConfigCache.Clear;
8011 begin
8012 // keep keys
8013 Kind:=pcFPC;
8014 CompilerDate:=0;
8015 RealCompiler:='';
8016 RealCompilerDate:=0;
8017 RealTargetCPU:='';
8018 RealTargetOS:='';
8019 RealTargetCPUCompiler:='';
8020 FullVersion:='';
8021 HasPPUs:=false;
8022 ConfigFiles.Clear;
8023 ErrorMsg:='';
8024 ErrorTranslatedMsg:='';
8025 FreeAndNil(Defines);
8026 FreeAndNil(Undefines);
8027 FreeAndNil(UnitPaths);
8028 FreeAndNil(IncludePaths);
8029 FreeAndNil(UnitScopes);
8030 FreeAndNil(Units);
8031 FreeAndNil(Includes);
8032 end;
8033
Equalsnull8034 function TPCTargetConfigCache.Equals(Item: TPCTargetConfigCache;
8035 CompareKey: boolean): boolean;
8036
CompareStringsnull8037 function CompareStrings(List1, List2: TStrings): boolean;
8038 var
8039 List1Empty: Boolean;
8040 List2Empty: Boolean;
8041 begin
8042 Result:=false;
8043 List1Empty:=(List1=nil) or (List1.Count=0);
8044 List2Empty:=(List2=nil) or (List2.Count=0);
8045 if (List1Empty<>List2Empty) then exit;
8046 if (not List1Empty) and (not List1.Equals(List2)) then exit;
8047 Result:=true;
8048 end;
8049
CompareStringTreesnull8050 function CompareStringTrees(Tree1, Tree2: TStringToStringTree): boolean;
8051 var
8052 Tree1Empty: Boolean;
8053 Tree2Empty: Boolean;
8054 begin
8055 Result:=false;
8056 Tree1Empty:=(Tree1=nil) or (Tree1.Tree.Count=0);
8057 Tree2Empty:=(Tree2=nil) or (Tree2.Tree.Count=0);
8058 if (Tree1Empty<>Tree2Empty) then exit;
8059 if (not Tree1Empty) and (not Tree1.Equals(Tree2)) then exit;
8060 Result:=true;
8061 end;
8062
8063 begin
8064 Result:=false;
8065 if CompareKey then begin
8066 if (TargetOS<>Item.TargetOS)
8067 or (TargetCPU<>Item.TargetCPU)
8068 or (Compiler<>Item.Compiler)
8069 or (CompilerOptions<>Item.CompilerOptions)
8070 then
8071 exit;
8072 end;
8073 if (Kind<>Item.Kind)
8074 or (CompilerDate<>Item.CompilerDate)
8075 or (RealCompiler<>Item.RealCompiler)
8076 or (RealCompilerDate<>Item.RealCompilerDate)
8077 or (RealTargetOS<>Item.RealTargetOS)
8078 or (RealTargetCPU<>Item.RealTargetCPU)
8079 or (RealTargetCPUCompiler<>Item.RealTargetCPUCompiler)
8080 or (FullVersion<>Item.FullVersion)
8081 or (HasPPUs<>Item.HasPPUs)
8082 or (not ConfigFiles.Equals(Item.ConfigFiles,true))
8083 then
8084 exit;
8085 if not CompareStringTrees(Defines,Item.Defines) then exit;
8086 if not CompareStringTrees(Undefines,Item.Undefines) then exit;
8087 if not CompareStrings(UnitPaths,Item.UnitPaths) then exit;
8088 if not CompareStrings(IncludePaths,Item.IncludePaths) then exit;
8089 if not CompareStrings(UnitScopes,Item.UnitScopes) then exit;
8090 if not CompareStringTrees(Units,Item.Units) then exit;
8091 if not CompareStringTrees(Includes,Item.Includes) then exit;
8092 Result:=true;
8093 end;
8094
8095 procedure TPCTargetConfigCache.Assign(Source: TPersistent);
8096 var
8097 Item: TPCTargetConfigCache;
8098
8099 procedure AssignStringTree(var Dest: TStringToStringTree; const Src: TStringToStringTree);
8100 begin
8101 if Src<>nil then begin
8102 if Dest=nil then Dest:=TStringToStringTree.Create(false);
8103 Dest.Assign(Src);
8104 end else begin
8105 FreeAndNil(Dest);
8106 end;
8107 end;
8108
8109 procedure AssignStringList(var Dest: TStrings; const Src: TStrings);
8110 begin
8111 if Src<>nil then begin
8112 if Dest=nil then Dest:=TStringList.Create;
8113 Dest.Assign(Src);
8114 end else begin
8115 FreeAndNil(Dest);
8116 end;
8117 end;
8118
8119 begin
8120 if Source is TPCTargetConfigCache then begin
8121 Item:=TPCTargetConfigCache(Source);
8122 // keys
8123 TargetOS:=Item.TargetOS;
8124 TargetCPU:=Item.TargetCPU;
8125 Compiler:=Item.Compiler;
8126 CompilerOptions:=Item.CompilerOptions;
8127 // values
8128 Kind:=Item.Kind;
8129 CompilerDate:=Item.CompilerDate;
8130 RealCompiler:=Item.RealCompiler;
8131 RealCompilerDate:=Item.RealCompilerDate;
8132 RealTargetOS:=Item.RealTargetOS;
8133 RealTargetCPU:=Item.RealTargetCPU;
8134 RealTargetCPUCompiler:=Item.RealTargetCPUCompiler;
8135 FullVersion:=Item.FullVersion;
8136 HasPPUs:=Item.HasPPUs;
8137 ConfigFiles.Assign(Item.ConfigFiles);
8138
8139 AssignStringTree(Defines,Item.Defines);
8140 AssignStringTree(Undefines,Item.Undefines);
8141 AssignStringList(UnitPaths,Item.UnitPaths);
8142 AssignStringList(IncludePaths,Item.IncludePaths);
8143 AssignStringList(UnitScopes,Item.UnitScopes);
8144 AssignStringTree(Units,Item.Units);
8145 AssignStringTree(Includes,Item.Includes);
8146
8147 ErrorMsg:=Item.ErrorMsg;
8148 ErrorTranslatedMsg:=Item.ErrorTranslatedMsg;
8149 end else
8150 inherited Assign(Source);
8151 end;
8152
8153 procedure TPCTargetConfigCache.LoadFromXMLConfig(XMLConfig: TXMLConfig;
8154 const Path: string);
8155
8156 procedure LoadPathsFor(out ADest: TStrings; const ASubPath: string);
8157 var
8158 i: Integer;
8159 List: TStringList;
8160 BaseDir, s: String;
8161 begin
8162 // Paths: format: semicolon separated compressed list
8163 List:=TStringList.Create;
8164 try
8165 s:=XMLConfig.GetValue(Path+ASubPath+'Value','');
8166 List.Delimiter:=';';
8167 List.StrictDelimiter:=true;
8168 List.DelimitedText:=s;
8169 ADest:=Decompress1FileList(List);
8170 BaseDir:=TrimFilename(AppendPathDelim(XMLConfig.GetValue(Path+ASubPath+'BaseDir','')));
8171 if BaseDir<>'' then
8172 for i:=0 to ADest.Count-1 do
8173 ADest[i]:=ChompPathDelim(TrimFilename(BaseDir+ADest[i]))
8174 else
8175 for i:=ADest.Count-1 downto 0 do
8176 if ADest[i]='' then
8177 ADest.Delete(i)
8178 else
8179 ADest[i]:=ChompPathDelim(TrimFilename(ADest[i]));
8180 // do not sort, order is important (e.g. for httpd.ppu)
8181 finally
8182 List.Free;
8183 end;
8184 end;
8185
8186 procedure LoadSemicolonList(out UnitScopes: TStrings; const ASubPath: string);
8187 var
8188 s, Scope: String;
8189 p: Integer;
8190 begin
8191 UnitScopes:=TStringList.Create;
8192 s:=XMLConfig.GetValue(Path+ASubPath,'');
8193 p:=1;
8194 while p<=length(s) do begin
8195 Scope:=GetNextDelimitedItem(s,';',p);
8196 if Scope<>'' then
8197 UnitScopes.Add(Scope);
8198 end;
8199 end;
8200
8201 procedure LoadFilesFor(var ADest: TStringToStringTree; const ASubPath: string);
8202 var
8203 i: Integer;
8204 List: TStringList;
8205 File_Name, CurPath, s, Filename: String;
8206 FileList: TStringList;
8207 begin
8208 // files: format: ASubPath+Values semicolon separated list of compressed filename
8209 if ADest=nil then
8210 ADest:=TStringToStringTree.Create(false);
8211 List:=TStringList.Create;
8212 FileList:=nil;
8213 try
8214 CurPath:=Path+ASubPath+'Value';
8215 s:=XMLConfig.GetValue(CurPath,'');
8216 List.Delimiter:=';';
8217 List.StrictDelimiter:=true;
8218 List.DelimitedText:=s;
8219 FileList:=Decompress1FileList(List);
8220 for i:=0 to FileList.Count-1 do begin
8221 Filename:=TrimFilename(FileList[i]);
8222 File_Name:=ExtractFileNameOnly(Filename);
8223 if (File_Name='') or not IsDottedIdentifier(File_Name) then begin
8224 DebugLn(['Warning: [TPCTargetConfigCache.LoadFromXMLConfig] invalid filename "',File_Name,'" in "',XMLConfig.Filename,'" at "',CurPath,'"']);
8225 continue;
8226 end;
8227 ADest[File_Name]:=Filename;
8228 end;
8229 finally
8230 List.Free;
8231 FileList.Free;
8232 end;
8233 end;
8234
8235 var
8236 Cnt: integer;
8237 SubPath: String;
8238 DefineName, DefineValue: String;
8239 s: String;
8240 i: Integer;
8241 p: Integer;
8242 StartPos: Integer;
8243 begin
8244 Clear;
8245
8246 Kind:=StrToPascalCompiler(XMLConfig.GetValue(Path+'Kind',PascalCompilerNames[pcFPC]));
8247 TargetOS:=XMLConfig.GetValue(Path+'TargetOS','');
8248 TargetCPU:=XMLConfig.GetValue(Path+'TargetCPU','');
8249 Compiler:=XMLConfig.GetValue(Path+'Compiler/File','');
8250 CompilerOptions:=XMLConfig.GetValue(Path+'Compiler/Options','');
8251 CompilerDate:=XMLConfig.GetValue(Path+'Compiler/Date',0);
8252 RealCompiler:=XMLConfig.GetValue(Path+'RealCompiler/File','');
8253 RealCompilerDate:=XMLConfig.GetValue(Path+'RealCompiler/Date',0);
8254 RealTargetOS:=XMLConfig.GetValue(Path+'RealCompiler/OS','');
8255 RealTargetCPU:=XMLConfig.GetValue(Path+'RealCompiler/CPU','');
8256 RealTargetCPUCompiler:=XMLConfig.GetValue(Path+'RealCompiler/InPath','');
8257 FullVersion:=XMLConfig.GetValue(Path+'RealCompiler/FullVersion','');
8258 HasPPUs:=XMLConfig.GetValue(Path+'HasPPUs',true);
8259 ConfigFiles.LoadFromXMLConfig(XMLConfig,Path+'Configs/');
8260
8261 // defines: format: Define<Number>/Name,Value
8262 Cnt:=XMLConfig.GetValue(Path+'Defines/Count',0);
8263 for i:=1 to Cnt do begin
8264 SubPath:=Path+'Defines/Macro'+IntToStr(i)+'/';
8265 DefineName:=UpperCaseStr(XMLConfig.GetValue(SubPath+'Name',''));
8266 if not IsValidIdent(DefineName) then begin
8267 DebugLn(['Warning: [TPCTargetConfigCache.LoadFromXMLConfig] invalid define name ',DefineName]);
8268 continue;
8269 end;
8270 DefineValue:=XMLConfig.GetValue(SubPath+'Value','');
8271 if Defines=nil then
8272 Defines:=TStringToStringTree.Create(false);
8273 Defines[DefineName]:=DefineValue;
8274 end;
8275
8276 // undefines: format: Undefines/Value and comma separated list of names
8277 s:=XMLConfig.GetValue(Path+'Undefines/Values','');
8278 if s<>'' then begin
8279 p:=1;
8280 while (p<=length(s)) do begin
8281 StartPos:=1;
8282 while (p<=length(s)) and (s[p]<>';') do inc(p);
8283 DefineName:=copy(s,StartPos,p-StartPos);
8284 if IsValidIdent(DefineName) then begin
8285 if Undefines=nil then
8286 Undefines:=TStringToStringTree.Create(false);
8287 Undefines[DefineName]:='';
8288 end;
8289 inc(p);
8290 end;
8291 end;
8292
8293 // Paths
8294 LoadPathsFor(UnitPaths,'UnitPaths/');
8295 LoadPathsFor(IncludePaths,'IncludePaths/');
8296
8297 // Unit scopes
8298 LoadSemicolonList(UnitScopes, 'UnitScopes');
8299
8300 // Files
8301 LoadFilesFor(Units,'Units/');
8302 LoadFilesFor(Includes,'Includes/');
8303 end;
8304
8305 procedure TPCTargetConfigCache.SaveToXMLConfig(XMLConfig: TXMLConfig;
8306 const Path: string);
8307
8308 procedure SavePathsFor(const ASource: TStrings; const ASubPath: string);
8309 var
8310 List: TStringList;
8311 RelativeUnitPaths: TStringList;
8312 BaseDir, s: string;
8313 begin
8314 // Paths: write as semicolon separated compressed list
8315 s:='';
8316 BaseDir:='';
8317 if ASource<>nil then begin
8318 List:=nil;
8319 RelativeUnitPaths:=nil;
8320 try
8321 RelativeUnitPaths:=MakeRelativeFileList(ASource,BaseDir);
8322 List:=Compress1FileList(RelativeUnitPaths);
8323 // do not sort, order is important (e.g. for httpd.ppu)
8324 List.Delimiter:=';';
8325 List.StrictDelimiter:=true;
8326 s:=List.DelimitedText;
8327 finally
8328 RelativeUnitPaths.Free;
8329 List.Free;
8330 end;
8331 end;
8332 XMLConfig.SetDeleteValue(Path+ASubPath+'BaseDir',BaseDir,'');
8333 XMLConfig.SetDeleteValue(Path+ASubPath+'Value',s,'');
8334 end;
8335
8336 procedure SaveSemicolonList(List: TStrings; const ASubPath: string);
8337 var
8338 i: Integer;
8339 s: String;
8340 begin
8341 s:='';
8342 if List<>nil then
8343 for i:=0 to List.Count-1 do
8344 s:=s+';'+List[i];
8345 delete(s,1,1);
8346 XMLConfig.SetDeleteValue(Path+ASubPath,s,'');
8347 end;
8348
8349 procedure SaveFilesFor(const ASource: TStringToStringTree; const ASubPath: string);
8350 var
8351 List: TStringList;
8352 FileList: TStringList;
8353 Filename, s: String;
8354 Node: TAVLTreeNode;
8355 Item: PStringToStringItem;
8356 begin
8357 // Files: ASubPath+Values semicolon separated list of compressed filenames
8358 // Files contains thousands of file names. This needs compression.
8359 s:='';
8360 List:=nil;
8361 FileList:=TStringList.Create;
8362 try
8363 if ASource<>nil then begin
8364 // Create a string list of filenames
8365 Node:=ASource.Tree.FindLowest;
8366 while Node<>nil do begin
8367 Item:=PStringToStringItem(Node.Data);
8368 Filename:=Item^.Value;
8369 FileList.Add(Filename);
8370 Node:=ASource.Tree.FindSuccessor(Node);
8371 end;
8372 // Sort the strings.
8373 FileList.CaseSensitive:=true;
8374 FileList.Sort;
8375 // Compress the file names
8376 List:=Compress1FileList(FileList);
8377 // and write the semicolon separated list
8378 List.Delimiter:=';';
8379 List.StrictDelimiter:=true;
8380 s:=List.DelimitedText;
8381 end;
8382 finally
8383 List.Free;
8384 FileList.Free;
8385 end;
8386 XMLConfig.SetDeleteValue(Path+ASubPath+'Value',s,'');
8387 end;
8388
8389 var
8390 Node: TAVLTreeNode;
8391 Item: PStringToStringItem;
8392 Cnt: Integer;
8393 SubPath: String;
8394 s: String;
8395 begin
8396 XMLConfig.SetDeleteValue(Path+'Kind',PascalCompilerNames[Kind],PascalCompilerNames[pcFPC]);
8397 XMLConfig.SetDeleteValue(Path+'TargetOS',TargetOS,'');
8398 XMLConfig.SetDeleteValue(Path+'TargetCPU',TargetCPU,'');
8399 XMLConfig.SetDeleteValue(Path+'Compiler/File',Compiler,'');
8400 XMLConfig.SetDeleteValue(Path+'Compiler/Options',CompilerOptions,'');
8401 XMLConfig.SetDeleteValue(Path+'Compiler/Date',CompilerDate,0);
8402 XMLConfig.SetDeleteValue(Path+'RealCompiler/File',RealCompiler,'');
8403 XMLConfig.SetDeleteValue(Path+'RealCompiler/Date',RealCompilerDate,0);
8404 XMLConfig.SetDeleteValue(Path+'RealCompiler/OS',RealTargetOS,'');
8405 XMLConfig.SetDeleteValue(Path+'RealCompiler/CPU',RealTargetCPU,'');
8406 XMLConfig.SetDeleteValue(Path+'RealCompiler/InPath',RealTargetCPUCompiler,'');
8407 XMLConfig.SetDeleteValue(Path+'RealCompiler/FullVersion',FullVersion,'');
8408 XMLConfig.SetDeleteValue(Path+'HasPPUs',HasPPUs,true);
8409 ConfigFiles.SaveToXMLConfig(XMLConfig,Path+'Configs/');
8410
8411 // Defines: write as Define<Number>/Name,Value
8412 Cnt:=0;
8413 if Defines<>nil then begin
8414 Node:=Defines.Tree.FindLowest;
8415 while Node<>nil do begin
8416 Item:=PStringToStringItem(Node.Data);
8417 if IsValidIdent(Item^.Name) then begin
8418 inc(Cnt);
8419 SubPath:=Path+'Defines/Macro'+IntToStr(Cnt)+'/';
8420 XMLConfig.SetDeleteValue(SubPath+'Name',Item^.Name,'');
8421 XMLConfig.SetDeleteValue(SubPath+'Value',Item^.Value,'');
8422 end;
8423 Node:=Defines.Tree.FindSuccessor(Node);
8424 end;
8425 end;
8426 XMLConfig.SetDeleteValue(Path+'Defines/Count',Cnt,0);
8427
8428 // Undefines: write as Undefines/Value and comma separated list of names
8429 Cnt:=0;
8430 s:='';
8431 if Undefines<>nil then begin
8432 Node:=Undefines.Tree.FindLowest;
8433 while Node<>nil do begin
8434 Item:=PStringToStringItem(Node.Data);
8435 inc(Cnt);
8436 if s<>'' then s:=s+',';
8437 s:=s+Item^.Name;
8438 Node:=Undefines.Tree.FindSuccessor(Node);
8439 end;
8440 end;
8441 XMLConfig.SetDeleteValue(Path+'Undefines/Values',s,'');
8442
8443 // Paths
8444 SavePathsFor(UnitPaths, 'UnitPaths/');
8445 SavePathsFor(IncludePaths, 'IncludePaths/');
8446
8447 // Unit scopes
8448 SaveSemicolonList(UnitScopes, 'UnitScopes');
8449
8450 // Files
8451 SaveFilesFor(Units, 'Units/');
8452 SaveFilesFor(Includes, 'Includes/');
8453 end;
8454
8455 procedure TPCTargetConfigCache.LoadFromFile(Filename: string);
8456 var
8457 XMLConfig: TXMLConfig;
8458 begin
8459 XMLConfig:=TXMLConfig.Create(Filename);
8460 try
8461 LoadFromXMLConfig(XMLConfig,'FPCConfig/');
8462 finally
8463 XMLConfig.Free;
8464 end;
8465 end;
8466
8467 procedure TPCTargetConfigCache.SaveToFile(Filename: string);
8468 var
8469 XMLConfig: TXMLConfig;
8470 begin
8471 XMLConfig:=TXMLConfig.CreateClean(Filename);
8472 try
8473 SaveToXMLConfig(XMLConfig,'FPCConfig/');
8474 finally
8475 XMLConfig.Free;
8476 end;
8477 end;
8478
TPCTargetConfigCache.NeedsUpdatenull8479 function TPCTargetConfigCache.NeedsUpdate: boolean;
8480 var
8481 i: Integer;
8482 Cfg: TPCConfigFileState;
8483 AFilename: String;
8484 begin
8485 Result:=true;
8486
8487 if (not FileExistsCached(Compiler)) then begin
8488 if CTConsoleVerbosity>0 then
8489 debugln(['Hint: [TPCTargetConfigCache.NeedsUpdate] TargetOS="',TargetOS,'" TargetCPU="',TargetCPU,'" Options="',CompilerOptions,'" compiler file missing "',Compiler,'"']);
8490 exit;
8491 end;
8492 if (FileAgeCached(Compiler)<>CompilerDate) then begin
8493 if CTConsoleVerbosity>0 then
8494 debugln(['Hint: [TPCTargetConfigCache.NeedsUpdate] TargetOS="',TargetOS,'" TargetCPU="',TargetCPU,'" Options="',CompilerOptions,'" compiler file changed "',Compiler,'" FileAge=',FileAgeCached(Compiler),' StoredAge=',CompilerDate]);
8495 exit;
8496 end;
8497 if (RealCompiler<>'') and (CompareFilenames(RealCompiler,Compiler)<>0)
8498 then begin
8499 if (not FileExistsCached(RealCompiler))
8500 or (FileAgeCached(RealCompiler)<>RealCompilerDate) then begin
8501 if CTConsoleVerbosity>0 then
8502 debugln(['Hint: [TPCTargetConfigCache.NeedsUpdate] TargetOS="',TargetOS,'" TargetCPU="',TargetCPU,'" Options="',CompilerOptions,'" real compiler file changed "',RealCompiler,'"']);
8503 exit;
8504 end;
8505 end;
8506 // fpc searches via PATH for the real compiler, resolves any symlink
8507 // and that is the RealCompiler
8508 AFilename:=FindDefaultTargetCPUCompiler(TargetCPU,true);
8509 if RealTargetCPUCompiler<>AFilename then begin
8510 if CTConsoleVerbosity>0 then
8511 debugln(['Hint: [TPCTargetConfigCache.NeedsUpdate] TargetOS="',TargetOS,'" TargetCPU="',TargetCPU,'" Options="',CompilerOptions,'" real compiler in PATH changed from "',RealTargetCPUCompiler,'" to "',AFilename,'"']);
8512 exit;
8513 end;
8514 for i:=0 to ConfigFiles.Count-1 do begin
8515 Cfg:=ConfigFiles[i];
8516 if (Cfg.Filename='') or (not FilenameIsAbsolute(Cfg.Filename)) then continue;
8517 if FileExistsCached(Cfg.Filename)<>Cfg.FileExists then begin
8518 if CTConsoleVerbosity>0 then
8519 debugln(['Hint: [TPCTargetConfigCache.NeedsUpdate] TargetOS="',TargetOS,'" TargetCPU="',TargetCPU,'" Options="',CompilerOptions,'" config fileexists changed "',Cfg.Filename,'"']);
8520 exit;
8521 end;
8522 if Cfg.FileExists and (FileAgeCached(Cfg.Filename)<>Cfg.FileDate) then begin
8523 if CTConsoleVerbosity>0 then
8524 debugln(['Hint: [TPCTargetConfigCache.NeedsUpdate] TargetOS="',TargetOS,'" TargetCPU="',TargetCPU,'" Options="',CompilerOptions,'" config file changed "',Cfg.Filename,'"']);
8525 exit;
8526 end;
8527 end;
8528 Result:=false;
8529 end;
8530
GetFPCInfoCmdLineOptionsnull8531 function TPCTargetConfigCache.GetFPCInfoCmdLineOptions(ExtraOptions: string
8532 ): string;
8533 begin
8534 Result:=CompilerOptions;
8535 if TargetCPU<>'' then
8536 Result:=Result+' -P'+LowerCase(TargetCPU);
8537 if TargetOS<>'' then
8538 Result:=Result+' -T'+LowerCase(TargetOS);
8539 if ExtraOptions<>'' then
8540 Result:=Result+' '+ExtraOptions;
8541 Result:=Trim(Result);
8542 end;
8543
8544 procedure TPCTargetConfigCache.IncreaseChangeStamp;
8545 begin
8546 CTIncreaseChangeStamp(FChangeStamp);
8547 if Caches<>nil then
8548 Caches.IncreaseChangeStamp;
8549 end;
8550
TPCTargetConfigCache.Updatenull8551 function TPCTargetConfigCache.Update(TestFilename: string;
8552 ExtraOptions: string; const OnProgress: TDefinePoolProgress): boolean;
8553
8554 procedure PreparePaths(APaths: TStrings);
8555 var
8556 i: Integer;
8557 begin
8558 if APaths<>nil then
8559 for i:=0 to APaths.Count-1 do
8560 APaths[i]:=ChompPathDelim(TrimFilename(APaths[i]));
8561 end;
8562
8563 var
8564 i: Integer;
8565 OldOptions: TPCTargetConfigCache;
8566 CfgFiles: TStrings;
8567 Filename: string;
8568 CfgFileExists: Boolean;
8569 CfgFileDate: Integer;
8570 Info: String;
8571 Infos: TFPCInfoStrings;
8572 InfoTypes: TFPCInfoTypes;
8573 BaseDir: String;
8574 FullFilename, KindErrorMsg: String;
8575 begin
8576 OldOptions:=TPCTargetConfigCache.Create(nil);
8577 CfgFiles:=nil;
8578 try
8579 // remember old state to find out if something changed
8580 OldOptions.Assign(Self);
8581 Clear;
8582
8583 if CTConsoleVerbosity>0 then
8584 debugln(['Hint: [TPCTargetConfigCache.NeedsUpdate] ',Compiler,' TargetOS=',TargetOS,' TargetCPU=',TargetCPU,' CompilerOptions=',CompilerOptions,' ExtraOptions=',ExtraOptions,' PATH=',GetEnvironmentVariableUTF8('PATH')]);
8585 CompilerDate:=-1;
8586 if FileExistsCached(Compiler) then begin
8587 CompilerDate:=FileAgeCached(Compiler);
8588 ExtraOptions:=GetFPCInfoCmdLineOptions(ExtraOptions);// add -TTargetOS and -PTargetCPU
8589 BaseDir:='';
8590
8591 // check if this is a FPC compatible compiler and get version, OS and CPU
8592 // Note: fpc.exe calls the real compiler depending on -T and -P
8593 InfoTypes:=[fpciTargetOS,fpciTargetProcessor,fpciFullVersion];
8594 Info:=RunFPCInfo(Compiler,InfoTypes,ExtraOptions);
8595 if ParseFPCInfo(Info,InfoTypes,Infos) then begin
8596 // fpc or pas2js
8597 RealTargetOS:=Infos[fpciTargetOS];
8598 RealTargetCPU:=Infos[fpciTargetProcessor];
8599 FullVersion:=Infos[fpciFullVersion];
8600 if FullVersion='' then
8601 debugln(['Warning: [TPCTargetConfigCache.Update] cannot determine compiler version: Compiler="'+Compiler+'" Options="'+ExtraOptions+'"']);
8602 end else begin
8603 RealTargetOS:=TargetOS;
8604 if RealTargetOS='' then
8605 RealTargetOS:=GetCompiledTargetOS;
8606 RealTargetCPU:=TargetCPU;
8607 if RealTargetCPU='' then
8608 RealTargetCPU:=GetCompiledTargetCPU;
8609 end;
8610
8611 if FullVersion<>'' then begin
8612 // run fpc/pas2js and parse output
8613
8614 if (Pos('-Fr',ExtraOptions)<1) and (Pos('-Fr',Caches.ExtraOptions)>0) then
8615 ExtraOptions:=Trim(ExtraOptions+' '+Caches.ExtraOptions);
8616 RunFPCVerbose(Compiler,TestFilename,CfgFiles,RealCompiler,UnitPaths,
8617 IncludePaths,UnitScopes,Defines,Undefines,ExtraOptions);
8618 //debugln(['TPCTargetConfigCache.Update UnitPaths="',UnitPaths.Text,'"']);
8619 //debugln(['TPCTargetConfigCache.Update UnitScopes="',UnitScopes.Text,'"']);
8620 //debugln(['TPCTargetConfigCache.Update IncludePaths="',IncludePaths.Text,'"']);
8621 end;
8622
8623 if Defines<>nil then begin
8624 if Defines.Contains('PAS2JS') and Defines.Contains('PAS2JS_FULLVERSION') then
8625 Kind:=pcPas2js
8626 else if Defines.Contains('FPC') and Defines.Contains('FPC_FULLVERSION') then
8627 Kind:=pcFPC
8628 else begin
8629 IsCompilerExecutable(Compiler,KindErrorMsg,Kind,false);
8630 if KindErrorMsg<>'' then
8631 debugln(['Warning: [TPCTargetConfigCache.Update] cannot determine type of compiler: Compiler="'+Compiler+'" Options="'+ExtraOptions+'"']);
8632 end;
8633 end;
8634 if Kind=pcFPC then begin
8635 RealTargetCPUCompiler:=FindDefaultTargetCPUCompiler(TargetCPU,true);
8636 if RealCompiler='' then RealCompiler:=RealTargetCPUCompiler;
8637 end;
8638 PreparePaths(UnitPaths);
8639 PreparePaths(IncludePaths);
8640 // store the real compiler file and date
8641 if (RealCompiler<>'') and FileExistsCached(RealCompiler) then
8642 RealCompilerDate:=FileAgeCached(RealCompiler)
8643 else if Kind=pcFPC then begin
8644 if CTConsoleVerbosity>=-1 then
8645 debugln(['Warning: [TPCTargetConfigCache.Update] cannot find real compiler for this platform: Compiler="'+Compiler+'" Options="'+ExtraOptions+'" RealCompiler="',RealCompiler,'"']);
8646 end;
8647 // store the list of tried and read cfg files
8648 if CfgFiles<>nil then
8649 for i:=0 to CfgFiles.Count-1 do begin
8650 Filename:=CfgFiles[i];
8651 if Filename='' then continue;
8652 CfgFileExists:=Filename[1]='+';
8653 Filename:=copy(Filename,2,length(Filename));
8654 FullFilename:=ExpandFileNameUTF8(TrimFileName(Filename),BaseDir);
8655 if CfgFileExists<>FileExistsCached(FullFilename) then begin
8656 debugln(['Warning: [TPCTargetConfigCache.Update] '+ExtractFileName(Compiler)+' found cfg a file, the IDE did not: "',Filename,'"']);
8657 CfgFileExists:=not CfgFileExists;
8658 end;
8659 CfgFileDate:=0;
8660 if CfgFileExists then
8661 CfgFileDate:=FileAgeCached(Filename);
8662 ConfigFiles.Add(Filename,CfgFileExists,CfgFileDate);
8663 end;
8664 // gather all units and include files in search paths
8665 GatherUnitsInSearchPaths(UnitPaths,IncludePaths,OnProgress,Units,Includes,true);
8666 //if Kind=pcPas2js then begin
8667 // debugln(['TPCTargetConfigCache.Update Units:']);
8668 // for e in Units do
8669 // debugln([' ',E^.Name,' ',E^.Value]);
8670 //end;
8671 if (UnitPaths<>nil) and (UnitPaths.Count=0) then begin
8672 if CTConsoleVerbosity>=-1 then
8673 debugln(['Warning: [TPCTargetConfigCache.Update] no unit paths: ',Compiler,' ',ExtraOptions]);
8674 end;
8675 // check if the system ppu exists
8676 HasPPUs:=(Kind=pcFPC) and (Units<>nil)
8677 and (CompareFileExt(Units['system'],'ppu',false)=0);
8678 // check compiler version define
8679 if (CTConsoleVerbosity>=-1) and (Defines<>nil) then begin
8680 case Kind of
8681 pcFPC:
8682 if not Defines.Contains('FPC_FULLVERSION') then
8683 debugln(['Warning: [TPCTargetConfigCache.Update] invalid fpc: Compiler="'+Compiler+'" Options="'+ExtraOptions+'" RealCompiler="',RealCompiler,'" missing FPC_FULLVERSION']);
8684 pcDelphi: ;
8685 pcPas2js:
8686 if not Defines.Contains('PAS2JS_FULLVERSION') then
8687 debugln(['Warning: [TPCTargetConfigCache.Update] invalid pas2js: Compiler="'+Compiler+'" Options="'+ExtraOptions+'" missing PAS2JS_FULLVERSION']);
8688 end;
8689 end;
8690 end;
8691 // check for changes
8692 if not Equals(OldOptions) then begin
8693 IncreaseChangeStamp;
8694 if CTConsoleVerbosity>=0 then
8695 debugln(['Hint: [TPCTargetConfigCache.Update] has changed']);
8696 end;
8697 Result:=true;
8698 finally
8699 CfgFiles.Free;
8700 OldOptions.Free;
8701 end;
8702 end;
8703
FindDefaultTargetCPUCompilernull8704 function TPCTargetConfigCache.FindDefaultTargetCPUCompiler(aTargetCPU: string;
8705 ResolveLinks: boolean): string;
8706
Searchnull8707 function Search(const ShortFileName: string): string;
8708 var
8709 ExtPath: String;
8710 begin
8711 // fpc.exe first searches in -Xp<path>
8712 ExtPath:=GetLastFPCParameter(CompilerOptions,'-Xp');
8713 if (ExtPath<>'') and (ExtPath<>'.') then begin
8714 if not FilenameIsAbsolute(ExtPath) then
8715 // If -Xp is relative then it is relative to the working directory
8716 ExtPath:=TrimFilename(AppendPathDelim(GetCurrentDirUTF8)+ExtPath);
8717 Result:=AppendPathDelim(ExtPath)+ShortFileName;
8718 if FileExistsCached(Result) then
8719 exit;
8720 end;
8721
8722 // then fpc.exe searches in its own directory
8723 if Compiler<>'' then begin
8724 Result:=ExtractFilePath(Compiler);
8725 if FilenameIsAbsolute(Result) then begin
8726 Result+=ShortFileName;
8727 if FileExistsCached(Result) then
8728 exit;
8729 end;
8730 end;
8731
8732 // finally fpc.exe searches in PATH
8733 Result:=SearchFileInPath(ShortFileName,GetCurrentDirUTF8,
8734 GetEnvironmentVariableUTF8('PATH'),PathSeparator,ctsfcDefault);
8735 if (Result<>'') or (Compiler='') then exit;
8736 end;
8737
8738 var
8739 CompiledTargetCPU: String;
8740 Cross: Boolean;
8741 Postfix: String;
8742 begin
8743 Result:='';
8744 if Kind<>pcFPC then exit;
8745
8746 CompiledTargetCPU:=GetCompiledTargetCPU;
8747 if aTargetCPU='' then
8748 aTargetCPU:=CompiledTargetCPU;
8749 Cross:=not SameText(aTargetCPU,CompiledTargetCPU);
8750
8751 // The -V<postfix> parameter searches for ppcx64-postfix instead of ppcx64
8752 Postfix:=GetLastFPCParameter(CompilerOptions,'-V');
8753 if Postfix<>'' then
8754 Postfix:='-'+Postfix;
8755
8756 Result:=Search(GetDefaultCompilerFilename(aTargetCPU,Cross)+Postfix);
8757 if (Result='') and Cross then begin
8758 Result:=Search(GetDefaultCompilerFilename(aTargetCPU,false)+Postfix);
8759 if Result='' then exit;
8760 end;
8761 if ResolveLinks then begin
8762 Result:=GetPhysicalFilenameCached(Result,false);
8763 end;
8764 end;
8765
GetUnitPathsnull8766 function TPCTargetConfigCache.GetUnitPaths: string;
8767 begin
8768 if UnitPaths=nil then exit('');
8769 UnitPaths.Delimiter:=';';
8770 UnitPaths.StrictDelimiter:=true;
8771 Result:=UnitPaths.DelimitedText;
8772 end;
8773
GetFPCVerNumbersnull8774 function TPCTargetConfigCache.GetFPCVerNumbers(out FPCVersion, FPCRelease,
8775 FPCPatch: integer): boolean;
8776 var
8777 v: string;
8778 begin
8779 // get default FPC version
8780 v:={$I %FPCVERSION%};
8781 Result:=SplitFPCVersion(v,FPCVersion,FPCRelease,FPCPatch);
8782 if Defines<>nil then begin
8783 // use defines
8784 FPCVersion:=StrToIntDef(Defines['FPC_VERSION'],FPCVersion);
8785 FPCRelease:=StrToIntDef(Defines['FPC_RELEASE'],FPCRelease);
8786 FPCPatch:=StrToIntDef(Defines['FPC_PATCH'],FPCPatch);
8787 end;
8788 end;
8789
TPCTargetConfigCache.GetFPCVernull8790 function TPCTargetConfigCache.GetFPCVer: string;
8791 var
8792 FPCVersion: integer;
8793 FPCRelease: integer;
8794 FPCPatch: integer;
8795 begin
8796 if GetFPCVerNumbers(FPCVersion,FPCRelease,FPCPatch) then
8797 Result:=IntToStr(FPCVersion)+'.'+IntToStr(FPCRelease)+'.'+IntToStr(FPCPatch)
8798 else
8799 Result:='';
8800 end;
8801
GetFPC_FULLVERSIONnull8802 function TPCTargetConfigCache.GetFPC_FULLVERSION: integer;
8803 begin
8804 if Defines<>nil then
8805 Result:=StrToIntDef(Defines['FPC_FULLVERSION'],0)
8806 else
8807 Result:=0;
8808 if Result=0 then
8809 Result:=GetCompiledFPCVersion;
8810 end;
8811
IndexOfUsedCfgFilenull8812 function TPCTargetConfigCache.IndexOfUsedCfgFile: integer;
8813 begin
8814 if ConfigFiles=nil then exit(-1);
8815 Result:=0;
8816 while (Result<ConfigFiles.Count) and (not ConfigFiles[Result].FileExists) do
8817 inc(Result);
8818 if Result=ConfigFiles.Count then Result:=-1;
8819 end;
8820
8821 { TPCTargetConfigCaches }
8822
8823 constructor TPCTargetConfigCaches.Create(AOwner: TComponent);
8824 begin
8825 CTIncreaseChangeStamp(FChangeStamp); // set to not 0
8826 inherited Create(AOwner);
8827 fItems:=TAVLTree.Create(@CompareFPCTargetConfigCacheItems);
8828 end;
8829
8830 destructor TPCTargetConfigCaches.Destroy;
8831 begin
8832 Clear;
8833 FreeAndNil(fItems);
8834 inherited Destroy;
8835 end;
8836
8837 procedure TPCTargetConfigCaches.Clear;
8838 begin
8839 if fItems.Count=0 then exit;
8840 fItems.FreeAndClear;
8841 IncreaseChangeStamp;
8842 end;
8843
TPCTargetConfigCaches.Equalsnull8844 function TPCTargetConfigCaches.Equals(Caches: TPCTargetConfigCaches): boolean;
8845 var
8846 Node1, Node2: TAVLTreeNode;
8847 Item1: TPCTargetConfigCache;
8848 Item2: TPCTargetConfigCache;
8849 begin
8850 Result:=false;
8851 if Caches.fItems.Count<>fItems.Count then exit;
8852 Node1:=fItems.FindLowest;
8853 Node2:=Caches.fItems.FindLowest;
8854 while Node1<>nil do begin
8855 Item1:=TPCTargetConfigCache(Node1.Data);
8856 Item2:=TPCTargetConfigCache(Node2.Data);
8857 if not Item1.Equals(Item2) then exit;
8858 Node1:=fItems.FindSuccessor(Node1);
8859 Node2:=Caches.fItems.FindSuccessor(Node2);
8860 end;
8861 Result:=true;
8862 end;
8863
8864 procedure TPCTargetConfigCaches.Assign(Source: TPersistent);
8865 var
8866 Caches: TPCTargetConfigCaches;
8867 Node: TAVLTreeNode;
8868 SrcItem: TPCTargetConfigCache;
8869 NewItem: TPCTargetConfigCache;
8870 begin
8871 if Source is TPCTargetConfigCaches then begin
8872 Caches:=TPCTargetConfigCaches(Source);
8873 if Equals(Caches) then exit; // no change, keep ChangeStamp
8874 Clear;
8875 Node:=Caches.fItems.FindLowest;
8876 while Node<>nil do begin
8877 SrcItem:=TPCTargetConfigCache(Node.Data);
8878 NewItem:=TPCTargetConfigCache.Create(Self);
8879 NewItem.Assign(SrcItem);
8880 fItems.Add(NewItem);
8881 Node:=Caches.fItems.FindSuccessor(Node);
8882 end;
8883 IncreaseChangeStamp;
8884 end else
8885 inherited Assign(Source);
8886 end;
8887
8888 procedure TPCTargetConfigCaches.LoadFromXMLConfig(XMLConfig: TXMLConfig;
8889 const Path: string);
8890 var
8891 Cnt: integer;
8892 i: Integer;
8893 Item: TPCTargetConfigCache;
8894 begin
8895 Clear;
8896 Cnt:=XMLConfig.GetValue(Path+'Count',0);
8897 for i:=1 to Cnt do begin
8898 Item:=TPCTargetConfigCache.Create(Self);
8899 Item.LoadFromXMLConfig(XMLConfig,Path+'Item'+IntToStr(i)+'/');
8900 if (Item.Compiler<>'') then
8901 fItems.Add(Item)
8902 else
8903 Item.Free;
8904 end;
8905 IncreaseChangeStamp;
8906 end;
8907
8908 procedure TPCTargetConfigCaches.SaveToXMLConfig(XMLConfig: TXMLConfig;
8909 const Path: string);
8910 var
8911 Node: TAVLTreeNode;
8912 Item: TPCTargetConfigCache;
8913 i: Integer;
8914 begin
8915 Node:=fItems.FindLowest;
8916 i:=0;
8917 while Node<>nil do begin
8918 Item:=TPCTargetConfigCache(Node.Data);
8919 inc(i);
8920 Item.SaveToXMLConfig(XMLConfig,Path+'Item'+IntToStr(i)+'/');
8921 Node:=fItems.FindSuccessor(Node);
8922 end;
8923 XMLConfig.SetDeleteValue(Path+'Count',i,0);
8924 end;
8925
8926 procedure TPCTargetConfigCaches.LoadFromFile(Filename: string);
8927 var
8928 XMLConfig: TXMLConfig;
8929 begin
8930 XMLConfig:=TXMLConfig.Create(Filename);
8931 try
8932 LoadFromXMLConfig(XMLConfig,'FPCConfigs/');
8933 finally
8934 XMLConfig.Free;
8935 end;
8936 end;
8937
8938 procedure TPCTargetConfigCaches.SaveToFile(Filename: string);
8939 var
8940 XMLConfig: TXMLConfig;
8941 begin
8942 XMLConfig:=TXMLConfig.CreateClean(Filename);
8943 try
8944 SaveToXMLConfig(XMLConfig,'FPCConfigs/');
8945 finally
8946 XMLConfig.Free;
8947 end;
8948 end;
8949
8950 procedure TPCTargetConfigCaches.IncreaseChangeStamp;
8951 begin
8952 CTIncreaseChangeStamp(FChangeStamp);
8953 end;
8954
TPCTargetConfigCaches.Findnull8955 function TPCTargetConfigCaches.Find(CompilerFilename, CompilerOptions,
8956 TargetOS, TargetCPU: string; CreateIfNotExists: boolean
8957 ): TPCTargetConfigCache;
8958 var
8959 Node: TAVLTreeNode;
8960 Cmp: TPCTargetConfigCache;
8961 begin
8962 Cmp:=TPCTargetConfigCache.Create(Self);
8963 try
8964 Cmp.Compiler:=CompilerFilename;
8965 Cmp.CompilerOptions:=CompilerOptions;
8966 Cmp.TargetOS:=TargetOS;
8967 Cmp.TargetCPU:=TargetCPU;
8968 Node:=fItems.Find(cmp);
8969 if Node<>nil then begin
8970 Result:=TPCTargetConfigCache(Node.Data);
8971 end else if CreateIfNotExists then begin
8972 Result:=cmp;
8973 cmp:=nil;
8974 fItems.Add(Result);
8975 end else begin
8976 Result:=nil;
8977 end;
8978 finally
8979 Cmp.Free;
8980 end;
8981 end;
8982
8983 procedure TPCTargetConfigCaches.GetDefaultCompilerTarget(
8984 const CompilerFilename, CompilerOptions: string; out TargetOS,
8985 TargetCPU: string);
8986 var
8987 Cfg: TPCTargetConfigCache;
8988 begin
8989 Cfg:=Find(CompilerFilename,CompilerOptions,'','',true);
8990 if Cfg=nil then begin
8991 TargetOS:='';
8992 TargetCPU:='';
8993 end else begin
8994 if Cfg.NeedsUpdate then
8995 Cfg.Update(TestFilename);
8996 TargetOS:=Cfg.RealTargetOS;
8997 TargetCPU:=Cfg.RealTargetCPU;
8998 end;
8999 end;
9000
TPCTargetConfigCaches.GetListingnull9001 function TPCTargetConfigCaches.GetListing: string;
9002 var
9003 Node: TAVLTreeNode;
9004 CfgCache: TPCTargetConfigCache;
9005 i: Integer;
9006 begin
9007 Result:='TPCTargetConfigCaches.GetListing Count='+dbgs(fItems.Count)+LineEnding;
9008 i:=0;
9009 Node:=fItems.FindLowest;
9010 while Node<>nil do begin
9011 inc(i);
9012 CfgCache:=TPCTargetConfigCache(Node.Data);
9013 Result+=' '+dbgs(i)+':'
9014 +' TargetOS="'+CfgCache.TargetOS+'"'
9015 +' TargetCPU="'+CfgCache.TargetCPU+'"'
9016 +' Compiler="'+CfgCache.Compiler+'"'
9017 +' CompilerOptions="'+CfgCache.CompilerOptions+'"'
9018 +LineEnding;
9019 Node:=fItems.FindSuccessor(Node);
9020 end;
9021 end;
9022
9023 { TPCConfigFileStateList }
9024
TPCConfigFileStateList.GetItemsnull9025 function TPCConfigFileStateList.GetItems(Index: integer): TPCConfigFileState;
9026 begin
9027 Result:=TPCConfigFileState(fItems[Index]);
9028 end;
9029
9030 constructor TPCConfigFileStateList.Create;
9031 begin
9032 fItems:=TFPList.Create;
9033 end;
9034
9035 destructor TPCConfigFileStateList.Destroy;
9036 begin
9037 Clear;
9038 FreeAndNil(fItems);
9039 inherited Destroy;
9040 end;
9041
9042 procedure TPCConfigFileStateList.Clear;
9043 var
9044 i: Integer;
9045 begin
9046 for i:=0 to fItems.Count-1 do
9047 TObject(fItems[i]).Free;
9048 fItems.Clear;
9049 end;
9050
9051 procedure TPCConfigFileStateList.Assign(List: TPCConfigFileStateList);
9052 var
9053 i: Integer;
9054 Item: TPCConfigFileState;
9055 begin
9056 Clear;
9057 for i:=0 to List.Count-1 do begin
9058 Item:=List[i];
9059 Add(Item.Filename,Item.FileExists,Item.FileDate);
9060 end;
9061 end;
9062
Equalsnull9063 function TPCConfigFileStateList.Equals(List: TPCConfigFileStateList;
9064 CheckDates: boolean): boolean;
9065 var
9066 i: Integer;
9067 begin
9068 Result:=false;
9069 if Count<>List.Count then exit;
9070 for i:=0 to Count-1 do
9071 if not Items[i].Equals(List[i],CheckDates) then exit;
9072 Result:=true;
9073 end;
9074
Addnull9075 function TPCConfigFileStateList.Add(aFilename: string; aFileExists: boolean;
9076 aFileDate: longint): TPCConfigFileState;
9077 begin
9078 Result:=TPCConfigFileState.Create(aFilename,aFileExists,aFileDate);
9079 fItems.Add(Result);
9080 end;
9081
Countnull9082 function TPCConfigFileStateList.Count: integer;
9083 begin
9084 Result:=fItems.Count;
9085 end;
9086
9087 procedure TPCConfigFileStateList.LoadFromXMLConfig(XMLConfig: TXMLConfig;
9088 const Path: string);
9089 var
9090 Cnt: integer;
9091 Item: TPCConfigFileState;
9092 i: Integer;
9093 begin
9094 Cnt:=XMLConfig.GetValue(Path+'Count',0);
9095 for i:=1 to Cnt do begin
9096 Item:=TPCConfigFileState.Create('',false,0);
9097 Item.LoadFromXMLConfig(XMLConfig,Path+'Item'+IntToStr(i)+'/');
9098 fItems.Add(Item);
9099 end;
9100 end;
9101
9102 procedure TPCConfigFileStateList.SaveToXMLConfig(XMLConfig: TXMLConfig;
9103 const Path: string);
9104 var
9105 i: Integer;
9106 begin
9107 for i:=1 to Count do
9108 Items[i-1].SaveToXMLConfig(XMLConfig,Path+'Item'+IntToStr(i)+'/');
9109 XMLConfig.SetDeleteValue(Path+'Count',Count,0);
9110 end;
9111
9112 { TPCConfigFileState }
9113
9114 constructor TPCConfigFileState.Create(const aFilename: string;
9115 aFileExists: boolean; aFileDate: longint);
9116 begin
9117 Filename:=aFilename;
9118 FileExists:=aFileExists;
9119 FileDate:=aFileDate;
9120 end;
9121
Equalsnull9122 function TPCConfigFileState.Equals(Other: TPCConfigFileState;
9123 CheckDate: boolean): boolean;
9124 begin
9125 Result:=false;
9126 if (Filename<>Other.Filename) or (FileExists<>Other.FileExists) then exit;
9127 if CheckDate and FileExists and (FileDate<>Other.FileDate) then exit;
9128 Result:=true;
9129 end;
9130
9131 procedure TPCConfigFileState.LoadFromXMLConfig(XMLConfig: TXMLConfig;
9132 const Path: string);
9133 begin
9134 Filename:=XMLConfig.GetValue(Path+'Filename','');
9135 FileExists:=XMLConfig.GetValue(Path+'Exists',false);
9136 FileDate:=XMLConfig.GetValue(Path+'Date',0);
9137 end;
9138
9139 procedure TPCConfigFileState.SaveToXMLConfig(XMLConfig: TXMLConfig;
9140 const Path: string);
9141 begin
9142 XMLConfig.SetDeleteValue(Path+'Filename',Filename,'');
9143 XMLConfig.SetDeleteValue(Path+'Exists',FileExists,false);
9144 XMLConfig.SetDeleteValue(Path+'Date',FileDate,0);
9145 end;
9146
9147 { TFPCSourceCacheItem }
9148
9149 constructor TFPCSourceCache.Create(AOwner: TComponent);
9150 begin
9151 inherited Create(AOwner);
9152 Files:=TStringList.Create;
9153 Valid:=false;
9154 CTIncreaseChangeStamp(FChangeStamp); // set to not 0
9155 if Owner is TFPCSourceCaches then
9156 Caches:=TFPCSourceCaches(Owner);
9157 end;
9158
9159 destructor TFPCSourceCache.Destroy;
9160 begin
9161 FreeAndNil(Files);
9162 inherited Destroy;
9163 end;
9164
9165 procedure TFPCSourceCache.Clear;
9166 begin
9167 FreeAndNil(Files);
9168 Valid:=false;
9169 end;
9170
9171 procedure TFPCSourceCache.Assign(Source: TPersistent);
9172 var
9173 Cache: TFPCSourceCache;
9174 begin
9175 if Source is TFPCSourceCache then begin
9176 Cache:=TFPCSourceCache(Source);
9177 Directory:=Cache.Directory;
9178 Files.Assign(Cache.Files);
9179 Valid:=Cache.Valid;
9180 end else
9181 inherited Assign(Source);
9182 end;
9183
Equalsnull9184 function TFPCSourceCache.Equals(Cache: TFPCSourceCache): boolean;
9185 begin
9186 Result:=false;
9187 if Valid<>Cache.Valid then exit;
9188 if Directory<>Cache.Directory then exit;
9189 if not Files.Equals(Cache.Files) then exit;
9190 Result:=true;
9191 end;
9192
9193 procedure TFPCSourceCache.LoadFromXMLConfig(XMLConfig: TXMLConfig;
9194 const Path: string);
9195 var
9196 List: TStringList;
9197 begin
9198 Clear;
9199 List:=nil;
9200 try
9201 Valid:=XMLConfig.GetValue(Path+'Valid',true);
9202 Directory:=XMLConfig.GetValue(Path+'Directory','');
9203 List:=TStringList.Create;
9204 List.StrictDelimiter:=true;
9205 List.Delimiter:=';';
9206 List.DelimitedText:=XMLConfig.GetValue(Path+'Files','');
9207 FreeAndNil(Files);
9208 Files:=Decompress1FileList(List);
9209 finally
9210 if Files=nil then Files:=TStringList.Create;
9211 List.Free;
9212 end;
9213 end;
9214
9215 procedure TFPCSourceCache.SaveToXMLConfig(XMLConfig: TXMLConfig;
9216 const Path: string);
9217 var
9218 List: TStringList;
9219 s: String;
9220 begin
9221 List:=nil;
9222 try
9223 XMLConfig.SetDeleteValue(Path+'Valid',Valid,true);
9224 XMLConfig.SetDeleteValue(Path+'Directory',Directory,'');
9225 if Files<>nil then begin
9226 List:=Compress1FileList(Files);
9227 List.StrictDelimiter:=true;
9228 List.Delimiter:=';';
9229 s:=List.DelimitedText;
9230 end else
9231 s:='';
9232 XMLConfig.SetDeleteValue(Path+'Files',s,'');
9233 finally
9234 List.Free;
9235 end;
9236 end;
9237
9238 procedure TFPCSourceCache.LoadFromFile(Filename: string);
9239 var
9240 XMLConfig: TXMLConfig;
9241 begin
9242 XMLConfig:=TXMLConfig.Create(Filename);
9243 try
9244 LoadFromXMLConfig(XMLConfig,'FPCSourceDirectory/');
9245 finally
9246 XMLConfig.Free;
9247 end;
9248 end;
9249
9250 procedure TFPCSourceCache.SaveToFile(Filename: string);
9251 var
9252 XMLConfig: TXMLConfig;
9253 begin
9254 XMLConfig:=TXMLConfig.CreateClean(Filename);
9255 try
9256 SaveToXMLConfig(XMLConfig,'FPCSourceDirectory/');
9257 finally
9258 XMLConfig.Free;
9259 end;
9260 end;
9261
9262 procedure TFPCSourceCache.Update(const OnProgress: TDefinePoolProgress);
9263 var
9264 NewFiles: TStringList;
9265 begin
9266 Valid:=false;
9267 if Directory<>'' then
9268 NewFiles:=GatherFilesInFPCSources(Directory,OnProgress)
9269 else
9270 NewFiles:=TStringList.Create;
9271 Update(NewFiles);
9272 end;
9273
9274 procedure TFPCSourceCache.Update(var NewFiles: TStringList);
9275 var
9276 OldFiles: TStringList;
9277 OldValid: Boolean;
9278 begin
9279 OldFiles:=Files;
9280 OldValid:=Valid;
9281 try
9282 Files:=NewFiles;
9283 NewFiles:=nil;
9284 Valid:=true;
9285 if (Valid<>OldValid)
9286 or ((Files=nil)<>(OldFiles=nil))
9287 or ((Files<>nil) and (Files.Text<>OldFiles.Text)) then begin
9288 IncreaseChangeStamp;
9289 if CTConsoleVerbosity>0 then
9290 debugln(['Hint: [TFPCSourceCache.Update] ',Directory,' has changed.']);
9291 end;
9292 finally
9293 OldFiles.Free;
9294 end;
9295 end;
9296
9297 procedure TFPCSourceCache.IncreaseChangeStamp;
9298 begin
9299 CTIncreaseChangeStamp(FChangeStamp);
9300 if Caches<>nil then
9301 Caches.IncreaseChangeStamp;
9302 end;
9303
9304 { TFPCSourceCache }
9305
9306 constructor TFPCSourceCaches.Create(AOwner: TComponent);
9307 begin
9308 CTIncreaseChangeStamp(FChangeStamp); // set to not 0
9309 inherited Create(AOwner);
9310 fItems:=TAVLTree.Create(@CompareFPCSourceCacheItems);
9311 end;
9312
9313 destructor TFPCSourceCaches.Destroy;
9314 begin
9315 Clear;
9316 FreeAndNil(fItems);
9317 inherited Destroy;
9318 end;
9319
9320 procedure TFPCSourceCaches.Clear;
9321 begin
9322 if fItems.Count=0 then exit;
9323 fItems.FreeAndClear;
9324 IncreaseChangeStamp;
9325 end;
9326
9327 procedure TFPCSourceCaches.Assign(Source: TPersistent);
9328 var
9329 Caches: TFPCSourceCaches;
9330 SrcItem: TFPCSourceCache;
9331 NewItem: TFPCSourceCache;
9332 Node: TAVLTreeNode;
9333 begin
9334 if Source is TFPCSourceCaches then begin
9335 Caches:=TFPCSourceCaches(Source);
9336 if Equals(Caches) then exit; // keep ChangeStamp if equal
9337 Clear;
9338 Node:=Caches.fItems.FindLowest;
9339 while Node<>nil do begin
9340 SrcItem:=TFPCSourceCache(Node.Data);
9341 NewItem:=TFPCSourceCache.Create(Self);
9342 NewItem.Assign(SrcItem);
9343 fItems.Add(NewItem);
9344 Node:=Caches.fItems.FindSuccessor(Node);
9345 end;
9346 IncreaseChangeStamp;
9347 end else
9348 inherited Assign(Source);
9349 end;
9350
Equalsnull9351 function TFPCSourceCaches.Equals(Caches: TFPCSourceCaches): boolean;
9352 var
9353 Node1, Node2: TAVLTreeNode;
9354 Item1: TFPCSourceCache;
9355 Item2: TFPCSourceCache;
9356 begin
9357 Result:=false;
9358 if Caches.fItems.Count<>fItems.Count then exit;
9359 Node1:=fItems.FindLowest;
9360 Node2:=Caches.fItems.FindLowest;
9361 while Node1<>nil do begin
9362 Item1:=TFPCSourceCache(Node1.Data);
9363 Item2:=TFPCSourceCache(Node2.Data);
9364 if not Item1.Equals(Item2) then exit;
9365 Node1:=fItems.FindSuccessor(Node1);
9366 Node2:=Caches.fItems.FindSuccessor(Node2);
9367 end;
9368 Result:=true;
9369 end;
9370
9371 procedure TFPCSourceCaches.LoadFromXMLConfig(XMLConfig: TXMLConfig;
9372 const Path: string);
9373 var
9374 Cnt: integer;
9375 i: Integer;
9376 Item: TFPCSourceCache;
9377 begin
9378 Clear;
9379 Cnt:=XMLConfig.GetValue(Path+'Count',0);
9380 for i:=1 to Cnt do begin
9381 Item:=TFPCSourceCache.Create(Self);
9382 Item.LoadFromXMLConfig(XMLConfig,Path+'Item'+IntToStr(i)+'/');
9383 if (Item.Directory='') or (fItems.Find(Item)<>nil) then
9384 Item.Free
9385 else
9386 fItems.Add(Item);
9387 end;
9388 end;
9389
9390 procedure TFPCSourceCaches.SaveToXMLConfig(XMLConfig: TXMLConfig;
9391 const Path: string);
9392 var
9393 Node: TAVLTreeNode;
9394 Item: TFPCSourceCache;
9395 Cnt: Integer;
9396 begin
9397 Cnt:=0;
9398 Node:=fItems.FindLowest;
9399 while Node<>nil do begin
9400 Item:=TFPCSourceCache(Node.Data);
9401 if Item.Directory<>'' then begin
9402 inc(Cnt);
9403 Item.SaveToXMLConfig(XMLConfig,Path+'Item'+IntToStr(Cnt)+'/');
9404 end;
9405 Node:=fItems.FindSuccessor(Node);
9406 end;
9407 XMLConfig.SetDeleteValue(Path+'Count',Cnt,0);
9408 end;
9409
9410 procedure TFPCSourceCaches.LoadFromFile(Filename: string);
9411 var
9412 XMLConfig: TXMLConfig;
9413 begin
9414 XMLConfig:=TXMLConfig.Create(Filename);
9415 try
9416 LoadFromXMLConfig(XMLConfig,'FPCSourceDirectories/');
9417 finally
9418 XMLConfig.Free;
9419 end;
9420 end;
9421
9422 procedure TFPCSourceCaches.SaveToFile(Filename: string);
9423 var
9424 XMLConfig: TXMLConfig;
9425 begin
9426 XMLConfig:=TXMLConfig.CreateClean(Filename);
9427 try
9428 SaveToXMLConfig(XMLConfig,'FPCSourceDirectories/');
9429 finally
9430 XMLConfig.Free;
9431 end;
9432 end;
9433
9434 procedure TFPCSourceCaches.IncreaseChangeStamp;
9435 begin
9436 CTIncreaseChangeStamp(FChangeStamp);
9437 end;
9438
Findnull9439 function TFPCSourceCaches.Find(Directory: string;
9440 CreateIfNotExists: boolean): TFPCSourceCache;
9441 var
9442 Node: TAVLTreeNode;
9443 begin
9444 Directory:=ChompPathDelim(TrimFilename(Directory));
9445 Node:=fItems.FindKey(PChar(Directory),@CompareDirectoryWithFPCSourceCacheItem);
9446 if Node<>nil then begin
9447 Result:=TFPCSourceCache(Node.Data);
9448 end else if CreateIfNotExists then begin
9449 Result:=TFPCSourceCache.Create(Self);
9450 Result.Directory:=Directory;
9451 fItems.Add(Result);
9452 end else begin
9453 Result:=nil;
9454 end;
9455 end;
9456
9457 { TCompilerDefinesCache }
9458
9459 procedure TCompilerDefinesCache.SetConfigCaches(const AValue: TPCTargetConfigCaches);
9460 begin
9461 if FConfigCaches=AValue then exit;
9462 FConfigCaches:=AValue;
9463 FConfigCachesSaveStamp:=Low(FConfigCachesSaveStamp);
9464 end;
9465
GetExtraOptionsnull9466 function TCompilerDefinesCache.GetExtraOptions: string;
9467 begin
9468 Result:=ConfigCaches.ExtraOptions;
9469 end;
9470
GetTestFilenamenull9471 function TCompilerDefinesCache.GetTestFilename: string;
9472 begin
9473 Result:=ConfigCaches.TestFilename;
9474 end;
9475
9476 procedure TCompilerDefinesCache.SetExtraOptions(AValue: string);
9477 begin
9478 ConfigCaches.ExtraOptions:=AValue;
9479 end;
9480
9481 procedure TCompilerDefinesCache.SetSourceCaches(const AValue: TFPCSourceCaches);
9482 begin
9483 if FSourceCaches=AValue then exit;
9484 FSourceCaches:=AValue;
9485 FSourceCachesSaveStamp:=low(FSourceCachesSaveStamp);
9486 end;
9487
9488 procedure TCompilerDefinesCache.ClearUnitToSrcCaches;
9489 var
9490 i: Integer;
9491 begin
9492 for i:=0 to fUnitToSrcCaches.Count-1 do
9493 TObject(fUnitToSrcCaches[i]).Free;
9494 fUnitToSrcCaches.Clear;
9495 end;
9496
9497 procedure TCompilerDefinesCache.SetTestFilename(AValue: string);
9498 begin
9499 ConfigCaches.TestFilename:=AValue;
9500 end;
9501
9502 constructor TCompilerDefinesCache.Create(AOwner: TComponent);
9503 begin
9504 inherited Create(AOwner);
9505 ConfigCaches:=TPCTargetConfigCaches.Create(nil);
9506 SourceCaches:=TFPCSourceCaches.Create(nil);
9507 fUnitToSrcCaches:=TFPList.Create;
9508 end;
9509
9510 destructor TCompilerDefinesCache.Destroy;
9511 begin
9512 ClearUnitToSrcCaches;
9513 FreeAndNil(FConfigCaches);
9514 FreeAndNil(FSourceCaches);
9515 FreeAndNil(fUnitToSrcCaches);
9516 inherited Destroy;
9517 end;
9518
9519 procedure TCompilerDefinesCache.Clear;
9520 begin
9521 ClearUnitToSrcCaches;
9522 if ConfigCaches<>nil then ConfigCaches.Clear;
9523 if SourceCaches<>nil then SourceCaches.Clear;
9524 end;
9525
9526 procedure TCompilerDefinesCache.LoadFromXMLConfig(XMLConfig: TXMLConfig;
9527 const Path: string);
9528 begin
9529 if ConfigCaches<>nil then begin
9530 ConfigCaches.LoadFromXMLConfig(XMLConfig,Path+'FPCConfigs/');
9531 FConfigCachesSaveStamp:=ConfigCaches.ChangeStamp;
9532 end;
9533 if SourceCaches<>nil then begin
9534 SourceCaches.LoadFromXMLConfig(XMLConfig,Path+'FPCSources/');
9535 FSourceCachesSaveStamp:=SourceCaches.ChangeStamp;
9536 end;
9537 end;
9538
9539 procedure TCompilerDefinesCache.SaveToXMLConfig(XMLConfig: TXMLConfig;
9540 const Path: string);
9541 begin
9542 //debugln(['TCompilerDefinesCache.SaveToXMLConfig ']);
9543 if ConfigCaches<>nil then begin
9544 ConfigCaches.SaveToXMLConfig(XMLConfig,Path+'FPCConfigs/');
9545 FConfigCachesSaveStamp:=ConfigCaches.ChangeStamp;
9546 end;
9547 if SourceCaches<>nil then begin
9548 SourceCaches.SaveToXMLConfig(XMLConfig,Path+'FPCSources/');
9549 FSourceCachesSaveStamp:=SourceCaches.ChangeStamp;
9550 end;
9551 end;
9552
9553 procedure TCompilerDefinesCache.LoadFromFile(Filename: string);
9554 var
9555 XMLConfig: TXMLConfig;
9556 begin
9557 XMLConfig:=TXMLConfig.Create(Filename);
9558 try
9559 LoadFromXMLConfig(XMLConfig,'');
9560 finally
9561 XMLConfig.Free;
9562 end;
9563 end;
9564
9565 procedure TCompilerDefinesCache.SaveToFile(Filename: string);
9566 var
9567 XMLConfig: TXMLConfig;
9568 begin
9569 XMLConfig:=TXMLConfig.CreateClean(Filename);
9570 try
9571 SaveToXMLConfig(XMLConfig,'');
9572 finally
9573 XMLConfig.Free;
9574 end;
9575 end;
9576
TCompilerDefinesCache.NeedsSavenull9577 function TCompilerDefinesCache.NeedsSave: boolean;
9578 begin
9579 Result:=true;
9580 if (ConfigCaches<>nil) and (ConfigCaches.ChangeStamp<>FConfigCachesSaveStamp)
9581 then exit;
9582 if (SourceCaches<>nil) and (SourceCaches.ChangeStamp<>FSourceCachesSaveStamp)
9583 then exit;
9584 Result:=false;
9585 end;
9586
TCompilerDefinesCache.GetFPCVersionnull9587 function TCompilerDefinesCache.GetFPCVersion(const CompilerFilename, TargetOS,
9588 TargetCPU: string; UseCompiledVersionAsDefault: boolean): string;
9589 var
9590 Kind: TPascalCompiler;
9591 begin
9592 Result:=GetPCVersion(CompilerFilename,TargetOS,TargetCPU,UseCompiledVersionAsDefault,Kind);
9593 if Kind=pcFPC then ;
9594 end;
9595
TCompilerDefinesCache.GetPCVersionnull9596 function TCompilerDefinesCache.GetPCVersion(const CompilerFilename, TargetOS,
9597 TargetCPU: string; UseCompiledVersionAsDefault: boolean; out
9598 Kind: TPascalCompiler): string;
9599 var
9600 CfgCache: TPCTargetConfigCache;
9601 ErrorMsg: string;
9602 begin
9603 Kind:=pcFPC;
9604 if UseCompiledVersionAsDefault then
9605 Result:={$I %FPCVersion%}
9606 else
9607 Result:='';
9608 if not IsCTExecutable(CompilerFilename,ErrorMsg) then
9609 exit;
9610 CfgCache:=ConfigCaches.Find(CompilerFilename,ExtraOptions,TargetOS,TargetCPU,true);
9611 if CfgCache.NeedsUpdate
9612 and not CfgCache.Update(TestFilename,ExtraOptions) then
9613 exit;
9614 Kind:=CfgCache.Kind;
9615 if CfgCache.FullVersion='' then exit;
9616 Result:=CfgCache.FullVersion;
9617 end;
9618
TCompilerDefinesCache.FindUnitSetnull9619 function TCompilerDefinesCache.FindUnitSet(const CompilerFilename, TargetOS,
9620 TargetCPU, Options, FPCSrcDir: string; CreateIfNotExists: boolean
9621 ): TFPCUnitSetCache;
9622 var
9623 i: Integer;
9624 begin
9625 for i:=0 to fUnitToSrcCaches.Count-1 do begin
9626 Result:=TFPCUnitSetCache(fUnitToSrcCaches[i]);
9627 if (CompareFilenames(Result.CompilerFilename,CompilerFilename)=0)
9628 and (SysUtils.CompareText(Result.TargetOS,TargetOS)=0)
9629 and (SysUtils.CompareText(Result.TargetCPU,TargetCPU)=0)
9630 and (CompareFilenames(Result.FPCSourceDirectory,FPCSrcDir)=0)
9631 and (Result.CompilerOptions=Options)
9632 then
9633 exit;
9634 end;
9635 if CreateIfNotExists then begin
9636 Result:=TFPCUnitSetCache.Create(Self);
9637 Result.CompilerFilename:=CompilerFilename;
9638 Result.CompilerOptions:=Options;
9639 Result.TargetOS:=TargetOS;
9640 Result.TargetCPU:=TargetCPU;
9641 Result.FPCSourceDirectory:=FPCSrcDir;
9642 fUnitToSrcCaches.Add(Result);
9643 end else
9644 Result:=nil;
9645 end;
9646
TCompilerDefinesCache.FindUnitSetWithIDnull9647 function TCompilerDefinesCache.FindUnitSetWithID(const UnitSetID: string; out
9648 Changed: boolean; CreateIfNotExists: boolean): TFPCUnitSetCache;
9649 var
9650 CompilerFilename, TargetOS, TargetCPU, Options, FPCSrcDir: string;
9651 ChangeStamp: integer;
9652 begin
9653 ParseUnitSetID(UnitSetID,CompilerFilename, TargetOS, TargetCPU,
9654 Options, FPCSrcDir, ChangeStamp);
9655 //debugln(['TCompilerDefinesCache.FindUnitToSrcCache UnitSetID="',dbgstr(UnitSetID),'" CompilerFilename="',CompilerFilename,'" TargetOS="',TargetOS,'" TargetCPU="',TargetCPU,'" Options="',Options,'" FPCSrcDir="',FPCSrcDir,'" ChangeStamp=',ChangeStamp,' exists=',FindUnitToSrcCache(CompilerFilename, TargetOS, TargetCPU,Options, FPCSrcDir,false)<>nil]);
9656 Result:=FindUnitSet(CompilerFilename, TargetOS, TargetCPU,
9657 Options, FPCSrcDir, false);
9658 if Result<>nil then begin
9659 Changed:=ChangeStamp<>Result.ChangeStamp;
9660 end else if CreateIfNotExists then begin
9661 Changed:=true;
9662 Result:=FindUnitSet(CompilerFilename, TargetOS, TargetCPU,
9663 Options, FPCSrcDir, true);
9664 end else
9665 Changed:=false;
9666 end;
9667
GetUnitSetIDnull9668 function TCompilerDefinesCache.GetUnitSetID(CompilerFilename, TargetOS, TargetCPU,
9669 Options, FPCSrcDir: string; ChangeStamp: integer): string;
9670 begin
9671 Result:='CompilerFilename='+CompilerFilename+LineEnding
9672 +'TargetOS='+TargetOS+LineEnding
9673 +'TargetCPU='+TargetCPU+LineEnding
9674 +'Options='+Options+LineEnding
9675 +'FPCSrcDir='+FPCSrcDir+LineEnding
9676 +'Stamp='+IntToStr(ChangeStamp);
9677 end;
9678
9679 procedure TCompilerDefinesCache.ParseUnitSetID(const ID: string;
9680 out CompilerFilename, TargetOS, TargetCPU, Options, FPCSrcDir: string;
9681 out ChangeStamp: integer);
9682 var
9683 NameStartPos: PChar;
9684
NameFitsnull9685 function NameFits(p: PChar): boolean;
9686 var
9687 p1: PChar;
9688 begin
9689 p1:=NameStartPos;
9690 while (FPUpChars[p1^]=FPUpChars[p^]) and (p^<>#0) do begin
9691 inc(p1);
9692 inc(p);
9693 end;
9694 Result:=p1^='=';
9695 end;
9696
9697 var
9698 ValueStartPos: PChar;
9699 ValueEndPos: PChar;
9700 Value: String;
9701 begin
9702 CompilerFilename:='';
9703 TargetCPU:='';
9704 TargetOS:='';
9705 Options:='';
9706 FPCSrcDir:='';
9707 ChangeStamp:=0;
9708 if ID='' then exit;
9709 // read the lines with name=value
9710 NameStartPos:=PChar(ID);
9711 while NameStartPos^<>#0 do begin
9712 while (NameStartPos^ in [#10,#13]) do inc(NameStartPos);
9713 ValueStartPos:=NameStartPos;
9714 while not (ValueStartPos^ in ['=',#10,#13,#0]) do inc(ValueStartPos);
9715 if ValueStartPos^<>'=' then exit;
9716 inc(ValueStartPos);
9717 ValueEndPos:=ValueStartPos;
9718 while not (ValueEndPos^ in [#10,#13,#0]) do inc(ValueEndPos);
9719 Value:=copy(ID,ValueStartPos-PChar(ID)+1,ValueEndPos-ValueStartPos);
9720 //debugln(['TCompilerDefinesCache.ParseUnitSetID Name=',copy(ID,NameStartPos-PChar(ID)+1,ValueStartPos-NameStartPos-1),' Value="',Value,'"']);
9721 case NameStartPos^ of
9722 'c','C':
9723 if NameFits('CompilerFilename') then
9724 CompilerFilename:=Value;
9725 'f','F':
9726 if NameFits('FPCSrcDir') then
9727 FPCSrcDir:=Value;
9728 'o','O':
9729 if NameFits('Options') then
9730 Options:=Value;
9731 's','S':
9732 if NameFits('Stamp') then
9733 ChangeStamp:=StrToIntDef(Value,0);
9734 't','T':
9735 if NameFits('TargetOS') then
9736 TargetOS:=Value
9737 else if NameFits('TargetCPU') then
9738 TargetCPU:=Value;
9739 end;
9740 NameStartPos:=ValueEndPos;
9741 end;
9742 end;
9743
9744 { TFPCUnitSetCache }
9745
9746 procedure TFPCUnitSetCache.SetCompilerFilename(const AValue: string);
9747 var
9748 NewFilename: String;
9749 begin
9750 NewFilename:=ResolveDots(AValue);
9751 if FCompilerFilename=NewFilename then exit;
9752 FCompilerFilename:=NewFilename;
9753 ClearConfigCache;
9754 end;
9755
9756 procedure TFPCUnitSetCache.SetCompilerOptions(const AValue: string);
9757 begin
9758 if FCompilerOptions=AValue then exit;
9759 FCompilerOptions:=AValue;
9760 ClearConfigCache;
9761 end;
9762
9763 procedure TFPCUnitSetCache.SetFPCSourceDirectory(const AValue: string);
9764 var
9765 NewValue: String;
9766 begin
9767 NewValue:=TrimAndExpandDirectory(AValue);
9768 if FFPCSourceDirectory=NewValue then exit;
9769 FFPCSourceDirectory:=NewValue;
9770 ClearSourceCache;
9771 end;
9772
9773 procedure TFPCUnitSetCache.SetTargetCPU(const AValue: string);
9774 begin
9775 if FTargetCPU=AValue then exit;
9776 FTargetCPU:=AValue;
9777 ClearConfigCache;
9778 end;
9779
9780 procedure TFPCUnitSetCache.SetTargetOS(const AValue: string);
9781 begin
9782 if FTargetOS=AValue then exit;
9783 FTargetOS:=AValue;
9784 ClearConfigCache;
9785 end;
9786
9787 procedure TFPCUnitSetCache.ClearConfigCache;
9788 begin
9789 FConfigCache:=nil;
9790 fFlags:=fFlags+[fuscfUnitTreeNeedsUpdate,fuscfSrcRulesNeedUpdate];
9791 end;
9792
9793 procedure TFPCUnitSetCache.ClearSourceCache;
9794 begin
9795 fSourceCache:=nil;
9796 Include(fFlags,fuscfUnitTreeNeedsUpdate);
9797 end;
9798
9799 procedure TFPCUnitSetCache.Notification(AComponent: TComponent;
9800 Operation: TOperation);
9801 begin
9802 inherited Notification(AComponent, Operation);
9803 if Operation=opRemove then begin
9804 if FConfigCache=AComponent then
9805 ClearConfigCache;
9806 if fSourceCache=AComponent then
9807 ClearSourceCache;
9808 end;
9809 end;
9810
9811 constructor TFPCUnitSetCache.Create(TheOwner: TComponent);
9812 begin
9813 inherited Create(TheOwner);
9814 CTIncreaseChangeStamp(FChangeStamp); // set ot not 0
9815 FCaches:=TheOwner as TCompilerDefinesCache;
9816 fUnitToSourceTree:=TStringToStringTree.Create(false);
9817 fSrcDuplicates:=TStringToStringTree.Create(false);
9818 fSourceRules:=TFPCSourceRules.Create;
9819 fFlags:=[fuscfUnitTreeNeedsUpdate,fuscfSrcRulesNeedUpdate];
9820 fUnitStampOfFPC:=CTInvalidChangeStamp;
9821 fUnitStampOfFiles:=CTInvalidChangeStamp;
9822 fUnitStampOfRules:=CTInvalidChangeStamp;
9823 end;
9824
9825 destructor TFPCUnitSetCache.Destroy;
9826 begin
9827 FreeAndNil(fSourceRules);
9828 FreeAndNil(fUnitToSourceTree);
9829 FreeAndNil(fSrcDuplicates);
9830 inherited Destroy;
9831 end;
9832
9833 procedure TFPCUnitSetCache.Clear;
9834 begin
9835
9836 end;
9837
9838 procedure TFPCUnitSetCache.Init;
9839 begin
9840 GetUnitToSourceTree(True);
9841 end;
9842
TFPCUnitSetCache.GetConfigCachenull9843 function TFPCUnitSetCache.GetConfigCache(AutoUpdate: boolean
9844 ): TPCTargetConfigCache;
9845 begin
9846 if CompilerFilename='' then
9847 raise Exception.Create('TFPCUnitToSrcCache.GetConfigCache missing CompilerFilename');
9848 if Caches.TestFilename='' then
9849 raise Exception.Create('TFPCUnitToSrcCache.GetConfigCache missing TestFilename');
9850 if FConfigCache=nil then begin
9851 FConfigCache:=Caches.ConfigCaches.Find(CompilerFilename,CompilerOptions,
9852 TargetOS,TargetCPU,true);
9853 FConfigCache.FreeNotification(Self);
9854 end;
9855 //debugln(['TFPCUnitSetCache.GetConfigCache CompilerOptions="',CompilerOptions,'" FConfigCache.CompilerOptions="',FConfigCache.CompilerOptions,'"']);
9856 if AutoUpdate and FConfigCache.NeedsUpdate then
9857 FConfigCache.Update(Caches.TestFilename,Caches.ExtraOptions);
9858 Result:=FConfigCache;
9859 end;
9860
TFPCUnitSetCache.GetSourceCachenull9861 function TFPCUnitSetCache.GetSourceCache(AutoUpdate: boolean
9862 ): TFPCSourceCache;
9863 begin
9864 if fSourceCache=nil then begin
9865 fSourceCache:=Caches.SourceCaches.Find(FPCSourceDirectory,true);
9866 fSourceCache.FreeNotification(Self);
9867 end;
9868 if AutoUpdate and (not fSourceCache.Valid) then
9869 fSourceCache.Update(nil);
9870 Result:=fSourceCache;
9871 end;
9872
GetSourceRulesnull9873 function TFPCUnitSetCache.GetSourceRules(AutoUpdate: boolean
9874 ): TFPCSourceRules;
9875 var
9876 Cfg: TPCTargetConfigCache;
9877 NewRules: TFPCSourceRules;
9878 begin
9879 Cfg:=GetConfigCache(AutoUpdate);
9880 if (fuscfSrcRulesNeedUpdate in fFlags)
9881 or (fRulesStampOfConfig<>Cfg.ChangeStamp) then begin
9882 Exclude(fFlags,fuscfSrcRulesNeedUpdate);
9883 if Cfg.Kind=pcFPC then begin
9884 NewRules:=DefaultFPCSourceRules.Clone;
9885 try
9886 if Cfg.Units<>nil then
9887 AdjustFPCSrcRulesForPPUPaths(Cfg.Units,NewRules);
9888 fSourceRules.Assign(NewRules); // increases ChangeStamp if something changed
9889 finally
9890 NewRules.Free;
9891 end;
9892 end else begin
9893 fSourceRules.Clear;
9894 end;
9895 fRulesStampOfConfig:=Cfg.ChangeStamp;
9896 end;
9897 Result:=fSourceRules;
9898 end;
9899
TFPCUnitSetCache.GetUnitToSourceTreenull9900 function TFPCUnitSetCache.GetUnitToSourceTree(AutoUpdate: boolean
9901 ): TStringToStringTree;
9902 var
9903 Src: TFPCSourceCache;
9904 SrcRules: TFPCSourceRules;
9905 NewUnitToSourceTree: TStringToStringTree;
9906 NewSrcDuplicates: TStringToStringTree;
9907 ConfigCache: TPCTargetConfigCache;
9908 begin
9909 Src:=GetSourceCache(AutoUpdate);
9910 SrcRules:=GetSourceRules(AutoUpdate);
9911 ConfigCache:=GetConfigCache(false); // Note: update already done by GetSourceRules(AutoUpdate)
9912
9913 if ConfigCache.Kind=pcFPC then begin
9914 if (fuscfUnitTreeNeedsUpdate in fFlags)
9915 or (fUnitStampOfFPC<>ConfigCache.ChangeStamp)
9916 or (fUnitStampOfFiles<>Src.ChangeStamp)
9917 or (fUnitStampOfRules<>SrcRules.ChangeStamp)
9918 then begin
9919 Exclude(fFlags,fuscfUnitTreeNeedsUpdate);
9920 NewSrcDuplicates:=nil;
9921 NewUnitToSourceTree:=nil;
9922 try
9923 NewSrcDuplicates:=TStringToStringTree.Create(false);
9924 NewUnitToSourceTree:=GatherUnitsInFPCSources(Src.Files,
9925 ConfigCache.RealTargetOS,ConfigCache.RealTargetCPU,
9926 NewSrcDuplicates,SrcRules);
9927 if NewUnitToSourceTree=nil then
9928 NewUnitToSourceTree:=TStringToStringTree.Create(false);
9929 // ToDo: add/replace sources in PPU search paths
9930 if not fUnitToSourceTree.Equals(NewUnitToSourceTree) then begin
9931 fUnitToSourceTree.Assign(NewUnitToSourceTree);
9932 IncreaseChangeStamp;
9933 end;
9934 if not fSrcDuplicates.Equals(NewSrcDuplicates) then begin
9935 fSrcDuplicates.Assign(NewSrcDuplicates);
9936 IncreaseChangeStamp;
9937 end;
9938 fUnitStampOfFPC:=ConfigCache.ChangeStamp;
9939 fUnitStampOfFiles:=Src.ChangeStamp;
9940 fUnitStampOfRules:=SrcRules.ChangeStamp;
9941 finally
9942 NewUnitToSourceTree.Free;
9943 NewSrcDuplicates.Free;
9944 end;
9945 end;
9946 end else begin
9947 fUnitToSourceTree.Clear;
9948 fSrcDuplicates.Clear;
9949 Exclude(fFlags,fuscfUnitTreeNeedsUpdate);
9950 fUnitStampOfFPC:=ConfigCache.ChangeStamp;
9951 fUnitStampOfFiles:=Src.ChangeStamp;
9952 fUnitStampOfRules:=SrcRules.ChangeStamp;
9953 end;
9954 Result:=fUnitToSourceTree;
9955 end;
9956
TFPCUnitSetCache.GetSourceDuplicatesnull9957 function TFPCUnitSetCache.GetSourceDuplicates(AutoUpdate: boolean
9958 ): TStringToStringTree;
9959 begin
9960 GetUnitToSourceTree(AutoUpdate);
9961 Result:=fSrcDuplicates;
9962 end;
9963
TFPCUnitSetCache.GetUnitSrcFilenull9964 function TFPCUnitSetCache.GetUnitSrcFile(const AnUnitName: string;
9965 SrcSearchRequiresPPU: boolean; SkipPPUCheckIfTargetIsSourceOnly: boolean): string;
9966 { Searches the unit in the FPC search path and sources.
9967 SrcSearchRequiresPPU: only search the sources if there is a ppu in the search path
9968 }
9969 var
9970 Tree: TStringToStringTree;
9971 ConfigCache: TPCTargetConfigCache;
9972 UnitInFPCPath: String;
9973 begin
9974 Result:='';
9975 {$IFDEF ShowTriedUnits}
9976 debugln(['TFPCUnitSetCache.GetUnitSrcFile Unit="',AnUnitName,'" SrcSearchRequiresPPU=',SrcSearchRequiresPPU,' SkipPPUCheckIfTargetIsSourceOnly=',SkipPPUCheckIfTargetIsSourceOnly]);
9977 {$ENDIF}
9978 Tree:=GetUnitToSourceTree(false);
9979 ConfigCache:=GetConfigCache(false);
9980 if (ConfigCache.Units<>nil) then begin
9981 UnitInFPCPath:=ConfigCache.Units[AnUnitName];
9982 //if Pos('lazmkunit',AnUnitName)>0 then debugln(['TFPCUnitSetCache.GetUnitSrcFile UnitInFPCPath=',UnitInFPCPath]);
9983 if (CompareFileExt(UnitInFPCPath,'ppu',false)=0) then begin
9984 // there is a ppu
9985 end else if UnitInFPCPath<>'' then begin
9986 // there is a pp or pas in the FPC search path
9987 {$IFDEF ShowTriedUnits}
9988 debugln(['TFPCUnitSetCache.GetUnitSrcFile Unit="',AnUnitName,'" source in FPC search path: "',Result,'"']);
9989 {$ENDIF}
9990 Result:=UnitInFPCPath;
9991 exit;
9992 end else begin
9993 // unit has no ppu in the FPC ppu search path
9994 if SrcSearchRequiresPPU then begin
9995 if ConfigCache.HasPPUs then begin
9996 // but there are other ppu files
9997 {$IFDEF ShowTriedUnits}
9998 debugln(['TFPCUnitSetCache.GetUnitSrcFile Unit="',AnUnitName,'" unit has no ppu file in FPC path, but there are other ppu']);
9999 {$ENDIF}
10000 exit;
10001 end else begin
10002 // no ppu exists at all
10003 // => the fpc is not installed properly for this target
10004 {$IFDEF ShowTriedUnits}
10005 debugln(['TFPCUnitSetCache.GetUnitSrcFile Unit="',AnUnitName,'" there are no ppu files for this target']);
10006 {$ENDIF}
10007 if (not SkipPPUCheckIfTargetIsSourceOnly) then
10008 exit;
10009 // => search directly in the sources
10010 // this allows cross editing even if FPC is not installed for this target
10011 end;
10012 end;
10013 end;
10014 end;
10015 // search the sources
10016 if Tree<>nil then begin
10017 Result:=Tree[AnUnitName];
10018 if (Result<>'') and (not FilenameIsAbsolute(Result)) then
10019 Result:=FPCSourceDirectory+Result;
10020 {$IFDEF ShowTriedUnits}
10021 debugln(['TFPCUnitSetCache.GetUnitSrcFile Unit="',AnUnitName,'" Result=',Result]);
10022 {$ENDIF}
10023 end;
10024 end;
10025
TFPCUnitSetCache.GetCompiledUnitFilenull10026 function TFPCUnitSetCache.GetCompiledUnitFile(const AUnitName: string): string;
10027 var
10028 ConfigCache: TPCTargetConfigCache;
10029 begin
10030 Result:='';
10031 ConfigCache:=GetConfigCache(false);
10032 if ConfigCache.Units=nil then exit;
10033 Result:=ConfigCache.Units[AUnitName];
10034 if Result='' then exit;
10035 if CompareFileExt(Result,'.ppu',false)<>0 then
10036 Result:='';
10037 end;
10038
TFPCUnitSetCache.GetInvalidChangeStampnull10039 class function TFPCUnitSetCache.GetInvalidChangeStamp: integer;
10040 begin
10041 Result:=CTInvalidChangeStamp;
10042 end;
10043
10044 procedure TFPCUnitSetCache.IncreaseChangeStamp;
10045 begin
10046 CTIncreaseChangeStamp(FChangeStamp);
10047 end;
10048
GetUnitSetIDnull10049 function TFPCUnitSetCache.GetUnitSetID: string;
10050 begin
10051 Result:=Caches.GetUnitSetID(CompilerFilename,TargetOS,TargetCPU,
10052 CompilerOptions,FPCSourceDirectory,ChangeStamp);
10053 end;
10054
GetFirstFPCCfgnull10055 function TFPCUnitSetCache.GetFirstFPCCfg: string;
10056 var
10057 Cfg: TPCTargetConfigCache;
10058 i: Integer;
10059 Files: TPCConfigFileStateList;
10060 begin
10061 Result:='';
10062 Cfg:=GetConfigCache(false);
10063 if Cfg=nil then exit;
10064 Files:=Cfg.ConfigFiles;
10065 if Files=nil then exit;
10066 for i:=0 to Files.Count-1 do begin
10067 if Files[i].FileExists then begin
10068 Result:=Files[i].Filename;
10069 exit;
10070 end;
10071 end;
10072 end;
10073
TFPCUnitSetCache.GetUnitScopesnull10074 function TFPCUnitSetCache.GetUnitScopes: string;
10075 var
10076 Cfg: TPCTargetConfigCache;
10077 Scopes: TStrings;
10078 Scope: String;
10079 i: Integer;
10080 begin
10081 Result:='';
10082 Cfg:=GetConfigCache(false);
10083 if Cfg=nil then exit;
10084 Scopes:=Cfg.UnitScopes;
10085 if Scopes=nil then exit;
10086 for i:=0 to Scopes.Count-1 do begin
10087 Scope:=Scopes[i];
10088 if Scope='' then continue;
10089 Result:=Result+';'+Scope;
10090 end;
10091 Delete(Result,1,1);
10092 end;
10093
TFPCUnitSetCache.GetCompilerKindnull10094 function TFPCUnitSetCache.GetCompilerKind: TPascalCompiler;
10095 var
10096 Cfg: TPCTargetConfigCache;
10097 begin
10098 Cfg:=GetConfigCache(false);
10099 if Cfg=nil then exit(pcFPC);
10100 Result:=Cfg.Kind;
10101 end;
10102
10103 initialization
10104 InitDefaultFPCSourceRules;
10105
10106 finalization
10107 FreeAndNil(DefaultFPCSourceRules);
10108
10109 end.
10110
10111
10112