{
 ***************************************************************************
 *                                                                         *
 *   This source is free software; you can redistribute it and/or modify   *
 *   it under the terms of the GNU General Public License as published by  *
 *   the Free Software Foundation; either version 2 of the License, or     *
 *   (at your option) any later version.                                   *
 *                                                                         *
 *   This code is distributed in the hope that it will be useful, but      *
 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
 *   General Public License for more details.                              *
 *                                                                         *
 *   A copy of the GNU General Public License is available on the World    *
 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 *   obtain it by writing to the Free Software Foundation,                 *
 *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
 *                                                                         *
 ***************************************************************************

  Author: Mattias Gaertner

  Abstract:
    This unit is a support unit for the code tools. It manages compilation
    information, which is not stored in the source, like Makefile information
    and compiler command line options. This information is needed to
    successfully find the right units, include files, predefined variables,
    etc..
    
    The information is stored in a TDefineTree, which contains nodes of type
    TDefineTemplate. Each TDefineTemplate is a tree of defines, undefines,
    definerecurses, ifdefs, ifndefs, elses, elseifs, directories ... .
    
    Simply give a TDefineTree a directory and it will return all predefined
    variables for that directory. These values can be used to parse a unit in
    the directory.
    
    TDefineTree can be saved to and loaded from a XML file.
    
    The TDefinePool contains a list of TDefineTemplate trees, and can generate
    some default templates for Lazarus and FPC sources.
}
unit DefineTemplates;

{$mode objfpc}{$H+}

{ $Define VerboseDefineCache}
{ $Define VerboseFPCSrcScan}
{ $Define ShowTriedFiles}
{ $Define ShowTriedUnits}

interface

uses
  // RTL + FCL
  Classes, SysUtils, AVL_Tree, process,
  // CodeTools
  CodeToolsStrConsts, ExprEval, DirectoryCacher, BasicCodeTools,
  CodeToolsStructs, KeywordFuncLists, LinkScanner, FileProcs,
  // LazUtils
  LazUtilities, LazUTF8, LazUTF8Classes, LazFileUtils, UTF8Process,
  LazFileCache, LazDbgLog, Laz2_XMLCfg;

const
  ExternalMacroStart = ExprEval.ExternalMacroStart;

  // Standard Template Names (do not translate them)
  StdDefTemplFPC            = 'Free Pascal Compiler';
  StdDefTemplFPCSrc         = 'Free Pascal sources';
  StdDefTemplLazarusSources = 'Lazarus sources';
  StdDefTemplLazarusSrcDir  = 'Lazarus source directory';
  StdDefTemplLazarusBuildOpts = 'Lazarus build options';
  StdDefTemplLCLProject     = 'LCL project';

  // Standard macros
  DefinePathMacroName      = ExternalMacroStart+'DefinePath'; // the current directory
  UnitPathMacroName        = ExternalMacroStart+'UnitPath'; // unit search path separated by semicolon (same as given to FPC)
  IncludePathMacroName     = ExternalMacroStart+'IncPath'; // include file search path separated by semicolon (same as given to FPC)
  SrcPathMacroName         = ExternalMacroStart+'SrcPath'; // unit source search path separated by semicolon (not given to FPC)
  PPUSrcPathMacroName      = ExternalMacroStart+'PPUSrcPath';
  DCUSrcPathMacroName      = ExternalMacroStart+'DCUSrcPath';
  CompiledSrcPathMacroName = ExternalMacroStart+'CompiledSrcPath';
  UnitLinksMacroName       = ExternalMacroStart+'UnitLinks';
  UnitSetMacroName         = ExternalMacroStart+'UnitSet';
  FPCUnitPathMacroName     = ExternalMacroStart+'FPCUnitPath';
  TargetOSMacroName        = ExternalMacroStart+'TargetOS';
  TargetCPUMacroName       = ExternalMacroStart+'TargetCPU';

  DefinePathMacro          = '$('+DefinePathMacroName+')'; // the path of the define template
  UnitPathMacro            = '$('+UnitPathMacroName+')';
  IncludePathMacro         = '$('+IncludePathMacroName+')';
  SrcPathMacro             = '$('+SrcPathMacroName+')';
  PPUSrcPathMacro          = '$('+PPUSrcPathMacroName+')';
  DCUSrcPathMacro          = '$('+DCUSrcPathMacroName+')';
  CompiledSrcPathMacro     = '$('+CompiledSrcPathMacroName+')';
  UnitLinksMacro           = '$('+UnitLinksMacroName+')';
  UnitSetMacro             = '$('+UnitSetMacroName+')';
  FPCUnitPathMacro         = '$('+FPCUnitPathMacroName+')';
  TargetOSMacro            = '$('+TargetOSMacroName+')';
  TargetCPUMacro           = '$('+TargetCPUMacroName+')';


  // virtual directories
  VirtualDirectory='VIRTUALDIRECTORY';
  VirtualTempDir='TEMPORARYDIRECTORY';
  
  // FPC operating systems and processor types
  FPCOperatingSystemNames: array[1..33] of shortstring =(
     'linux',
     'win32','win64','wince',
     'darwin','macos',
     'freebsd','netbsd','openbsd',
     'aix',
     'amiga',
     'android',
     'atari',
     'beos',
     'embedded',
     'emx',
     'gba',
     'go32v2',
     'haiku',
     'iphonesim',
     'java',
     'msdos',
     'morphos',
     'nds',
     'netware',
     'netwlibc',
     'os2',
     'palmos',
     'qnx',
     'solaris',
     'symbian',
     'watcom',
     'wdosx'
    );
  FPCOperatingSystemCaptions: array[1..33] of shortstring =(
     'AIX',
     'Amiga',
     'Android',
     'Atari',
     'Beos',
     'Darwin',
     'Embedded',
     'emx',
     'FreeBSD',
     'gba',
     'go32v2',
     'Haiku',
     'iphonesim',
     'Java',
     'Linux',
     'MacOS',
     'MorphOS',
     'MSDOS',
     'nds',
     'NetBSD',
     'Netware',
     'NetwLibC',
     'OpenBSD',
     'OS2',
     'PalmOS',
     'qnx',
     'Solaris',
     'Symbian',
     'Watcom',
     'wdosx',
     'Win32',
     'Win64',
     'WinCE'
    );

  FPCOperatingSystemAlternativeNames: array[1..2] of shortstring =(
      'unix', 'win' // see GetDefaultSrcOSForTargetOS
    );
  FPCOperatingSystemAlternative2Names: array[1..2] of shortstring =(
      'bsd', 'linux' // see GetDefaultSrcOS2ForTargetOS
    );
  FPCProcessorNames: array[1..12] of shortstring =(
      'a64',
      'arm',
      'avr',
      'i386',
      'i8086',
      'jvm',
      'm68k',
      'mips',
      'mipsel',
      'powerpc',
      'sparc',
      'x86_64'
    );
  FPCSyntaxModes: array[1..6] of shortstring = (
    'FPC', 'ObjFPC', 'Delphi', 'TP', 'MacPas', 'ISO'
    );

  Lazarus_CPU_OS_Widget_Combinations: array[1..65] of shortstring = (
    'i386-linux-gtk',
    'i386-linux-gtk2',
    'i386-linux-qt',
    'i386-linux-fpgui',
    'i386-linux-nogui',
    'i386-freebsd-gtk',
    'i386-freebsd-gtk2',
    'i386-freebsd-qt',
    'i386-freebsd-nogui',
    'i386-openbsd-gtk',
    'i386-openbsd-gtk2',
    'i386-openbsd-qt',
    'i386-openbsd-nogui',
    'i386-netbsd-gtk',
    'i386-netbsd-gtk2',
    'i386-netbsd-qt',
    'i386-netbsd-nogui',
    'i386-win32-win32',
    'i386-win32-gtk2',
    'i386-win32-qt',
    'i386-win32-fpgui',
    'i386-win32-nogui',
    'i386-wince-wince',
    'i386-wince-fpgui',
    'i386-wince-nogui',
    'i386-darwin-gtk',
    'i386-darwin-gtk2',
    'i386-darwin-carbon',
    'i386-darwin-qt',
    'i386-darwin-fpgui',
    'i386-darwin-nogui',
    'i386-haiku-qt',
    'i386-haiku-nogui',
    'powerpc-darwin-gtk',
    'powerpc-darwin-gtk2',
    'powerpc-darwin-carbon',
    'powerpc-linux-gtk',
    'powerpc-linux-gtk2',
    'powerpc-linux-nogui',
    'sparc-linux-gtk',
    'sparc-linux-gtk2',
    'sparc-linux-nogui',
    'arm-wince-wince',
    'arm-wince-fpgui',
    'arm-wince-nogui',
    'arm-linux-gtk',
    'arm-linux-gtk2',
    'arm-linux-qt',
    'arm-linux-android',
    'arm-linux-nogui',
    'arm-darwin-carbon',
    'arm-darwin-nogui',
    'x86_64-freebsd-gtk',
    'x86_64-freebsd-gtk2',
    'x86_64-freebsd-qt',
    'x86_64-freebsd-fpgui',
    'x86_64-freebsd-nogui',
    'x86_64-linux-gtk',
    'x86_64-linux-gtk2',
    'x86_64-linux-qt',
    'x86_64-linux-fpgui',
    'x86_64-linux-nogui',
    'x86_64-win64-win32',
    'x86_64-win64-fpgui',
    'x86_64-win64-nogui'
    );

type
  //---------------------------------------------------------------------------
  // TDefineTemplate stores a define action, the variablename and the value
  TDefineAction = (
    da_None,
    da_Block,
    da_Define,
    da_DefineRecurse,
    da_Undefine,
    da_UndefineRecurse,
    da_UndefineAll,
    da_If,
    da_IfDef,
    da_IfNDef,
    da_ElseIf,
    da_Else,
    da_Directory
  );

const
  DefineActionBlocks = [da_Block, da_Directory, da_If, da_IfDef, da_IfNDef,
                        da_ElseIf, da_Else];
  DefineActionDefines = [da_Define,da_DefineRecurse,da_Undefine,
                         da_UndefineRecurse,da_UndefineAll];
  DefineActionNames: array[TDefineAction] of string = (
      'None', 'Block', 'Define', 'DefineRecurse', 'Undefine', 'UndefineRecurse',
      'UndefineAll', 'If', 'IfDef', 'IfNDef', 'ElseIf', 'Else', 'Directory'
    );
var
  DefineActionImages: array[TDefineAction] of integer;
  AutogeneratedImage: Integer;

type
  TDefineTree = class;
  TDefineTemplateFlag = (
    dtfAutoGenerated
    );
  TDefineTemplateFlags = set of TDefineTemplateFlag;
  
  TDefineTemplate = class
  private
    FChildCount: integer;
    FFirstChild: TDefineTemplate;
    FLastChild: TDefineTemplate;
    FMarked: boolean;
    FMergeNameBehind: string;
    FMergeNameInFront: string;
    FNext: TDefineTemplate;
    FParent: TDefineTemplate;
    FPrior: TDefineTemplate;
  public
    Name: string;
    Description: string;
    Variable: string;
    Value: string;
    Action: TDefineAction;
    Flags: TDefineTemplateFlags;
    Owner: TObject;
    class procedure MergeTemplates(ParentDefTempl: TDefineTemplate;
                  var FirstSibling, LastSibling:TDefineTemplate;
                  SourceTemplate: TDefineTemplate; WithSiblings: boolean;
                  const NewNamePrefix: string);
    class procedure MergeXMLConfig(ParentDefTempl: TDefineTemplate;
                  var FirstSibling, LastSibling:TDefineTemplate;
                  XMLConfig: TXMLConfig; const Path, NewNamePrefix: string);
    constructor Create(const AName, ADescription, AVariable, AValue: string;
                       AnAction: TDefineAction);
    constructor Create;
    destructor Destroy; override;
    procedure ConsistencyCheck;
    procedure CalcMemSize(Stats: TCTMemStats);
    function  CreateCopy(OnlyMarked: boolean = false;
                         WithSiblings: boolean = true;
                         WithChilds: boolean = true): TDefineTemplate;
    function  CreateMergeCopy: TDefineTemplate;
    function  FindByName(const AName: string;
                     WithSubChilds, WithNextSiblings: boolean): TDefineTemplate;
    function  FindChildByName(const AName: string): TDefineTemplate;
    function  FindRoot: TDefineTemplate;
    function  FindUniqueName(const Prefix: string): string;
    function  GetFirstSibling: TDefineTemplate;
    function  HasDefines(OnlyMarked, WithSiblings: boolean): boolean;
    function  IsAutoGenerated: boolean;
    function  IsEqual(ADefineTemplate: TDefineTemplate;
                      CheckSubNodes, CheckNextSiblings: boolean): boolean;
    function  Level: integer;
    function  LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string;
                                ClearOldSiblings, WithMergeInfo: boolean): boolean;
    function  SelfOrParentContainsFlag(AFlag: TDefineTemplateFlag): boolean;
    procedure AddChild(ADefineTemplate: TDefineTemplate);
    procedure ReplaceChild(ADefineTemplate: TDefineTemplate);
    function DeleteChild(const AName: string): boolean;
    procedure Assign(ADefineTemplate: TDefineTemplate; WithSubNodes,
                     WithNextSiblings, ClearOldSiblings: boolean); virtual;
    procedure AssignValues(ADefineTemplate: TDefineTemplate);
    procedure Clear(WithSiblings: boolean);
    procedure CreateMergeInfo(WithSiblings, OnlyMarked: boolean);
    procedure InheritMarks(WithSiblings, WithChilds, Down, Up: boolean);
    procedure InsertBehind(APrior: TDefineTemplate);
    procedure InsertInFront(ANext: TDefineTemplate);
    procedure MoveToLast(Child: TDefineTemplate);
    procedure LoadValuesFromXMLConfig(XMLConfig: TXMLConfig; const Path: string;
                                      WithMergeInfo: boolean);
    procedure MarkFlags(const MustFlags, NotFlags: TDefineTemplateFlags;
                        WithSiblings, WithChilds: boolean);
    procedure MarkNodes(WithSiblings, WithChilds: boolean);
    procedure MarkOwnedBy(TheOwner: TObject;
                          const MustFlags, NotFlags: TDefineTemplateFlags;
                          WithSiblings, WithChilds: boolean);
    procedure RemoveFlags(TheFlags: TDefineTemplateFlags);
    procedure RemoveLeaves(TheOwner: TObject; const MustFlags,
                           NotFlags: TDefineTemplateFlags;
                           WithSiblings: boolean;
                           var FirstDefTemplate: TDefineTemplate);
    procedure RemoveMarked(WithSiblings: boolean;
                           var FirstDefTemplate: TDefineTemplate);
    procedure RemoveOwner(TheOwner: TObject; WithSiblings: boolean);
    procedure ReverseMarks(WithSiblings, WithChilds: boolean);
    procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string;
                              WithSiblings, OnlyMarked,
                              WithMergeInfo, UpdateMergeInfo: boolean);
    procedure SaveValuesToXMLConfig(XMLConfig: TXMLConfig; const Path: string;
                                    WithMergeInfo: boolean);
    procedure SetDefineOwner(NewOwner: TObject; WithSiblings: boolean);
    procedure SetFlags(AddFlags, SubFlags: TDefineTemplateFlags;
                       WithSiblings: boolean);
    procedure Unbind;
    procedure UnmarkNodes(WithSiblings, WithChilds: boolean);
    procedure WriteDebugReport(OnlyMarked: boolean);
    function GetNext: TDefineTemplate;
    function GetNextSkipChildren: TDefineTemplate;
  public
    property ChildCount: integer read FChildCount;
    property FirstChild: TDefineTemplate read FFirstChild;
    property LastChild: TDefineTemplate read FLastChild;
    property Marked: boolean read FMarked write FMarked;
    property Next: TDefineTemplate read FNext;
    property Parent: TDefineTemplate read FParent;
    property Prior: TDefineTemplate read FPrior;
    property MergeNameInFront: string read FMergeNameInFront write FMergeNameInFront;
    property MergeNameBehind: string read FMergeNameBehind write FMergeNameBehind;
  end;

  //---------------------------------------------------------------------------
  //

  { TDirectoryDefines }

  TDirectoryDefines = class
  public
    Path: string;
    Values: TExpressionEvaluator;
    constructor Create;
    destructor Destroy; override;
    procedure CalcMemSize(Stats: TCTMemStats);
  end;
  
  TOnGetVirtualDirectoryDefines = procedure(Sender: TDefineTree;
    Defines: TDirectoryDefines) of object;

  //---------------------------------------------------------------------------
  // TDefineTree caches the define values for directories
  TOnReadValue = procedure(Sender: TObject; const VariableName: string;
                          var Value: string; var Handled: boolean) of object;

  TOnGetVirtualDirectoryAlias = procedure(Sender: TObject;
    var RealDir: string) of object;
    
  TReadFunctionData = record
    Param: string;
    Result: string;
  end;
  PReadFunctionData = ^TReadFunctionData;
  
  TDefTreeCalculate = procedure(Tree: TDefineTree; Node: TDefineTemplate;
    ValueParsed: boolean; const ParsedValue: string;
    ExpressionCalculated: boolean; const ExpressionResult: string;
    Execute: boolean) of object;

  TDefineTree = class
  private
    FDirectoryCachePool: TCTDirectoryCachePool;
    FFirstDefineTemplate: TDefineTemplate;
    FCache: TAVLTree; // tree of TDirectoryDefines
    FDefineStrings: TStringTree;
    FChangeStep: integer;
    FErrorDescription: string;
    FErrorTemplate: TDefineTemplate;
    FMacroFunctions: TKeyWordFunctionList;
    FMacroVariables: TKeyWordFunctionList;
    FOnCalculate: TDefTreeCalculate;
    FOnGetVirtualDirectoryAlias: TOnGetVirtualDirectoryAlias;
    FOnGetVirtualDirectoryDefines: TOnGetVirtualDirectoryDefines;
    FOnPrepareTree: TNotifyEvent;
    FOnReadValue: TOnReadValue;
    FVirtualDirCache: TDirectoryDefines;
    function Calculate(DirDef: TDirectoryDefines): boolean;
    procedure IncreaseChangeStep;
    procedure SetDirectoryCachePool(const AValue: TCTDirectoryCachePool);
    procedure RemoveDoubles(Defines: TDirectoryDefines);
  protected
    function FindDirectoryInCache(const Path: string): TDirectoryDefines;
    function GetDirDefinesForDirectory(const Path: string;
                                    WithVirtualDir: boolean): TDirectoryDefines;
    function GetDirDefinesForVirtualDirectory: TDirectoryDefines;
    function MacroFuncExtractFileExt(Data: Pointer): boolean;
    function MacroFuncExtractFilePath(Data: Pointer): boolean;
    function MacroFuncExtractFileName(Data: Pointer): boolean;
    function MacroFuncExtractFileNameOnly(Data: Pointer): boolean;
    procedure DoClearCache;
    procedure DoPrepareTree;
  public
    property RootTemplate: TDefineTemplate
                           read FFirstDefineTemplate write FFirstDefineTemplate;
    property ChangeStep: integer read FChangeStep;
    property ErrorTemplate: TDefineTemplate read FErrorTemplate;
    property ErrorDescription: string read FErrorDescription;
    property OnGetVirtualDirectoryAlias: TOnGetVirtualDirectoryAlias
             read FOnGetVirtualDirectoryAlias write FOnGetVirtualDirectoryAlias;
    property OnGetVirtualDirectoryDefines: TOnGetVirtualDirectoryDefines
         read FOnGetVirtualDirectoryDefines write FOnGetVirtualDirectoryDefines;
    property OnReadValue: TOnReadValue read FOnReadValue write FOnReadValue;
    property OnPrepareTree: TNotifyEvent read FOnPrepareTree write FOnPrepareTree;
    property OnCalculate: TDefTreeCalculate read FOnCalculate write FOnCalculate;
    property MacroFunctions: TKeyWordFunctionList read FMacroFunctions;
    property MacroVariables: TKeyWordFunctionList read FMacroVariables;
  public
    constructor Create;
    destructor Destroy; override;
    procedure ConsistencyCheck;
    procedure CalcMemSize(Stats: TCTMemStats);
    function  ExtractNonAutoCreated: TDefineTemplate;
    function  ExtractTemplatesOwnedBy(TheOwner: TObject; const MustFlags,
                               NotFlags: TDefineTemplateFlags): TDefineTemplate;
    function  FindDefineTemplateByName(const AName: string;
                                       OnlyRoots: boolean): TDefineTemplate;
    function  GetCompiledSrcPathForDirectory(const Directory: string): string;
    function  GetDCUSrcPathForDirectory(const Directory: string): string;
    function  GetDefinesForDirectory(const Path: string;
                                 WithVirtualDir: boolean): TExpressionEvaluator;
    function  GetDefinesForVirtualDirectory: TExpressionEvaluator;
    function  GetIncludePathForDirectory(const Directory: string): string;
    function  GetLastRootTemplate: TDefineTemplate;
    function  GetPPUSrcPathForDirectory(const Directory: string): string;
    function  GetSrcPathForDirectory(const Directory: string): string;
    function  GetUnitPathForDirectory(const Directory: string): string;
    function  IsEqual(SrcDefineTree: TDefineTree): boolean;
    procedure Add(ADefineTemplate: TDefineTemplate);
    procedure AddChild(ParentTemplate, NewDefineTemplate: TDefineTemplate);
    procedure AddFirst(ADefineTemplate: TDefineTemplate);
    procedure MoveToLast(ADefineTemplate: TDefineTemplate);
    procedure Assign(SrcDefineTree: TDefineTree);
    procedure AssignNonAutoCreated(SrcDefineTree: TDefineTree);
    procedure Clear;
    procedure ClearCache;
    procedure MarkNonAutoCreated;
    procedure MarkTemplatesOwnedBy(TheOwner: TObject;
                               const MustFlags, NotFlags: TDefineTemplateFlags);
    procedure MergeDefineTemplates(SourceTemplate: TDefineTemplate;
                                   const NewNamePrefix: string);
    procedure MergeTemplates(SourceTemplate: TDefineTemplate;
                             const NewNamePrefix: string);
    procedure ReadValue(const DirDef: TDirectoryDefines;
                   const PreValue, CurDefinePath: string; out NewValue: string);
    procedure RemoveDefineTemplate(ADefTempl: TDefineTemplate);
    procedure RemoveMarked;
    procedure RemoveRootDefineTemplateByName(const AName: string);
    procedure RemoveTemplatesOwnedBy(TheOwner: TObject;
                               const MustFlags, NotFlags: TDefineTemplateFlags);
    procedure ReplaceChild(ParentTemplate, NewDefineTemplate: TDefineTemplate;
                           const ChildName: string);
    procedure ReplaceRootSameName(ADefineTemplate: TDefineTemplate);
    procedure ReplaceRootSameName(const Name: string;
                                  ADefineTemplate: TDefineTemplate);
    procedure ReplaceRootSameNameAddFirst(ADefineTemplate: TDefineTemplate);
    procedure WriteDebugReport;
    property DirectoryCachePool: TCTDirectoryCachePool read FDirectoryCachePool write SetDirectoryCachePool;
  end;

  //---------------------------------------------------------------------------

  { TDefinePool }

  TDefinePoolProgress = procedure(Sender: TObject;
    Index, MaxIndex: integer; // MaxIndex=-1 if unknown
    const Msg: string;
    var Abort: boolean) of object;

  TDefinePool = class
  private
    FEnglishErrorMsgFilename: string;
    FItems: TFPList; // list of TDefineTemplate;
    FOnProgress: TDefinePoolProgress;
    function GetItems(Index: integer): TDefineTemplate;
    procedure SetEnglishErrorMsgFilename(const AValue: string);
    function CheckAbort(ProgressID, MaxIndex: integer; const Msg: string
                        ): boolean;
  public
    property Items[Index: integer]: TDefineTemplate read GetItems; default;
    function Count: integer;
    procedure Add(ADefineTemplate: TDefineTemplate);
    procedure Insert(Index: integer; ADefineTemplate: TDefineTemplate);
    procedure Delete(Index: integer);
    procedure Move(SrcIndex, DestIndex: integer);
    property EnglishErrorMsgFilename: string
        read FEnglishErrorMsgFilename write SetEnglishErrorMsgFilename;
    // FPC templates
    function CreateFPCTemplate(const CompilerPath, CompilerOptions,
                               TestPascalFile: string;
                               out UnitSearchPath, TargetOS,
                               aTargetCPU: string;
                               Owner: TObject): TDefineTemplate;
    function GetFPCVerFromFPCTemplate(Template: TDefineTemplate;
                        out FPCVersion, FPCRelease, FPCPatch: integer): boolean;
    function CreateFPCSrcTemplate(const FPCSrcDir, UnitSearchPath, PPUExt,
                          DefaultTargetOS, DefaultProcessorName: string;
                          UnitLinkListValid: boolean; var UnitLinkList: string;
                          Owner: TObject): TDefineTemplate; deprecated;
    function CreateFPCCommandLineDefines(const Name, CmdLine: string;
                                 RecursiveDefines: boolean;
                                 Owner: TObject;
                                 AlwaysCreate: boolean = false;
                                 AddPaths: boolean = false
                                 ): TDefineTemplate;
    // Lazarus templates
    function CreateLazarusSrcTemplate(
                          const LazarusSrcDir, WidgetType, ExtraOptions: string;
                          Owner: TObject): TDefineTemplate;
    function CreateLCLProjectTemplate(const LazarusSrcDir, WidgetType,
                          ProjectDir: string; Owner: TObject): TDefineTemplate;
    // Delphi templates
    function CreateDelphiSrcPath(DelphiVersion: integer;
                                 const PathPrefix: string): string;
    function CreateDelphiCompilerDefinesTemplate(DelphiVersion: integer;
                                               Owner: TObject): TDefineTemplate;
    function CreateDelphiDirectoryTemplate(const DelphiDirectory: string;
                       DelphiVersion: integer; Owner: TObject): TDefineTemplate;
    function CreateDelphiProjectTemplate(const ProjectDir,
                                 DelphiDirectory: string; DelphiVersion: integer;
                                 Owner: TObject): TDefineTemplate;
    // Kylix templates
    function CreateKylixCompilerDefinesTemplate(KylixVersion: integer;
                                               Owner: TObject): TDefineTemplate;
    function CreateKylixSrcPath({%H-}KylixVersion: integer;
                                const PathPrefix: string): string;
    function CreateKylixDirectoryTemplate(const KylixDirectory: string;
                        KylixVersion: integer; Owner: TObject): TDefineTemplate;
    function CreateKylixProjectTemplate(const ProjectDir,
                                 KylixDirectory: string; KylixVersion: integer;
                                 Owner: TObject): TDefineTemplate;

    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    property OnProgress: TDefinePoolProgress read FOnProgress write FOnProgress;
    procedure ConsistencyCheck;
    procedure WriteDebugReport;
    procedure CalcMemSize(Stats: TCTMemStats);
  end;

  { TFPCSourceRule }

  TFPCSourceRule = class
  public
    Filename: string;
    Score: integer;
    Targets: string; // comma separated list of OS, CPU, e.g. win32,unix,i386 or * for all
    function FitsTargets(const FilterTargets: string): boolean;
    function FitsFilename(const aFilename: string): boolean;
    function IsEqual(Rule: TFPCSourceRule): boolean;
    procedure Assign(Rule: TFPCSourceRule);
  end;

  { TFPCSourceRules }

  TFPCSourceRules = class
  private
    FChangeStamp: integer;
    FItems: TFPList;// list of TFPCSourceRule
    FScore: integer;
    FTargets: string;
    function GetItems(Index: integer): TFPCSourceRule;
    procedure SetTargets(const AValue: string);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    function IsEqual(Rules: TFPCSourceRules): boolean;
    procedure Assign(Rules: TFPCSourceRules);
    function Clone: TFPCSourceRules;
    property Items[Index: integer]: TFPCSourceRule read GetItems; default;
    function Count: integer;
    function Add(const Filename: string): TFPCSourceRule;
    function GetDefaultTargets(TargetOS, TargetCPU: string): string;
    procedure GetRulesForTargets(Targets: string;
                                 var RulesSortedForFilenameStart: TAVLTree);
    function GetScore(Filename: string;
                      RulesSortedForFilenameStart: TAVLTree): integer;
    property Score: integer read FScore write FScore; // used for Add
    property Targets: string read FTargets write SetTargets; // used for Add, e.g. win32,unix,bsd or * for all
    property ChangeStamp: integer read FChangeStamp;
    procedure IncreaseChangeStamp;
  end;

var
  DefaultFPCSourceRules: TFPCSourceRules;
  
const
  DefineTemplateFlagNames: array[TDefineTemplateFlag] of shortstring = (
      'AutoGenerated'
    );

type
  TFPCInfoType = (
    fpciCompilerDate,      // -iD        Return compiler date
    fpciShortVersion,      // -iV        Return short compiler version
    fpciFullVersion,       // -iW        Return full compiler version
    fpciCompilerOS,        // -iSO       Return compiler OS
    fpciCompilerProcessor, // -iSP       Return compiler host processor
    fpciTargetOS,          // -iTO       Return target OS
    fpciTargetProcessor    // -iTP       Return target processor
    );
  TFPCInfoTypes = set of TFPCInfoType;
  TFPCInfoStrings = array[TFPCInfoType] of string;
const
  fpciAll = [low(TFPCInfoType)..high(TFPCInfoType)];

type

  { TFPCConfigFileState
    Store if a config file exists and its modification date }

  TFPCConfigFileState = class
  public
    Filename: string;
    FileExists: boolean;
    FileDate: longint;
    constructor Create(const aFilename: string;
                       aFileExists: boolean; aFileDate: longint);
    function Equals(Other: TFPCConfigFileState; CheckDate: boolean): boolean; reintroduce;
    procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
    procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
  end;

  { TFPCConfigFileStateList
    list of TFPCConfigFileState }

  TFPCConfigFileStateList = class
  private
    fItems: TFPList;
    function GetItems(Index: integer): TFPCConfigFileState;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    procedure Assign(List: TFPCConfigFileStateList);
    function Equals(List: TFPCConfigFileStateList; CheckDates: boolean): boolean; reintroduce;
    function Add(aFilename: string; aFileExists: boolean;
                 aFileDate: longint): TFPCConfigFileState;
    function Count: integer;
    property Items[Index: integer]: TFPCConfigFileState read GetItems; default;
    procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
    procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
  end;

  TFPCTargetConfigCaches = class;

  { TFPCTargetConfigCache
    Storing all information (macros, search paths) of one compiler
    with one specific TargetOS and TargetCPU. }

  TFPCTargetConfigCache = class(TComponent)
  private
    FChangeStamp: integer;
  public
    // key
    TargetOS: string; // will be passed lowercase
    TargetCPU: string; // will be passed lowercase
    Compiler: string; // full file name
    CompilerOptions: string; // e.g. -V<version> -Xp<path>
    // values
    CompilerDate: longint;
    RealCompiler: string; // when Compiler is fpc, this is the real compiler (e.g. ppc386)
    RealCompilerDate: longint;
    RealTargetOS: string;
    RealTargetCPU: string;
    RealCompilerInPath: string; // the ppc<target> in PATH
    FullVersion: string; // Version.Release.Patch
    ConfigFiles: TFPCConfigFileStateList;
    UnitPaths: TStrings;
    Defines: TStringToStringTree; // macro to value
    Undefines: TStringToStringTree; // macro
    Units: TStringToStringTree; // unit name to file name
    ErrorMsg: string;
    ErrorTranslatedMsg: string;
    Caches: TFPCTargetConfigCaches;
    HasPPUs: boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Clear; // values, not keys
    function Equals(Item: TFPCTargetConfigCache;
                    CompareKey: boolean = true): boolean; reintroduce;
    procedure Assign(Source: TPersistent); override;
    procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
    procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
    procedure LoadFromFile(Filename: string);
    procedure SaveToFile(Filename: string);
    function NeedsUpdate: boolean;
    function GetFPCInfoCmdLineOptions(ExtraOptions: string): string;
    function Update(TestFilename: string; ExtraOptions: string = '';
                    const OnProgress: TDefinePoolProgress = nil): boolean;
    function FindRealCompilerInPath(aTargetCPU: string; ResolveLinks: boolean): string;
    function GetUnitPaths: string;
    function GetFPCVerNumbers(out FPCVersion, FPCRelease, FPCPatch: integer): boolean;
    function GetFPCVer: string; // e.g. 2.7.1
    function GetFPC_FULLVERSION: integer; // e.g. 20701
    function IndexOfUsedCfgFile: integer;
    procedure IncreaseChangeStamp;
    property ChangeStamp: integer read FChangeStamp;
  end;

  { TFPCTargetConfigCaches
    List of TFPCTargetConfigCache }

  TFPCTargetConfigCaches = class(TComponent)
  private
    FChangeStamp: integer;
    FExtraOptions: string;
    fItems: TAVLTree; // tree of TFPCTargetConfigCache
    FTestFilename: string;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Clear;
    function Equals(Caches: TFPCTargetConfigCaches): boolean; reintroduce;
    procedure Assign(Source: TPersistent); override;
    procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
    procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
    procedure LoadFromFile(Filename: string);
    procedure SaveToFile(Filename: string);
    procedure IncreaseChangeStamp;
    property ChangeStamp: integer read FChangeStamp;
    function Find(CompilerFilename, CompilerOptions, TargetOS, TargetCPU: string;
                  CreateIfNotExists: boolean): TFPCTargetConfigCache;
    procedure GetDefaultCompilerTarget(const CompilerFilename,CompilerOptions: string;
                  out TargetOS, TargetCPU: string);
    function GetListing: string;
    property TestFilename: string read FTestFilename write FTestFilename; // an empty file to test the compiler, will be auto created
    property ExtraOptions: string read FExtraOptions write FExtraOptions; // additional compiler options not used as key, e.g. -Fr<language file>
  end;

  TFPCSourceCaches = class;

  { TFPCSourceCache
    All source files of one FPC source directory }

  TFPCSourceCache = class(TComponent)
  private
    FChangeStamp: integer;
  public
    Directory: string;
    Valid: boolean;
    Files: TStringList;
    Caches: TFPCSourceCaches;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Clear;
    procedure Assign(Source: TPersistent); override;
    function Equals(Cache: TFPCSourceCache): boolean; reintroduce;
    procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
    procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
    procedure LoadFromFile(Filename: string);
    procedure SaveToFile(Filename: string);
    procedure Update(const OnProgress: TDefinePoolProgress = nil);
    procedure Update(var NewFiles: TStringList); // NewFiles is used for Files! do not free NewFiles
    procedure IncreaseChangeStamp;
    property ChangeStamp: integer read FChangeStamp;
  end;

  { TFPCSourceCaches }

  TFPCSourceCaches = class(TComponent)
  private
    FChangeStamp: integer;
    fItems: TAVLTree; // tree of TFPCSourceCacheItem
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Clear;
    procedure Assign(Source: TPersistent); override;
    function Equals(Caches: TFPCSourceCaches): boolean; reintroduce;
    procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
    procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
    procedure LoadFromFile(Filename: string);
    procedure SaveToFile(Filename: string);
    procedure IncreaseChangeStamp;
    property ChangeStamp: integer read FChangeStamp;
    function Find(Directory: string;
                  CreateIfNotExists: boolean): TFPCSourceCache;
  end;

  TFPCDefinesCache = class;

  TFPCUnitToSrcCacheFlag = (
    fuscfSrcRulesNeedUpdate,
    fuscfUnitTreeNeedsUpdate
    );
  TFPCUnitToSrcCacheFlags = set of TFPCUnitToSrcCacheFlag;

  { TFPCUnitSetCache
    Unit name to FPC source file.
    Specific to one compiler, compileroptions, targetos, targetcpu and FPC source directory. }

  TFPCUnitSetCache = class(TComponent)
  private
    FCaches: TFPCDefinesCache;
    FChangeStamp: integer;
    FCompilerFilename: string;
    FCompilerOptions: string;
    FFPCSourceDirectory: string;
    FTargetCPU: string;
    FTargetOS: string;
    FConfigCache: TFPCTargetConfigCache;
    fSourceCache: TFPCSourceCache;
    fSourceRules: TFPCSourceRules;
    fRulesStampOfConfig: integer; // fSourceCache.ChangeStamp while creation of fFPCSourceRules
    fUnitToSourceTree: TStringToStringTree; // unit name to file name (maybe relative)
    fUnitStampOfFPC: integer;   // FConfigCache.ChangeStamp at creation of fUnitToSourceTree
    fUnitStampOfFiles: integer; // fSourceCache.ChangeStamp at creation of fUnitToSourceTree
    fUnitStampOfRules: integer; // fSourceRules.ChangeStamp at creation of fUnitToSourceTree
    fSrcDuplicates: TStringToStringTree; // unit to list of files (semicolon separated)
    fFlags: TFPCUnitToSrcCacheFlags;
    procedure SetCompilerFilename(const AValue: string);
    procedure SetCompilerOptions(const AValue: string);
    procedure SetFPCSourceDirectory(const AValue: string);
    procedure SetTargetCPU(const AValue: string);
    procedure SetTargetOS(const AValue: string);
    procedure ClearConfigCache;
    procedure ClearSourceCache;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure Clear;
    procedure Init;
    property Caches: TFPCDefinesCache read FCaches;
    property CompilerFilename: string read FCompilerFilename write SetCompilerFilename;
    property CompilerOptions: string read FCompilerOptions write SetCompilerOptions;
    property TargetOS: string read FTargetOS write SetTargetOS; // case insensitive, will be passed lowercase
    property TargetCPU: string read FTargetCPU write SetTargetCPU; // case insensitive, will be passed lowercase
    property FPCSourceDirectory: string read FFPCSourceDirectory write SetFPCSourceDirectory;
    function GetConfigCache(AutoUpdate: boolean): TFPCTargetConfigCache;
    function GetSourceCache(AutoUpdate: boolean): TFPCSourceCache;
    function GetSourceRules(AutoUpdate: boolean): TFPCSourceRules;
    function GetUnitToSourceTree(AutoUpdate: boolean): TStringToStringTree; // unit name to file name (maybe relative)
    function GetSourceDuplicates(AutoUpdate: boolean): TStringToStringTree; // unit to semicolon separated list of files
    function GetUnitSrcFile(const AnUnitName: string;
                            SrcSearchRequiresPPU: boolean = true;
                            SkipPPUCheckIfTargetIsSourceOnly: boolean = true): string;
    function GetCompiledUnitFile(const AUnitName: string): string;
    property ChangeStamp: integer read FChangeStamp;
    class function GetInvalidChangeStamp: integer;
    procedure IncreaseChangeStamp;
    function GetUnitSetID: string;
    function GetFirstFPCCfg: string;
  end;

  { TFPCDefinesCache }

  TFPCDefinesCache = class(TComponent)
  private
    FConfigCaches: TFPCTargetConfigCaches;
    FConfigCachesSaveStamp: integer;
    FSourceCaches: TFPCSourceCaches;
    FSourceCachesSaveStamp: integer;
    fUnitToSrcCaches: TFPList; // list of TFPCUnitSetCache
    function GetExtraOptions: string;
    function GetTestFilename: string;
    procedure SetConfigCaches(const AValue: TFPCTargetConfigCaches);
    procedure SetExtraOptions(AValue: string);
    procedure SetSourceCaches(const AValue: TFPCSourceCaches);
    procedure ClearUnitToSrcCaches;
    procedure SetTestFilename(AValue: string);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Clear;
    procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
    procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
    procedure LoadFromFile(Filename: string);
    procedure SaveToFile(Filename: string);
    function NeedsSave: boolean;
    property SourceCaches: TFPCSourceCaches read FSourceCaches write SetSourceCaches;
    property ConfigCaches: TFPCTargetConfigCaches read FConfigCaches write SetConfigCaches;
    property TestFilename: string read GetTestFilename write SetTestFilename; // an empty file to test the compiler, will be auto created
    property ExtraOptions: string read GetExtraOptions write SetExtraOptions; // additional compiler options not used as key, e.g. -Fr<language file>
    function GetFPCVersion(const CompilerFilename, TargetOS, TargetCPU: string;
                           UseCompiledVersionAsDefault: boolean): string;
    function FindUnitSet(const CompilerFilename, TargetOS, TargetCPU,
                         Options, FPCSrcDir: string;
                         CreateIfNotExists: boolean): TFPCUnitSetCache;
    function FindUnitSetWithID(const UnitSetID: string; out Changed: boolean;
                               CreateIfNotExists: boolean): TFPCUnitSetCache;
    function GetUnitSetID(CompilerFilename, TargetOS, TargetCPU, Options,
                          FPCSrcDir: string; ChangeStamp: integer): string;
    procedure ParseUnitSetID(const ID: string; out CompilerFilename,
                             TargetOS, TargetCPU, Options, FPCSrcDir: string;
                             out ChangeStamp: integer);
  end;

function DefineActionNameToAction(const s: string): TDefineAction;
function DefineTemplateFlagsToString(Flags: TDefineTemplateFlags): string;
function GetDefaultSrcOSForTargetOS(const TargetOS: string): string;
function GetDefaultSrcOS2ForTargetOS(const TargetOS: string): string;
function GetDefaultSrcCPUForTargetCPU(const TargetCPU: string): string;
procedure SplitLazarusCPUOSWidgetCombo(const Combination: string;
  out CPU, OS, WidgetSet: string);
function GetCompiledFPCVersion: integer;
function GetCompiledTargetOS: string;
function GetCompiledTargetCPU: string;
function GetDefaultCompilerFilename(const TargetCPU: string = ''; Cross: boolean = false): string;
procedure GetTargetProcessors(const TargetCPU: string; aList: TStrings);
function GetFPCTargetOS(TargetOS: string): string;
function GetFPCTargetCPU(TargetCPU: string): string;
function IsFPCExecutable(AFilename: string; out ErrorMsg: string): boolean; // not thread-safe

// functions to quickly setup some defines
function CreateDefinesInDirectories(const SourcePaths, FlagName: string
                                    ): TDefineTemplate;

function GatherFiles(Directory, ExcludeDirMask, IncludeFileMask: string;
         MaxLevel: integer; const OnProgress: TDefinePoolProgress): TStringList; // thread safe
function GatherFilesInFPCSources(Directory: string;
                            const OnProgress: TDefinePoolProgress): TStringList; // thread safe
function MakeRelativeFileList(Files: TStrings; out BaseDir: string): TStringList;
function Compress1FileList(Files: TStrings): TStringList; // thread-safe
function Decompress1FileList(Files: TStrings): TStringList; // thread-safe
function RunTool(const Filename: string; Params: TStrings;
                 WorkingDirectory: string = ''; Quiet: boolean = false): TStringList; // thread-safe
function RunTool(const Filename, Params: string;
                 WorkingDirectory: string = ''; Quiet: boolean = false): TStringList; // thread-safe

type
  // fpc parameter effecting search for compiler
  TFPCFrontEndParam = (
    fpcpT, // -T<targetos>
    fpcpP, // -P<targetprocessor>
    fpcpV, // -V<postfix>
    fpcpXp // -Xp<directory>
    );
  TFPCFrontEndParams = set of TFPCFrontEndParam;
const
  AllFPCFrontEndParams = [low(TFPCFrontEndParam)..high(TFPCFrontEndParam)];

function ParseFPCInfo(FPCInfo: string; InfoTypes: TFPCInfoTypes;
                      out Infos: TFPCInfoStrings): boolean;
function RunFPCInfo(const CompilerFilename: string;
                   InfoTypes: TFPCInfoTypes; const Options: string =''): string;
function ExtractFPCFrontEndParameters(const CmdLineParams: string;
  const Kinds: TFPCFrontEndParams = AllFPCFrontEndParams): string;
function FPCVersionToNumber(const FPCVersionString: string): integer;
function SplitFPCVersion(const FPCVersionString: string;
                        out FPCVersion, FPCRelease, FPCPatch: integer): boolean;
function ParseFPCVerbose(List: TStrings; // fpc -va output
                         const WorkDir: string;
                         out ConfigFiles: TStrings; // prefix '-' for file not found, '+' for found and read
                         out RealCompilerFilename: string; // what compiler is used by fpc
                         out UnitPaths: TStrings; // unit search paths
                         out Defines, Undefines: TStringToStringTree): boolean;
function RunFPCVerbose(const CompilerFilename, TestFilename: string;
                       out ConfigFiles: TStrings;
                       out RealCompilerFilename: string;
                       out UnitPaths: TStrings;
                       out Defines, Undefines: TStringToStringTree;
                       const Options: string = ''): boolean;
function GatherUnitsInSearchPaths(SearchPaths: TStrings;
                    const OnProgress: TDefinePoolProgress;
                    CheckFPMkInst: boolean = false): TStringToStringTree; // unit names to full file name
function GatherUnitSourcesInDirectory(Directory: string;
                    MaxLevel: integer = 1): TStringToStringTree; // unit names to full file name
procedure AdjustFPCSrcRulesForPPUPaths(Units: TStringToStringTree;
                                       Rules: TFPCSourceRules);
function GatherUnitsInFPCSources(Files: TStringList;
                   TargetOS: string = ''; TargetCPU: string = '';
                   Duplicates: TStringToStringTree = nil; // unit to semicolon separated list of files
                   Rules: TFPCSourceRules = nil;
                   const DebugUnitName: string = ''): TStringToStringTree;
function CreateFPCTemplate(Config: TFPCTargetConfigCache;
                           Owner: TObject): TDefineTemplate; overload;
function CreateFPCTemplate(Config: TFPCUnitSetCache;
                           Owner: TObject): TDefineTemplate; overload;
function CreateFPCSourceTemplate(Config: TFPCUnitSetCache;
                                 Owner: TObject): TDefineTemplate; overload;
function CreateFPCSourceTemplate(FPCSrcDir: string;
                                 Owner: TObject): TDefineTemplate; overload;
procedure CheckPPUSources(PPUFiles,  // unitname to filename
                          UnitToSource, // unitname to file name
                          UnitToDuplicates: TStringToStringTree; // unitname to semicolon separated list of files
                          var Duplicates, Missing: TStringToStringTree);
procedure LoadFPCCacheFromFile(Filename: string;
            var Configs: TFPCTargetConfigCaches; var Sources: TFPCSourceCaches);
procedure SaveFPCCacheToFile(Filename: string;
                    Configs: TFPCTargetConfigCaches; Sources: TFPCSourceCaches);

procedure ReadMakefileFPC(const Filename: string; List: TStrings);
procedure ParseMakefileFPC(const Filename, SrcOS: string;
                           out Dirs, SubDirs: string);

function CompareFPCSourceRulesViaFilename(Rule1, Rule2: Pointer): integer;
function CompareFPCTargetConfigCacheItems(CacheItem1, CacheItem2: Pointer): integer;
function CompareFPCSourceCacheItems(CacheItem1, CacheItem2: Pointer): integer;
function CompareDirectoryWithFPCSourceCacheItem(AString, CacheItem: Pointer): integer;


implementation


type
  TUnitNameLink = class
  public
    Unit_Name: string;
    Filename: string;
    ConflictFilename: string;
    MacroCount: integer;
    UsedMacroCount: integer;
    Score: integer;
  end;

function CompareUnitNameLinks(Link1, Link2: Pointer): integer;
var
  UnitLink1: TUnitNameLink absolute Link1;
  UnitLink2: TUnitNameLink absolute Link2;
begin
  Result:=CompareNames(UnitLink1.Unit_Name,UnitLink2.Unit_Name);
end;

function CompareUnitNameWithUnitNameLink(Name, Link: Pointer): integer;
var
  UnitLink: TUnitNameLink absolute Link;
begin
  Result:=CompareNames(AnsiString(Name),UnitLink.Unit_Name);
end;

// some useful functions

function GatherFiles(Directory, ExcludeDirMask, IncludeFileMask: string;
  MaxLevel: integer; const OnProgress: TDefinePoolProgress): TStringList;
{  ExcludeDirMask: check FilenameIsMatching vs the short file name of a directory
   IncludeFileMask: check FilenameIsMatching vs the short file name of a file
}
var
  Files: TAVLTree; // tree of ansistring
  FileCount: integer;
  Abort: boolean;

  procedure Add(Filename: string);
  var
    s: String;
  begin
    if Filename='' then exit;
    // increase refcount
    s:=Filename;
    // add
    Files.Add(PChar(s));
    // keep refcount
    Pointer(s):=nil;
  end;

  procedure Search(CurDir: string; Level: integer);
  var
    FileInfo: TSearchRec;
    ShortFilename: String;
    Filename: String;
  begin
    if Level>MaxLevel then exit;
    //DebugLn(['Search CurDir=',CurDir]);
    if FindFirstUTF8(Directory+CurDir+FileMask,faAnyFile,FileInfo)=0 then begin
      repeat
        inc(FileCount);
        if (FileCount mod 100=0) and Assigned(OnProgress) then begin
          OnProgress(nil,0,-1,'Scanned files: '+IntToStr(FileCount),Abort);
          if Abort then break;
        end;
        ShortFilename:=FileInfo.Name;
        if (ShortFilename='') or (ShortFilename='.') or (ShortFilename='..') then
          continue;
        //debugln(['Search ShortFilename=',ShortFilename,' IsDir=',(FileInfo.Attr and faDirectory)>0]);
        Filename:=CurDir+ShortFilename;
        if (FileInfo.Attr and faDirectory)>0 then begin
          // directory
          if (ExcludeDirMask='')
          or (not FilenameIsMatching(ExcludeDirMask,ShortFilename,true))
          then begin
            Search(Filename+PathDelim,Level+1);
            if Abort then break;
          end else begin
            //DebugLn(['Search DIR MISMATCH ',Filename]);
          end;
        end else begin
          // file
          if (IncludeFileMask='')
          or FilenameIsMatching(IncludeFileMask,ShortFilename,true) then begin
            //DebugLn(['Search ADD ',Filename]);
            Add(Filename);
          end else begin
            //DebugLn(['Search MISMATCH ',Filename]);
          end;
        end;
      until FindNextUTF8(FileInfo)<>0;
    end;
    FindCloseUTF8(FileInfo);
  end;

var
  Node: TAVLTreeNode;
  s: String;
  NodeMgr: TAVLTreeNodeMemManager;
begin
  Result:=nil;
  Files:=TAVLTree.Create(@CompareAnsiStringFilenames);
  NodeMgr:=TAVLTreeNodeMemManager.Create;
  Files.SetNodeManager(NodeMgr);
  Abort:=false;
  try
    FileCount:=0;
    Directory:=TrimAndExpandDirectory(Directory);
    if Directory='' then exit;
    Search('',0);
  finally
    if not Abort then
      Result:=TStringList.Create;
    Node:=Files.FindLowest;
    while Node<>nil do begin
      Pointer(s):=Node.Data;
      if Result<>nil then Result.Add(s);
      s:='';
      Node:=Files.FindSuccessor(Node);
    end;
    FreeAndNil(Files);
    FreeAndNil(NodeMgr);
  end;
end;

function GatherFilesInFPCSources(Directory: string;
  const OnProgress: TDefinePoolProgress): TStringList;
begin
  Result:=GatherFiles(Directory,'{.*,CVS}',
                      '{*.pas,*.pp,*.p,*.inc,Makefile.fpc}',8,OnProgress);
end;

function MakeRelativeFileList(Files: TStrings; out BaseDir: string
  ): TStringList;
var
  BaseDirLen: Integer;
  i: Integer;
  Filename: string;
begin
  BaseDir:='';
  Result:=TStringList.Create;
  if (Files=nil) or (Files.Count=0) then exit;
  Result.Assign(Files);
  // delete empty lines
  for i:=Result.Count-1 downto 0 do
    if Result[i]='' then Result.Delete(i);
  if Result.Count=0 then exit;
  // find shortest common BaseDir
  BaseDir:=ChompPathDelim(ExtractFilepath(Result[0]));
  BaseDirLen:=length(BaseDir);
  for i:=1 to Result.Count-1 do begin
    Filename:=Result[i];
    while (BaseDirLen>0) do begin
      if (BaseDirLen<=length(Filename))
      and ((BaseDirLen=length(Filename)) or (Filename[BaseDirLen+1]=PathDelim))
      and (CompareFilenames(BaseDir,copy(Filename,1,BaseDirLen))=0) then
        break;
      BaseDir:=ChompPathDelim(ExtractFilePath(copy(BaseDir,1,BaseDirLen-1)));
      BaseDirLen:=length(BaseDir);
      if (BaseDir='') or (BaseDir[length(BaseDir)]=PathDelim) then break;
    end;
  end;
  // create relative paths
  if (BaseDir<>'') then
    for i:=0 to Result.Count-1 do begin
      Filename:=Result[i];
      Filename:=copy(Filename,BaseDirLen+1,length(Filename));
      if (Filename<>'') and (Filename[1]=PathDelim) then
        System.Delete(Filename,1,1);
      Result[i]:=Filename;
    end;
end;

function Compress1FileList(Files: TStrings): TStringList;
var
  i: Integer;
  Filename: string;
  LastFilename: String;
  p: Integer;
begin
  Result:=TStringList.Create;
  LastFilename:='';
  for i:=0 to Files.Count-1 do begin
    Filename:=TrimFilename(Files[i]);
    p:=1;
    while (p<=length(Filename)) and (p<=length(LastFilename))
    and (Filename[p]=LastFilename[p]) do
      inc(p);
    Result.Add(IntToStr(p-1)+':'+copy(Filename,p,length(Filename)));
    LastFilename:=Filename;
  end;
end;

function Decompress1FileList(Files: TStrings): TStringList;
var
  LastFilename: String;
  i: Integer;
  Filename: string;
  p: Integer;
  Same: Integer;
begin
  Result:=TStringList.Create;
  LastFilename:='';
  try
    for i:=0 to Files.Count-1 do begin
      Filename:=Files[i];
      p:=1;
      Same:=0;
      while (p<=length(Filename)) and (Filename[p] in ['0'..'9']) do begin
        Same:=Same*10+ord(Filename[p])-ord('0');
        inc(p);
      end;
      inc(p);
      Filename:=copy(LastFilename,1,Same)+copy(Filename,p,length(Filename));
      Result.Add(Filename);
      LastFilename:=Filename;
    end;
  except
  end;
end;

function RunTool(const Filename: string; Params: TStrings;
  WorkingDirectory: string; Quiet: boolean): TStringList;
var
  buf: string;
  TheProcess: TProcessUTF8;
  OutputLine: String;
  OutLen: Integer;
  LineStart, i: Integer;
begin
  Result:=nil;
  if not FileIsExecutable(Filename) then
    exit(nil);
  if (WorkingDirectory<>'') and not DirPathExists(WorkingDirectory) then
    exit(nil);
  Result:=TStringList.Create;
  try
    buf:='';
    if (MainThreadID=GetCurrentThreadId) and not Quiet then begin
      DbgOut(['Hint: (lazarus) [RunTool] ',Filename]);
      for i:=0 to Params.Count-1 do
        dbgout(' "',Params[i],'"');
      Debugln;
    end;
    TheProcess := TProcessUTF8.Create(nil);
    try
      TheProcess.Executable := Filename;
      TheProcess.Parameters:=Params;
      TheProcess.Options:= [poUsePipes, poStdErrToOutPut];
      TheProcess.ShowWindow := swoHide;
      TheProcess.CurrentDirectory:=WorkingDirectory;
      TheProcess.Execute;
      OutputLine:='';
      SetLength(buf,4096);
      repeat
        if (TheProcess.Output<>nil) then begin
          OutLen:=TheProcess.Output.Read(Buf[1],length(Buf));
        end else
          OutLen:=0;
        //debugln(['RunTool OutLen=',OutLen,' Buf="',copy(Buf,1,OutLen),'"']);
        LineStart:=1;
        i:=1;
        while i<=OutLen do begin
          if Buf[i] in [#10,#13] then begin
            OutputLine:=OutputLine+copy(Buf,LineStart,i-LineStart);
            Result.Add(OutputLine);
            OutputLine:='';
            if (i<OutLen) and (Buf[i+1] in [#10,#13]) and (Buf[i]<>Buf[i+1])
            then
              inc(i);
            LineStart:=i+1;
          end;
          inc(i);
        end;
        OutputLine:=OutputLine+copy(Buf,LineStart,OutLen-LineStart+1);
      until OutLen=0;
      //debugln(['RunTool Last=',OutputLine]);
      if OutputLine<>'' then
        Result.Add(OutputLine);
      TheProcess.WaitOnExit;
    finally
      TheProcess.Free;
    end;
  except
    FreeAndNil(Result);
  end;
end;

function RunTool(const Filename, Params: string; WorkingDirectory: string;
  Quiet: boolean): TStringList;
var
  ParamList: TStringList;
begin
  ParamList:=TStringList.Create;
  try
    SplitCmdLineParams(Params,ParamList);
    Result:=RunTool(Filename,ParamList,WorkingDirectory,Quiet);
  finally
    ParamList.Free;
  end;
end;

function ParseFPCInfo(FPCInfo: string; InfoTypes: TFPCInfoTypes;
  out Infos: TFPCInfoStrings): boolean;
var
  i: TFPCInfoType;
  p: PChar;
  StartPos: PChar;
begin
  Result:=false;
  if FPCInfo='' then exit(InfoTypes=[]);
  if copy(FPCInfo,1,6)='Error:' then exit(false);

  p:=PChar(FPCInfo);
  for i:=low(TFPCInfoType) to high(TFPCInfoType) do begin
    if not (i in InfoTypes) then continue;
    StartPos:=p;
    while not (p^ in [' ',#0]) do inc(p);
    if (p=StartPos) then exit(false);
    Infos[i]:=copy(FPCInfo,StartPos-PChar(FPCInfo)+1,p-StartPos);
    // skip space
    if p^<>#0 then
      inc(p);
  end;
  Result:=true;
end;

function RunFPCInfo(const CompilerFilename: string;
  InfoTypes: TFPCInfoTypes; const Options: string): string;
var
  Params: String;
  List: TStringList;
begin
  Result:='';
  Params:='';
  if fpciCompilerDate in InfoTypes then Params:=Params+'D';
  if fpciShortVersion in InfoTypes then Params:=Params+'V';
  if fpciFullVersion in InfoTypes then Params:=Params+'W';
  if fpciCompilerOS in InfoTypes then Params:=Params+'SO';
  if fpciCompilerProcessor in InfoTypes then Params:=Params+'SP';
  if fpciTargetOS in InfoTypes then Params:=Params+'TO';
  if fpciTargetProcessor in InfoTypes then Params:=Params+'TP';
  if Params='' then exit;
  Params:='-i'+Params;
  if Options<>'' then
    Params:=Params+' '+Options;
  List:=nil;
  try
    List:=RunTool(CompilerFilename,Params);
    if (List=nil) or (List.Count<1) then exit;
    Result:=List[0];
    if copy(Result,1,6)='Error:' then Result:='';
  finally
    List.free;
  end;
end;

function ExtractFPCFrontEndParameters(const CmdLineParams: string;
  const Kinds: TFPCFrontEndParams): string;
// extract the parameters for the FPC frontend tool fpc.exe
// The result is normalized:
//   - only the last value
//   - order is: -T -P -V -Xp

  procedure Add(const Name, Value: string);
  begin
    if Value='' then exit;
    if Result<>'' then Result+=' ';
    Result+='-'+Name+StrToCmdLineParam(Value);
  end;

var
  Position: Integer;
  Param, ParamT, ParamP, ParamV, ParamXp: String;
  StartPos: integer;
  p: PChar;
begin
  Result:='';
  ParamT:='';
  ParamP:='';
  ParamV:='';
  ParamXp:='';
  Position:=1;
  while ReadNextFPCParameter(CmdLineParams,Position,StartPos) do begin
    Param:=ExtractFPCParameter(CmdLineParams,StartPos);
    if Param='' then continue;
    p:=PChar(Param);
    if p^<>'-' then continue;
    case p[1] of
    'T': if fpcpT in Kinds then ParamT:=copy(Param,3,255);
    'P': if fpcpP in Kinds then ParamP:=copy(Param,3,255);
    'V': if fpcpV in Kinds then ParamV:=copy(Param,3,length(Param));
    'X':
      case p[2] of
      'p': if fpcpXp in Kinds then ParamXp:=copy(Param,4,length(Param));
      end;
    end;
  end;
  // add parameters
  Add('Xp',ParamXp);
  Add('T',ParamT);
  Add('P',ParamP);
  Add('V',ParamV);
end;

function FPCVersionToNumber(const FPCVersionString: string): integer;
var
  FPCVersion, FPCRelease, FPCPatch: integer;
begin
  if SplitFPCVersion(FPCVersionString,FPCVersion,FPCRelease,FPCPatch) then
    Result:=FPCVersion*10000+FPCRelease*100+FPCPatch
  else
    Result:=0;
end;

function SplitFPCVersion(const FPCVersionString: string; out FPCVersion,
  FPCRelease, FPCPatch: integer): boolean;
// for example 2.5.1
var
  p: PChar;

  function ReadWord(out v: integer): boolean;
  var
    Empty: Boolean;
  begin
    v:=0;
    Empty:=true;
    while (p^ in ['0'..'9']) do begin
      if v>10000 then exit(false);
      v:=v*10+ord(p^)-ord('0');
      inc(p);
      Empty:=false;
    end;
    Result:=not Empty;
  end;

begin
  Result:=false;
  FPCVersion:=0;
  FPCRelease:=0;
  FPCPatch:=0;
  if FPCVersionString='' then exit;
  p:=PChar(FPCVersionString);
  if not ReadWord(FPCVersion) then exit;
  if (p^<>'.') then exit;
  inc(p);
  if not ReadWord(FPCRelease) then exit;
  if (p^<>'.') then exit;
  inc(p);
  if not ReadWord(FPCPatch) then exit;
  Result:=true;
end;

function ParseFPCVerbose(List: TStrings; const WorkDir: string; out
  ConfigFiles: TStrings; out RealCompilerFilename: string; out
  UnitPaths: TStrings; out Defines, Undefines: TStringToStringTree): boolean;

  procedure UndefineSymbol(const MacroName: string);
  begin
    //DebugLn(['UndefineSymbol ',MacroName]);
    Defines.Remove(MacroName);
    Undefines[MacroName]:='';
  end;

  procedure DefineSymbol(const MacroName, Value: string);
  begin
    //DebugLn(['DefineSymbol ',MacroName]);
    Undefines.Remove(MacroName);
    Defines[MacroName]:=Value;
  end;

  function ExpFile(const aFilename: string): string;
  begin
    Result:=aFilename;
    if FilenameIsAbsolute(Result) then exit;
    Result:=AppendPathDelim(WorkDir)+Result;
  end;

  procedure ProcessOutputLine(Line: string);
  var
    SymbolName, SymbolValue, UpLine, NewPath: string;
    i, len, CurPos: integer;
    Filename: String;
    p: SizeInt;
  begin
    //DebugLn(['ProcessOutputLine ',Line]);
    Line:=SysToUtf8(Line);
    len := length(Line);
    if len <= 6 then Exit; // shortest match

    CurPos := 1;
    // skip timestamp e.g. [0.306]
    if Line[CurPos] = '[' then begin
      repeat
        inc(CurPos);
        if CurPos > len then Exit;
      until line[CurPos] = ']';
      Inc(CurPos, 2); // skip space too
      if len - CurPos < 6 then Exit; // shortest match
    end;

    UpLine:=UpperCaseStr(Line);

    case UpLine[CurPos] of
    'C':
      if StrLComp(@UpLine[CurPos], 'CONFIGFILE SEARCH: ', 19) = 0 then
      begin
        // skip keywords
        Inc(CurPos, 19);
        Filename:=ExpFile(SetDirSeparators(copy(Line,CurPos,length(Line))));
        ConfigFiles.Add('-'+Filename);
      end else if StrLComp(@UpLine[CurPos], 'COMPILER: ', 10) = 0 then begin
        // skip keywords
        Inc(CurPos, 10);
        RealCompilerFilename:=ExpFile(copy(Line,CurPos,length(Line)));
      end;
    'E':
      if StrLComp(@UpLine[CurPos], 'ERROR: ', 7) = 0 then begin
        inc(CurPos,7);
        if RealCompilerFilename='' then begin
          p:=Pos(' returned an error exitcode',Line);
          if p>0 then
            RealCompilerFilename:=copy(Line,CurPos,p-CurPos);
        end;
      end;
    'M':
      if StrLComp(@UpLine[CurPos], 'MACRO ', 6) = 0 then begin
        // skip keyword macro
        Inc(CurPos, 6);

        if (StrLComp(@UpLine[CurPos], 'DEFINED: ', 9) = 0) then begin
          Inc(CurPos, 9);
          SymbolName:=copy(UpLine, CurPos, len);
          DefineSymbol(SymbolName,'');
          Exit;
        end;

        if (StrLComp(@UpLine[CurPos], 'UNDEFINED: ', 11) = 0) then begin
          Inc(CurPos, 11);
          SymbolName:=copy(UpLine,CurPos,len);
          UndefineSymbol(SymbolName);
          Exit;
        end;

        // MACRO something...
        i := CurPos;
        while (i <= len) and (Line[i]<>' ') do inc(i);
        SymbolName:=copy(UpLine,CurPos,i-CurPos);
        CurPos := i + 1; // skip space

        if StrLComp(@UpLine[CurPos], 'SET TO ', 7) = 0 then begin
          Inc(CurPos, 7);
          SymbolValue:=copy(Line, CurPos, len);
          DefineSymbol(SymbolName, SymbolValue);
        end;
      end;
    'R':
      if StrLComp(@UpLine[CurPos], 'READING OPTIONS FROM FILE ', 26) = 0 then
      begin
        // skip keywords
        Inc(CurPos, 26);
        Filename:=ExpFile(SetDirSeparators(copy(Line,CurPos,length(Line))));
        if (ConfigFiles.Count>0)
        and (ConfigFiles[ConfigFiles.Count-1]='-'+Filename) then
          ConfigFiles.Delete(ConfigFiles.Count-1);
        ConfigFiles.Add('+'+Filename);
      end;
    'U':
      if (StrLComp(@UpLine[CurPos], 'USING UNIT PATH: ', 17) = 0) then begin
        Inc(CurPos, 17);
        NewPath:=SetDirSeparators(copy(Line,CurPos,len));
        if not FilenameIsAbsolute(NewPath) then
          NewPath:=ExpFile(NewPath);
        NewPath:=ChompPathDelim(TrimFilename(NewPath));
        {$IFDEF VerboseFPCSrcScan}
        DebugLn('Using unit path: "',NewPath,'"');
        {$ENDIF}
        UnitPaths.Add(NewPath);
      end;
    end;
  end;

var
  i: Integer;
begin
  Result:=false;
  ConfigFiles:=TStringList.Create;
  RealCompilerFilename:='';
  UnitPaths:=TStringList.Create;
  Defines:=TStringToStringTree.Create(false);
  Undefines:=TStringToStringTree.Create(false);
  try
    for i:=0 to List.Count-1 do
      ProcessOutputLine(List[i]);
    Result:=true;
  finally
    if not Result then begin
      FreeAndNil(ConfigFiles);
      FreeAndNil(UnitPaths);
      FreeAndNil(Undefines);
      FreeAndNil(Defines);
    end;
  end;
end;

function RunFPCVerbose(const CompilerFilename, TestFilename: string;
  out ConfigFiles: TStrings; out RealCompilerFilename: string;
  out UnitPaths: TStrings; out Defines, Undefines: TStringToStringTree;
  const Options: string): boolean;
var
  Params: String;
  Filename: String;
  WorkDir: String;
  List: TStringList;
  fs: TFileStreamUTF8;
begin
  Result:=false;
  ConfigFiles:=nil;
  RealCompilerFilename:='';
  UnitPaths:=nil;
  Defines:=nil;
  Undefines:=nil;

  // create empty file
  try
    fs:=TFileStreamUTF8.Create(TestFilename,fmCreate);
    fs.Free;
  except
    debugln(['Warning: [RunFPCVerbose] unable to create test file "'+TestFilename+'"']);
    exit;
  end;

  Params:='-va';
  if Options<>'' then
    Params:=Params+' '+Options;
  Filename:=ExtractFileName(TestFilename);
  WorkDir:=ExtractFilePath(TestFilename);
  Params:=Params+' '+Filename;
  List:=nil;
  try
    //DebugLn(['RunFPCVerbose ',CompilerFilename,' ',Params,' ',WorkDir]);
    List:=RunTool(CompilerFilename,Params,WorkDir);
    if (List=nil) or (List.Count=0) then begin
      debugln(['Warning: RunFPCVerbose failed: ',CompilerFilename,' ',Params]);
      exit;
    end;
    Result:=ParseFPCVerbose(List,WorkDir,ConfigFiles,RealCompilerFilename,
                            UnitPaths,Defines,Undefines);
  finally
    List.Free;
    DeleteFileUTF8(TestFilename);
  end;
end;

function GatherUnitsInSearchPaths(SearchPaths: TStrings;
  const OnProgress: TDefinePoolProgress; CheckFPMkInst: boolean
  ): TStringToStringTree;
{ returns a stringtree,
  where name is unitname and value is the full file name

  SearchPaths are searched from last to start
  first found wins
  pas, pp, p replaces ppu

  check for each UnitPath of the form
    lib/fpc/<FPCVer>/units/<FPCTarget>/<name>/
  if there is lib/fpc/<FPCVer>/fpmkinst/><FPCTarget>/<name>.fpm
  and search line SourcePath=<directory>
  and search source files in this directory including subdirectories
}

  function SearchPriorPathDelim(var p: integer; const Filename: string): boolean; inline;
  begin
    repeat
      dec(p);
      if p<1 then exit(false)
    until Filename[p]=PathDelim;
    Result:=true;
  end;

var
  i: Integer;
  Directory: String;
  FileCount, p, EndPos, FPCTargetEndPos: Integer;
  Abort: boolean;
  FileInfo: TSearchRec;
  ShortFilename: String;
  Filename: String;
  Ext: String;
  Unit_Name, PkgName, FPMFilename, FPMSourcePath, Line, SrcFilename: String;
  AVLNode: TAVLTreeNode;
  S2SItem: PStringToStringTreeItem;
  FPMToUnitTree: TStringToPointerTree;// pkgname to TStringToStringTree (unitname to source filename)
  sl: TStringListUTF8;
  PkgUnitToFilename: TStringToStringTree;
begin
  Result:=TStringToStringTree.Create(false);
  FileCount:=0;
  Abort:=false;
  for i:=SearchPaths.Count-1 downto 0 do begin
    Directory:=TrimAndExpandDirectory(SearchPaths[i]);
    if (Directory='') then continue;
    if FindFirstUTF8(Directory+FileMask,faAnyFile,FileInfo)=0 then begin
      repeat
        inc(FileCount);
        if (FileCount mod 100=0) and Assigned(OnProgress) then begin
          OnProgress(nil, 0, -1, Format(ctsScannedFiles, [IntToStr(FileCount)]
            ), Abort);
          if Abort then break;
        end;
        ShortFilename:=FileInfo.Name;
        if (ShortFilename='') or (ShortFilename='.') or (ShortFilename='..') then
          continue;
        //debugln(['GatherUnitsInSearchPaths ShortFilename=',ShortFilename,' IsDir=',(FileInfo.Attr and faDirectory)>0]);
        Filename:=Directory+ShortFilename;
        Ext:=LowerCase(ExtractFileExt(ShortFilename));
        if (Ext='.pas') or (Ext='.pp') or (Ext='.p') or (Ext='.ppu') then begin
          Unit_Name:=ExtractFileNameOnly(Filename);
          if (not Result.Contains(Unit_Name))
          or ((Ext<>'.ppu') and (CompareFileExt(Result[Unit_Name],'ppu',false)=0))
          then
            Result[Unit_Name]:=Filename;
        end;
      until FindNextUTF8(FileInfo)<>0;
    end;
    FindCloseUTF8(FileInfo);
  end;

  if CheckFPMkInst then begin
    // try to resolve .ppu files via fpmkinst .fpm files
    FPMToUnitTree:=nil;
    try
      AVLNode:=Result.Tree.FindLowest;
      while AVLNode<>nil do begin
        S2SItem:=PStringToStringTreeItem(AVLNode.Data);
        Unit_Name:=S2SItem^.Name;
        Filename:=S2SItem^.Value; // trimmed and expanded filename
        //if Pos('lazmkunit',Filename)>0 then
        //  debugln(['GatherUnitsInSearchPaths ===== ',Filename]);
        AVLNode:=Result.Tree.FindSuccessor(AVLNode);
        if CompareFileExt(Filename,'ppu',false)<>0 then continue;
        // check if filename has the form
        //                  /something/lib/fpc/<FPCVer>/units/<FPCTarget>/<pkgname>/
        // and if there is  /something/lib/fpc/<FPCVer>/fpmkinst/><FPCTarget>/<pkgname>.fpm
        p:=length(Filename);
        if not SearchPriorPathDelim(p,Filename) then exit;
        // <pkgname>
        EndPos:=p;
        if not SearchPriorPathDelim(p,Filename) then exit;
        PkgName:=copy(Filename,p+1,EndPos-p-1);
        if PkgName='' then continue;
        FPCTargetEndPos:=p;
        if not SearchPriorPathDelim(p,Filename) then exit;
        // <fpctarget>
        EndPos:=p;
        if not SearchPriorPathDelim(p,Filename) then exit;
        // 'units'
        if (EndPos-p<>6) or (CompareIdentifiers(@Filename[p+1],'units')<>0) then
          continue;
        FPMFilename:=copy(Filename,1,p)+'fpmkinst'
                    +copy(Filename,EndPos,FPCTargetEndPos-EndPos+1)+PkgName+'.fpm';
        if FPMToUnitTree=nil then begin
          FPMToUnitTree:=TStringToPointerTree.Create(false);
          FPMToUnitTree.FreeValues:=true;
        end;
        if not FPMToUnitTree.Contains(PkgName) then begin
          FPMSourcePath:='';
          if FileExistsCached(FPMFilename) then begin
            //debugln(['GatherUnitsInSearchPaths Found .fpm: ',FPMFilename]);
            sl:=TStringListUTF8.Create;
            try
              try
                sl.LoadFromFile(FPMFilename);
                for i:=0 to sl.Count-1 do begin
                  Line:=sl[i];
                  if LeftStr(Line,length('SourcePath='))='SourcePath=' then
                  begin
                    FPMSourcePath:=TrimAndExpandDirectory(copy(Line,length('SourcePath=')+1,length(Line)));
                    break;
                  end;
                end;
              except
                on E: Exception do
                  debugln(['Warning: (lazarus) [GatherUnitsInSearchPaths] ',E.Message]);
              end;
            finally
              sl.Free;
            end;
          end;
          if FPMSourcePath<>'' then begin
            PkgUnitToFilename:=GatherUnitSourcesInDirectory(FPMSourcePath,5);
            FPMToUnitTree[PkgName]:=PkgUnitToFilename;
            //debugln(['GatherUnitsInSearchPaths Pkg=',PkgName,' UnitsFound=',PkgUnitToFilename.Count]);
          end else
            FPMToUnitTree[PkgName]:=nil; // mark as not found
        end;

        PkgUnitToFilename:=TStringToStringTree(FPMToUnitTree[PkgName]);
        if PkgUnitToFilename=nil then continue;
        SrcFilename:=PkgUnitToFilename[Unit_Name];
        if SrcFilename<>'' then begin
          // unit source found in fppkg -> replace ppu with src file
          //debugln(['GatherUnitsInSearchPaths ppu=',Filename,' -> fppkg src=',SrcFilename]);
          Result[Unit_Name]:=SrcFilename;
        end;
      end;
    finally
      FPMToUnitTree.Free;
    end;
  end;
end;

function GatherUnitSourcesInDirectory(Directory: string; MaxLevel: integer
  ): TStringToStringTree;

  procedure Traverse(Dir: string; Tree: TStringToStringTree; Lvl: integer);
  var
    Info: TSearchRec;
    Filename: String;
    AnUnitName: String;
  begin
    if FindFirstUTF8(Dir+AllFilesMask,faAnyFile,Info)=0 then begin
      repeat
        Filename:=Info.Name;
        if (Filename='') or (Filename='.') or (Filename='..') then continue;
        if faDirectory and Info.Attr>0 then begin
          if Lvl<MaxLevel then
            Traverse(Dir+Filename+PathDelim,Tree,Lvl+1);
        end else if FilenameIsPascalUnit(Filename) then begin
          AnUnitName:=ExtractFileNameOnly(Filename);
          if not Tree.Contains(AnUnitName) then
            Tree[AnUnitName]:=Dir+Filename;
        end;
      until FindNextUTF8(Info)<>0;
    end;
    FindCloseUTF8(Info);
  end;

begin
  Result:=TStringToStringTree.Create(false);
  if MaxLevel<1 then exit;
  Directory:=AppendPathDelim(Directory);
  Traverse(Directory,Result,1);
end;

procedure AdjustFPCSrcRulesForPPUPaths(Units: TStringToStringTree;
  Rules: TFPCSourceRules);
var
  Filename: string;
  Rule: TFPCSourceRule;
begin
  if Units.CaseSensitive then
    raise Exception.Create('AdjustFPCSrcRulesForPPUPaths Units is case sensitive');
  // check unit httpd
  Filename:=Units['httpd'];
  if Filename<>'' then begin
    Filename:=ChompPathDelim(ExtractFilePath(Filename));
    Rule:=Rules.Add('packages/'+ExtractFileName(Filename));
    Rule.Score:=10;
    Rule.Targets:='*';
    //DebugLn(['AdjustFPCSrcRulesForPPUPaths ',Rule.Filename,' ',Filename]);
  end;
end;

function GatherUnitsInFPCSources(Files: TStringList; TargetOS: string;
  TargetCPU: string; Duplicates: TStringToStringTree;
  Rules: TFPCSourceRules; const DebugUnitName: string): TStringToStringTree;
{ returns tree unit name to file name (maybe relative)
}

  function CountMatches(Targets, aTxt: PChar): integer;
  // check how many of the comma separated words in Targets are in words of aTxt
  var
    TxtStartPos: PChar;
    TargetPos: PChar;
    TxtPos: PChar;
  begin
    Result:=0;
    if (aTxt=nil) or (Targets=nil) then exit;
    TxtStartPos:=aTxt;
    while true do begin
      while (not (IsIdentChar[TxtStartPos^])) do begin
        if TxtStartPos^=#0 then exit;
        inc(TxtStartPos);
      end;
      //DebugLn(['CountMatches TxtStartPos=',TxtStartPos]);
      TargetPos:=Targets;
      repeat
        while (TargetPos^=',') do inc(TargetPos);
        if TargetPos^=#0 then break;
        //DebugLn(['CountMatches TargetPos=',TargetPos]);
        TxtPos:=TxtStartPos;
        while (TxtPos^=TargetPos^) and (not (TargetPos^ in [#0,','])) do begin
          inc(TargetPos);
          inc(TxtPos);
        end;
        //DebugLn(['CountMatches Test TargetPos=',TargetPos,' TxtPos=',TxtPos]);
        if (TargetPos^ in [#0,',']) and (not IsIdentChar[TxtPos^]) then begin
          // the target fits
          //DebugLn(['CountMatches FITS']);
          inc(Result);
        end;
        // try next target
        while not (TargetPos^ in [#0,',']) do inc(TargetPos);
      until TargetPos^=#0;
      // next txt word
      while IsIdentChar[TxtStartPos^] do inc(TxtStartPos);
    end;
  end;

var
  i: Integer;
  Filename: string;
  Links: TAVLTree;
  Unit_Name: String;
  LastDirectory: String;
  LastDirScore: Integer;
  Directory: String;
  DirScore: LongInt;
  Node: TAVLTreeNode;
  Link: TUnitNameLink;
  TargetRules: TAVLTree;
  Score: LongInt;
  Targets: string;
begin
  Result:=nil;
  if (Files=nil) or (Files.Count=0) then exit;

  if (Duplicates<>nil) and Duplicates.CaseSensitive then
    raise Exception.Create('GatherUnitsInFPCSources: Duplicates case sensitive');

  // get default targets
  if Rules=nil then Rules:=DefaultFPCSourceRules;
  Targets:=Rules.GetDefaultTargets(TargetOS,TargetCPU);

  TargetRules:=nil;
  Links:=TAVLTree.Create(@CompareUnitNameLinks);
  try
    // get Score rules for duplicate units
    Rules.GetRulesForTargets(Targets,TargetRules);
    //DebugLn(['GatherUnitsInFPCSources ',Rules.GetScore('packages/h',TargetRules)]);
    //exit;

    if (TargetRules<>nil) and (TargetRules.Count=0) then
      FreeAndNil(TargetRules);
    LastDirectory:='';
    LastDirScore:=0;
    for i:=0 to Files.Count-1 do begin
      Filename:=Files[i];
      if (CompareFileExt(Filename,'PAS',false)=0)
      or (CompareFileExt(Filename,'PP',false)=0)
      or (CompareFileExt(Filename,'P',false)=0)
      then begin
        if CompareFilenameOnly(PChar(Filename),length(Filename),'fpmake',6,true)=0
        then
          continue; // skip the fpmake.pp files
        // Filename is a pascal unit source
        Directory:=ExtractFilePath(Filename);
        if LastDirectory=Directory then begin
          // same directory => reuse directory Score
          DirScore:=LastDirScore;
        end else begin
          // a new directory => recompute directory score
          // default heuristic: add one point for every target in directory
          DirScore:=CountMatches(PChar(Targets),PChar(Directory));
        end;
        Score:=DirScore;
        // apply target rules
        if TargetRules<>nil then
          inc(Score,Rules.GetScore(Filename,TargetRules));
        // add or update unitlink
        Unit_Name:=ExtractFileNameOnly(Filename);
        Node:=Links.FindKey(Pointer(Unit_Name),@CompareUnitNameWithUnitNameLink);
        if Node<>nil then begin
          // duplicate unit
          Link:=TUnitNameLink(Node.Data);
          if Link.Score<Score then begin
            // found a better unit
            if (DebugUnitName<>'') and (SysUtils.CompareText(Unit_Name,DebugUnitName)=0)
            then
              debugln(['GatherUnitsInFPCSources UnitName=',Unit_Name,' File=',Filename,' Score=',Score,' => better than ',Link.Score]);
            Link.Unit_Name:=Unit_Name;
            Link.Filename:=Filename;
            Link.ConflictFilename:='';
            Link.Score:=Score;
          end else if Link.Score=Score then begin
            // unit with same Score => maybe a conflict
            // be deterministic and choose the highest
            if (DebugUnitName<>'') and (SysUtils.CompareText(Unit_Name,DebugUnitName)=0)
            then
              debugln(['GatherUnitsInFPCSources UnitName=',Unit_Name,' File=',Filename,' Score=',Score,' => duplicate']);
            if CompareStr(Filename,Link.Filename)>0 then begin
              if Link.ConflictFilename<>'' then
                Link.ConflictFilename:=Link.ConflictFilename+';'+Link.Filename
              else
                Link.ConflictFilename:=Link.Filename;
              Link.Filename:=Filename;
            end else begin
              Link.ConflictFilename:=Link.ConflictFilename+';'+Filename;
            end;
          end;
        end else begin
          // new unit source found => add to list
          if (DebugUnitName<>'') and (SysUtils.CompareText(Unit_Name,DebugUnitName)=0)
          then
            debugln(['GatherUnitsInFPCSources UnitName=',Unit_Name,' File=',Filename,' Score=',Score]);
          Link:=TUnitNameLink.Create;
          Link.Unit_Name:=Unit_Name;
          Link.Filename:=Filename;
          Link.Score:=Score;
          Links.Add(Link);
        end;
        LastDirectory:=Directory;
        LastDirScore:=DirScore;
      end;
    end;
    Result:=TStringToStringTree.Create(false);
    Node:=Links.FindLowest;
    while Node<>Nil do begin
      Link:=TUnitNameLink(Node.Data);
      Result[Link.Unit_Name]:=Link.Filename;
      if (Link.ConflictFilename<>'') and (Link.Score>0) then begin
        //DebugLn(['GatherUnitsInFPCSources Ambiguous: ',Link.Score,' ',Link.Filename,' ',Link.ConflictFilename]);
        if Duplicates<>nil then
          Duplicates[Link.Unit_Name]:=Link.Filename+';'+Link.ConflictFilename;
      end;
      Node:=Links.FindSuccessor(Node);
    end;
  finally
    TargetRules.Free;
    Links.FreeAndClear;
    Links.Free;
  end;
end;

function CreateFPCTemplate(Config: TFPCTargetConfigCache; Owner: TObject
  ): TDefineTemplate;
var
  Node: TAVLTreeNode;
  StrItem: PStringToStringTreeItem;
  NewDefTempl: TDefineTemplate;
  TargetOS: String;
  SrcOS: String;
  SrcOS2: String;
  TargetCPU: String;
begin
  Result:=TDefineTemplate.Create(StdDefTemplFPC,
    ctsFreePascalCompilerInitialMacros,'','',da_Block);

  // define #TargetOS
  TargetOS:=Config.RealTargetOS;
  if TargetOS='' then
    TargetOS:=Config.TargetOS;
  if TargetOS='' then
    TargetOS:=GetCompiledTargetOS;
  NewDefTempl:=TDefineTemplate.Create('Define TargetOS',
    ctsDefaultFPCTargetOperatingSystem,
    ExternalMacroStart+'TargetOS',TargetOS,da_DefineRecurse);
  Result.AddChild(NewDefTempl);
  // define #SrcOS
  SrcOS:=GetDefaultSrcOSForTargetOS(TargetOS);
  if SrcOS='' then SrcOS:=TargetOS;
  NewDefTempl:=TDefineTemplate.Create('Define SrcOS',
    ctsDefaultFPCSourceOperatingSystem,
    ExternalMacroStart+'SrcOS',SrcOS,da_DefineRecurse);
  Result.AddChild(NewDefTempl);
  // define #SrcOS2
  SrcOS2:=GetDefaultSrcOS2ForTargetOS(TargetOS);
  if SrcOS2='' then SrcOS2:=TargetOS;
  NewDefTempl:=TDefineTemplate.Create('Define SrcOS2',
    ctsDefaultFPCSource2OperatingSystem,
    ExternalMacroStart+'SrcOS2',SrcOS2,da_DefineRecurse);
  Result.AddChild(NewDefTempl);
  // define #TargetCPU
  TargetCPU:=Config.RealTargetCPU;
  if TargetCPU='' then
    TargetCPU:=Config.TargetCPU;
  if TargetCPU='' then
    TargetCPU:=GetCompiledTargetCPU;
  NewDefTempl:=TDefineTemplate.Create('Define TargetCPU',
    ctsDefaultFPCTargetProcessor,
    TargetCPUMacroName,TargetCPU,
    da_DefineRecurse);
  Result.AddChild(NewDefTempl);

  if Config.Defines<>nil then begin
    Node:=Config.Defines.Tree.FindLowest;
    while Node<>nil do begin
      StrItem:=PStringToStringTreeItem(Node.Data);
      NewDefTempl:=TDefineTemplate.Create('Define '+StrItem^.Name,
           'Macro',StrItem^.Name,StrItem^.Value,da_DefineRecurse);
      Result.AddChild(NewDefTempl);
      Node:=Config.Defines.Tree.FindSuccessor(Node);
    end;
  end;

  if Config.Undefines<>nil then begin
    Node:=Config.Undefines.Tree.FindLowest;
    while Node<>nil do begin
      StrItem:=PStringToStringTreeItem(Node.Data);
      NewDefTempl:=TDefineTemplate.Create('Undefine '+StrItem^.Name,
           'Macro',StrItem^.Name,'',da_UndefineRecurse);
      Result.AddChild(NewDefTempl);
      Node:=Config.Undefines.Tree.FindSuccessor(Node);
    end;
  end;

  Result.SetFlags([dtfAutoGenerated],[],false);
  Result.SetDefineOwner(Owner,true);
end;

function CreateFPCTemplate(Config: TFPCUnitSetCache; Owner: TObject
  ): TDefineTemplate; overload;
begin
  Result:=CreateFPCTemplate(Config.GetConfigCache(false),Owner);
  Result.AddChild(TDefineTemplate.Create('UnitSet','UnitSet identifier',
                  UnitSetMacroName,Config.GetUnitSetID,da_DefineRecurse));
end;

function CreateFPCSourceTemplate(FPCSrcDir: string; Owner: TObject
  ): TDefineTemplate;
var
  Dir, SrcOS, SrcOS2, aTargetCPU,
  IncPathMacro: string;
  DS: char; // dir separator

  function d(const Filenames: string): string;
  begin
    Result:=SetDirSeparators(Filenames);
  end;

  procedure AddSrcOSDefines(ParentDefTempl: TDefineTemplate);
  var
    IfTargetOSIsNotSrcOS: TDefineTemplate;
    RTLSrcOSDir: TDefineTemplate;
    IfTargetOSIsNotSrcOS2: TDefineTemplate;
    RTLSrcOS2Dir: TDefineTemplate;
  begin
    // if TargetOS<>SrcOS
    IfTargetOSIsNotSrcOS:=TDefineTemplate.Create(
      'IF TargetOS<>SrcOS',
      ctsIfTargetOSIsNotSrcOS,'',''''+TargetOSMacro+'''<>'''+SrcOS+'''',da_If);
    // rtl/$(#SrcOS)
    RTLSrcOSDir:=TDefineTemplate.Create('SrcOS',SrcOS,'',
      SrcOS,da_Directory);
    IfTargetOSIsNotSrcOS.AddChild(RTLSrcOSDir);
    RTLSrcOSDir.AddChild(TDefineTemplate.Create('Include Path',
      'include path',
      IncludePathMacroName,IncPathMacro+';inc',
      da_Define));
    RTLSrcOSDir.AddChild(TDefineTemplate.Create('Include Path',
      'include path to TargetCPU directories',
      IncludePathMacroName,IncPathMacro+';'+aTargetCPU,
      da_Define));
    ParentDefTempl.AddChild(IfTargetOSIsNotSrcOS);

    // if TargetOS<>SrcOS2
    IfTargetOSIsNotSrcOS2:=TDefineTemplate.Create(
      'IF TargetOS is not SrcOS2',
      ctsIfTargetOSIsNotSrcOS,'',''''+TargetOSMacro+'''<>'''+SrcOS2+'''',da_If);
    // rtl/$(#SrcOS2)
    RTLSrcOS2Dir:=TDefineTemplate.Create('SrcOS2',SrcOS2,'',
      SrcOS2,da_Directory);
    IfTargetOSIsNotSrcOS2.AddChild(RTLSrcOS2Dir);
    RTLSrcOS2Dir.AddChild(TDefineTemplate.Create('Include Path',
      'include path to TargetCPU directories',
      IncludePathMacroName,IncPathMacro+';'+aTargetCPU,
      da_DefineRecurse));
    ParentDefTempl.AddChild(IfTargetOSIsNotSrcOS2);
  end;

var
  DefTempl, MainDir, FCLDir, RTLDir, RTLOSDir, PackagesDir, CompilerDir,
  UtilsDir, DebugSvrDir: TDefineTemplate;
  s: string;
  FCLDBDir: TDefineTemplate;
  FCLDBInterbaseDir: TDefineTemplate;
  InstallerDir: TDefineTemplate;
  IFTempl: TDefineTemplate;
  FCLBaseDir: TDefineTemplate;
  FCLBaseSrcDir: TDefineTemplate;
  PackagesFCLAsyncDir: TDefineTemplate;
  PackagesExtraDir: TDefineTemplate;
  PackagesFCLExtraDir: TDefineTemplate;
  PackagesSubDir: TDefineTemplate;
  PkgExtraGraphDir: TDefineTemplate;
  PkgExtraAMunitsDir: TDefineTemplate;
  FCLSubSrcDir: TDefineTemplate;
  FCLSubDir: TDefineTemplate;
  Ok: Boolean;
begin
  {$IFDEF VerboseFPCSrcScan}
  DebugLn('CreateFPCSrcTemplate FPCSrcDir="',FPCSrcDir,'"');
  {$ENDIF}
  Result:=nil;
  Ok:=false;
  try
    if (FPCSrcDir='') or (not DirPathExists(FPCSrcDir)) then begin
      DebugLn(['Warning: [CreateFPCSrcTemplate] FPCSrcDir does not exist: FPCSrcDir="',FPCSrcDir,'"']);
      exit;
    end;
    DS:=PathDelim;
    Dir:=AppendPathDelim(FPCSrcDir);
    SrcOS:='$('+ExternalMacroStart+'SrcOS)';
    SrcOS2:='$('+ExternalMacroStart+'SrcOS2)';
    aTargetCPU:=TargetCPUMacro;
    IncPathMacro:=IncludePathMacro;

    Result:=TDefineTemplate.Create(StdDefTemplFPCSrc,
       Format(ctsFreePascalSourcesPlusDesc,['RTL, FCL, Packages, Compiler']),
       '','',da_Block);

    // The Free Pascal sources build a world of their own
    // => reset all search paths
    MainDir:=TDefineTemplate.Create('Free Pascal Source Directory',
      ctsFreePascalSourceDir,'',FPCSrcDir,da_Directory);
    Result.AddChild(MainDir);
    DefTempl:=TDefineTemplate.Create('Reset SrcPath',
      ctsSrcPathInitialization,ExternalMacroStart+'SrcPath','',da_DefineRecurse);
    MainDir.AddChild(DefTempl);
    DefTempl:=TDefineTemplate.Create('Reset UnitPath',
      ctsUnitPathInitialization,UnitPathMacroName,'',da_DefineRecurse);
    MainDir.AddChild(DefTempl);
    DefTempl:=TDefineTemplate.Create('Reset IncPath',
      ctsUnitPathInitialization,IncludePathMacroName,'',da_DefineRecurse);
    MainDir.AddChild(DefTempl);

    // rtl
    RTLDir:=TDefineTemplate.Create('RTL',ctsRuntimeLibrary,'','rtl',da_Directory);
    MainDir.AddChild(RTLDir);

    // rtl include paths
    s:=IncPathMacro
      +';'+Dir+'rtl'+DS+'objpas'+DS
      +';'+Dir+'rtl'+DS+'objpas'+DS+'sysutils'
      +';'+Dir+'rtl'+DS+'objpas'+DS+'classes'
      +';'+Dir+'rtl'+DS+'inc'+DS
      +';'+Dir+'rtl'+DS+'inc'+DS+'graph'+DS
      +';'+Dir+'rtl'+DS+SrcOS+DS
      +';'+Dir+'rtl'+DS+TargetOSMacro+DS
      +';'+Dir+'rtl'+DS+SrcOS2+DS
      +';'+Dir+'rtl'+DS+SrcOS2+DS+aTargetCPU
      +';'+Dir+'rtl'+DS+aTargetCPU+DS
      +';'+Dir+'rtl'+DS+TargetOSMacro+DS+aTargetCPU+DS;
    RTLDir.AddChild(TDefineTemplate.Create('Include Path',
      Format(ctsIncludeDirectoriesPlusDirs,
      ['objpas, inc,'+aTargetCPU+','+SrcOS]),
      IncludePathMacroName,s,da_DefineRecurse));

    // if solaris or darwin or beos then define FPC_USE_LIBC
    IFTempl:=TDefineTemplate.Create('IF darwin or solaris or beos',
      'If Darwin or Solaris or Beos', '', 'defined(darwin) or defined(solaris) or defined(beos)', da_If);
      // then define FPC_USE_LIBC
      IFTempl.AddChild(TDefineTemplate.Create('define FPC_USE_LIBC',
        'define FPC_USE_LIBC','FPC_USE_LIBC','',da_DefineRecurse));
    RTLDir.AddChild(IFTempl);

    // rtl: IF SrcOS=win then add include path rtl/TargetOS/wininc;rtl/win/wininc;rtl/win
    IFTempl:=TDefineTemplate.Create('If SrcOS=win','If SrcOS=win',
      '',''''+SrcOS+'''=''win''',da_If);
    IFTempl.AddChild(TDefineTemplate.Create('Include Path',
        Format(ctsIncludeDirectoriesPlusDirs,['wininc']),
        IncludePathMacroName,
        IncPathMacro
        +';'+Dir+'rtl'+DS+TargetOSMacro+DS+'wininc'
        +';'+Dir+'rtl'+DS+'win'+DS+'wininc'
        +';'+Dir+'rtl'+DS+'win',
        da_DefineRecurse));
    RTLDir.AddChild(IFTempl);

    // rtl: IF TargetOS=iphonesim then add include path rtl/unix, rtl/bsd, rtl/darwin
    IFTempl:=TDefineTemplate.Create('If TargetOS=iphonesim','If TargetOS=iphonesim',
      '',''''+TargetOSMacro+'''=''iphonesim''',da_If);
    IFTempl.AddChild(TDefineTemplate.Create('Include Path',
        Format(ctsIncludeDirectoriesPlusDirs,['unix,bsd,darwin']),
        IncludePathMacroName,
        IncPathMacro
        +';'+Dir+'rtl'+DS+'unix'
        +';'+Dir+'rtl'+DS+'bsd'
        +';'+Dir+'rtl'+DS+'darwin',
        da_DefineRecurse));
    RTLDir.AddChild(IFTempl);

    // add processor and SrcOS alias defines for the RTL
    AddSrcOSDefines(RTLDir);

    // rtl/$(#TargetOS)
    RTLOSDir:=TDefineTemplate.Create('TargetOS','Target OS','',
                                     TargetOSMacro,da_Directory);
    s:=IncPathMacro
      +';'+Dir+'rtl'+DS+TargetOSMacro+DS+SrcOS+'inc' // e.g. rtl/win32/inc/
      +';'+Dir+'rtl'+DS+TargetOSMacro+DS+aTargetCPU+DS
      ;
    RTLOSDir.AddChild(TDefineTemplate.Create('Include Path',
      Format(ctsIncludeDirectoriesPlusDirs,[aTargetCPU]),
      IncludePathMacroName,
      s,da_DefineRecurse));
    s:=SrcPathMacro
      +';'+Dir+'rtl'+DS+'objpas'+DS;
    RTLOSDir.AddChild(TDefineTemplate.Create('Src Path',
      Format(ctsAddsDirToSourcePath,[aTargetCPU]),
      ExternalMacroStart+'SrcPath',s,da_DefineRecurse));
    RTLDir.AddChild(RTLOSDir);


    // fcl
    FCLDir:=TDefineTemplate.Create('FCL',ctsFreePascalComponentLibrary,'','fcl',
        da_Directory);
    MainDir.AddChild(FCLDir);
    FCLDir.AddChild(TDefineTemplate.Create('Include Path',
      Format(ctsIncludeDirectoriesPlusDirs,['inc,'+SrcOS]),
      IncludePathMacroName,
      d(   DefinePathMacro+'/inc/'
      +';'+DefinePathMacro+'/classes/'
      +';'+DefinePathMacro+'/'+TargetOSMacro+DS // TargetOS before SrcOS !
      +';'+DefinePathMacro+'/'+SrcOS+DS
      +';'+IncPathMacro)
      ,da_DefineRecurse));

    // fcl/db
    FCLDBDir:=TDefineTemplate.Create('DB','DB','','db',da_Directory);
    FCLDir.AddChild(FCLDBDir);
    FCLDBInterbaseDir:=TDefineTemplate.Create('interbase','interbase','',
      'interbase',da_Directory);
    FCLDBDir.AddChild(FCLDBInterbaseDir);
    FCLDBInterbaseDir.AddChild(TDefineTemplate.Create('SrcPath',
      'SrcPath addition',
      ExternalMacroStart+'SrcPath',
      d(Dir+'/packages/base/ibase;'+SrcPathMacro)
      ,da_Define));

    // packages
    PackagesDir:=TDefineTemplate.Create('Packages',ctsPackageDirectories,'',
       'packages',da_Directory);
    MainDir.AddChild(PackagesDir);

    // packages/fcl-base
    FCLBaseDir:=TDefineTemplate.Create('FCL-base',
        ctsFreePascalComponentLibrary,'','fcl-base',
        da_Directory);
    PackagesDir.AddChild(FCLBaseDir);
    // packages/fcl-base/src
    FCLBaseSrcDir:=TDefineTemplate.Create('src',
        'src','','src',
        da_Directory);
    FCLBaseDir.AddChild(FCLBaseSrcDir);
    FCLBaseSrcDir.AddChild(TDefineTemplate.Create('Include Path',
      Format(ctsIncludeDirectoriesPlusDirs,['inc,'+SrcOS]),
      IncludePathMacroName,
      d(   DefinePathMacro+'/inc/'
      +';'+DefinePathMacro+'/'+TargetOSMacro+DS // TargetOS before SrcOS !
      +';'+DefinePathMacro+'/'+SrcOS+DS
      +';'+IncPathMacro)
      ,da_DefineRecurse));

    // packages/fcl-process
    FCLSubDir:=TDefineTemplate.Create('FCL-process',
        'fcl-process','','fcl-process',
        da_Directory);
    PackagesDir.AddChild(FCLSubDir);
    // packages/fcl-process/src
    FCLSubSrcDir:=TDefineTemplate.Create('src',
        'src','','src',
        da_Directory);
    FCLSubDir.AddChild(FCLSubSrcDir);
    FCLSubSrcDir.AddChild(TDefineTemplate.Create('Include Path',
      Format(ctsIncludeDirectoriesPlusDirs,['inc,'+SrcOS]),
      IncludePathMacroName,
      d(   DefinePathMacro+'/'+TargetOSMacro+DS // TargetOS before SrcOS !
      +';'+DefinePathMacro+'/'+SrcOS+DS
      +';'+IncPathMacro)
      ,da_DefineRecurse));

    // packages/fcl-async
    PackagesFCLAsyncDir:=TDefineTemplate.Create('fcl-async','fcl-async','','fcl-async',da_Directory);
    PackagesDir.AddChild(PackagesFCLAsyncDir);

    // packages/fcl-async/src
    PackagesFCLAsyncDir.AddChild(TDefineTemplate.Create('Include Path',
      Format(ctsIncludeDirectoriesPlusDirs,['packages/fcl-async/src']),
      IncludePathMacroName,
      d(   DefinePathMacro+'/src/'
      +';'+IncPathMacro)
      ,da_DefineRecurse));

    // packages/fcl-extra
    PackagesFCLExtraDir:=TDefineTemplate.Create('fcl-extra','fcl-extra','','fcl-extra',da_Directory);
    PackagesDir.AddChild(PackagesFCLExtraDir);

    // packages/fcl-extra/src
    PackagesFCLExtraDir.AddChild(TDefineTemplate.Create('Include Path',
      Format(ctsIncludeDirectoriesPlusDirs,['packages/fcl-extra/src']),
      IncludePathMacroName,
      d(   DefinePathMacro+'/src/'+SrcOS
      +';'+IncPathMacro)
      ,da_DefineRecurse));

    // packages/extra
    PackagesExtraDir:=TDefineTemplate.Create('extra','extra','','extra',da_Directory);
    PackagesDir.AddChild(PackagesExtraDir);

    // packages/extra/graph
    PkgExtraGraphDir:=TDefineTemplate.Create('graph','graph','','graph',
                                             da_Directory);
    PackagesExtraDir.AddChild(PkgExtraGraphDir);
    PkgExtraGraphDir.AddChild(TDefineTemplate.Create('Include Path',
      Format(ctsIncludeDirectoriesPlusDirs,['inc']),
      IncludePathMacroName,
      d(   DefinePathMacro+'/inc/'
      +';'+IncPathMacro)
      ,da_DefineRecurse));

    // packages/extra/amunits
    PkgExtraAMunitsDir:=TDefineTemplate.Create('amunits','amunits','','amunits',
                                             da_Directory);
    PackagesExtraDir.AddChild(PkgExtraAMunitsDir);
    PkgExtraAMunitsDir.AddChild(TDefineTemplate.Create('Include Path',
      Format(ctsIncludeDirectoriesPlusDirs,['inc']),
      IncludePathMacroName,
      d(   DefinePathMacro+'/inc/'
      +';'+IncPathMacro)
      ,da_DefineRecurse));

    // packages/graph
    PackagesSubDir:=TDefineTemplate.Create('graph','graph','','graph',da_Directory);
    PackagesDir.AddChild(PackagesSubDir);
    PackagesSubDir.AddChild(TDefineTemplate.Create('Include Path',
      Format(ctsIncludeDirectoriesPlusDirs,['packages/graph/src/inc']),
      IncludePathMacroName,
      d(DefinePathMacro+'/src/inc;'
       +IncPathMacro)
      ,da_DefineRecurse));

    // packages/rtl-console
    PackagesSubDir:=TDefineTemplate.Create('rtl-console','rtl-console','','rtl-console',da_Directory);
    PackagesDir.AddChild(PackagesSubDir);
    PackagesSubDir.AddChild(TDefineTemplate.Create('Include Path',
      Format(ctsIncludeDirectoriesPlusDirs,['packages/rtl-console/src/inc']),
      IncludePathMacroName,
      d(DefinePathMacro+'/src/inc;'
       +IncPathMacro)
      ,da_DefineRecurse));

    // packages/rtl-extra
    PackagesSubDir:=TDefineTemplate.Create('rtl-extra','rtl-extra','','rtl-extra',da_Directory);
    PackagesDir.AddChild(PackagesSubDir);
    PackagesSubDir.AddChild(TDefineTemplate.Create('Include Path',
      Format(ctsIncludeDirectoriesPlusDirs,['packages/rtl-extra/src/OS']),
      IncludePathMacroName,
      d(DefinePathMacro+'/src/inc;'
       +DefinePathMacro+'/src/'+TargetOSMacro+';'
       +IncPathMacro)
      ,da_DefineRecurse));

    // packages/rtl-objpas
    PackagesSubDir:=TDefineTemplate.Create('rtl-objpas','rtl-objpas','','rtl-objpas',da_Directory);
    PackagesDir.AddChild(PackagesSubDir);
    PackagesSubDir.AddChild(TDefineTemplate.Create('Include Path',
      Format(ctsIncludeDirectoriesPlusDirs,['packages/rtl-objpas/src/inc']),
      IncludePathMacroName,
      d(DefinePathMacro+'/src/inc;'
       +IncPathMacro)
      ,da_DefineRecurse));

    // utils
    UtilsDir:=TDefineTemplate.Create('Utils',ctsUtilsDirectories,'',
       'utils',da_Directory);
    MainDir.AddChild(UtilsDir);

    // utils/debugsvr
    DebugSvrDir:=TDefineTemplate.Create('DebugSvr','Debug Server','',
       'debugsvr',da_Directory);
    UtilsDir.AddChild(DebugSvrDir);
    DebugSvrDir.AddChild(TDefineTemplate.Create('Interface Path',
      Format(ctsAddsDirToSourcePath,['..']),ExternalMacroStart+'SrcPath',
      '..;'+ExternalMacroStart+'SrcPath',da_DefineRecurse));

    // installer
    InstallerDir:=TDefineTemplate.Create('Installer',ctsInstallerDirectories,'',
       'installer',da_Directory);
    InstallerDir.AddChild(TDefineTemplate.Create('SrcPath','SrcPath addition',
      ExternalMacroStart+'SrcPath',
      SrcPathMacro+';'+Dir+'ide;'+Dir+'fv',da_Define));
    MainDir.AddChild(InstallerDir);

    // compiler
    CompilerDir:=TDefineTemplate.Create('Compiler',ctsCompiler,'','compiler',
       da_Directory);
    CompilerDir.AddChild(TDefineTemplate.Create('SrcPath','SrcPath addition',
      ExternalMacroStart+'SrcPath',
      SrcPathMacro+';'+Dir+aTargetCPU,da_Define));
    CompilerDir.AddChild(TDefineTemplate.Create('IncPath','IncPath addition',
      IncludePathMacroName,
      IncPathMacro+';'+Dir+'compiler',da_DefineRecurse));
    MainDir.AddChild(CompilerDir);

    // compiler/utils
    UtilsDir:=TDefineTemplate.Create('utils',ctsUtilsDirectories,'',
       'utils',da_Directory);
    UtilsDir.AddChild(TDefineTemplate.Create('SrcPath','SrcPath addition',
      ExternalMacroStart+'SrcPath',
      SrcPathMacro+';..',da_Define));
    CompilerDir.AddChild(UtilsDir);

    Result.SetDefineOwner(Owner,true);
    Result.SetFlags([dtfAutoGenerated],[],false);

    Ok:=true;
  finally
    if not ok then
      FreeAndNil(Result);
  end;
end;

function CreateFPCSourceTemplate(Config: TFPCUnitSetCache; Owner: TObject
  ): TDefineTemplate;
begin
  Result:=CreateFPCSourceTemplate(Config.FPCSourceDirectory,Owner);
end;

procedure CheckPPUSources(PPUFiles, UnitToSource,
  UnitToDuplicates: TStringToStringTree;
  var Duplicates, Missing: TStringToStringTree);
var
  Node: TAVLTreeNode;
  Item: PStringToStringTreeItem;
  Unit_Name: String;
  Filename: String;
  SrcFilename: string;
  DuplicateFilenames: string;
begin
  if PPUFiles.CaseSensitive then
    raise Exception.Create('CheckPPUSources PPUFiles is case sensitive');
  if UnitToSource.CaseSensitive then
    raise Exception.Create('CheckPPUSources UnitToSource is case sensitive');
  if UnitToDuplicates.CaseSensitive then
    raise Exception.Create('CheckPPUSources UnitToDuplicates is case sensitive');
  if (Duplicates<>nil) and Duplicates.CaseSensitive then
    raise Exception.Create('CheckPPUSources Duplicates is case sensitive');
  if (Missing<>nil) and Missing.CaseSensitive then
    raise Exception.Create('CheckPPUSources Missing is case sensitive');
  Node:=PPUFiles.Tree.FindLowest;
  while Node<>nil do begin
    Item:=PStringToStringTreeItem(Node.Data);
    Unit_Name:=Item^.Name;
    Filename:=Item^.Value;
    if CompareFileExt(Filename,'.ppu',false)=0 then begin
      SrcFilename:=UnitToSource[Unit_Name];
      if SrcFilename<>'' then begin
        DuplicateFilenames:=UnitToDuplicates[Unit_Name];
        if (DuplicateFilenames<>'') and (Duplicates<>nil) then
          Duplicates[Unit_Name]:=DuplicateFilenames;
      end else begin
        if Missing<>nil then
          Missing[Unit_Name]:=Filename;
      end;
    end;
    Node:=PPUFiles.Tree.FindSuccessor(Node);
  end;
end;

procedure LoadFPCCacheFromFile(Filename: string;
  var Configs: TFPCTargetConfigCaches; var Sources: TFPCSourceCaches);
var
  XMLConfig: TXMLConfig;
begin
  if Configs=nil then Configs:=TFPCTargetConfigCaches.Create(nil);
  if Sources=nil then Sources:=TFPCSourceCaches.Create(nil);
  if not FileExistsUTF8(Filename) then exit;
  XMLConfig:=TXMLConfig.Create(Filename);
  try
    Configs.LoadFromXMLConfig(XMLConfig,'FPCConfigs/');
    Sources.LoadFromXMLConfig(XMLConfig,'FPCSourceDirectories/');
  finally
    XMLConfig.Free;
  end;
end;

procedure SaveFPCCacheToFile(Filename: string; Configs: TFPCTargetConfigCaches;
  Sources: TFPCSourceCaches);
var
  XMLConfig: TXMLConfig;
begin
  XMLConfig:=TXMLConfig.CreateClean(Filename);
  try
    Configs.SaveToXMLConfig(XMLConfig,'FPCConfigs/');
    Sources.SaveToXMLConfig(XMLConfig,'FPCSourceDirectories/');
  finally
    XMLConfig.Free;
  end;
end;

procedure ReadMakefileFPC(const Filename: string; List: TStrings);
var
  MakefileFPC: TStringListUTF8;
  i: Integer;
  Line: string;
  p: LongInt;
  NameValue: String;
begin
  MakefileFPC:=TStringListUTF8.Create;
  MakefileFPC.LoadFromFile(Filename);
  i:=0;
  while i<MakefileFPC.Count do begin
    Line:=MakefileFPC[i];
    if Line='' then begin
    end else if (Line[1]='[') then begin
      // start of section
      p:=System.Pos(']',Line);
      if p<1 then p:=length(Line);
      List.Add(Line);
    end else if (Line[1] in ['a'..'z','A'..'Z','0'..'9','_']) then begin
      // start of name=value pair
      NameValue:=Line;
      repeat
        p:=length(NameValue);
        while (p>=1) and (NameValue[p] in [' ',#9]) do dec(p);
        //List.Add(' NameValue="'+NameValue+'" p='+IntToStr(p)+' "'+NameValue[p]+'"');
        if (p>=1) and (NameValue[p]='\')
        and ((p=1) or (NameValue[p-1]<>'\')) then begin
          // append next line
          NameValue:=copy(NameValue,1,p-1);
          inc(i);
          if i>=MakefileFPC.Count then break;
          NameValue:=NameValue+MakefileFPC[i];
        end else break;
      until false;
      List.Add(NameValue);
    end;
    inc(i);
  end;
  MakefileFPC.Free;
end;

procedure ParseMakefileFPC(const Filename, SrcOS: string;
  out Dirs, SubDirs: string);

  function MakeSearchPath(const s: string): string;
  var
    SrcPos: Integer;
    DestPos: Integer;
  begin
    // check how much space is needed
    SrcPos:=1;
    DestPos:=0;
    while (SrcPos<=length(s)) do begin
      if s[SrcPos] in [#0..#31] then begin
        // space is a delimiter
        inc(SrcPos);
        // skip multiple spaces
        while (SrcPos<=length(s)) and (s[SrcPos] in [#0..#31]) do inc(SrcPos);
        if (DestPos>0) and (SrcPos<=length(s)) then begin
          inc(DestPos);// add semicolon
        end;
      end else begin
        inc(DestPos);
        inc(SrcPos);
      end;
    end;

    // allocate space
    SetLength(Result,DestPos);

    // create semicolon delimited search path
    SrcPos:=1;
    DestPos:=0;
    while (SrcPos<=length(s)) do begin
      if s[SrcPos] in [#0..#32] then begin
        // space is a delimiter
        inc(SrcPos);
        // skip multiple spaces
        while (SrcPos<=length(s)) and (s[SrcPos] in [#0..#32]) do inc(SrcPos);
        if (DestPos>0) and (SrcPos<=length(s)) then begin
          inc(DestPos);// add semicolon
          Result[DestPos]:=';';
        end;
      end else begin
        inc(DestPos);
        Result[DestPos]:=s[SrcPos];
        inc(SrcPos);
      end;
    end;
  end;

var
  Params: TStringList;
  i: Integer;
  Line: string;
  p: LongInt;
  Name: String;
  SubDirsName: String;
begin
  SubDirs:='';
  Dirs:='';
  Params:=TStringList.Create;
  try
    ReadMakefileFPC(Filename,Params);

    SubDirsName:='';
    if SrcOS<>'' then
      SubDirsName:='dirs_'+SrcOS;

    for i:=0 to Params.Count-1 do begin
      Line:=Params[i];
      if Line='' then continue;
      if (Line[1] in ['a'..'z','A'..'Z','0'..'9','_']) then begin
        p:=System.Pos('=',Line);
        if p<1 then continue;
        Name:=copy(Line,1,p-1);
        if Name=SubDirsName then begin
          SubDirs:=MakeSearchPath(copy(Line,p+1,length(Line)));
        end else if Name='dirs' then begin
          Dirs:=MakeSearchPath(copy(Line,p+1,length(Line)));
        end;
      end;
    end;
  except
    on e: Exception do begin
      debugln('Error: [ParseMakefileFPC] Filename=',Filename,': ',E.Message);
    end;
  end;
  Params.Free;
end;

function CompareFPCSourceRulesViaFilename(Rule1, Rule2: Pointer): integer;
var
  SrcRule1: TFPCSourceRule absolute Rule1;
  SrcRule2: TFPCSourceRule absolute Rule2;
begin
  Result:=CompareFilenames(SrcRule1.Filename,SrcRule2.Filename);
end;

function CompareFPCTargetConfigCacheItems(CacheItem1, CacheItem2: Pointer): integer;
var
  Item1: TFPCTargetConfigCache absolute CacheItem1;
  Item2: TFPCTargetConfigCache absolute CacheItem2;
begin
  Result:=CompareStr(Item1.TargetOS,Item2.TargetOS);
  if Result<>0 then exit;
  Result:=CompareStr(Item1.TargetCPU,Item2.TargetCPU);
  if Result<>0 then exit;
  Result:=CompareFilenames(Item1.Compiler,Item2.Compiler);
  if Result<>0 then exit;
  Result:=CompareFilenames(Item1.CompilerOptions,Item2.CompilerOptions);
end;

function CompareFPCSourceCacheItems(CacheItem1, CacheItem2: Pointer): integer;
var
  Src1: TFPCSourceCache absolute CacheItem1;
  Src2: TFPCSourceCache absolute CacheItem2;
begin
  Result:=CompareFilenames(Src1.Directory,Src2.Directory);
end;

function CompareDirectoryWithFPCSourceCacheItem(AString, CacheItem: Pointer
  ): integer;
var
  Src: TFPCSourceCache absolute CacheItem;
begin
  Result:=CompareFilenames(AnsiString(AString),Src.Directory);
end;

function DefineActionNameToAction(const s: string): TDefineAction;
begin
  for Result:=Low(TDefineAction) to High(TDefineAction) do
    if CompareText(s,DefineActionNames[Result])=0 then exit;
  Result:=da_None;
end;

function DefineTemplateFlagsToString(Flags: TDefineTemplateFlags): string;
var f: TDefineTemplateFlag;
begin
  Result:='';
  for f:=Low(TDefineTemplateFlag) to High(TDefineTemplateFlag) do begin
    if f in Flags then begin
      if Result<>'' then Result:=Result+',';
      Result:=Result+DefineTemplateFlagNames[f];
    end;
  end;
end;

function CompareUnitLinkNodes(NodeData1, NodeData2: pointer): integer;
var Link1, Link2: TUnitNameLink;
begin
  Link1:=TUnitNameLink(NodeData1);
  Link2:=TUnitNameLink(NodeData2);
  Result:=CompareText(Link1.Unit_Name,Link2.Unit_Name);
end;

function CompareUnitNameWithUnitLinkNode(AUnitName: Pointer;
  NodeData: pointer): integer;
begin
  Result:=CompareText(String(AUnitName),TUnitNameLink(NodeData).Unit_Name);
end;

function CompareDirectoryDefines(NodeData1, NodeData2: pointer): integer;
var DirDef1, DirDef2: TDirectoryDefines;
begin
  DirDef1:=TDirectoryDefines(NodeData1);
  DirDef2:=TDirectoryDefines(NodeData2);
  Result:=CompareFilenames(DirDef1.Path,DirDef2.Path);
end;

function GetDefaultSrcOSForTargetOS(const TargetOS: string): string;
begin
  Result:='';
  if (CompareText(TargetOS,'linux')=0)
  or (CompareText(TargetOS,'freebsd')=0)
  or (CompareText(TargetOS,'netbsd')=0)
  or (CompareText(TargetOS,'openbsd')=0)
  or (CompareText(TargetOS,'darwin')=0)
  or (CompareText(TargetOS,'solaris')=0)
  or (CompareText(TargetOS,'haiku')=0)
  or (CompareText(TargetOS,'android')=0)
  then
    Result:='unix'
  else
  if (CompareText(TargetOS,'win32')=0)
  or (CompareText(TargetOS,'win64')=0)
  or (CompareText(TargetOS,'wince')=0)
  then
    Result:='win';
end;

function GetDefaultSrcOS2ForTargetOS(const TargetOS: string): string;
begin
  Result:='';
  if (CompareText(TargetOS,'freebsd')=0)
  or (CompareText(TargetOS,'netbsd')=0)
  or (CompareText(TargetOS,'openbsd')=0)
  or (CompareText(TargetOS,'darwin')=0)
  then
    Result:='bsd'
  else if (CompareText(TargetOS,'android')=0) then
    Result:='linux';
end;

function GetDefaultSrcCPUForTargetCPU(const TargetCPU: string): string;
begin
  Result:='';
  if (CompareText(TargetCPU,'i386')=0)
  or (CompareText(TargetCPU,'x86_64')=0)
  then
    Result:='x86';
end;

procedure SplitLazarusCPUOSWidgetCombo(const Combination: string;
  out CPU, OS, WidgetSet: string);
var
  StartPos, EndPos: integer;
begin
  StartPos:=1;
  EndPos:=StartPos;
  while (EndPos<=length(Combination)) and (Combination[EndPos]<>'-') do
    inc(EndPos);
  CPU:=copy(Combination,StartPos,EndPos-StartPos);
  StartPos:=EndPos+1;
  EndPos:=StartPos;
  while (EndPos<=length(Combination)) and (Combination[EndPos]<>'-') do
    inc(EndPos);
  OS:=copy(Combination,StartPos,EndPos-StartPos);
  StartPos:=EndPos+1;
  EndPos:=StartPos;
  while (EndPos<=length(Combination)) and (Combination[EndPos]<>'-') do
    inc(EndPos);
  WidgetSet:=copy(Combination,StartPos,EndPos-StartPos);
end;

function GetCompiledFPCVersion: integer;
begin
  Result:=FPCVersionToNumber({$I %FPCVERSION%});
end;

function GetCompiledTargetOS: string;
begin
  Result:=lowerCase({$I %FPCTARGETOS%});
end;

function GetCompiledTargetCPU: string;
begin
  Result:=lowerCase({$I %FPCTARGETCPU%});
end;

function GetDefaultCompilerFilename(const TargetCPU: string;
  Cross: boolean): string;
begin
  if Cross then
    {$ifdef darwin}
    Result:='ppc' // the mach-o format supports "fat" binaries whereby
                  // a single executable contains machine code for several architectures
    {$else}
    Result:='ppcross'
    {$endif}
  else
    Result:='ppc';
  if TargetCPU='' then
    Result:='fpc'
  else if SysUtils.CompareText(TargetCPU,'i386')=0 then
    Result:=Result+'386'
  else if SysUtils.CompareText(TargetCPU,'m68k')=0 then
    Result:=Result+'86k'
  else if SysUtils.CompareText(TargetCPU,'alpha')=0 then
    Result:=Result+'apx'
  else if SysUtils.CompareText(TargetCPU,'powerpc')=0 then
    Result:=Result+'ppc'
  else if SysUtils.CompareText(TargetCPU,'powerpc64')=0 then
    Result:=Result+'ppc64'
  else if SysUtils.CompareText(TargetCPU,'arm')=0 then
    Result:=Result+'arm'
  else if SysUtils.CompareText(TargetCPU,'avr')=0 then
    Result:=Result+'avr'
  else if SysUtils.CompareText(TargetCPU,'sparc')=0 then
    Result:=Result+'sparc'
  else if SysUtils.CompareText(TargetCPU,'x86_64')=0 then
    Result:=Result+'x64'
  else if SysUtils.CompareText(TargetCPU,'ia64')=0 then
    Result:=Result+'ia64'
  else if SysUtils.CompareText(TargetCPU,'a64')=0 then
    Result:=Result+'a64'
  else
    Result:='fpc';
  Result:=Result+ExeExt;
end;

procedure GetTargetProcessors(const TargetCPU: string; aList: TStrings);

  procedure Arm;
  begin
    aList.Add('ARMV3');
    aList.Add('ARMV4');
    aList.Add('ARMV5');
    aList.Add('ARMV6');
    aList.Add('ARMV7');
    aList.Add('ARMV7A');
    aList.Add('ARMV7M');
    aList.Add('CORTEXM3');
  end;

  procedure Intel_i386;
  begin
    aList.Add('80386');
    aList.Add('Pentium');
    aList.Add('Pentium2');
    aList.Add('Pentium3');
    aList.Add('Pentium4');
    aList.Add('PentiumM');
  end;

  procedure Intel_x86_64;
  begin
    aList.Add('ATHLON64');
  end;

  procedure PowerPC;
  begin
    aList.Add('604');
    aList.Add('750');
    aList.Add('7400');
    aList.Add('970');
  end;

  procedure Sparc;
  begin
    aList.Add('SPARC V7');
    aList.Add('SPARC V8');
    aList.Add('SPARC V9');
  end;

  procedure Mips;
  begin
    aList.Add('mips1');
    aList.Add('mips2');
    aList.Add('mips3');
    aList.Add('mips4');
    aList.Add('mips5');
    aList.Add('mips32');
    aList.Add('mips32r2');
  end;
  
  procedure AVR;
  begin
    aList.Add('AVR1');
    aList.Add('AVR2');
    aList.Add('AVR25');
    aList.Add('AVR3');
    aList.Add('AVR31');
    aList.Add('AVR35');
    aList.Add('AVR4');
    aList.Add('AVR5');
    aList.Add('AVR51');
    aList.Add('AVR6');
  end;

begin
  case TargetCPU of
    'arm'    : Arm;
    'avr'    : AVR;
    'i386'   : Intel_i386;
    'm68k'   : ;
    'powerpc': PowerPC;
    'sparc'  : Sparc;
    'x86_64' : Intel_x86_64;
    'mipsel','mips' : Mips;
    'jvm'    : ;
    'a64'    : ;
  end;
end;

function GetFPCTargetOS(TargetOS: string): string;
begin
  Result:=lowercase(TargetOS);
end;

function GetFPCTargetCPU(TargetCPU: string): string;
begin
  Result:=LowerCase(TargetCPU);
end;

function IsFPCExecutable(AFilename: string; out ErrorMsg: string): boolean;
var
  ShortFilename: String;
begin
  Result:=false;
  AFilename:=ResolveDots(aFilename);
  //debugln(['IsFPCExecutable ',AFilename]);
  //debugln(['IsFPCompiler START ',aFilename]);
  if aFilename='' then begin
    ErrorMsg:='missing file name';
    exit;
  end;
  if not FilenameIsAbsolute(AFilename) then begin
    ErrorMsg:='file missing path';
    exit;
  end;
  if not FileExistsCached(AFilename) then begin
    ErrorMsg:='file not found';
    exit;
  end;
  if DirPathExistsCached(AFilename) then begin
    ErrorMsg:='file is a directory';
    exit;
  end;
  if not FileIsExecutableCached(AFilename) then begin
    ErrorMsg:='file is not executable';
    exit;
  end;
  ErrorMsg:='';

  // allow scripts like fpc.sh and fpc.bat
  ShortFilename:=ExtractFileNameOnly(AFilename);
  //debugln(['IsFPCompiler Short=',ShortFilename]);
  if CompareFilenames(ShortFilename,'fpc')=0 then
    exit(true);

  // allow ppcxxx.exe
  if (CompareFilenames(copy(ShortFilename,1,3),'ppc')=0)
  and ((ExeExt='') or (LazFileUtils.CompareFileExt(AFilename,ExeExt)=0))
  then
    exit(true);

  ErrorMsg:='unknown file name';
end;

function CreateDefinesInDirectories(const SourcePaths, FlagName: string
  ): TDefineTemplate;
var
  StartPos: Integer;
  EndPos: LongInt;
  CurDirectory: String;
  DirsTempl: TDefineTemplate;
  DirTempl: TDefineTemplate;
  SetFlagTempl: TDefineTemplate;
begin
  // create a block template for the directories
  DirsTempl:=TDefineTemplate.Create(FlagName,
    'Block of directories to set '+FlagName,
    '','',da_Block);

  // create a define flag for every directory
  StartPos:=1;
  while StartPos<=length(SourcePaths) do begin
    EndPos:=StartPos;
    while (EndPos<=length(SourcePaths)) and (SourcePaths[EndPos]<>';') do
      inc(EndPos);
    if EndPos>StartPos then begin
      CurDirectory:=copy(SourcePaths,StartPos,EndPos-StartPos);
      DirTempl:=TDefineTemplate.Create('FlagDirectory','FlagDirectory',
        '',CurDirectory,da_Directory);
      SetFlagTempl:=TDefineTemplate.Create(FlagName,FlagName,
        FlagName,'1',da_Define);
      DirTempl.AddChild(SetFlagTempl);
      DirsTempl.AddChild(DirTempl);
    end;
    StartPos:=EndPos+1;
  end;
  
  Result:=DirsTempl;
end;

procedure InitDefaultFPCSourceRules;
begin
  DefaultFPCSourceRules:=TFPCSourceRules.Create;
  with DefaultFPCSourceRules do begin
    // put into an include file for easy edit via an editor
    {$I fpcsrcrules.inc}
  end;
end;

{ TDefineTemplate }

procedure TDefineTemplate.MarkFlags(
  const MustFlags, NotFlags: TDefineTemplateFlags;
  WithSiblings, WithChilds: boolean);
var
  ANode: TDefineTemplate;
begin
  ANode:=Self;
  while ANode<>nil do begin
    ANode.FMarked:=ANode.FMarked
                   or (((ANode.Flags*MustFlags)=MustFlags)
                   and (ANode.Flags*NotFlags=[]));
    if (ANode.FirstChild<>nil) and WithChilds then
      ANode.FirstChild.MarkFlags(MustFlags,NotFlags,true,true);
    if not WithSiblings then break;
    ANode:=ANode.Next;
  end;
end;

procedure TDefineTemplate.MarkOwnedBy(TheOwner: TObject;
  const MustFlags, NotFlags: TDefineTemplateFlags;
  WithSiblings, WithChilds: boolean);
var
  ANode: TDefineTemplate;
begin
  ANode:=Self;
  while ANode<>nil do begin
    ANode.FMarked:=ANode.FMarked
                   or ((ANode.Owner=TheOwner)
                       and ((ANode.Flags*MustFlags)=MustFlags)
                       and (ANode.Flags*NotFlags=[]));
    if (ANode.FirstChild<>nil) and WithChilds then
      ANode.FirstChild.MarkOwnedBy(TheOwner,MustFlags,NotFlags,true,true);
    if not WithSiblings then break;
    ANode:=ANode.Next;
  end;
end;

procedure TDefineTemplate.MarkNodes(WithSiblings, WithChilds: boolean);
var
  ANode: TDefineTemplate;
begin
  ANode:=Self;
  while ANode<>nil do begin
    ANode.FMarked:=true;
    if (ANode.FirstChild<>nil) and WithChilds then
      ANode.FirstChild.MarkNodes(true,true);
    if not WithSiblings then break;
    ANode:=ANode.Next;
  end;
end;

procedure TDefineTemplate.ReverseMarks(WithSiblings, WithChilds: boolean);
var
  ANode: TDefineTemplate;
begin
  ANode:=Self;
  while ANode<>nil do begin
    ANode.FMarked:=not ANode.FMarked;
    if (ANode.FirstChild<>nil) and WithChilds then
      ANode.FirstChild.MarkNodes(true,true);
    if not WithSiblings then break;
    ANode:=ANode.Next;
  end;
end;

procedure TDefineTemplate.InheritMarks(WithSiblings, WithChilds, Down,
  Up: boolean);
var
  ANode: TDefineTemplate;
  ChildNode: TDefineTemplate;
begin
  ANode:=Self;
  while ANode<>nil do begin
    if WithChilds then begin
      ChildNode:=ANode.FirstChild;
      while ChildNode<>nil do begin
        if Down and ANode.FMarked then
          ChildNode.FMarked:=true;
        ChildNode.InheritMarks(false,true,Down,Up);
        if Up and ChildNode.FMarked then
          ANode.FMarked:=true;
        ChildNode:=ChildNode.Next;
      end;
    end;
    if not WithSiblings then break;
    ANode:=ANode.Next;
  end;
end;

procedure TDefineTemplate.UnmarkNodes(WithSiblings, WithChilds: boolean);
var
  ANode: TDefineTemplate;
begin
  ANode:=Self;
  while ANode<>nil do begin
    ANode.FMarked:=false;
    if (ANode.FirstChild<>nil) and WithChilds then
      ANode.FirstChild.UnmarkNodes(true,true);
    if not WithSiblings then break;
    ANode:=ANode.Next;
  end;
end;

procedure TDefineTemplate.RemoveMarked(WithSiblings: boolean;
  var FirstDefTemplate: TDefineTemplate);
var ANode, NextNode: TDefineTemplate;
begin
  ANode:=Self;
  while ANode<>nil do begin
    NextNode:=ANode.Next;
    if ANode.FirstChild<>nil then begin
      ANode.FirstChild.RemoveMarked(true,FirstDefTemplate);
    end;
    if ANode.FMarked and (ANode.FirstChild=nil) then begin
      if ANode=FirstDefTemplate then FirstDefTemplate:=ANode.Next;
      ANode.Unbind;
      ANode.Free;
    end;
    if not WithSiblings then break;
    ANode:=NextNode;
  end;
end;

procedure TDefineTemplate.RemoveOwner(TheOwner: TObject; WithSiblings: boolean);
var
  ANode: TDefineTemplate;
begin
  ANode:=Self;
  while ANode<>nil do begin
    if ANode.FFirstChild<>nil then
      ANode.FFirstChild.RemoveOwner(TheOwner,true);
    if ANode.Owner=TheOwner then ANode.Owner:=nil;
    if not WithSiblings then break;
    ANode:=ANode.Next;
  end;
end;

procedure TDefineTemplate.RemoveLeaves(TheOwner: TObject; const MustFlags,
  NotFlags: TDefineTemplateFlags; WithSiblings: boolean;
  var FirstDefTemplate: TDefineTemplate);
var ANode, NextNode: TDefineTemplate;
begin
  ANode:=Self;
  while ANode<>nil do begin
    NextNode:=ANode.Next;
    if ANode.FirstChild<>nil then
      ANode.FirstChild.RemoveLeaves(TheOwner,MustFlags,NotFlags,true,
                                    FirstDefTemplate);
    if ANode.FirstChild=nil then begin
      // this is a leaf
      if ((ANode.Owner=TheOwner)
      and ((ANode.Flags*MustFlags)=MustFlags)
      and (ANode.Flags*NotFlags=[]))
      then begin
        if ANode=FirstDefTemplate then
          FirstDefTemplate:=ANode.Next;
        ANode.Unbind;
        ANode.Free;
      end;
    end;
    if not WithSiblings then break;
    ANode:=NextNode;
  end;
end;

procedure TDefineTemplate.AddChild(ADefineTemplate: TDefineTemplate);
// add as last child
begin
  if ADefineTemplate=nil then exit;
  if ADefineTemplate.Parent<>nil then
    raise Exception.Create('TDefineTemplate.AddChild');
  if LastChild=nil then begin
    while ADefineTemplate<>nil do begin
      ADefineTemplate.fParent:=Self;
      if ADefineTemplate.Prior=nil then FFirstChild:=ADefineTemplate;
      if ADefineTemplate.Next=nil then FLastChild:=ADefineTemplate;
      inc(FChildCount);
      ADefineTemplate:=ADefineTemplate.Next;
    end;
  end else begin
    ADefineTemplate.InsertBehind(LastChild);
  end;
end;

procedure TDefineTemplate.ReplaceChild(ADefineTemplate: TDefineTemplate);
var
  OldTempl: TDefineTemplate;
begin
  OldTempl:=FindChildByName(ADefineTemplate.Name);
  if OldTempl<>nil then begin
    ADefineTemplate.InsertInFront(OldTempl);
    OldTempl.UnBind;
    OldTempl.Free;
  end else
    AddChild(ADefineTemplate);
end;

function TDefineTemplate.DeleteChild(const AName: string): boolean;
var
  OldTempl: TDefineTemplate;
begin
  OldTempl:=FindChildByName(AName);
  if OldTempl<>nil then begin
    Result:=true;
    OldTempl.Unbind;
    OldTempl.Free;
  end else
    Result:=false;
end;

procedure TDefineTemplate.InsertBehind(APrior: TDefineTemplate);
// insert this and all next siblings behind APrior
var ANode, LastSibling, NewParent: TDefineTemplate;
begin
  if APrior=nil then exit;
  NewParent:=APrior.Parent;
  if Parent<>nil then begin
    ANode:=Self;
    while ANode<>nil do begin
      if ANode=APrior then
        raise Exception.Create('internal error: '
          +'TDefineTemplate.InsertBehind: APrior=ANode');
      dec(Parent.FChildCount);
      ANode.FParent:=nil;
      ANode:=ANode.Next;
    end;
  end;
  LastSibling:=Self;
  while LastSibling.Next<>nil do LastSibling:=LastSibling.Next;
  FParent:=NewParent;
  if Parent<>nil then begin
    ANode:=Self;
    while (ANode<>nil) do begin
      ANode.FParent:=Parent;
      inc(Parent.FChildCount);
      ANode:=ANode.Next;
    end;
    if Parent.LastChild=APrior then Parent.FLastChild:=LastSibling;
  end;
  FPrior:=APrior;
  LastSibling.FNext:=APrior.Next;
  APrior.FNext:=Self;
  if LastSibling.Next<>nil then LastSibling.Next.FPrior:=LastSibling;
end;

procedure TDefineTemplate.InsertInFront(ANext: TDefineTemplate);
// insert this and all next siblings in front of ANext
var ANode, LastSibling: TDefineTemplate;
begin
  if ANext=nil then exit;
  if FParent<>nil then begin
    ANode:=Self;
    while ANode<>nil do begin
      if ANode=ANext then
        raise Exception.Create('internal error: '
          +'TDefineTemplate.InsertInFront: ANext=ANode');
      dec(FParent.FChildCount);
      ANode.FParent:=nil;
      ANode:=ANode.Next;
    end;
  end;
  LastSibling:=Self;
  while LastSibling.Next<>nil do LastSibling:=LastSibling.Next;
  FParent:=ANext.Parent;
  if Parent<>nil then begin
    ANode:=Self;
    while ANode<>nil do begin
      ANode.FParent:=Parent;
      inc(Parent.FChildCount);
      ANode:=ANode.Next;
    end;
    if Parent.FirstChild=ANext then Parent.FFirstChild:=Self;
  end;
  FPrior:=ANext.Prior;
  if Prior<>nil then Prior.FNext:=Self;
  LastSibling.FNext:=ANext;
  ANext.FPrior:=LastSibling;
end;

procedure TDefineTemplate.MoveToLast(Child: TDefineTemplate);
var
  Node: TDefineTemplate;
begin
  if Child.Next=nil then exit;
  Node:=Child.Next;
  while Node.Next<>nil do Node:=Node.Next;
  Child.Unbind;
  Child.InsertBehind(Node);
end;

procedure TDefineTemplate.Assign(ADefineTemplate: TDefineTemplate;
  WithSubNodes, WithNextSiblings, ClearOldSiblings: boolean);
var ChildTemplate, CopyTemplate, NextTemplate: TDefineTemplate;
begin
  Clear(ClearOldSiblings);
  if ADefineTemplate=nil then exit;
  AssignValues(ADefineTemplate);
  if WithSubNodes then begin
    ChildTemplate:=ADefineTemplate.FirstChild;
    if ChildTemplate<>nil then begin
      CopyTemplate:=TDefineTemplate.Create;
      AddChild(CopyTemplate);
      CopyTemplate.Assign(ChildTemplate,true,true,false);
    end;
  end;
  if WithNextSiblings then begin
    NextTemplate:=ADefineTemplate.Next;
    if NextTemplate<>nil then begin
      CopyTemplate:=TDefineTemplate.Create;
      CopyTemplate.InsertBehind(Self);
      CopyTemplate.Assign(NextTemplate,WithSubNodes,true,false);
    end;
  end;
end;

procedure TDefineTemplate.AssignValues(ADefineTemplate: TDefineTemplate);
begin
  Name:=ADefineTemplate.Name;
  Description:=ADefineTemplate.Description;
  Variable:=ADefineTemplate.Variable;
  Value:=ADefineTemplate.Value;
  Action:=ADefineTemplate.Action;
  Flags:=ADefineTemplate.Flags;
  MergeNameInFront:=ADefineTemplate.MergeNameInFront;
  MergeNameBehind:=ADefineTemplate.MergeNameBehind;
  Owner:=ADefineTemplate.Owner;
end;

procedure TDefineTemplate.Unbind;
begin
  if FPrior<>nil then FPrior.FNext:=FNext;
  if FNext<>nil then FNext.FPrior:=FPrior;
  if FParent<>nil then begin
    if FParent.FFirstChild=Self then FParent.FFirstChild:=FNext;
    if FParent.FLastChild=Self then FParent.FLastChild:=FPrior;
    dec(FParent.FChildCount);
  end;
  FNext:=nil;
  FPrior:=nil;
  FParent:=nil;
end;

procedure TDefineTemplate.Clear(WithSiblings: boolean);
begin
  while FFirstChild<>nil do FFirstChild.Free;
  if WithSiblings then
    while FNext<>nil do FNext.Free;
  Name:='';
  Description:='';
  Value:='';
  Variable:='';
  Flags:=[];
end;

constructor TDefineTemplate.Create;
begin
  inherited Create;
end;

constructor TDefineTemplate.Create(const AName, ADescription, AVariable,
  AValue: string; AnAction: TDefineAction);
begin
  inherited Create;
  Name:=AName;
  Description:=ADescription;
  Variable:=AVariable;
  Value:=AValue;
  Action:=AnAction;
end;

function TDefineTemplate.CreateCopy(OnlyMarked: boolean;
  WithSiblings: boolean; WithChilds: boolean): TDefineTemplate;
var LastNewNode, NewNode, ANode: TDefineTemplate;
begin
  Result:=nil;
  LastNewNode:=nil;
  ANode:=Self;
  while ANode<>nil do begin
    if (not OnlyMarked) or (ANode.FMarked) then begin
      // copy node
      NewNode:=TDefineTemplate.Create;
      NewNode.Assign(ANode,false,false,false);
      if LastNewNode<>nil then
        NewNode.InsertBehind(LastNewNode)
      else
        Result:=NewNode;
      LastNewNode:=NewNode;
      // copy children
      if WithChilds and (ANode.FirstChild<>nil) then begin
        NewNode:=ANode.FirstChild.CreateCopy(OnlyMarked,true,true);
        if NewNode<>nil then
          LastNewNode.AddChild(NewNode);
      end;
    end;
    if not WithSiblings then break;
    ANode:=ANode.Next;
  end;
end;

function TDefineTemplate.CreateMergeCopy: TDefineTemplate;
begin
  CreateMergeInfo(false,false);
  Result:=TDefineTemplate.Create;
  Result.Assign(Self,true,false,false);
end;

function TDefineTemplate.FindRoot: TDefineTemplate;
begin
  Result:=Self;
  repeat
    if Result.Parent<>nil then
      Result:=Result.Parent
    else if Result.Prior<>nil then
      Result:=Result.Prior
    else
      break;
  until false;
end;

destructor TDefineTemplate.Destroy;
begin
  Clear(false);
  Unbind;
  inherited Destroy;
end;

function TDefineTemplate.LoadFromXMLConfig(XMLConfig: TXMLConfig;
  const Path: string; ClearOldSiblings, WithMergeInfo: boolean): boolean;
var IndexedPath: string;
  i, LvlCount: integer;
  DefTempl, LastDefTempl: TDefineTemplate;
  NewChild: TDefineTemplate;
begin
  Clear(ClearOldSiblings);
  LvlCount:=XMLConfig.GetValue(Path+'Count/Value',0);
  DefTempl:=nil;
  for i:=1 to LvlCount do begin
    if i=1 then begin
      DefTempl:=Self;
      LastDefTempl:=Prior;
    end else begin
      LastDefTempl:=DefTempl;
      DefTempl:=TDefineTemplate.Create;
      DefTempl.InsertBehind(LastDefTempl);
    end;
    IndexedPath:=Path+'Node'+IntToStr(i)+'/';
    DefTempl.LoadValuesFromXMLConfig(XMLConfig,IndexedPath,WithMergeInfo);
    // load children
    if XMLConfig.GetValue(IndexedPath+'Count/Value',0)>0 then begin
      NewChild:=TDefineTemplate.Create;
      DefTempl.AddChild(NewChild);
      if not NewChild.LoadFromXMLConfig(XMLConfig,IndexedPath,
                                        false,WithMergeInfo) then
      begin
        Result:=false;  exit;
      end;
    end;
  end;
  Result:=true;
end;

procedure TDefineTemplate.LoadValuesFromXMLConfig(XMLConfig: TXMLConfig;
  const Path: string; WithMergeInfo: boolean);
var f: TDefineTemplateFlag;
begin
  Name:=XMLConfig.GetValue(Path+'Name/Value','no name');
  Description:=XMLConfig.GetValue(Path+'Description/Value','');
  Value:=XMLConfig.GetValue(Path+'Value/Value','');
  Variable:=XMLConfig.GetValue(Path+'Variable/Value','');
  Action:=DefineActionNameToAction(
                         XMLConfig.GetValue(Path+'Action/Value',''));
  Flags:=[];
  for f:=Low(TDefineTemplateFlag) to High(TDefineTemplateFlag) do begin
    if (f<>dtfAutoGenerated)
    and (XMLConfig.GetValue(Path+'Flags/'+DefineTemplateFlagNames[f],false))
    then
      Include(Flags,f);
  end;
  if WithMergeInfo then begin
    MergeNameInFront:=XMLConfig.GetValue(Path+'MergeNameInFront/Value','');
    MergeNameBehind:=XMLConfig.GetValue(Path+'MergeNameInFront/Value','');
  end else begin
    MergeNameInFront:='';
    MergeNameBehind:='';
  end;
end;

procedure TDefineTemplate.SaveValuesToXMLConfig(XMLConfig: TXMLConfig;
  const Path: string; WithMergeInfo: boolean);
var
  f: TDefineTemplateFlag;
begin
  XMLConfig.SetDeleteValue(Path+'Name/Value',Name,'');
  XMLConfig.SetDeleteValue(Path+'Description/Value',Description,'');
  XMLConfig.SetDeleteValue(Path+'Value/Value',Value,'');
  XMLConfig.SetDeleteValue(Path+'Variable/Value',Variable,'');
  XMLConfig.SetDeleteValue(Path+'Action/Value',
                           DefineActionNames[Action],
                           DefineActionNames[da_None]);
  for f:=Low(TDefineTemplateFlag) to High(TDefineTemplateFlag) do begin
    if (f<>dtfAutoGenerated) then
      XMLConfig.SetDeleteValue(
         Path+'Flags/'+DefineTemplateFlagNames[f]
         ,f in Flags,false);
  end;
  if WithMergeInfo then begin
    XMLConfig.SetDeleteValue(Path+'MergeNameInFront/Value',
                             MergeNameInFront,'');
    XMLConfig.SetDeleteValue(Path+'MergeNameBehind/Value',
                             MergeNameBehind,'');
  end else begin
    XMLConfig.SetDeleteValue(Path+'MergeNameInFront/Value','','');
    XMLConfig.SetDeleteValue(Path+'MergeNameBehind/Value','','');
  end;
end;

procedure TDefineTemplate.SaveToXMLConfig(XMLConfig: TXMLConfig;
  const Path: string;
  WithSiblings, OnlyMarked, WithMergeInfo, UpdateMergeInfo: boolean);
var IndexedPath: string;
  Index, LvlCount: integer;
  DefTempl: TDefineTemplate;
begin
  if UpdateMergeInfo then CreateMergeInfo(WithSiblings,OnlyMarked);
  DefTempl:=Self;
  LvlCount:=0;
  while DefTempl<>nil do begin
    inc(LvlCount);
    DefTempl:=DefTempl.Next;
  end;
  DefTempl:=Self;
  Index:=0;
  repeat
    if (DefTempl.FMarked) or (not OnlyMarked) then begin
      // save node
      inc(Index);
      IndexedPath:=Path+'Node'+IntToStr(Index)+'/';
      DefTempl.SaveValuesToXMLConfig(XMLConfig,IndexedPath,WithMergeInfo);
      // save children
      if DefTempl.FFirstChild<>nil then
        DefTempl.FirstChild.SaveToXMLConfig(XMLConfig,IndexedPath,
                                   true,OnlyMarked,
                                   WithMergeInfo,false)
      else
        XMLConfig.SetDeleteValue(IndexedPath+'Count/Value',0,0);
    end;
    if not WithSiblings then break;
    DefTempl:=DefTempl.Next;
  until DefTempl=nil;
  XMLConfig.SetDeleteValue(Path+'Count/Value',Index,0);
end;

procedure TDefineTemplate.CreateMergeInfo(WithSiblings, OnlyMarked: boolean);
var
  DefTempl: TDefineTemplate;
begin
  DefTempl:=Self;
  repeat
    if (DefTempl.FMarked) or (not OnlyMarked) then begin
      if DefTempl.Prior<>nil then
        DefTempl.MergeNameInFront:=DefTempl.Prior.Name
      else
        DefTempl.MergeNameInFront:='';
      if DefTempl.Next<>nil then
        DefTempl.MergeNameBehind:=DefTempl.Next.Name
      else
        DefTempl.MergeNameBehind:='';
      // update children
      if DefTempl.FFirstChild<>nil then
        DefTempl.FirstChild.CreateMergeInfo(true,OnlyMarked);
    end;
    if not WithSiblings then break;
    DefTempl:=DefTempl.Next;
  until DefTempl=nil;
end;

class procedure TDefineTemplate.MergeXMLConfig(ParentDefTempl: TDefineTemplate;
  var FirstSibling, LastSibling: TDefineTemplate;
  XMLConfig: TXMLConfig; const Path, NewNamePrefix: string);
var
  SrcNode: TDefineTemplate;
begin
  SrcNode:=TDefineTemplate.Create;
  SrcNode.LoadFromXMLConfig(XMLConfig,Path,false,true);
  MergeTemplates(ParentDefTempl,FirstSibling,LastSibling,SrcNode,true,
                 NewNamePrefix);
  SrcNode.Clear(true);
  SrcNode.Free;
end;

class procedure TDefineTemplate.MergeTemplates(ParentDefTempl: TDefineTemplate;
  var FirstSibling, LastSibling: TDefineTemplate;
  SourceTemplate: TDefineTemplate; WithSiblings: boolean;
  const NewNamePrefix: string);
// merge SourceTemplate. This will keep SourceTemplate untouched
var
  NewNode, PosNode: TDefineTemplate;
  Inserted: boolean;
  SrcNode: TDefineTemplate;
begin
  SrcNode:=SourceTemplate;
  while SrcNode<>nil do begin
    // merge all source nodes
    NewNode:=SrcNode.CreateCopy(false,false,false);
    Inserted:=false;
    if NewNode.Name<>'' then begin
      // node has a name -> test if already exists
      PosNode:=FirstSibling;
      while (PosNode<>nil)
      and (CompareText(PosNode.Name,NewNode.Name)<>0) do
        PosNode:=PosNode.Next;
      if PosNode<>nil then begin
        // node with same name already exists -> check if it is a copy
        if NewNode.IsEqual(PosNode,false,false) then begin
          // node already exists
          NewNode.Free;
          NewNode:=PosNode;
        end else begin
          // node has same name, but different values
          // -> rename node
          NewNode.Name:=NewNode.FindUniqueName(NewNamePrefix+NewNode.Name);
          // insert behind PosNode
          NewNode.InsertBehind(PosNode);
        end;
        Inserted:=true;
      end;
    end;
    if not Inserted then begin
      // node name is unique or empty -> insert node
      if NewNode.MergeNameInFront<>'' then begin
        // last time, node was inserted behind MergeNameInFront
        // -> search MergeNameInFront
        PosNode:=LastSibling;
        while (PosNode<>nil)
        and (CompareText(PosNode.Name,NewNode.MergeNameInFront)<>0) do
          PosNode:=PosNode.Prior;
        if PosNode<>nil then begin
          // MergeNameInFront found -> insert behind
          NewNode.InsertBehind(PosNode);
          Inserted:=true;
        end;
      end;
      if not Inserted then begin
        if NewNode.MergeNameBehind<>'' then begin
          // last time, node was inserted in front of MergeNameBehind
          // -> search MergeNameBehind
          PosNode:=FirstSibling;
          while (PosNode<>nil)
          and (CompareText(PosNode.Name,NewNode.MergeNameBehind)<>0) do
            PosNode:=PosNode.Next;
          if PosNode<>nil then begin
            // MergeNameBehind found -> insert in front
            NewNode.InsertInFront(PosNode);
            Inserted:=true;
          end;
        end;
      end;
      if not Inserted then begin
        // no merge position found -> add as last
        if LastSibling<>nil then begin
          NewNode.InsertBehind(LastSibling);
        end else if ParentDefTempl<>nil then begin
          ParentDefTempl.AddChild(NewNode);
        end;
      end;
    end;
    // NewNode is now inserted -> update FirstSibling and LastSibling
    if FirstSibling=nil then begin
      FirstSibling:=NewNode;
      LastSibling:=NewNode;
    end;
    while FirstSibling.Prior<>nil do
      FirstSibling:=FirstSibling.Prior;
    while LastSibling.Next<>nil do
      LastSibling:=LastSibling.Next;
    // merge children
    MergeTemplates(NewNode,NewNode.FFirstChild,NewNode.FLastChild,
                   SrcNode.FirstChild,true,NewNamePrefix);
    if not WithSiblings then break;
    SrcNode:=SrcNode.Next;
  end;
end;

procedure TDefineTemplate.ConsistencyCheck;
var RealChildCount: integer;
  DefTempl: TDefineTemplate;
begin
  RealChildCount:=0;
  DefTempl:=FFirstChild;
  if DefTempl<>nil then begin
    if DefTempl.Prior<>nil then begin
      // not first child
      RaiseCatchableException('');
    end;
    while DefTempl<>nil do begin
      if DefTempl.Parent<>Self then begin
        DebugLn('  C: DefTempl.Parent<>Self: ',Name,',',DefTempl.Name);
        RaiseCatchableException('');
      end;
      if (DefTempl.Next<>nil) and (DefTempl.Next.Prior<>DefTempl) then
        RaiseCatchableException('');
      if (DefTempl.Prior<>nil) and (DefTempl.Prior.Next<>DefTempl) then
        RaiseCatchableException('');
      DefTempl.ConsistencyCheck;
      DefTempl:=DefTempl.Next;
      inc(RealChildCount);
    end;
  end;
  if (Parent<>nil) then begin
    if (Prior=nil) and (Parent.FirstChild<>Self) then
      RaiseCatchableException('');
    if (Next=nil) and (Parent.LastChild<>Self) then
      RaiseCatchableException('');
  end;
  if RealChildCount<>FChildCount then
    RaiseCatchableException('');
end;

procedure TDefineTemplate.CalcMemSize(Stats: TCTMemStats);
var
  Child: TDefineTemplate;
begin
  Stats.Add('TDefineTemplate Instance Count',1);
  Stats.Add('TDefineTemplate',
    PtrUInt(InstanceSize)
    +MemSizeString(FMergeNameBehind)
    +MemSizeString(FMergeNameInFront)
    +MemSizeString(Name)
    +MemSizeString(Description)
    +MemSizeString(Variable)
    +MemSizeString(Value)
    +MemSizeString(Value)
    );
  Child:=FFirstChild;
  while Child<>nil do begin
    Child.CalcMemSize(Stats);
    Child:=Child.Next;
  end;
end;

procedure TDefineTemplate.SetDefineOwner(NewOwner: TObject;
  WithSiblings: boolean);
var
  ANode: TDefineTemplate;
begin
  ANode:=Self;
  while ANode<>nil do begin
    ANode.Owner:=NewOwner;
    if ANode.FFirstChild<>nil then
      ANode.FFirstChild.SetDefineOwner(NewOwner,true);
    if not WithSiblings then exit;
    ANode:=ANode.Next;
  end;
end;

procedure TDefineTemplate.SetFlags(AddFlags, SubFlags: TDefineTemplateFlags;
  WithSiblings: boolean);
var
  ANode: TDefineTemplate;
begin
  ANode:=Self;
  while ANode<>nil do begin
    ANode.Flags:=ANode.Flags+AddFlags-SubFlags;
    if ANode.FFirstChild<>nil then
      ANode.FFirstChild.SetFlags(AddFlags,SubFlags,true);
    if not WithSiblings then exit;
    ANode:=ANode.Next;
  end;
end;

procedure TDefineTemplate.WriteDebugReport(OnlyMarked: boolean);

  procedure WriteNode(ANode: TDefineTemplate; const Prefix: string);
  var ActionStr: string;
  begin
    if ANode=nil then exit;
    if (not OnlyMarked) or (ANode.Marked) then begin
      ActionStr:=DefineActionNames[ANode.Action];
      DebugLn(Prefix+'Self='+DbgS(ANode),
        ' Name="'+ANode.Name,'"',
        ' Next='+DbgS(ANode.Next),
        ' Prior='+DbgS(ANode.Prior),
        ' Action='+ActionStr,
        ' Flags=['+DefineTemplateFlagsToString(ANode.Flags),']',
        ' Marked='+dbgs(ANode.Marked)
        );
      DebugLn(Prefix+'   + Description="',ANode.Description,'"');
      DebugLn(Prefix+'   + Variable="',ANode.Variable,'"');
      DebugLn(Prefix+'   + Value="',ANode.Value,'"');
    end;
    WriteNode(ANode.FirstChild,Prefix+'  ');
    WriteNode(ANode.Next,Prefix);
  end;

begin
  WriteNode(Self,'  ');
end;

function TDefineTemplate.GetNext: TDefineTemplate;
begin
  if FirstChild<>nil then
    exit(FirstChild);
  Result:=GetNextSkipChildren;
end;

function TDefineTemplate.GetNextSkipChildren: TDefineTemplate;
begin
  Result:=Self;
  while (Result<>nil) do begin
    if Result.Next<>nil then begin
      Result:=Result.Next;
      exit;
    end;
    Result:=Result.Parent;
  end;
end;

function TDefineTemplate.HasDefines(OnlyMarked, WithSiblings: boolean): boolean;
var
  CurTempl: TDefineTemplate;
begin
  Result:=true;
  CurTempl:=Self;
  while CurTempl<>nil do begin
    if ((not OnlyMarked) or (CurTempl.FMarked))
    and (CurTempl.Action in DefineActionDefines) then exit;
    // go to next
    if CurTempl.FFirstChild<>nil then
      CurTempl:=CurTempl.FFirstChild
    else if (CurTempl.FNext<>nil)
    and (WithSiblings or (CurTempl.Parent<>Parent)) then
      CurTempl:=CurTempl.FNext
    else begin
      // search uncle
      repeat
        CurTempl:=CurTempl.Parent;
        if (CurTempl=Parent)
        or ((CurTempl.Parent=Parent) and not WithSiblings) then begin
          Result:=false;
          exit;
        end;
      until (CurTempl.FNext<>nil);
      CurTempl:=CurTempl.FNext;
    end;
  end;
  Result:=false;
end;

function TDefineTemplate.IsEqual(ADefineTemplate: TDefineTemplate;
  CheckSubNodes, CheckNextSiblings: boolean): boolean;
var SrcNode, DestNode: TDefineTemplate;
begin
  Result:=(ADefineTemplate<>nil)
      and (Name=ADefineTemplate.Name)
      and (Description=ADefineTemplate.Description)
      and (Variable=ADefineTemplate.Variable)
      and (Value=ADefineTemplate.Value)
      and (Action=ADefineTemplate.Action)
      and (Flags=ADefineTemplate.Flags)
      and (Owner=ADefineTemplate.Owner);
  if not Result then begin
    exit;
  end;
  if CheckSubNodes then begin
    if (ChildCount<>ADefineTemplate.ChildCount) then begin
      Result:=false;
      exit;
    end;
    SrcNode:=FirstChild;
    DestNode:=ADefineTemplate.FirstChild;
    if SrcNode<>nil then begin
      Result:=SrcNode.IsEqual(DestNode,CheckSubNodes,true);
      if not Result then exit;
    end;
  end;
  if CheckNextSiblings then begin
    SrcNode:=Next;
    DestNode:=ADefineTemplate.Next;
    while (SrcNode<>nil) and (DestNode<>nil) do begin
      Result:=SrcNode.IsEqual(DestNode,CheckSubNodes,false);
      if not Result then exit;
      SrcNode:=SrcNode.Next;
      DestNode:=DestNode.Next;
    end;
    Result:=(SrcNode=nil) and (DestNode=nil);
    if not Result then begin
      //DebugLn('TDefineTemplate.IsEqual DIFF 3 ',Name,' ',
      //  ADefineTemplate.Name,' ',dbgs(ChildCount),' ',dbgs(ADefineTemplate.ChildCount));
    end;
  end;
end;

function TDefineTemplate.IsAutoGenerated: boolean;
begin
  Result:=SelfOrParentContainsFlag(dtfAutoGenerated);
end;

procedure TDefineTemplate.RemoveFlags(TheFlags: TDefineTemplateFlags);
var ANode: TDefineTemplate;
begin
  ANode:=Self;
  while ANode<>nil do begin
    Flags:=Flags-TheFlags;
    if FirstChild<>nil then FirstChild.RemoveFlags(TheFlags);
    ANode:=ANode.Next;
  end;
end;

function TDefineTemplate.Level: integer;
var ANode: TDefineTemplate;
begin
  Result:=-1;
  ANode:=Self;
  while ANode<>nil do begin
    inc(Result);
    ANode:=ANode.Parent;
  end;
end;

function TDefineTemplate.GetFirstSibling: TDefineTemplate;
begin
  Result:=Self;
  while Result.Prior<>nil do Result:=Result.Prior;
end;

function TDefineTemplate.SelfOrParentContainsFlag(
  AFlag: TDefineTemplateFlag): boolean;
var Node: TDefineTemplate;
begin
  Node:=Self;
  while (Node<>nil) do begin
    if AFlag in Node.Flags then begin
      Result:=true;
      exit;
    end;
    Node:=Node.Parent;
  end;
  Result:=false;
end;

function TDefineTemplate.FindChildByName(const AName: string): TDefineTemplate;
begin
  if FirstChild<>nil then begin
    Result:=FirstChild.FindByName(AName,false,true)
  end else
    Result:=nil;
end;

function TDefineTemplate.FindByName(const AName: string; WithSubChilds,
  WithNextSiblings: boolean): TDefineTemplate;
var ANode: TDefineTemplate;
begin
  if CompareText(AName,Name)=0 then begin
    Result:=Self;
  end else begin
    if WithSubChilds and (FirstChild<>nil) then
      Result:=FirstChild.FindByName(AName,true,true)
    else
      Result:=nil;
    if (Result=nil) and WithNextSiblings then begin
      ANode:=Next;
      while (ANode<>nil) do begin
        Result:=ANode.FindByName(AName,WithSubChilds,false);
        if Result<>nil then break;
        ANode:=ANode.Next;
      end;
    end;
  end;
end;

function TDefineTemplate.FindUniqueName(const Prefix: string): string;
var Root: TDefineTemplate;
  i: integer;
begin
  Root:=FindRoot;
  i:=0;
  repeat
    inc(i);
    Result:=Prefix+IntToStr(i);
  until Root.FindByName(Result,true,true)=nil;
end;


{ TDirectoryDefines }

constructor TDirectoryDefines.Create;
begin
  inherited Create;
  Values:=TExpressionEvaluator.Create;
  Path:='';
end;

destructor TDirectoryDefines.Destroy;
begin
  Values.Free;
  inherited Destroy;
end;

procedure TDirectoryDefines.CalcMemSize(Stats: TCTMemStats);
begin
  Stats.Add('TDirectoryDefines',PtrUInt(InstanceSize)
    +MemSizeString(Path));
  if Values<>nil then
    Stats.Add('TDirectoryDefines.Values',Values.CalcMemSize(false,nil));
end;


{ TDefineTree }

procedure TDefineTree.Clear;
begin
  if FFirstDefineTemplate<>nil then begin
    FFirstDefineTemplate.Clear(true);
    FFirstDefineTemplate.Free;
    FFirstDefineTemplate:=nil;
  end;
  ClearCache;
end;

function TDefineTree.IsEqual(SrcDefineTree: TDefineTree): boolean;
begin
  Result:=false;
  if SrcDefineTree=nil then exit;
  if (FFirstDefineTemplate=nil) xor (SrcDefineTree.FFirstDefineTemplate=nil)
  then exit;
  if (FFirstDefineTemplate<>nil)
  and (not FFirstDefineTemplate.IsEqual(
                                  SrcDefineTree.FFirstDefineTemplate,true,true))
  then exit;
  Result:=true;
end;

procedure TDefineTree.Assign(SrcDefineTree: TDefineTree);
begin
  if IsEqual(SrcDefineTree) then exit;
  Clear;
  if SrcDefineTree.FFirstDefineTemplate<>nil then begin
    FFirstDefineTemplate:=TDefineTemplate.Create;
    FFirstDefineTemplate.Assign(SrcDefineTree.FFirstDefineTemplate,
                                true,true,true);
  end;
end;

procedure TDefineTree.AssignNonAutoCreated(SrcDefineTree: TDefineTree);
var
  SrcNonAutoCreated: TDefineTemplate;
begin
  MarkNonAutoCreated;
  RemoveMarked;
  SrcNonAutoCreated:=SrcDefineTree.ExtractNonAutoCreated;
  if SrcNonAutoCreated=nil then exit;
  //DebugLn('TDefineTree.AssignNonAutoCreated A Front=',SrcNonAutoCreated.MergeNameInFront,' Behind=',SrcNonAutoCreated.MergeNameBehind);
  MergeTemplates(SrcNonAutoCreated,'');
  SrcNonAutoCreated.Clear(true);
  SrcNonAutoCreated.Free;
  FFirstDefineTemplate.CreateMergeInfo(true,false);
  //DebugLn('TDefineTree.AssignNonAutoCreated B Front=',FFirstDefineTemplate.MergeNameInFront,' Behind=',FFirstDefineTemplate.MergeNameBehind);
end;

procedure TDefineTree.ClearCache;
begin
  if (FCache.Count=0) and (FVirtualDirCache=nil) then exit;
  DoClearCache;
end;

constructor TDefineTree.Create;
begin
  inherited Create;
  IncreaseChangeStep;
  FFirstDefineTemplate:=nil;
  FCache:=TAVLTree.Create(@CompareDirectoryDefines);
  FDefineStrings:=TStringTree.Create;

  FMacroFunctions:=TKeyWordFunctionList.Create('TDefineTree.Create.MacroFunctions');
  FMacroFunctions.AddExtended('Ext',nil,@MacroFuncExtractFileExt);
  FMacroFunctions.AddExtended('PATH',nil,@MacroFuncExtractFilePath);
  FMacroFunctions.AddExtended('NAME',nil,@MacroFuncExtractFileName);
  FMacroFunctions.AddExtended('NAMEONLY',nil,@MacroFuncExtractFileNameOnly);
  
  FMacroVariables:=TKeyWordFunctionList.Create('TDefineTree.Create.MacroVariables');
end;

destructor TDefineTree.Destroy;
begin
  Clear;
  FMacroVariables.Free;
  FMacroFunctions.Free;
  FCache.Free;
  FreeAndNil(FDefineStrings);
  inherited Destroy;
end;

function TDefineTree.GetLastRootTemplate: TDefineTemplate;
begin
  Result:=FFirstDefineTemplate;
  if Result=nil then exit;
  while Result.Next<>nil do Result:=Result.Next;
end;

function TDefineTree.FindDirectoryInCache(
  const Path: string): TDirectoryDefines;
var cmp: integer;
  ANode: TAVLTreeNode;
begin
  ANode:=FCache.Root;
  while (ANode<>nil) do begin
    cmp:=CompareFilenames(Path,TDirectoryDefines(ANode.Data).Path);
    if cmp<0 then
      ANode:=ANode.Left
    else if cmp>0 then
      ANode:=ANode.Right
    else
      break;
  end;
  if ANode<>nil then
    Result:=TDirectoryDefines(ANode.Data)
  else
    Result:=nil;
end;

function TDefineTree.GetDirDefinesForDirectory(const Path: string;
  WithVirtualDir: boolean): TDirectoryDefines;
var
  ExpPath: String;
begin
  //DebugLn('[TDefineTree.GetDirDefinesForDirectory] "',Path,'"');
  if (Path<>'') or (not WithVirtualDir) then begin
    DoPrepareTree;
    ExpPath:=AppendPathDelim(TrimFilename(Path));
    Result:=FindDirectoryInCache(ExpPath);
    if Result=nil then begin
      Result:=TDirectoryDefines.Create;
      Result.Path:=ExpPath;
      //DebugLn('[TDefineTree.GetDirDefinesForDirectory] B ',ExpPath,' ');
      if Calculate(Result) then begin
        //DebugLn('[TDefineTree.GetDirDefinesForDirectory] C success');
        RemoveDoubles(Result);
        FCache.Add(Result);
      end else begin
        Result.Free;
        Result:=nil;
      end;
    end;
  end else begin
    Result:=GetDirDefinesForVirtualDirectory;
  end;
end;

function TDefineTree.GetDirDefinesForVirtualDirectory: TDirectoryDefines;
begin
  DoPrepareTree;
  if FVirtualDirCache=nil then begin
    //DebugLn('################ TDefineTree.GetDirDefinesForVirtualDirectory');
    FVirtualDirCache:=TDirectoryDefines.Create;
    FVirtualDirCache.Path:=VirtualDirectory;
    if Calculate(FVirtualDirCache) then begin
      //DebugLn('TDefineTree.GetDirDefinesForVirtualDirectory ');
      RemoveDoubles(FVirtualDirCache);
    end else begin
      FVirtualDirCache.Free;
      FVirtualDirCache:=nil;
    end;
  end;
  Result:=FVirtualDirCache;
end;

function TDefineTree.MacroFuncExtractFileExt(Data: Pointer): boolean;
var
  FuncData: PReadFunctionData;
begin
  FuncData:=PReadFunctionData(Data);
  FuncData^.Result:=ExtractFileExt(FuncData^.Param);
  Result:=true;
end;

function TDefineTree.MacroFuncExtractFilePath(Data: Pointer): boolean;
var
  FuncData: PReadFunctionData;
begin
  FuncData:=PReadFunctionData(Data);
  FuncData^.Result:=ExtractFilePath(FuncData^.Param);
  Result:=true;
end;

function TDefineTree.MacroFuncExtractFileName(Data: Pointer): boolean;
var
  FuncData: PReadFunctionData;
begin
  FuncData:=PReadFunctionData(Data);
  FuncData^.Result:=ExtractFileName(FuncData^.Param);
  Result:=true;
end;

function TDefineTree.MacroFuncExtractFileNameOnly(Data: Pointer): boolean;
var
  FuncData: PReadFunctionData;
begin
  FuncData:=PReadFunctionData(Data);
  FuncData^.Result:=ExtractFileNameOnly(FuncData^.Param);
  Result:=true;
end;

procedure TDefineTree.DoClearCache;
begin
  {$IFDEF VerboseDefineCache}
  DebugLn('TDefineTree.DoClearCache A +++++++++');
  {$ENDIF}
  if FCache<>nil then FCache.FreeAndClear;
  if FVirtualDirCache<>nil then begin
    FVirtualDirCache.Free;
    FVirtualDirCache:=nil;
  end;
  IncreaseChangeStep;
  FDefineStrings.Clear;
end;

procedure TDefineTree.DoPrepareTree;
begin
  if Assigned(OnPrepareTree) then OnPrepareTree(Self);
end;

procedure TDefineTree.RemoveMarked;
begin
  if FFirstDefineTemplate=nil then exit;
  FFirstDefineTemplate.RemoveMarked(true,FFirstDefineTemplate);
  ClearCache;
end;

procedure TDefineTree.MarkNonAutoCreated;
begin
  if FFirstDefineTemplate=nil then exit;
  with FFirstDefineTemplate do begin
    // clear marks
    UnmarkNodes(true,true);
    // mark each non autocreated node
    MarkFlags([],[dtfAutoGenerated],true,true);
    // mark every parent with a marked child
    InheritMarks(true,true,false,true);
  end;
end;

function TDefineTree.GetUnitPathForDirectory(const Directory: string): string;
var Evaluator: TExpressionEvaluator;
begin
  Evaluator:=GetDefinesForDirectory(Directory,true);
  if Evaluator<>nil then begin
    Result:=Evaluator.Variables[UnitPathMacroName];
  end else begin
    Result:='';
  end;
end;

function TDefineTree.GetIncludePathForDirectory(const Directory: string
  ): string;
var Evaluator: TExpressionEvaluator;
begin
  Evaluator:=GetDefinesForDirectory(Directory,true);
  if Evaluator<>nil then begin
    Result:=Evaluator.Variables[IncludePathMacroName];
  end else begin
    Result:='';
  end;
end;

function TDefineTree.GetSrcPathForDirectory(const Directory: string): string;
var Evaluator: TExpressionEvaluator;
begin
  Evaluator:=GetDefinesForDirectory(Directory,true);
  if Evaluator<>nil then begin
    Result:=Evaluator.Variables[SrcPathMacroName];
  end else begin
    Result:='';
  end;
end;

function TDefineTree.GetPPUSrcPathForDirectory(const Directory: string
  ): string;
var Evaluator: TExpressionEvaluator;
begin
  Evaluator:=GetDefinesForDirectory(Directory,true);
  if Evaluator<>nil then begin
    Result:=Evaluator.Variables[PPUSrcPathMacroName];
  end else begin
    Result:='';
  end;
end;

function TDefineTree.GetDCUSrcPathForDirectory(const Directory: string
  ): string;
var Evaluator: TExpressionEvaluator;
begin
  Evaluator:=GetDefinesForDirectory(Directory,true);
  if Evaluator<>nil then begin
    Result:=Evaluator.Variables[DCUSrcPathMacroName];
  end else begin
    Result:='';
  end;
end;

function TDefineTree.GetCompiledSrcPathForDirectory(const Directory: string
  ): string;
var
  Evaluator: TExpressionEvaluator;
begin
  Evaluator:=GetDefinesForDirectory(Directory,true);
  if Evaluator<>nil then begin
    Result:=Evaluator.Variables[CompiledSrcPathMacroName];
  end else begin
    Result:='';
  end;
end;

function TDefineTree.GetDefinesForDirectory(
  const Path: string; WithVirtualDir: boolean): TExpressionEvaluator;
var
  DirDef: TDirectoryDefines;
begin
  DirDef:=GetDirDefinesForDirectory(Path,WithVirtualDir);
  if DirDef<>nil then
    Result:=DirDef.Values
  else
    Result:=nil;
end;

function TDefineTree.GetDefinesForVirtualDirectory: TExpressionEvaluator;
var
  DirDef: TDirectoryDefines;
begin
  DirDef:=GetDirDefinesForVirtualDirectory;
  if DirDef<>nil then
    Result:=DirDef.Values
  else
    Result:=nil;
end;

procedure TDefineTree.ReadValue(const DirDef: TDirectoryDefines;
  const PreValue, CurDefinePath: string; out NewValue: string);
var
  Buffer: PChar;
  BufferPos: integer;
  BufferSize: integer;
  ValuePos: integer;

  function SearchBracketClose(const s: string; Position:integer): integer;
  var BracketClose:char;
    sLen: Integer;
  begin
    if s[Position]='(' then
      BracketClose:=')'
    else
      BracketClose:='{';
    inc(Position);
    sLen:=length(s);
    while (Position<=sLen) and (s[Position]<>BracketClose) do begin
      if s[Position]=SpecialChar then
        inc(Position)
      else if (s[Position] in ['(','{']) then
        Position:=SearchBracketClose(s,Position);
      inc(Position);
    end;
    Result:=Position;
  end;

  function ExecuteMacroFunction(const FuncName, Params: string): string;
  var
    FuncData: TReadFunctionData;
  begin
    FuncData.Param:=Params;
    FuncData.Result:='';
    FMacroFunctions.DoDataFunction(PChar(Pointer(FuncName)),length(FuncName),
                                   @FuncData);
    Result:=FuncData.Result;
  end;
  
  function ExecuteMacroVariable(var MacroVariable: string): boolean;
  var
    FuncData: TReadFunctionData;
  begin
    FuncData.Param:=MacroVariable;
    FuncData.Result:='';
    Result:=FMacroVariables.DoDataFunction(
                 PChar(Pointer(MacroVariable)),length(MacroVariable),@FuncData);
    if Result then
      MacroVariable:=FuncData.Result;
  end;

  procedure GrowBuffer(MinSize: integer);
  var
    NewSize: Integer;
  begin
    if MinSize<=BufferSize then exit;
    NewSize:=MinSize*2+100;
    ReAllocMem(Buffer,NewSize);
    BufferSize:=NewSize;
  end;

  procedure CopyStringToBuffer(const Src: string);
  begin
    if Src='' then exit;
    Move(Src[1],Buffer[BufferPos],length(Src));
    inc(BufferPos,length(Src));
  end;

  procedure CopyFromValueToBuffer(Len: integer);
  begin
    if Len=0 then exit;
    Move(NewValue[ValuePos],Buffer[BufferPos],Len);
    inc(BufferPos,Len);
    inc(ValuePos,Len);
  end;

  function Substitute(const CurValue: string; ValueLen: integer;
    MacroStart: integer; var MacroEnd: integer): boolean;
  var
    MacroFuncNameEnd: Integer;
    MacroFuncNameLen: Integer;
    MacroStr: String;
    MacroFuncName: String;
    NewMacroLen: Integer;
    MacroParam: string;
    OldMacroLen: Integer;
    Handled: Boolean;
    MacroVarName: String;
  begin
    Result:=false;
    MacroFuncNameEnd:=MacroEnd;
    MacroFuncNameLen:=MacroFuncNameEnd-MacroStart-1;
    MacroEnd:=SearchBracketClose(CurValue,MacroFuncNameEnd)+1;
    if MacroEnd>ValueLen+1 then exit;
    OldMacroLen:=MacroEnd-MacroStart;
    // Macro found
    if MacroFuncNameLen>0 then begin
      MacroFuncName:=copy(CurValue,MacroStart+1,MacroFuncNameLen);
      // Macro function -> substitute macro parameter first
      ReadValue(DirDef,copy(CurValue,MacroFuncNameEnd+1
          ,MacroEnd-MacroFuncNameEnd-2),CurDefinePath,MacroParam);
      // execute the macro function
      //debugln('Substitute MacroFuncName="',MacroFuncName,'" MacroParam="',MacroParam,'"');
      MacroStr:=ExecuteMacroFunction(MacroFuncName,MacroParam);
    end else begin
      // Macro variable
      MacroVarName:=copy(CurValue,MacroStart+2,MacroEnd-MacroStart-3);
      MacroStr:=MacroVarName;
      //DebugLn('**** MacroVarName=',MacroVarName,' ',DirDef.Values.Variables[MacroVarName]);
      //DebugLn('DirDef.Values=',DirDef.Values.AsString);
      if MacroVarName=DefinePathMacroName then begin
        MacroStr:=CurDefinePath;
      end else if DirDef.Values.IsDefined(MacroVarName) then begin
        MacroStr:=DirDef.Values.Variables[MacroVarName];
      end else begin
        Handled:=false;
        if Assigned(FOnReadValue) then begin
          MacroParam:=MacroVarName;
          MacroStr:='';
          FOnReadValue(Self,MacroParam,MacroStr,Handled);
        end;
        if not Handled then begin
          MacroStr:=MacroVarName;
          Handled:=ExecuteMacroVariable(MacroStr);
        end;
        if not Handled then begin
          MacroStr:='';
        end;
      end;
    end;
    NewMacroLen:=length(MacroStr);
    GrowBuffer(BufferPos+NewMacroLen-OldMacroLen+ValueLen-ValuePos+1);
    // copy text between this macro and last macro
    CopyFromValueToBuffer(MacroStart-ValuePos);
    // copy macro value to buffer
    CopyStringToBuffer(MacroStr);
    ValuePos:=MacroEnd;
    Result:=true;
  end;

  procedure SetNewValue;
  var
    RestLen: Integer;
  begin
    if Buffer=nil then exit;
    // write rest to buffer
    RestLen:=length(NewValue)-ValuePos+1;
    if RestLen>0 then begin
      GrowBuffer(BufferPos+RestLen);
      Move(NewValue[ValuePos],Buffer[BufferPos],RestLen);
      inc(BufferPos,RestLen);
    end;
    // copy the buffer into NewValue
    //DebugLn('    [ReadValue] Old="',copy(NewValue,1,100),'"');
    SetLength(NewValue,BufferPos);
    if BufferPos>0 then
      Move(Buffer^,NewValue[1],BufferPos);
    //DebugLn('    [ReadValue] New="',copy(NewValue,1,100),'"');
    // clean up
    FreeMem(Buffer);
    Buffer:=nil;
  end;

var MacroStart,MacroEnd: integer;
  ValueLen: Integer;
begin
  //  DebugLn('    [ReadValue] A   "',copy(PreValue,1,100),'"');
  NewValue:=PreValue;
  if NewValue='' then exit;
  MacroStart:=1;
  ValueLen:=length(NewValue);
  Buffer:=nil;
  BufferSize:=0;
  BufferPos:=0; // position in buffer
  ValuePos:=1;  // same position in value
  while MacroStart<=ValueLen do begin
    // search for macro
    while (MacroStart<=ValueLen) and (NewValue[MacroStart]<>'$') do begin
      if (NewValue[MacroStart]=SpecialChar) then inc(MacroStart);
      inc(MacroStart);
    end;
    if MacroStart>ValueLen then break;
    // read macro function name
    MacroEnd:=MacroStart+1;
    while (MacroEnd<=ValueLen)
    and (NewValue[MacroEnd] in ['0'..'9','A'..'Z','a'..'z','_']) do
      inc(MacroEnd);
    // read macro name / parameters
    if (MacroEnd<ValueLen) and (NewValue[MacroEnd] in ['(','{']) then
    begin
      if not Substitute(NewValue,ValueLen,MacroStart,MacroEnd) then break;
    end;
    MacroStart:=MacroEnd;
  end;
  if Buffer<>nil then SetNewValue;
end;

procedure TDefineTree.MarkTemplatesOwnedBy(TheOwner: TObject; const MustFlags,
  NotFlags: TDefineTemplateFlags);
begin
  if FFirstDefineTemplate=nil then exit;
  with FFirstDefineTemplate do begin
    // unmark all nodes
    UnmarkNodes(true,true);
    // mark each node in filter
    MarkOwnedBy(TheOwner,MustFlags,NotFlags,true,true);
    // mark every parent, that has a marked child
    InheritMarks(true,true,false,true);
  end;
end;

procedure TDefineTree.RemoveTemplatesOwnedBy(TheOwner: TObject;
  const MustFlags, NotFlags: TDefineTemplateFlags);
begin
  if FFirstDefineTemplate=nil then exit;
  FFirstDefineTemplate.RemoveLeaves(TheOwner,MustFlags,NotFlags,true,
                                    FFirstDefineTemplate);
  FFirstDefineTemplate.RemoveOwner(TheOwner,true);
  ClearCache;
end;

function TDefineTree.ExtractTemplatesOwnedBy(TheOwner: TObject;
  const MustFlags, NotFlags: TDefineTemplateFlags): TDefineTemplate;
begin
  Result:=nil;
  if FFirstDefineTemplate=nil then exit;
  MarkTemplatesOwnedBy(TheOwner,MustFlags,NotFlags);
  with FFirstDefineTemplate do begin
    // store some information, so that merging the nodes will result in old order
    CreateMergeInfo(true,false);
    // extract marked nodes
    Result:=CreateCopy(true,true,true);
  end;
end;

function TDefineTree.ExtractNonAutoCreated: TDefineTemplate;
begin
  Result:=nil;
  if FFirstDefineTemplate=nil then exit;
  MarkNonAutoCreated;
  with FFirstDefineTemplate do begin
    // store some information, so that merging the nodes will result in old order
    CreateMergeInfo(true,false);
    // extract marked nodes
    Result:=CreateCopy(true,true,true);
  end;
end;

procedure TDefineTree.MergeTemplates(SourceTemplate: TDefineTemplate;
  const NewNamePrefix: string);
var
  LastDefTempl: TDefineTemplate;
begin
  LastDefTempl:=GetLastRootTemplate;
  TDefineTemplate.MergeTemplates(nil,FFirstDefineTemplate,LastDefTempl,
                  SourceTemplate,true,NewNamePrefix);
  ClearCache;
end;

function TDefineTree.Calculate(DirDef: TDirectoryDefines): boolean;
// calculates the values for a single directory
// returns false on error
var
  ExpandedDirectory, EvalResult, TempValue: string;

  procedure CalculateTemplate(DefTempl: TDefineTemplate; const CurPath: string);
  
    procedure CalculateIfChildren;
    begin
      // execute children
      CalculateTemplate(DefTempl.FirstChild,CurPath);
      // jump to end of else templates
      while (DefTempl.Next<>nil)
      and (DefTempl.Next.Action in [da_Else,da_ElseIf])
      do begin
        if Assigned(OnCalculate) then
          OnCalculate(Self,DefTempl,false,'',false,'',false);
        DefTempl:=DefTempl.Next;
      end;
    end;

  // procedure CalculateTemplate(DefTempl: TDefineTemplate; const CurPath: string);
  var SubPath, TempValue: string;
    VarName: string;
  begin
    while DefTempl<>nil do begin
      //DebugLn('  [CalculateTemplate] CurPath="',CurPath,'" DefTempl.Name="',DefTempl.Name,'"');
      case DefTempl.Action of
      da_Block:
        // calculate children
        begin
          if Assigned(OnCalculate) then
            OnCalculate(Self,DefTempl,false,'',false,'',true);
          CalculateTemplate(DefTempl.FirstChild,CurPath);
        end;

      da_Define:
        // Define for a single Directory (not SubDirs)
        begin
          if FilenameIsMatching(CurPath,ExpandedDirectory,true) then begin
            ReadValue(DirDef,DefTempl.Value,CurPath,TempValue);
            if Assigned(OnCalculate) then
              OnCalculate(Self,DefTempl,true,TempValue,false,'',true);
            ReadValue(DirDef,DefTempl.Variable,CurPath,VarName);
            DirDef.Values.Variables[VarName]:=TempValue;
          end else begin
            if Assigned(OnCalculate) then
              OnCalculate(Self,DefTempl,false,'',false,'',false);
          end;
        end;

      da_DefineRecurse:
        // Define for current and sub directories
        begin
          ReadValue(DirDef,DefTempl.Value,CurPath,TempValue);
          if Assigned(OnCalculate) then
            OnCalculate(Self,DefTempl,true,TempValue,false,'',true);
          ReadValue(DirDef,DefTempl.Variable,CurPath,VarName);
          DirDef.Values.Variables[VarName]:=TempValue;
        end;

      da_Undefine:
        // Undefine for a single Directory (not SubDirs)
        if FilenameIsMatching(CurPath,ExpandedDirectory,true) then begin
          if Assigned(OnCalculate) then
            OnCalculate(Self,DefTempl,false,'',false,'',true);
          ReadValue(DirDef,DefTempl.Variable,CurPath,VarName);
          DirDef.Values.Undefine(VarName);
        end else begin
          if Assigned(OnCalculate) then
            OnCalculate(Self,DefTempl,false,'',false,'',false);
        end;

      da_UndefineRecurse:
        // Undefine for current and sub directories
        begin
          if Assigned(OnCalculate) then
            OnCalculate(Self,DefTempl,false,'',false,'',true);
          ReadValue(DirDef,DefTempl.Variable,CurPath,VarName);
          DirDef.Values.Undefine(VarName);
        end;

      da_UndefineAll:
        // Undefine every value for current and sub directories
        begin
          if Assigned(OnCalculate) then
            OnCalculate(Self,DefTempl,false,'',false,'',true);
          DirDef.Values.Clear;
        end;

      da_If, da_ElseIf:
        begin
          // test expression in value
          ReadValue(DirDef,DefTempl.Value,CurPath,TempValue);
          EvalResult:=DirDef.Values.Eval(TempValue,true);
          if Assigned(OnCalculate) then
            OnCalculate(Self,DefTempl,true,TempValue,true,EvalResult,EvalResult='1');
          //debugln('da_If,da_ElseIf: DefTempl.Value="',DbgStr(DefTempl.Value),'" CurPath="',CurPath,'" TempValue="',TempValue,'" EvalResult=',EvalResult);
          if DirDef.Values.ErrorPosition>=0 then begin
            FErrorDescription:=Format(ctsSyntaxErrorInExpr,[TempValue]);
            FErrorTemplate:=DefTempl;
            //debugln(['CalculateTemplate "',FErrorDescription,'"']);
          end else if EvalResult='1' then
            CalculateIfChildren;
        end;
      da_IfDef,da_IfNDef:
        // test if variable is defined
        begin
          //DebugLn('da_IfDef A Name=',DefTempl.Name,
          //  ' Variable=',DefTempl.Variable,
          //  ' Is=',dbgs(DirDef.Values.IsDefined(DefTempl.Variable)),
          //  ' CurPath="',CurPath,'"',
          //  ' Values.Count=',dbgs(DirDef.Values.Count));
          ReadValue(DirDef,DefTempl.Variable,CurPath,VarName);
          if DirDef.Values.IsDefined(VarName)=(DefTempl.Action=da_IfDef) then begin
            if Assigned(OnCalculate) then
              OnCalculate(Self,DefTempl,false,'',false,'',true);
            CalculateIfChildren;
          end else begin
            if Assigned(OnCalculate) then
              OnCalculate(Self,DefTempl,false,'',false,'',false);
          end;
        end;

      da_Else:
        // execute children
        begin
          if Assigned(OnCalculate) then
            OnCalculate(Self,DefTempl,false,'',false,'',true);
          CalculateTemplate(DefTempl.FirstChild,CurPath);
        end;

      da_Directory:
        begin
          // template for a sub directory
          ReadValue(DirDef,DefTempl.Value,CurPath,TempValue);
          // CurPath can be ''
          SubPath:=AppendPathDelim(CurPath)+TempValue;
          // test if ExpandedDirectory is part of SubPath
          if FilenameIsMatching(SubPath,ExpandedDirectory,false) then begin
            if Assigned(OnCalculate) then
              OnCalculate(Self,DefTempl,true,SubPath,false,'',true);
            CalculateTemplate(DefTempl.FirstChild,SubPath);
          end else begin
            if Assigned(OnCalculate) then
              OnCalculate(Self,DefTempl,true,SubPath,false,'',false);
          end;
        end;
      end;
      if ErrorTemplate<>nil then exit;
      if DefTempl<>nil then
        DefTempl:=DefTempl.Next;
    end;
  end;

// function TDefineTree.Calculate(DirDef: TDirectoryDefines): boolean;
begin
  {$IFDEF VerboseDefineCache}
  DebugLn('[TDefineTree.Calculate] ++++++ "',DirDef.Path,'"');
  {$ENDIF}
  Result:=true;
  FErrorTemplate:=nil;
  ExpandedDirectory:=DirDef.Path;
  if (ExpandedDirectory=VirtualDirectory)
  and Assigned(OnGetVirtualDirectoryAlias) then
    OnGetVirtualDirectoryAlias(Self,ExpandedDirectory);
  if (ExpandedDirectory<>VirtualDirectory) then begin
    ReadValue(DirDef,ExpandedDirectory,'',TempValue);
    ExpandedDirectory:=TempValue;
  end;
  DirDef.Values.Clear;
  // compute the result of all matching DefineTemplates
  CalculateTemplate(FFirstDefineTemplate,'');
  if (ExpandedDirectory=VirtualDirectory)
  and (Assigned(OnGetVirtualDirectoryDefines)) then
    OnGetVirtualDirectoryDefines(Self,DirDef);
  Result:=(ErrorTemplate=nil);
end;

procedure TDefineTree.IncreaseChangeStep;
begin
  CTIncreaseChangeStamp(FChangeStep);
  if DirectoryCachePool<>nil then DirectoryCachePool.IncreaseConfigTimeStamp;
end;

procedure TDefineTree.SetDirectoryCachePool(const AValue: TCTDirectoryCachePool);
begin
  if FDirectoryCachePool=AValue then exit;
  FDirectoryCachePool:=AValue;
end;

procedure TDefineTree.RemoveDoubles(Defines: TDirectoryDefines);
// use only one copy of each ansistring
begin
  if Defines=nil then exit;
  Defines.Values.RemoveDoubles(@FDefineStrings.ReplaceString);
end;

procedure TDefineTree.Add(ADefineTemplate: TDefineTemplate);
// add as last
var LastDefTempl: TDefineTemplate;
begin
  if ADefineTemplate=nil then exit;
  if RootTemplate=nil then
    RootTemplate:=ADefineTemplate
  else begin
    // add as last
    LastDefTempl:=RootTemplate;
    while LastDefTempl.Next<>nil do
      LastDefTempl:=LastDefTempl.Next;
    ADefineTemplate.InsertBehind(LastDefTempl);
  end;
  ClearCache;
end;

procedure TDefineTree.AddFirst(ADefineTemplate: TDefineTemplate);
// add as first
begin
  if ADefineTemplate=nil then exit;
  if RootTemplate=nil then
    RootTemplate:=ADefineTemplate
  else begin
    RootTemplate.InsertBehind(ADefineTemplate);
    RootTemplate:=ADefineTemplate;
  end;
  ClearCache;
end;

procedure TDefineTree.MoveToLast(ADefineTemplate: TDefineTemplate);
begin
  if (ADefineTemplate.Next=nil) and (ADefineTemplate.Parent=nil) then exit;
  ADefineTemplate.Unbind;
  if FFirstDefineTemplate=ADefineTemplate then FFirstDefineTemplate:=nil;
  Add(ADefineTemplate);
end;

function TDefineTree.FindDefineTemplateByName(
  const AName: string; OnlyRoots: boolean): TDefineTemplate;
begin
  Result:=RootTemplate;
  if RootTemplate<>nil then
    Result:=RootTemplate.FindByName(AName,not OnlyRoots,true)
  else
    Result:=nil;
end;

procedure TDefineTree.ReplaceRootSameName(const Name: string;
  ADefineTemplate: TDefineTemplate);
// if there is a DefineTemplate with the same name then replace it
// else add as last
var OldDefineTemplate: TDefineTemplate;
begin
  if (Name='') then exit;
  OldDefineTemplate:=FindDefineTemplateByName(Name,true);
  if OldDefineTemplate<>nil then begin
    if not OldDefineTemplate.IsEqual(ADefineTemplate,true,false) then begin
      ClearCache;
    end;
    if ADefineTemplate<>nil then
      ADefineTemplate.InsertBehind(OldDefineTemplate);
    if OldDefineTemplate=FFirstDefineTemplate then
      FFirstDefineTemplate:=FFirstDefineTemplate.Next;
    OldDefineTemplate.Unbind;
    OldDefineTemplate.Free;
  end else
    Add(ADefineTemplate);
end;

procedure TDefineTree.RemoveRootDefineTemplateByName(const AName: string);
var ADefTempl: TDefineTemplate;
begin
  ADefTempl:=FindDefineTemplateByName(AName,true);
  if ADefTempl<>nil then RemoveDefineTemplate(ADefTempl);
end;

procedure TDefineTree.RemoveDefineTemplate(ADefTempl: TDefineTemplate);
var
  HadDefines: Boolean;
begin
  if ADefTempl=FFirstDefineTemplate then
    FFirstDefineTemplate:=FFirstDefineTemplate.Next;
  HadDefines:=ADefTempl.HasDefines(false,false);
  ADefTempl.Unbind;
  ADefTempl.Free;
  if HadDefines then ClearCache;
end;

procedure TDefineTree.ReplaceChild(ParentTemplate,
  NewDefineTemplate: TDefineTemplate; const ChildName: string);
// if there is a DefineTemplate with the same name then replace it
// else add as last
var OldDefineTemplate: TDefineTemplate;
begin
  if (ChildName='') or (ParentTemplate=nil) then exit;
  OldDefineTemplate:=ParentTemplate.FindChildByName(ChildName);
  if OldDefineTemplate<>nil then begin
    if not OldDefineTemplate.IsEqual(NewDefineTemplate,true,false) then begin
      ClearCache;
    end;
    if NewDefineTemplate<>nil then
      NewDefineTemplate.InsertBehind(OldDefineTemplate);
    if OldDefineTemplate=FFirstDefineTemplate then
      FFirstDefineTemplate:=FFirstDefineTemplate.Next;
    OldDefineTemplate.Unbind;
    OldDefineTemplate.Free;
  end else begin
    ClearCache;
    ParentTemplate.AddChild(NewDefineTemplate);
  end;
end;

procedure TDefineTree.AddChild(ParentTemplate,
  NewDefineTemplate: TDefineTemplate);
begin
  ClearCache;
  ParentTemplate.AddChild(NewDefineTemplate);
end;

procedure TDefineTree.ReplaceRootSameName(ADefineTemplate: TDefineTemplate);
begin
  if (ADefineTemplate=nil) then exit;
  ReplaceRootSameName(ADefineTemplate.Name,ADefineTemplate);
end;

procedure TDefineTree.ReplaceRootSameNameAddFirst(
  ADefineTemplate: TDefineTemplate);
var OldDefineTemplate: TDefineTemplate;
begin
  if ADefineTemplate=nil then exit;
  OldDefineTemplate:=FindDefineTemplateByName(ADefineTemplate.Name,true);
  if OldDefineTemplate<>nil then begin
    if not OldDefineTemplate.IsEqual(ADefineTemplate,true,false) then begin
      ClearCache;
    end;
    ADefineTemplate.InsertBehind(OldDefineTemplate);
    if OldDefineTemplate=FFirstDefineTemplate then
      FFirstDefineTemplate:=FFirstDefineTemplate.Next;
    OldDefineTemplate.Unbind;
    OldDefineTemplate.Free;
  end else
    AddFirst(ADefineTemplate);
end;

procedure TDefineTree.MergeDefineTemplates(SourceTemplate: TDefineTemplate;
  const NewNamePrefix: string);
var
  LastDefTempl: TDefineTemplate;
begin
  if SourceTemplate=nil then exit;
  // import new defines
  LastDefTempl:=GetLastRootTemplate;
  TDefineTemplate.MergeTemplates(nil,FFirstDefineTemplate,LastDefTempl,
                                 SourceTemplate,true,NewNamePrefix);
  ClearCache;
end;

procedure TDefineTree.ConsistencyCheck;
var
  CurResult: LongInt;
begin
  if FFirstDefineTemplate<>nil then
    FFirstDefineTemplate.ConsistencyCheck;
  CurResult:=FCache.ConsistencyCheck;
  if CurResult<>0 then
    RaiseCatchableException(IntToStr(CurResult));
end;

procedure TDefineTree.CalcMemSize(Stats: TCTMemStats);
var
  Node: TAVLTreeNode;
begin
  Stats.Add('TDefineTree',PtrUInt(InstanceSize)
    +MemSizeString(FErrorDescription)
    );
  if FMacroFunctions<>nil then
    Stats.Add('TDefineTree.FMacroFunctions',FMacroFunctions.CalcMemSize);
  if FMacroVariables<>nil then
    Stats.Add('TDefineTree.FMacroVariables',FMacroVariables.CalcMemSize);
  if FFirstDefineTemplate<>nil then
    FFirstDefineTemplate.CalcMemSize(Stats);
  if FVirtualDirCache<>nil then
    FVirtualDirCache.CalcMemSize(Stats);
  if FDefineStrings<>nil then
    Stats.Add('TDefineTree.FDefineStrings',FDefineStrings.CalcMemSize);
  if FCache<>nil then begin
    Stats.Add('TDefineTree.FCache.Count',FCache.Count);
    Node:=FCache.FindLowest;
    while Node<>nil do begin
      TDirectoryDefines(Node.Data).CalcMemSize(Stats);
      Node:=FCache.FindSuccessor(Node);
    end;
  end;
end;

procedure TDefineTree.WriteDebugReport;
begin
  DebugLn('TDefineTree.WriteDebugReport');
  if FFirstDefineTemplate<>nil then
    FFirstDefineTemplate.WriteDebugReport(false)
  else
    DebugLn('  No templates defined');
  DebugLn(FCache.ReportAsString);
  DebugLn('');
  ConsistencyCheck;
end;

    
{ TDefinePool }

constructor TDefinePool.Create;
begin
  inherited Create;
  FItems:=TFPList.Create;
end;

destructor TDefinePool.Destroy;
begin
  Clear;
  FItems.Free;
  inherited Destroy;
end;

procedure TDefinePool.Clear;
var i: integer;
begin
  for i:=0 to Count-1 do begin
    Items[i].Clear(true);
    Items[i].Free;
  end;
  FItems.Clear;
end;

function TDefinePool.GetItems(Index: integer): TDefineTemplate;
begin
  Result:=TDefineTemplate(FItems[Index]);
end;

procedure TDefinePool.SetEnglishErrorMsgFilename(const AValue: string);
begin
  if FEnglishErrorMsgFilename=AValue then exit;
  FEnglishErrorMsgFilename:=AValue;
end;

function TDefinePool.CheckAbort(ProgressID, MaxIndex: integer;
  const Msg: string): boolean;
begin
  Result:=false;
  if Assigned(OnProgress) then
    OnProgress(Self,ProgressID,MaxIndex,Msg,Result);
end;

procedure TDefinePool.Add(ADefineTemplate: TDefineTemplate);
begin
  if ADefineTemplate<>nil then
    FItems.Add(ADefineTemplate);
end;

procedure TDefinePool.Insert(Index: integer; ADefineTemplate: TDefineTemplate);
begin
  FItems.Insert(Index,ADefineTemplate);
end;

procedure TDefinePool.Delete(Index: integer);
begin
  Items[Index].Clear(true);
  Items[Index].Free;
  FItems.Delete(Index);
end;

procedure TDefinePool.Move(SrcIndex, DestIndex: integer);
begin
  FItems.Move(SrcIndex,DestIndex);
end;

function TDefinePool.Count: integer;
begin
  Result:=FItems.Count;
end;

function TDefinePool.CreateFPCTemplate(
  const CompilerPath, CompilerOptions, TestPascalFile: string;
  out UnitSearchPath, TargetOS, aTargetCPU: string;
  Owner: TObject): TDefineTemplate;
// create symbol definitions for the freepascal compiler
// To get reliable values the compiler itself is asked for
var
  LastDefTempl: TDefineTemplate;

  procedure AddTemplate(NewDefTempl: TDefineTemplate);
  begin
    if NewDefTempl=nil then exit;
    if LastDefTempl<>nil then
      NewDefTempl.InsertBehind(LastDefTempl);
    LastDefTempl:=NewDefTempl;
  end;
  
  function FindSymbol(const SymbolName: string): TDefineTemplate;
  begin
    Result:=LastDefTempl;
    while (Result<>nil)
    and (Comparetext(Result.Variable,SymbolName)<>0) do
      Result:=Result.Prior;
  end;

  procedure DefineSymbol(const SymbolName, SymbolValue: string;
    const Description: string = '');
  var NewDefTempl: TDefineTemplate;
    Desc: String;
  begin
    NewDefTempl:=FindSymbol(SymbolName);
    if NewDefTempl=nil then begin
      if Description<>'' then
        Desc:=Description
      else
        Desc:=ctsDefaultFPCSymbol;
      NewDefTempl:=TDefineTemplate.Create('Define '+SymbolName,
           Desc,SymbolName,SymbolValue,da_DefineRecurse);
      AddTemplate(NewDefTempl);
    end else begin
      NewDefTempl.Value:=SymbolValue;
    end;
  end;

  procedure UndefineSymbol(const SymbolName: string);
  var
    ADefTempl: TDefineTemplate;
  begin
    ADefTempl:=FindSymbol(SymbolName);
    if ADefTempl=nil then exit;
    if LastDefTempl=ADefTempl then LastDefTempl:=ADefTempl.Prior;
    ADefTempl.Unbind;
    ADefTempl.Free;
  end;

  procedure ProcessOutputLine(var Line: string);
  var
    SymbolName, SymbolValue, UpLine, NewPath: string;
    i, len, curpos: integer;
  begin
    len := length(Line);
    if len <= 6 then Exit; // shortest match
    
    CurPos := 1;
    // strip timestamp e.g. [0.306]
    if Line[CurPos] = '[' then begin
      repeat
        inc(CurPos);
        if CurPos > len then Exit;
      until line[CurPos] = ']';
      Inc(CurPos, 2); // skip space too
      if len - CurPos < 6 then Exit; // shortest match
    end;

    UpLine:=UpperCaseStr(Line);
    //DebugLn(['ProcessOutputLine ',Line]);
    
    case UpLine[CurPos] of
      'M':
        if StrLComp(@UpLine[CurPos], 'MACRO ', 6) = 0 then begin
          // no macro
          Inc(CurPos, 6);

          if (StrLComp(@UpLine[CurPos], 'DEFINED: ', 9) = 0) then begin
            Inc(CurPos, 9);
            SymbolName:=copy(UpLine, CurPos, len);
            DefineSymbol(SymbolName,'');
            Exit;
          end;

          if (StrLComp(@UpLine[CurPos], 'UNDEFINED: ', 11) = 0) then begin
            Inc(CurPos, 11);
            SymbolName:=copy(UpLine,CurPos,len);
            UndefineSymbol(SymbolName);
            Exit;
          end;

          // MACRO something...
          i := CurPos;
          while (i <= len) and (Line[i]<>' ') do inc(i);
          SymbolName:=copy(UpLine,CurPos,i-CurPos);
          CurPos := i + 1; // skip space

          if StrLComp(@UpLine[CurPos], 'SET TO ', 7) = 0 then begin
            Inc(CurPos, 7);
            SymbolValue:=copy(Line, CurPos, len);
            DefineSymbol(SymbolName, SymbolValue);
          end;
        end;
      'U':
        if (StrLComp(@UpLine[CurPos], 'USING UNIT PATH: ', 17) = 0) then begin
          Inc(CurPos, 17);
          NewPath:=copy(Line,CurPos,len);
          if not FilenameIsAbsolute(NewPath) then
            NewPath:=ExpandFileNameUTF8(NewPath);
          {$IFDEF VerboseFPCSrcScan}
          DebugLn('Using unit path: "',NewPath,'"');
          {$ENDIF}
          UnitSearchPath:=UnitSearchPath+NewPath+';';
        end;
    end;
  end;
  
var CmdLine: string;
  i, OutLen, LineStart: integer;
  TheProcess: TProcessUTF8;
  OutputLine, Buf: String;
  NewDefTempl: TDefineTemplate;
  SrcOS: string;
  SrcOS2: String;
  Step: String;
begin
  Result:=nil;
  //DebugLn('TDefinePool.CreateFPCTemplate PPC386Path="',CompilerPath,'" FPCOptions="',CompilerOptions,'"');
  if TestPascalFile='' then begin
    DebugLn(['Warning: [TDefinePool.CreateFPCTemplate] TestPascalFile empty']);
  end;
  UnitSearchPath:='';
  TargetOS:='';
  SrcOS:='';
  aTargetCPU:='';
  if (CompilerPath='') or (not FileIsExecutable(CompilerPath)) then exit;
  LastDefTempl:=nil;
  // find all initial compiler macros and all unit paths
  // -> ask compiler with the -va switch
  SetLength(Buf,1024);
  Step:='Init';
  try
    CmdLine:=CompilerPath+' -va ';
    if FileExistsCached(EnglishErrorMsgFilename) then
      CmdLine:=CmdLine+'-Fr'+EnglishErrorMsgFilename+' ';
    if CompilerOptions<>'' then
      CmdLine:=CmdLine+CompilerOptions+' ';
    CmdLine:=CmdLine+TestPascalFile;
    //DebugLn('TDefinePool.CreateFPCTemplate CmdLine="',CmdLine,'"');

    TheProcess := TProcessUTF8.Create(nil);
    TheProcess.CommandLine := CmdLine;
    TheProcess.Options:= [poUsePipes, poStdErrToOutPut];
    TheProcess.ShowWindow := swoHide;
    Step:='Running '+CmdLine;
    try
      TheProcess.Execute;
      OutputLine:='';
      repeat
        if (TheProcess.Output<>nil) then begin
          OutLen:=TheProcess.Output.Read(Buf[1],length(Buf));
        end else
          OutLen:=0;
        LineStart:=1;
        i:=1;
        while i<=OutLen do begin
          if Buf[i] in [#10,#13] then begin
            OutputLine:=OutputLine+copy(Buf,LineStart,i-LineStart);
            ProcessOutputLine(OutputLine);
            OutputLine:='';
            if (i<OutLen) and (Buf[i+1] in [#10,#13]) and (Buf[i]<>Buf[i+1])
            then
              inc(i);
            LineStart:=i+1;
          end;
          inc(i);
        end;
        OutputLine:=copy(Buf,LineStart,OutLen-LineStart+1);
      until OutLen=0;
      TheProcess.WaitOnExit;
    finally
      //DebugLn('TDefinePool.CreateFPCTemplate Run with -va: OutputLine="',OutputLine,'"');
      TheProcess.Free;
    end;
    DefineSymbol(FPCUnitPathMacroName,UnitSearchPath,'FPC default unit search path');

    //DebugLn('TDefinePool.CreateFPCTemplate First done UnitSearchPath="',UnitSearchPath,'"');

    // ask for target operating system -> ask compiler with switch -iTO
    CmdLine:=CompilerPath;
    if CompilerOptions<>'' then
      CmdLine:=CmdLine+' '+CompilerOptions;
    CmdLine:=CmdLine+' -iTO';

    TheProcess := TProcessUTF8.Create(nil);
    TheProcess.CommandLine := CmdLine;
    TheProcess.Options:= [poUsePipes, poStdErrToOutPut];
    TheProcess.ShowWindow := swoHide;
    Step:='Running '+CmdLine;
    try
      TheProcess.Execute;
      if (TheProcess.Output<>nil) then
        OutLen:=TheProcess.Output.Read(Buf[1],length(Buf))
      else
        OutLen:=0;
      i:=1;
      while i<=OutLen do begin
        if Buf[i] in [#10,#13] then begin
          // define #TargetOS
          TargetOS:=copy(Buf,1,i-1);
          NewDefTempl:=TDefineTemplate.Create('Define TargetOS',
            ctsDefaultFPCTargetOperatingSystem,
            ExternalMacroStart+'TargetOS',TargetOS,da_DefineRecurse);
          AddTemplate(NewDefTempl);
          // define #SrcOS
          SrcOS:=GetDefaultSrcOSForTargetOS(TargetOS);
          if SrcOS='' then SrcOS:=TargetOS;
          NewDefTempl:=TDefineTemplate.Create('Define SrcOS',
            ctsDefaultFPCSourceOperatingSystem,
            ExternalMacroStart+'SrcOS',SrcOS,da_DefineRecurse);
          AddTemplate(NewDefTempl);
          // define #SrcOS2
          SrcOS2:=GetDefaultSrcOS2ForTargetOS(TargetOS);
          if SrcOS2='' then SrcOS2:=TargetOS;
          NewDefTempl:=TDefineTemplate.Create('Define SrcOS2',
            ctsDefaultFPCSource2OperatingSystem,
            ExternalMacroStart+'SrcOS2',SrcOS2,da_DefineRecurse);
          AddTemplate(NewDefTempl);
          break;
        end;
        inc(i);
      end;
      TheProcess.WaitOnExit;
      //DebugLn('TDefinePool.CreateFPCTemplate target OS done');
    finally
      //DebugLn('TDefinePool.CreateFPCTemplate Run with -iTO: OutputLine="',OutputLine,'"');
      TheProcess.Free;
    end;
    
    // ask for target processor -> ask compiler with switch -iTP
    TheProcess := TProcessUTF8.Create(nil);
    CmdLine:=CompilerPath;
    if CompilerOptions<>'' then
      CmdLine:=CmdLine+' '+CompilerOptions;
    CmdLine:=CmdLine+' -iTP';
    TheProcess.CommandLine := CmdLine;
    TheProcess.Options:= [poUsePipes, poStdErrToOutPut];
    TheProcess.ShowWindow := swoHide;
    Step:='Running '+CmdLine;
    try
      TheProcess.Execute;
      if TheProcess.Output<>nil then
        OutLen:=TheProcess.Output.Read(Buf[1],length(Buf))
      else
        OutLen:=0;
      i:=1;
      while i<=OutLen do begin
        if Buf[i] in [#10,#13] then begin
          aTargetCPU:=copy(Buf,1,i-1);
          NewDefTempl:=TDefineTemplate.Create('Define TargetCPU',
            ctsDefaultFPCTargetProcessor,
            TargetCPUMacroName,aTargetCPU,
            da_DefineRecurse);
          AddTemplate(NewDefTempl);
          break;
        end;
        inc(i);
      end;
      TheProcess.WaitOnExit;
      //DebugLn('TDefinePool.CreateFPCTemplate target CPU done');
    finally
      //DebugLn('TDefinePool.CreateFPCTemplate Run with -iTP: OutputLine="',OutputLine,'"');
      TheProcess.Free;
    end;

    // add
    if (LastDefTempl<>nil) then begin
      Result:=TDefineTemplate.Create(StdDefTemplFPC,
        ctsFreePascalCompilerInitialMacros,'','',da_Block);
      Result.AddChild(LastDefTempl.GetFirstSibling);
      Result.SetFlags([dtfAutoGenerated],[],false);
      //DebugLn('TDefinePool.CreateFPCTemplate FPC defines done');
    end;
  except
    on E: Exception do begin
      DebugLn('Error: TDefinePool.CreateFPCTemplate (',Step,'): ',E.Message);
    end;
  end;
  if Result<>nil then
    Result.SetDefineOwner(Owner,true);
end;

function TDefinePool.GetFPCVerFromFPCTemplate(Template: TDefineTemplate; out
  FPCVersion, FPCRelease, FPCPatch: integer): boolean;
var
  p: Integer;

  function ReadInt(const VarName: string; out AnInteger: integer): boolean;
  var
    StartPos: Integer;
  begin
    StartPos:=p;
    AnInteger:=0;
    while (p<=length(VarName)) and (VarName[p] in ['0'..'9']) do begin
      AnInteger:=AnInteger*10+(ord(VarName[p])-ord('0'));
      if AnInteger>=100 then begin
        Result:=false;
        exit;
      end;
      inc(p);
    end;
    Result:=StartPos<p;
  end;

  function ReadVersion(const VarName: string;
    out NewVersion, NewRelease, NewPatch: integer): integer;
  begin
    Result:=0;
    if (length(VarName)>3) and (VarName[1] in ['V','v'])
    and (VarName[2] in ['E','e']) and (VarName[3] in ['R','r'])
    and (VarName[4] in ['0'..'9']) then begin
      p:=4;
      if not ReadInt(VarName,NewVersion) then exit;
      inc(Result);
      if (p>=length(VarName)) or (VarName[p]<>'_') then exit;
      inc(p);
      if not ReadInt(VarName,NewRelease) then exit;
      inc(Result);
      if (p>=length(VarName)) or (VarName[p]<>'_') then exit;
      inc(p);
      if not ReadInt(VarName,NewPatch) then exit;
      inc(Result);
    end;
  end;

var
  Def: TDefineTemplate;
  VarName: String;
  BestCount: integer;
  NewCount: LongInt;
  NewVersion: integer;
  NewRelease: integer;
  NewPatch: integer;
begin
  Result:=false;
  FPCVersion:=0;
  FPCRelease:=0;
  FPCPatch:=0;
  BestCount:=0;
  Def:=Template;
  while Def<>nil do begin
    if Def.Action in [da_Define,da_DefineRecurse] then begin
      VarName:=Def.Variable;
      NewCount:=ReadVersion(VarName,NewVersion,NewRelease,NewPatch);
      if NewCount>BestCount then begin
        BestCount:=NewCount;
        FPCVersion:=NewVersion;
        if NewCount>1 then FPCRelease:=NewRelease;
        if NewCount>2 then FPCPatch:=NewPatch;
        if NewCount=3 then exit;
      end;
    end;
    Def:=Def.Next;
  end;
end;

function TDefinePool.CreateFPCSrcTemplate(
  const FPCSrcDir, UnitSearchPath, PPUExt, DefaultTargetOS,
  DefaultProcessorName: string;
  UnitLinkListValid: boolean; var UnitLinkList: string;
  Owner: TObject): TDefineTemplate;
var
  Dir, SrcOS, SrcOS2, TargetCPU, UnitLinks: string;
  UnitTree: TAVLTree; // tree of TDefTemplUnitNameLink
  IncPathMacro, DefaultSrcOS, DefaultSrcOS2: string;
  ProgressID: integer;
  
  function d(const Filenames: string): string;
  begin
    Result:=SetDirSeparators(Filenames);
  end;

  function GatherUnits: boolean; forward;

  function FindUnitLink(const AnUnitName: string): TUnitNameLink;
  var ANode: TAVLTreeNode;
    cmp: integer;
  begin
    if UnitTree=nil then GatherUnits;
    ANode:=UnitTree.Root;
    while ANode<>nil do begin
      Result:=TUnitNameLink(ANode.Data);
      cmp:=CompareText(AnUnitName,Result.Unit_Name);
      if cmp<0 then
        ANode:=ANode.Left
      else if cmp>0 then
        ANode:=ANode.Right
      else
        exit;
    end;
    Result:=nil;
  end;

  function GatherUnits: boolean;
  
    function FileNameMacroCount(const AFilename: string): integer;
    // count number of macros in filename
    // a macro looks like this '$(name)' without a SpecialChar in front
    // macronames can contain macros themselves
    var i: integer;
    begin
      Result:=0;
      i:=1;
      while (i<=length(AFilename)) do begin
        if (AFilename[i]=SpecialChar) then
          inc(i,2)
        else if (AFilename[i]='$') then begin
          inc(i);
          if (i<=length(AFilename)) and (AFilename[i]='(') then
            inc(Result);
        end else
          inc(i);
      end;
    end;
    
    function BuildMacroFilename(const AFilename: string;
      var MacroCount, UsedMacroCount: integer): string;
    // replace Operating System and Processor Type with macros
    // MacroCount = number of macros are in the filename
    // UsedMacroCount = number of macros fitting to the current settings
    var DirStart, DirEnd, i: integer;
      DirName: string;
      
      function ReplaceDir(const MacroValue, DefaultMacroValue,
        MacroName: string): boolean;
      begin
        Result:=false;
        if CompareText(MacroValue,DirName)=0 then begin
          // this is a macro
          if CompareText(DirName,DefaultMacroValue)=0 then begin
            // the current settings would replace the macro to fit this filename
            inc(UsedMacroCount);
          end;
          BuildMacroFilename:=copy(BuildMacroFilename,1,DirStart-1)+MacroName+
            copy(BuildMacroFilename,DirEnd,length(BuildMacroFilename)-DirEnd+1);
          inc(DirEnd,length(MacroName)-length(DirName));
          DirName:=MacroName;
          Result:=true;
        end;
      end;
      
    begin
      MacroCount:=0;
      Result:=copy(AFilename,length(Dir)+1,length(AFilename)-length(Dir));
      DirStart:=1;
      while (DirStart<=length(Result)) do begin
        while (DirStart<=length(Result)) and (Result[DirStart]=PathDelim)
        do
          inc(DirStart);
        DirEnd:=DirStart;
        while (DirEnd<=length(Result)) and (Result[DirEnd]<>PathDelim) do
          inc(DirEnd);
        if DirEnd>length(Result) then break;
        if DirEnd>DirStart then begin
          DirName:=copy(Result,DirStart,DirEnd-DirStart);
          // replace operating system
          for i:=Low(FPCOperatingSystemNames) to High(FPCOperatingSystemNames)
          do
            if ReplaceDir(FPCOperatingSystemNames[i],DefaultTargetOS,TargetOSMacro)
            then
              break;
          // replace operating system class
          for i:=Low(FPCOperatingSystemAlternativeNames)
              to High(FPCOperatingSystemAlternativeNames)
          do
            if ReplaceDir(FPCOperatingSystemAlternativeNames[i],DefaultSrcOS,
              SrcOS)
            then
              break;
          // replace operating system secondary class
          for i:=Low(FPCOperatingSystemAlternative2Names)
              to High(FPCOperatingSystemAlternative2Names)
          do
            if ReplaceDir(FPCOperatingSystemAlternative2Names[i],DefaultSrcOS2,
              SrcOS2)
            then
              break;
          // replace processor type
          for i:=Low(FPCProcessorNames) to High(FPCProcessorNames) do
            if ReplaceDir(FPCProcessorNames[i],DefaultProcessorName,
              TargetCPU)
            then
              break;
        end;
        DirStart:=DirEnd;
      end;
      Result:=Dir+Result;
    end;

    function IsSpecialDirectory(Dir, SpecialDir: string): boolean;
    var
      p1: Integer;
      p2: Integer;
    begin
      p1:=length(Dir);
      p2:=length(SpecialDir);
      if (p1>=1) and (Dir[p1]=PathDelim) then dec(p1);
      if (p2>=1) and (SpecialDir[p2]=PathDelim) then dec(p2);
      while (p1>=1) and (p2>=1)
      and (UpChars[Dir[p1]]=UpChars[SpecialDir[p2]]) do begin
        dec(p1);
        dec(p2);
      end;
      Result:=(p2=0) and ((p1=0) or (Dir[p1]=PathDelim));
    end;
    
    function BrowseDirectory(ADirPath: string; Priority: integer): boolean;
    const
      IgnoreDirs: array[1..16] of shortstring =(
          '.', '..', 'CVS', '.svn', 'examples', 'example', 'tests', 'fake',
          'ide', 'demo', 'docs', 'template', 'fakertl', 'install', 'installer',
          'compiler'
        );
    var
      AFilename, Ext, AUnitName, MacroFileName: string;
      FileInfo: TSearchRec;
      NewUnitLink, OldUnitLink: TUnitNameLink;
      i: integer;
      MacroCount, UsedMacroCount: integer;
      MakeFileFPC: String;
      SubDirs, GlobalSubDirs, TargetSubDirs: String;
      SubPriority: Integer;
    begin
      Result:=true;
      {$IFDEF VerboseFPCSrcScan}
      DebugLn('Browse ',ADirPath);
      {$ENDIF}
      if ADirPath='' then exit;
      ADirPath:=AppendPathDelim(ADirPath);

      // check for special directories
      if IsSpecialDirectory(ADirPath,'packages'+PathDelim+'amunits') then begin
        {$IFDEF VerboseFPCSrcScan}
        DebugLn(['BrowseDirectory skip ',ADirPath]);
        {$ENDIF}
        exit;
      end;

      inc(ProgressID);
      if CheckAbort(ProgressID,-1,'') then exit(false);
      // read Makefile.fpc to get some hints
      MakeFileFPC:=ADirPath+'Makefile.fpc';
      SubDirs:='';
      if FileExistsUTF8(MakeFileFPC) then begin
        ParseMakefileFPC(MakeFileFPC,DefaultTargetOS,GlobalSubDirs,TargetSubDirs);
        SubDirs:=GlobalSubDirs;
        if TargetSubDirs<>'' then begin
          if SubDirs<>'' then
            SubDirs:=SubDirs+';';
          SubDirs:=SubDirs+TargetSubDirs;
        end;
        //debugln('BrowseDirectory ADirPath="',ADirPath,'" SubDirs="',SubDirs,'" SrcOS="',DefaultTargetOS,'"');
      end;

      // set directory priority
      if System.Pos(Dir+'rtl'+PathDelim,ADirPath)>0 then
        inc(Priority);
      if System.Pos(Dir+'packages'+PathDelim+'fcl',ADirPath)>0 then // packages/fcl*
        inc(Priority);
      // search sources .pp,.pas
      if FindFirstUTF8(ADirPath+FileMask,faAnyFile,FileInfo)=0 then begin
        repeat
          AFilename:=FileInfo.Name;
          if (AFilename='') or (AFilename='.') or (AFilename='..') then
            continue;
          //debugln('Browse Filename=',AFilename,' IsDir=',(FileInfo.Attr and faDirectory)>0);
          i:=High(IgnoreDirs);
          while (i>=Low(IgnoreDirs)) and (AFilename<>IgnoreDirs[i]) do dec(i);
          //if CompareText(AFilename,'fcl')=0 then
          //  debugln('Browse ',AFilename,' IsDir=',(FileInfo.Attr and faDirectory)>0,' Ignore=',i>=Low(IgnoreDirs));
          if i>=Low(IgnoreDirs) then continue;
          AFilename:=ADirPath+AFilename;
          if (FileInfo.Attr and faDirectory)>0 then begin
            // directory -> recursively
            // ToDo: prevent cycling in links
            SubPriority:=0;
            if CompareFilenames(AFilename,Dir+'rtl')=0
            then begin
              // units in 'rtl' have higher priority than other directories
              inc(SubPriority);
            end;
            if (SubDirs<>'')
            and (FindPathInSearchPath(@FileInfo.Name[1],length(FileInfo.Name),
              PChar(SubDirs),length(SubDirs))<>nil)
            then begin
              // units in directories compiled by the Makefile have higher prio
              inc(SubPriority);
            end;
            if not BrowseDirectory(AFilename,SubPriority) then exit(false);
          end else begin
            Ext:=UpperCaseStr(ExtractFileExt(AFilename));
            if (Ext='.PP') or (Ext='.PAS') or (Ext='.P') then begin
              // pascal unit found
              AUnitName:=FileInfo.Name;
              AUnitName:=copy(AUnitName,1,length(AUnitName)-length(Ext));
              if AUnitName<>'' then begin
                OldUnitLink:=FindUnitLink(AUnitName);
                MacroCount:=0;
                UsedMacroCount:=0;
                MacroFileName:=
                        BuildMacroFileName(AFilename,MacroCount,UsedMacroCount);
                if OldUnitLink=nil then begin
                  // first unit with this name
                  NewUnitLink:=TUnitNameLink.Create;
                  NewUnitLink.Unit_Name:=AUnitName;
                  NewUnitLink.FileName:=MacroFileName;
                  NewUnitLink.MacroCount:=MacroCount;
                  NewUnitLink.UsedMacroCount:=UsedMacroCount;
                  NewUnitLink.Score:=Priority;
                  UnitTree.Add(NewUnitLink);
                end else begin
                  { there is another unit with this name

                    the decision which filename is the right one is based on a
                    simple heuristic:
                    - a filename with macros is preferred above one without
                      This skips the templates.
                    - A macro fitting better with the current settings
                      is preferred. For example:
                      If the current OS is linux then on fpc 1.0.x:
                        $(#FPCSrcDir)/fcl/classes/$(#TargetOS)/classes.pp
                    - A unit in the rtl is preferred above one in the fcl

                     FPC stores a unit many times, if there is different version
                     for each Operating System or Processor Type. And sometimes
                     units are stored in a combined OS (e.g. 'unix').
                     Therefore every occurence of such values is replaced by a
                     macro. And filenames without macros are always deleted if
                     there is a filename with a macro. (The filename without
                     macro is only used by the FPC team as a template source
                     for the OS specific).
                     If there are several macro filenames for the same unit, the
                     filename with the highest number of default values is used.
                     
                     For example:
                       classes.pp can be found in several places
                       In fpc 1.0.x:

                        <FPCSrcDir>/rtl/amiga/classes.pp
                        <FPCSrcDir>/fcl/amiga/classes.pp
                        <FPCSrcDir>/fcl/beos/classes.pp
                        <FPCSrcDir>/fcl/qnx/classes.pp
                        <FPCSrcDir>/fcl/sunos/classes.pp
                        <FPCSrcDir>/fcl/template/classes.pp
                        <FPCSrcDir>/fcl/classes/freebsd/classes.pp
                        <FPCSrcDir>/fcl/classes/go32v2/classes.pp
                        <FPCSrcDir>/fcl/classes/linux/classes.pp
                        <FPCSrcDir>/fcl/classes/netbsd/classes.pp
                        <FPCSrcDir>/fcl/classes/openbsd/classes.pp
                        <FPCSrcDir>/fcl/classes/os2/classes.pp
                        <FPCSrcDir>/fcl/classes/win32/classes.pp

                       In fpc 1.9.x/2.0.x:
                        <FPCSrcDir>/rtl/win32/classes.pp
                        <FPCSrcDir>/rtl/watcom/classes.pp
                        <FPCSrcDir>/rtl/go32v2/classes.pp
                        <FPCSrcDir>/rtl/netwlibc/classes.pp
                        <FPCSrcDir>/rtl/netbsd/classes.pp
                        <FPCSrcDir>/rtl/linux/classes.pp
                        <FPCSrcDir>/rtl/os2/classes.pp
                        <FPCSrcDir>/rtl/freebsd/classes.pp
                        <FPCSrcDir>/rtl/openbsd/classes.pp
                        <FPCSrcDir>/rtl/netware/classes.pp
                        <FPCSrcDir>/rtl/darwin/classes.pp
                        <FPCSrcDir>/rtl/morphos/classes.pp
                        <FPCSrcDir>/fcl/sunos/classes.pp
                        <FPCSrcDir>/fcl/beos/classes.pp
                        <FPCSrcDir>/fcl/qnx/classes.pp
                        <FPCSrcDir>/fcl/classes/win32/classes.pp
                        <FPCSrcDir>/fcl/classes/go32v2/classes.pp
                        <FPCSrcDir>/fcl/classes/netbsd/classes.pp
                        <FPCSrcDir>/fcl/classes/linux/classes.pp
                        <FPCSrcDir>/fcl/classes/os2/classes.pp
                        <FPCSrcDir>/fcl/classes/freebsd/classes.pp
                        <FPCSrcDir>/fcl/classes/openbsd/classes.pp
                        <FPCSrcDir>/fcl/template/classes.pp
                        <FPCSrcDir>/fcl/amiga/classes.pp

                       This means, there are several possible macro filenames:
                        $(#FPCSrcDir)/rtl/$(#TargetOS)/classes.pp
                        $(#FPCSrcDir)/fcl/$(#TargetOS)/classes.pp
                        $(#FPCSrcDir)/fcl/classes/$(#TargetOS)/classes.pp
                        
                   Example: libc.pp
                     <FPCSrcDir>/rtl/netwlibc/libc.pp
                     <FPCSrcDir>/packages/base/libc/libc.pp
                     There are no macros and no templates. This is a special case.
                     
                  }
                  if (AUnitName='libc')
                  and (System.Pos(AppendPathDelim(FPCSrcDir)+'packages'+PathDelim,ADirPath)>0)
                  then begin
                    // <FPCSrcDir>/rtl/netwlibc/libc.pp
                    // <FPCSrcDir>/packages/base/libc/libc.pp
                    inc(Priority,2);
                  end;
                  //DebugLn(['BrowseDirectory duplicate found: ',AUnitName,' OldUnitLink.Filename=',OldUnitLink.Filename,' MacroFileName=',MacroFileName,' Priority=',Priority,' OldUnitLink.Priority=',OldUnitLink.Score]);
                  if (Priority>OldUnitLink.Score)
                  or ((Priority=OldUnitLink.Score)
                     and (UsedMacroCount>OldUnitLink.UsedMacroCount))
                  then begin
                    // take the new macro filename
                    OldUnitLink.Filename:=MacroFileName;
                    OldUnitLink.MacroCount:=MacroCount;
                    OldUnitLink.Score:=Priority;
                  end;
                end;
              end;
            end;
          end;
        until FindNextUTF8(FileInfo)<>0;
      end;
      FindCloseUTF8(FileInfo);
    end;
  
  begin
    if UnitTree<>nil then exit(true);
    UnitTree:=TAVLTree.Create(@CompareUnitLinkNodes);
    Result:=BrowseDirectory(Dir,0);
  end;
  

  procedure AddFPCSourceLinkForUnit(const AnUnitName: string);
  var UnitLink: TUnitNameLink;
    s: string;
  begin
    // search
    if AnUnitName='' then exit;
    UnitLink:=FindUnitLink(AnUnitName);
    {$IFDEF VerboseFPCSrcScan}
    DbgOut('AddFPCSourceLinkForUnit ',AnUnitName,' ');
    if UnitLink<>nil then
      DebugLn(' -> ',UnitLink.Filename)
    else
      DebugLn('MISSING');
    {$ELSE}
    if (UnitLink=nil) and (CTConsoleVerbosity>=0) then
      DebugLn(['Warning: unable to find source of fpc unit ',AnUnitName]);
    {$ENDIF}
    if UnitLink=nil then exit;
    s:=AnUnitName+' '+UnitLink.Filename+LineEnding;
    UnitLinkList:=UnitLinkList+s;
  end;

  function FindStandardPPUSources: boolean;
  var PathStart, PathEnd: integer;
    ADirPath, AUnitName: string;
    FileInfo: TSearchRec;
    CurMask: String;
  begin
    Result:=false;
    {$IFDEF VerboseFPCSrcScan}
    DebugLn('FindStandardPPUSources ..');
    {$ENDIF}
    // try every ppu file in every reachable directory (CompUnitPath)
    if UnitLinkListValid then exit(true);
    UnitLinkList:='';
    PathStart:=1;
    CurMask:=PPUExt;
    if CurMask='' then CurMask:='.ppu';
    if CurMask[1]<>'.' then
      CurMask:='.'+CurMask;
    CurMask:='*'+CurMask;
    //DebugLn('FindStandardPPUSources UnitSearchPath="',UnitSearchPath,'"');
    while PathStart<=length(UnitSearchPath) do begin
      while (PathStart<=length(UnitSearchPath))
      and (UnitSearchPath[PathStart]=';') do
        inc(PathStart);
      PathEnd:=PathStart;
      // extract single path from unit search path
      while (PathEnd<=length(UnitSearchPath))
      and (UnitSearchPath[PathEnd]<>';') do
        inc(PathEnd);
      if PathEnd>PathStart then begin
        ADirPath:=copy(UnitSearchPath,PathStart,PathEnd-PathStart);
        {$IFDEF VerboseFPCSrcScan}
        DebugLn('FindStandardPPUSources Searching ',CurMask,' in ',ADirPath);
        {$ENDIF}
        inc(ProgressID);
        if CheckAbort(ProgressID,-1,'') then exit(false);
        // search all ppu files in this directory
        if FindFirstUTF8(ADirPath+CurMask,faAnyFile,FileInfo)=0 then begin
          repeat
            AUnitName:=lowercase(ExtractFileNameOnly(FileInfo.Name));
            {$IFDEF VerboseFPCSrcScan}
            DebugLn('FindStandardPPUSources Found: ',AUnitName);
            {$ENDIF}
            if (UnitTree=nil) and (not GatherUnits) then exit;
            AddFPCSourceLinkForUnit(AUnitName);
            if (UnitTree=nil) or (UnitTree.Count=0) then exit;
          until FindNextUTF8(FileInfo)<>0;
        end;
        FindCloseUTF8(FileInfo);
      end;
      PathStart:=PathEnd;
    end;
    UnitLinkListValid:=true;
    Result:=true;
  end;
  
  procedure AddProcessorTypeDefine(ParentDefTempl: TDefineTemplate);
  // some FPC source files expects defines 'i386' instead of 'CPUi386'
  // define them automatically with IF..THEN constructs
  var
    i: Integer;
    CPUName: String;
    IfTemplate: TDefineTemplate;
  begin
    // FPC defines CPUxxx defines (e.g. CPUI386, CPUPOWERPC).
    // These defines are created by the compiler depending
    // on xxx defines (i386, powerpc).
    // Create:
    //   IF CPUi386 then define i386
    //   IF CPUpowerpc then define powerpc
    //   ...
    for i:=Low(FPCProcessorNames) to high(FPCProcessorNames) do begin
      CPUName:=FPCProcessorNames[i];
      IfTemplate:=TDefineTemplate.Create('IFDEF CPU'+CPUName,
        'IFDEF CPU'+CPUName,'CPU'+CPUName,'',da_IfDef);
      IfTemplate.AddChild(TDefineTemplate.Create('DEFINE '+CPUName,
        'DEFINE '+CPUName,CPUName,'',da_DefineRecurse));
      ParentDefTempl.AddChild(IfTemplate);
    end;
  end;
  
  procedure AddSrcOSDefines(ParentDefTempl: TDefineTemplate);
  var
    IfTargetOSIsNotSrcOS: TDefineTemplate;
    RTLSrcOSDir: TDefineTemplate;
    IfTargetOSIsNotSrcOS2: TDefineTemplate;
    RTLSrcOS2Dir: TDefineTemplate;
  begin
    // if TargetOS<>SrcOS
    IfTargetOSIsNotSrcOS:=TDefineTemplate.Create(
      'IF TargetOS<>SrcOS',
      ctsIfTargetOSIsNotSrcOS,'',''''+TargetOSMacro+'''<>'''+SrcOS+'''',da_If);
    // rtl/$(#SrcOS)
    RTLSrcOSDir:=TDefineTemplate.Create('SrcOS',SrcOS,'',
      SrcOS,da_Directory);
    IfTargetOSIsNotSrcOS.AddChild(RTLSrcOSDir);
    RTLSrcOSDir.AddChild(TDefineTemplate.Create('Include Path',
      'include path',
      IncludePathMacroName,IncPathMacro+';inc',
      da_Define));
    RTLSrcOSDir.AddChild(TDefineTemplate.Create('Include Path',
      'include path to TargetCPU directories',
      IncludePathMacroName,IncPathMacro+';'+TargetCPU,
      da_Define));
    ParentDefTempl.AddChild(IfTargetOSIsNotSrcOS);

    // if TargetOS<>SrcOS2
    IfTargetOSIsNotSrcOS2:=TDefineTemplate.Create(
      'IF TargetOS is not SrcOS2',
      ctsIfTargetOSIsNotSrcOS,'',''''+TargetOSMacro+'''<>'''+SrcOS2+'''',da_If);
    // rtl/$(#SrcOS2)
    RTLSrcOS2Dir:=TDefineTemplate.Create('SrcOS2',SrcOS2,'',
      SrcOS2,da_Directory);
    IfTargetOSIsNotSrcOS2.AddChild(RTLSrcOS2Dir);
    RTLSrcOS2Dir.AddChild(TDefineTemplate.Create('Include Path',
      'include path to TargetCPU directories',
      IncludePathMacroName,IncPathMacro+';'+TargetCPU,
      da_DefineRecurse));
    ParentDefTempl.AddChild(IfTargetOSIsNotSrcOS2);
  end;

var
  DefTempl: TDefineTemplate;
  Ok: Boolean;
begin
  {$IFDEF VerboseFPCSrcScan}
  DebugLn('CreateFPCSrcTemplate ',FPCSrcDir,': length(UnitSearchPath)=',DbgS(length(UnitSearchPath)),' Valid=',DbgS(UnitLinkListValid),' PPUExt=',PPUExt);
  {$ENDIF}
  if UnitSearchPath='' then begin
    DebugLn(['Note: [TDefinePool.CreateFPCSrcTemplate] UnitSearchPath empty']);
  end;
  Result:=nil;
  ProgressID:=0;
  Ok:=false;
  try
    Dir:=AppendPathDelim(FPCSrcDir);
    SrcOS:='$('+ExternalMacroStart+'SrcOS)';
    SrcOS2:='$('+ExternalMacroStart+'SrcOS2)';
    TargetCPU:=TargetCPUMacro;
    IncPathMacro:=IncludePathMacro;
    DefaultSrcOS:=GetDefaultSrcOSForTargetOS(DefaultTargetOS);
    DefaultSrcOS2:=GetDefaultSrcOS2ForTargetOS(DefaultTargetOS);

    if (FPCSrcDir='') or (not DirPathExists(FPCSrcDir)) then begin
      DebugLn(['Warning: [TDefinePool.CreateFPCSrcTemplate] FPCSrcDir does not exist: FPCSrcDir="',FPCSrcDir,'" (env FPCDIR)']);
      exit;
    end;
    // try to find for every reachable ppu file the unit file in the FPC sources
    UnitLinks:=UnitLinksMacroName;
    UnitTree:=nil;
    if not FindStandardPPUSources then exit;

    Result:=CreateFPCSourceTemplate(FPCSrcDir,Owner);

    DefTempl:=TDefineTemplate.Create('FPC Unit Links',
      ctsSourceFilenamesForStandardFPCUnits,
      UnitLinks,UnitLinkList,da_DefineRecurse);
    Result.AddChild(DefTempl);

    // clean up
    if UnitTree<>nil then begin
      UnitTree.FreeAndClear;
      UnitTree.Free;
    end;

    Result.SetDefineOwner(Owner,true);
    Result.SetFlags([dtfAutoGenerated],[],false);

    Ok:=true;
  finally
    if not ok then
      FreeAndNil(Result);
    if (ProgressID>0) and Assigned(OnProgress) then
      OnProgress(Self,ProgressID,ProgressID,'',Ok);
  end;
end;

function TDefinePool.CreateDelphiSrcPath(DelphiVersion: integer;
  const PathPrefix: string): string;
begin
  case DelphiVersion of
  1..5:
    Result:=PathPrefix+'Source/Rtl/Win;'
      +PathPrefix+'Source/Rtl/Sys;'
      +PathPrefix+'Source/Rtl/Corba;'
      +PathPrefix+'Source/Vcl;';
  else
    // 6 and above
    Result:=PathPrefix+'Source/Rtl/Win;'
      +PathPrefix+'Source/Rtl/Sys;'
      +PathPrefix+'Source/Rtl/Common;'
      +PathPrefix+'Source/Rtl/Corba40;'
      +PathPrefix+'Source/Vcl;';
  end;
end;

function TDefinePool.CreateLazarusSrcTemplate(
  const LazarusSrcDir, WidgetType, ExtraOptions: string;
  Owner: TObject): TDefineTemplate;

  function D(const Filename: string): string;
  begin
    Result:=SetDirSeparators(Filename);
  end;
    
var
  MainDir, DirTempl, SubDirTempl, IfTemplate,
  SubTempl: TDefineTemplate;
  TargetOS, SrcOS, SrcPath: string;
  i: Integer;
  CurCPU, CurOS, CurWidgetSet: string;
  ToolsInstallDirTempl: TDefineTemplate;
  AllWidgetSets: String;
begin
  Result:=nil;
  if (LazarusSrcDir='') or (WidgetType='') then exit;
  TargetOS:='$('+ExternalMacroStart+'TargetOS)';
  SrcOS:='$('+ExternalMacroStart+'SrcOS)';
  SrcPath:='$('+ExternalMacroStart+'SrcPath)';

  AllWidgetSets:='';
  for i:=Low(Lazarus_CPU_OS_Widget_Combinations)
      to High(Lazarus_CPU_OS_Widget_Combinations) do
  begin
    SplitLazarusCPUOSWidgetCombo(Lazarus_CPU_OS_Widget_Combinations[i],
                                 CurCPU,CurOS,CurWidgetSet);
    if not HasDelimitedItem(AllWidgetSets,';',CurWidgetSet) then begin
      if AllWidgetSets<>'' then
        AllWidgetSets:=AllWidgetSets+';';
      AllWidgetSets:=AllWidgetSets+CurWidgetSet;
    end;
  end;

  // <LazarusSrcDir>
  MainDir:=TDefineTemplate.Create(
    StdDefTemplLazarusSrcDir, ctsDefsForLazarusSources,'',LazarusSrcDir,
    da_Directory);
  // clear src path
  MainDir.AddChild(TDefineTemplate.Create('Clear SrcPath','Clear SrcPath',
    ExternalMacroStart+'SrcPath','',da_DefineRecurse));
  // if SrcOS<>win
  IfTemplate:=TDefineTemplate.Create('IF '''+SrcOS+'''<>''win''',
    ctsIfTargetOSIsNotWin32,'',''''+SrcOS+'''<>''win''',da_If);
    // then define #SrcPath := #SrcPath;lcl/nonwin32
    IfTemplate.AddChild(TDefineTemplate.Create('win32api for non win',
      Format(ctsAddsDirToSourcePath,[d(LazarusSrcDir+'/lcl/nonwin32')]),
      ExternalMacroStart+'SrcPath',
      d(LazarusSrcDir+'/lcl/nonwin32;')+SrcPath,da_DefineRecurse));
  MainDir.AddChild(IfTemplate);
  // define 'LCL'
  MainDir.AddChild(TDefineTemplate.Create('define LCL',
    ctsDefineLCL,'LCL',WidgetType,da_DefineRecurse));
  // define LCLwidgetset, e.g. LCLcarbon, LCLgtk, LCLgtk2
  MainDir.AddChild(TDefineTemplate.Create('Define LCLwidgettype',
    ctsDefineLCLWidgetset,
    'LCL$(#LCLWidgetType)','',da_DefineRecurse));

  // <LazarusSrcDir>/ide
  DirTempl:=TDefineTemplate.Create('ide',ctsIDEDirectory,
    '','ide',da_Directory);
  DirTempl.AddChild(TDefineTemplate.Create('IDE path addition',
    Format(ctsAddsDirToSourcePath,['designer, debugger, synedit, ...']),
    ExternalMacroStart+'SrcPath',
      d(LazarusSrcDir+'/ide;'
       +LazarusSrcDir+'/ide/frames;'
       +LazarusSrcDir+'/designer;'
       +LazarusSrcDir+'/debugger;'
       +LazarusSrcDir+'/debugger/frames;'
       +LazarusSrcDir+'/converter;'
       +LazarusSrcDir+'/packager;'
       +LazarusSrcDir+'/packager/registration;'
       +LazarusSrcDir+'/packager/frames;'
       +LazarusSrcDir+'/components/ideintf;'
       +LazarusSrcDir+'/components/lazutils;'
       +LazarusSrcDir+'/components/lazcontrols;'
       +LazarusSrcDir+'/components/synedit;'
       +LazarusSrcDir+'/components/codetools;'
       +LazarusSrcDir+'/components/lazdebuggergdbmi;'
       +LazarusSrcDir+'/components/debuggerintf;'
       +LazarusSrcDir+'/lcl;'
       +LazarusSrcDir+'/lcl/interfaces;'
       +LazarusSrcDir+'/lcl/interfaces/'+WidgetType+';'
       +LazarusSrcDir+'/components/custom;'
       +SrcPath)
    ,da_DefineRecurse));
  // include path addition
  DirTempl.AddChild(TDefineTemplate.Create('includepath addition',
    Format(ctsSetsIncPathTo,['include, include/TargetOS, include/SrcOS']),
    IncludePathMacroName,
    d(LazarusSrcDir+'/ide/include;'
      +LazarusSrcDir+'/ide/include/'+TargetOS+';'
      +LazarusSrcDir+'/ide/include/'+SrcOS),
    da_DefineRecurse));
  MainDir.AddChild(DirTempl);

  // <LazarusSrcDir>/designer
  DirTempl:=TDefineTemplate.Create('Designer',ctsDesignerDirectory,
    '','designer',da_Directory);
  DirTempl.AddChild(TDefineTemplate.Create('components path addition',
    Format(ctsAddsDirToSourcePath,['synedit']),
    SrcPathMacroName,
      d('../components/lazutils'
       +';../components/codetools'
       +';../lcl'
       +';../lcl/interfaces'
       +';../lcl/interfaces/'+WidgetType
       +';../components/ideintf'
       +';../components/synedit'
       +';../components/codetools'
       +';../components/lazcontrols'
       +';../components/custom')
       +';'+SrcPath
    ,da_Define));
  DirTempl.AddChild(TDefineTemplate.Create('main path addition',
    Format(ctsAddsDirToSourcePath,[ctsLazarusMainDirectory]),
    SrcPathMacroName,
    d('../ide;../packager;')+SrcPath
    ,da_Define));
  DirTempl.AddChild(TDefineTemplate.Create('includepath addition',
    Format(ctsIncludeDirectoriesPlusDirs,['include']),
    IncludePathMacroName,
    d('../ide/include;../ide/include/'+TargetOS),
    da_Define));
  // <LazarusSrcDir>/designer/units
  MainDir.AddChild(DirTempl);


  // <LazarusSrcDir>/images


  // <LazarusSrcDir>/debugger
  DirTempl:=TDefineTemplate.Create('Debugger',ctsDebuggerDirectory,
    '','debugger',da_Directory);
  DirTempl.AddChild(TDefineTemplate.Create('LCL path addition',
    Format(ctsAddsDirToSourcePath,['lcl, components']),
    ExternalMacroStart+'SrcPath',
      d(LazarusSrcDir+'/debugger;'
       +LazarusSrcDir+'/debugger/frames;'
       +LazarusSrcDir+'/ide;'
       +LazarusSrcDir+'/components/ideintf;'
       +LazarusSrcDir+'/components/lazutils;'
       +LazarusSrcDir+'/components/codetools;'
       +LazarusSrcDir+'/components/lazdebuggergdbmi;'
       +LazarusSrcDir+'/components/debuggerintf;'
       +LazarusSrcDir+'/lcl;'
       +LazarusSrcDir+'/lcl/interfaces;'
       +LazarusSrcDir+'/lcl/interfaces/'+WidgetType+';')
       +SrcPath
    ,da_DefineRecurse));
  MainDir.AddChild(DirTempl);


  // <LazarusSrcDir>/converter
  DirTempl:=TDefineTemplate.Create('Converter',ctsDebuggerDirectory,
    '','converter',da_Directory);
  DirTempl.AddChild(TDefineTemplate.Create('LCL path addition',
    Format(ctsAddsDirToSourcePath,['lcl, components']),
    ExternalMacroStart+'SrcPath',
      d('../ide'
       +';../components/ideintf'
       +';../components/lazutils'
       +';../components/codetools'
       +';../components/synedit'
       +';../components/lazcontrols'
       +';../packager'
       +';../debugger'
       +';../designer'
       +';../lcl'
       +';../lcl/interfaces'
       +';../lcl/interfaces/'+WidgetType)
       +';'+SrcPath
    ,da_Define));
  MainDir.AddChild(DirTempl);


  // <LazarusSrcDir>/packager
  DirTempl:=TDefineTemplate.Create('Packager',ctsDesignerDirectory,
    '','packager',da_Directory);
  DirTempl.AddChild(TDefineTemplate.Create('src path addition',
    Format(ctsAddsDirToSourcePath,['lcl synedit codetools lazcontrols ideintf']),
    SrcPathMacroName,
      d(LazarusSrcDir+'/lcl'
      +';'+LazarusSrcDir+'/lcl/interfaces'
      +';'+LazarusSrcDir+'/lcl/interfaces/'+WidgetType
      +';'+LazarusSrcDir+'/ide'
      +';'+LazarusSrcDir+'/components/ideintf'
      +';'+LazarusSrcDir+'/components/synedit'
      +';'+LazarusSrcDir+'/components/lazcontrols'
      +';'+LazarusSrcDir+'/components/lazutils'
      +';'+LazarusSrcDir+'/components/codetools'
      +';'+LazarusSrcDir+'/packager/frames'
      +';'+LazarusSrcDir+'/packager/registration'
      +';'+SrcPath)
    ,da_DefineRecurse));
  DirTempl.AddChild(TDefineTemplate.Create('includepath addition',
    Format(ctsIncludeDirectoriesPlusDirs,['include']),
    IncludePathMacroName,
    d('../ide/include;../ide/include/'+TargetOS),
    da_Define));
  // <LazarusSrcDir>/packager/frames
  SubDirTempl:=TDefineTemplate.Create('Frames',
    'Frames','','frames',da_Directory);
  DirTempl.AddChild(SubDirTempl);
  SubDirTempl.AddChild(TDefineTemplate.Create('src path addition',
    Format(ctsAddsDirToSourcePath,['ide']),
    SrcPathMacroName,
    d(LazarusSrcDir+'/ide;'+LazarusSrcDir+'/packager;'+SrcPath)
    ,da_Define));
  // <LazarusSrcDir>/packager/registration
  SubDirTempl:=TDefineTemplate.Create('Registration',
    ctsPackagerRegistrationDirectory,'','registration',da_Directory);
  DirTempl.AddChild(SubDirTempl);
  // <LazarusSrcDir>/packager/units
  SubDirTempl:=TDefineTemplate.Create('Packager Units',
    ctsPackagerUnitsDirectory,'','units',da_Directory);
  SubDirTempl.AddChild(TDefineTemplate.Create('CompiledSrcPath',
    ctsCompiledSrcPath,CompiledSrcPathMacroName,
    LazarusSrcDir+d('/packager/registration'),
    da_DefineRecurse));
  DirTempl.AddChild(SubDirTempl);
  MainDir.AddChild(DirTempl);


  // <LazarusSrcDir>/examples
  DirTempl:=TDefineTemplate.Create('Examples',
    Format(ctsNamedDirectory,['Examples']),
    '','examples',da_Directory);
  DirTempl.AddChild(TDefineTemplate.Create('LCL path addition',
    Format(ctsAddsDirToSourcePath,['lcl']),
    ExternalMacroStart+'SrcPath',
      d('../lcl'
      +';../lcl/interfaces/'+WidgetType+';'+SrcPath)
    ,da_Define));
  MainDir.AddChild(DirTempl);

  // <LazarusSrcDir>/components
  DirTempl:=TDefineTemplate.Create('Components',ctsComponentsDirectory,
    '','components',da_Directory);

  // <LazarusSrcDir>/components/custom
  SubDirTempl:=TDefineTemplate.Create('Custom Components',
    ctsCustomComponentsDirectory,
    '','custom',da_Directory);
  SubDirTempl.AddChild(TDefineTemplate.Create('lazarus standard components',
    Format(ctsAddsDirToSourcePath,['synedit']),
    ExternalMacroStart+'SrcPath',
    d('../synedit;')
    +SrcPath
    ,da_DefineRecurse));
  DirTempl.AddChild(SubDirTempl);
  MainDir.AddChild(DirTempl);

  // <LazarusSrcDir>/tools
  DirTempl:=TDefineTemplate.Create('Tools',
    ctsToolsDirectory,'','tools',da_Directory);
  DirTempl.AddChild(TDefineTemplate.Create('LCL path addition',
    Format(ctsAddsDirToSourcePath,['lcl']),
    ExternalMacroStart+'SrcPath',
    d('../lcl;../lcl/interfaces/'+WidgetType
    +';../components/codetools')
    +';'+SrcPath
    ,da_Define));
    // <LazarusSrcDir>/tools/install
    ToolsInstallDirTempl:=TDefineTemplate.Create('Install',
      ctsInstallDirectory,'','install',da_Directory);
    DirTempl.AddChild(ToolsInstallDirTempl);
    ToolsInstallDirTempl.AddChild(TDefineTemplate.Create('LCL path addition',
      Format(ctsAddsDirToSourcePath,['lcl']),
      ExternalMacroStart+'SrcPath',
      d('../../lcl;../../lcl/interfaces/'+WidgetType
      +';../../components/codetools')
      +';'+SrcPath
      ,da_Define));
  MainDir.AddChild(DirTempl);

  // extra options
  SubTempl:=CreateFPCCommandLineDefines(StdDefTemplLazarusBuildOpts,
                                        ExtraOptions,true,Owner);
  MainDir.AddChild(SubTempl);

  // put it all into a block
  if MainDir<>nil then begin
    Result:=TDefineTemplate.Create(StdDefTemplLazarusSources,
       ctsLazarusSources,'','',da_Block);
    Result.AddChild(MainDir);
  end;
  
  Result.SetDefineOwner(Owner,true);
  Result.SetFlags([dtfAutoGenerated],[],false);
end;

function TDefinePool.CreateLCLProjectTemplate(
  const LazarusSrcDir, WidgetType, ProjectDir: string;
  Owner: TObject): TDefineTemplate;
var DirTempl: TDefineTemplate;
begin
  Result:=nil;
  if (LazarusSrcDir='') or (WidgetType='') or (ProjectDir='') then exit;
  DirTempl:=TDefineTemplate.Create('ProjectDir',ctsAnLCLProject,
    '',ProjectDir,da_Directory);
  DirTempl.AddChild(TDefineTemplate.Create('LCL',
    Format(ctsAddsDirToSourcePath,['lcl']),
    ExternalMacroStart+'SrcPath',
    LazarusSrcDir+PathDelim+'lcl;'
     +LazarusSrcDir+PathDelim+'lcl'+PathDelim+'interfaces'
     +PathDelim+WidgetType
     +';$('+ExternalMacroStart+'SrcPath)'
    ,da_DefineRecurse));
  Result:=TDefineTemplate.Create(StdDefTemplLCLProject,
       'LCL Project','','',da_Block);
  Result.AddChild(DirTempl);
  Result.SetDefineOwner(Owner,true);
  Result.SetFlags([dtfAutoGenerated],[],false);
end;

function TDefinePool.CreateDelphiCompilerDefinesTemplate(
  DelphiVersion: integer; Owner: TObject): TDefineTemplate;
var
  DefTempl: TDefineTemplate;
  VerMacro: String;
begin
  DefTempl:=TDefineTemplate.Create('Delphi'+IntToStr(DelphiVersion)
      +' Compiler Defines',
      Format(ctsOtherCompilerDefines,['Delphi'+IntToStr(DelphiVersion)]),
      '','',da_Block);
  DefTempl.AddChild(TDefineTemplate.Create('Reset',
      ctsResetAllDefines,
      '','',da_UndefineAll));
  DefTempl.AddChild(TDefineTemplate.Create('Define macro DELPHI',
      Format(ctsDefineMacroName,['DELPHI']),
      'DELPHI','',da_DefineRecurse));
  DefTempl.AddChild(TDefineTemplate.Create('Define macro FPC_DELPHI',
      Format(ctsDefineMacroName,['FPC_DELPHI']),
      'FPC_DELPHI','',da_DefineRecurse));
  DefTempl.AddChild(TDefineTemplate.Create('Define macro MSWINDOWS',
      Format(ctsDefineMacroName,['MSWINDOWS']),
      'MSWINDOWS','',da_DefineRecurse));

  // version
  case DelphiVersion of
  3: VerMacro:='VER_110';
  4: VerMacro:='VER_125';
  5: VerMacro:='VER_130';
  6: VerMacro:='VER_140';
  else
    // else define Delphi 7
    VerMacro:='VER_150';
  end;
  DefTempl.AddChild(TDefineTemplate.Create('Define macro '+VerMacro,
      Format(ctsDefineMacroName,[VerMacro]),
      VerMacro,'',da_DefineRecurse));

  DefTempl.AddChild(TDefineTemplate.Create(
     Format(ctsDefineMacroName,[ExternalMacroStart+'Compiler']),
     'Define '+ExternalMacroStart+'Compiler variable',
     ExternalMacroStart+'Compiler','DELPHI',da_DefineRecurse));

  Result:=DefTempl;
  Result.SetDefineOwner(Owner,true);
end;

function TDefinePool.CreateDelphiDirectoryTemplate(
  const DelphiDirectory: string; DelphiVersion: integer;
  Owner: TObject): TDefineTemplate;
var MainDirTempl: TDefineTemplate;
begin
  MainDirTempl:=TDefineTemplate.Create('Delphi'+IntToStr(DelphiVersion)
     +' Directory',
     Format(ctsNamedDirectory,['Delphi'+IntToStr(DelphiVersion)]),
     '',DelphiDirectory,da_Directory);
  MainDirTempl.AddChild(CreateDelphiCompilerDefinesTemplate(DelphiVersion,Owner));
  MainDirTempl.AddChild(TDefineTemplate.Create('SrcPath',
      Format(ctsSetsSrcPathTo,['RTL, VCL']),
      ExternalMacroStart+'SrcPath',
      SetDirSeparators(
          CreateDelphiSrcPath(DelphiVersion,DefinePathMacro+'/')+'$(#SrcPath)'),
      da_DefineRecurse));

  Result:=MainDirTempl;
  Result.SetDefineOwner(Owner,true);
end;

function TDefinePool.CreateDelphiProjectTemplate(
  const ProjectDir, DelphiDirectory: string;
  DelphiVersion: integer; Owner: TObject): TDefineTemplate;
var MainDirTempl: TDefineTemplate;
begin
  MainDirTempl:=TDefineTemplate.Create('Delphi'+IntToStr(DelphiVersion)+' Project',
     Format(ctsNamedProject,['Delphi'+IntToStr(DelphiVersion)]),
     '',ProjectDir,da_Directory);
  MainDirTempl.AddChild(
    CreateDelphiCompilerDefinesTemplate(DelphiVersion,Owner));
  MainDirTempl.AddChild(TDefineTemplate.Create(
     'Define '+ExternalMacroStart+'DelphiDir',
     Format(ctsDefineMacroName,[ExternalMacroStart+'DelphiDir']),
     ExternalMacroStart+'DelphiDir',DelphiDirectory,da_DefineRecurse));
  MainDirTempl.AddChild(TDefineTemplate.Create('SrcPath',
      Format(ctsAddsDirToSourcePath,['Delphi RTL+VCL']),
      ExternalMacroStart+'SrcPath',
      SetDirSeparators(CreateDelphiSrcPath(DelphiVersion,'$(#DelphiDir)/')
                       +'$(#SrcPath)'),
      da_DefineRecurse));

  Result:=MainDirTempl;
  Result.SetDefineOwner(Owner,true);
end;

function TDefinePool.CreateKylixCompilerDefinesTemplate(KylixVersion: integer;
  Owner: TObject): TDefineTemplate;
var
  DefTempl: TDefineTemplate;
begin
  DefTempl:=TDefineTemplate.Create('Kylix'+IntToStr(KylixVersion)
      +' Compiler Defines',
      Format(ctsOtherCompilerDefines,['Kylix'+IntToStr(KylixVersion)]),
      '','',da_Block);
  DefTempl.AddChild(TDefineTemplate.Create('Reset',
      ctsResetAllDefines,
      '','',da_UndefineAll));
  DefTempl.AddChild(TDefineTemplate.Create('Define macro KYLIX',
      Format(ctsDefineMacroName,['KYLIX']),
      'KYLIX','',da_DefineRecurse));
  DefTempl.AddChild(TDefineTemplate.Create('Define macro FPC_DELPHI',
      Format(ctsDefineMacroName,['FPC_DELPHI']),
      'FPC_DELPHI','',da_DefineRecurse));
  DefTempl.AddChild(TDefineTemplate.Create('Define macro LINUX',
      Format(ctsDefineMacroName,['LINUX']),
      'LINUX','',da_DefineRecurse));
  DefTempl.AddChild(TDefineTemplate.Create('Define macro CPU386',
      Format(ctsDefineMacroName,['CPU386']),
      'CPU386','',da_DefineRecurse));

  // version
  case KylixVersion of
  1:
    DefTempl.AddChild(TDefineTemplate.Create('Define macro VER_125',
        Format(ctsDefineMacroName,['VER_125']),
        'VER_125','',da_DefineRecurse));
  2:
    DefTempl.AddChild(TDefineTemplate.Create('Define macro VER_130',
        Format(ctsDefineMacroName,['VER_130']),
        'VER_130','',da_DefineRecurse));
  else
    // else define Kylix 3
    DefTempl.AddChild(TDefineTemplate.Create('Define macro VER_140',
        Format(ctsDefineMacroName,['VER_140']),
        'VER_140','',da_DefineRecurse));
  end;

  DefTempl.AddChild(TDefineTemplate.Create(
     Format(ctsDefineMacroName,[ExternalMacroStart+'Compiler']),
     'Define '+ExternalMacroStart+'Compiler variable',
     ExternalMacroStart+'Compiler','DELPHI',da_DefineRecurse));

  Result:=DefTempl;
  Result.SetDefineOwner(Owner,true);
end;

function TDefinePool.CreateKylixSrcPath(KylixVersion: integer;
  const PathPrefix: string): string;
begin
  Result:=PathPrefix+'source/rtl/linux;'
    +PathPrefix+'source/rtl/sys;'
    +PathPrefix+'source/rtl/common;'
    +PathPrefix+'source/rtl/corba40;'
    +PathPrefix+'source/rtle;'
    +PathPrefix+'source/rtl/clx';
end;

function TDefinePool.CreateKylixDirectoryTemplate(const KylixDirectory: string;
  KylixVersion: integer; Owner: TObject): TDefineTemplate;
var MainDirTempl: TDefineTemplate;
begin
  MainDirTempl:=TDefineTemplate.Create('Kylix'+IntToStr(KylixVersion)
     +' Directory',
     Format(ctsNamedDirectory,['Kylix'+IntToStr(KylixVersion)]),
     '',KylixDirectory,da_Directory);
  MainDirTempl.AddChild(CreateKylixCompilerDefinesTemplate(KylixVersion,Owner));
  MainDirTempl.AddChild(TDefineTemplate.Create('SrcPath',
      Format(ctsSetsSrcPathTo,['RTL, CLX']),
      ExternalMacroStart+'SrcPath',
      SetDirSeparators(CreateKylixSrcPath(KylixVersion,DefinePathMacro+'/')
                       +'$(#SrcPath)'),
      da_DefineRecurse));

  Result:=MainDirTempl;
  Result.SetDefineOwner(Owner,true);
end;

function TDefinePool.CreateKylixProjectTemplate(const ProjectDir,
  KylixDirectory: string; KylixVersion: integer; Owner: TObject
  ): TDefineTemplate;
var MainDirTempl: TDefineTemplate;
begin
  MainDirTempl:=TDefineTemplate.Create('Kylix'+IntToStr(KylixVersion)+' Project',
     Format(ctsNamedProject,['Kylix'+IntToStr(KylixVersion)]),
     '',ProjectDir,da_Directory);
  MainDirTempl.AddChild(
    CreateDelphiCompilerDefinesTemplate(KylixVersion,Owner));
  MainDirTempl.AddChild(TDefineTemplate.Create(
     'Define '+ExternalMacroStart+'KylixDir',
     Format(ctsDefineMacroName,[ExternalMacroStart+'KylixDir']),
     ExternalMacroStart+'KylixDir',KylixDirectory,da_DefineRecurse));
  MainDirTempl.AddChild(TDefineTemplate.Create('SrcPath',
      Format(ctsAddsDirToSourcePath,['Kylix RTL+VCL']),
      ExternalMacroStart+'SrcPath',
      SetDirSeparators(CreateKylixSrcPath(KylixVersion,'$(#KylixDir)/')
                       +'$(#SrcPath)'),
      da_DefineRecurse));

  Result:=MainDirTempl;
  Result.SetDefineOwner(Owner,true);
end;

function TDefinePool.CreateFPCCommandLineDefines(const Name, CmdLine: string;
  RecursiveDefines: boolean; Owner: TObject; AlwaysCreate: boolean;
  AddPaths: boolean): TDefineTemplate;

  procedure CreateMainTemplate;
  begin
    if Result=nil then
      Result:=TDefineTemplate.Create(Name,ctsCommandLineParameters,'','',
                                     da_Block);
  end;
  
  procedure AddDefine(const AName, ADescription, AVariable, AValue: string;
    AnAction: TDefineAction);
  var
    NewTempl: TDefineTemplate;
  begin
    if AName='' then exit;
    NewTempl:=TDefineTemplate.Create(AName, ADescription, AVariable, AValue,
                                     AnAction);
    CreateMainTemplate;
    Result.AddChild(NewTempl);
  end;
  
  procedure AddDefine(const AName, ADescription, AVariable, AValue: string);
  var
    NewAction: TDefineAction;
  begin
    //debugln(['AddDefine Name="',AName,'" Var="',AVariable,'" Value="',AValue,'"']);
    if RecursiveDefines then
      NewAction:=da_DefineRecurse
    else
      NewAction:=da_Define;
    AddDefine(AName,ADescription,AVariable,AValue,NewAction);
  end;

  procedure AddDefine(const AParam: string);
  var
    Identifier: String;
    AValue: String;
  begin
    Identifier:=GetIdentifier(PChar(AParam));
    if Identifier='' then exit;
    AValue:='';
    if length(Identifier)<length(AParam) then begin
      if copy(AParam,length(Identifier)+1,2)=':=' then
        AValue:=copy(AParam,length(Identifier)+3,length(AParam));
    end;
    AddDefine('Define '+Identifier,ctsDefine+AParam,Identifier,AValue);
  end;

  procedure AddUndefine(const AParam: string);
  var
    NewAction: TDefineAction;
    Identifier: String;
  begin
    if RecursiveDefines then
      NewAction:=da_UndefineRecurse
    else
      NewAction:=da_Undefine;
    Identifier:=GetIdentifier(PChar(AParam));
    AddDefine('Undefine '+Identifier,ctsUndefine+AParam,Identifier,'',NewAction);
  end;

  procedure AddDefineUndefine(const AName: string; Define: boolean);
  begin
    if Define then
      AddDefine(AName)
    else
      AddUndefine(AName);
  end;

  function FindControllerUnit(const AControllerName: string): string;
  type
    TControllerType = record
      controllertypestr,
      controllerunitstr: string[20];
    end;
  const
    ControllerTypes: array[0..430] of TControllerType =
     ((controllertypestr:'';                  controllerunitstr:''),
      (controllertypestr:'LPC810M021FN8';     controllerunitstr:'LPC8xx'),
      (controllertypestr:'LPC811M001FDH16';   controllerunitstr:'LPC8xx'),
      (controllertypestr:'LPC812M101FDH16';   controllerunitstr:'LPC8xx'),
      (controllertypestr:'LPC812M101FD20';    controllerunitstr:'LPC8xx'),
      (controllertypestr:'LPC812M101FDH20';   controllerunitstr:'LPC8xx'),
      (controllertypestr:'LPC1110FD20';       controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1111FDH20_002';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1111FHN33_101';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1111FHN33_102';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1111FHN33_103';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1111FHN33_201';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1111FHN33_202';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1111FHN33_203';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1112FD20_102';   controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1112FDH20_102';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1112FDH28_102';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1112FHN33_101';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1112FHN33_102';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1112FHN33_103';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1112FHN33_201';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1112FHN24_202';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1112FHN33_202';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1112FHN33_203';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1112FHI33_202';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1112FHI33_203';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1113FHN33_201';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1113FHN33_202';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1113FHN33_203';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1113FHN33_301';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1113FHN33_302';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1113FHN33_303';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1113FBD48_301';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1113FBD48_302';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1113FBD48_303';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1114FDH28_102';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1114FN28_102';   controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1114FHN33_201';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1114FHN33_202';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1114FHN33_203';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1114FHN33_301';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1114FHN33_302';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1114FHN33_303';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1114FHN33_333';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1114FHI33_302';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1114FHI33_303';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1114FBD48_301';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1114FBD48_302';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1114FBD48_303';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1114FBD48_323';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1114FBD48_333';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1115FBD48_303';  controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC11C12FBD48_301'; controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC11C14FBD48_301'; controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC11C22FBD48_301'; controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC11C24FBD48_301'; controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC11D14FBD100_302';controllerunitstr:'LPC11XX'),
      (controllertypestr:'LPC1224FBD48_101';  controllerunitstr:'LPC122X'),
      (controllertypestr:'LPC1224FBD48_121';  controllerunitstr:'LPC122X'),
      (controllertypestr:'LPC1224FBD64_101';  controllerunitstr:'LPC122X'),
      (controllertypestr:'LPC1224FBD64_121';  controllerunitstr:'LPC122X'),
      (controllertypestr:'LPC1225FBD48_301';  controllerunitstr:'LPC122X'),
      (controllertypestr:'LPC1225FBD48_321';  controllerunitstr:'LPC122X'),
      (controllertypestr:'LPC1225FBD64_301';  controllerunitstr:'LPC122X'),
      (controllertypestr:'LPC1225FBD64_321';  controllerunitstr:'LPC122X'),
      (controllertypestr:'LPC1226FBD48_301';  controllerunitstr:'LPC122X'),
      (controllertypestr:'LPC1226FBD64_301';  controllerunitstr:'LPC122X'),
      (controllertypestr:'LPC1227FBD48_301';  controllerunitstr:'LPC122X'),
      (controllertypestr:'LPC1227FBD64_301';  controllerunitstr:'LPC122X'),
      (controllertypestr:'LPC12D27FBD100_301';controllerunitstr:'LPC122X'),
      (controllertypestr:'LPC1311FHN33';      controllerunitstr:'LPC13XX'),
      (controllertypestr:'LPC1311FHN33_01';   controllerunitstr:'LPC13XX'),
      (controllertypestr:'LPC1313FHN33';      controllerunitstr:'LPC13XX'),
      (controllertypestr:'LPC1313FHN33_01';   controllerunitstr:'LPC13XX'),
      (controllertypestr:'LPC1313FBD48';      controllerunitstr:'LPC13XX'),
      (controllertypestr:'LPC1313FBD48_01';   controllerunitstr:'LPC13XX'),
      (controllertypestr:'LPC1315FHN33';      controllerunitstr:'LPC13XX'),
      (controllertypestr:'LPC1315FBD48';      controllerunitstr:'LPC13XX'),
      (controllertypestr:'LPC1316FHN33';      controllerunitstr:'LPC13XX'),
      (controllertypestr:'LPC1316FBD48';      controllerunitstr:'LPC13XX'),
      (controllertypestr:'LPC1317FHN33';      controllerunitstr:'LPC13XX'),
      (controllertypestr:'LPC1317FBD48';      controllerunitstr:'LPC13XX'),
      (controllertypestr:'LPC1317FBD64';      controllerunitstr:'LPC13XX'),
      (controllertypestr:'LPC1342FHN33';      controllerunitstr:'LPC13XX'),
      (controllertypestr:'LPC1342FBD48';      controllerunitstr:'LPC13XX'),
      (controllertypestr:'LPC1343FHN33';      controllerunitstr:'LPC13XX'),
      (controllertypestr:'LPC1343FBD48';      controllerunitstr:'LPC13XX'),
      (controllertypestr:'LPC1345FHN33';      controllerunitstr:'LPC13XX'),
      (controllertypestr:'LPC1345FBD48';      controllerunitstr:'LPC13XX'),
      (controllertypestr:'LPC1346FHN33';      controllerunitstr:'LPC13XX'),
      (controllertypestr:'LPC1346FBD48';      controllerunitstr:'LPC13XX'),
      (controllertypestr:'LPC1347FHN33';      controllerunitstr:'LPC13XX'),
      (controllertypestr:'LPC1347FBD48';      controllerunitstr:'LPC13XX'),
      (controllertypestr:'LPC1347FBD64';      controllerunitstr:'LPC13XX'),
      (controllertypestr:'LPC2114';           controllerunitstr:'LPC21x4'),
      (controllertypestr:'LPC2124';           controllerunitstr:'LPC21x4'),
      (controllertypestr:'LPC2194';           controllerunitstr:'LPC21x4'),
      (controllertypestr:'LPC1754';           controllerunitstr:'LPC1754'),
      (controllertypestr:'LPC1756';           controllerunitstr:'LPC1756'),
      (controllertypestr:'LPC1758';           controllerunitstr:'LPC1758'),
      (controllertypestr:'LPC1764';           controllerunitstr:'LPC1764'),
      (controllertypestr:'LPC1766';           controllerunitstr:'LPC1766'),
      (controllertypestr:'LPC1768';           controllerunitstr:'LPC1768'),
      (controllertypestr:'AT91SAM7S256';      controllerunitstr:'AT91SAM7x256'),
      (controllertypestr:'AT91SAM7SE256';     controllerunitstr:'AT91SAM7x256'),
      (controllertypestr:'AT91SAM7X256';      controllerunitstr:'AT91SAM7x256'),
      (controllertypestr:'AT91SAM7XC256';     controllerunitstr:'AT91SAM7x256'),
      (controllertypestr:'STM32F030C6';       controllerunitstr:'STM32F0XX'),
      (controllertypestr:'STM32F030C8';       controllerunitstr:'STM32F0XX'),
      (controllertypestr:'STM32F030F4';       controllerunitstr:'STM32F0XX'),
      (controllertypestr:'STM32F030K6';       controllerunitstr:'STM32F0XX'),
      (controllertypestr:'STM32F030R8';       controllerunitstr:'STM32F0XX'),
      (controllertypestr:'STM32F050C4';       controllerunitstr:'STM32F0XX'),
      (controllertypestr:'STM32F050C6';       controllerunitstr:'STM32F0XX'),
      (controllertypestr:'STM32F050F4';       controllerunitstr:'STM32F0XX'),
      (controllertypestr:'STM32F050F6';       controllerunitstr:'STM32F0XX'),
      (controllertypestr:'STM32F050G4';       controllerunitstr:'STM32F0XX'),
      (controllertypestr:'STM32F050G6';       controllerunitstr:'STM32F0XX'),
      (controllertypestr:'STM32F050K4';       controllerunitstr:'STM32F0XX'),
      (controllertypestr:'STM32F050K6';       controllerunitstr:'STM32F0XX'),
      (controllertypestr:'STM32F051C4';       controllerunitstr:'STM32F0XX'),
      (controllertypestr:'STM32F051C6';       controllerunitstr:'STM32F0XX'),
      (controllertypestr:'STM32F051C8';       controllerunitstr:'STM32F0XX'),
      (controllertypestr:'STM32F051K4';       controllerunitstr:'STM32F0XX'),
      (controllertypestr:'STM32F051K6';       controllerunitstr:'STM32F0XX'),
      (controllertypestr:'STM32F051K8';       controllerunitstr:'STM32F0XX'),
      (controllertypestr:'STM32F051R4';       controllerunitstr:'STM32F0XX'),
      (controllertypestr:'STM32F051R6';       controllerunitstr:'STM32F0XX'),
      (controllertypestr:'STM32F051R8';       controllerunitstr:'STM32F0XX'),
      (controllertypestr:'STM32F100X4';       controllerunitstr:'STM32F10X_LD'),
      (controllertypestr:'STM32F100X6';       controllerunitstr:'STM32F10X_LD'),
      (controllertypestr:'STM32F100X8';       controllerunitstr:'STM32F10X_MD'),
      (controllertypestr:'STM32F100XB';       controllerunitstr:'STM32F10X_MD'),
      (controllertypestr:'STM32F100XC';       controllerunitstr:'STM32F10X_HD'),
      (controllertypestr:'STM32F100XD';       controllerunitstr:'STM32F10X_HD'),
      (controllertypestr:'STM32F100XE';       controllerunitstr:'STM32F10X_HD'),
      (controllertypestr:'STM32F101X4';       controllerunitstr:'STM32F10X_LD'),
      (controllertypestr:'STM32F101X6';       controllerunitstr:'STM32F10X_LD'),
      (controllertypestr:'STM32F101X8';       controllerunitstr:'STM32F10X_MD'),
      (controllertypestr:'STM32F101XB';       controllerunitstr:'STM32F10X_MD'),
      (controllertypestr:'STM32F101XC';       controllerunitstr:'STM32F10X_HD'),
      (controllertypestr:'STM32F101XD';       controllerunitstr:'STM32F10X_HD'),
      (controllertypestr:'STM32F101XE';       controllerunitstr:'STM32F10X_HD'),
      (controllertypestr:'STM32F101XF';       controllerunitstr:'STM32F10X_XL'),
      (controllertypestr:'STM32F101XG';       controllerunitstr:'STM32F10X_XL'),
      (controllertypestr:'STM32F102X4';       controllerunitstr:'STM32F10X_LD'),
      (controllertypestr:'STM32F102X6';       controllerunitstr:'STM32F10X_LD'),
      (controllertypestr:'STM32F102X8';       controllerunitstr:'STM32F10X_MD'),
      (controllertypestr:'STM32F102XB';       controllerunitstr:'STM32F10X_MD'),
      (controllertypestr:'STM32F103X4';       controllerunitstr:'STM32F10X_LD'),
      (controllertypestr:'STM32F103X6';       controllerunitstr:'STM32F10X_LD'),
      (controllertypestr:'STM32F103X8';       controllerunitstr:'STM32F10X_MD'),
      (controllertypestr:'STM32F103XB';       controllerunitstr:'STM32F10X_MD'),
      (controllertypestr:'STM32F103XC';       controllerunitstr:'STM32F10X_HD'),
      (controllertypestr:'STM32F103XD';       controllerunitstr:'STM32F10X_HD'),
      (controllertypestr:'STM32F103XE';       controllerunitstr:'STM32F10X_HD'),
      (controllertypestr:'STM32F103XF';       controllerunitstr:'STM32F10X_XL'),
      (controllertypestr:'STM32F103XG';       controllerunitstr:'STM32F10X_XL'),
      (controllertypestr:'STM32F107X8';       controllerunitstr:'STM32F10X_CONN'),
      (controllertypestr:'STM32F107XB';       controllerunitstr:'STM32F10X_CONN'),
      (controllertypestr:'STM32F107XC';       controllerunitstr:'STM32F10X_CONN'),
      (controllertypestr:'STM32F105R8';       controllerunitstr:'STM32F10X_CL'),
      (controllertypestr:'STM32F105RB';       controllerunitstr:'STM32F10X_CL'),
      (controllertypestr:'STM32F105RC';       controllerunitstr:'STM32F10X_CL'),
      (controllertypestr:'STM32F105V8';       controllerunitstr:'STM32F10X_CL'),
      (controllertypestr:'STM32F105VB';       controllerunitstr:'STM32F10X_CL'),
      (controllertypestr:'STM32F105VC';       controllerunitstr:'STM32F10X_CL'),
      (controllertypestr:'STM32F107RB';       controllerunitstr:'STM32F10X_CL'),
      (controllertypestr:'STM32F107RC';       controllerunitstr:'STM32F10X_CL'),
      (controllertypestr:'STM32F107VB';       controllerunitstr:'STM32F10X_CL'),
      (controllertypestr:'STM32F107VC';       controllerunitstr:'STM32F10X_CL'),
      (controllertypestr:'STM32F429XE';       controllerunitstr:'STM32F429'),
      (controllertypestr:'STM32F429XG';       controllerunitstr:'STM32F429'),
      (controllertypestr:'STM32F429XI';       controllerunitstr:'STM32F429'),
      (controllertypestr:'STM32F745XE';       controllerunitstr:'STM32F745'),
      (controllertypestr:'STM32F745XG';       controllerunitstr:'STM32F745'),
      (controllertypestr:'STM32F746XE';       controllerunitstr:'STM32F746'),
      (controllertypestr:'STM32F746XG';       controllerunitstr:'STM32F746'),
      (controllertypestr:'STM32F756XE';       controllerunitstr:'STM32F756'),
      (controllertypestr:'STM32F756XG';       controllerunitstr:'STM32F756'),
      (controllertypestr:'LM3S1110';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S1133';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S1138';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S1150';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S1162';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S1165';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S1166';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S2110';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S2139';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S6100';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S6110';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S1601';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S1608';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S1620';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S1635';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S1636';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S1637';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S1651';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S2601';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S2608';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S2620';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S2637';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S2651';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S6610';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S6611';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S6618';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S6633';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S6637';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S8630';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S1911';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S1918';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S1937';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S1958';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S1960';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S1968';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S1969';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S2911';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S2918';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S2919';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S2939';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S2948';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S2950';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S2965';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S6911';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S6918';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S6938';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S6950';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S6952';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S6965';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S8930';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S8933';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S8938';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S8962';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S8970';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S8971';          controllerunitstr:'LM3FURY'),
      (controllertypestr:'LM3S5951';          controllerunitstr:'LM3TEMPEST'),
      (controllertypestr:'LM3S5956';          controllerunitstr:'LM3TEMPEST'),
      (controllertypestr:'LM3S1B21';          controllerunitstr:'LM3TEMPEST'),
      (controllertypestr:'LM3S2B93';          controllerunitstr:'LM3TEMPEST'),
      (controllertypestr:'LM3S5B91';          controllerunitstr:'LM3TEMPEST'),
      (controllertypestr:'LM3S9B81';          controllerunitstr:'LM3TEMPEST'),
      (controllertypestr:'LM3S9B90';          controllerunitstr:'LM3TEMPEST'),
      (controllertypestr:'LM3S9B92';          controllerunitstr:'LM3TEMPEST'),
      (controllertypestr:'LM3S9B95';          controllerunitstr:'LM3TEMPEST'),
      (controllertypestr:'LM3S9B96';          controllerunitstr:'LM3TEMPEST'),
      (controllertypestr:'LM3S5D51';          controllerunitstr:'LM3TEMPEST'),
      (controllertypestr:'LM4F120H5';         controllerunitstr:'LM4F120'),
      (controllertypestr:'SC32442B';          controllerunitstr:'SC32442b'),
      (controllertypestr:'XMC4500X1024';      controllerunitstr:'XMC4500'),
      (controllertypestr:'XMC4500X768';       controllerunitstr:'XMC4500'),
      (controllertypestr:'XMC4502X768';       controllerunitstr:'XMC4502'),
      (controllertypestr:'XMC4504X512';       controllerunitstr:'XMC4504'),
      (controllertypestr:'ALLWINNER_A20';     controllerunitstr:'ALLWINNER_A20'),
      (controllertypestr:'MK20DX128XXX7';     controllerunitstr:'MK20D7'),
      (controllertypestr:'MK20DX256XXX7';     controllerunitstr:'MK20D7'),
      (controllertypestr:'MK20DX64XXX7';      controllerunitstr:'MK20D7'),
      (controllertypestr:'THUMB2_BARE';       controllerunitstr:'THUMB2_BARE'),
      (controllertypestr:'PIC32MX110F016B';   controllerunitstr:'PIC32MX1xxFxxxB'),
      (controllertypestr:'PIC32MX110F016C';   controllerunitstr:'PIC32MX1xxFxxxC'),
      (controllertypestr:'PIC32MX110F016D';   controllerunitstr:'PIC32MX1xxFxxxD'),
      (controllertypestr:'PIC32MX120F032B';   controllerunitstr:'PIC32MX1xxFxxxB'),
      (controllertypestr:'PIC32MX120F032C';   controllerunitstr:'PIC32MX1xxFxxxC'),
      (controllertypestr:'PIC32MX120F032D';   controllerunitstr:'PIC32MX1xxFxxxD'),
      (controllertypestr:'PIC32MX130F064B';   controllerunitstr:'PIC32MX1xxFxxxB'),
      (controllertypestr:'PIC32MX130F064C';   controllerunitstr:'PIC32MX1xxFxxxC'),
      (controllertypestr:'PIC32MX130F064D';   controllerunitstr:'PIC32MX1xxFxxxD'),
      (controllertypestr:'PIC32MX150F128B';   controllerunitstr:'PIC32MX1xxFxxxB'),
      (controllertypestr:'PIC32MX150F128C';   controllerunitstr:'PIC32MX1xxFxxxC'),
      (controllertypestr:'PIC32MX150F128D';   controllerunitstr:'PIC32MX1xxFxxxD'),
      (controllertypestr:'PIC32MX210F016B';   controllerunitstr:'PIC32MX2xxFxxxB'),
      (controllertypestr:'PIC32MX210F016C';   controllerunitstr:'PIC32MX2xxFxxxC'),
      (controllertypestr:'PIC32MX210F016D';   controllerunitstr:'PIC32MX2xxFxxxD'),
      (controllertypestr:'PIC32MX220F032B';   controllerunitstr:'PIC32MX2xxFxxxB'),
      (controllertypestr:'PIC32MX220F032C';   controllerunitstr:'PIC32MX2xxFxxxC'),
      (controllertypestr:'PIC32MX220F032D';   controllerunitstr:'PIC32MX2xxFxxxD'),
      (controllertypestr:'PIC32MX230F064B';   controllerunitstr:'PIC32MX2xxFxxxB'),
      (controllertypestr:'PIC32MX230F064C';   controllerunitstr:'PIC32MX2xxFxxxC'),
      (controllertypestr:'PIC32MX230F064D';   controllerunitstr:'PIC32MX2xxFxxxD'),
      (controllertypestr:'PIC32MX250F128B';   controllerunitstr:'PIC32MX2xxFxxxB'),
      (controllertypestr:'PIC32MX250F128C';   controllerunitstr:'PIC32MX2xxFxxxC'),
      (controllertypestr:'PIC32MX250F128D';   controllerunitstr:'PIC32MX2xxFxxxD'),
      (controllertypestr:'PIC32MX775F256H';   controllerunitstr:'PIC32MX7x5FxxxH'),
      (controllertypestr:'PIC32MX775F256L';   controllerunitstr:'PIC32MX7x5FxxxL'),
      (controllertypestr:'PIC32MX775F512H';   controllerunitstr:'PIC32MX7x5FxxxH'),
      (controllertypestr:'PIC32MX775F512L';   controllerunitstr:'PIC32MX7x5FxxxL'),
      (controllertypestr:'PIC32MX795F512H';   controllerunitstr:'PIC32MX7x5FxxxH'),
      (controllertypestr:'PIC32MX795F512L';   controllerunitstr:'PIC32MX7x5FxxxL'),
      (controllertypestr:'ATMEGA645';         controllerunitstr:'ATMEGA645'),
      (controllertypestr:'ATMEGA165A';        controllerunitstr:'ATMEGA165A'),
      (controllertypestr:'ATTINY44A';         controllerunitstr:'ATTINY44A'),
      (controllertypestr:'ATMEGA649A';        controllerunitstr:'ATMEGA649A'),
      (controllertypestr:'ATMEGA32U4';        controllerunitstr:'ATMEGA32U4'),
      (controllertypestr:'ATTINY26';          controllerunitstr:'ATTINY26'),
      (controllertypestr:'AT90USB1287';       controllerunitstr:'AT90USB1287'),
      (controllertypestr:'AT90PWM161';        controllerunitstr:'AT90PWM161'),
      (controllertypestr:'ATTINY48';          controllerunitstr:'ATTINY48'),
      (controllertypestr:'ATMEGA168P';        controllerunitstr:'ATMEGA168P'),
      (controllertypestr:'ATTINY10';          controllerunitstr:'ATTINY10'),
      (controllertypestr:'ATTINY84A';         controllerunitstr:'ATTINY84A'),
      (controllertypestr:'AT90USB82';         controllerunitstr:'AT90USB82'),
      (controllertypestr:'ATTINY2313';        controllerunitstr:'ATTINY2313'),
      (controllertypestr:'ATTINY461';         controllerunitstr:'ATTINY461'),
      (controllertypestr:'ATMEGA3250PA';      controllerunitstr:'ATMEGA3250PA'),
      (controllertypestr:'ATMEGA3290A';       controllerunitstr:'ATMEGA3290A'),
      (controllertypestr:'ATMEGA165P';        controllerunitstr:'ATMEGA165P'),
      (controllertypestr:'ATTINY43U';         controllerunitstr:'ATTINY43U'),
      (controllertypestr:'AT90USB162';        controllerunitstr:'AT90USB162'),
      (controllertypestr:'ATMEGA16U4';        controllerunitstr:'ATMEGA16U4'),
      (controllertypestr:'ATTINY24A';         controllerunitstr:'ATTINY24A'),
      (controllertypestr:'ATMEGA88P';         controllerunitstr:'ATMEGA88P'),
      (controllertypestr:'ATTINY88';          controllerunitstr:'ATTINY88'),
      (controllertypestr:'ATMEGA6490P';       controllerunitstr:'ATMEGA6490P'),
      (controllertypestr:'ATTINY40';          controllerunitstr:'ATTINY40'),
      (controllertypestr:'ATMEGA324P';        controllerunitstr:'ATMEGA324P'),
      (controllertypestr:'ATTINY167';         controllerunitstr:'ATTINY167'),
      (controllertypestr:'ATMEGA328';         controllerunitstr:'ATMEGA328'),
      (controllertypestr:'ATTINY861';         controllerunitstr:'ATTINY861'),
      (controllertypestr:'ATTINY85';          controllerunitstr:'ATTINY85'),
      (controllertypestr:'ATMEGA64M1';        controllerunitstr:'ATMEGA64M1'),
      (controllertypestr:'ATMEGA645P';        controllerunitstr:'ATMEGA645P'),
      (controllertypestr:'ATMEGA8U2';         controllerunitstr:'ATMEGA8U2'),
      (controllertypestr:'ATMEGA329A';        controllerunitstr:'ATMEGA329A'),
      (controllertypestr:'ATMEGA8A';          controllerunitstr:'ATMEGA8A'),
      (controllertypestr:'ATMEGA324PA';       controllerunitstr:'ATMEGA324PA'),
      (controllertypestr:'ATMEGA32HVB';       controllerunitstr:'ATMEGA32HVB'),
      (controllertypestr:'AT90PWM316';        controllerunitstr:'AT90PWM316'),
      (controllertypestr:'AT90PWM3B';         controllerunitstr:'AT90PWM3B'),
      (controllertypestr:'AT90USB646';        controllerunitstr:'AT90USB646'),
      (controllertypestr:'ATTINY20';          controllerunitstr:'ATTINY20'),
      (controllertypestr:'ATMEGA16';          controllerunitstr:'ATMEGA16'),
      (controllertypestr:'ATMEGA48A';         controllerunitstr:'ATMEGA48A'),
      (controllertypestr:'ATTINY24';          controllerunitstr:'ATTINY24'),
      (controllertypestr:'ATMEGA644';         controllerunitstr:'ATMEGA644'),
      (controllertypestr:'ATMEGA1284';        controllerunitstr:'ATMEGA1284'),
      (controllertypestr:'ATA6285';           controllerunitstr:'ATA6285'),
      (controllertypestr:'AT90CAN64';         controllerunitstr:'AT90CAN64'),
      (controllertypestr:'ATMEGA48';          controllerunitstr:'ATMEGA48'),
      (controllertypestr:'AT90CAN32';         controllerunitstr:'AT90CAN32'),
      (controllertypestr:'ATTINY9';           controllerunitstr:'ATTINY9'),
      (controllertypestr:'ATTINY87';          controllerunitstr:'ATTINY87'),
      (controllertypestr:'ATMEGA1281';        controllerunitstr:'ATMEGA1281'),
      (controllertypestr:'AT90PWM216';        controllerunitstr:'AT90PWM216'),
      (controllertypestr:'ATMEGA3250A';       controllerunitstr:'ATMEGA3250A'),
      (controllertypestr:'ATMEGA88A';         controllerunitstr:'ATMEGA88A'),
      (controllertypestr:'ATMEGA128RFA1';     controllerunitstr:'ATMEGA128RFA1'),
      (controllertypestr:'ATMEGA3290PA';      controllerunitstr:'ATMEGA3290PA'),
      (controllertypestr:'AT90PWM81';         controllerunitstr:'AT90PWM81'),
      (controllertypestr:'ATMEGA325P';        controllerunitstr:'ATMEGA325P'),
      (controllertypestr:'ATTINY84';          controllerunitstr:'ATTINY84'),
      (controllertypestr:'ATMEGA328P';        controllerunitstr:'ATMEGA328P'),
      (controllertypestr:'ATTINY13A';         controllerunitstr:'ATTINY13A'),
      (controllertypestr:'ATMEGA8';           controllerunitstr:'ATMEGA8'),
      (controllertypestr:'ATMEGA1284P';       controllerunitstr:'ATMEGA1284P'),
      (controllertypestr:'ATMEGA16U2';        controllerunitstr:'ATMEGA16U2'),
      (controllertypestr:'ATTINY45';          controllerunitstr:'ATTINY45'),
      (controllertypestr:'ATMEGA3250';        controllerunitstr:'ATMEGA3250'),
      (controllertypestr:'ATMEGA329';         controllerunitstr:'ATMEGA329'),
      (controllertypestr:'ATMEGA32A';         controllerunitstr:'ATMEGA32A'),
      (controllertypestr:'ATTINY5';           controllerunitstr:'ATTINY5'),
      (controllertypestr:'AT90CAN128';        controllerunitstr:'AT90CAN128'),
      (controllertypestr:'ATMEGA6490';        controllerunitstr:'ATMEGA6490'),
      (controllertypestr:'ATMEGA8515';        controllerunitstr:'ATMEGA8515'),
      (controllertypestr:'ATMEGA88PA';        controllerunitstr:'ATMEGA88PA'),
      (controllertypestr:'ATMEGA168A';        controllerunitstr:'ATMEGA168A'),
      (controllertypestr:'ATMEGA128';         controllerunitstr:'ATMEGA128'),
      (controllertypestr:'AT90USB1286';       controllerunitstr:'AT90USB1286'),
      (controllertypestr:'ATMEGA164PA';       controllerunitstr:'ATMEGA164PA'),
      (controllertypestr:'ATTINY828';         controllerunitstr:'ATTINY828'),
      (controllertypestr:'ATMEGA88';          controllerunitstr:'ATMEGA88'),
      (controllertypestr:'ATMEGA645A';        controllerunitstr:'ATMEGA645A'),
      (controllertypestr:'ATMEGA3290P';       controllerunitstr:'ATMEGA3290P'),
      (controllertypestr:'ATMEGA644P';        controllerunitstr:'ATMEGA644P'),
      (controllertypestr:'ATMEGA164A';        controllerunitstr:'ATMEGA164A'),
      (controllertypestr:'ATTINY4313';        controllerunitstr:'ATTINY4313'),
      (controllertypestr:'ATMEGA162';         controllerunitstr:'ATMEGA162'),
      (controllertypestr:'ATMEGA32C1';        controllerunitstr:'ATMEGA32C1'),
      (controllertypestr:'ATMEGA128A';        controllerunitstr:'ATMEGA128A'),
      (controllertypestr:'ATMEGA324A';        controllerunitstr:'ATMEGA324A'),
      (controllertypestr:'ATTINY13';          controllerunitstr:'ATTINY13'),
      (controllertypestr:'ATMEGA2561';        controllerunitstr:'ATMEGA2561'),
      (controllertypestr:'ATMEGA169A';        controllerunitstr:'ATMEGA169A'),
      (controllertypestr:'ATTINY261';         controllerunitstr:'ATTINY261'),
      (controllertypestr:'ATMEGA644A';        controllerunitstr:'ATMEGA644A'),
      (controllertypestr:'ATMEGA3290';        controllerunitstr:'ATMEGA3290'),
      (controllertypestr:'ATMEGA64A';         controllerunitstr:'ATMEGA64A'),
      (controllertypestr:'ATMEGA169P';        controllerunitstr:'ATMEGA169P'),
      (controllertypestr:'ATMEGA2560';        controllerunitstr:'ATMEGA2560'),
      (controllertypestr:'ATMEGA32';          controllerunitstr:'ATMEGA32'),
      (controllertypestr:'ATTINY861A';        controllerunitstr:'ATTINY861A'),
      (controllertypestr:'ATTINY28';          controllerunitstr:'ATTINY28'),
      (controllertypestr:'ATMEGA48P';         controllerunitstr:'ATMEGA48P'),
      (controllertypestr:'ATMEGA8535';        controllerunitstr:'ATMEGA8535'),
      (controllertypestr:'ATMEGA168PA';       controllerunitstr:'ATMEGA168PA'),
      (controllertypestr:'ATMEGA16M1';        controllerunitstr:'ATMEGA16M1'),
      (controllertypestr:'ATMEGA16HVB';       controllerunitstr:'ATMEGA16HVB'),
      (controllertypestr:'ATMEGA164P';        controllerunitstr:'ATMEGA164P'),
      (controllertypestr:'ATMEGA325A';        controllerunitstr:'ATMEGA325A'),
      (controllertypestr:'ATMEGA640';         controllerunitstr:'ATMEGA640'),
      (controllertypestr:'ATMEGA6450';        controllerunitstr:'ATMEGA6450'),
      (controllertypestr:'ATMEGA329P';        controllerunitstr:'ATMEGA329P'),
      (controllertypestr:'ATA6286';           controllerunitstr:'ATA6286'),
      (controllertypestr:'AT90USB647';        controllerunitstr:'AT90USB647'),
      (controllertypestr:'ATMEGA168';         controllerunitstr:'ATMEGA168'),
      (controllertypestr:'ATMEGA6490A';       controllerunitstr:'ATMEGA6490A'),
      (controllertypestr:'ATMEGA32M1';        controllerunitstr:'ATMEGA32M1'),
      (controllertypestr:'ATMEGA64C1';        controllerunitstr:'ATMEGA64C1'),
      (controllertypestr:'ATMEGA32U2';        controllerunitstr:'ATMEGA32U2'),
      (controllertypestr:'ATTINY4';           controllerunitstr:'ATTINY4'),
      (controllertypestr:'ATMEGA644PA';       controllerunitstr:'ATMEGA644PA'),
      (controllertypestr:'AT90PWM1';          controllerunitstr:'AT90PWM1'),
      (controllertypestr:'ATTINY44';          controllerunitstr:'ATTINY44'),
      (controllertypestr:'ATMEGA325PA';       controllerunitstr:'ATMEGA325PA'),
      (controllertypestr:'ATMEGA6450A';       controllerunitstr:'ATMEGA6450A'),
      (controllertypestr:'ATTINY2313A';       controllerunitstr:'ATTINY2313A'),
      (controllertypestr:'ATMEGA329PA';       controllerunitstr:'ATMEGA329PA'),
      (controllertypestr:'ATTINY461A';        controllerunitstr:'ATTINY461A'),
      (controllertypestr:'ATMEGA6450P';       controllerunitstr:'ATMEGA6450P'),
      (controllertypestr:'ATMEGA64';          controllerunitstr:'ATMEGA64'),
      (controllertypestr:'ATMEGA165PA';       controllerunitstr:'ATMEGA165PA'),
      (controllertypestr:'ATMEGA16A';         controllerunitstr:'ATMEGA16A'),
      (controllertypestr:'ATMEGA649';         controllerunitstr:'ATMEGA649'),
      (controllertypestr:'ATMEGA1280';        controllerunitstr:'ATMEGA1280'),
      (controllertypestr:'AT90PWM2B';         controllerunitstr:'AT90PWM2B'),
      (controllertypestr:'ATMEGA649P';        controllerunitstr:'ATMEGA649P'),
      (controllertypestr:'ATMEGA3250P';       controllerunitstr:'ATMEGA3250P'),
      (controllertypestr:'ATMEGA48PA';        controllerunitstr:'ATMEGA48PA'),
      (controllertypestr:'ATTINY1634';        controllerunitstr:'ATTINY1634'),
      (controllertypestr:'ATMEGA325';         controllerunitstr:'ATMEGA325'),
      (controllertypestr:'ATMEGA169PA';       controllerunitstr:'ATMEGA169PA'),
      (controllertypestr:'ATTINY261A';        controllerunitstr:'ATTINY261A'),
      (controllertypestr:'ATTINY25';          controllerunitstr:'ATTINY25'));

  var
    i: integer;
    str: String;
  begin
    str:=UpperCase(AControllerName);
    for i := low(ControllerTypes) to high(ControllerTypes) do
      if ControllerTypes[i].controllertypestr=str then
        exit(ControllerTypes[i].controllerunitstr);
    result:='';
  end;

var
  s: string;
  CompilerMode: String;
  m: Integer;
  UnitPath: String;
  IncPath: String;
  Params: TStrings;
  i: Integer;
  Param: String;
  p: PChar;
begin
  Result:=nil;
  if AlwaysCreate then
    CreateMainTemplate;
  CompilerMode:='';
  UnitPath:='';
  IncPath:='';
  Params:=TStringList.Create;
  try
    SplitCmdLineParams(CmdLine,Params);
    for i:=0 to Params.Count-1 do begin
      Param:=Params[i];
      if Param='' then continue;
      p:=PChar(Param);
      if p^<>'-' then continue;
      // a parameter
      case p[1] of
      'F':
        case p[2] of
        'u':
          UnitPath+=';'+copy(Param,4,length(Param));
        'i':
          IncPath+=';'+copy(Param,4,length(Param));
        end;

      'd':
        begin
          // define
          AddDefine(copy(Param,3,255));
        end;

      'u':
        begin
          // undefine
          AddUndefine(copy(Param,3,255));
        end;

      'S':
        begin
          // syntax
          inc(p,2);
          repeat
            case p^ of
            '2': CompilerMode:='ObjFPC';
            'd': CompilerMode:='Delphi';
            'o': CompilerMode:='TP';
            'p': CompilerMode:='GPC';
            else break;
            end;
            inc(p);
          until false;
        end;

      'M':
        begin
          // syntax
          CompilerMode:=copy(Param,3,255);
        end;

      'W':
        case p[2] of
        'p':
          begin
            s:=FindControllerUnit(copy(Param,4,255));

            // controller unit
            if s<>'' then
              AddDefine('Define '+MacroControllerUnit,
                ctsDefine+MacroControllerUnit,MacroControllerUnit,
                s);
          end;
        end;

      end;
    end;
  finally
    Params.Free;
  end;
  if CompilerMode<>'' then begin
    for m:=low(FPCSyntaxModes) to high(FPCSyntaxModes) do
      AddDefineUndefine('FPC_'+FPCSyntaxModes[m],SysUtils.CompareText(CompilerMode,FPCSyntaxModes[m])=0);
  end;
  if AddPaths then begin
    if UnitPath<>'' then
      AddDefine('UnitPath','UnitPath addition',UnitPathMacroName,UnitPathMacro+UnitPath);
    if IncPath<>'' then
      AddDefine('IncPath','IncPath addition',IncludePathMacroName,IncludePathMacro+IncPath);
  end;

  Result.SetDefineOwner(Owner,true);
end;

procedure TDefinePool.ConsistencyCheck;
var i: integer;
begin
  for i:=0 to Count-1 do
    Items[i].ConsistencyCheck;
end;

procedure TDefinePool.WriteDebugReport;
var i: integer;
begin
  DebugLn('TDefinePool.WriteDebugReport');
  for i:=0 to Count-1 do
    Items[i].WriteDebugReport(false);
  ConsistencyCheck;
end;

procedure TDefinePool.CalcMemSize(Stats: TCTMemStats);
var
  i: Integer;
begin
  Stats.Add('TDefinePool',PtrUInt(InstanceSize)
    +MemSizeString(FEnglishErrorMsgFilename));
  if FItems<>nil then begin
    Stats.Add('TDefinePool.Count',Count);
    for i:=0 to Count-1 do
      Items[i].CalcMemSize(Stats);
  end;
end;


{ TFPCSourceRules }

function TFPCSourceRules.GetItems(Index: integer): TFPCSourceRule;
begin
  Result:=TFPCSourceRule(FItems[Index]);
end;

procedure TFPCSourceRules.SetTargets(const AValue: string);
begin
  if FTargets=AValue then exit;
  FTargets:=LowerCase(AValue);
end;

constructor TFPCSourceRules.Create;
begin
  FItems:=TFPList.Create;
end;

destructor TFPCSourceRules.Destroy;
begin
  Clear;
  FreeAndNil(FItems);
  inherited Destroy;
end;

procedure TFPCSourceRules.Clear;
var
  i: Integer;
begin
  if FItems.Count=0 then exit;
  for i:=0 to FItems.Count-1 do
    TObject(FItems[i]).Free;
  FItems.Clear;
  IncreaseChangeStamp;
end;

function TFPCSourceRules.IsEqual(Rules: TFPCSourceRules): boolean;
var
  i: Integer;
begin
  Result:=false;
  if Count<>Rules.Count then exit;
  for i:=0 to Count-1 do
    if not Items[i].IsEqual(Rules[i]) then exit;
  Result:=true;
end;

procedure TFPCSourceRules.Assign(Rules: TFPCSourceRules);
var
  i: Integer;
  SrcRule: TFPCSourceRule;
  Rule: TFPCSourceRule;
begin
  if IsEqual(Rules) then exit;
  Clear;
  for i:=0 to Rules.Count-1 do begin
    SrcRule:=Rules[i];
    Rule:=Add(SrcRule.Filename);
    Rule.Assign(SrcRule);
    //debugln(['TFPCSourceRules.Assign ',i,' ',Rule.Targets,' ',Rule.Filename]);
  end;
  IncreaseChangeStamp;
end;

function TFPCSourceRules.Clone: TFPCSourceRules;
begin
  Result:=TFPCSourceRules.Create;
  Result.Assign(Self);
end;

function TFPCSourceRules.Count: integer;
begin
  Result:=FItems.Count;
end;

function TFPCSourceRules.Add(const Filename: string): TFPCSourceRule;
begin
  Result:=TFPCSourceRule.Create;
  Result.Score:=Score;
  Result.Targets:=Targets;
  //DebugLn(['TFPCSourceRules.Add Targets="',Result.Targets,'" Priority=',Result.Score]);
  Result.Filename:=lowercase(SetDirSeparators(Filename));
  FItems.Add(Result);
  IncreaseChangeStamp;
end;

function TFPCSourceRules.GetDefaultTargets(TargetOS, TargetCPU: string): string;
var
  SrcOS: String;
  SrcOS2: String;
  SrcCPU: String;
begin
  if TargetOS='' then
    TargetOS:=GetCompiledTargetOS;
  if TargetCPU='' then
    TargetCPU:=GetCompiledTargetCPU;
  Result:=TargetOS+','+TargetCPU;
  SrcOS:=GetDefaultSrcOSForTargetOS(TargetOS);
  SrcOS2:=GetDefaultSrcOS2ForTargetOS(TargetOS);
  SrcCPU:=GetDefaultSrcCPUForTargetCPU(TargetCPU);
  if SrcOS<>'' then Result:=Result+','+SrcOS;
  if SrcOS2<>'' then Result:=Result+','+SrcOS2;
  if SrcCPU<>'' then Result:=Result+','+SrcCPU;
end;

procedure TFPCSourceRules.GetRulesForTargets(Targets: string;
  var RulesSortedForFilenameStart: TAVLTree);
var
  i: Integer;
begin
  if RulesSortedForFilenameStart=nil then
    RulesSortedForFilenameStart:=
                             TAVLTree.Create(@CompareFPCSourceRulesViaFilename);
  for i:=0 to Count-1 do
    if Items[i].FitsTargets(Targets) then
      RulesSortedForFilenameStart.Add(Items[i]);
end;

function TFPCSourceRules.GetScore(Filename: string;
  RulesSortedForFilenameStart: TAVLTree): integer;
var
  Node: TAVLTreeNode;
  Rule: TFPCSourceRule;
  cmp: LongInt;
  Cnt: Integer;
begin
  Result:=0;
  if Filename='' then exit;
  Filename:=LowerCase(Filename);
  {Node:=RulesSortedForFilenameStart.FindLowest;
  while Node<>nil do begin
    Rule:=TFPCSourceRule(Node.Data);
    DebugLn(['TFPCSourceRules.GetScore Rule: ',Rule.Score,' ',Rule.Filename]);
    Node:=RulesSortedForFilenameStart.FindSuccessor(Node);
  end;}
  // find first rule for Filename
  Node:=RulesSortedForFilenameStart.Root;
  while true do begin
    Rule:=TFPCSourceRule(Node.Data);
    cmp:=CompareFilenames(Filename,Rule.Filename);
    //DebugLn(['TFPCSourceRules.GetScore Rule.Filename=',Rule.Filename,' Filename=',Filename,' cmp=',cmp]);
    if cmp=0 then
      break;
    if cmp<0 then begin
      if Node.Left<>nil then
        Node:=Node.Left
      else
        break;
    end else begin
      if Node.Right<>nil then
        Node:=Node.Right
      else
        break;
    end;
  end;
  { The rules are sorted for the file name. Shorter file names comes before
    longer ones.
       packages/httpd20/examples
       packages/httpd22
       packages/httpd22/examples
    A filename packages/httpd22/examples matches
           packages/httpd22
       and packages/httpd22/examples
    If a file name has no exact match the binary search for packages/httpd22/e
    can either point to
           packages/httpd22
        or packages/httpd22/examples
  }

  // run through all fitting rules (the Filename is >= Rule.Filename)
  Cnt:=0;
  while Node<>nil do begin
    inc(Cnt);
    Rule:=TFPCSourceRule(Node.Data);
    if Rule.FitsFilename(Filename) then
      inc(Result,Rule.Score)
    else if Cnt>1 then
      break;
    Node:=RulesSortedForFilenameStart.FindPrecessor(Node);
  end;
end;

procedure TFPCSourceRules.IncreaseChangeStamp;
begin
  if FChangeStamp<High(FChangeStamp) then
    inc(FChangeStamp)
  else
    FChangeStamp:=Low(FChangeStamp);
end;

{ TFPCSourceRule }

function TFPCSourceRule.FitsTargets(const FilterTargets: string): boolean;
var
  FilterStartPos: PChar;
  TargetPos: PChar;
  FilterPos: PChar;
begin
  //DebugLn(['TFPCSourceRule.FitsTargets FilterTargets="',FilterTargets,'" Targets="',Targets,'"']);
  if Targets='*' then exit(true);
  if (Targets='') or (FilterTargets='') then exit(false);
  FilterStartPos:=PChar(FilterTargets);
  while true do begin
    while (FilterStartPos^=',') do inc(FilterStartPos);
    if FilterStartPos^=#0 then exit(false);
    TargetPos:=PChar(Targets);
    repeat
      while (TargetPos^=',') do inc(TargetPos);
      if TargetPos^=#0 then break;
      FilterPos:=FilterStartPos;
      while (FilterPos^=TargetPos^) and (not (FilterPos^ in [#0,','])) do begin
        inc(TargetPos);
        inc(FilterPos);
      end;
      if (TargetPos^ in [#0,',']) then begin
        // the target fits
        exit(true);
      end;
      // try next target
      while not (TargetPos^ in [#0,',']) do inc(TargetPos);
    until TargetPos^=#0;
    // next target filter
    while not (FilterStartPos^ in [#0,',']) do inc(FilterStartPos);
  end;
  Result:=false;
end;

function TFPCSourceRule.FitsFilename(const aFilename: string): boolean;
begin
  Result:=(length(Filename)<=length(aFilename))
         and CompareMem(Pointer(Filename),Pointer(aFilename),length(Filename));
end;

function TFPCSourceRule.IsEqual(Rule: TFPCSourceRule): boolean;
begin
  Result:=false;
  if (Filename<>Rule.Filename)
  or (Score<>Rule.Score)
  or (Targets<>Rule.Targets) then
    exit;
  Result:=true;
end;

procedure TFPCSourceRule.Assign(Rule: TFPCSourceRule);
begin
  Filename:=Rule.Filename;
  Score:=Rule.Score;
  Targets:=Rule.Targets;
end;

{ TFPCTargetConfigCacheItem }

constructor TFPCTargetConfigCache.Create(AOwner: TComponent);
begin
  CTIncreaseChangeStamp(FChangeStamp); // set to not 0
  inherited Create(AOwner);
  ConfigFiles:=TFPCConfigFileStateList.Create;
  if Owner is TFPCTargetConfigCaches then
    Caches:=TFPCTargetConfigCaches(Owner);
end;

destructor TFPCTargetConfigCache.Destroy;
begin
  Clear;
  FreeAndNil(ConfigFiles);
  inherited Destroy;
end;

procedure TFPCTargetConfigCache.Clear;
begin
  // keep keys
  CompilerDate:=0;
  RealCompiler:='';
  RealCompilerDate:=0;
  RealTargetCPU:='';
  RealTargetOS:='';
  RealCompilerInPath:='';
  FullVersion:='';
  HasPPUs:=false;
  ConfigFiles.Clear;
  ErrorMsg:='';
  ErrorTranslatedMsg:='';
  FreeAndNil(Defines);
  FreeAndNil(Undefines);
  FreeAndNil(UnitPaths);
  FreeAndNil(Units);
end;

function TFPCTargetConfigCache.Equals(Item: TFPCTargetConfigCache;
  CompareKey: boolean): boolean;

  function CompareStrings(List1, List2: TStrings): boolean;
  var
    List1Empty: Boolean;
    List2Empty: Boolean;
  begin
    Result:=false;
    List1Empty:=(List1=nil) or (List1.Count=0);
    List2Empty:=(List2=nil) or (List2.Count=0);
    if (List1Empty<>List2Empty) then exit;
    if (not List1Empty) and (not List1.Equals(List2)) then exit;
    Result:=true;
  end;

  function CompareStringTrees(Tree1, Tree2: TStringToStringTree): boolean;
  var
    Tree1Empty: Boolean;
    Tree2Empty: Boolean;
  begin
    Result:=false;
    Tree1Empty:=(Tree1=nil) or (Tree1.Tree.Count=0);
    Tree2Empty:=(Tree2=nil) or (Tree2.Tree.Count=0);
    if (Tree1Empty<>Tree2Empty) then exit;
    if (not Tree1Empty) and (not Tree1.Equals(Tree2)) then exit;
    Result:=true;
  end;

begin
  Result:=false;
  if CompareKey then begin
    if (TargetOS<>Item.TargetOS)
      or (TargetCPU<>Item.TargetCPU)
      or (Compiler<>Item.Compiler)
      or (CompilerOptions<>Item.CompilerOptions)
    then
      exit;
  end;
  if (CompilerDate<>Item.CompilerDate)
    or (RealCompiler<>Item.RealCompiler)
    or (RealCompilerDate<>Item.RealCompilerDate)
    or (RealTargetOS<>Item.RealTargetOS)
    or (RealTargetCPU<>Item.RealTargetCPU)
    or (RealCompilerInPath<>Item.RealCompilerInPath)
    or (FullVersion<>Item.FullVersion)
    or (HasPPUs<>Item.HasPPUs)
    or (not ConfigFiles.Equals(Item.ConfigFiles,true))
  then
    exit;
  if not CompareStringTrees(Defines,Item.Defines) then exit;
  if not CompareStringTrees(Undefines,Item.Undefines) then exit;
  if not CompareStrings(UnitPaths,Item.UnitPaths) then exit;
  if not CompareStringTrees(Units,Item.Units) then exit;
  Result:=true;
end;

procedure TFPCTargetConfigCache.Assign(Source: TPersistent);
var
  Item: TFPCTargetConfigCache;
begin
  if Source is TFPCTargetConfigCache then begin
    Item:=TFPCTargetConfigCache(Source);
    // keys
    TargetOS:=Item.TargetOS;
    TargetCPU:=Item.TargetCPU;
    Compiler:=Item.Compiler;
    CompilerOptions:=Item.CompilerOptions;
    // values
    CompilerDate:=Item.CompilerDate;
    RealCompiler:=Item.RealCompiler;
    RealCompilerDate:=Item.RealCompilerDate;
    RealTargetOS:=Item.RealTargetOS;
    RealTargetCPU:=Item.RealTargetCPU;
    RealCompilerInPath:=Item.RealCompilerInPath;
    FullVersion:=Item.FullVersion;
    HasPPUs:=Item.HasPPUs;
    ConfigFiles.Assign(Item.ConfigFiles);
    if Item.Defines<>nil then begin
      if Defines=nil then Defines:=TStringToStringTree.Create(false);
      Defines.Assign(Item.Defines);
    end else begin
      FreeAndNil(Defines);
    end;
    if Item.Undefines<>nil then begin
      if Undefines=nil then Undefines:=TStringToStringTree.Create(false);
      Undefines.Assign(Item.Undefines);
    end else begin
      FreeAndNil(Undefines);
    end;
    if Item.UnitPaths<>nil then begin
      if UnitPaths=nil then UnitPaths:=TStringList.Create;
      UnitPaths.Assign(Item.UnitPaths);
    end else begin
      FreeAndNil(UnitPaths);
    end;
    if Item.Units<>nil then begin
      if Units=nil then Units:=TStringToStringTree.Create(false);
      Units.Assign(Item.Units);
    end else begin
      FreeAndNil(Units);
    end;

    ErrorMsg:=Item.ErrorMsg;
    ErrorTranslatedMsg:=Item.ErrorTranslatedMsg;
  end else
    inherited Assign(Source);
end;

procedure TFPCTargetConfigCache.LoadFromXMLConfig(XMLConfig: TXMLConfig;
  const Path: string);
var
  Cnt: integer;
  SubPath: String;
  DefineName, DefineValue: String;
  s: String;
  i: Integer;
  p: Integer;
  StartPos: Integer;
  List: TStringList;
  UnitList: TStringList;
  Unit_Name: String;
  Filename: String;
  BaseDir: String;
begin
  Clear;

  TargetOS:=XMLConfig.GetValue(Path+'TargetOS','');
  TargetCPU:=XMLConfig.GetValue(Path+'TargetCPU','');
  Compiler:=XMLConfig.GetValue(Path+'Compiler/File','');
  CompilerOptions:=XMLConfig.GetValue(Path+'Compiler/Options','');
  CompilerDate:=XMLConfig.GetValue(Path+'Compiler/Date',0);
  RealCompiler:=XMLConfig.GetValue(Path+'RealCompiler/File','');
  RealCompilerDate:=XMLConfig.GetValue(Path+'RealCompiler/Date',0);
  RealTargetOS:=XMLConfig.GetValue(Path+'RealCompiler/OS','');
  RealTargetCPU:=XMLConfig.GetValue(Path+'RealCompiler/CPU','');
  RealCompilerInPath:=XMLConfig.GetValue(Path+'RealCompiler/InPath','');
  FullVersion:=XMLConfig.GetValue(Path+'RealCompiler/FullVersion','');
  HasPPUs:=XMLConfig.GetValue(Path+'HasPPUs',true);
  ConfigFiles.LoadFromXMLConfig(XMLConfig,Path+'Configs/');

  // defines: format: Define<Number>/Name,Value
  Cnt:=XMLConfig.GetValue(Path+'Defines/Count',0);
  for i:=1 to Cnt do begin
    SubPath:=Path+'Defines/Macro'+IntToStr(i)+'/';
    DefineName:=UpperCaseStr(XMLConfig.GetValue(SubPath+'Name',''));
    if (DefineName='') or (not IsValidIdent(DefineName)) then begin
      DebugLn(['Warning: [TFPCTargetConfigCache.LoadFromXMLConfig] invalid define name ',DefineName]);
      continue;
    end;
    DefineValue:=XMLConfig.GetValue(SubPath+'Value','');
    if Defines=nil then
      Defines:=TStringToStringTree.Create(false);
    Defines[DefineName]:=DefineValue;
  end;

  // undefines: format: Undefines/Value and comma separated list of names
  s:=XMLConfig.GetValue(Path+'Undefines/Values','');
  if s<>'' then begin
    p:=1;
    while (p<=length(s)) do begin
      StartPos:=1;
      while (p<=length(s)) and (s[p]<>';') do inc(p);
      DefineName:=copy(s,StartPos,p-StartPos);
      if (DefineName<>'') and IsValidIdent(DefineName) then begin
        if Undefines=nil then
          Undefines:=TStringToStringTree.Create(false);
        Undefines[DefineName]:='';
      end;
      inc(p);
    end;
  end;

  // UnitPaths: format: semicolon separated compressed list
  List:=TStringList.Create;
  try
    s:=XMLConfig.GetValue(Path+'UnitPaths/Value','');
    List.Delimiter:=';';
    List.StrictDelimiter:=true;
    List.DelimitedText:=s;
    UnitPaths:=Decompress1FileList(List);
    BaseDir:=TrimFilename(AppendPathDelim(XMLConfig.GetValue(Path+'UnitPaths/BaseDir','')));
    if BaseDir<>'' then
      for i:=0 to UnitPaths.Count-1 do
        UnitPaths[i]:=ChompPathDelim(TrimFilename(BaseDir+UnitPaths[i]))
    else
      for i:=UnitPaths.Count-1 downto 0 do
        if UnitPaths[i]='' then
          UnitPaths.Delete(i)
        else
          UnitPaths[i]:=ChompPathDelim(TrimFilename(UnitPaths[i]));
    // do not sort, order is important (e.g. for httpd.ppu)
  finally
    List.Free;
  end;

  // units: format: Units/Values semicolon separated list of compressed filename
  List:=TStringList.Create;
  UnitList:=nil;
  try
    s:=XMLConfig.GetValue(Path+'Units/Value','');
    List.Delimiter:=';';
    List.StrictDelimiter:=true;
    List.DelimitedText:=s;
    UnitList:=Decompress1FileList(List);
    for i:=0 to UnitList.Count-1 do begin
      Filename:=TrimFilename(UnitList[i]);
      Unit_Name:=ExtractFileNameOnly(Filename);
      if (Unit_Name='') or not IsValidIdent(Unit_Name) then begin
        DebugLn(['Warning: [TFPCTargetConfigCache.LoadFromXMLConfig] invalid unitname: ',s]);
        continue;
      end;
      if Units=nil then
        Units:=TStringToStringTree.Create(false);
      Units[Unit_Name]:=Filename;
    end;
  finally
    List.Free;
    UnitList.Free;
  end;
end;

procedure TFPCTargetConfigCache.SaveToXMLConfig(XMLConfig: TXMLConfig;
  const Path: string);
var
  Node: TAVLTreeNode;
  Item: PStringToStringTreeItem;
  Cnt: Integer;
  SubPath: String;
  UnitList: TStringList;
  Filename: String;
  List: TStringList;
  s: String;
  BaseDir: string;
  RelativeUnitPaths: TStringList;
begin
  XMLConfig.SetDeleteValue(Path+'TargetOS',TargetOS,'');
  XMLConfig.SetDeleteValue(Path+'TargetCPU',TargetCPU,'');
  XMLConfig.SetDeleteValue(Path+'Compiler/File',Compiler,'');
  XMLConfig.SetDeleteValue(Path+'Compiler/Options',CompilerOptions,'');
  XMLConfig.SetDeleteValue(Path+'Compiler/Date',CompilerDate,0);
  XMLConfig.SetDeleteValue(Path+'RealCompiler/File',RealCompiler,'');
  XMLConfig.SetDeleteValue(Path+'RealCompiler/Date',RealCompilerDate,0);
  XMLConfig.SetDeleteValue(Path+'RealCompiler/OS',RealTargetOS,'');
  XMLConfig.SetDeleteValue(Path+'RealCompiler/CPU',RealTargetCPU,'');
  XMLConfig.SetDeleteValue(Path+'RealCompiler/InPath',RealCompilerInPath,'');
  XMLConfig.SetDeleteValue(Path+'RealCompiler/FullVersion',FullVersion,'');
  XMLConfig.SetDeleteValue(Path+'HasPPUs',HasPPUs,true);
  ConfigFiles.SaveToXMLConfig(XMLConfig,Path+'Configs/');

  // Defines: write as Define<Number>/Name,Value
  Cnt:=0;
  if Defines<>nil then begin
    Node:=Defines.Tree.FindLowest;
    while Node<>nil do begin
      Item:=PStringToStringTreeItem(Node.Data);
      if (Item^.Name<>'') and IsValidIdent(Item^.Name) then begin
        inc(Cnt);
        SubPath:=Path+'Defines/Macro'+IntToStr(Cnt)+'/';
        XMLConfig.SetDeleteValue(SubPath+'Name',Item^.Name,'');
        XMLConfig.SetDeleteValue(SubPath+'Value',Item^.Value,'');
      end;
      Node:=Defines.Tree.FindSuccessor(Node);
    end;
  end;
  XMLConfig.SetDeleteValue(Path+'Defines/Count',Cnt,0);

  // Undefines: write as Undefines/Value and comma separated list of names
  Cnt:=0;
  s:='';
  if Undefines<>nil then begin
    Node:=Undefines.Tree.FindLowest;
    while Node<>nil do begin
      Item:=PStringToStringTreeItem(Node.Data);
      inc(Cnt);
      if s<>'' then s:=s+',';
      s:=s+Item^.Name;
      Node:=Undefines.Tree.FindSuccessor(Node);
    end;
  end;
  XMLConfig.SetDeleteValue(Path+'Undefines/Values',s,'');

  // UnitPaths: write as semicolon separated compressed list
  s:='';
  BaseDir:='';
  if UnitPaths<>nil then begin
    List:=nil;
    RelativeUnitPaths:=nil;
    try
      RelativeUnitPaths:=MakeRelativeFileList(UnitPaths,BaseDir);
      List:=Compress1FileList(RelativeUnitPaths);
      // do not sort, order is important (e.g. for httpd.ppu)
      List.Delimiter:=';';
      List.StrictDelimiter:=true;
      s:=List.DelimitedText;
    finally
      RelativeUnitPaths.Free;
      List.Free;
    end;
  end;
  XMLConfig.SetDeleteValue(Path+'UnitPaths/BaseDir',BaseDir,'');
  XMLConfig.SetDeleteValue(Path+'UnitPaths/Value',s,'');

  // Units: Units/Values semicolon separated list of compressed filenames
  // Units contains thousands of file names. This needs compression.
  s:='';
  List:=nil;
  UnitList:=TStringList.Create;
  try
    if Units<>nil then begin
      // Create a string list of filenames
      Node:=Units.Tree.FindLowest;
      while Node<>nil do begin
        Item:=PStringToStringTreeItem(Node.Data);
        Filename:=Item^.Value;
        UnitList.Add(Filename);
        Node:=Units.Tree.FindSuccessor(Node);
      end;
      // Sort the strings.
      UnitList.CaseSensitive:=true;
      UnitList.Sort;
      // Compress the file names
      List:=Compress1FileList(UnitList);
      // and write the semicolon separated list
      List.Delimiter:=';';
      List.StrictDelimiter:=true;
      s:=List.DelimitedText;
    end;
  finally
    List.Free;
    UnitList.Free;
  end;
  XMLConfig.SetDeleteValue(Path+'Units/Value',s,'');
end;

procedure TFPCTargetConfigCache.LoadFromFile(Filename: string);
var
  XMLConfig: TXMLConfig;
begin
  XMLConfig:=TXMLConfig.Create(Filename);
  try
    LoadFromXMLConfig(XMLConfig,'FPCConfig/');
  finally
    XMLConfig.Free;
  end;
end;

procedure TFPCTargetConfigCache.SaveToFile(Filename: string);
var
  XMLConfig: TXMLConfig;
begin
  XMLConfig:=TXMLConfig.CreateClean(Filename);
  try
    SaveToXMLConfig(XMLConfig,'FPCConfig/');
  finally
    XMLConfig.Free;
  end;
end;

function TFPCTargetConfigCache.NeedsUpdate: boolean;
var
  i: Integer;
  Cfg: TFPCConfigFileState;
  AFilename: String;
begin
  Result:=true;
  if (not FileExistsCached(Compiler)) then begin
    if CTConsoleVerbosity>0 then
      debugln(['Hint: [TFPCTargetConfigCache.NeedsUpdate] TargetOS="',TargetOS,'" TargetCPU="',TargetCPU,'" Options="',CompilerOptions,'" compiler file missing "',Compiler,'"']);
    exit;
  end;
  if (FileAgeCached(Compiler)<>CompilerDate) then begin
    if CTConsoleVerbosity>0 then
      debugln(['Hint: [TFPCTargetConfigCache.NeedsUpdate] TargetOS="',TargetOS,'" TargetCPU="',TargetCPU,'" Options="',CompilerOptions,'" compiler file changed "',Compiler,'" FileAge=',FileAgeCached(Compiler),' StoredAge=',CompilerDate]);
    exit;
  end;
  if (RealCompiler<>'') and (CompareFilenames(RealCompiler,Compiler)<>0)
  then begin
    if (not FileExistsCached(RealCompiler))
    or (FileAgeCached(RealCompiler)<>RealCompilerDate) then begin
      if CTConsoleVerbosity>0 then
        debugln(['Hint: [TFPCTargetConfigCache.NeedsUpdate] TargetOS="',TargetOS,'" TargetCPU="',TargetCPU,'" Options="',CompilerOptions,'" real compiler file changed "',RealCompiler,'"']);
      exit;
    end;
  end;
  // fpc searches via PATH for the real compiler, resolves any symlink
  // and that is the RealCompiler
  AFilename:=FindRealCompilerInPath(TargetCPU,true);
  if RealCompilerInPath<>AFilename then begin
    if CTConsoleVerbosity>0 then
      debugln(['Hint: [TFPCTargetConfigCache.NeedsUpdate] TargetOS="',TargetOS,'" TargetCPU="',TargetCPU,'" Options="',CompilerOptions,'" real compiler in PATH changed from "',RealCompilerInPath,'" to "',AFilename,'"']);
    exit;
  end;
  for i:=0 to ConfigFiles.Count-1 do begin
    Cfg:=ConfigFiles[i];
    if (Cfg.Filename='') or (not FilenameIsAbsolute(Cfg.Filename)) then continue;
    if FileExistsCached(Cfg.Filename)<>Cfg.FileExists then begin
      if CTConsoleVerbosity>0 then
        debugln(['Hint: [TFPCTargetConfigCache.NeedsUpdate] TargetOS="',TargetOS,'" TargetCPU="',TargetCPU,'" Options="',CompilerOptions,'" config fileexists changed "',Cfg.Filename,'"']);
      exit;
    end;
    if Cfg.FileExists and (FileAgeCached(Cfg.Filename)<>Cfg.FileDate) then begin
      if CTConsoleVerbosity>0 then
        debugln(['Hint: [TFPCTargetConfigCache.NeedsUpdate] TargetOS="',TargetOS,'" TargetCPU="',TargetCPU,'" Options="',CompilerOptions,'" config file changed "',Cfg.Filename,'"']);
      exit;
    end;
  end;
  Result:=false;
end;

function TFPCTargetConfigCache.GetFPCInfoCmdLineOptions(ExtraOptions: string
  ): string;
begin
  Result:=CompilerOptions;
  if TargetCPU<>'' then
    Result:=Result+' -P'+LowerCase(TargetCPU);
  if TargetOS<>'' then
    Result:=Result+' -T'+LowerCase(TargetOS);
  if ExtraOptions<>'' then
    Result:=Result+' '+ExtraOptions;
  Result:=Trim(Result);
end;

procedure TFPCTargetConfigCache.IncreaseChangeStamp;
begin
  CTIncreaseChangeStamp(FChangeStamp);
  if Caches<>nil then
    Caches.IncreaseChangeStamp;
end;

function TFPCTargetConfigCache.Update(TestFilename: string;
  ExtraOptions: string; const OnProgress: TDefinePoolProgress): boolean;
var
  OldOptions: TFPCTargetConfigCache;
  CfgFiles: TStrings;
  i: Integer;
  Filename: string;
  CfgFileExists: Boolean;
  CfgFileDate: Integer;
  Info: String;
  Infos: TFPCInfoStrings;
  InfoTypes: TFPCInfoTypes;
  BaseDir: String;
  FullFilename: String;
begin
  OldOptions:=TFPCTargetConfigCache.Create(nil);
  CfgFiles:=nil;
  try
    // remember old state to find out if something changed
    OldOptions.Assign(Self);
    Clear;

    if CTConsoleVerbosity>0 then
      debugln(['Hint: [TFPCTargetConfigCache.NeedsUpdate] ',Compiler,' TargetOS=',TargetOS,' TargetCPU=',TargetCPU,' CompilerOptions=',CompilerOptions,' ExtraOptions=',ExtraOptions,' PATH=',GetEnvironmentVariableUTF8('PATH')]);
    CompilerDate:=FileAgeCached(Compiler);
    if FileExistsCached(Compiler) then begin
      ExtraOptions:=GetFPCInfoCmdLineOptions(ExtraOptions);
      BaseDir:='';

      // get version and real OS and CPU
      InfoTypes:=[fpciTargetOS,fpciTargetProcessor,fpciFullVersion];
      Info:=RunFPCInfo(Compiler,InfoTypes,ExtraOptions);
      if ParseFPCInfo(Info,InfoTypes,Infos) then begin
        RealTargetOS:=Infos[fpciTargetOS];
        RealTargetCPU:=Infos[fpciTargetProcessor];
        FullVersion:=Infos[fpciFullVersion];
      end else begin
        RealTargetOS:=TargetOS;
        if RealTargetOS='' then
          RealTargetOS:=GetCompiledTargetOS;
        RealTargetCPU:=TargetCPU;
        if RealTargetCPU='' then
          RealTargetCPU:=GetCompiledTargetCPU;
      end;
      RealCompilerInPath:=FindRealCompilerInPath(TargetCPU,true);

      // run fpc and parse output
      HasPPUs:=false;
      RunFPCVerbose(Compiler,TestFilename,CfgFiles,RealCompiler,UnitPaths,
                    Defines,Undefines,ExtraOptions);
      if UnitPaths<>nil then
        for i:=0 to UnitPaths.Count-1 do
          UnitPaths[i]:=ChompPathDelim(TrimFilename(UnitPaths[i]));
      // store the real compiler file and date
      if (RealCompiler<>'') and FileExistsCached(RealCompiler) then begin
        RealCompilerDate:=FileAgeCached(RealCompiler);
      end else begin
        if CTConsoleVerbosity>=-1 then
          debugln(['Warning: [TFPCTargetConfigCache.Update] invalid compiler: Compiler="'+Compiler+'" Options="'+ExtraOptions+'" RealCompiler="',RealCompiler,'"']);
      end;
      // store the list of tried and read cfg files
      if CfgFiles<>nil then
        for i:=0 to CfgFiles.Count-1 do begin
          Filename:=CfgFiles[i];
          if Filename='' then continue;
          CfgFileExists:=Filename[1]='+';
          Filename:=copy(Filename,2,length(Filename));
          FullFilename:=LazFileUtils.ExpandFileNameUTF8(TrimFileName(Filename),BaseDir);
          if CfgFileExists<>FileExistsCached(FullFilename) then begin
            debugln(['Warning: [TFPCTargetConfigCache.Update] fpc found cfg a file, the IDE did not: "',Filename,'"']);
            CfgFileExists:=not CfgFileExists;
          end;
          CfgFileDate:=0;
          if CfgFileExists then
            CfgFileDate:=FileAgeCached(Filename);
          ConfigFiles.Add(Filename,CfgFileExists,CfgFileDate);
        end;
      // gather all units in all unit search paths
      if (UnitPaths<>nil) and (UnitPaths.Count>0) then begin
        Units:=GatherUnitsInSearchPaths(UnitPaths,OnProgress,true);
      end
      else begin
        if CTConsoleVerbosity>=-1 then
          debugln(['Warning: [TFPCTargetConfigCache.Update] no unit paths: ',Compiler,' ',ExtraOptions]);
        Units:=TStringToStringTree.Create(false);
      end;
      // check if the system ppu exists
      HasPPUs:=CompareFileExt(Units['system'],'ppu',false)=0;
    end;
    // check for changes
    if not Equals(OldOptions) then begin
      IncreaseChangeStamp;
      if CTConsoleVerbosity>=0 then
        debugln(['Hint: [TFPCTargetConfigCache.Update] has changed']);
    end;
    Result:=true;
  finally
    CfgFiles.Free;
    OldOptions.Free;
  end;
end;

function TFPCTargetConfigCache.FindRealCompilerInPath(aTargetCPU: string;
  ResolveLinks: boolean): string;

  function Search(const ShortFileName: string): string;
  var
    ExtPath: String;
  begin
    // fpc.exe first searches in -Xp<path>
    ExtPath:=GetLastFPCParameter(CompilerOptions,'-Xp');
    if (ExtPath<>'') and (ExtPath<>'.') then begin
      if not FilenameIsAbsolute(ExtPath) then
        // If -Xp is relative then it is relative to the working directory
        ExtPath:=TrimFilename(AppendPathDelim(GetCurrentDirUTF8)+ExtPath);
      Result:=AppendPathDelim(ExtPath)+ShortFileName;
      if FileExistsCached(Result) then
        exit;
    end;

    // then fpc.exe searches in its own directory
    if Compiler<>'' then begin
      Result:=ExtractFilePath(Compiler);
      if FilenameIsAbsolute(Result) then begin
        Result+=ShortFileName;
        if FileExistsCached(Result) then
          exit;
      end;
    end;

    // finally fpc.exe searches in PATH
    Result:=SearchFileInPath(ShortFileName,GetCurrentDirUTF8,
      GetEnvironmentVariableUTF8('PATH'),PathSeparator,ctsfcDefault);
    if (Result<>'') or (Compiler='') then exit;
  end;

var
  CompiledTargetCPU: String;
  Cross: Boolean;
  Postfix: String;
begin
  Result:='';

  CompiledTargetCPU:=GetCompiledTargetCPU;
  if aTargetCPU='' then
    aTargetCPU:=CompiledTargetCPU;
  Cross:=aTargetCPU<>CompiledTargetCPU;

  // The -V<postfix> parameter searches for ppcx64-postfix instead of ppcx64
  Postfix:=GetLastFPCParameter(CompilerOptions,'-V');
  if Postfix<>'' then
    Postfix:='-'+Postfix;

  Result:=Search(GetDefaultCompilerFilename(aTargetCPU,Cross)+Postfix);
  if (Result='') and Cross then begin
    Result:=Search(GetDefaultCompilerFilename(aTargetCPU,false)+Postfix);
    if Result='' then exit;
  end;
  if ResolveLinks then begin
    Result:=GetPhysicalFilenameCached(Result,false);
  end;
end;

function TFPCTargetConfigCache.GetUnitPaths: string;
begin
  if UnitPaths=nil then exit('');
  UnitPaths.Delimiter:=';';
  UnitPaths.StrictDelimiter:=true;
  Result:=UnitPaths.DelimitedText;
end;

function TFPCTargetConfigCache.GetFPCVerNumbers(out FPCVersion, FPCRelease,
  FPCPatch: integer): boolean;
var
  v: string;
begin
  v:={$I %FPCVERSION%};
  Result:=SplitFPCVersion(v,FPCVersion,FPCRelease,FPCPatch);
  if Defines<>nil then begin
    FPCVersion:=StrToIntDef(Defines['FPC_VERSION'],FPCVersion);
    FPCRelease:=StrToIntDef(Defines['FPC_RELEASE'],FPCRelease);
    FPCPatch:=StrToIntDef(Defines['FPC_PATCH'],FPCPatch);
  end;
end;

function TFPCTargetConfigCache.GetFPCVer: string;
var
  FPCVersion: integer;
  FPCRelease: integer;
  FPCPatch: integer;
begin
  if GetFPCVerNumbers(FPCVersion,FPCRelease,FPCPatch) then
    Result:=IntToStr(FPCVersion)+'.'+IntToStr(FPCRelease)+'.'+IntToStr(FPCPatch)
  else
    Result:='';
end;

function TFPCTargetConfigCache.GetFPC_FULLVERSION: integer;
begin
  if Defines<>nil then
    Result:=StrToIntDef(Defines['FPC_FULLVERSION'],0)
  else
    Result:=0;
  if Result=0 then
    Result:=GetCompiledFPCVersion;
end;

function TFPCTargetConfigCache.IndexOfUsedCfgFile: integer;
begin
  if ConfigFiles=nil then exit(-1);
  Result:=0;
  while (Result<ConfigFiles.Count) and (not ConfigFiles[Result].FileExists) do
    inc(Result);
  if Result=ConfigFiles.Count then Result:=-1;
end;

{ TFPCTargetConfigCaches }

constructor TFPCTargetConfigCaches.Create(AOwner: TComponent);
begin
  CTIncreaseChangeStamp(FChangeStamp); // set to not 0
  inherited Create(AOwner);
  fItems:=TAVLTree.Create(@CompareFPCTargetConfigCacheItems);
end;

destructor TFPCTargetConfigCaches.Destroy;
begin
  Clear;
  FreeAndNil(fItems);
  inherited Destroy;
end;

procedure TFPCTargetConfigCaches.Clear;
begin
  if fItems.Count=0 then exit;
  fItems.FreeAndClear;
  IncreaseChangeStamp;
end;

function TFPCTargetConfigCaches.Equals(Caches: TFPCTargetConfigCaches): boolean;
var
  Node1, Node2: TAVLTreeNode;
  Item1: TFPCTargetConfigCache;
  Item2: TFPCTargetConfigCache;
begin
  Result:=false;
  if Caches.fItems.Count<>fItems.Count then exit;
  Node1:=fItems.FindLowest;
  Node2:=Caches.fItems.FindLowest;
  while Node1<>nil do begin
    Item1:=TFPCTargetConfigCache(Node1.Data);
    Item2:=TFPCTargetConfigCache(Node2.Data);
    if not Item1.Equals(Item2) then exit;
    Node1:=fItems.FindSuccessor(Node1);
    Node2:=Caches.fItems.FindSuccessor(Node2);
  end;
  Result:=true;
end;

procedure TFPCTargetConfigCaches.Assign(Source: TPersistent);
var
  Caches: TFPCTargetConfigCaches;
  Node: TAVLTreeNode;
  SrcItem: TFPCTargetConfigCache;
  NewItem: TFPCTargetConfigCache;
begin
  if Source is TFPCTargetConfigCaches then begin
    Caches:=TFPCTargetConfigCaches(Source);
    if Equals(Caches) then exit; // no change, keep ChangeStamp
    Clear;
    Node:=Caches.fItems.FindLowest;
    while Node<>nil do begin
      SrcItem:=TFPCTargetConfigCache(Node.Data);
      NewItem:=TFPCTargetConfigCache.Create(Self);
      NewItem.Assign(SrcItem);
      fItems.Add(NewItem);
      Node:=Caches.fItems.FindSuccessor(Node);
    end;
    IncreaseChangeStamp;
  end else
    inherited Assign(Source);
end;

procedure TFPCTargetConfigCaches.LoadFromXMLConfig(XMLConfig: TXMLConfig;
  const Path: string);
var
  Cnt: integer;
  i: Integer;
  Item: TFPCTargetConfigCache;
begin
  Clear;
  Cnt:=XMLConfig.GetValue(Path+'Count',0);
  for i:=1 to Cnt do begin
    Item:=TFPCTargetConfigCache.Create(Self);
    Item.LoadFromXMLConfig(XMLConfig,Path+'Item'+IntToStr(i)+'/');
    if (Item.Compiler<>'') then
      fItems.Add(Item)
    else
      Item.Free;
  end;
  IncreaseChangeStamp;
end;

procedure TFPCTargetConfigCaches.SaveToXMLConfig(XMLConfig: TXMLConfig;
  const Path: string);
var
  Node: TAVLTreeNode;
  Item: TFPCTargetConfigCache;
  i: Integer;
begin
  Node:=fItems.FindLowest;
  i:=0;
  while Node<>nil do begin
    Item:=TFPCTargetConfigCache(Node.Data);
    inc(i);
    Item.SaveToXMLConfig(XMLConfig,Path+'Item'+IntToStr(i)+'/');
    Node:=fItems.FindSuccessor(Node);
  end;
  XMLConfig.SetDeleteValue(Path+'Count',i,0);
end;

procedure TFPCTargetConfigCaches.LoadFromFile(Filename: string);
var
  XMLConfig: TXMLConfig;
begin
  XMLConfig:=TXMLConfig.Create(Filename);
  try
    LoadFromXMLConfig(XMLConfig,'FPCConfigs/');
  finally
    XMLConfig.Free;
  end;
end;

procedure TFPCTargetConfigCaches.SaveToFile(Filename: string);
var
  XMLConfig: TXMLConfig;
begin
  XMLConfig:=TXMLConfig.CreateClean(Filename);
  try
    SaveToXMLConfig(XMLConfig,'FPCConfigs/');
  finally
    XMLConfig.Free;
  end;
end;

procedure TFPCTargetConfigCaches.IncreaseChangeStamp;
begin
  CTIncreaseChangeStamp(FChangeStamp);
end;

function TFPCTargetConfigCaches.Find(CompilerFilename, CompilerOptions,
  TargetOS, TargetCPU: string; CreateIfNotExists: boolean
  ): TFPCTargetConfigCache;
var
  Node: TAVLTreeNode;
  Cmp: TFPCTargetConfigCache;
begin
  Cmp:=TFPCTargetConfigCache.Create(Self);
  try
    Cmp.Compiler:=CompilerFilename;
    Cmp.CompilerOptions:=CompilerOptions;
    Cmp.TargetOS:=TargetOS;
    Cmp.TargetCPU:=TargetCPU;
    Node:=fItems.Find(cmp);
    if Node<>nil then begin
      Result:=TFPCTargetConfigCache(Node.Data);
    end else if CreateIfNotExists then begin
      Result:=cmp;
      cmp:=nil;
      fItems.Add(Result);
    end else begin
      Result:=nil;
    end;
  finally
    Cmp.Free;
  end;
end;

procedure TFPCTargetConfigCaches.GetDefaultCompilerTarget(
  const CompilerFilename, CompilerOptions: string; out TargetOS,
  TargetCPU: string);
var
  Cfg: TFPCTargetConfigCache;
begin
  Cfg:=Find(CompilerFilename,CompilerOptions,'','',true);
  if Cfg=nil then begin
    TargetOS:='';
    TargetCPU:='';
  end else begin
    if Cfg.NeedsUpdate then
      Cfg.Update(TestFilename);
    TargetOS:=Cfg.RealTargetOS;
    TargetCPU:=Cfg.RealTargetCPU;
  end;
end;

function TFPCTargetConfigCaches.GetListing: string;
var
  Node: TAVLTreeNode;
  CfgCache: TFPCTargetConfigCache;
  i: Integer;
begin
  Result:='TFPCTargetConfigCaches.GetListing Count='+dbgs(fItems.Count)+LineEnding;
  i:=0;
  Node:=fItems.FindLowest;
  while Node<>nil do begin
    inc(i);
    CfgCache:=TFPCTargetConfigCache(Node.Data);
    Result+='  '+dbgs(i)+':'
           +' TargetOS="'+CfgCache.TargetOS+'"'
           +' TargetCPU="'+CfgCache.TargetCPU+'"'
           +' Compiler="'+CfgCache.Compiler+'"'
           +' CompilerOptions="'+CfgCache.CompilerOptions+'"'
           +LineEnding;
    Node:=fItems.FindSuccessor(Node);
  end;
end;

{ TFPCConfigFileStateList }

function TFPCConfigFileStateList.GetItems(Index: integer): TFPCConfigFileState;
begin
  Result:=TFPCConfigFileState(fItems[Index]);
end;

constructor TFPCConfigFileStateList.Create;
begin
  fItems:=TFPList.Create;
end;

destructor TFPCConfigFileStateList.Destroy;
begin
  Clear;
  FreeAndNil(fItems);
  inherited Destroy;
end;

procedure TFPCConfigFileStateList.Clear;
var
  i: Integer;
begin
  for i:=0 to fItems.Count-1 do
    TObject(fItems[i]).Free;
  fItems.Clear;
end;

procedure TFPCConfigFileStateList.Assign(List: TFPCConfigFileStateList);
var
  i: Integer;
  Item: TFPCConfigFileState;
begin
  Clear;
  for i:=0 to List.Count-1 do begin
    Item:=List[i];
    Add(Item.Filename,Item.FileExists,Item.FileDate);
  end;
end;

function TFPCConfigFileStateList.Equals(List: TFPCConfigFileStateList;
  CheckDates: boolean): boolean;
var
  i: Integer;
begin
  Result:=false;
  if Count<>List.Count then exit;
  for i:=0 to Count-1 do
    if not Items[i].Equals(List[i],CheckDates) then exit;
  Result:=true;
end;

function TFPCConfigFileStateList.Add(aFilename: string; aFileExists: boolean;
  aFileDate: longint): TFPCConfigFileState;
begin
  Result:=TFPCConfigFileState.Create(aFilename,aFileExists,aFileDate);
  fItems.Add(Result);
end;

function TFPCConfigFileStateList.Count: integer;
begin
  Result:=fItems.Count;
end;

procedure TFPCConfigFileStateList.LoadFromXMLConfig(XMLConfig: TXMLConfig;
  const Path: string);
var
  Cnt: integer;
  Item: TFPCConfigFileState;
  i: Integer;
begin
  Cnt:=XMLConfig.GetValue(Path+'Count',0);
  for i:=1 to Cnt do begin
    Item:=TFPCConfigFileState.Create('',false,0);
    Item.LoadFromXMLConfig(XMLConfig,Path+'Item'+IntToStr(i)+'/');
    fItems.Add(Item);
  end;
end;

procedure TFPCConfigFileStateList.SaveToXMLConfig(XMLConfig: TXMLConfig;
  const Path: string);
var
  i: Integer;
begin
  for i:=1 to Count do
    Items[i-1].SaveToXMLConfig(XMLConfig,Path+'Item'+IntToStr(i)+'/');
  XMLConfig.SetDeleteValue(Path+'Count',Count,0);
end;

{ TFPCConfigFileState }

constructor TFPCConfigFileState.Create(const aFilename: string;
  aFileExists: boolean; aFileDate: longint);
begin
  Filename:=aFilename;
  FileExists:=aFileExists;
  FileDate:=aFileDate;
end;

function TFPCConfigFileState.Equals(Other: TFPCConfigFileState;
  CheckDate: boolean): boolean;
begin
  Result:=false;
  if (Filename<>Other.Filename) or (FileExists<>Other.FileExists) then exit;
  if CheckDate and FileExists and (FileDate<>Other.FileDate) then exit;
  Result:=true;
end;

procedure TFPCConfigFileState.LoadFromXMLConfig(XMLConfig: TXMLConfig;
  const Path: string);
begin
  Filename:=XMLConfig.GetValue(Path+'Filename','');
  FileExists:=XMLConfig.GetValue(Path+'Exists',false);
  FileDate:=XMLConfig.GetValue(Path+'Date',0);
end;

procedure TFPCConfigFileState.SaveToXMLConfig(XMLConfig: TXMLConfig;
  const Path: string);
begin
  XMLConfig.SetDeleteValue(Path+'Filename',Filename,'');
  XMLConfig.SetDeleteValue(Path+'Exists',FileExists,false);
  XMLConfig.SetDeleteValue(Path+'Date',FileDate,0);
end;

{ TFPCSourceCacheItem }

constructor TFPCSourceCache.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Files:=TStringList.Create;
  Valid:=false;
  CTIncreaseChangeStamp(FChangeStamp); // set to not 0
  if Owner is TFPCSourceCaches then
    Caches:=TFPCSourceCaches(Owner);
end;

destructor TFPCSourceCache.Destroy;
begin
  FreeAndNil(Files);
  inherited Destroy;
end;

procedure TFPCSourceCache.Clear;
begin
  FreeAndNil(Files);
  Valid:=false;
end;

procedure TFPCSourceCache.Assign(Source: TPersistent);
var
  Cache: TFPCSourceCache;
begin
  if Source is TFPCSourceCache then begin
    Cache:=TFPCSourceCache(Source);
    Directory:=Cache.Directory;
    Files.Assign(Cache.Files);
    Valid:=Cache.Valid;
  end else
    inherited Assign(Source);
end;

function TFPCSourceCache.Equals(Cache: TFPCSourceCache): boolean;
begin
  Result:=false;
  if Valid<>Cache.Valid then exit;
  if Directory<>Cache.Directory then exit;
  if not Files.Equals(Cache.Files) then exit;
  Result:=true;
end;

procedure TFPCSourceCache.LoadFromXMLConfig(XMLConfig: TXMLConfig;
  const Path: string);
var
  List: TStringList;
begin
  Clear;
  List:=nil;
  try
    Valid:=XMLConfig.GetValue(Path+'Valid',true);
    Directory:=XMLConfig.GetValue(Path+'Directory','');
    List:=TStringList.Create;
    List.StrictDelimiter:=true;
    List.Delimiter:=';';
    List.DelimitedText:=XMLConfig.GetValue(Path+'Files','');
    FreeAndNil(Files);
    Files:=Decompress1FileList(List);
  finally
    if Files=nil then Files:=TStringList.Create;
    List.Free;
  end;
end;

procedure TFPCSourceCache.SaveToXMLConfig(XMLConfig: TXMLConfig;
  const Path: string);
var
  List: TStringList;
  s: String;
begin
  List:=nil;
  try
    XMLConfig.SetDeleteValue(Path+'Valid',Valid,true);
    XMLConfig.SetDeleteValue(Path+'Directory',Directory,'');
    if Files<>nil then begin
      List:=Compress1FileList(Files);
      List.StrictDelimiter:=true;
      List.Delimiter:=';';
      s:=List.DelimitedText;
    end else
      s:='';
    XMLConfig.SetDeleteValue(Path+'Files',s,'');
  finally
    List.Free;
  end;
end;

procedure TFPCSourceCache.LoadFromFile(Filename: string);
var
  XMLConfig: TXMLConfig;
begin
  XMLConfig:=TXMLConfig.Create(Filename);
  try
    LoadFromXMLConfig(XMLConfig,'FPCSourceDirectory/');
  finally
    XMLConfig.Free;
  end;
end;

procedure TFPCSourceCache.SaveToFile(Filename: string);
var
  XMLConfig: TXMLConfig;
begin
  XMLConfig:=TXMLConfig.CreateClean(Filename);
  try
    SaveToXMLConfig(XMLConfig,'FPCSourceDirectory/');
  finally
    XMLConfig.Free;
  end;
end;

procedure TFPCSourceCache.Update(const OnProgress: TDefinePoolProgress);
var
  NewFiles: TStringList;
begin
  Valid:=false;
  if Directory<>'' then
    NewFiles:=GatherFilesInFPCSources(Directory,OnProgress)
  else
    NewFiles:=TStringList.Create;
  Update(NewFiles);
end;

procedure TFPCSourceCache.Update(var NewFiles: TStringList);
var
  OldFiles: TStringList;
  OldValid: Boolean;
begin
  OldFiles:=Files;
  OldValid:=Valid;
  try
    Files:=NewFiles;
    NewFiles:=nil;
    Valid:=true;
    if (Valid<>OldValid)
    or ((Files=nil)<>(OldFiles=nil))
    or ((Files<>nil) and (Files.Text<>OldFiles.Text)) then begin
      IncreaseChangeStamp;
      if CTConsoleVerbosity>0 then
        debugln(['Hint: [TFPCSourceCache.Update] ',Directory,' has changed.']);
    end;
  finally
    OldFiles.Free;
  end;
end;

procedure TFPCSourceCache.IncreaseChangeStamp;
begin
  CTIncreaseChangeStamp(FChangeStamp);
  if Caches<>nil then
    Caches.IncreaseChangeStamp;
end;

{ TFPCSourceCache }

constructor TFPCSourceCaches.Create(AOwner: TComponent);
begin
  CTIncreaseChangeStamp(FChangeStamp); // set to not 0
  inherited Create(AOwner);
  fItems:=TAVLTree.Create(@CompareFPCSourceCacheItems);
end;

destructor TFPCSourceCaches.Destroy;
begin
  Clear;
  FreeAndNil(fItems);
  inherited Destroy;
end;

procedure TFPCSourceCaches.Clear;
begin
  if fItems.Count=0 then exit;
  fItems.FreeAndClear;
  IncreaseChangeStamp;
end;

procedure TFPCSourceCaches.Assign(Source: TPersistent);
var
  Caches: TFPCSourceCaches;
  SrcItem: TFPCSourceCache;
  NewItem: TFPCSourceCache;
  Node: TAVLTreeNode;
begin
  if Source is TFPCSourceCaches then begin
    Caches:=TFPCSourceCaches(Source);
    if Equals(Caches) then exit; // keep ChangeStamp if equal
    Clear;
    Node:=Caches.fItems.FindLowest;
    while Node<>nil do begin
      SrcItem:=TFPCSourceCache(Node.Data);
      NewItem:=TFPCSourceCache.Create(Self);
      NewItem.Assign(SrcItem);
      fItems.Add(NewItem);
      Node:=Caches.fItems.FindSuccessor(Node);
    end;
    IncreaseChangeStamp;
  end else
    inherited Assign(Source);
end;

function TFPCSourceCaches.Equals(Caches: TFPCSourceCaches): boolean;
var
  Node1, Node2: TAVLTreeNode;
  Item1: TFPCSourceCache;
  Item2: TFPCSourceCache;
begin
  Result:=false;
  if Caches.fItems.Count<>fItems.Count then exit;
  Node1:=fItems.FindLowest;
  Node2:=Caches.fItems.FindLowest;
  while Node1<>nil do begin
    Item1:=TFPCSourceCache(Node1.Data);
    Item2:=TFPCSourceCache(Node2.Data);
    if not Item1.Equals(Item2) then exit;
    Node1:=fItems.FindSuccessor(Node1);
    Node2:=Caches.fItems.FindSuccessor(Node2);
  end;
  Result:=true;
end;

procedure TFPCSourceCaches.LoadFromXMLConfig(XMLConfig: TXMLConfig;
  const Path: string);
var
  Cnt: integer;
  i: Integer;
  Item: TFPCSourceCache;
begin
  Clear;
  Cnt:=XMLConfig.GetValue(Path+'Count',0);
  for i:=1 to Cnt do begin
    Item:=TFPCSourceCache.Create(Self);
    Item.LoadFromXMLConfig(XMLConfig,Path+'Item'+IntToStr(i)+'/');
    if (Item.Directory='') or (fItems.Find(Item)<>nil) then
      Item.Free
    else
      fItems.Add(Item);
  end;
end;

procedure TFPCSourceCaches.SaveToXMLConfig(XMLConfig: TXMLConfig;
  const Path: string);
var
  Node: TAVLTreeNode;
  Item: TFPCSourceCache;
  Cnt: Integer;
begin
  Cnt:=0;
  Node:=fItems.FindLowest;
  while Node<>nil do begin
    Item:=TFPCSourceCache(Node.Data);
    if Item.Directory<>'' then begin
      inc(Cnt);
      Item.SaveToXMLConfig(XMLConfig,Path+'Item'+IntToStr(Cnt)+'/');
    end;
    Node:=fItems.FindSuccessor(Node);
  end;
  XMLConfig.SetDeleteValue(Path+'Count',Cnt,0);
end;

procedure TFPCSourceCaches.LoadFromFile(Filename: string);
var
  XMLConfig: TXMLConfig;
begin
  XMLConfig:=TXMLConfig.Create(Filename);
  try
    LoadFromXMLConfig(XMLConfig,'FPCSourceDirectories/');
  finally
    XMLConfig.Free;
  end;
end;

procedure TFPCSourceCaches.SaveToFile(Filename: string);
var
  XMLConfig: TXMLConfig;
begin
  XMLConfig:=TXMLConfig.CreateClean(Filename);
  try
    SaveToXMLConfig(XMLConfig,'FPCSourceDirectories/');
  finally
    XMLConfig.Free;
  end;
end;

procedure TFPCSourceCaches.IncreaseChangeStamp;
begin
  CTIncreaseChangeStamp(FChangeStamp);
end;

function TFPCSourceCaches.Find(Directory: string;
  CreateIfNotExists: boolean): TFPCSourceCache;
var
  Node: TAVLTreeNode;
begin
  Directory:=ChompPathDelim(TrimFilename(Directory));
  Node:=fItems.FindKey(PChar(Directory),@CompareDirectoryWithFPCSourceCacheItem);
  if Node<>nil then begin
    Result:=TFPCSourceCache(Node.Data);
  end else if CreateIfNotExists then begin
    Result:=TFPCSourceCache.Create(Self);
    Result.Directory:=Directory;
    fItems.Add(Result);
  end else begin
    Result:=nil;
  end;
end;

{ TFPCDefinesCache }

procedure TFPCDefinesCache.SetConfigCaches(const AValue: TFPCTargetConfigCaches);
begin
  if FConfigCaches=AValue then exit;
  FConfigCaches:=AValue;
  FConfigCachesSaveStamp:=Low(FConfigCachesSaveStamp);
end;

function TFPCDefinesCache.GetExtraOptions: string;
begin
  Result:=ConfigCaches.ExtraOptions;
end;

function TFPCDefinesCache.GetTestFilename: string;
begin
  Result:=ConfigCaches.TestFilename;
end;

procedure TFPCDefinesCache.SetExtraOptions(AValue: string);
begin
  ConfigCaches.ExtraOptions:=AValue;
end;

procedure TFPCDefinesCache.SetSourceCaches(const AValue: TFPCSourceCaches);
begin
  if FSourceCaches=AValue then exit;
  FSourceCaches:=AValue;
  FSourceCachesSaveStamp:=low(FSourceCachesSaveStamp);
end;

procedure TFPCDefinesCache.ClearUnitToSrcCaches;
var
  i: Integer;
begin
  for i:=0 to fUnitToSrcCaches.Count-1 do
    TObject(fUnitToSrcCaches[i]).Free;
  fUnitToSrcCaches.Clear;
end;

procedure TFPCDefinesCache.SetTestFilename(AValue: string);
begin
  ConfigCaches.TestFilename:=AValue;
end;

constructor TFPCDefinesCache.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ConfigCaches:=TFPCTargetConfigCaches.Create(nil);
  SourceCaches:=TFPCSourceCaches.Create(nil);
  fUnitToSrcCaches:=TFPList.Create;
end;

destructor TFPCDefinesCache.Destroy;
begin
  ClearUnitToSrcCaches;
  FreeAndNil(FConfigCaches);
  FreeAndNil(FSourceCaches);
  FreeAndNil(fUnitToSrcCaches);
  inherited Destroy;
end;

procedure TFPCDefinesCache.Clear;
begin
  ClearUnitToSrcCaches;
  if ConfigCaches<>nil then ConfigCaches.Clear;
  if SourceCaches<>nil then SourceCaches.Clear;
end;

procedure TFPCDefinesCache.LoadFromXMLConfig(XMLConfig: TXMLConfig;
  const Path: string);
begin
  if ConfigCaches<>nil then begin
    ConfigCaches.LoadFromXMLConfig(XMLConfig,Path+'FPCConfigs/');
    FConfigCachesSaveStamp:=ConfigCaches.ChangeStamp;
  end;
  if SourceCaches<>nil then begin
    SourceCaches.LoadFromXMLConfig(XMLConfig,Path+'FPCSources/');
    FSourceCachesSaveStamp:=SourceCaches.ChangeStamp;
  end;
end;

procedure TFPCDefinesCache.SaveToXMLConfig(XMLConfig: TXMLConfig;
  const Path: string);
begin
  //debugln(['TFPCDefinesCache.SaveToXMLConfig ']);
  if ConfigCaches<>nil then begin
    ConfigCaches.SaveToXMLConfig(XMLConfig,Path+'FPCConfigs/');
    FConfigCachesSaveStamp:=ConfigCaches.ChangeStamp;
  end;
  if SourceCaches<>nil then begin
    SourceCaches.SaveToXMLConfig(XMLConfig,Path+'FPCSources/');
    FSourceCachesSaveStamp:=SourceCaches.ChangeStamp;
  end;
end;

procedure TFPCDefinesCache.LoadFromFile(Filename: string);
var
  XMLConfig: TXMLConfig;
begin
  XMLConfig:=TXMLConfig.Create(Filename);
  try
    LoadFromXMLConfig(XMLConfig,'');
  finally
    XMLConfig.Free;
  end;
end;

procedure TFPCDefinesCache.SaveToFile(Filename: string);
var
  XMLConfig: TXMLConfig;
begin
  XMLConfig:=TXMLConfig.CreateClean(Filename);
  try
    SaveToXMLConfig(XMLConfig,'');
  finally
    XMLConfig.Free;
  end;
end;

function TFPCDefinesCache.NeedsSave: boolean;
begin
  Result:=true;
  if (ConfigCaches<>nil) and (ConfigCaches.ChangeStamp<>FConfigCachesSaveStamp)
  then exit;
  if (SourceCaches<>nil) and (SourceCaches.ChangeStamp<>FSourceCachesSaveStamp)
  then exit;
  Result:=false;
end;

function TFPCDefinesCache.GetFPCVersion(const CompilerFilename, TargetOS,
  TargetCPU: string; UseCompiledVersionAsDefault: boolean): string;
var
  CfgCache: TFPCTargetConfigCache;
  ErrorMsg: string;
begin
  if UseCompiledVersionAsDefault then
    Result:={$I %FPCVersion%}
  else
    Result:='';
  if not IsFPCExecutable(CompilerFilename,ErrorMsg) then
    exit;
  CfgCache:=ConfigCaches.Find(CompilerFilename,ExtraOptions,TargetOS,TargetCPU,true);
  if CfgCache.NeedsUpdate
  and not CfgCache.Update(TestFilename,ExtraOptions) then
    exit;
  if CfgCache.FullVersion='' then exit;
  Result:=CfgCache.FullVersion;
end;

function TFPCDefinesCache.FindUnitSet(const CompilerFilename, TargetOS,
  TargetCPU, Options, FPCSrcDir: string; CreateIfNotExists: boolean
  ): TFPCUnitSetCache;
var
  i: Integer;
begin
  for i:=0 to fUnitToSrcCaches.Count-1 do begin
    Result:=TFPCUnitSetCache(fUnitToSrcCaches[i]);
    if (CompareFilenames(Result.CompilerFilename,CompilerFilename)=0)
    and (SysUtils.CompareText(Result.TargetOS,TargetOS)=0)
    and (SysUtils.CompareText(Result.TargetCPU,TargetCPU)=0)
    and (CompareFilenames(Result.FPCSourceDirectory,FPCSrcDir)=0)
    and (Result.CompilerOptions=Options)
    then
      exit;
  end;
  if CreateIfNotExists then begin
    Result:=TFPCUnitSetCache.Create(Self);
    Result.CompilerFilename:=CompilerFilename;
    Result.CompilerOptions:=Options;
    Result.TargetOS:=TargetOS;
    Result.TargetCPU:=TargetCPU;
    Result.FPCSourceDirectory:=FPCSrcDir;
    fUnitToSrcCaches.Add(Result);
  end else
    Result:=nil;
end;

function TFPCDefinesCache.FindUnitSetWithID(const UnitSetID: string; out
  Changed: boolean; CreateIfNotExists: boolean): TFPCUnitSetCache;
var
  CompilerFilename, TargetOS, TargetCPU, Options, FPCSrcDir: string;
  ChangeStamp: integer;
begin
  ParseUnitSetID(UnitSetID,CompilerFilename, TargetOS, TargetCPU,
                 Options, FPCSrcDir, ChangeStamp);
  //debugln(['TFPCDefinesCache.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]);
  Result:=FindUnitSet(CompilerFilename, TargetOS, TargetCPU,
                             Options, FPCSrcDir, false);
  if Result<>nil then begin
    Changed:=ChangeStamp<>Result.ChangeStamp;
  end else if CreateIfNotExists then begin
    Changed:=true;
    Result:=FindUnitSet(CompilerFilename, TargetOS, TargetCPU,
                               Options, FPCSrcDir, true);
  end else
    Changed:=false;
end;

function TFPCDefinesCache.GetUnitSetID(CompilerFilename, TargetOS, TargetCPU,
  Options, FPCSrcDir: string; ChangeStamp: integer): string;
begin
  Result:='CompilerFilename='+CompilerFilename+LineEnding
         +'TargetOS='+TargetOS+LineEnding
         +'TargetCPU='+TargetCPU+LineEnding
         +'Options='+Options+LineEnding
         +'FPCSrcDir='+FPCSrcDir+LineEnding
         +'Stamp='+IntToStr(ChangeStamp);
end;

procedure TFPCDefinesCache.ParseUnitSetID(const ID: string;
  out CompilerFilename, TargetOS, TargetCPU, Options, FPCSrcDir: string;
  out ChangeStamp: integer);
var
  NameStartPos: PChar;

  function NameFits(p: PChar): boolean;
  var
    p1: PChar;
  begin
    p1:=NameStartPos;
    while (FPUpChars[p1^]=FPUpChars[p^]) and (p^<>#0) do begin
      inc(p1);
      inc(p);
    end;
    Result:=p1^='=';
  end;

var
  ValueStartPos: PChar;
  ValueEndPos: PChar;
  Value: String;
begin
  CompilerFilename:='';
  TargetCPU:='';
  TargetOS:='';
  Options:='';
  FPCSrcDir:='';
  ChangeStamp:=0;
  if ID='' then exit;
  // read the lines with name=value
  NameStartPos:=PChar(ID);
  while NameStartPos^<>#0 do begin
    while (NameStartPos^ in [#10,#13]) do inc(NameStartPos);
    ValueStartPos:=NameStartPos;
    while not (ValueStartPos^ in ['=',#10,#13,#0]) do inc(ValueStartPos);
    if ValueStartPos^<>'=' then exit;
    inc(ValueStartPos);
    ValueEndPos:=ValueStartPos;
    while not (ValueEndPos^ in [#10,#13,#0]) do inc(ValueEndPos);
    Value:=copy(ID,ValueStartPos-PChar(ID)+1,ValueEndPos-ValueStartPos);
    //debugln(['TFPCDefinesCache.ParseUnitSetID Name=',copy(ID,NameStartPos-PChar(ID)+1,ValueStartPos-NameStartPos-1),' Value="',Value,'"']);
    case NameStartPos^ of
    'c','C':
      if NameFits('CompilerFilename') then
        CompilerFilename:=Value;
    'f','F':
      if NameFits('FPCSrcDir') then
        FPCSrcDir:=Value;
    'o','O':
      if NameFits('Options') then
        Options:=Value;
    's','S':
      if NameFits('Stamp') then
        ChangeStamp:=StrToIntDef(Value,0);
    't','T':
      if NameFits('TargetOS') then
        TargetOS:=Value
      else if NameFits('TargetCPU') then
        TargetCPU:=Value;
    end;
    NameStartPos:=ValueEndPos;
  end;
end;

{ TFPCUnitSetCache }

procedure TFPCUnitSetCache.SetCompilerFilename(const AValue: string);
var
  NewFilename: String;
begin
  NewFilename:=ResolveDots(AValue);
  if FCompilerFilename=NewFilename then exit;
  FCompilerFilename:=NewFilename;
  ClearConfigCache;
end;

procedure TFPCUnitSetCache.SetCompilerOptions(const AValue: string);
begin
  if FCompilerOptions=AValue then exit;
  FCompilerOptions:=AValue;
  ClearConfigCache;
end;

procedure TFPCUnitSetCache.SetFPCSourceDirectory(const AValue: string);
var
  NewValue: String;
begin
  NewValue:=TrimAndExpandDirectory(AValue);
  if FFPCSourceDirectory=NewValue then exit;
  FFPCSourceDirectory:=NewValue;
  ClearSourceCache;
end;

procedure TFPCUnitSetCache.SetTargetCPU(const AValue: string);
begin
  if FTargetCPU=AValue then exit;
  FTargetCPU:=AValue;
  ClearConfigCache;
end;

procedure TFPCUnitSetCache.SetTargetOS(const AValue: string);
begin
  if FTargetOS=AValue then exit;
  FTargetOS:=AValue;
  ClearConfigCache;
end;

procedure TFPCUnitSetCache.ClearConfigCache;
begin
  FConfigCache:=nil;
  fFlags:=fFlags+[fuscfUnitTreeNeedsUpdate,fuscfSrcRulesNeedUpdate];
end;

procedure TFPCUnitSetCache.ClearSourceCache;
begin
  fSourceCache:=nil;
  Include(fFlags,fuscfUnitTreeNeedsUpdate);
end;

procedure TFPCUnitSetCache.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation=opRemove then begin
    if FConfigCache=AComponent then
      ClearConfigCache;
    if fSourceCache=AComponent then
      ClearSourceCache;
  end;
end;

constructor TFPCUnitSetCache.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  CTIncreaseChangeStamp(FChangeStamp); // set ot not 0
  FCaches:=TheOwner as TFPCDefinesCache;
  fUnitToSourceTree:=TStringToStringTree.Create(false);
  fSrcDuplicates:=TStringToStringTree.Create(false);
  fSourceRules:=TFPCSourceRules.Create;
  fFlags:=[fuscfUnitTreeNeedsUpdate,fuscfSrcRulesNeedUpdate];
  fUnitStampOfFPC:=CTInvalidChangeStamp;
  fUnitStampOfFiles:=CTInvalidChangeStamp;
  fUnitStampOfRules:=CTInvalidChangeStamp;
end;

destructor TFPCUnitSetCache.Destroy;
begin
  FreeAndNil(fSourceRules);
  FreeAndNil(fUnitToSourceTree);
  FreeAndNil(fSrcDuplicates);
  inherited Destroy;
end;

procedure TFPCUnitSetCache.Clear;
begin

end;

procedure TFPCUnitSetCache.Init;
begin
  GetUnitToSourceTree(True);
end;

function TFPCUnitSetCache.GetConfigCache(AutoUpdate: boolean
  ): TFPCTargetConfigCache;
begin
  if CompilerFilename='' then
    raise Exception.Create('TFPCUnitToSrcCache.GetConfigCache missing CompilerFilename');
  if Caches.TestFilename='' then
    raise Exception.Create('TFPCUnitToSrcCache.GetConfigCache missing TestFilename');
  if FConfigCache=nil then begin
    FConfigCache:=Caches.ConfigCaches.Find(CompilerFilename,CompilerOptions,
                                           TargetOS,TargetCPU,true);
    FConfigCache.FreeNotification(Self);
  end;
  //debugln(['TFPCUnitSetCache.GetConfigCache CompilerOptions="',CompilerOptions,'" FConfigCache.CompilerOptions="',FConfigCache.CompilerOptions,'"']);
  if AutoUpdate and FConfigCache.NeedsUpdate then
    FConfigCache.Update(Caches.TestFilename,Caches.ExtraOptions);
  Result:=FConfigCache;
end;

function TFPCUnitSetCache.GetSourceCache(AutoUpdate: boolean
  ): TFPCSourceCache;
begin
  if fSourceCache=nil then begin
    fSourceCache:=Caches.SourceCaches.Find(FPCSourceDirectory,true);
    fSourceCache.FreeNotification(Self);
  end;
  if AutoUpdate and (not fSourceCache.Valid) then
    fSourceCache.Update(nil);
  Result:=fSourceCache;
end;

function TFPCUnitSetCache.GetSourceRules(AutoUpdate: boolean
  ): TFPCSourceRules;
var
  Cfg: TFPCTargetConfigCache;
  NewRules: TFPCSourceRules;
begin
  Cfg:=GetConfigCache(AutoUpdate);
  if (fuscfSrcRulesNeedUpdate in fFlags)
  or (fRulesStampOfConfig<>Cfg.ChangeStamp) then begin
    Exclude(fFlags,fuscfSrcRulesNeedUpdate);
    NewRules:=DefaultFPCSourceRules.Clone;
    try
      if Cfg.Units<>nil then
        AdjustFPCSrcRulesForPPUPaths(Cfg.Units,NewRules);
      fSourceRules.Assign(NewRules); // increases ChangeStamp if something changed
      fRulesStampOfConfig:=Cfg.ChangeStamp;
    finally
      NewRules.Free;
    end;
  end;
  Result:=fSourceRules;
end;

function TFPCUnitSetCache.GetUnitToSourceTree(AutoUpdate: boolean
  ): TStringToStringTree;
var
  Src: TFPCSourceCache;
  SrcRules: TFPCSourceRules;
  NewUnitToSourceTree: TStringToStringTree;
  NewSrcDuplicates: TStringToStringTree;
  ConfigCache: TFPCTargetConfigCache;
begin
  Src:=GetSourceCache(AutoUpdate);
  SrcRules:=GetSourceRules(AutoUpdate);
  ConfigCache:=GetConfigCache(false); // Note: update already done by GetSourceRules(AutoUpdate)

  if (fuscfUnitTreeNeedsUpdate in fFlags)
  or (fUnitStampOfFPC<>ConfigCache.ChangeStamp)
  or (fUnitStampOfFiles<>Src.ChangeStamp)
  or (fUnitStampOfRules<>SrcRules.ChangeStamp)
  then begin
    Exclude(fFlags,fuscfUnitTreeNeedsUpdate);
    NewSrcDuplicates:=nil;
    NewUnitToSourceTree:=nil;
    try
      NewSrcDuplicates:=TStringToStringTree.Create(false);
      NewUnitToSourceTree:=GatherUnitsInFPCSources(Src.Files,
                     ConfigCache.RealTargetOS,ConfigCache.RealTargetCPU,
                     NewSrcDuplicates,SrcRules);
      if NewUnitToSourceTree=nil then
        NewUnitToSourceTree:=TStringToStringTree.Create(false);
      // ToDo: add/replace sources in PPU search paths
      if not fUnitToSourceTree.Equals(NewUnitToSourceTree) then begin
        fUnitToSourceTree.Assign(NewUnitToSourceTree);
        IncreaseChangeStamp;
      end;
      if not fSrcDuplicates.Equals(NewSrcDuplicates) then begin
        fSrcDuplicates.Assign(NewSrcDuplicates);
        IncreaseChangeStamp;
      end;
      fUnitStampOfFPC:=ConfigCache.ChangeStamp;
      fUnitStampOfFiles:=Src.ChangeStamp;
      fUnitStampOfRules:=SrcRules.ChangeStamp;
    finally
      NewUnitToSourceTree.Free;
      NewSrcDuplicates.Free;
    end;
  end;
  Result:=fUnitToSourceTree;
end;

function TFPCUnitSetCache.GetSourceDuplicates(AutoUpdate: boolean
  ): TStringToStringTree;
begin
  GetUnitToSourceTree(AutoUpdate);
  Result:=fSrcDuplicates;
end;

function TFPCUnitSetCache.GetUnitSrcFile(const AnUnitName: string;
  SrcSearchRequiresPPU: boolean; SkipPPUCheckIfTargetIsSourceOnly: boolean): string;
{ Searches the unit in the FPC search path and sources.
  SrcSearchRequiresPPU: only search the sources if there is a ppu in the search path
}
var
  Tree: TStringToStringTree;
  ConfigCache: TFPCTargetConfigCache;
  UnitInFPCPath: String;
begin
  Result:='';
  {$IFDEF ShowTriedUnits}
  debugln(['TFPCUnitSetCache.GetUnitSrcFile Unit="',AnUnitName,'" SrcSearchRequiresPPU=',SrcSearchRequiresPPU,' SkipPPUCheckIfTargetIsSourceOnly=',SkipPPUCheckIfTargetIsSourceOnly]);
  {$ENDIF}
  Tree:=GetUnitToSourceTree(false);
  ConfigCache:=GetConfigCache(false);
  if (ConfigCache.Units<>nil) then begin
    UnitInFPCPath:=ConfigCache.Units[AnUnitName];
    //if Pos('lazmkunit',AnUnitName)>0 then debugln(['TFPCUnitSetCache.GetUnitSrcFile UnitInFPCPath=',UnitInFPCPath]);
    if (CompareFileExt(UnitInFPCPath,'ppu',false)=0) then begin
      // there is a ppu
    end else if UnitInFPCPath<>'' then begin
      // there is a pp or pas in the FPC search path
      {$IFDEF ShowTriedUnits}
      debugln(['TFPCUnitSetCache.GetUnitSrcFile Unit="',AnUnitName,'" source in FPC search path: "',Result,'"']);
      {$ENDIF}
      Result:=UnitInFPCPath;
      exit;
    end else begin
      // unit has no ppu in the FPC ppu search path
      if SrcSearchRequiresPPU then begin
        if ConfigCache.HasPPUs then begin
          // but there are other ppu files
          {$IFDEF ShowTriedUnits}
          debugln(['TFPCUnitSetCache.GetUnitSrcFile Unit="',AnUnitName,'" unit has no ppu file in FPC path, but there are other ppu']);
          {$ENDIF}
          exit;
        end else begin
          // no ppu exists at all
          // => the fpc is not installed properly for this target
          {$IFDEF ShowTriedUnits}
          debugln(['TFPCUnitSetCache.GetUnitSrcFile Unit="',AnUnitName,'" there are no ppu files for this target']);
          {$ENDIF}
          if (not SkipPPUCheckIfTargetIsSourceOnly) then
            exit;
          // => search directly in the sources
          // this allows cross editing even if FPC is not installed for this target
        end;
      end;
    end;
  end;
  // search the sources
  if Tree<>nil then begin
    Result:=Tree[AnUnitName];
    if (Result<>'') and (not FilenameIsAbsolute(Result)) then
      Result:=FPCSourceDirectory+Result;
    {$IFDEF ShowTriedUnits}
    debugln(['TFPCUnitSetCache.GetUnitSrcFile Unit="',AnUnitName,'" Result=',Result]);
    {$ENDIF}
  end;
end;

function TFPCUnitSetCache.GetCompiledUnitFile(const AUnitName: string): string;
var
  ConfigCache: TFPCTargetConfigCache;
begin
  Result:='';
  ConfigCache:=GetConfigCache(false);
  if ConfigCache.Units=nil then exit;
  Result:=ConfigCache.Units[AUnitName];
  if Result='' then exit;
  if CompareFileExt(Result,'.ppu',false)<>0 then
    Result:='';
end;

class function TFPCUnitSetCache.GetInvalidChangeStamp: integer;
begin
  Result:=CTInvalidChangeStamp;
end;

procedure TFPCUnitSetCache.IncreaseChangeStamp;
begin
  CTIncreaseChangeStamp(FChangeStamp);
end;

function TFPCUnitSetCache.GetUnitSetID: string;
begin
  Result:=Caches.GetUnitSetID(CompilerFilename,TargetOS,TargetCPU,
                              CompilerOptions,FPCSourceDirectory,ChangeStamp);
end;

function TFPCUnitSetCache.GetFirstFPCCfg: string;
var
  Cfg: TFPCTargetConfigCache;
  i: Integer;
begin
  Result:='';
  Cfg:=GetConfigCache(false);
  if Cfg=nil then exit;
  if Cfg.ConfigFiles=nil then exit;
  for i:=0 to Cfg.ConfigFiles.Count-1 do begin
    if Cfg.ConfigFiles[i].FileExists then begin
      Result:=Cfg.ConfigFiles[i].Filename;
      exit;
    end;
  end;
end;

initialization
  InitDefaultFPCSourceRules;

finalization
  FreeAndNil(DefaultFPCSourceRules);

end.


